X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=infra%2Fdgit-repos-server;h=2be40c57c94cc50ebd8233fe0e0f23c8e4c4c9d1;hp=9c4859db4eba73f068e29d66c12d222388e95ae8;hb=2d2bbb5a3356b960f18683773c6b370bcce9660f;hpb=48f18b95adcd0f9c1d5a9a204126e845d116d44f diff --git a/infra/dgit-repos-server b/infra/dgit-repos-server index 9c4859db..2be40c57 100755 --- a/infra/dgit-repos-server +++ b/infra/dgit-repos-server @@ -2,8 +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 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 # @@ -14,13 +20,14 @@ # 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 use strict; +$SIG{__WARN__} = sub { die $_[0]; }; # DGIT-REPOS-DIR contains: # git tree (or other object) lock (in acquisition order, outer first) @@ -34,6 +41,8 @@ use strict; # PACKAGE_garbage } (also covers executions of # PACKAGE_garbage-old } policy hook script for PACKAGE) # PACKAGE_garbage-tmp } +# policy* } (for policy hook script, covered by +# } lock only when invoked for a package) # # leaf locks, held during brief operaton only: # @@ -105,6 +114,52 @@ use strict; # the corresponding temporary tree, as the lockfile is also # a stampfile whose presence indicates that there may be # cleanup to do +# +# Policy hook script is invoked like this: +# 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 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) +# suppress dgit-repos-server's fast-forward check ("push" only) +# FRESHREPO (4) +# blow away repo right away (ie, as if before push or fetch) +# ("check-package" and "push" only) +# any unexpected bits mean failure, and then known set bits are ignored +# if no unexpected bits set, operation continues (subject to meaning +# of any expected bits set). So, eg, exit 0 means "continue normally" +# and would be appropriate for an unknown action. +# +# cwd for push and push-confirm is a temporary repo where the +# 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. +# +# 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); @@ -117,9 +172,10 @@ open DEBUG, ">/dev/null" or die $!; our $func; our $dgitrepos; our $package; +our $distro; our $suitesfile; our $policyhook; -our $realdestrepo; +our $dgitlive; our $destrepo; our $workrepo; our $keyrings; @@ -135,6 +191,8 @@ sub debug { print DEBUG "$debug @_\n"; } +sub realdestrepo () { "$dgitrepos/$package.git"; } + sub acquirelock ($$) { my ($lock, $must) = @_; my $fh; @@ -173,7 +231,7 @@ sub locksometree ($) { } sub lockrealtree () { - locksometree($realdestrepo); + locksometree(realdestrepo); } sub mkrepotmp () { @@ -222,11 +280,12 @@ sub policyhook { my ($policyallowbits, @polargs) = @_; # => ($exitstatuspolicybitmap); die if $policyallowbits & ~0x3e; - my @cmd = ($policyhook,$distro,$repos,@polargs); - debugcmd @_; - my $r = system @_; + 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; } @@ -245,7 +304,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 @@ -259,20 +318,20 @@ sub movetogarbage () { } rename "$garbagerepo", "$garbagerepo-old" or die "$garbagerepo $!"; } - rename $realdestrepo, $garbagerepo + rename realdestrepo, $garbagerepo or $! == ENOENT or die "$garbagerepo $!"; } -sub onwardpush () { - my @cmd = (qw(git send-pack), $destrepo); - push @cmd, qw(--force) if $policy & NOFFCHECK; - push @cmd, "$commit:refs/dgit/$suite", - "$tagval:refs/tags/$tagname"); - debugcmd @cmd; - $!=0; - my $r = system @cmd; - !$r or die "onward push to $destrepo failed: $r $!"; +sub policy_checkpackage () { + my $lfh = lockrealtree(); + + $policy = policyhook(FRESHREPO,'check-package',$package); + if ($policy & FRESHREPO) { + movetogarbage(); + } + + close $lfh; } #----- git-receive-pack ----- @@ -316,7 +375,7 @@ sub dealwithfreshrepo () { } sub maybeinstallprospective () { - return if $destrepo eq $realdestrepo; + return if $destrepo eq realdestrepo; if (open REJ, "<", "$workrepo/drs-error") { local $/ = undef; @@ -360,8 +419,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 $!; } @@ -432,12 +491,14 @@ sub parsetag () { $version = $2; die "$3 != $suite " unless $3 eq $suite; + my $copyl = $_; for (;;) { - print PT or die $!; + print PT $copyl or die $!; $!=0; $_=; defined or die "missing signature? $!"; + $copyl = $_; if (m/^\[dgit ([^"].*)\]$/) { # [dgit "something"] is for future $_ = $1." "; - for (;;) { + while (length) { if (s/^distro\=(\S+) //) { die "$1 != $distro" unless $1 eq $distro; } elsif (s/^(--deliberately-$package_re) //) { @@ -447,13 +508,14 @@ sub parsetag () { $supersedes{$1} = $2; } elsif (s/^[-+.=0-9a-z]\S* //) { } else { - die "unknown dgit info in tag"; + die "unknown dgit info in tag ($_)"; } } next; } last if m/^-----BEGIN PGP/; } + $_ = $copyl; for (;;) { print DS or die $!; $!=0; $_=; @@ -619,7 +681,7 @@ sub checktagnoreplay () { my @problems; - git_for_each_tag_referring($objreferring, sub { + git_for_each_tag_referring($onlyreferring, sub { my ($objid,$fullrefname,$tagname) = @_; debug "checktagnoreplay - overwriting $fullrefname=$objid"; my $supers = $supersedes{$fullrefname}; @@ -666,7 +728,7 @@ sub checks () { lockrealtree(); my @policy_args = ($package,$version,$suite,$tagname, - join(",",@delberatelies)); + join(",",@deliberatelies)); $policy = policyhook(NOFFCHECK|FRESHREPO, 'push', @policy_args); checktagnoreplay(); @@ -697,7 +759,19 @@ 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 () { + my @cmd = (qw(git send-pack), $destrepo); + push @cmd, qw(--force) if $policy & NOFFCHECK; + push @cmd, "$commit:refs/dgit/$suite", + "$tagval:refs/tags/$tagname"; + debugcmd @cmd; + $!=0; + my $r = system @cmd; + !$r or die "onward push to $destrepo failed: $r $!"; } sub stunthook () { @@ -741,6 +815,55 @@ 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 parseargsdispatch () { die unless @ARGV; @@ -757,12 +880,9 @@ sub parseargsdispatch () { shift @ARGV; @ARGV == 1 or die; $package = shift @ARGV; - defined($distro = $ENV{'DGIT_DRS_DISTRO'}) 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(); @@ -774,54 +894,28 @@ sub parseargsdispatch () { exit 0; } - $ENV{'DGIT_DRS_DISTRO'} = argval(); - $ENV{'DGIT_DRS_SUITES'} = argval(); - $ENV{'DGIT_DRS_KEYRINGS'} = argval(); - $dgitrepos = argval(); - $ENV{'DGIT_DRS_POLICYHOOK'} = $policyhook = argval(); - - die unless @ARGV==1 && $ARGV[0] eq '--ssh'; - - 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"}; + $distro = $ENV{'DGIT_DRS_DISTRO'} = argval(); + my $distrodir = argval(); + $keyrings = $ENV{'DGIT_DRS_KEYRINGS'} = argval(); - 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 () {