diff options
Diffstat (limited to 'libpiny')
| -rw-r--r-- | libpiny/Build.PL | 30 | ||||
| -rw-r--r-- | libpiny/debian/changelog | 89 | ||||
| -rw-r--r-- | libpiny/debian/compat | 1 | ||||
| -rw-r--r-- | libpiny/debian/control | 13 | ||||
| -rw-r--r-- | libpiny/debian/copyright | 2 | ||||
| -rwxr-xr-x | libpiny/debian/rules | 4 | ||||
| -rw-r--r-- | libpiny/debian/source/format | 1 | ||||
| -rw-r--r-- | libpiny/lib/IkiWiki/FakeSetup.pm | 88 | ||||
| -rw-r--r-- | libpiny/lib/Piny.pm | 16 | ||||
| -rw-r--r-- | libpiny/lib/Piny/Config.pm | 218 | ||||
| -rw-r--r-- | libpiny/lib/Piny/Email.pm | 49 | ||||
| -rw-r--r-- | libpiny/lib/Piny/Environment.pm | 45 | ||||
| -rw-r--r-- | libpiny/lib/Piny/Group.pm | 136 | ||||
| -rw-r--r-- | libpiny/lib/Piny/Repo.pm | 637 | ||||
| -rw-r--r-- | libpiny/lib/Piny/User.pm | 216 | ||||
| -rw-r--r-- | libpiny/lib/Piny/User/IkiWiki.pm | 37 | ||||
| -rw-r--r-- | libpiny/share/ikiwiki.setup | 76 | ||||
| -rwxr-xr-x | libpiny/test | 12 |
18 files changed, 1670 insertions, 0 deletions
diff --git a/libpiny/Build.PL b/libpiny/Build.PL new file mode 100644 index 0000000..bfb5fd7 --- /dev/null +++ b/libpiny/Build.PL @@ -0,0 +1,30 @@ +use Module::Build; + +open( DCH, "<", "debian/changelog" ) or die "changelog: $!"; + +my $version = "0"; +while ( defined ( my $line = <DCH> ) ) { + if ( $line =~ /\(([0-9.]+)\)/ ) { + $version = $1; + last; + }; +}; + +close( DCH ); + +my $build = Module::Build->new + ( 'module_name' => 'Piny' + , 'dist_version' => $version + , 'license' => 'BSD-3' + , 'setup_files' => { 'share/ikiwiki.setup' => 'share/ikiwiki.setup' } + , 'install_path' => + { 'share' => '/usr/share/libpiny' + } + , 'requires' => + { 'Moose' => 0 + , 'Email::Valid::Loose' => 0 + } + ); + +$build->add_build_element( "setup" ); +$build->create_build_script( ); diff --git a/libpiny/debian/changelog b/libpiny/debian/changelog new file mode 100644 index 0000000..e97c2fe --- /dev/null +++ b/libpiny/debian/changelog @@ -0,0 +1,89 @@ +libpiny-perl (0.14) unstable; urgency=low + + * Support rebuilding a repo's config. + + -- Julian Blake Kongslie <jblake@omgwallhack.org> Wed, 13 Oct 2010 20:38:15 -0700 + +libpiny-perl (0.13) unstable; urgency=low + + * Vastly overhauled the config stuff. + + -- Julian Blake Kongslie <jblake@omgwallhack.org> Mon, 11 Oct 2010 21:55:40 -0700 + +libpiny-perl (0.12) unstable; urgency=low + + * Support for per-repo configuration in the git config, section piny. + * Support for per-repo custom http/https base URLs. + + -- Julian Blake Kongslie <jblake@omgwallhack.org> Sun, 01 Aug 2010 20:07:44 -0700 + +libpiny-perl (0.11) unstable; urgency=low + + * Destroying dead repos. + + -- Julian Blake Kongslie <jblake@omgwallhack.org> Mon, 19 Jul 2010 02:30:01 -0700 + +libpiny-perl (0.10) unstable; urgency=low + + * Support for the global /etc/piny.conf stuff. + + -- Julian Blake Kongslie <jblake@omgwallhack.org> Sun, 18 Jul 2010 21:23:28 -0700 + +libpiny-perl (0.9) unstable; urgency=low + + * Creating new repos. + + -- Julian Blake Kongslie <jblake@omgwallhack.org> Wed, 07 Jul 2010 15:34:37 -0700 + +libpiny-perl (0.8) unstable; urgency=low + + * Added apache config stuff. + + -- Julian Blake Kongslie <jblake@omgwallhack.org> Wed, 07 Jul 2010 14:26:38 -0700 + +libpiny-perl (0.7) unstable; urgency=low + + * Lots more ikiwiki integration. + + -- Julian Blake Kongslie <jblake@omgwallhack.org> Wed, 07 Jul 2010 13:45:42 -0700 + +libpiny-perl (0.6) unstable; urgency=low + + * Added IkiWiki::FakeSetup for manipulating IkiWiki setup scripts. + + -- Julian Blake Kongslie <jblake@omgwallhack.org> Wed, 07 Jul 2010 12:12:37 -0700 + +libpiny-perl (0.5) unstable; urgency=low + + * Allow listing repos and querying access rights. + + -- Julian Blake Kongslie <jblake@omgwallhack.org> Tue, 29 Jun 2010 22:28:59 -0700 + +libpiny-perl (0.4) unstable; urgency=low + + * Switch to native packaging. + + -- Julian Blake Kongslie <jblake@omgwallhack.org> Sun, 18 Apr 2010 12:33:19 -0700 + +libpiny-perl (0.3-1) unstable; urgency=low + + * Fix some build-depends stuff. + * Add group membership manipulation. + * Add some more type constraints. + * Fix a bug in the username detection. + * Forbid purely-numeric usernames. + * Use fixed paths to reach adduser and deluser. + + -- Julian Blake Kongslie <jblake@omgwallhack.org> Thu, 18 Mar 2010 16:56:24 -0700 + +libpiny-perl (0.2-1) unstable; urgency=low + + * Switched to Module::Build because it seems marginally sane. + + -- Julian Blake Kongslie <jblake@omgwallhack.org> Thu, 18 Mar 2010 00:08:05 -0700 + +libpiny-perl (0.1-1) unstable; urgency=low + + * Initial release. + + -- Julian Blake Kongslie <jblake@omgwallhack.org> Wed, 17 Mar 2010 23:44:25 -0700 diff --git a/libpiny/debian/compat b/libpiny/debian/compat new file mode 100644 index 0000000..7f8f011 --- /dev/null +++ b/libpiny/debian/compat @@ -0,0 +1 @@ +7 diff --git a/libpiny/debian/control b/libpiny/debian/control new file mode 100644 index 0000000..b64d8fa --- /dev/null +++ b/libpiny/debian/control @@ -0,0 +1,13 @@ +Source: libpiny-perl +Maintainer: Julian Blake Kongslie <jblake@omgwallhack.org> +Section: perl +Build-depends: debhelper (>= 7) +Priority: extra +Standards-version: 3.8.4 + +Package: libpiny-perl +Architecture: all +Depends: ${perl:Depends}, ${misc:Depends}, libconfig-simple-perl, libemail-valid-loose-perl, libmoose-perl, libmoosex-singleton-perl, libmoosex-strictconstructor-perl +Description: Perl interface for the piny infrastructure + This is a set of modules for accomplishing administrative tasks in the piny.be + infrastructure. diff --git a/libpiny/debian/copyright b/libpiny/debian/copyright new file mode 100644 index 0000000..db049e1 --- /dev/null +++ b/libpiny/debian/copyright @@ -0,0 +1,2 @@ +Copyright © 2010 Julian Blake Kongslie <jblake@omgwallhack.org> +Licensed under the BSD 3-clause license. diff --git a/libpiny/debian/rules b/libpiny/debian/rules new file mode 100755 index 0000000..2d33f6a --- /dev/null +++ b/libpiny/debian/rules @@ -0,0 +1,4 @@ +#!/usr/bin/make -f + +%: + dh $@ diff --git a/libpiny/debian/source/format b/libpiny/debian/source/format new file mode 100644 index 0000000..89ae9db --- /dev/null +++ b/libpiny/debian/source/format @@ -0,0 +1 @@ +3.0 (native) diff --git a/libpiny/lib/IkiWiki/FakeSetup.pm b/libpiny/lib/IkiWiki/FakeSetup.pm new file mode 100644 index 0000000..c9c823b --- /dev/null +++ b/libpiny/lib/IkiWiki/FakeSetup.pm @@ -0,0 +1,88 @@ +package IkiWiki::FakeSetup; + +use strict; +use warnings; + +use Data::Dumper qw( ); +use Exporter qw( import ); + +our @EXPORT_OK = qw( readSetup writeSetup ); + +sub readSetup { + my ( $setupfile ) = @_; + + # Sorry about the use of globals but it's hard to share lexicals with dynamically generated source. + $IkiWiki::FakeSetup::package = undef; + @IkiWiki::FakeSetup::args = (); + + sub inc { + my ( $self, $file ) = @_; + + my $package = $file; + $package =~ s/\//::/g; + $package =~ s/\.pm//; + + my @src = + ( "package $package;\n" + , "sub import {\n" + , " my ( \$class, \@args ) = \@_;\n" + , " \$IkiWiki::FakeSetup::package = \$class;\n" + , " \@IkiWiki::FakeSetup::args = \@args;\n" + , "}\n" + , "1;\n" + ); + + return sub { if ( scalar @src ) { $_ = shift @src; return 1; } else { return 0; } }; + + }; + + eval { + my @oldINC = @INC; + @INC = ( ".", \&inc ); + + my %oldINC = %INC; + %INC = ( ); + + do $setupfile; + + @INC = @oldINC; + %INC = %oldINC; + }; + + return ( $IkiWiki::FakeSetup::package, @IkiWiki::FakeSetup::args ); + +} + +sub writeSetup { + my ( $package, @args ) = @_; + + my $d = Data::Dumper->new( \@args ); + $d->Terse( 1 ); + + return "#!/usr/bin/perl\n\nuse $package " . $d->Dump( ) . ";\n"; +} + +1; + +__END__ + +Because it may not be completely obvious, here's how you would use this: + +#!/usr/bin/perl + +use strict; +use warnings; + +use IkiWiki::FakeSetup qw( readSetup writeSetup ); + +# This reads the setup file, returning the package it uses and any configuration it passed to that package. +my ( $package, $config ) = readSetup( "almighty_ikiwiki_template.setup" ); + +# Make changes to the configuration. +$config->{"srcdir"} = "/some/dir"; +$config->{"adminemail"} = "somejerk\@jerkville.com"; + +# Open a new file, and write the changed configuration to it. +open( SETUP, ">", "almighty_ikiwiki_template_changed.setup" ); +print SETUP writeSetup( $package, $config ); +close( SETUP ); diff --git a/libpiny/lib/Piny.pm b/libpiny/lib/Piny.pm new file mode 100644 index 0000000..54a5b00 --- /dev/null +++ b/libpiny/lib/Piny.pm @@ -0,0 +1,16 @@ +# Copyright © 2010 Julian Blake Kongslie <jblake@omgwallhack.org> +# Licensed under the BSD 3-clause license. + +# This very pointedly does not have a package line. +# That way, you can "use Piny" and import all the Piny packages into your namespace in one fell swoop. +# Of course, you don't get to pass arguments to their import functions anymore. + +use Piny::Config; +use Piny::Email; +use Piny::Environment; +use Piny::Group; +use Piny::Repo; +use Piny::User; +use Piny::User::IkiWiki; + +1; diff --git a/libpiny/lib/Piny/Config.pm b/libpiny/lib/Piny/Config.pm new file mode 100644 index 0000000..76405ee --- /dev/null +++ b/libpiny/lib/Piny/Config.pm @@ -0,0 +1,218 @@ +# Copyright © 2010 Julian Blake Kongslie <jblake@omgwallhack.org> +# Licensed under the BSD 3-clause license. + +use strict; +use warnings; + +package Piny::Config; + +use Moose; +use Moose::Util::TypeConstraints; +use MooseX::StrictConstructor; + +use Carp; +use Config::Simple qw( -lc ); + +# Types + +subtype 'GitBool' + => as 'Str' + => where { $_ =~ /^(1|0|true|false)$/i } + => message { 'Not correct format for a git-compatible boolean.' } + ; + +subtype 'Path' + => as 'Str' + => where { $_ =~ /^\// and -e $_ } + => message { 'Not an absolute path, or does not exist.' } + ; + +subtype 'PathDir' + => as 'Path' + => where { -d $_ } + => message { 'Not an absolute path, or not a directory.' } + ; + +subtype 'HttpUrl' + => as 'Str' + => where { $_ =~ /^http:\/\//i } + => message { 'Not a http:// URL.' } + ; + +subtype 'HttpsUrl' + => as 'Str' + => where { $_ =~ /^https:\/\//i } + => message { 'Not a https:// URL.' } + ; + +# Attributes + +has 'confpath' => + ( is => 'ro' + , isa => 'Str' + , predicate => 'has_confpath' + ); + +has '_conf' => + ( is => 'ro' + , isa => 'HashRef[Str]' + , lazy_build => 1 + , clearer => 'clear_conf' + , init_arg => undef + ); + +# Builder methods + +# If constructed with just one argument, then treat it as a config path. +around BUILDARGS => sub { + my ( $orig, $class ) = ( shift, shift ); + + if ( @_ == 1 && ! ref $_[0] ) { + return $class->$orig( confpath => $_[0] ); + } else { + return $class->$orig( @_ ); + }; +}; + +sub _build__conf { + my ( $s ) = @_; + + my $conf; + + if ( $s->has_confpath and -e $s->confpath ) { + $conf = Config::Simple->new( $s->confpath )->vars; + } else { + $conf = { }; + }; + + if ( -e "/etc/piny-default.conf" ) { + + my $default = Config::Simple->new( "/etc/piny-default.conf" )->vars; + + foreach my $key ( keys %$default ) { + if ( not exists $conf->{$key} ) { + $conf->{$key} = $default->{$key}; + }; + }; + + }; + + if ( -e "/etc/piny-override.conf" ) { + + my $override = Config::Simple->new( "/etc/piny-override.conf" )->vars; + + foreach my $key ( keys %$override ) { + $conf->{$key} = $override->{$key}; + }; + + }; + + return $conf; +}; + +# Save the config + +sub save { + my ( $s ) = @_; + + if ( not $s->has_confpath ) { + croak "Can't save a Piny::Config if the confpath is not set!"; + }; + + if ( -e "/etc/piny-override.conf" ) { + + my $override = Config::Simple->new( "/etc/piny-override.conf" )->vars; + + foreach my $key ( keys %$override ) { + if ( exists $s->_conf->{$key} and $s->_conf->{$key} eq $override->{$key} ) { + delete $s->_conf->{$key}; + }; + }; + + }; + + if ( -e "/etc/piny-default.conf" ) { + + my $default = Config::Simple->new( "/etc/piny-default.conf" )->vars; + + foreach my $key ( keys %$default ) { + if ( exists $s->_conf->{$key} and $s->_conf->{$key} eq $default->{$key} ) { + delete $s->_conf->{$key}; + }; + }; + + }; + + my $cs = Config::Simple->new( syntax => "ini" ); + + foreach my $key ( keys %{$s->_conf} ) { + $cs->param( $key, $s->_conf->{$key} ); + }; + + $cs->write( $s->confpath ); +}; + +# Tweakable helper + +sub tweakable { + my ( $attr, $default, $isa ) = @_; + + $attr = lc $attr; + + my $attrname = $attr; + $attrname =~ s/_/./; + + if ( $attrname =~ /_/ ) { croak "Illegal attribute name $attrname! (use only one underbar)"; }; + + has $attr => + ( is => 'rw' + , isa => $isa + , lazy_build => 1 + , trigger => sub { + my ( $s, $new, $old ) = @_; + + $s->_conf->{$attrname} = $new; + + if ( $s->has_confpath ) { + $s->save; + } else { + carp "Attribute $attrname modification ignored!"; + }; + + $s->clear_conf; + my $clearer = "clear_$attr"; + $s->$clearer; + } + ); + + my $builder = sub { + my ( $s ) = @_; + + if ( exists $s->_conf->{$attrname} ) { + return $s->_conf->{$attrname}; + } else { + return $default; + }; + }; + + { + no strict "refs"; + + *{"_build_" . $attr} = $builder; + }; +}; + +# The tweakables + +tweakable "piny_ikiwikidestdir" => "/srv/www/piny.be/", 'PathDir'; +tweakable "piny_ikiwikisrcdir" => "/srv/ikiwiki/", 'PathDir'; +tweakable "piny_ikiwikiurl" => "http://piny.be/", 'HttpUrl'; +tweakable "piny_ikiwikisecureurl" => "https://secure.piny.be/", 'HttpsUrl'; +tweakable "piny_ikiwikisecurepath" => "/srv/www/secure.piny.be/", 'PathDir'; +tweakable "receive_denynonfastforwards" => "true", 'GitBool'; + +# Moose boilerplate + +__PACKAGE__->meta->make_immutable; + +1; diff --git a/libpiny/lib/Piny/Email.pm b/libpiny/lib/Piny/Email.pm new file mode 100644 index 0000000..baa56f0 --- /dev/null +++ b/libpiny/lib/Piny/Email.pm @@ -0,0 +1,49 @@ +# Copyright © 2010 Julian Blake Kongslie <jblake@omgwallhack.org> +# Licensed under the BSD 3-clause license. + +use strict; +use warnings; + +package Piny::Email; + +use Moose; +use Moose::Util::TypeConstraints; +use MooseX::StrictConstructor; + +use Email::Valid::Loose; + +# Types + +my $checker = Email::Valid::Loose->new("-fqdn" => 1, "-fudge" => 0, "-local_rules" => 0, "-mxcheck" => 1, "-tldcheck" => 0 ); + +subtype 'EmailAddress' + => as 'Str' + => where { $checker->address( $_ ) } + => message { 'That does not appear to be a valid email address.' } + ; + +# Attributes + +has 'address' => + ( is => 'ro' + , isa => 'EmailAddress' + ); + +# Builder methods + +# If constructed with just one argument, then treat it as an address. +around BUILDARGS => sub { + my ( $orig, $class ) = ( shift, shift ); + + if ( @_ == 1 && ! ref $_[0] ) { + return $class->$orig( address => $_[0] ); + } else { + return $class->$orig( @_ ); + }; +}; + +# Moose boilerplate + +__PACKAGE__->meta->make_immutable; + +1; diff --git a/libpiny/lib/Piny/Environment.pm b/libpiny/lib/Piny/Environment.pm new file mode 100644 index 0000000..06416b8 --- /dev/null +++ b/libpiny/lib/Piny/Environment.pm @@ -0,0 +1,45 @@ +# Copyright © 2010 Julian Blake Kongslie <jblake@omgwallhack.org> +# Licensed under the BSD 3-clause license. + +use strict; +use warnings; + +package Piny::Environment; + +use MooseX::Singleton; +use MooseX::StrictConstructor; + +use Piny::User; + +# Attributes + +has 'user' => + ( is => 'ro' + , isa => 'Piny::User' + , lazy_build => 1 + , init_arg => undef + ); + +# Builder methods + +sub _build_user { + my ( $s ) = @_; + + if ( defined $ENV{"SUDO_UID"} ) { + return Piny::User->new( uid => $ENV{"SUDO_UID"} ); + } elsif ( defined $ENV{"SUDO_USER"} ) { + return Piny::User->new( name => $ENV{"SUDO_USER"} ); + } elsif ( defined $ENV{"UID"} ) { + return Piny::User->new( uid => $ENV{"UID"} ); + } elsif ( defined $ENV{"USER"} ) { + return Piny::User->new( name => $ENV{"USER"} ); + } else { + return Piny::User->new( uid => $< ); + }; +}; + +# Moose boilerplate + +__PACKAGE__->meta->make_immutable( inline_constructor => 0 ); + +1; diff --git a/libpiny/lib/Piny/Group.pm b/libpiny/lib/Piny/Group.pm new file mode 100644 index 0000000..86a6d95 --- /dev/null +++ b/libpiny/lib/Piny/Group.pm @@ -0,0 +1,136 @@ +# Copyright © 2010 Julian Blake Kongslie <jblake@omgwallhack.org> +# Licensed under the BSD 3-clause license. + +use strict; +use warnings; + +package Piny::Group; + +use Moose; +use MooseX::StrictConstructor; + +use Piny::User; + +# Attributes + +has 'gid' => + ( is => 'ro' + , isa => 'Int' + , lazy_build => 1 + ); + +has 'name' => + ( is => 'ro' + , isa => 'Str' + , lazy_build => 1 + ); + +has 'grent' => + ( is => 'ro' + , isa => 'ArrayRef' + , lazy_build => 1 + , init_arg => undef + ); + +has 'members' => + ( is => 'ro' + , isa => 'ArrayRef[Piny::User]' + , lazy_build => 1 + , init_arg => undef + ); + +# Public methods + +sub add_member { + my ( $s, @users ) = @_; + + foreach my $user ( @users ) { + system( "/usr/sbin/adduser", $user->name( ), $s->name( ) ); + $user->clear_groups( ); + }; + + $s->clear_members( ); +}; + +sub remove_member { + my ( $s, @users ) = @_; + + foreach my $user ( @users ) { + system( "/usr/sbin/deluser", $user->name( ), $s->name( ) ); + $user->clear_groups( ); + }; + + $s->clear_members( ); +}; + +# Builder methods + +# If constructed with just one argument, then +# * If that argument is numeric, treat it as a GID. +# * Otherwise, treat it as a name. +around BUILDARGS => sub { + my ( $orig, $class ) = ( shift, shift ); + + if ( @_ == 1 && ! ref $_[0] ) { + if ( $_[0] =~ m/^\d+$/ ) { + return $class->$orig( gid => $_[0] ); + } else { + return $class->$orig( name => $_[0] ); + }; + } else { + return $class->$orig( @_ ); + }; +}; + +sub BUILD { + my ( $s ) = @_; + + if ( not ( $s->has_gid( ) or $s->has_name( ) ) ) { + die "You must provide either GID or name!"; + }; + + if ( $s->has_gid( ) and $s->has_name( ) ) { + die "You must not provide both GID and name!"; + }; +}; + +sub _build_gid { + my ( $s ) = @_; + + return $s->grent( )->[2]; +}; + +sub _build_name { + my ( $s ) = @_; + + return $s->grent( )->[0]; +}; + +sub _build_grent { + my ( $s ) = @_; + + if ( $s->has_gid( ) ) { + my @res = getgrgid( $s->gid( ) ); + die "getgrgid( " . $s->gid( ) . " ) failed: $!" unless @res; + return \@res; + } elsif ( $s->has_name( ) ) { + my @res = getgrnam( $s->name( ) ); + die "getgrnam( " . $s->name( ) . " ) failed: $!" unless @res; + return \@res; + } else { + die "Not enough information provided to lookup group!"; + }; +}; + +sub _build_members { + my ( $s ) = @_; + + return [ ] if ( $s->grent( )->[3] eq "" ); + return [ map { Piny::User->new( name => $_ ) } split( /:/, $s->grent( )->[3] ) ]; +}; + +# Moose boilerplate + +__PACKAGE__->meta->make_immutable; + +1; diff --git a/libpiny/lib/Piny/Repo.pm b/libpiny/lib/Piny/Repo.pm new file mode 100644 index 0000000..8ebb0f4 --- /dev/null +++ b/libpiny/lib/Piny/Repo.pm @@ -0,0 +1,637 @@ +# Copyright © 2010 Julian Blake Kongslie <jblake@omgwallhack.org> +# Licensed under the BSD 3-clause license. + +use strict; +use warnings; + +package Piny::Repo; + +use Moose; +use Moose::Util::TypeConstraints; +use MooseX::StrictConstructor; + +use File::Find qw( find ); +use File::Temp qw( ); +use IO::Dir qw( ); + +use IkiWiki::FakeSetup qw( readSetup writeSetup ); + +use Piny::Config; +use Piny::Environment; +use Piny::Group; +use Piny::User; +use Piny::User::IkiWiki; + +# Types + +subtype 'Reponame' + => as 'Str' + => where { $_ =~ /^[a-zA-Z0-9][a-zA-Z0-9_.-]*$/ } + => message { 'That name is not in the correct format for a piny repo.' } + ; + +subtype 'SimpleText' + => as 'Str' + => where { $_ =~ /^[\x{0020}-\x{FDCF}\x{FDF0}-\x{FFFD}]{1,80}$/ } + => message { 'That description is not in the correct format for a piny repo.' } + ; + +# Attributes + +has 'name' => + ( is => 'rw' + , isa => 'Reponame' + , trigger => \&_rename_repo + , required => 1 + ); + +has 'group' => + ( is => 'ro' + , isa => 'Piny::Group' + , lazy_build => 1 + , init_arg => undef + ); + +has 'path' => + ( is => 'ro' + , isa => 'Str' + , lazy_build => 1 + , init_arg => undef + ); + +has 'description' => + ( is => 'rw' + , isa => 'SimpleText' + , trigger => \&_set_description + , lazy_build => 1 + , init_arg => undef + ); + +has 'repostat' => + ( is => 'ro' + , isa => 'ArrayRef' + , lazy_build => 1 + , init_arg => undef + ); + +has 'owner' => + ( is => 'rw' + , isa => 'Piny::User' + , trigger => \&_change_owner + , lazy_build => 1 + , init_arg => undef + ); + +has 'globally_readable' => + ( is => 'ro' + , isa => 'Bool' + , lazy_build => 1 + , init_arg => undef + ); + +has 'globally_writable' => + ( is => 'ro' + , isa => 'Bool' + , lazy_build => 1 + , init_arg => undef + ); + +has 'ikiwiki_setup' => + ( is => 'ro' + , isa => 'Str' + , lazy_build => 1 + , init_arg => undef + ); + +has 'ikiwiki_destdir' => + ( is => 'ro' + , isa => 'Str' + , lazy_build => 1 + , init_arg => undef + ); + +has 'ikiwiki_srcdir' => + ( is => 'ro' + , isa => 'Str' + , lazy_build => 1 + , init_arg => undef + ); + +has 'ikiwiki_url' => + ( is => 'ro' + , isa => 'Str' + , lazy_build => 1 + , init_arg => undef + ); + +has 'ikiwiki_cgiurl' => + ( is => 'ro' + , isa => 'Str' + , lazy_build => 1 + , init_arg => undef + ); + +has 'ikiwiki_historyurl' => + ( is => 'ro' + , isa => 'Str' + , lazy_build => 1 + , init_arg => undef + ); + +has 'ikiwiki_diffurl' => + ( is => 'ro' + , isa => 'Str' + , lazy_build => 1 + , init_arg => undef + ); + +has 'ikiwiki_cgipath' => + ( is => 'ro' + , isa => 'Str' + , lazy_build => 1 + , init_arg => undef + ); + +has 'secure_path' => + ( is => 'ro' + , isa => 'Str' + , lazy_build => 1 + , init_arg => undef + ); + +has 'apache_config' => + ( is => 'ro' + , isa => 'Str' + , lazy_build => 1 + , init_arg => undef + ); + +has 'config' => + ( is => 'ro' + , isa => 'Piny::Config' + , lazy_build => 1 + , init_arg => undef + ); + +# Public methods + +sub add_access { + my ( $s, @users ) = @_; + + $s->group->add_member( @users ); +}; + +sub remove_access { + my ( $s, @users ) = @_; + + $s->group->remove_member( @users ); +}; + +sub has_access { + my ( $s, $user ) = @_; + + return $s->owner->uid == $user->uid || $user->has_group( $s->group ); +}; + +sub rebuild { + my ( $s ) = @_; + + my $ikiuser = Piny::User::IkiWiki->new( "name" => "ikiwiki-" . $s->name ); + + foreach( "git-daemon-export-ok", "packed-refs" ) { + open( TOUCH, ">", $s->path . "/" . $_ ) or die "Could not touch $_ for repo: $!"; + close( TOUCH ); + }; + + foreach( "info", "logs" ) { + (-e $s->path . "/" . $_) or mkdir( $s->path . "/" . $_ ) or die "Could not mkdir $_ for repo: $!"; + }; + + chown( 0, 0, $s->path, $s->path . "/config" ) or die "Could not change ownership of git dir!"; + + foreach( "branches", "description", "HEAD", "info", "logs", "objects", "packed-refs", "refs" ) { + system( "/bin/chown", "-R", $s->owner->name . "." . $s->group->name, $s->path . "/" . $_ ) and die "Could not change ownership of $_ for repo: $!"; + }; + + system( "/bin/chown", "-R", $ikiuser->name . "." . $ikiuser->name, $s->path . "/hooks" ) and die "Could not change ownership of git hooks!"; + + open( SETUP, ">", "/etc/ikiwiki/piny/" . $s->name . ".setup" ) or die "Could not open new ikiwiki setup file: $!"; + print SETUP $s->ikiwiki_setup; + close( SETUP ) or die "Could not close new ikiwiki setup file: $!"; + + system( "/bin/chown", "-R", $ikiuser->name . "." . $ikiuser->name, $s->ikiwiki_srcdir, $s->ikiwiki_destdir, $s->secure_path ) and die "Could not change ownership of ikiwiki directories!"; + + open( WIKILIST, ">", "/etc/ikiwiki/wikilist.d/" . $s->name ) or die "Could not create wikilist.d file: $!"; + print WIKILIST $ikiuser->name . " /etc/ikiwiki/piny/" . $s->name . ".setup\n"; + close( WIKILIST ) or die "Could not close wikilist.d file: $!"; + + my $temp = File::Temp->new( ) or die "Could not create temporary file: $!"; + $temp->unlink_on_destroy( 0 ); + + my $dh = IO::Dir->new( "/etc/ikiwiki/wikilist.d" ) or die "Could not open wikilist.d directory: $!"; + while ( defined ( my $entry = $dh->read ) ) { + next if ( $entry =~ /^\./ ); + open( FILE, "<", "/etc/ikiwiki/wikilist.d/" . $entry ) or die "Could not open wikilist.d entry $entry: $!"; + print $temp <FILE>; + close( FILE ) or die "Could not close wikilist.d entry $entry: $!"; + }; + + $temp->close or die "Could not close new wikilist: $!"; + + chmod( 00644, $temp->filename ) or die "Could not fix mode of new wikilist: $!"; + + rename( $temp->filename, "/etc/ikiwiki/wikilist" ) or die "Could not rename over old wikilist: $!"; + + $ENV{"GIT_DIR"} = $s->path; + system( "/usr/bin/git", "config", "gitweb.owner", $s->owner->email->address ) and die "Could not git config gitweb.owner!"; + delete $ENV{"GIT_DIR"}; + + system( "/usr/bin/sudo", "-u", $ikiuser->name, "/usr/bin/ikiwiki", "--setup", "/etc/ikiwiki/piny/" . $s->name . ".setup" ) and die "Could not do initial compile of ikiwiki!"; + + open( APACHE, ">", "/etc/apache2/piny-available/" . $s->name ) or die "Could not open new apache config: $!"; + print APACHE $s->apache_config; + close( APACHE ) or die "Could not close new apache config: $!"; + + unlink( "/etc/apache2/piny-enabled/" . $s->name ); + symlink( "/etc/apache2/piny-available/" . $s->name, "/etc/apache2/piny-enabled/" . $s->name ) or die "Could not symlink apache config: $!"; + + system( "/etc/init.d/apache2", "reload" ) and die "Could not reload apache config!"; +}; + +sub destroy { + my ( $s ) = @_; + + my $user = Piny::Environment->instance->user; + + unlink( "/etc/apache2/piny-enabled/" . $s->name ); + unlink( "/etc/apache2/piny-available/" . $s->name ); + + system( "/etc/init.d/apache2", "reload" ) and die "Could not reload apache config!"; + + unlink( "/etc/ikiwiki/wikilist.d/" . $s->name ); + + my $temp = File::Temp->new( ) or die "Could not create temporary file: $!"; + $temp->unlink_on_destroy( 0 ); + + my $dh = IO::Dir->new( "/etc/ikiwiki/wikilist.d" ) or die "Could not open wikilist.d directory: $!"; + while ( defined ( my $entry = $dh->read ) ) { + next if ( $entry =~ /^\./ ); + open( FILE, "<", "/etc/ikiwiki/wikilist.d/" . $entry ) or die "Could not open wikilist.d entry $entry: $!"; + print $temp <FILE>; + close( FILE ) or die "Could not close wikilist.d entry $entry: $!"; + }; + + $temp->close or die "Could not close new wikilist: $!"; + + chmod( 00644, $temp->filename ) or die "Could not fix mode of new wikilist: $!"; + + rename( $temp->filename, "/etc/ikiwiki/wikilist" ) or die "Could not rename over old wikilist: $!"; + + system( "rm", "-rf", $s->secure_path, $s->ikiwiki_destdir, $s->ikiwiki_srcdir, "/etc/ikiwiki/piny/" . $s->name . ".setup", $s->path ); + + my $ikiuser = Piny::User::IkiWiki->new( "name" => "ikiwiki-" . $s->name ); + + system( "deluser", "--remove-home", $ikiuser->name ); + system( "delgroup", $ikiuser->name ); + system( "delgroup", "git-" . $s->name ); + +}; + +# Triggers + +sub _rename_repo { + my ( $s, $new_name, $old_name ) = @_; + + return unless defined $old_name; + + my $olddir = "/srv/git/$old_name.git"; + my $newdir = "/srv/git/$new_name.git"; + + rename( $olddir, $newdir ) or die "Couldn't rename $olddir to $newdir: $!"; + + warn "XXX Not renaming all the ikiwiki stuff!"; + + $s->clear_path; + $s->clear_ikiwiki_setup; + $s->clear_ikiwiki_destdir; + $s->clear_ikiwiki_srcdir; + $s->clear_ikiwiki_url; + $s->clear_ikiwiki_cgiurl; + $s->clear_ikiwiki_historyurl; + $s->clear_ikiwiki_cgipath; + $s->clear_secure_path; + $s->clear_apache_config; +}; + +sub _set_description { + my ( $s, $new_description, $old_description ) = @_; + + return unless defined $old_description; + + open( my $fd, ">", $s->path . "/description" ) or die "Unable to open " . $s->path . "/description for writing: $!"; + print $fd $new_description; + close( $fd ) or die "Error when closing " . $s->path . "/description: $!"; +}; + +sub _change_owner { + my ( $s, $new_owner, $old_owner ) = @_; + + return unless defined $old_owner; + + find( { wanted => sub { chown( $new_owner->uid, -1, $_ ) or die "Couldn't chown $_: $!"; }, no_chdir => 1 }, $s->path . "/objects" ); + + $s->clear_ikiwiki_setup; +}; + +# Class methods + +sub all_repos { + my ( $class, $dir ) = @_; + + $dir = "/srv/git" unless defined $dir; + + my @ret; + + find( { wanted => sub { if ( /^[^.].*\.git$/ ) { $File::Find::prune = 1; push( @ret, $File::Find::name ); }; } }, $dir ); + + @ret = map { s/^\Q$dir\E\/?//; s/\.git$//; $class->new( name => $_ ); } @ret; + + return @ret; +}; + +sub create { + my ( $class, $name, $description ) = @_; + + my $user = Piny::Environment->instance->user; + + find_type_constraint( "Reponame" )->assert_valid( $name ); + find_type_constraint( "SimpleText" )->assert_valid( $description ); + + my $repo = $class->new( "name" => $name ); + + mkdir( $repo->path ) or die "The repo $name appears to already exist! ($!)"; + + system( "/usr/sbin/adduser", "--quiet", "--system", "--group", "--gecos", $name, "ikiwiki-$name" ) and die "Could not create ikiwiki user!"; + + my $ikiuser = Piny::User::IkiWiki->new( "name" => "ikiwiki-$name" ); + + system( "/usr/sbin/addgroup", "--quiet", "git-$name" ) and die "Could not create repo group!"; + + my $group = Piny::Group->new( "name" => "git-$name" ); + + system( "/usr/sbin/adduser", "--quiet", $user->name, $group->name ) and die "Could not add you to the repo group!"; + system( "/usr/sbin/adduser", "--quiet", $ikiuser->name, $group->name ) and die "Could not add ikiwiki user to the repo group!"; + + $ENV{"GIT_DIR"} = $repo->path; + system( "/usr/bin/git", "init", "--template=/srv/git-template.git", "--quiet", "--shared" ) and die "Could not initialize git repo!"; + + foreach( "git-daemon-export-ok", "packed-refs" ) { + open( TOUCH, ">", $repo->path . "/" . $_ ) or die "Could not touch $_ for repo: $!"; + close( TOUCH ); + }; + + foreach( "info", "logs" ) { + ( -e $repo->path . "/" . $_ ) or mkdir( $repo->path . "/" . $_ ) or die "Could not mkdir $_ for repo: $!"; + }; + + foreach( "branches", "description", "HEAD", "info", "logs", "objects", "packed-refs", "refs" ) { + system( "/bin/chown", "-R", $user->name . "." . $group->name, $repo->path . "/" . $_ ) and die "Could not change ownership of $_ for repo: $!"; + }; + + chown( 0, 0, $repo->path, $repo->path . "/config" ) or die "Could not change ownership of git dir!"; + + system( "/bin/chown", "-R", $ikiuser->name . "." . $ikiuser->name, $repo->path . "/hooks" ) and die "Could not change ownership of git hooks!"; + + system( "/usr/bin/git", "config", "gitweb.owner", $repo->owner->email->address ) and die "Could not git config gitweb.owner!"; + delete $ENV{"GIT_DIR"}; + + $repo->description( $description ); + + open( SETUP, ">", "/etc/ikiwiki/piny/" . $repo->name . ".setup" ) or die "Could not open new ikiwiki setup file: $!"; + print SETUP $repo->ikiwiki_setup; + close( SETUP ) or die "Could not close new ikiwiki setup file: $!"; + + system( "/usr/bin/git", "clone", "--quiet", $repo->path, $repo->ikiwiki_srcdir ) and die "Could not clone repo to ikiwiki srcdir!"; + + mkdir( $repo->ikiwiki_destdir ) or die "Could not create ikiwiki destdir: $!"; + mkdir( $repo->secure_path ) or die "Could not create secure dir: $!"; + + system( "/bin/chown", "-R", $ikiuser->name . "." . $ikiuser->name, $repo->ikiwiki_srcdir, $repo->ikiwiki_destdir, $repo->secure_path ) and die "Could not change ownership of ikiwiki directories!"; + + open( WIKILIST, ">", "/etc/ikiwiki/wikilist.d/" . $repo->name ) or die "Could not create wikilist.d file: $!"; + print WIKILIST $ikiuser->name . " /etc/ikiwiki/piny/" . $repo->name . ".setup\n"; + close( WIKILIST ) or die "Could not close wikilist.d file: $!"; + + my $temp = File::Temp->new( ) or die "Could not create temporary file: $!"; + $temp->unlink_on_destroy( 0 ); + + my $dh = IO::Dir->new( "/etc/ikiwiki/wikilist.d" ) or die "Could not open wikilist.d directory: $!"; + while ( defined ( my $entry = $dh->read ) ) { + next if ( $entry =~ /^\./ ); + open( FILE, "<", "/etc/ikiwiki/wikilist.d/" . $entry ) or die "Could not open wikilist.d entry $entry: $!"; + print $temp <FILE>; + close( FILE ) or die "Could not close wikilist.d entry $entry: $!"; + }; + + $temp->close or die "Could not close new wikilist: $!"; + + chmod( 00644, $temp->filename ) or die "Could not fix mode of new wikilist: $!"; + + rename( $temp->filename, "/etc/ikiwiki/wikilist" ) or die "Could not rename over old wikilist: $!"; + + system( "/usr/bin/sudo", "-u", $ikiuser->name, "/usr/bin/ikiwiki", "--setup", "/etc/ikiwiki/piny/" . $repo->name . ".setup" ) and die "Could not do initial compile of ikiwiki!"; + + open( APACHE, ">", "/etc/apache2/piny-available/" . $repo->name ) or die "Could not open new apache config: $!"; + print APACHE $repo->apache_config; + close( APACHE ) or die "Could not close new apache config: $!"; + + symlink( "/etc/apache2/piny-available/" . $repo->name, "/etc/apache2/piny-enabled/" . $repo->name ) or die "Could not symlink apache config: $!"; + + system( "/etc/init.d/apache2", "reload" ) and die "Could not reload apache config!"; + + return $repo; +}; + +# Builder methods + +# If constructed with just one argument, then treat it as a repo name. +around BUILDARGS => sub { + my ( $orig, $class ) = ( shift, shift ); + + if ( @_ == 1 && ! ref $_[0] ) { + return $class->$orig( name => $_[0] ); + } else { + return $class->$orig( @_ ); + }; +}; + +sub _build_group { + my ( $s ) = @_; + + return Piny::Group->new( name => "git-" . $s->name ); +}; + +sub _build_path { + my ( $s ) = @_; + + return "/srv/git/" . $s->name . ".git"; +}; + +sub _build_description { + my ( $s ) = @_; + + open( my $d, "<", $s->path . "/description" ) or die "Unable to open " . $s->path . "/description: $!"; + my $desc; + { + local $/ = undef; + $desc = <$d>; + }; + close( $d ); + + return $desc; +}; + +sub _build_repostat { + my ( $s ) = @_; + + my @res = stat( $s->path . "/objects" ); + die "stat( " . $s->path . "/objects ) failed: $!" unless @res; + return \@res; +}; + +sub _build_owner { + my ( $s ) = @_; + + my ( $uid ) = $s->repostat->[4]; + + return Piny::User->new( uid => $uid ); +}; + +sub _build_globally_readable { + my ( $s ) = @_; + + return ( $s->repostat->[2] & 0444 ) == 0444; +}; + +sub _build_globally_writable { + my ( $s ) = @_; + + return ( $s->repostat->[2] & 0111 ) == 0111; +}; + +sub _build_ikiwiki_setup { + my ( $s ) = @_; + + my ( $package, $config ) = readSetup( "/usr/share/libpiny/ikiwiki.setup" ); + + $config->{"wikiname"} = $s->name; + $config->{"adminemail"} = $s->owner->email->address; + $config->{"srcdir"} = $s->ikiwiki_srcdir; + $config->{"destdir"} = $s->ikiwiki_destdir; + $config->{"url"} = $s->ikiwiki_url; + $config->{"cgiurl"} = $s->ikiwiki_cgiurl; + $config->{"historyurl"} = $s->ikiwiki_historyurl; + $config->{"diffurl"} = $s->ikiwiki_diffurl; + + $config->{"wrappers"} = + [ { "wrapper" => $s->ikiwiki_cgipath + , "wrappergroup" => $s->group->name + , "wrappermode" => "06755" + , "cgi" => 1 + } + , { "wrapper" => $s->path . "/hooks/post-update" + , "wrappergroup" => $s->group->name + , "wrappermode" => "06755" + , "notify" => 0 + } + ]; + + if ( -e "/etc/ikiwiki/piny/" . $s->name . ".setup.pl" ) { + undef $@; + eval { + package TEMP; + use Piny; + $TEMP::repo = $s; + $TEMP::conf = $config; + no strict 'vars'; + do "/etc/ikiwiki/piny/" . $s->name . ".setup.pl"; + }; + if ( not $@ ) { $config = $TEMP::conf; }; + }; + + return writeSetup( $package, $config ); +}; + +sub _build_ikiwiki_destdir { + my ( $s ) = @_; + + return $s->config->piny_ikiwikidestdir . $s->name; +}; + +sub _build_ikiwiki_srcdir { + my ( $s ) = @_; + + return $s->config->piny_ikiwikisrcdir . $s->name; +}; + +sub _build_ikiwiki_url { + my ( $s ) = @_; + + return $s->config->piny_ikiwikiurl . $s->name; +}; + +sub _build_ikiwiki_cgiurl { + my ( $s ) = @_; + + return $s->config->piny_ikiwikisecureurl . "repos/" . $s->name . "/ikiwiki.cgi"; +}; + +sub _build_secure_path { + my ( $s ) = @_; + + return $s->config->piny_ikiwikisecurepath . "repos/" . $s->name; +}; + +sub _build_ikiwiki_cgipath { + my ( $s ) = @_; + + return $s->secure_path . "/ikiwiki.cgi"; +}; + +sub _build_ikiwiki_historyurl { + my ( $s ) = @_; + + if ( defined $s->config->{"https_url"} ) { + return $s->config->{"https_url"} . "cgit/" . $s->name . "/log/[[file]]"; + } else { + return $s->config->piny_ikiwikisecureurl . "cgit/" . $s->name . "/log/[[file]]"; + }; +}; + +sub _build_ikiwiki_diffurl { + my ( $s ) = @_; + + if ( defined $s->config->{"https_url"} ) { + return $s->config->{"https_url"} . "cgit/" . $s->name . "/diff/?id=[[sha1_commit]]"; + } else { + return $s->config->piny_ikiwikisecureurl . "cgit/" . $s->name . "/diff/?id=[[sha1_commit]]"; + }; +}; + +sub _build_apache_config { + my ( $s ) = @_; + + return "<Directory " . $s->secure_path . ">\n AuthPAM_Enabled on\n AuthGROUP_Enabled on\n AuthPAM_FallThrough off\n AuthBasicAuthoritative off\n AuthType Basic\n AuthName \"User access to " . $s->name . " repository needed.\"\n Require group " . $s->group->name . "\n</Directory>\n"; +}; + +sub _build_config { + my ( $s ) = @_; + + return Piny::Config->new( confpath => $s->path . "/config" ); +}; + +# Moose boilerplate + +__PACKAGE__->meta->make_immutable; + +1; diff --git a/libpiny/lib/Piny/User.pm b/libpiny/lib/Piny/User.pm new file mode 100644 index 0000000..20ef4f1 --- /dev/null +++ b/libpiny/lib/Piny/User.pm @@ -0,0 +1,216 @@ +# Copyright © 2010 Julian Blake Kongslie <jblake@omgwallhack.org> +# Licensed under the BSD 3-clause license. + +use strict; +use warnings; + +package Piny::User; + +use Moose; +use Moose::Util::TypeConstraints; +use MooseX::StrictConstructor; + +use Piny::Email; +use Piny::Group; + +# Types + +subtype 'Username' + => as 'Str' + => where { $_ =~ /^(?!(git|ikiwiki)-)[a-zA-Z][a-zA-Z0-9_.-]*$/ } + => message { 'That username is not in the correct format for a piny user.' } + ; + +# Attributes + +has 'uid' => + ( is => 'ro' + , isa => 'Int' + , lazy_build => 1 + ); + +has 'name' => + ( is => 'ro' + , isa => 'Username' + , lazy_build => 1 + ); + +has 'pwent' => + ( is => 'ro' + , isa => 'ArrayRef' + , lazy_build => 1 + , init_arg => undef + ); + +has 'password_hash' => + ( is => 'ro' + , isa => 'Str' + , lazy_build => 1 + , init_arg => undef + ); + +has 'email' => + ( is => 'ro' + , isa => 'Piny::Email' + , lazy_build => 1 + , init_arg => undef + ); + +has 'groups' => + ( is => 'ro' + , isa => 'ArrayRef[Piny::Group]' + , lazy_build => 1 + , init_arg => undef + ); + +# Public methods + +sub add_group { + my ( $s, @groups ) = @_; + + foreach my $group ( @groups ) { + $group->add_member( $s ); + }; +}; + +sub remove_group { + my ( $s, @groups ) = @_; + + foreach my $group ( @groups ) { + $group->remove_member( $s ); + }; +}; + +sub has_group { + my ( $s, $group ) = @_; + + foreach my $owngroup ( @{$s->groups( )} ) { + return 1 if $owngroup->gid( ) == $group->gid( ); + }; + + return; +}; + +# Class methods + +sub all_users { + my ( $class ) = @_; + + my @ret; + + endpwent( ); + + while ( my @info = getpwent( ) ) { + eval { + my $user = $class->new( uid => $info[2] ); + # Some forced early evaluation, so error checking happens now. + $user->name( ); + $user->email( ); + push( @ret, $user ); + }; + }; + + endpwent( ); + + return @ret; +}; + +# Builder methods + +# If constructed with just one argument, then +# * If that argument is numeric, treat it as a UID. +# * Otherwise, treat it as a username. +around BUILDARGS => sub { + my ( $orig, $class ) = ( shift, shift ); + + if ( @_ == 1 && ! ref $_[0] ) { + if ( $_[0] =~ m/^\d+$/ ) { + return $class->$orig( uid => $_[0] ); + } else { + return $class->$orig( name => $_[0] ); + }; + } else { + return $class->$orig( @_ ); + }; +}; + +sub BUILD { + my ( $s ) = @_; + + if ( not ( $s->has_uid( ) or $s->has_name( ) ) ) { + die "You must provide either UID or name!"; + }; + + if ( $s->has_uid( ) and $s->has_name( ) ) { + die "You must not provide both UID and name!"; + }; +}; + +sub _build_uid { + my ( $s ) = @_; + + return $s->pwent( )->[2]; +}; + +sub _build_name { + my ( $s ) = @_; + + return $s->pwent( )->[0]; +}; + +sub _build_pwent { + my ( $s ) = @_; + + if ( $s->has_uid( ) ) { + my @res = getpwuid( $s->uid( ) ); + die "getpwuid( " . $s->uid( ) . " ) failed: $!" unless @res; + return \@res; + } elsif ( $s->has_name( ) ) { + my @res = getpwnam( $s->name( ) ); + die "getpwnam( " . $s->name( ) . " ) failed: $!" unless @res; + return \@res; + } else { + die "Not enough information provided to lookup user!"; + }; +}; + +sub _build_password_hash { + my ( $s ) = @_; + + return $s->pwent( )->[1]; +}; + +sub _build_email { + my ( $s ) = @_; + + return Piny::Email->new( address => $s->pwent( )->[6] ); +}; + +sub _build_groups { + my ( $s ) = @_; + + my @res; + my @ent; + + endgrent( ); + + while ( @ent = getgrent( ) ) { + next if ( $ent[3] eq "" ); + foreach my $member ( split( / /, $ent[3] ) ) { + if ( $member eq $s->name( ) ) { + push @res, Piny::Group->new( gid => $ent[2] ); + last; + }; + }; + }; + + endgrent( ); + + return \@res; +}; + +# Moose boilerplate + +__PACKAGE__->meta->make_immutable; + +1; diff --git a/libpiny/lib/Piny/User/IkiWiki.pm b/libpiny/lib/Piny/User/IkiWiki.pm new file mode 100644 index 0000000..8585e90 --- /dev/null +++ b/libpiny/lib/Piny/User/IkiWiki.pm @@ -0,0 +1,37 @@ +# Copyright © 2010 Julian Blake Kongslie <jblake@omgwallhack.org> +# Licensed under the BSD 3-clause license. + +use strict; +use warnings; + +package Piny::User::IkiWiki; + +use Moose; +use Moose::Util::TypeConstraints; +use MooseX::StrictConstructor; + +use Piny::User; + +extends "Piny::User"; + +# Types + +subtype 'IkiWikiUsername' + => as 'Str' + => where { $_ =~ /^ikiwiki-[a-zA-Z][a-zA-Z0-9_.-]*$/ } + => message { 'That username is not in the correct format for an ikiwiki user.' } + ; + +# Attributes + +has 'name' => + ( is => 'ro' + , isa => 'IkiWikiUsername' + , lazy_build => 1 + ); + +# Moose boilerplate + +__PACKAGE__->meta->make_immutable; + +1; diff --git a/libpiny/share/ikiwiki.setup b/libpiny/share/ikiwiki.setup new file mode 100644 index 0000000..18f8418 --- /dev/null +++ b/libpiny/share/ikiwiki.setup @@ -0,0 +1,76 @@ +#!/usr/bin/perl +# Configuration file for ikiwiki. +# Passing this to ikiwiki --setup will make ikiwiki generate wrappers and +# build the wiki. +# +# Remember to re-run ikiwiki --setup any time you edit this file. + +use IkiWiki::Setup::Standard { + # wikiname => "', # LATER MODIFIED BY LATER MODIFIED BY PINY + # adminemail => "', # LATER MODIFIED BY LATER MODIFIED BY PINY + # srcdir => "', # LATER MODIFIED BY PINY + # destdir => "', # LATER MODIFIED BY PINY + # url => "', # LATER MODIFIED BY PINY + # cgiurl => "', # LATER MODIFIED BY PINY + # historyurl => "', # LATER MODIFIED BY PINY + # diffurl => "', # LATER MODIFIED BY PINY + + templatedir => "/srv/templates", # TODO: user-customizable templates + underlaydir => "/usr/share/ikiwiki/basewiki", + + rcs => "git", + gitorigin_branch => "origin", + gitmaster_branch => "master", + + # wrappers => [ ], controlled by piny + + # Generate rss feeds for blogs? + rss => 1, + # Generate atom feeds for blogs? + atom => 0, + # Include discussion links on all pages? + discussion => 0, + # To exclude files matching a regexp from processing. This adds to + # the default exclude list. + #exclude => qr/*\.wav/, + # To change the extension used for generated html files. + #htmlext => "htm", + # Time format (for strftime) + #timeformat => "%c", + # Locale to use. Must be a UTF-8 locale. + #locale => "en_US.UTF-8", + # Only send cookies over SSL connections. + sslcookie => 1, + # Logging settings: + verbose => 0, + syslog => 1, + # To link to user pages in a subdirectory of the wiki. + #userdir => "users", + # To create output files named page.html rather than page/index.html. + usedirs => 1, + # Simple spam prevention: require an account-creation password. + #account_creation_password => "example", + # Use new "!"-prefixed preprocessor directive syntax + prefix_directives => 1, + httpauth => 1, + # To add plugins, list them here. + add_plugins => [qw{sidebar toc meta table tag graphviz httpauth img attachment rename remove map teximg version edittemplate}], + disable_plugins => [qw{openid passwordauth}], + teximg_prefix => "\\documentclass{scrartcl} +\\usepackage[version=3]{mhchem} +\\usepackage{amsmath} +\\usepackage{amsfonts} +\\usepackage{amssymb} +\\pagestyle{empty} +\\begin{document}", + + teximg_dvipng => 1, + + # For use with the tag plugin, make all tags be located under a + # base page. + tagbase => "tag", + + # For use with the search plugin if your estseek.cgi is located + # somewhere else. + #estseek => "/usr/lib/estraier/estseek.cgi", +}; diff --git a/libpiny/test b/libpiny/test new file mode 100755 index 0000000..fc1eb55 --- /dev/null +++ b/libpiny/test @@ -0,0 +1,12 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Devel::REPL; + +use lib "lib"; + +use Piny; + +Devel::REPL->new->run; |