path: root/libpiny/lib/Piny/Repo.pm

# 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 Digest::SHA qw( sha256_hex );
use File::Find qw( find );
use File::Temp qw( );
use IO::Dir qw( );
use Math::GMP 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        => 'ro'
  , isa       => 'Reponame'
  , required  => 1
  );

has 'shortname' =>
  ( is          => 'ro'
  , isa         => 'Str'
  , lazy_build  => 1
  , init_arg    => undef
  );

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 'cgit_url' =>
  ( is          => 'ro'
  , isa         => 'Str'
  , 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 ) = @_;

  $s->rebuild_git;
  $s->rebuild_ikiwiki;
};

sub rebuild_git {
  my ( $s ) = @_;

  unless( getgrnam("git-" . $s->shortname ) ) {
    system( "/usr/sbin/addgroup", "--quiet", "git-" . $s->shortname ) and die "Could not create repo group!";
    system( "/usr/sbin/adduser", "--quiet", $s->owner->name, "git-" . $s->shortname ) and die "Could not add you to the repo group!";
    system( "/usr/sbin/adduser", "--quiet", "iki-" . $s->shortname, "git-" . $s->shortname ) and print "...But that's okay.\n";
  };

  foreach( "git-daemon-export-ok", "packed-refs" ) {
    unless( -e $s->path . "/" . $_ ) {
      open( TOUCH, ">", $s->path . "/" . $_ ) or die "Could not touch $_ for repo: $!";
      close( TOUCH );
    };
  };

  chown( 0, 0, $s->path, $s->path . "/config" ) or die "Could not change ownership of git config!";

  foreach( "info", "logs", "branches" ) {
    (-e $s->path . "/" . $_) or mkdir( $s->path . "/" . $_ ) or die "Could not mkdir $_ for repo: $!";
  };

  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: $!";
  };

  $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"};

};

sub rebuild_ikiwiki {
  my ( $s ) = @_;

  unless( getpwnam("iki-" . $s->shortname ) ) {
    system( "/usr/sbin/adduser", "--quiet", "--system", "--group", "--gecos", $s->shortname, "iki-" . $s->shortname ) and die "Could not create ikiwiki user!";
    system( "/usr/sbin/adduser", "--quiet", "iki-" . $s->shortname, "git-" . $s->shortname ) and die "Could not add ikiwiki user to the repo group!";
  };

  my $ikiuser = Piny::User::IkiWiki->new( "name" => "iki-" . $s->shortname );

  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: $!";

  unless( -d $s->ikiwiki_srcdir ) {
    system( "/usr/bin/git", "clone", "--quiet", $s->path, $s->ikiwiki_srcdir ) and die "Could not clone repo to ikiwiki srcdir!"; 
  };

  system( "/usr/bin/find " . $s->ikiwiki_srcdir . " -type d -name .ikiwiki -print0 | xargs -0 --no-run-if-empty rm -r") and die "Could not remove old Ikiwiki state dir!";

  foreach( $s->ikiwiki_srcdir, $s->ikiwiki_destdir, $s->secure_path ) {
    unless( -d $_ ) { mkdir( $_ ) };
    system( "/bin/chown", "-R", $ikiuser->name . ".", $_ ) 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: $!";

  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" => "iki-" . $s->name );

  system( "deluser", "--remove-home", "iki-" . $s->shortname );
  system( "delgroup", "iki-" . $s->shortname );
  system( "delgroup", $s->group->name );

};

# Triggers

sub _set_description {
  my ( $s, $new_description, $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 ) = @_;

  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;
};

# Only sets up needed data; ->rebuild takes care of the rest.
sub create {
  my ( $class, $name, $description, $source ) = @_;

  if ( not defined $source) {
    $source = Piny::Environment->config->piny_template;
  };

  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! ($!)";

  $ENV{"GIT_DIR"} = $repo->path;
    system( "/usr/bin/git", "init", "--bare", "--quiet", "--shared" ) and die "Could not initialize git repo!";
  delete $ENV{"GIT_DIR"};

  system( "/bin/chown", "-R", $user->name, $repo->path . "/objects" ) and die "Could not change ownership of $_ for repo: $!";

  if ( defined $source ) {
    $ENV{"GIT_DIR"} = $source;
      system( "/usr/bin/git", "push", "--mirror", $repo->path ) and die "Could not push refs to new repository!";
    delete $ENV{"GIT_DIR"};
  };

  $repo->description( $description );

  $repo->rebuild;

  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( @_ );
  };
};

my @letter1 =             ( 'a' .. 'z' );           # First digit is base 26.
my @lettern = ( '0' .. '9', 'a' .. 'z', '-', '_' ); # Remaining digits are base 38.

sub _build_shortname {
  my ( $s ) = @_;

  my $str = $s->name;

  # Short inputs don't need to be hashed.
  return $str if length $str <= 28;

  # We have to use Math::GMP here instead of Math::BigInt or pragma bignum
  # support because we actually require infinite precision integer arithmetic,
  # and bignum tends to only give us 40 decimal digits of precision during
  # division because the Perl maintainers are jackasses.
  my $n = Math::GMP->new( "0x" . sha256_hex( $str ) );

  my ( $m );

  # First digit.
  ( $n, $m ) = $n->bdiv( scalar @letter1 );
  my $out = $letter1[$m];

  # Remaining digits.
  while ( length $out < 28 and $n > 0 ) {
    ( $n, $m ) = $n->bdiv( scalar @lettern );
    $out .= $lettern[$m];
  };

  return $out;
};

sub _build_group {
  my ( $s ) = @_;

  return Piny::Group->new( name => "git-" . $s->shortname );
};

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_cgit_url {
  my ( $s ) = @_;

  return $s->config->piny_ikiwikisecureurl . "cgit/" . $s->name;
}

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" ) {
    system( "perl", "-C", "/etc/ikiwiki/piny/" . $s->name . ".setup.pl" ) && die ( 'Failed to compile ikiwiki overrides file!' );
    undef $@;
    eval {
      package TEMP;
      use Piny;
      $TEMP::repo = $s;
      $TEMP::conf = $config;
      no strict 'vars';
      do "/etc/ikiwiki/piny/" . $s->name . ".setup.pl";
    };
  };

  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;