taskd/taskd.pl: Never ACK; we will write to the socket only on errors
[girocco/susan.git] / taskd / taskd.pl
blob8230348d77b7561b5d025cd294a231bf86cb67f8
1 #!/usr/bin/perl
3 # taskd - Clone repositories on request
5 # taskd is Girocco mirroring servant; it processes requests for clones
6 # of given URLs received over its socket.
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.
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.
22 # Based on perlipc example.
24 use strict;
25 use warnings;
27 use Girocco::Config;
28 use Girocco::Project;
29 use Socket;
31 $| = 1;
33 sub logmsg { print '['.(scalar localtime)."] $0 $$: @_\n" }
35 my $NAME = $Girocco::Config::chroot.'/etc/taskd.socket';
36 my $uaddr = sockaddr_un($NAME);
38 socket(Server, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
39 unlink($NAME);
40 bind(Server, $uaddr) or die "bind: $!";
41 listen(Server, SOMAXCONN) or die "listen: $!";
42 if ($Girocco::Config::owning_group) {
43 chmod 0664, $NAME or die "chmod: $!";
44 my $gid = scalar(getgrnam($Girocco::Config::owning_group));
45 chown(-1, $gid, $NAME) or die "chgrp $gid: $!";
46 } else {
47 chmod 0666, $NAME or die "chmod: $!";
51 use POSIX ":sys_wait_h";
52 sub REAPER {
53 my $child;
54 my $waitedpid;
55 while (($waitedpid = waitpid(-1, WNOHANG)) > 0) {
56 logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
58 $SIG{CHLD} = \&REAPER; # loathe sysV
61 $SIG{CHLD} = \&REAPER; # Apollo 440
63 sub spawn {
64 my $coderef = shift;
66 my $pid = fork;
67 if (not defined $pid) {
68 logmsg "cannot fork: $!";
69 return;
70 } elsif ($pid) {
71 logmsg "begat $pid";
72 return; # I'm the parent
75 open STDIN, "<&Client" or die "can't dup client to stdin";
76 open STDOUT, ">&Client" or die "can't dup client to stdout";
77 exit &$coderef();
80 sub clone {
81 my ($name) = @_;
82 Girocco::Project::does_exist($name) or die "won't clone non-existing project $name";
83 print STDERR "cloning $name\n";
84 open STDOUT, ">".$Girocco::Config::reporoot."/".$name.".git/.clonelog" or die "cannot open clonelog: $!";
85 open STDERR, ">&STDOUT";
86 open STDIN, "</dev/null";
87 exec $Girocco::Config::basedir.'/taskd/clone.sh', "$name.git" or die "exec failed: $!";
90 while (1) {
91 unless (accept(Client, Server)) {
92 logmsg "accept failed: $!";
93 next;
95 logmsg "connection on $NAME";
96 spawn sub {
97 my $inp = <>;
98 chomp $inp;
99 my ($cmd, $arg) = $inp =~ /^([a-zA-Z0-9-]+)\s+(.*)$/;
100 if ($cmd eq 'clone') {
101 clone($arg);
102 } else {
103 die "unknown command: $cmd";
106 close Client;
107 sleep 1;