scripts/git-cache-proxy

   1 #!/usr/bin/perl
   2 #
   3 # git caching proxy
   4 #
   5 # usage: run it on some port, and then clone or fetch
   6 #  git://<realhost>:<realport>/OPTIONS<real-git-url>
   7 # where <real-git-url> is http://<host>/... or git://<host>/...
   8 # and OPTIONS is zero or more of
   9 #    [<some-option>]      will be ignored if not recognised
  10 #    {<some-option>}      error if not recognised
  11 # options currently known:
  12 #    fetch=must           fail if the fetch/clone from upstream fails
  13 #    fetch=no             just use what is in the cache
  14 #    fetch=try            use what is in the cache if the fetch/clone fails
  15 #    timeout=<seconds>    length of time to allow for fetch/clone
  16
  17 use strict;
  18 use warnings;
  19
  20 use POSIX;
  21 use Socket;
  22 use Sys::Syslog;
  23
  24 our $us = 'git-cache-proxy';
  25 our $log; # filehandle (ref), or "1" meaning syslog
  26 our $fetchtimeout = 1800;
  27 our $maxfetchtimeout = 3600;
  28
  29 sub ntoa {
  30     my $sockaddr = shift;
  31     return ('(local)') unless defined $sockaddr;
  32     my ($port,$addr) = sockaddr_in $sockaddr;
  33     $addr = inet_ntoa $addr;
  34     return ("[$addr]:$port",$addr,$port);
  35 }
  36
  37 our ($client,$client_addr,$client_port) = ntoa getpeername STDIN;
  38 our ($server,$server_addr,$server_port) = ntoa getsockname STDIN;
  39
  40 sub ensurelog () {
  41     return if $log;
  42     openlog $us, qw(pid), 'daemon';
  43     $log = 1;
  44 }
  45
  46 sub log ($) {
  47     my ($pri, $msg) = @_;
  48     ensurelog();
  49     my $mainmsg = sprintf "%s-%s: %s", $server, $client, $msg;
  50     if (ref $log) {
  51         my $wholemsg = sprintf("%s [%d] %s: %s\n",
  52                                strftime("%Y-%m-%d %H:%M:%S Z", gmtime),
  53                                $$,
  54                                $pri,
  55                                $mainmsg);
  56         print $log $wholemsg;
  57     } else {
  58         syslog $pri, $mainmsg;
  59     }
  60 }
  61
  62 sub fail ($) {
  63     my ($msg) = @_;
  64     log 'error', $msg;
  65     exit 1;
  66 }
  67
  68 sub gitfail ($) {
  69     my ($msg) = @_;
  70     close LOCK;
  71     alarm 60;
  72     log 'notice', $msg;
  73     my $gitmsg = "ERR $us: $msg";
  74     $gitmsg = substr($gitmsg,0,65535); # just in case
  75     printf "%04x%s", length($gitmsg)+4, $gitmsg;
  76     flush STDOUT;
  77     exit 1;
  78 }
  79
  80 our $cachedir = '/var/cache/git-cache-proxy';
  81
  82 for (;;) {
  83     last unless @ARGV;
  84     last unless $ARGV[0] =~ m/^-/;
  85     $_ = shift @ARGV;
  86     for (;;) {
  87         last unless m/^-./;
  88         if (s/^-L(.*)$//) {
  89             my $logfile = $_;
  90             open STDERR, ">>", $logfile or fail "open $logfile: $!";
  91             $log = \*STDERR;
  92         } elsif (s/^-d(.*)$//) {
  93             $cachedir = $1;
  94         } elsif (s/^--(maxfetchtimeout|fetchtimeout)=(\d+)$//) {
  95             ${ $::{$1} } = $2;
  96         } else {
  97             fail "bad usage: unknown option `$_'";
  98         }
  99     }
 100 }
 101
 102 !@ARGV or fail "bad usage: no non-option arguments permitted";
 103
 104 chdir $cachedir or fail "chdir $cachedir: $!";
 105
 106 our ($service,$specpath,$spechost);
 107
 108 $SIG{ALRM} = sub { fail "timeout" };
 109 alarm 30;
 110
 111 sub xread {
 112     my $length = shift;
 113     my $buffer = "";
 114     while ($length > length $buffer) {
 115         my $ret = sysread STDIN, $buffer, $length, length $buffer;
 116         fail "Expected $length bytes, got ".length $buffer
 117                             if defined $ret and $ret == 0;
 118         fail "read: $!" if not defined $ret and $! != EINTR and $! != EAGAIN;
 119     }
 120     return $buffer;
 121 }
 122 my $hex_len = xread 4;
 123 fail "Bad hex in packet length" unless $hex_len =~ m|^[0-9a-fA-F]{4}$|;
 124 my $line = xread -4 + hex $hex_len;
 125 unless (($service,$specpath,$spechost) = $line =~
 126         m|^(git-[a-z-]+) /*([!-~]+)\0host=([!-~]+)\0$|) {
 127     $line =~ s|[^ -~]+| |g;
 128     fail "Could not parse \"$line\""
 129 }
 130
 131 alarm 0;
 132
 133 $service eq 'git-upload-pack'
 134     or gitfail "unknown/unsupported service `$service'";
 135
 136 my $fetch = 2; # 0:don't; 1:try; 2:force
 137 my $url = $specpath;
 138
 139 while ($url =~ s#^(\[)([^][{}])+\]## ||
 140        $url =~ s#^(\{)([^][{}])+\}##) {
 141     $_ = $2;
 142     my $must = $1 eq '{';
 143     if (m/^fetch=try$/) {
 144         $fetch = 1;
 145     } elsif (m/^fetch=no$/) {
 146         $fetch = 0;
 147     } elsif (m/^fetch=must$/) {
 148         $fetch = 2; # the default
 149     } elsif (m/^timeout=(\d+)$/) {
 150         $fetchtimeout = $1 <= $maxfetchtimeout ? $1 : $maxfetchtimeout;
 151     } elsif ($must) {
 152         gitfail "unknown/unsupported option `$_'";
 153     }
 154 }
 155
 156 $url =~ m{^(?:https?|git)://[-.0-9a-z]+/}
 157     or gitfail "unknown/unsupported url scheme or format `$url'";
 158
 159 our $subdir = $url;
 160 $subdir =~ s|\\|\\\\|g;
 161 $subdir =~ s|,|\\,|g;
 162 $subdir =~ s|/|,|g;
 163
 164 log 'info', "$specpath locking";
 165
 166 my $tmpd= "$subdir\\.tmp";
 167 my $gitd= "$subdir\\.git";
 168 my $lock = "$subdir\\.lock";
 169
 170 for (;;) {
 171     open LOCK, "+>", $lock or fail "open/create $lock: $!";
 172     flock LOCK, LOCK_EX or fail "lock exclusive $lock: $!";
 173
 174     my $exists = stat $gitd;
 175     $exists or $!==ENOENT or FAIL "stat $gitd: $!";
 176
 177     our $fetchfail = '';
 178
 179     if ($fetch) {
 180
 181         our @cmd;
 182
 183         if (!$exists) {
 184             system qw(rm -rf --), $tmpd;
 185             @cmd = qw(git clone -q --mirror), $url;
 186             log 'info', "$specpath cloning";
 187         } else {
 188             @cmd = qw(git remote update --prune), $url;
 189             log 'info', "$specpath fetching";
 190         }
 191
 192         my $child = open FETCHERR, "-|";
 193         defined $child or fail "fork: $!";
 194         if (!$child) {
 195             if ($exists) {
 196                 chdir $gitd or fail "chdir $gitd: $!";
 197             }
 198             setpgrp or fail "setpgrp: $!";
 199             open STDERR, ">&STDOUT" or fail "redirect stderr: $!";
 200             exec @cmd or fail "exec $cmd[0]: $!";
 201         }
 202
 203         my $timedout = 0;
 204         {
 205             local $SIG{ALARM} = sub { $timedout=1; kill 9, -$child; };
 206             alarm($fetchtimeout);
 207             my $fetcherr = '';
 208             $!=0; { local $/=undef; $fetcherr = <FETCHERR>; }
 209             !FETCHERR->error or fail "read pipe from fetch/clone: $!";
 210             alarm(10);
 211         }
 212
 213         kill -9, $child or fail "kill fetch/clone: $!";
 214         $!=0; $?=0; if (!close FETCHERR) {
 215             fail "reap fetch/clone: $!" if $!;
 216             my $fetchfail =
 217                 !($? & 255) ? "$cmd[0] died with error exit code ".($? >> 8) :
 218                 $? != 9 ? "$cmd[0] died due to fatal signa, status $?" :
 219                 $timedout ? "$cmd[0] timed out (${fetchtimeout}s)" :
 220                 "$cmd[0] died due to unexpected SIGKILL";
 221             if (length $fetcherr) {
 222                 $fetchfail .= "\n$fetcherr";
 223                 $fetchfail =~ s{\n}{ // }g;
 224             }
 225             if ($fetch >= 2) {
 226                 gitfail $fetchfail;
 227             } else {
 228                 log 'info', "$specpatch fetch failed: $fetchfail";
 229             }
 230         }
 231
 232         if (!$exists) {
 233             rename $tmpd, $gitd or fail "rename fresh $tmpd to $gitd: $!";
 234             $exists = 1;
 235         }
 236     } else {
 237         $fetchfail = 'not attempted';
 238     }
 239
 240     if (!$exists) {
 241         gitfail "no cached data, and not cloned: $fetchfail";
 242     }
 243
 244     flock LOCK, LOCK_UN for fail "unlock $lock: $!";
 245     flock LOCK, LOCK_SH for fail "lock shared $lock: $!";
 246     # actually, just relocking as shared would have the same semantics
 247     # but it's best to be explicit
 248
 249     if (chdir $gitd) {
 250         last;
 251     }
 252     $!==ENOENT or fail "chdir $gitd: $!";
 253
 254     # Well, err, someone must have taken the lock in between
 255     # and garbage collected it.  How annoying.
 256 }
 257
 258 exec qw(git-upload-pack --strict --timeout=1000 .)
 259     or fail "exec git-upload-pack: $!";