chiark / gitweb /
git-cache-proxy: add warning re clients being able to DoS
[chiark-utils.git] / scripts / git-cache-proxy
1 #!/usr/bin/perl -w
2 #
3 # git caching proxy
4
5 # Suitable only for exposing to semi-trusted clients: clients are not
6 # supposed to be able to take over the server.  However, clients can
7 # probably deny service to each other because the current
8 # implementation is not very good at handling various out-of-course
9 # situations (notably, clients which are too slow).
10
11 # usage: run it on some port, and then clone or fetch
12 #  "git://<realhost>:<realport>/<real-git-url>[ <options>]"
13 # where <real-git-url> is http://<host>/... or git://<host>/...
14 # and <options> is zero or more (whitespace-separated) of
15 #    [<some-option>]      will be ignored if not recognised
16 #    {<some-option>}      error if not recognised
17 # options currently known:
18 #    fetch=must           fail if the fetch/clone from upstream fails
19 #    fetch=no             just use what is in the cache
20 #    fetch=try            use what is in the cache if the fetch/clone fails
21 #    timeout=<seconds>    length of time to allow for fetch/clone
22
23 # example inetd.conf line:
24 #  9419 stream tcp nowait git-cache /usr/bin/git-cache-proxy git-cache-proxy
25 # you'll need to 
26 #  adduser git-cache
27 #  mkdir /var/cache/git-cache-proxy
28 #  chown git-cache /var/cache/git-cache-proxy
29
30 # git-cache-proxy
31 # Copyright 2010 Tony Finch
32 # Copyright 2013 Ian Jackson
33
34 # git-cache-proxy is free software; you can redistribute it and/or
35 # modify them under the terms of the GNU General Public License as
36 # published by the Free Software Foundation; either version 3, or (at
37 # your option) any later version.
38 #
39 # git-cache-proxy is distributed in the hope that it will be useful,
40 # but WITHOUT ANY WARRANTY; without even the implied warranty of
41 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
42 # General Public License for more details.
43
44 # You should have received a copy of the GNU General Public License along
45 # with this program; if not, consult the Free Software Foundation's
46 # website at www.fsf.org, or the GNU Project website at www.gnu.org.
47
48 # (Some code taken from userv-utils's git-daemon.in and git-service.in
49 # which were written by Tony Finch <dot@dotat.at> and subsequently
50 # heavily modified by Ian Jackson <ijackson@chiark.greenend.org.uk>
51 # and were released under CC0 1.0.  The whole program is now GPLv3+.)
52
53 use strict;
54 use warnings;
55
56 use POSIX;
57 use Socket;
58 use Sys::Syslog;
59 use Fcntl qw(:flock SEEK_SET);
60 use File::Path qw(remove_tree);
61
62 our $us = 'git-cache-proxy';
63
64 our $debug = 0;
65 our $housekeepingeverydays = 1;
66 our $treeexpiredays = 21;
67 our $fetchtimeout = 1800;
68 our $maxfetchtimeout = 3600;
69 our $cachedir = '/var/cache/git-cache-proxy';
70 our $housekeepingonly = 0;
71
72 #---------- error handling and logging ----------
73
74 # This is a bit fiddly, because we want to catch errors sent to stderr
75 # and dump them to syslog if we can, but only if we are running as an
76 # inetd service.
77
78 our $log; # filehandle (ref), or "1" meaning syslog
79
80 sub ntoa {
81     my $sockaddr = shift;
82     return ('(local)') unless defined $sockaddr;
83     my ($port,$addr) = sockaddr_in $sockaddr;
84     $addr = inet_ntoa $addr;
85     return ("[$addr]:$port",$addr,$port);
86 }
87
88 our ($client) = ntoa getpeername STDIN;
89 our ($server) = ntoa getsockname STDIN;
90
91 sub ensurelog () {
92     return if $log;
93     openlog $us, qw(pid), 'daemon';
94     $log = 1;
95 }
96
97 sub logm ($$) {
98     my ($pri, $msg) = @_;
99     return if $pri eq 'debug' && !$debug;
100     if ($client eq '(local)') {
101         print STDERR "$us: $pri: $msg\n" or die $!;
102         return;
103     }
104     ensurelog();
105     my $mainmsg = sprintf "%s-%s: %s", $server, $client, $msg;
106     if (ref $log) {
107         my $wholemsg = sprintf("%s [%d] %s: %s\n",
108                                strftime("%Y-%m-%d %H:%M:%S Z", gmtime),
109                                $$,
110                                $pri eq 'err' ? 'error' : $pri,
111                                $mainmsg);
112         print $log $wholemsg;
113     } else {
114         syslog $pri, "%s", "$pri $mainmsg";
115     }
116 }
117
118 if ($client ne '(local)') {
119     open STDERR, ">/dev/null" or exit 255;
120     open TEMPERR, "+>", undef or exit 255;
121     open STDERR, ">&TEMPERR" or exit 255;
122 }
123
124 END {
125     if ($client ne '(local)') {
126         if ($?) { logm 'crit', "crashing ($?)"; }
127         seek TEMPERR, 0, SEEK_SET;
128         while (<TEMPERR>) {
129             chomp;
130             logm 'crit', $_;
131         }
132     }
133     exit $?;
134 }
135
136 sub fail ($) {
137     my ($msg) = @_;
138     logm 'err', $msg;
139     exit 0;
140 }
141
142 sub gitfail ($) {
143     my ($msg) = @_;
144     close LOCK;
145     alarm 60;
146     logm 'notice', $msg;
147     my $gitmsg = "ERR $us: $msg";
148     $gitmsg = substr($gitmsg,0,65535); # just in case
149     printf "%04x%s", length($gitmsg)+4, $gitmsg;
150     flush STDOUT;
151     exit 0;
152 }
153
154 #---------- argument parsing ----------
155
156 for (;;) {
157     last unless @ARGV;
158     last unless $ARGV[0] =~ m/^-/;
159     $_ = shift @ARGV;
160     for (;;) {
161         last unless m/^-./;
162         if (s/^-H/-/) {
163             $housekeepingonly++;
164         } elsif (s/^-D/-/) {
165             $debug++;
166         } elsif (s/^-L(.*)$//) {
167             my $logfile = $_;
168             open STDERR, ">>", $logfile or fail "open $logfile: $!";
169             $log = \*STDERR;
170         } elsif (s/^-d(.*)$//) {
171             $cachedir = $1;
172         } elsif (s/^--( max-fetch-timeout
173                       | fetch-timeout
174                       | tree-expire-days
175                       | housekeeping-interval-days
176                       )=(\d+)$//x) {
177             my $vn = $1;
178             $vn =~ y/-//d;
179             die $vn unless defined ${ $::{$vn} };
180             ${ $::{$vn} } = $2;
181         } else {
182             fail "bad usage: unknown option `$_'";
183         }
184     }
185 }
186
187 !@ARGV or fail "bad usage: no non-option arguments permitted";
188
189 #---------- utility functions ----------
190
191 sub lockfile ($$$) {
192     my ($fh, $fn, $flockmode) = @_;
193     my $what = $fn.(($flockmode & ~LOCK_NB) == LOCK_SH ? " (shared)" : "");
194     for (;;) {
195         close $fh;
196         open $fh, '+>', $fn or fail "open/create $fn for lock: $!";
197         logm 'debug', "lock $what: acquiring";
198         if (!flock $fh, $flockmode) {
199             if ($flockmode & LOCK_NB && $! == EWOULDBLOCK) {
200                 return 0; # ok then
201             }
202             fail "lock $what: $!";
203         }
204         stat $fh or fail "stat opened $fn: $!";
205         my $fh_ino = ((stat _)[1]);
206         if (!stat $fn) {
207             $! == ENOENT or fail "stat $fn: $!";
208             next;
209         }
210         my $fn_ino = ((stat _)[1]);
211         if ($fn_ino == $fh_ino) {
212             logm 'debug', "lock $what: acquired";
213             return 1;
214         }
215         logm 'debug', "lock $what: deleted, need to loop again";
216         # oh dear
217     }
218 }
219
220 sub xread {
221     my $length = shift;
222     my $buffer = "";
223     while ($length > length $buffer) {
224         my $ret = sysread STDIN, $buffer, $length, length $buffer;
225         fail "expected $length bytes, got ".length $buffer
226                             if defined $ret and $ret == 0;
227         fail "read: $!" if not defined $ret and $! != EINTR and $! != EAGAIN;
228     }
229     return $buffer;
230 }
231
232 #---------- main program ----------
233
234 chdir $cachedir or fail "chdir $cachedir: $!";
235
236 our ($service,$specpath,$spechost,$subdir);
237 our ($tmpd,$gitd,$lock);
238 our ($fetch,$url);
239
240 sub servinfo ($) {
241     my ($msg) = @_;
242     logm 'info', "service `$specpath': $msg";
243 }
244
245 sub readcommand () {
246     $SIG{ALRM} = sub { fail "timeout" };
247     alarm 30;
248
249     my $hex_len = xread 4;
250     fail "Bad hex in packet length" unless $hex_len =~ m|^[0-9a-fA-F]{4}$|;
251     my $line = xread -4 + hex $hex_len;
252     unless (($service,$specpath,$spechost) = $line =~
253             m|^(git-[a-z-]+) /*([!-~ ]+)\0host=([!-~]+)\0$|) {
254         $line =~ s|[^ -~]+| |g;
255         gitfail "unknown/unsupported instruction `$line'"
256     }
257
258     alarm 0;
259
260     $service eq 'git-upload-pack'
261         or gitfail "unknown/unsupported service `$service'";
262
263     $fetch = 2; # 0:don't; 1:try; 2:force
264     $url = $specpath;
265
266     while ($url =~ s#\s+(\[)([^][{}]+)\]$## ||
267            $url =~ s#\s+(\{)([^][{}]+)\}$##) {
268         $_ = $2;
269         my $must = $1 eq '{';
270         if (m/^fetch=try$/) {
271             $fetch = 1;
272         } elsif (m/^fetch=no$/) {
273             $fetch = 0;
274         } elsif (m/^fetch=must$/) {
275             $fetch = 2; # the default
276         } elsif (m/^timeout=(\d+)$/ && $1 >= 1) {
277             $fetchtimeout = $1 <= $maxfetchtimeout ? $1 : $maxfetchtimeout;
278         } elsif ($must) {
279             gitfail "unknown/unsupported option `$_'";
280         }
281     }
282
283     $url =~ m{^(?:https?|git)://[-.0-9a-z]+/}
284         or gitfail "unknown/unsupported url scheme or format `$url'";
285
286     $subdir = $url;
287     $subdir =~ s|\\|\\\\|g;
288     $subdir =~ s|,|\\,|g;
289     $subdir =~ s|/|,|g;
290
291     $tmpd= "$subdir\\.tmp";
292     $gitd= "$subdir\\.git";
293     $lock = "$subdir\\.lock";
294
295     servinfo "locking";
296 }
297
298 sub clonefetch () {
299     lockfile \*LOCK, $lock, LOCK_EX;
300
301     my $exists = lstat $gitd;
302     $exists or $!==ENOENT or fail "lstat $gitd: $!";
303
304     our $fetchfail = '';
305
306     if ($fetch) {
307
308         our @cmd;
309
310         if (!$exists) {
311             system qw(rm -rf --), $tmpd;
312             @cmd = (qw(git clone -q --mirror), $url, $tmpd);
313             servinfo "cloning";
314         } else {
315             @cmd = (qw(git remote update --prune));
316             servinfo "fetching";
317         }
318         my $cmd = "@cmd[0..1]";
319
320         my $child = open FETCHERR, "-|";
321         defined $child or fail "fork: $!";
322         if (!$child) {
323             if ($exists) {
324                 chdir $gitd or fail "chdir $gitd: $!";
325             }
326             setpgrp or fail "setpgrp: $!";
327             open STDERR, ">&STDOUT" or fail "redirect stderr: $!";
328             exec @cmd or fail "exec $cmd[0]: $!";
329         }
330
331         my $fetcherr = '';
332         my $timedout = 0;
333         {
334             local $SIG{ALRM} = sub {
335                 servinfo "fetch/clone timeout";
336                 $timedout=1; kill 9, -$child;
337             };
338             alarm($fetchtimeout);
339             $!=0; { local $/=undef; $fetcherr = <FETCHERR>; }
340             !FETCHERR->error or fail "read pipe from fetch/clone: $!";
341             alarm(10);
342         }
343
344         kill -9, $child or fail "kill fetch/clone: $!";
345         $!=0; $?=0; if (!close FETCHERR) {
346             fail "reap fetch/clone: $!" if $!;
347             my $fetchfail =
348                 !($? & 255) ? "$cmd died with error exit code ".($? >> 8) :
349                 $? != 9 ? "$cmd died due to fatal signa, status $?" :
350                 $timedout ? "$cmd timed out (${fetchtimeout}s)" :
351                 "$cmd died due to unexpected SIGKILL";
352             if (length $fetcherr) {
353                 $fetchfail .= "\n$fetcherr";
354                 $fetchfail =~ s/\n$//;
355                 $fetchfail =~ s{\n}{ // }g;
356             }
357             if ($fetch >= 2) {
358                 gitfail $fetchfail;
359             } else {
360                 servinfo "fetch/clone failed: $fetchfail";
361             }
362         }
363
364         if (!$exists) {
365             rename $tmpd, $gitd or fail "rename fresh $tmpd to $gitd: $!";
366             $exists = 1;
367         }
368     } else {
369         $fetchfail = 'not attempted';
370     }
371
372     if (!$exists) {
373         gitfail "no cached data, and not cloned: $fetchfail";
374     }
375
376     servinfo "sharing";
377     lockfile \*LOCK, $lock, LOCK_SH; # NB releases and relocks
378
379     if (stat $gitd) {
380         return 1;
381     }
382     $!==ENOENT or fail "stat $gitd: $!";
383
384     # Well, err, someone must have taken the lock in between
385     # and garbage collected it.  How annoying.
386     return 0;
387 }
388
389 sub hkfail ($) { my ($msg) = @_; fail "housekeeping: $msg"; }
390
391 sub housekeeping () {
392     logm 'info', "housekeeping started";
393     foreach $lock (<[a-z]*\\.lock>) {
394         my $subdir = $lock;  $subdir =~ s/\\.lock$//;
395         if (!lstat $lock) {
396             $! == ENOENT or hkfail "$lock: lstat: $!";
397             next;
398         }
399         if (-M _ <= $treeexpiredays) {
400             logm 'debug', "housekeeping: subdirs $subdir: touched recently";
401             next;
402         }
403         if (!lockfile \*LOCK, $lock, LOCK_EX|LOCK_NB) {
404             logm 'info', "housekeeping: subdirs $subdir: lock busy, skipping";
405             next;
406         }
407         logm 'info', "housekeeping: subdirs $subdir: cleaning";
408         my $ok = 1;
409         foreach my $suffix (qw(tmp git)) {
410             my $dir = "${subdir}\\.$suffix";
411             my $errs;
412             remove_tree($dir, { safe=>1, error=>\$errs });
413             if (stat $dir) {
414                 $ok = 0;
415                 logm 'warning', "housekeeping: $dir: problems with".
416                     "deletion prevent cleanup:";
417                 foreach my $err (@$errs) {
418                     logm 'info', "problem deleting: $err->[0]: $err->[1]";
419                 }
420             }
421         }
422         if ($ok) {
423             unlink $lock or hkfail "remove $lock: $!";
424         }
425     }
426     open HS, ">", "Housekeeping.stamp" or hkfail "touch Housekeeping.stamp: $!";
427     close HS or hkfail "close Housekeeping.stamp: $!";
428     logm 'info', "housekeeping finished";
429 }
430
431 sub housekeepingcheck ($$) {
432     my ($dofork, $force) = @_;
433     if (!$force) {
434         if (!lockfile \*HLOCK, "Housekeeping.lock", LOCK_EX|LOCK_NB) {
435             logm 'debug', "housekeeping lock taken, not running";
436             close HLOCK;
437             return 0;
438         }
439     }
440     if ($force) {
441         logm 'info', "housekeeping forced";
442     } elsif (!lstat "Housekeeping.stamp") {
443         $! == ENOENT or fail "lstat Housekeeping.stamp: $!";
444         logm 'info', "housekeeping not done yet, will run";
445     } elsif (-M _ <= $housekeepingeverydays) {
446         logm 'debug', "housekeeping done recently";
447         close HLOCK;
448         return 0;
449     }
450     if ($dofork) {
451         my $child = fork;
452         defined $child or hkfail "fork: $!";
453         if (!$child) {
454             housekeeping();
455             exit 0;
456         }
457     } else {
458         housekeeping();
459     }
460     close HLOCK;
461     return 1;
462 }
463
464 sub runcommand () {
465     servinfo "serving";
466
467     chdir $gitd or fail "chdir $gitd: $!";
468
469     exec qw(git-upload-pack --strict --timeout=1000 .)
470         or fail "exec git-upload-pack: $!";
471 }
472
473 sub daemonservice () {
474     readcommand();
475     while (!clonefetch()) { }
476     housekeepingcheck(1,0);
477     runcommand();
478 }
479
480 if ($housekeepingonly) {
481     housekeepingcheck(0, $housekeepingonly>=2);
482 } else {
483     daemonservice();
484 }