4 # git protocol proxy to check dgit pushes etc.
6 # Copyright (C) 2014-2017,2019 Ian Jackson
8 # This program is free software; you can redistribute it and/or modify
9 # it under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # This program is distributed in the hope that it will be useful,
14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with this program. If not, see <http://www.gnu.org/licenses/>.
22 # dgit-repos-server DISTRO DISTRO-DIR AUTH-SPEC [<settings>] --ssh
23 # dgit-repos-server DISTRO DISTRO-DIR AUTH-SPEC [<settings>] --cron
24 # dgit-repos-server DISTRO DISTRO-DIR AUTH-SPEC [<settings>] \
25 # --tag2upload URL TAGNAME
27 # --repos=GIT-REPOS-DIR default DISTRO-DIR/repos/
28 # --suites=SUITES-FILE default DISTRO-DIR/suites
29 # --suites-master=SUITES-FILE default DISTRO-DIR/suites-master
30 # --policy-hook=POLICY-HOOK default DISTRO-DIR/policy-hook
31 # --mirror-hook=MIRROR-HOOK default DISTRO-DIR/mirror-hook
32 # --dgit-live=DGIT-LIVE-DIR default DISTRO-DIR/dgit-live
33 # (DISTRO-DIR is not used other than as default and to pass to policy
36 # .../dgit-repos-server --pre-receive-hook PACKAGE
38 # Invoked as the ssh restricted command
40 # Works like git-receive-pack
42 # SUITES-FILE is the name of a file which lists the permissible suites
43 # one per line (#-comments and blank lines ignored). For --suites-master
44 # it is a list of the suite(s) which should, when pushed to, update
45 # `master' on the server (if fast forward).
47 # AUTH-SPEC is a :-separated list of
48 # KEYRING.GPG,AUTH-SPEC
49 # where AUTH-SPEC is one of
52 # (With --cron AUTH-SPEC is not used and may be the empty string.)
58 use Debian::Dgit::Infra; # must precede Debian::Dgit; - can change @INC!
59 use Debian::Dgit qw(:DEFAULT :policyflags);
62 # DGIT-REPOS-DIR contains:
63 # git tree (or other object) lock (in acquisition order, outer first)
65 # _tmp/PACKAGE_prospective ! } SAME.lock, held during receive-pack
67 # _tmp/PACKAGE_incoming$$ ! } SAME.lock, held during receive-pack
68 # _tmp/PACKAGE_incoming$$_fresh ! }
70 # PACKAGE.git } PACKAGE.git.lock
71 # PACKAGE_garbage } (also covers executions of
72 # PACKAGE_garbage-old } policy hook script for PACKAGE)
73 # PACKAGE_garbage-tmp }
74 # policy* } (for policy hook script, covered by
75 # } lock only when invoked for a package)
77 # leaf locks, held during brief operaton only:
82 # _template } SAME.lock
84 # locks marked ! may be held during client data transfer
86 # What we do on push is this:
87 # - extract the destination repo name
88 # - make a hardlink clone of the destination repo
89 # - provide the destination with a stunt pre-receive hook
90 # - run actual git-receive-pack with that new destination
91 # as a result of this the stunt pre-receive hook runs; it does this:
92 # + understand what refs we are allegedly updating and
93 # check some correspondences:
94 # * we are updating only refs/tags/[archive/]DISTRO/* and refs/dgit/*
95 # * and only one of each
96 # * and the tag does not already exist
98 # * recover the suite name from the destination refs/dgit/ ref
99 # + disassemble the signed tag into its various fields and signature
101 # * parsing the first line of the tag message to recover
102 # the package name, version and suite
103 # * checking that the package name corresponds to the dest repo name
104 # * checking that the suite name is as recovered above
105 # + verify the signature on the signed tag
106 # and if necessary check that the keyid and package are listed in dm.txt
107 # + check various correspondences:
108 # * the signed tag must refer to a commit
109 # * the signed tag commit must be the refs/dgit value
110 # * the name in the signed tag must correspond to its ref name
111 # * the tag name must be [archive/]debian/<version> (massaged as needed)
112 # * the suite is one of those permitted
113 # * the signed tag has a suitable name
114 # * run the "push" policy hook
115 # * replay prevention for --deliberately-not-fast-forward
116 # * check the commit is a fast forward
117 # * handle a request from the policy hook for a fresh repo
118 # + push the signed tag and new dgit branch to the actual repo
120 # If the destination repo does not already exist, we need to make
121 # sure that we create it reasonably atomically, and also that
122 # we don't every have a destination repo containing no refs at all
123 # (because such a thing causes git-fetch-pack to barf). So then we
124 # do as above, except:
125 # - before starting, we take out our own lock for the destination repo
126 # - we create a prospective new destination repo by making a copy
128 # - we use the prospective new destination repo instead of the
129 # actual new destination repo (since the latter doesn't exist)
130 # - after git-receive-pack exits, we
131 # + check that the prospective repo contains a tag and head
132 # + rename the prospective destination repo into place
135 # - We are crash-only
136 # - Temporary working trees and their locks are cleaned up
137 # opportunistically by a program which tries to take each lock and
138 # if successful deletes both the tree and the lockfile
139 # - Prospective working trees and their locks are cleaned up by
140 # a program which tries to take each lock and if successful
141 # deletes any prospective working tree and the lock (but not
142 # of course any actual tree)
143 # - It is forbidden to _remove_ the lockfile without removing
144 # the corresponding temporary tree, as the lockfile is also
145 # a stampfile whose presence indicates that there may be
148 # Policy hook scripts are invoked like this:
149 # POLICY-HOOK-SCRIPT DISTRO DGIT-REPOS-DIR DGIT-LIVE-DIR DISTRO-DIR ACTION...
151 # POLICY-HOOK-SCRIPT ... check-list [...]
152 # POLICY-HOOK-SCRIPT ... check-package PACKAGE [...]
153 # POLICY-HOOK-SCRIPT ... push PACKAGE \
154 # VERSION SUITE TAGNAME DELIBERATELIES [...]
155 # POLICY-HOOK-SCRIPT ... push-confirm PACKAGE \
156 # VERSION SUITE TAGNAME DELIBERATELIES FRESH-REPO|'' [...]
158 # DELIBERATELIES is like this: --deliberately-foo,--deliberately-bar,...
160 # Exit status of policy hook is a bitmask.
161 # Bit weight constants are defined in Dgit.pm.
163 # suppress dgit-repos-server's fast-forward check ("push" only)
165 # blow away repo right away (ie, as if before push or fetch)
166 # ("check-package" and "push" only)
168 # suppress dgit-repos-server's check that commits do
169 # not lack "committer" info (eg as produced by #849041)
171 # any unexpected bits mean failure, and then known set bits are ignored
172 # if no unexpected bits set, operation continues (subject to meaning
173 # of any expected bits set). So, eg, exit 0 means "continue normally"
174 # and would be appropriate for an unknown action.
176 # cwd for push and push-confirm is a temporary repo where the incoming
177 # objects have been received; TAGNAME is the version-based tag.
179 # FRESH-REPO is '' iff the repo for this package already existed, or
180 # the pathname of the newly-created repo which will be renamed into
181 # place if everything goes well. (NB that this is generally not the
182 # same repo as the cwd, because the objects are first received into a
183 # temporary repo so they can be examined.) In this case FRESH-REPO
184 # contains exactly the objects and refs that will appear in the
185 # destination if push-confirm approves.
187 # if push requested FRESHREPO, push-confirm happens in the old working
188 # repo and FRESH-REPO is guaranteed not to be ''.
190 # policy hook for a particular package will be invoked only once at
191 # a time - (see comments about DGIT-REPOS-DIR, above)
193 # check-list and check-package are invoked via the --cron option.
194 # First, without any locking, check-list is called. It should produce
195 # a list of package names (one per line). Then check-package will be
196 # invoked for each named package, in each case after taking an
199 # If policy hook wants to run dgit (or something else in the dgit
200 # package), it should use DGIT-LIVE-DIR/dgit (etc.), or if that is
201 # ENOENT, use the installed version.
203 # Mirror hook scripts are invoked like this:
204 # MIRROR-HOOK-SCRIPT DISTRO-DIR ACTION...
205 # and currently there is only one action invoked by dgit-repos-server:
206 # MIRROR-HOOK-SCRIPT DISTRO-DIR updated-hook PACKAGE [...]
208 # Exit status of the mirror hook is advisory only. The mirror hook
209 # runs too late to do anything useful about a problem, so the only
210 # effect of a mirror hook exiting nonzero is a warning message to
211 # stderr (which the pushing user should end up seeing).
213 # If the mirror hook does not exist, it is silently skipped.
216 use Fcntl qw(:flock);
217 use File::Path qw(rmtree);
218 use File::Temp qw(tempfile);
227 our $suitesformasterfile;
242 #----- utilities -----
244 sub realdestrepo () { "$dgitrepos/$package.git"; }
246 sub acquirelock ($$) {
247 my ($lock, $must) = @_;
249 printdebug sprintf "locking %s %d\n", $lock, $must;
252 $fh = new IO::File $lock, ">" or die "open $lock: $!";
253 my $ok = flock $fh, $must ? LOCK_EX : (LOCK_EX|LOCK_NB);
255 die "flock $lock: $!" if $must;
256 printdebug " locking $lock failed\n";
259 next unless stat_exists $lock;
260 my $want = (stat _)[1];
262 my $got = (stat _)[1];
263 last if $got == $want;
268 sub acquirermtree ($$) {
269 my ($tree, $must) = @_;
270 my $fh = acquirelock("$tree.lock", $must);
278 sub locksometree ($) {
280 acquirelock("$tree.lock", 1);
283 sub lockrealtree () {
284 locksometree(realdestrepo);
287 sub mkrepotmp () { ensuredir "$dgitrepos/_tmp" };
289 sub removedtagsfile () { "$dgitrepos/_removed-tags/$package"; }
291 sub recorderror ($) {
293 my $w = $ENV{'DGIT_DRS_WORK'}; # we are in stunthook
296 open ERR, ">", "$w/drs-error" or die $!;
297 print ERR $why, "\n" or die $!;
306 recorderror "reject: $why";
307 die "\ndgit-repos-server: reject: $why\n\n";
311 my ($policyallowbits, @polargs) = @_;
312 # => ($exitstatuspolicybitmap);
313 die if $policyallowbits & ~0x3e;
314 my @cmd = ($policyhook,$distro,$dgitrepos,$dgitlive,$distrodir,@polargs);
317 die "system: $!" if $r < 0;
318 die "dgit-repos-server: policy hook failed (or rejected) ($?)\n"
319 if $r & ~($policyallowbits << 8);
320 printdebug sprintf "hook => %#x\n", $r;
324 sub mkemptyrepo ($$) {
325 my ($dir,$sharedperm) = @_;
326 runcmd qw(git init --bare --quiet), "--shared=$sharedperm", $dir;
329 sub mkrepo_fromtemplate ($) {
331 my $template = "$dgitrepos/_template";
332 my $templatelock = locksometree($template);
333 printdebug "copy template $template -> $dir\n";
334 my $r = system qw(cp -a --), $template, $dir;
335 !$r or die "create new repo $dir failed: $r $!";
339 sub movetogarbage () {
340 # realdestrepo must have been locked
342 my $real = realdestrepo;
343 return unless stat_exists $real;
345 my $garbagerepo = "$dgitrepos/${package}_garbage";
346 # We arrange to always keep at least one old tree, for recovery
347 # from mistakes. This is either $garbage or $garbage-old.
348 if (stat_exists "$garbagerepo") {
349 printdebug "movetogarbage: rmtree $garbagerepo-tmp\n";
350 rmtree "$garbagerepo-tmp";
351 if (rename "$garbagerepo-old", "$garbagerepo-tmp") {
352 printdebug "movetogarbage: $garbagerepo-old -> -tmp, rmtree\n";
353 rmtree "$garbagerepo-tmp";
355 die "$garbagerepo $!" unless $!==ENOENT;
356 printdebug "movetogarbage: $garbagerepo-old -> -tmp\n";
358 printdebug "movetogarbage: $garbagerepo -> -old\n";
359 rename "$garbagerepo", "$garbagerepo-old" or die "$garbagerepo $!";
362 ensuredir "$dgitrepos/_removed-tags";
363 open PREVIOUS, ">>", removedtagsfile or die removedtagsfile." $!";
364 git_for_each_ref([ map { 'refs/tags/'.$_ } debiantags('*',$distro) ],
366 my ($objid,$objtype,$fullrefname,$reftail) = @_;
367 print PREVIOUS "\n$objid $reftail .\n" or die $!;
369 close PREVIOUS or die $!;
371 printdebug "movetogarbage: $real -> $garbagerepo\n";
372 rename $real, $garbagerepo
374 or die "$garbagerepo $!";
377 sub policy_checkpackage () {
378 my $lfh = lockrealtree();
380 $policy = policyhook(FRESHREPO,'check-package',$package);
381 if ($policy & FRESHREPO) {
388 #----- git-receive-pack -----
390 sub fixmissing__git_receive_pack () {
392 $destrepo = "$dgitrepos/_tmp/${package}_prospective";
393 acquirermtree($destrepo, 1);
394 mkrepo_fromtemplate($destrepo);
397 sub makeworkingclone () {
399 $workrepo = "$dgitrepos/_tmp/${package}_incoming$$";
400 acquirermtree($workrepo, 1);
401 my $lfh = lockrealtree();
402 runcmd qw(git clone -l -q --mirror), $destrepo, $workrepo;
404 rmtree "${workrepo}_fresh";
408 my ($path,$contents) = @_;
409 my $fh = new IO::File $path, O_WRONLY|O_CREAT|O_TRUNC, 0777
411 print $fh $contents or die "$path: $!";
412 close $fh or die "$path: $!";
415 sub setupstunthook () {
416 my $prerecv = "$workrepo/hooks/pre-receive";
417 mkscript $prerecv, <<END;
420 exec $0 --pre-receive-hook $package
422 $ENV{'DGIT_DRS_WORK'}= $workrepo;
423 $ENV{'DGIT_DRS_DEST'}= $destrepo;
424 printdebug " stunt hook set up $prerecv\n";
427 sub dealwithfreshrepo () {
428 my $freshrepo = "${workrepo}_fresh";
429 return unless stat_exists $freshrepo;
430 $destrepo = $freshrepo;
434 my @cmd = ($mirrorhook,$distrodir,@_);
436 return unless stat_exists $mirrorhook;
440 dgit-repos-server: warning: mirror hook failed: %s
441 dgit-repos-server: push complete but may not fully visible.
443 ($r < 0 ? "exec: $!" :
444 $r == (124 << 8) ? "exited status 124 (timeout?)" :
445 !($r & ~0xff00) ? "exited ".($? >> 8) :
450 sub maybeinstallprospective () {
451 return if $destrepo eq realdestrepo;
453 if (open REJ, "<", "$workrepo/drs-error") {
456 REJ->error and die $!;
460 $!==&ENOENT or die $!;
463 printdebug " show-ref ($destrepo) ...\n";
465 my $child = open SR, "-|";
466 defined $child or die $!;
468 chdir $destrepo or die $!;
469 exec qw(git show-ref);
472 my %got = qw(newtag 0 omtag 0 head 0);
475 printdebug " show-refs| $_\n";
476 s/^\S*[1-9a-f]\S* (\S+)$/$1/ or die;
477 next if m{^refs/heads/master$};
479 m{^refs/tags/archive/} ? 'newtag' :
480 m{^refs/tags/} ? 'omtag' :
481 m{^refs/dgit/} ? 'head' :
486 $!=0; $?=0; close SR or $?==256 or die "$? $!";
488 printdebug "installprospective ?\n";
489 die Dumper(\%got)." -- missing refs in new repo"
490 unless $got{head} && grep { m/tag$/ && $got{$_} } keys %got;
494 if ($destrepo eq "${workrepo}_fresh") {
498 printdebug "install $destrepo => ".realdestrepo."\n";
499 rename $destrepo, realdestrepo or die $!;
500 remove realdestrepo.".lock" or die $!;
503 sub main__git_receive_pack () {
506 runcmd qw(git receive-pack), $workrepo;
508 maybeinstallprospective();
509 mirrorhook('updated-hook', $package);
512 #----- stunt post-receive hook -----
514 our ($tagname, $tagval, $suite, $oldcommit, $commit);
515 our ($version, %tagh);
516 our ($maint_tagname, $maint_tagval);
518 our ($tagexists_error);
521 printdebug " updates ...\n";
525 printdebug " upd.| $_\n";
526 m/^(\S+) (\S+) (\S+)$/ or die "$_ ?";
527 my ($old, $sha1, $refname) = ($1, $2, $3);
528 if ($refname =~ m{^refs/tags/(?=(?:archive/)?$distro/)}) {
531 $tagexists_error= "tag $tn already exists -".
532 " not replacing previously-pushed version"
534 } elsif ($refname =~ m{^refs/dgit/}) {
535 reject "pushing multiple heads!" if defined $suite;
540 reject "pushing unexpected ref!";
543 STDIN->error and die $!;
545 reject "push is missing tag ref update" unless %tags;
546 my @dtags = grep { m#^archive/# } keys %tags;
547 reject "need exactly one archive/* tag" if @dtags!=1;
548 my @mtags = grep { !m#^archive/# } keys %tags;
549 reject "pushing too many non-dgit tags" if @mtags>1;
551 ($maint_tagname) = @mtags;
552 $tagval = $tags{$tagname};
553 $maint_tagval = $tags{$maint_tagname // ''};
555 reject "push is missing head ref update" unless defined $suite;
556 printdebug " updates ok.\n";
560 printdebug " readtag...\n";
562 open PT, ">dgit-tmp/plaintext" or die $!;
563 open DS, ">dgit-tmp/plaintext.asc" or die $!;
564 open T, "-|", qw(git cat-file tag), $tagval or die $!;
566 $!=0; $_=<T>; defined or die $!;
568 if (m/^(\S+) (.*)/) {
569 push @{ $tagh{$1} }, $2;
576 $!=0; $_=<T>; defined or die $!;
579 sub parsetag_general ($$) {
580 my ($dgititemfn, $distrofn) = @_;
581 printdebug " parsetag...\n";
585 print PT $copyl or die $!;
586 $!=0; $_=<T>; defined or die "missing signature? $!";
588 if (m/^\[dgit ([^"].*)\]$/) { # [dgit "something"] is for future
591 if ($dgititemfn->()) {
592 } elsif (s/^distro\=(\S+) //) {
594 } elsif (s/^([-+.=0-9a-z]\S*) //) {
595 printdebug " parsetag ignoring unrecognised \`$1'\n";
597 die "unknown dgit info in tag ($_)";
602 last if m/^-----BEGIN PGP/;
614 printdebug " parsetag ok.\n";
619 m/^($package_re) release (\S+) for \S+ \((\S+)\) \[dgit\]$/ or
620 reject "tag message not in expected format";
621 die unless $1 eq $package;
623 die "$3 != $suite " unless $3 eq $suite;
625 parsetag_general sub {
626 if (s/^(--deliberately-$deliberately_re) //) {
627 push @deliberatelies, $1;
628 } elsif (s/^previously:(\S+)=(\w+) //) {
629 die "previously $1 twice" if defined $previously{$1};
630 $previously{$1} = $2;
636 my ($gotdistro) = @_;
637 die "$gotdistro != $distro" unless $gotdistro eq $distro;
641 sub checksig_keyring ($) {
642 my ($keyringfile) = @_;
643 # returns primary-keyid if signed by a key in this keyring
645 # or dies on other errors
649 printdebug " checksig keyring $keyringfile...\n";
651 our @cmd = (qw(gpgv --status-fd=1 --keyring),
653 qw(dgit-tmp/plaintext.asc dgit-tmp/plaintext));
660 next unless s/^\[GNUPG:\] //;
662 printdebug " checksig| $_\n";
663 my @l = split / /, $_;
664 if ($l[0] eq 'NO_PUBKEY') {
666 } elsif ($l[0] eq 'VALIDSIG') {
668 $sigtype eq '00' or reject "signature is not of type 00!";
670 die unless defined $ok;
676 printdebug sprintf " checksig ok=%d\n", !!$ok;
681 sub dm_txt_check ($$) {
682 my ($keyid, $dmtxtfn) = @_;
683 printdebug " dm_txt_check $keyid $dmtxtfn\n";
684 open DT, '<', $dmtxtfn or die "$dmtxtfn $!";
686 m/^fingerprint:\s+\Q$keyid\E$/oi
688 if (s/^allow:/ /i..0) {
691 or reject "key $keyid missing Allow section in permissions!";
696 or reject "package $package not allowed for key $keyid";
701 printdebug " dm_txt_check allow| $_\n";
702 foreach my $p (split /\s+/) {
703 if ($p eq $package) {
705 printdebug " dm_txt_check ok\n";
710 DT->error and die $!;
712 reject "key $keyid not in permissions list although in keyring!";
716 foreach my $kas (split /:/, $keyrings) {
717 printdebug "verifytag $kas...\n";
718 $kas =~ s/^([^,]+),// or die;
719 my $keyid = checksig_keyring $1;
720 if (defined $keyid) {
721 if ($kas =~ m/^a$/) {
722 printdebug "verifytag a ok\n";
724 } elsif ($kas =~ m/^m([^,]+)$/) {
725 dm_txt_check($keyid, $1);
726 printdebug "verifytag m ok\n";
733 reject "key not found in keyrings";
736 sub suite_is_in ($) {
738 printdebug "suite_is_in ($sf)\n";
739 if (!open SUITES, "<", $sf) {
740 $!==ENOENT or die $!;
748 return 1 if $_ eq $suite;
750 die $! if SUITES->error;
755 printdebug "checksuite ($suitesfile)\n";
756 return if suite_is_in $suitesfile;
757 reject "unknown suite";
760 sub checktagnoreplay () {
761 # We need to prevent a replay attack using an earlier signed tag.
762 # We also want to archive in the history the object ids of
763 # anything we remove, even if we get rid of the actual objects.
765 # So, we check that the signed tag mentions the name and tag
768 # (a) In the case of FRESHREPO: all tags and refs/heads/* in
769 # the repo. That is, effectively, all the things we are
772 # This prevents any tag implying a FRESHREPO push
773 # being replayed into a different state of the repo.
775 # There is still the folowing risk: If a non-ff push is of a
776 # head which is an ancestor of a previous ff-only push, the
777 # previous push can be replayed.
779 # So we keep a separate list, as a file in the repo, of all
780 # the tag object ids we have ever seen and removed. Any such
781 # tag object id will be rejected even for ff-only pushes.
783 # (b) In the case of just NOFFCHECK: all tags referring to the
784 # current head for the suite (there must be at least one).
786 # This prevents any tag implying a NOFFCHECK push being
787 # replayed to rewind from a different head.
789 # The possibility of an earlier ff-only push being replayed is
790 # eliminated as follows: the tag from such a push would still
791 # be in our repo, and therefore the replayed push would be
792 # rejected because the set of refs being updated would be
795 if (!open PREVIOUS, "<", removedtagsfile) {
796 die removedtagsfile." $!" unless $!==ENOENT;
798 # Protocol for updating this file is to append to it, not
799 # write-new-and-rename. So all updates are prefixed with \n
800 # and suffixed with " .\n" so that partial writes can be
803 next unless m/^(\w+) (.*) \.\n/;
804 next unless $1 eq $tagval;
805 reject "Replay of previously-rewound upload ($tagval $2)";
807 die removedtagsfile." $!" if PREVIOUS->error;
811 return unless $policy & (FRESHREPO|NOFFCHECK);
813 my $garbagerepo = "$dgitrepos/${package}_garbage";
819 my $check_ref_previously= sub {
820 my ($objid,$objtype,$fullrefname,$reftail) = @_;
821 my $supkey = $fullrefname;
822 $supkey =~ s{^refs/}{} or die "$supkey $objid ?";
823 my $supobjid = $previously{$supkey};
824 if (!defined $supobjid) {
825 printdebug "checktagnoreply - missing\n";
826 push @problems, "does not declare previously $supkey";
827 } elsif ($supobjid ne $objid) {
828 push @problems, "declared previously $supkey=$supobjid".
829 " but actually previously $supkey=$objid";
835 if ($policy & FRESHREPO) {
836 foreach my $kind (qw(tags heads)) {
837 git_for_each_ref("refs/$kind", $check_ref_previously);
840 my $branch= server_branch($suite);
841 my $branchhead= git_get_ref(server_ref($suite));
842 if (!length $branchhead) {
843 # No such branch - NOFFCHECK was unnecessary. Oh well.
844 printdebug "checktagnoreplay - not FRESHREPO, new branch, ok\n";
846 printdebug "checktagnoreplay - not FRESHREPO,".
847 " checking for overwriting refs/$branch=$branchhead\n";
848 git_for_each_tag_referring($branchhead, sub {
849 my ($tagobjid,$refobjid,$fullrefname,$tagname) = @_;
850 $check_ref_previously->($tagobjid,undef,$fullrefname,undef);
852 printdebug "checktagnoreplay - not FRESHREPO, nchecked=$nchecked";
853 push @problems, "does not declare previously any tag".
854 " referring to branch head $branch=$branchhead"
860 reject "replay attack prevention check failed:".
861 " signed tag for $version: ".
862 join("; ", @problems).
865 printdebug "checktagnoreplay - all ok ($tagval)\n"
870 my $vals = $tagh{$tag};
871 reject "missing header $tag in signed tag object" unless $vals;
872 reject "multiple headers $tag in signed tag object" unless @$vals == 1;
876 sub basic_tag_checks() {
877 printdebug "checks\n";
879 tagh1('type') eq 'commit' or reject "tag refers to wrong kind of object";
880 tagh1('object') eq $commit or reject "tag refers to wrong commit";
881 tagh1('tag') eq $tagname or reject "tag name in tag is wrong";
887 my @expecttagnames = debiantags($version, $distro);
888 printdebug "expected tag @expecttagnames\n";
889 grep { $tagname eq $_ } @expecttagnames or die;
891 foreach my $othertag (grep { $_ ne $tagname } @expecttagnames) {
892 reject "tag $othertag already exists -".
893 " not replacing previously-pushed version"
894 if git_get_ref "refs/tags/".$othertag;
899 @policy_args = ($package,$version,$suite,$tagname,
900 join(",",@deliberatelies));
901 $policy = policyhook(NOFFCHECK|FRESHREPO|NOCOMMITCHECK, 'push', @policy_args);
903 if (defined $tagexists_error) {
904 if ($policy & FRESHREPO) {
905 printdebug "ignoring tagexists_error: $tagexists_error\n";
907 reject $tagexists_error;
914 # check that our ref is being fast-forwarded
915 printdebug "oldcommit $oldcommit\n";
916 if (!($policy & NOFFCHECK) && $oldcommit =~ m/[^0]/) {
917 $?=0; $!=0; my $mb = `git merge-base $commit $oldcommit`;
919 $mb eq $oldcommit or reject "not fast forward on dgit branch";
922 # defend against commits generated by #849041
923 if (!($policy & NOCOMMITCHECK)) {
926 my @chk = qw(git log -z);
927 push @chk, '--pretty=tformat:%H%n'.
928 (join "", map { $_, '%n' } @checks);
929 push @chk, "^$oldcommit" if $oldcommit =~ m/[^0]/;
931 printdebug " ~NOCOMMITCHECK @chk\n";
932 open CHK, "-|", @chk or die $!;
936 m/^\w+(?=\n)/ or die;
937 reject "corrupted object $& (missing metadata)";
939 $!=0; $?=0; close CHK or $?==256 or die "$? $!";
942 if ($policy & FRESHREPO) {
943 # It's a bit late to be discovering this here, isn't it ?
945 # What we do is: Generate a fresh destination repo right now,
946 # and arrange to treat it from now on as if it were a
949 # The presence of this fresh destination repo is detected by
950 # the parent, which responds by making a fresh master repo
951 # from the template. (If the repo didn't already exist then
952 # $destrepo was _prospective, and we change it here. This is
953 # OK because the parent's check for _fresh persuades it not to
956 $destrepo = "${workrepo}_fresh"; # workrepo lock covers
957 mkrepo_fromtemplate $destrepo;
962 my @cmdbase = (qw(git send-pack), $destrepo);
963 push @cmdbase, qw(--force) if $policy & NOFFCHECK;
965 if ($ENV{GIT_QUARANTINE_PATH}) {
966 my $recv_wrapper = "$ENV{GIT_QUARANTINE_PATH}/dgit-recv-wrapper";
967 mkscript $recv_wrapper, <<'END';
970 unset GIT_QUARANTINE_PATH
971 exec git receive-pack "$@"
973 push @cmdbase, "--receive-pack=$recv_wrapper";
977 push @cmd, "$commit:refs/dgit/$suite",
978 "$tagval:refs/tags/$tagname";
979 push @cmd, "$maint_tagval:refs/tags/$maint_tagname"
980 if defined $maint_tagname;
984 !$r or die "onward push to $destrepo failed: $r $!";
986 if (suite_is_in $suitesformasterfile) {
988 push @cmd, "$commit:refs/heads/master";
990 $!=0; my $r = system @cmd;
991 # tolerate errors (might be not ff)
992 !($r & ~0xff00) or die
993 "onward push to $destrepo#master failed: $r $!";
997 sub finalisepush () {
998 if ($destrepo eq realdestrepo) {
999 policyhook(0, 'push-confirm', @policy_args, '');
1002 # We are to receive the push into a new repo (perhaps
1003 # because the policy push hook asked us to with FRESHREPO, or
1004 # perhaps because the repo didn't exist before).
1006 # We want to provide the policy push-confirm hook with a repo
1007 # which looks like the one which is going to be installed.
1008 # The working repo is no good because it might contain
1011 # So we push the objects into the prospective new repo right
1012 # away. If the hook declines, we decline, and the prospective
1013 # repo is never installed.
1015 policyhook(0, 'push-confirm', @policy_args, $destrepo);
1020 printdebug "stunthook in $workrepo\n";
1021 chdir $workrepo or die "chdir $workrepo: $!";
1022 mkdir "dgit-tmp" or $!==EEXIST or die $!;
1028 printdebug "stunthook done.\n";
1031 #----- git-upload-pack -----
1033 sub fixmissing__git_upload_pack () {
1034 $destrepo = "$dgitrepos/_empty";
1035 my $lfh = locksometree($destrepo);
1036 return if stat_exists $destrepo;
1037 rmtree "$destrepo.new";
1038 mkemptyrepo "$destrepo.new", "0644";
1039 rename "$destrepo.new", $destrepo or die $!;
1040 unlink "$destrepo.lock" or die $!;
1044 sub main__git_upload_pack () {
1045 my $lfh = locksometree($destrepo);
1046 printdebug "git-upload-pack in $destrepo\n";
1047 chdir $destrepo or die "$destrepo: $!";
1049 runcmd qw(git upload-pack), ".";
1052 #----- arg parsing and main program -----
1056 my $v = shift @ARGV;
1061 our %indistrodir = (
1062 # keys are used for DGIT_DRS_XXX too
1063 'repos' => \$dgitrepos,
1064 'suites' => \$suitesfile,
1065 'suites-master' => \$suitesformasterfile,
1066 'policy-hook' => \$policyhook,
1067 'mirror-hook' => \$mirrorhook,
1068 'dgit-live' => \$dgitlive,
1071 our @hookenvs = qw(distro suitesfile suitesformasterfile policyhook
1072 mirrorhook dgitlive keyrings dgitrepos distrodir);
1074 # workrepo and destrepo handled ad-hoc
1076 sub mode_tag2upload () {
1077 # CALLER MUST PREVENT MULTIPLE CONCURRENT RUNS IN SAME CWD
1078 # If we fail (exit nonzero), caller should capture our stderr,
1079 # and retry some bounded number of times in some appropriate way
1080 # Uses whatever ambient gpg key is available
1084 ($url,$tagval) = @ARGV;
1086 $ENV{DGIT_DRS_EMAIL_NOREPLY} // die;
1088 my $start = time // die;
1089 my @t = gmtime $start;
1091 die if $url =~ m/[^[:graph:]]/;
1092 die if $tagval =~ m/[^[:graph:]]/;
1094 open OL, ">>overall.log" or die $!;
1097 printf OL "%04d-%02d-%02d %02d:%02d:%02d (%04ds): %s %s: %s\n",
1098 $t[5] + 1900, @t[4,3,2,1,0], (time-$start), $url, $tagval, $_[0];
1102 $ENV{DGIT_DRS_ANY_URL} or $url =~ m{^https://}s
1103 or $quit->("url scheme not as expected");
1105 $tagval =~ m{^$distro/($versiontag_re)$}s
1106 or $quit->("tag name not for us");
1109 $version =~ y/_\%\#/:~/d;
1113 my $tagref = "refs/tags/$tagval";
1117 mkdir $work or die $!;
1118 mkdir 'bpd' or die $!;
1120 dif $! if <*.orig*>;
1122 runcmd qw(git init -q);
1123 runcmd qw(git remote add origin), $url;
1124 runcmd qw(git fetch --depth=1 origin), "$tagref:$tagref";
1126 mkdir 'dgit-tmp' or die $!;
1129 open T, "-|", qw(git cat-file tag), $tagval or die $!;
1132 $!=0; $_=<T>; defined or die $!;
1134 # quick and dirty check, will check properly later
1135 m/^\[dgit[^"]* please-upload(?:\]| )/m or
1136 $quit->("tag missing please-upload request");
1138 m/^tagger (.*) \d+ [-+]\d+$/m or
1139 $quit->("failed to fish tagger out of tag");
1144 m/^($package_re) release (\S+) for ($suite_re)$/ or
1145 $quit->("tag headline not for us");
1147 my $tagmversion = $2;
1151 # This is for us. From now on, we will capture errors to
1152 # be emailed to the tagger.
1154 open H, ">>dgit-tmp/tagupl.email" or die $!;
1155 print H <<END or die $!;
1156 Subject: push-to-upload failed, $package $version ($distro)
1157 X-Debian-Push-Distro: $distro
1158 X-Debian-Push-Package: $package
1160 printf H "To: %s", $tagger or die $!; # no newline
1163 open L, ">>dgit-tmp/tagupl.log" or die $!;
1165 my $child = fork() // die $!;
1168 # if child exits 0, it has called $quit->()
1169 $!=0; waitpid $child, 0 == $child or die $!;
1170 printdebug "child $child ?=$?\n";
1172 print L "execution child: ", waitstatusmsg(), "\n" or die $!;
1174 print H <<END or die $!;
1177 Processing of tag $tagval
1182 $ENV{DGIT_DRS_SENDMAIL} //= '/usr/lib/sendmail';
1185 runcmd qw(sh -ec), <<"END";
1187 cat tagupl.log >>tagupl.email
1188 $ENV{DGIT_DRS_SENDMAIL} -oee -odb -oi -t \\
1189 -f$ENV{DGIT_DRS_EMAIL_NOREPLY} \\
1192 $quit->("failed, emailed");
1195 open STDERR, ">&L" or die $!;
1196 open STDOUT, ">&STDERR" or die $!;
1197 open DEBUG, ">&STDERR" if $debuglevel;
1199 reject "version mismatch $tagmversion != $version "
1200 unless $tagmversion eq $version;
1202 my %need = map { $_ => 1 } qw(please-upload split);
1203 my ($upstreamc, $upstreamt);
1207 confess if defined $upstreamt;
1209 parsetag_general sub {
1210 if (m/^(\S+) / && exists $need{$1}) {
1213 } elsif (s/^upstream=(\w+) //) {
1215 } elsif (s/^upstream-tag=(\S+) //) {
1217 } elsif (s/^--quilt=([-+0-9a-z]+) //) {
1224 my ($gotdistro) = @_;
1225 $distro_ok ||= $gotdistro eq $distro;
1228 $quit->("not for this distro") unless $distro_ok;
1230 reject "missing \"$_\"" foreach keys %need;
1234 reject "upstream tag and not commitish, or v-v"
1235 unless defined $upstreamt == defined $upstreamc;
1238 push @dgit, $ENV{DGIT_DRS_DGIT} // 'dgit';
1240 push @dgit, "-p$package";
1241 push @dgit, '--build-products-dir=../bpd';
1244 runcmd (@dgit, qw(setup-gitattributes));
1246 my @fetch = qw(git fetch origin --unshallow);
1247 if (defined $upstreamt) {
1248 runcmd qw(git check-ref-format), "refs/tags/$upstreamt";
1249 my $utagref = "refs/tags/$upstreamt";
1250 push @fetch, "$utagref:$utagref";
1254 runcmd qw(git checkout -q), "refs/tags/$tagval";
1256 my $clogp = parsechangelog();
1259 my $got = getfield $clogp, $f;
1260 return if $got eq $exp;
1261 reject "mismatch: changelog $f $got != $exp";
1263 $clogf->('Version', $version);
1264 $clogf->('Source', $package);
1266 @fetch = (@dgit, qw(--for-push fetch), $suite);
1269 if (system @fetch) {
1270 failedcmd @fetch unless $? == 4*256;
1272 # this is just to get the orig, so we don't really care about the ref
1273 if (defined $upstreamc) {
1274 my $need_upstreamc = git_rev_parse "refs/tags/$upstreamt";
1275 $upstreamc eq $need_upstreamc or reject
1276 "upstream-commitish=$upstreamc but tag refers to $need_upstreamc";
1277 runcmd qw(git deborig), "$upstreamc";
1281 push @dgitcmd, @dgit;
1282 push @dgitcmd, qw(--force-uploading-source-only);
1283 if (defined $quilt) {
1284 push @dgitcmd, "--quilt=$quilt";
1285 if ($quilt =~ m/baredebian/) {
1286 die "needed upstream commmitish with --quilt=baredebian"
1287 unless defined $upstreamc;
1288 push @dgitcmd, "--upstream-commitish=refs/tags/$upstreamt";
1291 push @dgitcmd, qw(push-source --new --overwrite), $suite;
1301 my $cmd = $ENV{'SSH_ORIGINAL_COMMAND'};
1311 or reject "command string not understood";
1315 my $funcn = $method;
1317 my $mainfunc = $main::{"main__$funcn"};
1319 reject "unknown method" unless $mainfunc;
1321 policy_checkpackage();
1323 if (stat_exists realdestrepo) {
1324 $destrepo = realdestrepo;
1326 printdebug " fixmissing $funcn\n";
1327 my $fixfunc = $main::{"fixmissing__$funcn"};
1331 printdebug " running main $funcn\n";
1338 my $listfh = tempfile();
1339 open STDOUT, ">&", $listfh or die $!;
1340 policyhook(0,'check-list');
1341 open STDOUT, ">&STDERR" or die $!;
1343 seek $listfh, 0, 0 or die $!;
1348 die unless m/^($package_re)$/;
1351 policy_checkpackage();
1353 die $! if $listfh->error;
1356 sub parseargsdispatch () {
1359 delete $ENV{'GIT_DIR'}; # if not run via ssh, our parent git process
1360 delete $ENV{'GIT_PREFIX'}; # sets these and they mess things up
1362 if ($ENV{'DGIT_DRS_DEBUG'}) {
1366 if ($ARGV[0] eq '--pre-receive-hook') {
1369 printdebug "in stunthook ".(shellquote @ARGV)."\n";
1370 foreach my $k (sort keys %ENV) {
1371 printdebug "$k=$ENV{$k}\n" if $k =~ m/^DGIT/;
1376 $package = shift @ARGV;
1377 ${ $main::{$_} } = $ENV{"DGIT_DRS_\U$_"} foreach @hookenvs;
1378 defined($workrepo = $ENV{'DGIT_DRS_WORK'}) or die;
1379 defined($destrepo = $ENV{'DGIT_DRS_DEST'}) or die;
1380 open STDOUT, ">&STDERR" or die $!;
1385 recorderror "$@" or die;
1392 $distrodir = argval();
1393 $keyrings = argval();
1395 foreach my $dk (keys %indistrodir) {
1396 ${ $indistrodir{$dk} } = "$distrodir/$dk";
1399 while (@ARGV && $ARGV[0] =~ m/^--([-0-9a-z]+)=/ && $indistrodir{$1}) {
1400 ${ $indistrodir{$1} } = $'; #';
1404 $ENV{"DGIT_DRS_\U$_"} = ${ $main::{$_} } foreach @hookenvs;
1406 die unless @ARGV>=1;
1408 my $mode = shift @ARGV;
1409 die unless $mode =~ m/^--(\w+)$/;
1410 my $fn = ${*::}{"mode_$1"};
1416 while (my $fh = pop @lockfhs) { close $fh; }
1421 if (!chdir "$dgitrepos/_tmp") {
1422 $!==ENOENT or die $!;
1425 foreach my $lf (<*.lock>) {
1427 $tree =~ s/\.lock$//;
1428 next unless acquirermtree($tree, 0);
1429 remove $lf or warn $!;
1434 parseargsdispatch();