X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=infra%2Fdgit-repos-server;h=bbf1aa215a34e054b5b4532254865365c7f6e3b4;hp=634f91edab17ee52103433f1e1790f3f92b14dba;hb=HEAD;hpb=89dfd17c9cd0a9c030083a5530ac816987431187 diff --git a/infra/dgit-repos-server b/infra/dgit-repos-server index 634f91ed..bbf1aa21 100755 --- a/infra/dgit-repos-server +++ b/infra/dgit-repos-server @@ -1,15 +1,37 @@ #!/usr/bin/perl -w # dgit-repos-server # +# git protocol proxy to check dgit pushes etc. +# +# Copyright (C) 2014-2017,2019 Ian Jackson +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + # usages: # dgit-repos-server DISTRO DISTRO-DIR AUTH-SPEC [] --ssh # dgit-repos-server DISTRO DISTRO-DIR AUTH-SPEC [] --cron +# dgit-repos-server DISTRO DISTRO-DIR AUTH-SPEC [] \ +# --tag2upload URL TAGNAME # settings # --repos=GIT-REPOS-DIR default DISTRO-DIR/repos/ # --suites=SUITES-FILE default DISTRO-DIR/suites +# --suites-master=SUITES-FILE default DISTRO-DIR/suites-master # --policy-hook=POLICY-HOOK default DISTRO-DIR/policy-hook +# --mirror-hook=MIRROR-HOOK default DISTRO-DIR/mirror-hook # --dgit-live=DGIT-LIVE-DIR default DISTRO-DIR/dgit-live -# (DISTRO-DIR is not used other than as default) +# (DISTRO-DIR is not used other than as default and to pass to policy +# and mirror hooks) # internal usage: # .../dgit-repos-server --pre-receive-hook PACKAGE # @@ -17,8 +39,10 @@ # # Works like git-receive-pack # -# SUITES is the name of a file which lists the permissible suites -# one per line (#-comments and blank lines ignored) +# SUITES-FILE is the name of a file which lists the permissible suites +# one per line (#-comments and blank lines ignored). For --suites-master +# it is a list of the suite(s) which should, when pushed to, update +# `master' on the server (if fast forward). # # AUTH-SPEC is a :-separated list of # KEYRING.GPG,AUTH-SPEC @@ -28,7 +52,12 @@ # (With --cron AUTH-SPEC is not used and may be the empty string.) use strict; -$SIG{__WARN__} = sub { die $_[0]; }; +use Carp; +use IO::Handle; + +use Debian::Dgit::Infra; # must precede Debian::Dgit; - can change @INC! +use Debian::Dgit qw(:DEFAULT :policyflags); +setup_sigwarn(); # DGIT-REPOS-DIR contains: # git tree (or other object) lock (in acquisition order, outer first) @@ -62,7 +91,7 @@ $SIG{__WARN__} = sub { die $_[0]; }; # as a result of this the stunt pre-receive hook runs; it does this: # + understand what refs we are allegedly updating and # check some correspondences: -# * we are updating only refs/tags/debian/* and refs/dgit/* +# * we are updating only refs/tags/[archive/]DISTRO/* and refs/dgit/* # * and only one of each # * and the tag does not already exist # and @@ -79,7 +108,7 @@ $SIG{__WARN__} = sub { die $_[0]; }; # * the signed tag must refer to a commit # * the signed tag commit must be the refs/dgit value # * the name in the signed tag must correspond to its ref name -# * the tag name must be debian/ (massaged as needed) +# * the tag name must be [archive/]debian/ (massaged as needed) # * the suite is one of those permitted # * the signed tag has a suitable name # * run the "push" policy hook @@ -116,8 +145,8 @@ $SIG{__WARN__} = sub { die $_[0]; }; # 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... +# Policy hook scripts are invoked like this: +# 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 [...] @@ -126,29 +155,37 @@ $SIG{__WARN__} = sub { die $_[0]; }; # 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. +# DELIBERATELIES is like this: --deliberately-foo,--deliberately-bar,... +# +# Exit status of policy hook 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) +# NOCOMMITCHECK (8) +# suppress dgit-repos-server's check that commits do +# not lack "committer" info (eg as produced by #849041) +# ("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 +# cwd for push and push-confirm is a temporary repo where the incoming +# 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.) +# 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 said fresh repo -# and FRESH-REPO is guaranteed not to be ''. +# 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) @@ -160,16 +197,26 @@ $SIG{__WARN__} = sub { die $_[0]; }; # appropriate lock. # # If policy hook wants to run dgit (or something else in the dgit -# package), it should use DGIT-LIVE-DIR/dgit (etc.) - +# package), it should use DGIT-LIVE-DIR/dgit (etc.), or if that is +# ENOENT, use the installed version. +# +# Mirror hook scripts are invoked like this: +# MIRROR-HOOK-SCRIPT DISTRO-DIR ACTION... +# and currently there is only one action invoked by dgit-repos-server: +# MIRROR-HOOK-SCRIPT DISTRO-DIR updated-hook PACKAGE [...] +# +# Exit status of the mirror hook is advisory only. The mirror hook +# runs too late to do anything useful about a problem, so the only +# effect of a mirror hook exiting nonzero is a warning message to +# stderr (which the pushing user should end up seeing). +# +# If the mirror hook does not exist, it is silently skipped. use POSIX; use Fcntl qw(:flock); use File::Path qw(rmtree); use File::Temp qw(tempfile); -use Debian::Dgit qw(:DEFAULT :policyflags); - initdebug(''); our $func; @@ -177,16 +224,20 @@ our $dgitrepos; our $package; our $distro; our $suitesfile; +our $suitesformasterfile; our $policyhook; +our $mirrorhook; our $dgitlive; +our $distrodir; our $destrepo; our $workrepo; our $keyrings; our @lockfhs; our @deliberatelies; -our %supersedes; +our %previously; our $policy; +our @policy_args; #----- utilities ----- @@ -233,12 +284,9 @@ sub lockrealtree () { 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) = @_; @@ -256,25 +304,18 @@ sub recorderror ($) { sub reject ($) { my ($why) = @_; recorderror "reject: $why"; - die "dgit-repos-server: reject: $why\n"; -} - -sub runcmd { - debugcmd '+',@_; - $!=0; $?=0; - my $r = system @_; - die (shellquote @_)." $? $!" if $r; + die "\ndgit-repos-server: reject: $why\n\n"; } sub policyhook { my ($policyallowbits, @polargs) = @_; # => ($exitstatuspolicybitmap); die if $policyallowbits & ~0x3e; - my @cmd = ($policyhook,$distro,$dgitrepos,$dgitlive,@polargs); - debugcmd '+',@cmd; + my @cmd = ($policyhook,$distro,$dgitrepos,$dgitlive,$distrodir,@polargs); + debugcmd '+M',@cmd; my $r = system @cmd; die "system: $!" if $r < 0; - die "hook (".(shellquote @cmd).") failed ($?)" + die "dgit-repos-server: policy hook failed (or rejected) ($?)\n" if $r & ~($policyallowbits << 8); printdebug sprintf "hook => %#x\n", $r; return $r >> 8; @@ -288,18 +329,22 @@ sub mkemptyrepo ($$) { sub mkrepo_fromtemplate ($) { my ($dir) = @_; my $template = "$dgitrepos/_template"; - locksometree($template); + my $templatelock = locksometree($template); printdebug "copy template $template -> $dir\n"; my $r = system qw(cp -a --), $template, $dir; !$r or die "create new repo $dir failed: $r $!"; + close $templatelock; } sub movetogarbage () { # 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"; @@ -313,7 +358,16 @@ sub movetogarbage () { printdebug "movetogarbage: $garbagerepo -> -old\n"; rename "$garbagerepo", "$garbagerepo-old" or die "$garbagerepo $!"; } - my $real = realdestrepo; + + ensuredir "$dgitrepos/_removed-tags"; + open PREVIOUS, ">>", removedtagsfile or die removedtagsfile." $!"; + git_for_each_ref([ map { 'refs/tags/'.$_ } debiantags('*',$distro) ], + 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 @@ -350,16 +404,21 @@ sub makeworkingclone () { rmtree "${workrepo}_fresh"; } +sub mkscript ($$) { + my ($path,$contents) = @_; + my $fh = new IO::File $path, O_WRONLY|O_CREAT|O_TRUNC, 0777 + or die "$path: $!"; + print $fh $contents or die "$path: $!"; + close $fh or die "$path: $!"; +} + sub setupstunthook () { my $prerecv = "$workrepo/hooks/pre-receive"; - my $fh = new IO::File $prerecv, O_WRONLY|O_CREAT|O_TRUNC, 0777 - or die "$prerecv: $!"; - print $fh <> 8) : + "wait status $?"); + } +} + sub maybeinstallprospective () { return if $destrepo eq realdestrepo; @@ -393,22 +469,25 @@ sub maybeinstallprospective () { exec qw(git show-ref); die $!; } - my %got = qw(tag 0 head 0); + my %got = qw(newtag 0 omtag 0 head 0); while () { chomp or die; printdebug " show-refs| $_\n"; s/^\S*[1-9a-f]\S* (\S+)$/$1/ or die; + next if m{^refs/heads/master$}; my $wh = - m{^refs/tags/} ? 'tag' : + m{^refs/tags/archive/} ? 'newtag' : + m{^refs/tags/} ? 'omtag' : m{^refs/dgit/} ? 'head' : die; + use Data::Dumper; die if $got{$wh}++; } $!=0; $?=0; close SR or $?==256 or die "$? $!"; printdebug "installprospective ?\n"; die Dumper(\%got)." -- missing refs in new repo" - if grep { !$_ } values %got; + unless $got{head} && grep { m/tag$/ && $got{$_} } keys %got; lockrealtree(); @@ -418,7 +497,7 @@ sub maybeinstallprospective () { printdebug "install $destrepo => ".realdestrepo."\n"; rename $destrepo, realdestrepo or die $!; - remove "$destrepo.lock" or die $!; + remove realdestrepo.".lock" or die $!; } sub main__git_receive_pack () { @@ -427,25 +506,29 @@ sub main__git_receive_pack () { runcmd qw(git receive-pack), $workrepo; dealwithfreshrepo(); maybeinstallprospective(); + mirrorhook('updated-hook', $package); } #----- stunt post-receive hook ----- our ($tagname, $tagval, $suite, $oldcommit, $commit); our ($version, %tagh); +our ($maint_tagname, $maint_tagval); + +our ($tagexists_error); sub readupdates () { printdebug " updates ...\n"; + my %tags; while () { chomp or die; 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 -". + if ($refname =~ m{^refs/tags/(?=(?:archive/)?$distro/)}) { + my $tn = $'; #'; + $tags{$tn} = $sha1; + $tagexists_error= "tag $tn already exists -". " not replacing previously-pushed version" if $old =~ m/[^0]/; } elsif ($refname =~ m{^refs/dgit/}) { @@ -459,13 +542,23 @@ sub readupdates () { } STDIN->error and die $!; - reject "push is missing tag ref update" unless defined $tagname; + reject "push is missing tag ref update" unless %tags; + my @dtags = grep { m#^archive/# } keys %tags; + reject "need exactly one archive/* tag" if @dtags!=1; + my @mtags = grep { !m#^archive/# } keys %tags; + reject "pushing too many non-dgit tags" if @mtags>1; + ($tagname) = @dtags; + ($maint_tagname) = @mtags; + $tagval = $tags{$tagname}; + $maint_tagval = $tags{$maint_tagname // ''}; + reject "push is missing head ref update" unless defined $suite; printdebug " updates ok.\n"; } -sub parsetag () { - printdebug " parsetag...\n"; +sub readtag () { + printdebug " readtag...\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 $!; @@ -481,12 +574,11 @@ sub parsetag () { } } $!=0; $_=; defined or die $!; - m/^($package_re) release (\S+) for \S+ \((\S+)\) \[dgit\]$/ or - reject "tag message not in expected format"; +} - die unless $1 eq $package; - $version = $2; - die "$3 != $suite " unless $3 eq $suite; +sub parsetag_general ($$) { + my ($dgititemfn, $distrofn) = @_; + printdebug " parsetag...\n"; my $copyl = $_; for (;;) { @@ -496,14 +588,11 @@ sub parsetag () { if (m/^\[dgit ([^"].*)\]$/) { # [dgit "something"] is for future $_ = $1." "; while (length) { - if (s/^distro\=(\S+) //) { - die "$1 != $distro" unless $1 eq $distro; - } elsif (s/^(--deliberately-$package_re) //) { - push @deliberatelies, $1; - } elsif (s/^supersede:(\S+)=(\w+) //) { - die "supersede $1 twice" if defined $supersedes{$1}; - $supersedes{$1} = $2; - } elsif (s/^[-+.=0-9a-z]\S* //) { + if ($dgititemfn->()) { + } elsif (s/^distro\=(\S+) //) { + $distrofn->($1); + } elsif (s/^([-+.=0-9a-z]\S*) //) { + printdebug " parsetag ignoring unrecognised \`$1'\n"; } else { die "unknown dgit info in tag ($_)"; } @@ -512,6 +601,7 @@ sub parsetag () { } last if m/^-----BEGIN PGP/; } + $_ = $copyl; for (;;) { print DS or die $!; @@ -524,6 +614,30 @@ sub parsetag () { printdebug " parsetag ok.\n"; } +sub parsetag () { + readtag(); + m/^($package_re) release (\S+) for \S+ \((\S+)\) \[dgit\]$/ or + reject "tag message not in expected format"; + die unless $1 eq $package; + $version = $2; + die "$3 != $suite " unless $3 eq $suite; + + parsetag_general sub { + if (s/^(--deliberately-$deliberately_re) //) { + push @deliberatelies, $1; + } elsif (s/^previously:(\S+)=(\w+) //) { + die "previously $1 twice" if defined $previously{$1}; + $previously{$1} = $2; + } else { + return 0; + } + return 1; + }, sub { + my ($gotdistro) = @_; + die "$gotdistro != $distro" unless $gotdistro eq $distro; + }; +} + sub checksig_keyring ($) { my ($keyringfile) = @_; # returns primary-keyid if signed by a key in this keyring @@ -569,7 +683,7 @@ sub dm_txt_check ($$) { printdebug " dm_txt_check $keyid $dmtxtfn\n"; open DT, '<', $dmtxtfn or die "$dmtxtfn $!"; while (
) { - m/^fingerprint:\s+$keyid$/oi + m/^fingerprint:\s+\Q$keyid\E$/oi ..0 or next; if (s/^allow:/ /i..0) { } else { @@ -619,78 +733,128 @@ sub verifytag () { reject "key not found in keyrings"; } -sub checksuite () { - printdebug "checksuite ($suitesfile)\n"; - open SUITES, "<", $suitesfile or die $!; +sub suite_is_in ($) { + my ($sf) = @_; + printdebug "suite_is_in ($sf)\n"; + if (!open SUITES, "<", $sf) { + $!==ENOENT or die $!; + return 0; + } while () { chomp; next unless m/\S/; next if m/^\#/; s/\s+$//; - return if $_ eq $suite; + return 1 if $_ eq $suite; } die $! if SUITES->error; + return 0; +} + +sub checksuite () { + printdebug "checksuite ($suitesfile)\n"; + return if suite_is_in $suitesfile; reject "unknown suite"; } 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 overwrite 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; + my $nchecked = 0; + my @problems; + + 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++; } - } - if (!defined $ENV{GIT_DIR}) { - # Nothing to overwrite so the FRESHREPO and NOFFCHECK were - # pointless. Oh well. - printdebug "checktagnoreplay - no garbage, ok\n"; - return; - } + }; - 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) { + 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"; - return; - } - m/^(\w+)\n$/ or die "$branch $_ ?"; - $onlyreferring = $1; - printdebug "checktagnoreplay - not FRESHREPO,". - " checking for overwriting refs/$branch=$onlyreferring\n"; - } - - my @problems; - - git_for_each_tag_referring($onlyreferring, sub { - my ($objid,$fullrefname,$tagname) = @_; - printdebug "checktagnoreplay - overwriting $fullrefname=$objid\n"; - 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"; } 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:". @@ -698,7 +862,7 @@ sub checktagnoreplay () { join("; ", @problems). "\n"; } - printdebug "checktagnoreply - all ok\n" + printdebug "checktagnoreplay - all ok ($tagval)\n" } sub tagh1 ($) { @@ -709,24 +873,40 @@ sub tagh1 ($) { return $vals->[0]; } -sub checks () { +sub basic_tag_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"; tagh1('tag') eq $tagname or reject "tag name in tag is wrong"; +} - my $v = $version; - $v =~ y/~:/_%/; +sub checks () { + basic_tag_checks(); - printdebug "translated version $v\n"; - $tagname eq "debian/$v" or die; + my @expecttagnames = debiantags($version, $distro); + printdebug "expected tag @expecttagnames\n"; + grep { $tagname eq $_ } @expecttagnames or die; + + foreach my $othertag (grep { $_ ne $tagname } @expecttagnames) { + reject "tag $othertag already exists -". + " not replacing previously-pushed version" + if git_get_ref "refs/tags/".$othertag; + } lockrealtree(); - my @policy_args = ($package,$version,$suite,$tagname, - join(",",@deliberatelies)); - $policy = policyhook(NOFFCHECK|FRESHREPO, 'push', @policy_args); + @policy_args = ($package,$version,$suite,$tagname, + join(",",@deliberatelies)); + $policy = policyhook(NOFFCHECK|FRESHREPO|NOCOMMITCHECK, 'push', @policy_args); + + if (defined $tagexists_error) { + if ($policy & FRESHREPO) { + printdebug "ignoring tagexists_error: $tagexists_error\n"; + } else { + reject $tagexists_error; + } + } checktagnoreplay(); checksuite(); @@ -739,36 +919,101 @@ sub checks () { $mb eq $oldcommit or reject "not fast forward on dgit branch"; } + # defend against commits generated by #849041 + if (!($policy & NOCOMMITCHECK)) { + my @checks = qw(%at + %ct); + my @chk = qw(git log -z); + push @chk, '--pretty=tformat:%H%n'. + (join "", map { $_, '%n' } @checks); + push @chk, "^$oldcommit" if $oldcommit =~ m/[^0]/; + push @chk, $commit;; + printdebug " ~NOCOMMITCHECK @chk\n"; + open CHK, "-|", @chk or die $!; + local $/ = "\0"; + while () { + next unless m/^$/m; + m/^\w+(?=\n)/ or die; + reject "corrupted object $& (missing metadata)"; + } + $!=0; $?=0; close CHK or $?==256 or die "$? $!"; + } + 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; } - - 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; + my @cmdbase = (qw(git send-pack), $destrepo); + push @cmdbase, qw(--force) if $policy & NOFFCHECK; + + if ($ENV{GIT_QUARANTINE_PATH}) { + my $recv_wrapper = "$ENV{GIT_QUARANTINE_PATH}/dgit-recv-wrapper"; + mkscript $recv_wrapper, <<'END'; +#!/bin/sh +set -e +unset GIT_QUARANTINE_PATH +exec git receive-pack "$@" +END + push @cmdbase, "--receive-pack=$recv_wrapper"; + } + + my @cmd = @cmdbase; push @cmd, "$commit:refs/dgit/$suite", "$tagval:refs/tags/$tagname"; + push @cmd, "$maint_tagval:refs/tags/$maint_tagname" + if defined $maint_tagname; debugcmd '+',@cmd; $!=0; my $r = system @cmd; !$r or die "onward push to $destrepo failed: $r $!"; + + if (suite_is_in $suitesformasterfile) { + @cmd = @cmdbase; + push @cmd, "$commit:refs/heads/master"; + debugcmd '+', @cmd; + $!=0; my $r = system @cmd; + # tolerate errors (might be not ff) + !($r & ~0xff00) or die + "onward push to $destrepo#master 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 () { @@ -779,7 +1024,7 @@ sub stunthook () { parsetag(); verifytag(); checks(); - onwardpush(); + finalisepush(); printdebug "stunthook done.\n"; } @@ -817,14 +1062,239 @@ our %indistrodir = ( # keys are used for DGIT_DRS_XXX too 'repos' => \$dgitrepos, 'suites' => \$suitesfile, + 'suites-master' => \$suitesformasterfile, 'policy-hook' => \$policyhook, + 'mirror-hook' => \$mirrorhook, 'dgit-live' => \$dgitlive, ); -our @hookenvs = qw(distro suitesfile policyhook dgitlive keyrings dgitrepos); +our @hookenvs = qw(distro suitesfile suitesformasterfile policyhook + mirrorhook dgitlive keyrings dgitrepos distrodir); # workrepo and destrepo handled ad-hoc +sub mode_tag2upload () { + # CALLER MUST PREVENT MULTIPLE CONCURRENT RUNS IN SAME CWD + # If we fail (exit nonzero), caller should capture our stderr, + # and retry some bounded number of times in some appropriate way + # Uses whatever ambient gpg key is available + @ARGV==2 or die; + + my $url; + ($url,$tagval) = @ARGV; + + $ENV{DGIT_DRS_EMAIL_NOREPLY} // die; + + my $start = time // die; + my @t = gmtime $start; + + die if $url =~ m/[^[:graph:]]/; + die if $tagval =~ m/[^[:graph:]]/; + + open OL, ">>overall.log" or die $!; + autoflush OL 1; + my $quit = sub { + printf OL "%04d-%02d-%02d %02d:%02d:%02d (%04ds): %s %s: %s\n", + $t[5] + 1900, @t[4,3,2,1,0], (time-$start), $url, $tagval, $_[0]; + exit 0; + }; + + $ENV{DGIT_DRS_ANY_URL} or $url =~ m{^https://}s + or $quit->("url scheme not as expected"); + + $tagval =~ m{^$distro/($versiontag_re)$}s + or $quit->("tag name not for us"); + + $version = $1; + $version =~ y/_\%\#/:~/d; + + my $work = 'work'; + + my $tagref = "refs/tags/$tagval"; + + rmtree $work; + rmtree 'bpd'; + mkdir $work or die $!; + mkdir 'bpd' or die $!; + unlink <*.orig*>; + dif $! if <*.orig*>; + changedir $work; + runcmd qw(git init -q); + runcmd qw(git remote add origin), $url; + runcmd qw(git fetch --depth=1 origin), "$tagref:$tagref"; + changedir ".git"; + mkdir 'dgit-tmp' or die $!; + + my $tagger; + open T, "-|", qw(git cat-file tag), $tagval or die $!; + { + local $/ = undef; + $!=0; $_=; defined or die $!; + + # quick and dirty check, will check properly later + m/^\[dgit[^"]* please-upload(?:\]| )/m or + $quit->("tag missing please-upload request"); + + m/^tagger (.*) \d+ [-+]\d+$/m or + $quit->("failed to fish tagger out of tag"); + $tagger = $1; + }; + + readtag(); + m/^($package_re) release (\S+) for ($suite_re)$/ or + $quit->("tag headline not for us"); + $package = $1; + my $tagmversion = $2; + $suite = $3; + + + # This is for us. From now on, we will capture errors to + # be emailed to the tagger. + + open H, ">>dgit-tmp/tagupl.email" or die $!; + print H <>dgit-tmp/tagupl.log" or die $!; + + my $child = fork() // die $!; + if ($child) { + # we are the parent + # if child exits 0, it has called $quit->() + $!=0; waitpid $child, 0 == $child or die $!; + printdebug "child $child ?=$?\n"; + exit 0 unless $?; + print L "execution child: ", waitstatusmsg(), "\n" or die $!; + close L or die $!; + print H <>tagupl.email + $ENV{DGIT_DRS_SENDMAIL} -oee -odb -oi -t \\ + -f$ENV{DGIT_DRS_EMAIL_NOREPLY} \\ + ("failed, emailed"); + } + + open STDERR, ">&L" or die $!; + open STDOUT, ">&STDERR" or die $!; + open DEBUG, ">&STDERR" if $debuglevel; + + reject "version mismatch $tagmversion != $version " + unless $tagmversion eq $version; + + my %need = map { $_ => 1 } qw(please-upload split); + my ($upstreamc, $upstreamt); + my $quilt; + my $distro_ok; + + confess if defined $upstreamt; + + parsetag_general sub { + if (m/^(\S+) / && exists $need{$1}) { + $_ = $'; + delete $need{$1}; + } elsif (s/^upstream=(\w+) //) { + $upstreamc = $1; + } elsif (s/^upstream-tag=(\S+) //) { + $upstreamt = $1; + } elsif (s/^--quilt=([-+0-9a-z]+) //) { + $quilt = $1; + } else { + return 0; + } + return 1; + }, sub { + my ($gotdistro) = @_; + $distro_ok ||= $gotdistro eq $distro; + }; + + $quit->("not for this distro") unless $distro_ok; + + reject "missing \"$_\"" foreach keys %need; + + verifytag(); + + reject "upstream tag and not commitish, or v-v" + unless defined $upstreamt == defined $upstreamc; + + my @dgit; + push @dgit, $ENV{DGIT_DRS_DGIT} // 'dgit'; + push @dgit, '-wn'; + push @dgit, "-p$package"; + push @dgit, '--build-products-dir=../bpd'; + + changedir ".."; + runcmd (@dgit, qw(setup-gitattributes)); + + my @fetch = qw(git fetch origin --unshallow); + if (defined $upstreamt) { + runcmd qw(git check-ref-format), "refs/tags/$upstreamt"; + my $utagref = "refs/tags/$upstreamt"; + push @fetch, "$utagref:$utagref"; + } + runcmd @fetch; + + runcmd qw(git checkout -q), "refs/tags/$tagval"; + + my $clogp = parsechangelog(); + my $clogf = sub { + my ($f, $exp) = @_; + my $got = getfield $clogp, $f; + return if $got eq $exp; + reject "mismatch: changelog $f $got != $exp"; + }; + $clogf->('Version', $version); + $clogf->('Source', $package); + + @fetch = (@dgit, qw(--for-push fetch), $suite); + debugcmd "+",@_; + $!=0; $?=-1; + if (system @fetch) { + failedcmd @fetch unless $? == 4*256; + } + # this is just to get the orig, so we don't really care about the ref + if (defined $upstreamc) { + my $need_upstreamc = git_rev_parse "refs/tags/$upstreamt"; + $upstreamc eq $need_upstreamc or reject + "upstream-commitish=$upstreamc but tag refers to $need_upstreamc"; + runcmd qw(git deborig), "$upstreamc"; + } + + my @dgitcmd; + push @dgitcmd, @dgit; + push @dgitcmd, qw(--force-uploading-source-only); + if (defined $quilt) { + push @dgitcmd, "--quilt=$quilt"; + if ($quilt =~ m/baredebian/) { + die "needed upstream commmitish with --quilt=baredebian" + unless defined $upstreamc; + push @dgitcmd, "--upstream-commitish=refs/tags/$upstreamt"; + } + } + push @dgitcmd, qw(push-source --new --overwrite), $suite; + + runcmd @dgitcmd; + + $quit->('done'); +} + sub mode_ssh () { die if @ARGV; @@ -918,9 +1388,9 @@ sub parseargsdispatch () { exit 0; } - $distro = $ENV{'DGIT_DRS_DISTRO'} = argval(); - my $distrodir = argval(); - $keyrings = $ENV{'DGIT_DRS_KEYRINGS'} = argval(); + $distro = argval(); + $distrodir = argval(); + $keyrings = argval(); foreach my $dk (keys %indistrodir) { ${ $indistrodir{$dk} } = "$distrodir/$dk"; @@ -933,7 +1403,7 @@ sub parseargsdispatch () { $ENV{"DGIT_DRS_\U$_"} = ${ $main::{$_} } foreach @hookenvs; - die unless @ARGV==1; + die unless @ARGV>=1; my $mode = shift @ARGV; die unless $mode =~ m/^--(\w+)$/;