X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=infra%2Fdgit-repos-server;h=b43d5745bfe2d472e6422543083a169027ea9ada;hp=d3d711f178ab99fda55dbe849fd77114f98b6e01;hb=e170fb0964308d97bf19f341ea79dab08f11935e;hpb=07bdd0fbd6a2cf1c0b175afe1e075bb566ed1f2c diff --git a/infra/dgit-repos-server b/infra/dgit-repos-server index d3d711f1..b43d5745 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 and to pass to policy hook) # 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,16 @@ 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 DISTRO-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|'' [...] +# +# DELIBERATELIES is like this: --deliberately-foo,--deliberately-bar,... # # Exit status is a bitmask. Bit weight constants are defined in Dgit.pm. # NOFFCHECK (2) @@ -129,28 +139,41 @@ use strict; # 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 +# cwd for push and push-confirm is a temporary repo where the incoming +# objects have been received; TAGNAME is the version-based tag. # -# if push requested FRESHREPO, push-confirm happens in said fresh repo +# 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.) In this case FRESH-REPO +# contains exactly the objects and refs that will appear in the +# destination if push-confirm approves. +# +# if push requested FRESHREPO, push-confirm happens in the old working +# 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); -open DEBUG, ">/dev/null" or die $!; +initdebug(''); our $func; our $dgitrepos; @@ -158,33 +181,33 @@ our $package; our $distro; our $suitesfile; our $policyhook; -our $realdestrepo; +our $dgitlive; +our $distrodir; our $destrepo; our $workrepo; our $keyrings; our @lockfhs; -our $debug=''; + our @deliberatelies; -our %supersedes; +our %previously; our $policy; +our @policy_args; #----- utilities ----- -sub debug { - print DEBUG "$debug @_\n"; -} +sub realdestrepo () { "$dgitrepos/$package.git"; } sub acquirelock ($$) { my ($lock, $must) = @_; my $fh; - printf DEBUG "$debug locking %s %d\n", $lock, $must; + printdebug sprintf "locking %s %d\n", $lock, $must; for (;;) { close $fh if $fh; $fh = new IO::File $lock, ">" or die "open $lock: $!"; my $ok = flock $fh, $must ? LOCK_EX : (LOCK_EX|LOCK_NB); if (!$ok) { die "flock $lock: $!" if $must; - debug " locking $lock failed"; + printdebug " locking $lock failed\n"; return undef; } next unless stat_exists $lock; @@ -212,15 +235,12 @@ sub locksometree ($) { } sub lockrealtree () { - locksometree($realdestrepo); + locksometree(realdestrepo); } -sub mkrepotmp () { - my $tmpdir = "$dgitrepos/_tmp"; - return if mkdir $tmpdir; - return if $! == EEXIST; - die $!; -} +sub mkrepotmp () { ensuredir "$dgitrepos/_tmp" }; + +sub removedtagsfile () { "$dgitrepos/_removed-tags/$package"; } sub recorderror ($) { my ($why) = @_; @@ -241,31 +261,24 @@ sub reject ($) { die "dgit-repos-server: reject: $why\n"; } -sub debugcmd { - if ($debug) { - use Data::Dumper; - local $Data::Dumper::Indent = 0; - local $Data::Dumper::Terse = 1; - debug "|".Dumper(\@_); - } -} - sub runcmd { - debugcmd @_; + debugcmd '+',@_; $!=0; $?=0; my $r = system @_; - die "@_ $? $!" if $r; + die (shellquote @_)." $? $!" if $r; } sub policyhook { my ($policyallowbits, @polargs) = @_; # => ($exitstatuspolicybitmap); die if $policyallowbits & ~0x3e; - my @cmd = ($policyhook,$distro,$dgitrepos,@polargs); - debugcmd @cmd; + my @cmd = ($policyhook,$distro,$dgitrepos,$dgitlive,$distrodir,@polargs); + debugcmd '+',@cmd; my $r = system @cmd; die "system: $!" if $r < 0; - die "hook (@cmd) failed ($?)" if $r & ~($policyallowbits << 8); + die "dgit-repos-server: policy hook failed (or rejected) ($?)\n" + if $r & ~($policyallowbits << 8); + printdebug sprintf "hook => %#x\n", $r; return $r >> 8; } @@ -278,31 +291,59 @@ sub mkrepo_fromtemplate ($) { my ($dir) = @_; my $template = "$dgitrepos/_template"; locksometree($template); - debug "copy template $template -> $dir"; + printdebug "copy template $template -> $dir\n"; my $r = system qw(cp -a --), $template, $dir; !$r or die "create new repo $dir failed: $r $!"; } sub movetogarbage () { - # $realdestrepo must have been locked + # realdestrepo must have been locked + + my $real = realdestrepo; + return unless stat_exists $real; + 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 - # $garbage or $garbage-old. + # We arrange to always keep at least one old tree, for recovery + # from mistakes. This is either $garbage or $garbage-old. if (stat_exists "$garbagerepo") { + printdebug "movetogarbage: rmtree $garbagerepo-tmp\n"; rmtree "$garbagerepo-tmp"; if (rename "$garbagerepo-old", "$garbagerepo-tmp") { + printdebug "movetogarbage: $garbagerepo-old -> -tmp, rmtree\n"; rmtree "$garbagerepo-tmp"; } else { die "$garbagerepo $!" unless $!==ENOENT; + printdebug "movetogarbage: $garbagerepo-old -> -tmp\n"; } + printdebug "movetogarbage: $garbagerepo -> -old\n"; rename "$garbagerepo", "$garbagerepo-old" or die "$garbagerepo $!"; } - rename $realdestrepo, $garbagerepo + + ensuredir "$dgitrepos/_removed-tags"; + open PREVIOUS, ">>", removedtagsfile or die removedtagsfile." $!"; + git_for_each_ref('refs/tags/'.debiantag('*'), sub { + my ($objid,$objtype,$fullrefname,$reftail) = @_; + print PREVIOUS "\n$objid $reftail .\n" or die $!; + }, $real); + close PREVIOUS or die $!; + + printdebug "movetogarbage: $real -> $garbagerepo\n"; + rename $real, $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 () { @@ -334,7 +375,7 @@ END close $fh or die "$prerecv: $!"; $ENV{'DGIT_DRS_WORK'}= $workrepo; $ENV{'DGIT_DRS_DEST'}= $destrepo; - debug " stunt hook set up $prerecv"; + printdebug " stunt hook set up $prerecv\n"; } sub dealwithfreshrepo () { @@ -344,7 +385,7 @@ sub dealwithfreshrepo () { } sub maybeinstallprospective () { - return if $destrepo eq $realdestrepo; + return if $destrepo eq realdestrepo; if (open REJ, "<", "$workrepo/drs-error") { local $/ = undef; @@ -356,7 +397,7 @@ sub maybeinstallprospective () { $!==&ENOENT or die $!; } - debug " show-ref ($destrepo) ..."; + printdebug " show-ref ($destrepo) ...\n"; my $child = open SR, "-|"; defined $child or die $!; @@ -368,7 +409,7 @@ sub maybeinstallprospective () { my %got = qw(tag 0 head 0); while () { chomp or die; - debug " show-refs| $_"; + printdebug " show-refs| $_\n"; s/^\S*[1-9a-f]\S* (\S+)$/$1/ or die; my $wh = m{^refs/tags/} ? 'tag' : @@ -378,7 +419,7 @@ sub maybeinstallprospective () { } $!=0; $?=0; close SR or $?==256 or die "$? $!"; - debug "installprospective ?"; + printdebug "installprospective ?\n"; die Dumper(\%got)." -- missing refs in new repo" if grep { !$_ } values %got; @@ -388,9 +429,9 @@ sub maybeinstallprospective () { movetogarbage; } - debug "install $destrepo => $realdestrepo"; - rename $destrepo, $realdestrepo or die $!; - remove "$destrepo.lock" or die $!; + printdebug "install $destrepo => ".realdestrepo."\n"; + rename $destrepo, realdestrepo or die $!; + remove realdestrepo.".lock" or die $!; } sub main__git_receive_pack () { @@ -406,18 +447,20 @@ sub main__git_receive_pack () { our ($tagname, $tagval, $suite, $oldcommit, $commit); our ($version, %tagh); +our ($tagexists_error); + sub readupdates () { - debug " updates ..."; + printdebug " updates ...\n"; while () { chomp or die; - debug " upd.| $_"; + printdebug " upd.| $_\n"; m/^(\S+) (\S+) (\S+)$/ or die "$_ ?"; my ($old, $sha1, $refname) = ($1, $2, $3); if ($refname =~ m{^refs/tags/(?=debian/)}) { reject "pushing multiple tags!" if defined $tagname; $tagname = $'; #'; $tagval = $sha1; - reject "tag $tagname already exists -". + $tagexists_error= "tag $tagname already exists -". " not replacing previously-pushed version" if $old =~ m/[^0]/; } elsif ($refname =~ m{^refs/dgit/}) { @@ -433,11 +476,11 @@ sub readupdates () { reject "push is missing tag ref update" unless defined $tagname; reject "push is missing head ref update" unless defined $suite; - debug " updates ok."; + printdebug " updates ok.\n"; } sub parsetag () { - debug " parsetag..."; + printdebug " parsetag...\n"; open PT, ">dgit-tmp/plaintext" or die $!; open DS, ">dgit-tmp/plaintext.asc" or die $!; open T, "-|", qw(git cat-file tag), $tagval or die $!; @@ -470,11 +513,11 @@ sub parsetag () { while (length) { if (s/^distro\=(\S+) //) { die "$1 != $distro" unless $1 eq $distro; - } elsif (s/^(--deliberately-$package_re) //) { + } elsif (s/^(--deliberately-$deliberately_re) //) { push @deliberatelies, $1; - } elsif (s/^supersede:(\S+)=(\w+) //) { - die "supersede $1 twice" if defined $supersedes{$1}; - $supersedes{$1} = $2; + } elsif (s/^previously:(\S+)=(\w+) //) { + die "previously $1 twice" if defined $previously{$1}; + $previously{$1} = $2; } elsif (s/^[-+.=0-9a-z]\S* //) { } else { die "unknown dgit info in tag ($_)"; @@ -493,7 +536,7 @@ sub parsetag () { T->error and die $!; close PT or die $!; close DS or die $!; - debug " parsetag ok."; + printdebug " parsetag ok.\n"; } sub checksig_keyring ($) { @@ -504,12 +547,12 @@ sub checksig_keyring ($) { my $ok = undef; - debug " checksig keyring $keyringfile..."; + printdebug " checksig keyring $keyringfile...\n"; our @cmd = (qw(gpgv --status-fd=1 --keyring), $keyringfile, qw(dgit-tmp/plaintext.asc dgit-tmp/plaintext)); - debugcmd @cmd; + debugcmd '|',@cmd; open P, "-|", @cmd or die $!; @@ -517,7 +560,7 @@ sub checksig_keyring ($) { while (

) { next unless s/^\[GNUPG:\] //; chomp or die; - debug " checksig| $_"; + printdebug " checksig| $_\n"; my @l = split / /, $_; if ($l[0] eq 'NO_PUBKEY') { last; @@ -531,14 +574,14 @@ sub checksig_keyring ($) { } close P; - debug sprintf " checksig ok=%d", !!$ok; + printdebug sprintf " checksig ok=%d\n", !!$ok; return $ok; } sub dm_txt_check ($$) { my ($keyid, $dmtxtfn) = @_; - debug " dm_txt_check $keyid $dmtxtfn"; + printdebug " dm_txt_check $keyid $dmtxtfn\n"; open DT, '<', $dmtxtfn or die "$dmtxtfn $!"; while (

) { m/^fingerprint:\s+$keyid$/oi @@ -556,11 +599,11 @@ sub dm_txt_check ($$) { s/\([^()]+\)//; s/\,//; chomp or die; - debug " dm_txt_check allow| $_"; + printdebug " dm_txt_check allow| $_\n"; foreach my $p (split /\s+/) { if ($p eq $package) { # yay! - debug " dm_txt_check ok"; + printdebug " dm_txt_check ok\n"; return; } } @@ -572,16 +615,16 @@ sub dm_txt_check ($$) { sub verifytag () { foreach my $kas (split /:/, $keyrings) { - debug "verifytag $kas..."; + printdebug "verifytag $kas...\n"; $kas =~ s/^([^,]+),// or die; my $keyid = checksig_keyring $1; if (defined $keyid) { if ($kas =~ m/^a$/) { - debug "verifytag a ok"; + printdebug "verifytag a ok\n"; return; # yay } elsif ($kas =~ m/^m([^,]+)$/) { dm_txt_check($keyid, $1); - debug "verifytag m ok"; + printdebug "verifytag m ok\n"; return; } else { die; @@ -592,7 +635,7 @@ sub verifytag () { } sub checksuite () { - debug "checksuite ($suitesfile)"; + printdebug "checksuite ($suitesfile)\n"; open SUITES, "<", $suitesfile or die $!; while () { chomp; @@ -606,63 +649,103 @@ sub checksuite () { } sub checktagnoreplay () { - # We check that the signed tag mentions the name and value of - # (a) in the case of FRESHREPO all tags in the repo; - # (b) in the case of just NOFFCHECK all tags referring to - # the current head for the suite (there must be at least one). - # This prevents a replay attack using an earlier signed tag. + # We need to prevent a replay attack using an earlier signed tag. + # We also want to archive in the history the object ids of + # anything we remove, even if we get rid of the actual objects. + # + # So, we check that the signed tag mentions the name and tag + # object id of: + # + # (a) In the case of FRESHREPO: all tags and refs/heads/* in + # the repo. That is, effectively, all the things we are + # deleting. + # + # This prevents any tag implying a FRESHREPO push + # being replayed into a different state of the repo. + # + # There is still the folowing risk: If a non-ff push is of a + # head which is an ancestor of a previous ff-only push, the + # previous push can be replayed. + # + # So we keep a separate list, as a file in the repo, of all + # the tag object ids we have ever seen and removed. Any such + # tag object id will be rejected even for ff-only pushes. + # + # (b) In the case of just NOFFCHECK: all tags referring to the + # current head for the suite (there must be at least one). + # + # This prevents any tag implying a NOFFCHECK push being + # replayed to rewind from a different head. + # + # The possibility of an earlier ff-only push being replayed is + # eliminated as follows: the tag from such a push would still + # be in our repo, and therefore the replayed push would be + # rejected because the set of refs being updated would be + # wrong. + + if (!open PREVIOUS, "<", removedtagsfile) { + die removedtagsfile." $!" unless $!==ENOENT; + } else { + # Protocol for updating this file is to append to it, not + # write-new-and-rename. So all updates are prefixed with \n + # and suffixed with " .\n" so that partial writes can be + # ignored. + while () { + next unless m/^(\w+) (.*) \.\n/; + next unless $1 eq $tagval; + reject "Replay of previously-rewound upload ($tagval $2)"; + } + die removedtagsfile." $!" if PREVIOUS->error; + close PREVIOUS; + } + return unless $policy & (FRESHREPO|NOFFCHECK); my $garbagerepo = "$dgitrepos/${package}_garbage"; lockrealtree(); - local $ENV{GIT_DIR}; - foreach my $garb ("$garbagerepo", "$garbagerepo-old") { - if (stat_exists $garb) { - $ENV{GIT_DIR} = $garb; - last; - } - } - if (!defined $ENV{GIT_DIR}) { - # Nothing to overwrite so the FRESHREPO and NOFFCHECK were - # pointless. Oh well. - debug "checktagnoreplay - no garbage, ok"; - return; - } + my $nchecked = 0; + my @problems; - my $onlyreferring; - if (!($policy & FRESHREPO)) { - my $branch = server_branch($suite); - $!=0; $?=0; $_ = - `git for-each-ref --format='%(objectname)' '[r]efs/$branch'`; - defined or die "$branch $? $!"; - $? and die "$branch $?"; - if (!length) { - # No such branch - NOFFCHECK was unnecessary. Oh well. - debug "checktagnoreplay - not FRESHREPO, new branch, ok"; - return; + my $check_ref_previously= sub { + my ($objid,$objtype,$fullrefname,$reftail) = @_; + my $supkey = $fullrefname; + $supkey =~ s{^refs/}{} or die "$supkey $objid ?"; + my $supobjid = $previously{$supkey}; + if (!defined $supobjid) { + printdebug "checktagnoreply - missing\n"; + push @problems, "does not declare previously $supkey"; + } elsif ($supobjid ne $objid) { + push @problems, "declared previously $supkey=$supobjid". + " but actually previously $supkey=$objid"; + } else { + $nchecked++; } - m/^(\w+)\n$/ or die "$branch $_ ?"; - $onlyreferring = $1; - debug "checktagnoreplay - not FRESHREPO,". - " checking for overwriting refs/$branch=$onlyreferring"; - } - - my @problems; + }; - git_for_each_tag_referring($onlyreferring, sub { - my ($objid,$fullrefname,$tagname) = @_; - debug "checktagnoreplay - overwriting $fullrefname=$objid"; - my $supers = $supersedes{$fullrefname}; - if (!defined $supers) { - push @problems, "does not supersede $fullrefname"; - } elsif ($supers ne $objid) { - push @problems, - "supersedes $fullrefname=$supers but previously $fullrefname=$objid"; + if ($policy & FRESHREPO) { + foreach my $kind (qw(tags heads)) { + git_for_each_ref("refs/$kind", $check_ref_previously); + } + } else { + my $branch= server_branch($suite); + my $branchhead= git_get_ref(server_ref($suite)); + if (!length $branchhead) { + # No such branch - NOFFCHECK was unnecessary. Oh well. + printdebug "checktagnoreplay - not FRESHREPO, new branch, ok\n"; } else { - # ok; + printdebug "checktagnoreplay - not FRESHREPO,". + " checking for overwriting refs/$branch=$branchhead\n"; + git_for_each_tag_referring($branchhead, sub { + my ($tagobjid,$refobjid,$fullrefname,$tagname) = @_; + $check_ref_previously->($tagobjid,undef,$fullrefname,undef); + }); + printdebug "checktagnoreplay - not FRESHREPO, nchecked=$nchecked"; + push @problems, "does not declare previously any tag". + " referring to branch head $branch=$branchhead" + unless $nchecked; } - }); + } if (@problems) { reject "replay attack prevention check failed:". @@ -670,7 +753,7 @@ sub checktagnoreplay () { join("; ", @problems). "\n"; } - debug "checktagnoreply - all ok" + printdebug "checktagnoreplay - all ok ($tagval)\n" } sub tagh1 ($) { @@ -682,7 +765,7 @@ sub tagh1 ($) { } sub checks () { - debug "checks"; + printdebug "checks\n"; tagh1('type') eq 'commit' or reject "tag refers to wrong kind of object"; tagh1('object') eq $commit or reject "tag refers to wrong commit"; @@ -691,44 +774,50 @@ sub checks () { my $v = $version; $v =~ y/~:/_%/; - debug "translated version $v"; + printdebug "translated version $v\n"; $tagname eq "debian/$v" or die; lockrealtree(); - my @policy_args = ($package,$version,$suite,$tagname, - join(",",@deliberatelies)); + @policy_args = ($package,$version,$suite,$tagname, + join(",",@deliberatelies)); $policy = policyhook(NOFFCHECK|FRESHREPO, 'push', @policy_args); + if (defined $tagexists_error) { + if ($policy & FRESHREPO) { + printdebug "ignoring tagexists_error: $tagexists_error\n"; + } else { + reject $tagexists_error; + } + } + checktagnoreplay(); checksuite(); # check that our ref is being fast-forwarded - debug "oldcommit $oldcommit"; + printdebug "oldcommit $oldcommit\n"; if (!($policy & NOFFCHECK) && $oldcommit =~ m/[^0]/) { $?=0; $!=0; my $mb = `git merge-base $commit $oldcommit`; chomp $mb; $mb eq $oldcommit or reject "not fast forward on dgit branch"; } - if ($policy & FRESHREPO) { - # This is troublesome. We have been asked by the policy hook - # to receive the push into a fresh repo. But of course we - # have actually already mostly received the push into the working - # repo. (This is unavoidable because the instruction to use a new - # repo comes ultimately from the signed tag for the dgit push, - # which has to have been received into some repo.) + # It's a bit late to be discovering this here, isn't it ? + # + # What we do is: Generate a fresh destination repo right now, + # and arrange to treat it from now on as if it were a + # prospective repo. + # + # The presence of this fresh destination repo is detected by + # the parent, which responds by making a fresh master repo + # from the template. (If the repo didn't already exist then + # $destrepo was _prospective, and we change it here. This is + # OK because the parent's check for _fresh persuades it not to + # use _prospective.) # - # So what we do is generate a fresh working repo right now and - # push the head and tag into it. The presence of this fresh - # working repo is detected by the parent, which responds by - # making a fresh master repo from the template. - $destrepo = "${workrepo}_fresh"; # workrepo lock covers mkrepo_fromtemplate $destrepo; } - - policyhook(0, 'push-confirm', @policy_args); } sub onwardpush () { @@ -736,22 +825,44 @@ sub onwardpush () { push @cmd, qw(--force) if $policy & NOFFCHECK; push @cmd, "$commit:refs/dgit/$suite", "$tagval:refs/tags/$tagname"; - debugcmd @cmd; + debugcmd '+',@cmd; $!=0; my $r = system @cmd; !$r or die "onward push to $destrepo failed: $r $!"; } +sub finalisepush () { + if ($destrepo eq realdestrepo) { + policyhook(0, 'push-confirm', @policy_args, ''); + onwardpush(); + } else { + # We are to receive the push into a new repo (perhaps + # because the policy push hook asked us to with FRESHREPO, or + # perhaps because the repo didn't exist before). + # + # We want to provide the policy push-confirm hook with a repo + # which looks like the one which is going to be installed. + # The working repo is no good because it might contain + # previous history. + # + # So we push the objects into the prospective new repo right + # away. If the hook declines, we decline, and the prospective + # repo is never installed. + onwardpush(); + policyhook(0, 'push-confirm', @policy_args, $destrepo); + } +} + sub stunthook () { - debug "stunthook"; + printdebug "stunthook in $workrepo\n"; chdir $workrepo or die "chdir $workrepo: $!"; mkdir "dgit-tmp" or $!==EEXIST or die $!; readupdates(); parsetag(); verifytag(); checks(); - onwardpush(); - debug "stunthook done."; + finalisepush(); + printdebug "stunthook done.\n"; } #----- git-upload-pack ----- @@ -769,6 +880,7 @@ sub fixmissing__git_upload_pack () { sub main__git_upload_pack () { my $lfh = locksometree($destrepo); + printdebug "git-upload-pack in $destrepo\n"; chdir $destrepo or die "$destrepo: $!"; close $lfh; runcmd qw(git upload-pack), "."; @@ -783,6 +895,77 @@ 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 distrodir); + +# 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 { + printdebug " fixmissing $funcn\n"; + my $fixfunc = $main::{"fixmissing__$funcn"}; + &$fixfunc; + } + + printdebug " running main $funcn\n"; + &$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; @@ -790,22 +973,23 @@ sub parseargsdispatch () { delete $ENV{'GIT_PREFIX'}; # sets these and they mess things up if ($ENV{'DGIT_DRS_DEBUG'}) { - $debug='='; - open DEBUG, ">&STDERR" or die $!; + enabledebug(); } if ($ARGV[0] eq '--pre-receive-hook') { - if ($debug) { $debug.="="; } + if ($debuglevel) { + $debugprefix.="="; + printdebug "in stunthook ".(shellquote @ARGV)."\n"; + foreach my $k (sort keys %ENV) { + printdebug "$k=$ENV{$k}\n" if $k =~ m/^DGIT/; + } + } 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 +1001,28 @@ sub parseargsdispatch () { exit 0; } - $ENV{'DGIT_DRS_DISTRO'} = $distro = argval(); - $ENV{'DGIT_DRS_SUITES'} = $suitesfile = argval(); - $ENV{'DGIT_DRS_KEYRINGS'} = $keyrings = argval(); - $ENV{'DGIT_DRS_REPOS'} = $dgitrepos = argval(); - $ENV{'DGIT_DRS_POLICYHOOK'} = $policyhook = argval(); + $distro = argval(); + $distrodir = argval(); + $keyrings = 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"}; - - 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 () {