git-cache-proxy: more wip

diff --git a/scripts/git-cache-proxy b/scripts/git-cache-proxy
old mode 100644 (file)
new mode 100755 (executable)
index cd4b087..b3cf412
--- a/scripts/git-cache-proxy
+++ b/scripts/git-cache-proxy
@@ -1,11 +1,11 @@
-#!/usr/bin/perl
+#!/usr/bin/perl -w

 #
 # git caching proxy
 #
 # usage: run it on some port, and then clone or fetch
 #
 # git caching proxy
 #
 # usage: run it on some port, and then clone or fetch

-#  git://<realhost>:<realport>/OPTIONS<real-git-url>
+#  "git://<realhost>:<realport>/<real-git-url>[ <options>]"

 # where <real-git-url> is http://<host>/... or git://<host>/...
 # where <real-git-url> is http://<host>/... or git://<host>/...

-# and OPTIONS is zero or more of
+# and <options> is zero or more (whitespace-separated) of

 #    [<some-option>]      will be ignored if not recognised
 #    {<some-option>}      error if not recognised
 # options currently known:
 #    [<some-option>]      will be ignored if not recognised
 #    {<some-option>}      error if not recognised
 # options currently known:


@@ -20,61 +20,79 @@ use warnings;
 use POSIX;
 use Socket;
 use Sys::Syslog;
 use POSIX;
 use Socket;
 use Sys::Syslog;

+use Fcntl qw(:flock SEEK_SET);

 
 our $us = 'git-cache-proxy';
 our $log; # filehandle (ref), or "1" meaning syslog
 
 our $us = 'git-cache-proxy';
 our $log; # filehandle (ref), or "1" meaning syslog

-our $fetchtimeout = 1800;
-our $maxfetchtimeout = 3600;

 
 

-sub ntoa {
-    my $sockaddr = shift;
-    return ('(local)') unless defined $sockaddr;
-    my ($port,$addr) = sockaddr_in $sockaddr;
-    $addr = inet_ntoa $addr;
-    return ("[$addr]:$port",$addr,$port);
-}
+BEGIN {
+    open STDERR, ">/dev/null" or exit 255;
+    open TEMPERR, "+>", undef or exit 255;
+    open STDERR, ">&TEMPERR" or exit 255;
+
+    sub ntoa {
+       my $sockaddr = shift;
+       return ('(local)') unless defined $sockaddr;
+       my ($port,$addr) = sockaddr_in $sockaddr;
+       $addr = inet_ntoa $addr;
+       return ("[$addr]:$port",$addr,$port);
+    }

 
 

-our ($client,$client_addr,$client_port) = ntoa getpeername STDIN;
-our ($server,$server_addr,$server_port) = ntoa getsockname STDIN;
+    our ($client,$client_addr,$client_port) = ntoa getpeername STDIN;
+    our ($server,$server_addr,$server_port) = ntoa getsockname STDIN;

 
 

-sub ensurelog () {
-    return if $log;
-    openlog $us, qw(pid), 'daemon';
-    $log = 1;
-}
+    sub ensurelog () {
+       return if $log;
+       openlog $us, qw(pid), 'daemon';
+       $log = 1;
+    }

 
 

-sub log ($) {
-    my ($pri, $msg) = @_;
-    ensurelog();
-    my $mainmsg = sprintf "%s-%s: %s", $server, $client, $msg;
-    if (ref $log) {
-       my $wholemsg = sprintf("%s [%d] %s: %s\n",
-                              strftime("%Y-%m-%d %H:%M:%S Z", gmtime),
-                              $$,
-                              $pri,
-                              $mainmsg);
-       print $log $wholemsg;
-    } else {
-       syslog $pri, $mainmsg;
+    sub logm ($$) {
+       my ($pri, $msg) = @_;
+       ensurelog();
+       my $mainmsg = sprintf "%s-%s: %s", $server, $client, $msg;
+       if (ref $log) {
+           my $wholemsg = sprintf("%s [%d] %s: %s\n",
+                                  strftime("%Y-%m-%d %H:%M:%S Z", gmtime),
+                                  $$,
+                                  $pri,
+                                  $mainmsg);
+           print $log $wholemsg;
+       } else {
+           syslog $pri, $mainmsg;
+       }
+    }
+
+    END {
+       if ($?) { logm 'crit', "crashing ($?)"; }
+       seek TEMPERR, 0, SEEK_SET;
+       while (<TEMPERR>) {
+           chomp;
+           logm 'crit', $_;
+       }
+       exit $?;

     }
 }
 
     }
 }
 

