From: Ian Jackson Date: Sat, 9 Nov 2013 20:29:46 +0000 (+0000) Subject: git-cache-proxy: wip based on userv-utils git-daemon and git-service X-Git-Tag: debian/4.2.1__iwj2~13 X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?a=commitdiff_plain;h=4d1cbdd9af99eeeefa99c2f3ef9a9bd1db52f8c2;p=chiark-utils.git git-cache-proxy: wip based on userv-utils git-daemon and git-service --- diff --git a/scripts/git-cache-proxy b/scripts/git-cache-proxy new file mode 100644 index 0000000..d8ef34d --- /dev/null +++ b/scripts/git-cache-proxy @@ -0,0 +1,230 @@ +#!/usr/bin/perl +# +# git caching proxy +# +# usage: run it on some port, and then clone or fetch +# git://:/ +# where is http:///... or git:///... + +use strict; +use warnings; + +use POSIX; +use Socket; +use Sys::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); +} + +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 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 fail ($) { + my ($msg) = @_; + log 'error', $msg; + exit 1; +} + +sub gitfail ($) { + my ($msg) = @_; + log 'warning', $msg; + my $gitmsg = "ERR $us: $msg"; + $gitmsg = substr($gitmsg,0,65535); # just in case + printf "%04x%s", length($gitmsg)+4, $gitmsg; + flush STDOUT; + exit 1; +} + +our $cachedir = '/var/cache/git-cache-proxy'; + +for (;;) { + last unless @ARGV; + last unless $ARGV[0] =~ m/^-/; + $_ = shift @ARGV; + for (;;) { + last unless m/^-./; + if (s/^-L(.*)$//) { + my $logfile = $_; + open STDERR, ">>", $logfile or fail "open $logfile: $!"; + $log = \*STDERR; + } elsif (s/^-d(.*)$//) { + $cachedir = $1; + } elsif (s/^--(maxfetchtimeout|fetchtimeout)=(\d+)$//) { + ${ $::{$1} } = $2; + } else { + fail "bad usage: unknown option `$_'"; + } + } +} + +!@ARGV or fail "bad usage: no non-option arguments permitted"; + +chdir $cachedir or fail "chdir $cachedir: $!"; + +our ($service,$specpath,$spechost); + +$SIG{ALRM} = sub { fail "timeout" }; +alarm 30; + +sub xread { + my $length = shift; + my $buffer = ""; + while ($length > length $buffer) { + my $ret = sysread STDIN, $buffer, $length, length $buffer; + fail "Expected $length bytes, got ".length $buffer + if defined $ret and $ret == 0; + fail "read: $!" if not defined $ret and $! != EINTR and $! != EAGAIN; + } + return $buffer; +} +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 =~ + m|^(git-[a-z-]+) /*([!-~]+)\0host=([!-~]+)\0$|) { + $line =~ s|[^ -~]+| |g; + fail "Could not parse \"$line\"" +} + +alarm 0; + +$service eq 'git-upload-pack' + or gitfail "unknown/unsupported service `$service'"; + +my $fetch = 2; # 0:don't; 1:try; 2:force +my $url = $specpath; + +while ($url =~ s#^(\[)([^][{}])+\]## || + $url =~ s#^(\{)([^][{}])+\}##) { + $_ = $2; + my $must = $1 eq '{'; + if (m/^relaxed$/) { + $fetch = 1; + } elsif (m/^nofetch$/) { + $fetch = 0; + } elsif (m/^timeout=(\d+)$/) { + $fetchtimeout = $1 <= $maxfetchtimeout ? $1 : $maxfetchtimeout; + } elsif ($must) { + gitfail "unknown/unsupported option `$_'"; + } +} + +$url =~ m{^(?:https?|git)://[-.0-9a-z]+/} + or gitfail "unknown/unsupported url scheme or format `$url'"; + +our $subdir = $url; +$subdir =~ s|\\|\\\\|g; +$subdir =~ s|,|\\,|g; +$subdir =~ s|/|,|g; + +log 'info', "$specpath locking"; + +my $tmpd= "$subdir\\.tmp"; +my $gitd= "$subdir\\.git"; +my $lock = "$subdir\\.lock"; + +open LOCK, "+>", $lock or fail "open/create $lock: $!"; +flock LOCK, LOCK_EX or fail "lock $lock: $!"; + +$exists = stat $gitd; +$exists or $!==ENOENT or FAIL "stat $gitd: $!"; + +if ($fetch) { + + our @cmd; + + 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"; + } + + my $child = open P, "-|"; + 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]: $!"; + } + + 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; + + + + + +$service eq ' + +@@READ_URLMAP@@ + +fail "No global mapping for $uri" unless defined $serve_user; + +my ($hn,$ha,$at,$naddrs,@addrs) = gethostbyname $spechost; +fail "hostname/address mismatch ($spechost $server_addr)" unless grep { + $server_addr eq inet_ntoa $_ + } @addrs; + +our @opts; + +push @opts, "-D$_=${$::{$_}}" + for qw(service specpath spechost + client client_addr client_port + server server_addr server_port); + +fail "no user $serve_user" unless getpwnam($serve_user); + +syslog 'notice', "$client $service $uri $serve_user"; + +my @cmd = ('userv', '-t300', @opts, $serve_user, $service); +no warnings; # suppress errors to stderr +exec @cmd or fail "exec userv: $!"; + +# end