X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=infra%2Fdgit-repos-server;h=f6ac5072d8849a1e3de83b60bffa67088b610ae6;hb=ab3be575e6a64ca698684995a02563b3cb82f68a;hp=baaf99197198a603b3ecddd101d16bd1f8eb5e56;hpb=c5ecd001b6b7bd34cfdb161882fa20519df7fbde;p=dgit.git diff --git a/infra/dgit-repos-server b/infra/dgit-repos-server index baaf9919..f6ac5072 100755 --- a/infra/dgit-repos-server +++ b/infra/dgit-repos-server @@ -2,10 +2,14 @@ # dgit-repos-server # # usages: -# .../dgit-repos-server DISTRO SUITES KEYRING-AUTH-SPEC \ -# DGIT-REPOS-DIR POLICY-HOOK-SCRIPT --ssh -# .../dgit-repos-server DISTRO SUITES KEYRING-AUTH-SPEC \ -# DGIT-REPOS-DIR POLICY-HOOK-SCRIPT --cron +# dgit-repos-server DISTRO DISTRO-DIR AUTH-SPEC [] --ssh +# dgit-repos-server DISTRO DISTRO-DIR AUTH-SPEC [] --cron +# settings +# --repos=GIT-REPOS-DIR default DISTRO-DIR/repos/ +# --suites=SUITES-FILE default DISTRO-DIR/suites +# --policy-hook=POLICY-HOOK default DISTRO-DIR/policy-hook +# --dgit-live=DGIT-LIVE-DIR default DISTRO-DIR/dgit-live +# (DISTRO-DIR is not used other than as default) # internal usage: # .../dgit-repos-server --pre-receive-hook PACKAGE # @@ -16,13 +20,15 @@ # SUITES is the name of a file which lists the permissible suites # one per line (#-comments and blank lines ignored) # -# KEYRING-AUTH-SPEC is a :-separated list of +# AUTH-SPEC is a :-separated list of # KEYRING.GPG,AUTH-SPEC # where AUTH-SPEC is one of # a # mDM.TXT +# (With --cron AUTH-SPEC is not used and may be the empty string.) use strict; +$SIG{__WARN__} = sub { die $_[0]; }; # DGIT-REPOS-DIR contains: # git tree (or other object) lock (in acquisition order, outer first) @@ -111,12 +117,14 @@ use strict; # cleanup to do # # Policy hook script is invoked like this: -# POLICY-HOOK-SCRIPT DISTRO DGIT-REPOS-DIR ACTION... +# POLICY-HOOK-SCRIPT DISTRO DGIT-REPOS-DIR DGIT-LIVE-DIR ACTION... # ie. # POLICY-HOOK-SCRIPT ... check-list [...] # POLICY-HOOK-SCRIPT ... check-package PACKAGE [...] -# POLICY-HOOK-SCRIPT ... push|push-confirm PACKAGE \ +# POLICY-HOOK-SCRIPT ... push PACKAGE \ # VERSION SUITE TAGNAME DELIBERATELIES [...] +# POLICY-HOOK-SCRIPT ... push-confirm PACKAGE \ +# VERSION SUITE TAGNAME DELIBERATELIES FRESH-REPO|'' [...] # # Exit status is a bitmask. Bit weight constants are defined in Dgit.pm. # NOFFCHECK (2) @@ -133,20 +141,32 @@ use strict; # to-be-pushed objects have been received; TAGNAME is the # version-based tag # +# FRESH-REPO is '' iff the repo for this package already existed, or +# the pathname of the newly-created repo which will be renamed into +# place if everything goes well. (NB that this is generally not the +# same repo as the cwd, because the objects are first received into a +# temporary repo so they can be examined.) +# # if push requested FRESHREPO, push-confirm happens in said fresh repo +# and FRESH-REPO is guaranteed not to be ''. # # policy hook for a particular package will be invoked only once at # a time - (see comments about DGIT-REPOS-DIR, above) # # check-list and check-package are invoked via the --cron option. # First, without any locking, check-list is called. It should produce -# a list of package names. Then check-package will be invoked for -# each named package, in each case after taking an appropriate lock. +# a list of package names (one per line). Then check-package will be +# invoked for each named package, in each case after taking an +# appropriate lock. +# +# If policy hook wants to run dgit (or something else in the dgit +# package), it should use DGIT-LIVE-DIR/dgit (etc.) use POSIX; use Fcntl qw(:flock); use File::Path qw(rmtree); +use File::Temp qw(tempfile); use Debian::Dgit qw(:DEFAULT :policyflags); @@ -158,7 +178,7 @@ our $package; our $distro; our $suitesfile; our $policyhook; -our $realdestrepo; +our $dgitlive; our $destrepo; our $workrepo; our $keyrings; @@ -174,6 +194,8 @@ sub debug { print DEBUG "$debug @_\n"; } +sub realdestrepo () { "$dgitrepos/$package.git"; } + sub acquirelock ($$) { my ($lock, $must) = @_; my $fh; @@ -212,7 +234,7 @@ sub locksometree ($) { } sub lockrealtree () { - locksometree($realdestrepo); + locksometree(realdestrepo); } sub mkrepotmp () { @@ -261,11 +283,12 @@ sub policyhook { my ($policyallowbits, @polargs) = @_; # => ($exitstatuspolicybitmap); die if $policyallowbits & ~0x3e; - my @cmd = ($policyhook,$distro,$dgitrepos,@polargs); + my @cmd = ($policyhook,$distro,$dgitrepos,$dgitlive,@polargs); debugcmd @cmd; my $r = system @cmd; die "system: $!" if $r < 0; die "hook (@cmd) failed ($?)" if $r & ~($policyallowbits << 8); + debug sprintf "hook (%s) => %#x", "@polargs", $r; return $r >> 8; } @@ -284,7 +307,7 @@ sub mkrepo_fromtemplate ($) { } sub movetogarbage () { - # $realdestrepo must have been locked + # realdestrepo must have been locked my $garbagerepo = "$dgitrepos/${package}_garbage"; # We arrange to always keep at least one old tree, for anti-rewind # purposes (and, I guess, recovery from mistakes). This is either @@ -298,11 +321,22 @@ sub movetogarbage () { } rename "$garbagerepo", "$garbagerepo-old" or die "$garbagerepo $!"; } - rename $realdestrepo, $garbagerepo + rename realdestrepo, $garbagerepo or $! == ENOENT or die "$garbagerepo $!"; } +sub policy_checkpackage () { + my $lfh = lockrealtree(); + + $policy = policyhook(FRESHREPO,'check-package',$package); + if ($policy & FRESHREPO) { + movetogarbage(); + } + + close $lfh; +} + #----- git-receive-pack ----- sub fixmissing__git_receive_pack () { @@ -344,7 +378,7 @@ sub dealwithfreshrepo () { } sub maybeinstallprospective () { - return if $destrepo eq $realdestrepo; + return if $destrepo eq realdestrepo; if (open REJ, "<", "$workrepo/drs-error") { local $/ = undef; @@ -388,8 +422,8 @@ sub maybeinstallprospective () { movetogarbage; } - debug "install $destrepo => $realdestrepo"; - rename $destrepo, $realdestrepo or die $!; + debug "install $destrepo => ".realdestrepo; + rename $destrepo, realdestrepo or die $!; remove "$destrepo.lock" or die $!; } @@ -728,7 +762,8 @@ sub checks () { mkrepo_fromtemplate $destrepo; } - policyhook(0, 'push-confirm', @policy_args); + my $willinstall = ($destrepo eq realdestrepo ? '' : $destrepo); + policyhook(0, 'push-confirm', @policy_args, $willinstall); } sub onwardpush () { @@ -783,6 +818,76 @@ sub argval () { return $v; } +our %indistrodir = ( + # keys are used for DGIT_DRS_XXX too + 'repos' => \$dgitrepos, + 'suites' => \$suitesfile, + 'policy-hook' => \$policyhook, + 'dgit-live' => \$dgitlive, + ); + +our @hookenvs = qw(distro suitesfile policyhook dgitlive keyrings dgitrepos); + +# workrepo and destrepo handled ad-hoc + +sub mode_ssh () { + die if @ARGV; + + my $cmd = $ENV{'SSH_ORIGINAL_COMMAND'}; + $cmd =~ m{ + ^ + (?: \S* / )? + ( [-0-9a-z]+ ) + \s+ + '? (?: \S* / )? + ($package_re) \.git + '?$ + }ox + or reject "command string not understood"; + my $method = $1; + $package = $2; + + my $funcn = $method; + $funcn =~ y/-/_/; + my $mainfunc = $main::{"main__$funcn"}; + + reject "unknown method" unless $mainfunc; + + policy_checkpackage(); + + if (stat_exists realdestrepo) { + $destrepo = realdestrepo; + } else { + debug " fixmissing $funcn"; + my $fixfunc = $main::{"fixmissing__$funcn"}; + &$fixfunc; + } + + debug " running main $funcn"; + &$mainfunc; +} + +sub mode_cron () { + die if @ARGV; + + my $listfh = tempfile(); + open STDOUT, ">&", $listfh or die $!; + policyhook(0,'check-list'); + open STDOUT, ">&STDERR" or die $!; + + seek $listfh, 0, 0 or die $!; + while (<$listfh>) { + chomp or die; + next if m/^\s*\#/; + next unless m/\S/; + die unless m/^($package_re)$/; + + $package = $1; + policy_checkpackage(); + } + die $! if $listfh->error; +} + sub parseargsdispatch () { die unless @ARGV; @@ -799,13 +904,9 @@ sub parseargsdispatch () { shift @ARGV; @ARGV == 1 or die; $package = shift @ARGV; - defined($distro = $ENV{'DGIT_DRS_DISTRO'}) or die; - defined($dgitrepos = $ENV{'DGIT_DRS_REPOS'}) or die; - defined($suitesfile = $ENV{'DGIT_DRS_SUITES'}) or die; + ${ $main::{$_} } = $ENV{"DGIT_DRS_\U$_"} foreach @hookenvs; defined($workrepo = $ENV{'DGIT_DRS_WORK'}) or die; defined($destrepo = $ENV{'DGIT_DRS_DEST'}) or die; - defined($keyrings = $ENV{'DGIT_DRS_KEYRINGS'}) or die $!; - defined($policyhook = $ENV{'DGIT_DRS_POLICYHOOK'}) or die $!; open STDOUT, ">&STDERR" or die $!; eval { stunthook(); @@ -817,54 +918,28 @@ sub parseargsdispatch () { exit 0; } - $ENV{'DGIT_DRS_DISTRO'} = $distro = argval(); - $ENV{'DGIT_DRS_SUITES'} = argval(); - $ENV{'DGIT_DRS_KEYRINGS'} = argval(); - $ENV{'DGIT_DRS_REPOS'} = $dgitrepos = argval(); - $ENV{'DGIT_DRS_POLICYHOOK'} = $policyhook = argval(); - - die unless @ARGV==1 && $ARGV[0] eq '--ssh'; + $distro = $ENV{'DGIT_DRS_DISTRO'} = argval(); + my $distrodir = argval(); + $keyrings = $ENV{'DGIT_DRS_KEYRINGS'} = argval(); - my $cmd = $ENV{'SSH_ORIGINAL_COMMAND'}; - $cmd =~ m{ - ^ - (?: \S* / )? - ( [-0-9a-z]+ ) - \s+ - '? (?: \S* / )? - ($package_re) \.git - '?$ - }ox - or reject "command string not understood"; - my $method = $1; - $package = $2; - $realdestrepo = "$dgitrepos/$package.git"; - - my $funcn = $method; - $funcn =~ y/-/_/; - my $mainfunc = $main::{"main__$funcn"}; - - reject "unknown method" unless $mainfunc; - - my $lfh = lockrealtree(); + foreach my $dk (keys %indistrodir) { + ${ $indistrodir{$dk} } = "$distrodir/$dk"; + } - $policy = policyhook(FRESHREPO,'check-package',$package); - if ($policy & FRESHREPO) { - movetogarbage; + while (@ARGV && $ARGV[0] =~ m/^--([-0-9a-z]+)=/ && $indistrodir{$1}) { + ${ $indistrodir{$1} } = $'; #'; + shift @ARGV; } - close $lfh; + $ENV{"DGIT_DRS_\U$_"} = ${ $main::{$_} } foreach @hookenvs; - if (stat_exists $realdestrepo) { - $destrepo = $realdestrepo; - } else { - debug " fixmissing $funcn"; - my $fixfunc = $main::{"fixmissing__$funcn"}; - &$fixfunc; - } + die unless @ARGV==1; - debug " running main $funcn"; - &$mainfunc; + my $mode = shift @ARGV; + die unless $mode =~ m/^--(\w+)$/; + my $fn = ${*::}{"mode_$1"}; + die unless $fn; + $fn->(); } sub unlockall () {