X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=chiark-utils.git;a=blobdiff_plain;f=scripts%2Fgit-cache-proxy;h=b4b23001cb3ed42686ccaf0c1392c7f4f0bc40c5;hp=f797e74920cc36822141ad2422ad683d6f8e4281;hb=32c189107d19892ab4730757003c07576f139de5;hpb=cb8ee35c18f491d1a9e0b334a0d0e165a52adfe1

diff --git a/scripts/git-cache-proxy b/scripts/git-cache-proxy
index f797e74..b4b2300 100755
--- a/scripts/git-cache-proxy
+++ b/scripts/git-cache-proxy
@@ -40,6 +40,7 @@ use POSIX;
 use Socket;
 use Sys::Syslog;
 use Fcntl qw(:flock SEEK_SET);
+use File::Path qw(remove_tree);
 
 our $us = 'git-cache-proxy';
 
@@ -126,6 +127,8 @@ sub gitfail ($) {
 
 #---------- argument parsing ----------
 
+our $housekeepingthreshdays = 1;
+our $treeexpiredays = 21;
 our $fetchtimeout = 1800;
 our $maxfetchtimeout = 3600;
 our $cachedir = '/var/cache/git-cache-proxy';
@@ -152,13 +155,32 @@ for (;;) {
 
 !@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;
@@ -172,6 +194,19 @@ sub xread {
     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;
@@ -218,19 +253,18 @@ sub readcommand () {
     $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 = '';
 
@@ -241,10 +275,10 @@ sub clonefetch () {
 	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]";
 
@@ -263,10 +297,9 @@ sub clonefetch () {
 	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: $!";
@@ -289,7 +322,7 @@ logm 'info', "timeout=$fetchtimeout";
 	    if ($fetch >= 2) {
 		gitfail $fetchfail;
 	    } else {
-		logm 'info', "$specpath fetch/clone failed: $fetchfail";
+		servinfo "fetch/clone failed: $fetchfail";
 	    }
 	}
 
@@ -305,11 +338,8 @@ logm 'info', "timeout=$fetchtimeout";
 	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;
@@ -321,8 +351,66 @@ logm 'info', "timeout=$fetchtimeout";
     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: $!";
 }