mirroring/cloned.pl

   1 #!/usr/bin/perl
   2 #
   3 # cloned - Clone repositories on request
   4 #
   5 # cloned 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, ACKs on the socket and reports further progress
  10 # to .clonelog within the repository. In case the clone fails,
  11 # .clone_failed is touched.
  12
  13 # 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 back 0 if ok, error code otherwise
  18 # Bob closes connection
  19 # Alice polls .clonelog in case of 0.
  20 # If Alice reads "@OVER@" from .clonelog, it stops polling.
  21
  22 # Based on perlipc example.
  23
  24 use strict;
  25 use warnings;
  26
  27 use Girocco::Config;
  28 use Socket;
  29
  30 $| = 1;
  31
  32 sub logmsg { print '['.(scalar localtime)."] $0 $$: @_\n" }
  33
  34 my $NAME = '/tmp/girocco.cloned';
  35 my $uaddr = sockaddr_un($NAME);
  36
  37 socket(Server, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
  38 unlink($NAME);
  39 bind(Server, $uaddr) or die "bind: $!";
  40 listen(Server, SOMAXCONN) or die "listen: $!";
  41 chmod 0664, $NAME or die "chmod: $!";
  42 my $gid = scalar(getgrnam($Girocco::Config::owning_group));
  43 chown(-1, $gid, $NAME) or die "chgrp $gid: $!";
  44
  45
  46 use POSIX ":sys_wait_h";
  47 sub REAPER {
  48         my $child;
  49         my $waitedpid;
  50         while (($waitedpid = waitpid(-1, WNOHANG)) > 0) {
  51                 logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
  52         }
  53         $SIG{CHLD} = \&REAPER;  # loathe sysV
  54 }
  55
  56 $SIG{CHLD} = \&REAPER;  # Apollo 440
  57
  58 sub spawn {
  59         my $coderef = shift;
  60
  61         my $pid = fork;
  62         if (not defined $pid) {
  63                 logmsg "cannot fork: $!";
  64                 return;
  65         } elsif ($pid) {
  66                 logmsg "begat $pid";
  67                 return; # I'm the parent
  68         }
  69
  70         open STDIN, "<&Client" or die "can't dup client to stdin";
  71         open STDOUT, ">&Client" or die "can't dup client to stdout";
  72         exit &$coderef();
  73 }
  74
  75
  76 while (1) {
  77         unless (accept(Client, Server)) {
  78                 logmsg "accept failed: $!";
  79                 next;
  80         }
  81         logmsg "connection on $NAME";
  82         spawn sub {
  83                 my $name = <>;
  84                 print STDERR "read\n";
  85                 chomp $name;
  86                 print STDERR "print\n";
  87                 print "1\n";
  88                 print STDERR "cloning $name\n";
  89                 open STDOUT, ">".$Girocco::Config::reporoot."/".$name."/.clonelog" or die "cannot open clonelog: $!";
  90                 open STDERR, ">&STDOUT";
  91                 open STDIN, "</dev/null";
  92                 exec $Girocco::Config::basedir.'/mirroring/clone.sh', $name or die "exec failed: $!";
  93         };
  94         close Client;
  95         sleep 1;
  96 }