taskd/taskd.pl

   1 #!/usr/bin/perl
   2 #
   3 # taskd - Clone repositories on request
   4 #
   5 # taskd is Girocco mirroring servant; it processes requests for clones
   6 # of given URLs received over its socket.
   7 #
   8 # When a request is received, new process is spawned that sets up
   9 # the repository and reports further progress
  10 # to .clonelog within the repository. In case the clone fails,
  11 # .clone_failed is touched and .clone_in_progress is removed.
  12
  13 # Clone protocol:
  14 # Alice sets up repository and touches .cloning
  15 # Alice opens connection to Bob
  16 # Alice sends project name through the connection
  17 # Bob opens the repository and sends error code if there is a problem
  18 # Bob closes connection
  19 # Alice polls .clonelog in case of success.
  20 # If Alice reads "@OVER@" from .clonelog, it stops polling.
  21
  22 # Ref-change protocol:
  23 # Alice opens connection to Bob
  24 # Alice sends ref-change command for each changed ref
  25 # Alice closes connection
  26 # Bob sends out notifications
  27
  28 # Based on perlipc example.
  29
  30 use strict;
  31 use warnings;
  32
  33 use Socket;
  34 use Errno;
  35 use POSIX ":sys_wait_h";
  36 use File::Basename;
  37
  38 use lib dirname($0);
  39 use Girocco::Config;
  40 use Girocco::Notify;
  41 use Girocco::Project;
  42 use Girocco::User;
  43
  44 $| = 1;
  45
  46 my $progname = basename($0);
  47
  48 sub logmsg { print '['.(scalar localtime)."] $progname $$: @_\n" }
  49
  50 my $NAME = $Girocco::Config::chroot.'/etc/taskd.socket';
  51 my $uaddr = sockaddr_un($NAME);
  52
  53 socket(Server, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
  54 unlink($NAME);
  55 bind(Server, $uaddr) or die "bind: $!";
  56 listen(Server, SOMAXCONN) or die "listen: $!";
  57 chmod 0666, $NAME or die "chmod: $!";
  58
  59 sub REAPER {
  60         local $!;
  61         my $child;
  62         my $waitedpid;
  63         while (($waitedpid = waitpid(-1, WNOHANG)) > 0) {
  64                 logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
  65         }
  66         $SIG{CHLD} = \&REAPER;  # loathe sysV
  67 }
  68
  69 $SIG{CHLD} = \&REAPER;  # Apollo 440
  70
  71 sub spawn {
  72         my $coderef = shift;
  73
  74         my $pid = fork;
  75         if (not defined $pid) {
  76                 logmsg "cannot fork: $!";
  77                 return;
  78         } elsif ($pid) {
  79                 logmsg "begat $pid";
  80                 return; # I'm the parent
  81         }
  82
  83         $SIG{CHLD} = 'DEFAULT';
  84
  85         open STDIN, "<&Client" or die "can't dup client to stdin";
  86         open STDOUT, ">&Client" or die "can't dup client to stdout";
  87         exit &$coderef();
  88 }
  89
  90 sub clone {
  91         my ($name) = @_;
  92         my $proj = Girocco::Project->load($name);
  93         $proj or die "failed to load project $name";
  94         $proj->{clone_in_progress} or die "project $name is not marked for cloning";
  95         $proj->{clone_logged} and die "project $name is already being cloned";
  96         print STDERR "cloning $name\n";
  97         open STDOUT, '>', "$Girocco::Config::reporoot/$name.git/.clonelog" or die "cannot open clonelog: $!";
  98         open STDERR, ">&STDOUT";
  99         open STDIN, '<', '/dev/null';
 100         exec "$Girocco::Config::basedir/taskd/clone.sh", "$name.git" or die "exec failed: $!";
 101 }
 102
 103 sub ref_change {
 104         my ($arg) = @_;
 105         my ($username, $name, $oldrev, $newrev, $ref) = split(/\s+/, $arg);
 106
 107         my $proj = Girocco::Project->load($name);
 108         $proj or die "failed to load project $name";
 109
 110         my $user;
 111         if ($username && $username !~ /^%.*%$/) {
 112                 $user = Girocco::User->load($username);
 113                 $user or die "failed to load user $username";
 114         }
 115
 116         print STDERR "ref-change $username $name ($ref: $oldrev -> $newrev)\n";
 117         open STDIN, '<', '/dev/null';
 118         Girocco::Notify::ref_change($proj, $user, $ref, $oldrev, $newrev);
 119         return 0;
 120 }
 121
 122 while (1) {
 123         unless (accept(Client, Server)) {
 124                 logmsg "accept failed: $!" unless $!{EINTR};
 125                 next;
 126         }
 127         logmsg "connection on $NAME";
 128         spawn sub {
 129                 my $inp = <>;
 130                 chomp $inp;
 131                 $inp or exit 0; # ignore empty connects
 132                 my ($cmd, $arg) = $inp =~ /^([a-zA-Z0-9-]+)\s+(.*)$/;
 133                 if ($cmd eq 'clone') {
 134                         clone($arg);
 135                 } elsif ($cmd eq 'ref-change') {
 136                         ref_change($arg);
 137                 } else {
 138                         die "unknown command: $cmd";
 139                 }
 140         };
 141         close Client;
 142         sleep 1;
 143 }