use Socket;
use Sys::Syslog;
use Fcntl qw(:flock SEEK_SET);
+use File::Path qw(remove_tree);
our $us = 'git-cache-proxy';
#---------- argument parsing ----------
+our $housekeepingthreshdays = 1;
+our $treeexpiredays = 21;
our $fetchtimeout = 1800;
our $maxfetchtimeout = 3600;
our $cachedir = '/var/cache/git-cache-proxy';
!@ARGV or fail "bad usage: no non-option arguments permitted";
-#---------- main program ----------
-
-chdir $cachedir or fail "chdir $cachedir: $!";
+#---------- utility functions ----------
-our ($service,$specpath,$spechost,$subdir);
-our ($tmpd,$gitd,$lock);
-our ($fetch,$url);
+sub lockfile ($$) {
+ my ($fh, $fn, $flockmode) = @_;
+ for (;;) {
+ close $fh;
+ open $fh, '+>', $fn or fail "open/create $fn for lock: $!";
+ if (!flock $fh, $lockmode) {
+ if ($lockmode & LOCK_NB and $! == EWOULDBLOCK) {
+ return 0; # ok then
+ }
+ fail "lock $fn".
+ (($flockmode & ~LOCK_NB) == LOCK_SH ? " (shared)" : "").
+ ": $!";
+ }
+ stat $fh or fail "stat opened $fn: $!";
+ my $fh_ino = ((stat _)[1]);
+ if (!stat $fn) {
+ $! == ENOENT or fail "stat $fn: $!";
+ next;
+ }
+ my $fn_ino = ((stat _)[1]);
+ return 1 if $fn_ino == $fh_ino;
+ # oh dear
+ }
+}
sub xread {
my $length = shift;
return $buffer;
}
+#---------- main program ----------
+
+chdir $cachedir or fail "chdir $cachedir: $!";
+
+our ($service,$specpath,$spechost,$subdir);
+our ($tmpd,$gitd,$lock);
+our ($fetch,$url);
+
+sub servinfo ($) {
+ my ($msg) = @_;
+ logm 'info', "service `$specpath': $msg";
+}
+
sub readcommand () {
$SIG{ALRM} = sub { fail "timeout" };
alarm 30;
$subdir =~ s|,|\\,|g;
$subdir =~ s|/|,|g;
- logm 'info', "$specpath locking";
-
$tmpd= "$subdir\\.tmp";
$gitd= "$subdir\\.git";
$lock = "$subdir\\.lock";
+
+ servinfo "locking";
}
sub clonefetch () {
- open LOCK, "+>", $lock or fail "open/create $lock: $!";
- flock LOCK, LOCK_EX or fail "lock exclusive $lock: $!";
+ lockfile \*LOCK, $lock, LOCK_EX;
- my $exists = stat $gitd;
- $exists or $!==ENOENT or fail "stat $gitd: $!";
+ my $exists = lstat $gitd;
+ $exists or $!==ENOENT or fail "lstat $gitd: $!";
our $fetchfail = '';
if (!$exists) {
system qw(rm -rf --), $tmpd;
@cmd = (qw(git clone -q --mirror), $url, $tmpd);
- logm 'info', "$specpath cloning @cmd";
+ servinfo "cloning";
} else {
@cmd = (qw(git remote update --prune));
- logm 'info', "$specpath fetching @cmd";
+ servinfo "fetching";
}
my $cmd = "@cmd[0..1]";
my $timedout = 0;
{
local $SIG{ALRM} = sub {
- logm 'info', "$specpath fetch/clone timeout";
+ servinfo "fetch/clone timeout";
$timedout=1; kill 9, -$child;
};
-logm 'info', "timeout=$fetchtimeout";
alarm($fetchtimeout);
$!=0; { local $/=undef; $fetcherr = <FETCHERR>; }
!FETCHERR->error or fail "read pipe from fetch/clone: $!";
if ($fetch >= 2) {
gitfail $fetchfail;
} else {
- logm 'info', "$specpath fetch/clone failed: $fetchfail";
+ servinfo "fetch/clone failed: $fetchfail";
}
}
gitfail "no cached data, and not cloned: $fetchfail";
}
- logm 'info', "$specpath sharing";
- flock LOCK, LOCK_UN or fail "unlock $lock: $!";
- flock LOCK, LOCK_SH or fail "lock shared $lock: $!";
- # actually, just relocking as shared would have the same semantics
- # but it's best to be explicit
+ servinfo "sharing";
+ lockfile \*LOCK, $lock, LOCK_SH; # NB releases and relocks
if (chdir $gitd) {
return 1;
return 0;
}
+sub housekeeping () {
+ foreach $lock (<[a-z]*\\.lock>) {
+ if (!lstat $lock) {
+ $! == ENOENT or fail "housekeeping: $lock: lstat: $!";
+ next;
+ }
+ if (-M _ <= $treeexpiredays) {
+ logm 'debug', "housekeeping: $lock: not too old";
+ next;
+ }
+ my $subdir = $lock; $subdir =~ s/\\.lock$//;
+ my $ok = 1;
+ foreach my $suffix (qw(tmp git)) {
+ my $dir = "${subdir}\\.$suffix";
+ my $errs;
+ remove_tree($dir, { safe=>1, error=>\$errs });
+ $ok = 0 if @$errs;
+ foreach my $err (@$errs) {
+ logm 'warning', "problem deleting: $err[0]: $err[1]";
+ }
+ }
+ if ($ok) {
+
+
+sub housekeepingcheck ($$) {
+ my ($dofork, $force) = @_;
+ or fail "open/create Housekeeping.lock: $!";
+ if (!$force) {
+ if (!lockfile \*HLOCK, "Housekeeping.lock", LOCK_EX|LOCK_NB) {
+ logm 'debug', "housekeeping lock taken, not running";
+ close HLOCK;
+ return 0;
+ }
+ }
+ if ($force) {
+ logm 'info', "housekeeping forced";
+ } elsif (!lstat "Housekeeping.stamp") {
+ $! == ENOENT or fail "lstat Housekeeping.stamp: $!";
+ logm 'info', "housekeeping stamp missing, will run";
+ } elsif (-M _ <= $housekeepingthreshdays) {
+ logm 'debug', "housekeeping done recently";
+ close HLOCK;
+ return 0;
+ }
+ if ($dofork) {
+ my $child = fork;
+ defined $child or fail "fork for housekeeping: $!";
+ if (!$child) {
+ housekeeping();
+ exit 0;
+ }
+ return 1;
+ } else {
+ housekeeping();
+ return 1;
+ }
+}
+
sub runcommand () {
- logm 'info', "$specpath servicing";
+ servinfo "servicing";
exec qw(git-upload-pack --strict --timeout=1000 .)
or fail "exec git-upload-pack: $!";
}