+our $fetchtimeout = 1800;
+our $maxfetchtimeout = 3600;
+

 sub fail ($) {
     my ($msg) = @_;
 sub fail ($) {
     my ($msg) = @_;

-    log 'error', $msg;
-    exit 1;
+    logm 'err', $msg;
+    exit 0;

 }
 
 sub gitfail ($) {
     my ($msg) = @_;
     close LOCK;
     alarm 60;
 }
 
 sub gitfail ($) {
     my ($msg) = @_;
     close LOCK;
     alarm 60;

-    log 'notice', $msg;
+    logm 'notice', $msg;

     my $gitmsg = "ERR $us: $msg";
     $gitmsg = substr($gitmsg,0,65535); # just in case
     printf "%04x%s", length($gitmsg)+4, $gitmsg;
     flush STDOUT;
     my $gitmsg = "ERR $us: $msg";
     $gitmsg = substr($gitmsg,0,65535); # just in case
     printf "%04x%s", length($gitmsg)+4, $gitmsg;
     flush STDOUT;

-    exit 1;
+    exit 0;

 }
 
 our $cachedir = '/var/cache/git-cache-proxy';
 }
 
 our $cachedir = '/var/cache/git-cache-proxy';


@@ -123,9 +141,9 @@ my $hex_len = xread 4;
 fail "Bad hex in packet length" unless $hex_len =~ m|^[0-9a-fA-F]{4}$|;
 my $line = xread -4 + hex $hex_len;
 unless (($service,$specpath,$spechost) = $line =~
 fail "Bad hex in packet length" unless $hex_len =~ m|^[0-9a-fA-F]{4}$|;
 my $line = xread -4 + hex $hex_len;
 unless (($service,$specpath,$spechost) = $line =~

-        m|^(git-[a-z-]+) /*([!-~]+)\0host=([!-~]+)\0$|) {
+        m|^(git-[a-z-]+) /*([!-~ ]+)\0host=([!-~]+)\0$|) {

     $line =~ s|[^ -~]+| |g;
     $line =~ s|[^ -~]+| |g;

-    fail "Could not parse \"$line\""
+    gitfail "unknown/unsupported instruction `$line'"

 }
 
 alarm 0;
 }
 
 alarm 0;


@@ -136,8 +154,8 @@ $service eq 'git-upload-pack'
 my $fetch = 2; # 0:don't; 1:try; 2:force
 my $url = $specpath;
 
 my $fetch = 2; # 0:don't; 1:try; 2:force
 my $url = $specpath;
 

-while ($url =~ s#^(\[)([^][{}])+\]## ||
-       $url =~ s#^(\{)([^][{}])+\}##) {
+while ($url =~ s#\s+(\[)([^][{}]+)\]$## ||
+       $url =~ s#\s+(\{)([^][{}]+)\}$##) {

     $_ = $2;
     my $must = $1 eq '{';
     if (m/^fetch=try$/) {
     $_ = $2;
     my $must = $1 eq '{';
     if (m/^fetch=try$/) {


@@ -161,7 +179,7 @@ $subdir =~ s|\\|\\\\|g;
 $subdir =~ s|,|\\,|g;
 $subdir =~ s|/|,|g;
 
 $subdir =~ s|,|\\,|g;
 $subdir =~ s|/|,|g;
 

-log 'info', "$specpath locking";
+logm 'info', "$specpath locking";

 
 my $tmpd= "$subdir\\.tmp";
 my $gitd= "$subdir\\.git";
 
 my $tmpd= "$subdir\\.tmp";
 my $gitd= "$subdir\\.git";


@@ -172,7 +190,7 @@ for (;;) {
     flock LOCK, LOCK_EX or fail "lock exclusive $lock: $!";
 
     my $exists = stat $gitd;
     flock LOCK, LOCK_EX or fail "lock exclusive $lock: $!";
 
     my $exists = stat $gitd;

-    $exists or $!==ENOENT or FAIL "stat $gitd: $!";
+    $exists or $!==ENOENT or fail "stat $gitd: $!";

 
     our $fetchfail = '';
 
 
     our $fetchfail = '';
 


@@ -182,12 +200,13 @@ for (;;) {
 
        if (!$exists) {
            system qw(rm -rf --), $tmpd;
 
        if (!$exists) {
            system qw(rm -rf --), $tmpd;

-           @cmd = qw(git clone -q --mirror), $url;
-           log 'info', "$specpath cloning";
+           @cmd = (qw(git clone -q --mirror), $url, $tmpd);
+           logm 'info', "$specpath cloning @cmd";

        } else {
        } else {

-           @cmd = qw(git remote update --prune), $url;
-           log 'info', "$specpath fetching";
+           @cmd = (qw(git remote update --prune));
+           logm 'info', "$specpath fetching @cmd";

        }
        }

+       my $cmd = "@cmd[0..1]";

 
        my $child = open FETCHERR, "-|";
        defined $child or fail "fork: $!";
 
        my $child = open FETCHERR, "-|";
        defined $child or fail "fork: $!";


@@ -200,11 +219,15 @@ for (;;) {
            exec @cmd or fail "exec $cmd[0]: $!";
        }
 
            exec @cmd or fail "exec $cmd[0]: $!";
        }
 

+       my $fetcherr = '';

        my $timedout = 0;
        {
        my $timedout = 0;
        {

-           local $SIG{ALARM} = sub { $timedout=1; kill 9, -$child; };
+           local $SIG{ALRM} = sub {
+               logm 'info', "$specpath fetch/clone timeout";
+               $timedout=1; kill 9, -$child;
+           };
+logm 'info', "timeout=$fetchtimeout";

            alarm($fetchtimeout);
            alarm($fetchtimeout);

-           my $fetcherr = '';

            $!=0; { local $/=undef; $fetcherr = <FETCHERR>; }
            !FETCHERR->error or fail "read pipe from fetch/clone: $!";
            alarm(10);
            $!=0; { local $/=undef; $fetcherr = <FETCHERR>; }
            !FETCHERR->error or fail "read pipe from fetch/clone: $!";
            alarm(10);


@@ -214,18 +237,19 @@ for (;;) {
        $!=0; $?=0; if (!close FETCHERR) {
            fail "reap fetch/clone: $!" if $!;
            my $fetchfail =
        $!=0; $?=0; if (!close FETCHERR) {
            fail "reap fetch/clone: $!" if $!;
            my $fetchfail =

-               !($? & 255) ? "$cmd[0] died with error exit code ".($? >> 8) :
-               $? != 9 ? "$cmd[0] died due to fatal signa, status $?" :
-               $timedout ? "$cmd[0] timed out (${fetchtimeout}s)" :
-               "$cmd[0] died due to unexpected SIGKILL";
+               !($? & 255) ? "$cmd died with error exit code ".($? >> 8) :
+               $? != 9 ? "$cmd died due to fatal signa, status $?" :
+               $timedout ? "$cmd timed out (${fetchtimeout}s)" :
+               "$cmd died due to unexpected SIGKILL";

            if (length $fetcherr) {
                $fetchfail .= "\n$fetcherr";
            if (length $fetcherr) {
                $fetchfail .= "\n$fetcherr";

+               $fetchfail =~ s/\n$//;

                $fetchfail =~ s{\n}{ // }g;
            }
            if ($fetch >= 2) {
                gitfail $fetchfail;
            } else {
                $fetchfail =~ s{\n}{ // }g;
            }
            if ($fetch >= 2) {
                gitfail $fetchfail;
            } else {

-               log 'info', "$specpatch fetch failed: $fetchfail";
+               logm 'info', "$specpath fetch/clone failed: $fetchfail";

            }
        }
 
            }
        }
 


@@ -241,8 +265,9 @@ for (;;) {
        gitfail "no cached data, and not cloned: $fetchfail";
     }
 
        gitfail "no cached data, and not cloned: $fetchfail";
     }
 

-    flock LOCK, LOCK_UN for fail "unlock $lock: $!";
-    flock LOCK, LOCK_SH for fail "lock shared $lock: $!";
+    logm 'info', "$specpath sharing";
+    flock LOCK, LOCK_UN or fail "unlock $lock: $!";
+    flock LOCK, LOCK_SH or fail "lock shared $lock: $!";

     # actually, just relocking as shared would have the same semantics
     # but it's best to be explicit
 
     # actually, just relocking as shared would have the same semantics
     # but it's best to be explicit
 


@@ -255,5 +280,6 @@ for (;;) {
     # and garbage collected it.  How annoying.
 }
 
     # and garbage collected it.  How annoying.
 }
 

+logm 'info', "$specpath servicing";

 exec qw(git-upload-pack --strict --timeout=1000 .)
     or fail "exec git-upload-pack: $!";
 exec qw(git-upload-pack --strict --timeout=1000 .)
     or fail "exec git-upload-pack: $!";