# 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>/...
+# 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;
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;
$url =~ s#^(\{)([^][{}])+\}##) {
$_ = $2;
my $must = $1 eq '{';
- if (m/^relaxed$/) {
+ if (m/^fetch=try$/) {
$fetch = 1;
- } elsif (m/^nofetch$/) {
+ } elsif (m/^fetch=no$/) {
$fetch = 0;
+ } elsif (m/^fetch=must$/) {
+ $fetch = 2; # the default
} elsif (m/^timeout=(\d+)$/) {
$fetchtimeout = $1 <= $maxfetchtimeout ? $1 : $maxfetchtimeout;
} elsif ($must) {
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: $!";