git-cache-proxy: more wip

diff --git a/scripts/git-cache-proxy b/scripts/git-cache-proxy
index d8ef34df617349c50e5dec41e29770e9ede32928..cd4b087c037b3a09db29a811da2895b199d56185 100644 (file)
--- a/scripts/git-cache-proxy
+++ b/scripts/git-cache-proxy
@@ -3,8 +3,16 @@
 # 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>/<real-git-url>
+#  git://<realhost>:<realport>/OPTIONS<real-git-url>

 # 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
+#    [<some-option>]      will be ignored if not recognised
+#    {<some-option>}      error if not recognised
+# options currently known:
+#    fetch=must           fail if the fetch/clone from upstream fails
+#    fetch=no             just use what is in the cache
+#    fetch=try            use what is in the cache if the fetch/clone fails
+#    timeout=<seconds>    length of time to allow for fetch/clone

 
 use strict;
 use warnings;
 
 use strict;
 use warnings;


@@ -59,7 +67,9 @@ sub fail ($) {
 
 sub gitfail ($) {
     my ($msg) = @_;
 
 sub gitfail ($) {
     my ($msg) = @_;

-    log 'warning', $msg;
+    close LOCK;
+    alarm 60;
+    log 'notice', $msg;

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


@@ -130,10 +140,12 @@ while ($url =~ s#^(\[)([^][{}])+\]## ||
        $url =~ s#^(\{)([^][{}])+\}##) {
     $_ = $2;
     my $must = $1 eq '{';
        $url =~ s#^(\{)([^][{}])+\}##) {
     $_ = $2;
     my $must = $1 eq '{';

-    if (m/^relaxed$/) {
+    if (m/^fetch=try$/) {

        $fetch = 1;
        $fetch = 1;

-    } elsif (m/^nofetch$/) {
+    } elsif (m/^fetch=no$/) {

        $fetch = 0;
        $fetch = 0;

+    } elsif (m/^fetch=must$/) {
+       $fetch = 2; # the default

     } elsif (m/^timeout=(\d+)$/) {
        $fetchtimeout = $1 <= $maxfetchtimeout ? $1 : $maxfetchtimeout;
     } elsif ($must) {
     } elsif (m/^timeout=(\d+)$/) {
        $fetchtimeout = $1 <= $maxfetchtimeout ? $1 : $maxfetchtimeout;
     } elsif ($must) {


@@ -155,76 +167,93 @@ my $tmpd= "$subdir\\.tmp";
 my $gitd= "$subdir\\.git";
 my $lock = "$subdir\\.lock";
 
 my $gitd= "$subdir\\.git";
 my $lock = "$subdir\\.lock";
 

-open LOCK, "+>", $lock or fail "open/create $lock: $!";
-flock LOCK, LOCK_EX or fail "lock $lock: $!";
+for (;;) {
+    open LOCK, "+>", $lock or fail "open/create $lock: $!";
+    flock LOCK, LOCK_EX or fail "lock exclusive $lock: $!";

 
 

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

 
 

-if ($fetch) {
+    our $fetchfail = '';

 
 

-    our @cmd;
+    if ($fetch) {

 
 

-    if (!$exists) {
-       system qw(rm -rf --), $tmpd;
-       @cmd = qw(git clone -q --mirror), $url;
-       log 'info', "$specpath cloning";
-    } else {
-       @cmd = qw(git remote update --prune), $url;
-       log 'info', "$specpath fetching";
-    }
+       our @cmd;

 
 

-    my $child = open P, "-|";
-    defined $child or fail "fork: $!";
-    if (!$child) {
-       if ($exists) {
-           chdir $gitd or fail "chdir $gitd: $!";
+       if (!$exists) {
+           system qw(rm -rf --), $tmpd;
+           @cmd = qw(git clone -q --mirror), $url;
+           log 'info', "$specpath cloning";
+       } else {
+           @cmd = qw(git remote update --prune), $url;
+           log 'info', "$specpath fetching";

        }
        }

-       setpgrp or fail "setpgrp: $!";
-       open STDERR, ">&STDOUT" or fail "redirect stderr: $!";
-       exec @cmd or fail "exec $cmd[0]: $!";
-    }
-
-    local $SIG{ALARM} = sub {
-       kill 9, -$child;
-       
-       } or log 'crit', 
-    };
-
-    alarm($fetchtimeout);
-    
-
-printf STDERR "%s [$$] %s %s\n",
-    strftime("%Y-%m-%d %H:%M:%S %Z", localtime), $server, $client;
-
-
-

 
 

+       my $child = open FETCHERR, "-|";
+       defined $child or fail "fork: $!";
+       if (!$child) {
+           if ($exists) {
+               chdir $gitd or fail "chdir $gitd: $!";
+           }
+           setpgrp or fail "setpgrp: $!";
+           open STDERR, ">&STDOUT" or fail "redirect stderr: $!";
+           exec @cmd or fail "exec $cmd[0]: $!";
+       }

 
 

-$service eq '
-
-@@READ_URLMAP@@
-
-fail "No global mapping for $uri" unless defined $serve_user;
+       my $timedout = 0;
+       {
+           local $SIG{ALARM} = sub { $timedout=1; kill 9, -$child; };
+           alarm($fetchtimeout);
+           my $fetcherr = '';
+           $!=0; { local $/=undef; $fetcherr = <FETCHERR>; }
+           !FETCHERR->error or fail "read pipe from fetch/clone: $!";
+           alarm(10);
+       }

 
 

-my ($hn,$ha,$at,$naddrs,@addrs) = gethostbyname $spechost;
-fail "hostname/address mismatch ($spechost $server_addr)" unless grep {
-    $server_addr eq inet_ntoa $_
-    } @addrs;
+       kill -9, $child or fail "kill fetch/clone: $!";
+       $!=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";
+           if (length $fetcherr) {
+               $fetchfail .= "\n$fetcherr";
+               $fetchfail =~ s{\n}{ // }g;
+           }
+           if ($fetch >= 2) {
+               gitfail $fetchfail;
+           } else {
+               log 'info', "$specpatch fetch failed: $fetchfail";
+           }
+       }

 
 

-our @opts;
+       if (!$exists) {
+           rename $tmpd, $gitd or fail "rename fresh $tmpd to $gitd: $!";
+           $exists = 1;
+       }
+    } else {
+       $fetchfail = 'not attempted';
+    }

 
 

-push @opts, "-D$_=${$::{$_}}"
-    for qw(service specpath spechost
-          client client_addr client_port
-          server server_addr server_port);
+    if (!$exists) {
+       gitfail "no cached data, and not cloned: $fetchfail";
+    }

 
 

-fail "no user $serve_user" unless getpwnam($serve_user);
+    flock LOCK, LOCK_UN for fail "unlock $lock: $!";
+    flock LOCK, LOCK_SH for fail "lock shared $lock: $!";
+    # actually, just relocking as shared would have the same semantics
+    # but it's best to be explicit

 
 

-syslog 'notice', "$client $service $uri $serve_user";
+    if (chdir $gitd) {
+       last;
+    }
+    $!==ENOENT or fail "chdir $gitd: $!";

 
 

-my @cmd = ('userv', '-t300', @opts, $serve_user, $service);
-no warnings; # suppress errors to stderr
-exec @cmd or fail "exec userv: $!";
+    # Well, err, someone must have taken the lock in between
+    # and garbage collected it.  How annoying.
+}

 
 

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