5 # dgit-repos-server DISTRO DISTRO-DIR AUTH-SPEC [<settings>] --ssh
6 # dgit-repos-server DISTRO DISTRO-DIR AUTH-SPEC [<settings>] --cron
8 # --repos=GIT-REPOS-DIR default DISTRO-DIR/repos/
9 # --suites=SUITES-FILE default DISTRO-DIR/suites
10 # --suites-master=SUITES-FILE default DISTRO-DIR/suites-master
11 # --policy-hook=POLICY-HOOK default DISTRO-DIR/policy-hook
12 # --dgit-live=DGIT-LIVE-DIR default DISTRO-DIR/dgit-live
13 # (DISTRO-DIR is not used other than as default and to pass to policy hook)
15 # .../dgit-repos-server --pre-receive-hook PACKAGE
17 # Invoked as the ssh restricted command
19 # Works like git-receive-pack
21 # SUITES-FILE is the name of a file which lists the permissible suites
22 # one per line (#-comments and blank lines ignored). For --suites-master
23 # it is a list of the suite(s) which should, when pushed to, update
24 # `master' on the server (if fast forward).
26 # AUTH-SPEC is a :-separated list of
27 # KEYRING.GPG,AUTH-SPEC
28 # where AUTH-SPEC is one of
31 # (With --cron AUTH-SPEC is not used and may be the empty string.)
34 $SIG{__WARN__} = sub { die $_[0]; };
36 # DGIT-REPOS-DIR contains:
37 # git tree (or other object) lock (in acquisition order, outer first)
39 # _tmp/PACKAGE_prospective ! } SAME.lock, held during receive-pack
41 # _tmp/PACKAGE_incoming$$ ! } SAME.lock, held during receive-pack
42 # _tmp/PACKAGE_incoming$$_fresh ! }
44 # PACKAGE.git } PACKAGE.git.lock
45 # PACKAGE_garbage } (also covers executions of
46 # PACKAGE_garbage-old } policy hook script for PACKAGE)
47 # PACKAGE_garbage-tmp }
48 # policy* } (for policy hook script, covered by
49 # } lock only when invoked for a package)
51 # leaf locks, held during brief operaton only:
56 # _template } SAME.lock
58 # locks marked ! may be held during client data transfer
60 # What we do on push is this:
61 # - extract the destination repo name
62 # - make a hardlink clone of the destination repo
63 # - provide the destination with a stunt pre-receive hook
64 # - run actual git-receive-pack with that new destination
65 # as a result of this the stunt pre-receive hook runs; it does this:
66 # + understand what refs we are allegedly updating and
67 # check some correspondences:
68 # * we are updating only refs/tags/DISTRO/* and refs/dgit/*
69 # * and only one of each
70 # * and the tag does not already exist
72 # * recover the suite name from the destination refs/dgit/ ref
73 # + disassemble the signed tag into its various fields and signature
75 # * parsing the first line of the tag message to recover
76 # the package name, version and suite
77 # * checking that the package name corresponds to the dest repo name
78 # * checking that the suite name is as recovered above
79 # + verify the signature on the signed tag
80 # and if necessary check that the keyid and package are listed in dm.txt
81 # + check various correspondences:
82 # * the signed tag must refer to a commit
83 # * the signed tag commit must be the refs/dgit value
84 # * the name in the signed tag must correspond to its ref name
85 # * the tag name must be debian/<version> (massaged as needed)
86 # * the suite is one of those permitted
87 # * the signed tag has a suitable name
88 # * run the "push" policy hook
89 # * replay prevention for --deliberately-not-fast-forward
90 # * check the commit is a fast forward
91 # * handle a request from the policy hook for a fresh repo
92 # + push the signed tag and new dgit branch to the actual repo
94 # If the destination repo does not already exist, we need to make
95 # sure that we create it reasonably atomically, and also that
96 # we don't every have a destination repo containing no refs at all
97 # (because such a thing causes git-fetch-pack to barf). So then we
98 # do as above, except:
99 # - before starting, we take out our own lock for the destination repo
100 # - we create a prospective new destination repo by making a copy
102 # - we use the prospective new destination repo instead of the
103 # actual new destination repo (since the latter doesn't exist)
104 # - after git-receive-pack exits, we
105 # + check that the prospective repo contains a tag and head
106 # + rename the prospective destination repo into place
109 # - We are crash-only
110 # - Temporary working trees and their locks are cleaned up
111 # opportunistically by a program which tries to take each lock and
112 # if successful deletes both the tree and the lockfile
113 # - Prospective working trees and their locks are cleaned up by
114 # a program which tries to take each lock and if successful
115 # deletes any prospective working tree and the lock (but not
116 # of course any actual tree)
117 # - It is forbidden to _remove_ the lockfile without removing
118 # the corresponding temporary tree, as the lockfile is also
119 # a stampfile whose presence indicates that there may be
122 # Policy hook script is invoked like this:
123 # POLICY-HOOK-SCRIPT DISTRO DGIT-REPOS-DIR DGIT-LIVE-DIR DISTRO-DIR ACTION...
125 # POLICY-HOOK-SCRIPT ... check-list [...]
126 # POLICY-HOOK-SCRIPT ... check-package PACKAGE [...]
127 # POLICY-HOOK-SCRIPT ... push PACKAGE \
128 # VERSION SUITE TAGNAME DELIBERATELIES [...]
129 # POLICY-HOOK-SCRIPT ... push-confirm PACKAGE \
130 # VERSION SUITE TAGNAME DELIBERATELIES FRESH-REPO|'' [...]
132 # DELIBERATELIES is like this: --deliberately-foo,--deliberately-bar,...
134 # Exit status is a bitmask. Bit weight constants are defined in Dgit.pm.
136 # suppress dgit-repos-server's fast-forward check ("push" only)
138 # blow away repo right away (ie, as if before push or fetch)
139 # ("check-package" and "push" only)
140 # any unexpected bits mean failure, and then known set bits are ignored
141 # if no unexpected bits set, operation continues (subject to meaning
142 # of any expected bits set). So, eg, exit 0 means "continue normally"
143 # and would be appropriate for an unknown action.
145 # cwd for push and push-confirm is a temporary repo where the incoming
146 # objects have been received; TAGNAME is the version-based tag.
148 # FRESH-REPO is '' iff the repo for this package already existed, or
149 # the pathname of the newly-created repo which will be renamed into
150 # place if everything goes well. (NB that this is generally not the
151 # same repo as the cwd, because the objects are first received into a
152 # temporary repo so they can be examined.) In this case FRESH-REPO
153 # contains exactly the objects and refs that will appear in the
154 # destination if push-confirm approves.
156 # if push requested FRESHREPO, push-confirm happens in the old working
157 # repo and FRESH-REPO is guaranteed not to be ''.
159 # policy hook for a particular package will be invoked only once at
160 # a time - (see comments about DGIT-REPOS-DIR, above)
162 # check-list and check-package are invoked via the --cron option.
163 # First, without any locking, check-list is called. It should produce
164 # a list of package names (one per line). Then check-package will be
165 # invoked for each named package, in each case after taking an
168 # If policy hook wants to run dgit (or something else in the dgit
169 # package), it should use DGIT-LIVE-DIR/dgit (etc.), or if that is
170 # ENOENT, use the installed version.
174 use Fcntl qw(:flock);
175 use File::Path qw(rmtree);
176 use File::Temp qw(tempfile);
178 use Debian::Dgit qw(:DEFAULT :policyflags);
187 our $suitesformasterfile;
201 #----- utilities -----
203 sub realdestrepo () { "$dgitrepos/$package.git"; }
205 sub acquirelock ($$) {
206 my ($lock, $must) = @_;
208 printdebug sprintf "locking %s %d\n", $lock, $must;
211 $fh = new IO::File $lock, ">" or die "open $lock: $!";
212 my $ok = flock $fh, $must ? LOCK_EX : (LOCK_EX|LOCK_NB);
214 die "flock $lock: $!" if $must;
215 printdebug " locking $lock failed\n";
218 next unless stat_exists $lock;
219 my $want = (stat _)[1];
221 my $got = (stat _)[1];
222 last if $got == $want;
227 sub acquirermtree ($$) {
228 my ($tree, $must) = @_;
229 my $fh = acquirelock("$tree.lock", $must);
237 sub locksometree ($) {
239 acquirelock("$tree.lock", 1);
242 sub lockrealtree () {
243 locksometree(realdestrepo);
246 sub mkrepotmp () { ensuredir "$dgitrepos/_tmp" };
248 sub removedtagsfile () { "$dgitrepos/_removed-tags/$package"; }
250 sub recorderror ($) {
252 my $w = $ENV{'DGIT_DRS_WORK'}; # we are in stunthook
255 open ERR, ">", "$w/drs-error" or die $!;
256 print ERR $why, "\n" or die $!;
265 recorderror "reject: $why";
266 die "\ndgit-repos-server: reject: $why\n\n";
273 die (shellquote @_)." $? $!" if $r;
277 my ($policyallowbits, @polargs) = @_;
278 # => ($exitstatuspolicybitmap);
279 die if $policyallowbits & ~0x3e;
280 my @cmd = ($policyhook,$distro,$dgitrepos,$dgitlive,$distrodir,@polargs);
283 die "system: $!" if $r < 0;
284 die "dgit-repos-server: policy hook failed (or rejected) ($?)\n"
285 if $r & ~($policyallowbits << 8);
286 printdebug sprintf "hook => %#x\n", $r;
290 sub mkemptyrepo ($$) {
291 my ($dir,$sharedperm) = @_;
292 runcmd qw(git init --bare --quiet), "--shared=$sharedperm", $dir;
295 sub mkrepo_fromtemplate ($) {
297 my $template = "$dgitrepos/_template";
298 my $templatelock = locksometree($template);
299 printdebug "copy template $template -> $dir\n";
300 my $r = system qw(cp -a --), $template, $dir;
301 !$r or die "create new repo $dir failed: $r $!";
305 sub movetogarbage () {
306 # realdestrepo must have been locked
308 my $real = realdestrepo;
309 return unless stat_exists $real;
311 my $garbagerepo = "$dgitrepos/${package}_garbage";
312 # We arrange to always keep at least one old tree, for recovery
313 # from mistakes. This is either $garbage or $garbage-old.
314 if (stat_exists "$garbagerepo") {
315 printdebug "movetogarbage: rmtree $garbagerepo-tmp\n";
316 rmtree "$garbagerepo-tmp";
317 if (rename "$garbagerepo-old", "$garbagerepo-tmp") {
318 printdebug "movetogarbage: $garbagerepo-old -> -tmp, rmtree\n";
319 rmtree "$garbagerepo-tmp";
321 die "$garbagerepo $!" unless $!==ENOENT;
322 printdebug "movetogarbage: $garbagerepo-old -> -tmp\n";
324 printdebug "movetogarbage: $garbagerepo -> -old\n";
325 rename "$garbagerepo", "$garbagerepo-old" or die "$garbagerepo $!";
328 ensuredir "$dgitrepos/_removed-tags";
329 open PREVIOUS, ">>", removedtagsfile or die removedtagsfile." $!";
330 git_for_each_ref('refs/tags/'.debiantag('*',$distro), sub {
331 my ($objid,$objtype,$fullrefname,$reftail) = @_;
332 print PREVIOUS "\n$objid $reftail .\n" or die $!;
334 close PREVIOUS or die $!;
336 printdebug "movetogarbage: $real -> $garbagerepo\n";
337 rename $real, $garbagerepo
339 or die "$garbagerepo $!";
342 sub policy_checkpackage () {
343 my $lfh = lockrealtree();
345 $policy = policyhook(FRESHREPO,'check-package',$package);
346 if ($policy & FRESHREPO) {
353 #----- git-receive-pack -----
355 sub fixmissing__git_receive_pack () {
357 $destrepo = "$dgitrepos/_tmp/${package}_prospective";
358 acquirermtree($destrepo, 1);
359 mkrepo_fromtemplate($destrepo);
362 sub makeworkingclone () {
364 $workrepo = "$dgitrepos/_tmp/${package}_incoming$$";
365 acquirermtree($workrepo, 1);
366 my $lfh = lockrealtree();
367 runcmd qw(git clone -l -q --mirror), $destrepo, $workrepo;
369 rmtree "${workrepo}_fresh";
372 sub setupstunthook () {
373 my $prerecv = "$workrepo/hooks/pre-receive";
374 my $fh = new IO::File $prerecv, O_WRONLY|O_CREAT|O_TRUNC, 0777
375 or die "$prerecv: $!";
376 print $fh <<END or die "$prerecv: $!";
379 exec $0 --pre-receive-hook $package
381 close $fh or die "$prerecv: $!";
382 $ENV{'DGIT_DRS_WORK'}= $workrepo;
383 $ENV{'DGIT_DRS_DEST'}= $destrepo;
384 printdebug " stunt hook set up $prerecv\n";
387 sub dealwithfreshrepo () {
388 my $freshrepo = "${workrepo}_fresh";
389 return unless stat_exists $freshrepo;
390 $destrepo = $freshrepo;
393 sub maybeinstallprospective () {
394 return if $destrepo eq realdestrepo;
396 if (open REJ, "<", "$workrepo/drs-error") {
399 REJ->error and die $!;
403 $!==&ENOENT or die $!;
406 printdebug " show-ref ($destrepo) ...\n";
408 my $child = open SR, "-|";
409 defined $child or die $!;
411 chdir $destrepo or die $!;
412 exec qw(git show-ref);
415 my %got = qw(tag 0 head 0);
418 printdebug " show-refs| $_\n";
419 s/^\S*[1-9a-f]\S* (\S+)$/$1/ or die;
420 next if m{^refs/heads/master$};
422 m{^refs/tags/} ? 'tag' :
423 m{^refs/dgit/} ? 'head' :
427 $!=0; $?=0; close SR or $?==256 or die "$? $!";
429 printdebug "installprospective ?\n";
430 die Dumper(\%got)." -- missing refs in new repo"
431 if grep { !$_ } values %got;
435 if ($destrepo eq "${workrepo}_fresh") {
439 printdebug "install $destrepo => ".realdestrepo."\n";
440 rename $destrepo, realdestrepo or die $!;
441 remove realdestrepo.".lock" or die $!;
444 sub main__git_receive_pack () {
447 runcmd qw(git receive-pack), $workrepo;
449 maybeinstallprospective();
452 #----- stunt post-receive hook -----
454 our ($tagname, $tagval, $suite, $oldcommit, $commit);
455 our ($version, %tagh);
457 our ($tagexists_error);
460 printdebug " updates ...\n";
463 printdebug " upd.| $_\n";
464 m/^(\S+) (\S+) (\S+)$/ or die "$_ ?";
465 my ($old, $sha1, $refname) = ($1, $2, $3);
466 if ($refname =~ m{^refs/tags/(?=$distro/)}) {
467 reject "pushing multiple tags!" if defined $tagname;
470 $tagexists_error= "tag $tagname already exists -".
471 " not replacing previously-pushed version"
473 } elsif ($refname =~ m{^refs/dgit/}) {
474 reject "pushing multiple heads!" if defined $suite;
479 reject "pushing unexpected ref!";
482 STDIN->error and die $!;
484 reject "push is missing tag ref update" unless defined $tagname;
485 reject "push is missing head ref update" unless defined $suite;
486 printdebug " updates ok.\n";
490 printdebug " parsetag...\n";
491 open PT, ">dgit-tmp/plaintext" or die $!;
492 open DS, ">dgit-tmp/plaintext.asc" or die $!;
493 open T, "-|", qw(git cat-file tag), $tagval or die $!;
495 $!=0; $_=<T>; defined or die $!;
497 if (m/^(\S+) (.*)/) {
498 push @{ $tagh{$1} }, $2;
505 $!=0; $_=<T>; defined or die $!;
506 m/^($package_re) release (\S+) for \S+ \((\S+)\) \[dgit\]$/ or
507 reject "tag message not in expected format";
509 die unless $1 eq $package;
511 die "$3 != $suite " unless $3 eq $suite;
515 print PT $copyl or die $!;
516 $!=0; $_=<T>; defined or die "missing signature? $!";
518 if (m/^\[dgit ([^"].*)\]$/) { # [dgit "something"] is for future
521 if (s/^distro\=(\S+) //) {
522 die "$1 != $distro" unless $1 eq $distro;
523 } elsif (s/^(--deliberately-$deliberately_re) //) {
524 push @deliberatelies, $1;
525 } elsif (s/^previously:(\S+)=(\w+) //) {
526 die "previously $1 twice" if defined $previously{$1};
527 $previously{$1} = $2;
528 } elsif (s/^[-+.=0-9a-z]\S* //) {
530 die "unknown dgit info in tag ($_)";
535 last if m/^-----BEGIN PGP/;
546 printdebug " parsetag ok.\n";
549 sub checksig_keyring ($) {
550 my ($keyringfile) = @_;
551 # returns primary-keyid if signed by a key in this keyring
553 # or dies on other errors
557 printdebug " checksig keyring $keyringfile...\n";
559 our @cmd = (qw(gpgv --status-fd=1 --keyring),
561 qw(dgit-tmp/plaintext.asc dgit-tmp/plaintext));
568 next unless s/^\[GNUPG:\] //;
570 printdebug " checksig| $_\n";
571 my @l = split / /, $_;
572 if ($l[0] eq 'NO_PUBKEY') {
574 } elsif ($l[0] eq 'VALIDSIG') {
576 $sigtype eq '00' or reject "signature is not of type 00!";
578 die unless defined $ok;
584 printdebug sprintf " checksig ok=%d\n", !!$ok;
589 sub dm_txt_check ($$) {
590 my ($keyid, $dmtxtfn) = @_;
591 printdebug " dm_txt_check $keyid $dmtxtfn\n";
592 open DT, '<', $dmtxtfn or die "$dmtxtfn $!";
594 m/^fingerprint:\s+$keyid$/oi
596 if (s/^allow:/ /i..0) {
599 or reject "key $keyid missing Allow section in permissions!";
604 or reject "package $package not allowed for key $keyid";
609 printdebug " dm_txt_check allow| $_\n";
610 foreach my $p (split /\s+/) {
611 if ($p eq $package) {
613 printdebug " dm_txt_check ok\n";
618 DT->error and die $!;
620 reject "key $keyid not in permissions list although in keyring!";
624 foreach my $kas (split /:/, $keyrings) {
625 printdebug "verifytag $kas...\n";
626 $kas =~ s/^([^,]+),// or die;
627 my $keyid = checksig_keyring $1;
628 if (defined $keyid) {
629 if ($kas =~ m/^a$/) {
630 printdebug "verifytag a ok\n";
632 } elsif ($kas =~ m/^m([^,]+)$/) {
633 dm_txt_check($keyid, $1);
634 printdebug "verifytag m ok\n";
641 reject "key not found in keyrings";
644 sub suite_is_in ($) {
646 printdebug "suite_is_in ($sf)\n";
647 if (!open SUITES, "<", $sf) {
648 $!==ENOENT or die $!;
656 return 1 if $_ eq $suite;
658 die $! if SUITES->error;
663 printdebug "checksuite ($suitesfile)\n";
664 return if suite_is_in $suitesfile;
665 reject "unknown suite";
668 sub checktagnoreplay () {
669 # We need to prevent a replay attack using an earlier signed tag.
670 # We also want to archive in the history the object ids of
671 # anything we remove, even if we get rid of the actual objects.
673 # So, we check that the signed tag mentions the name and tag
676 # (a) In the case of FRESHREPO: all tags and refs/heads/* in
677 # the repo. That is, effectively, all the things we are
680 # This prevents any tag implying a FRESHREPO push
681 # being replayed into a different state of the repo.
683 # There is still the folowing risk: If a non-ff push is of a
684 # head which is an ancestor of a previous ff-only push, the
685 # previous push can be replayed.
687 # So we keep a separate list, as a file in the repo, of all
688 # the tag object ids we have ever seen and removed. Any such
689 # tag object id will be rejected even for ff-only pushes.
691 # (b) In the case of just NOFFCHECK: all tags referring to the
692 # current head for the suite (there must be at least one).
694 # This prevents any tag implying a NOFFCHECK push being
695 # replayed to rewind from a different head.
697 # The possibility of an earlier ff-only push being replayed is
698 # eliminated as follows: the tag from such a push would still
699 # be in our repo, and therefore the replayed push would be
700 # rejected because the set of refs being updated would be
703 if (!open PREVIOUS, "<", removedtagsfile) {
704 die removedtagsfile." $!" unless $!==ENOENT;
706 # Protocol for updating this file is to append to it, not
707 # write-new-and-rename. So all updates are prefixed with \n
708 # and suffixed with " .\n" so that partial writes can be
711 next unless m/^(\w+) (.*) \.\n/;
712 next unless $1 eq $tagval;
713 reject "Replay of previously-rewound upload ($tagval $2)";
715 die removedtagsfile." $!" if PREVIOUS->error;
719 return unless $policy & (FRESHREPO|NOFFCHECK);
721 my $garbagerepo = "$dgitrepos/${package}_garbage";
727 my $check_ref_previously= sub {
728 my ($objid,$objtype,$fullrefname,$reftail) = @_;
729 my $supkey = $fullrefname;
730 $supkey =~ s{^refs/}{} or die "$supkey $objid ?";
731 my $supobjid = $previously{$supkey};
732 if (!defined $supobjid) {
733 printdebug "checktagnoreply - missing\n";
734 push @problems, "does not declare previously $supkey";
735 } elsif ($supobjid ne $objid) {
736 push @problems, "declared previously $supkey=$supobjid".
737 " but actually previously $supkey=$objid";
743 if ($policy & FRESHREPO) {
744 foreach my $kind (qw(tags heads)) {
745 git_for_each_ref("refs/$kind", $check_ref_previously);
748 my $branch= server_branch($suite);
749 my $branchhead= git_get_ref(server_ref($suite));
750 if (!length $branchhead) {
751 # No such branch - NOFFCHECK was unnecessary. Oh well.
752 printdebug "checktagnoreplay - not FRESHREPO, new branch, ok\n";
754 printdebug "checktagnoreplay - not FRESHREPO,".
755 " checking for overwriting refs/$branch=$branchhead\n";
756 git_for_each_tag_referring($branchhead, sub {
757 my ($tagobjid,$refobjid,$fullrefname,$tagname) = @_;
758 $check_ref_previously->($tagobjid,undef,$fullrefname,undef);
760 printdebug "checktagnoreplay - not FRESHREPO, nchecked=$nchecked";
761 push @problems, "does not declare previously any tag".
762 " referring to branch head $branch=$branchhead"
768 reject "replay attack prevention check failed:".
769 " signed tag for $version: ".
770 join("; ", @problems).
773 printdebug "checktagnoreplay - all ok ($tagval)\n"
778 my $vals = $tagh{$tag};
779 reject "missing header $tag in signed tag object" unless $vals;
780 reject "multiple headers $tag in signed tag object" unless @$vals == 1;
785 printdebug "checks\n";
787 tagh1('type') eq 'commit' or reject "tag refers to wrong kind of object";
788 tagh1('object') eq $commit or reject "tag refers to wrong commit";
789 tagh1('tag') eq $tagname or reject "tag name in tag is wrong";
791 my $expecttagname = debiantag $version, $distro;
792 printdebug "expected tag $expecttagname\n";
793 $tagname eq $expecttagname or die;
797 @policy_args = ($package,$version,$suite,$tagname,
798 join(",",@deliberatelies));
799 $policy = policyhook(NOFFCHECK|FRESHREPO, 'push', @policy_args);
801 if (defined $tagexists_error) {
802 if ($policy & FRESHREPO) {
803 printdebug "ignoring tagexists_error: $tagexists_error\n";
805 reject $tagexists_error;
812 # check that our ref is being fast-forwarded
813 printdebug "oldcommit $oldcommit\n";
814 if (!($policy & NOFFCHECK) && $oldcommit =~ m/[^0]/) {
815 $?=0; $!=0; my $mb = `git merge-base $commit $oldcommit`;
817 $mb eq $oldcommit or reject "not fast forward on dgit branch";
819 if ($policy & FRESHREPO) {
820 # It's a bit late to be discovering this here, isn't it ?
822 # What we do is: Generate a fresh destination repo right now,
823 # and arrange to treat it from now on as if it were a
826 # The presence of this fresh destination repo is detected by
827 # the parent, which responds by making a fresh master repo
828 # from the template. (If the repo didn't already exist then
829 # $destrepo was _prospective, and we change it here. This is
830 # OK because the parent's check for _fresh persuades it not to
833 $destrepo = "${workrepo}_fresh"; # workrepo lock covers
834 mkrepo_fromtemplate $destrepo;
839 my @cmdbase = (qw(git send-pack), $destrepo);
840 push @cmdbase, qw(--force) if $policy & NOFFCHECK;
843 push @cmd, "$commit:refs/dgit/$suite",
844 "$tagval:refs/tags/$tagname";
848 !$r or die "onward push to $destrepo failed: $r $!";
850 if (suite_is_in $suitesformasterfile) {
852 push @cmd, "$commit:refs/heads/master";
854 $!=0; my $r = system @cmd;
855 # tolerate errors (might be not ff)
856 !($r & ~0xff00) or die
857 "onward push to $destrepo#master failed: $r $!";
861 sub finalisepush () {
862 if ($destrepo eq realdestrepo) {
863 policyhook(0, 'push-confirm', @policy_args, '');
866 # We are to receive the push into a new repo (perhaps
867 # because the policy push hook asked us to with FRESHREPO, or
868 # perhaps because the repo didn't exist before).
870 # We want to provide the policy push-confirm hook with a repo
871 # which looks like the one which is going to be installed.
872 # The working repo is no good because it might contain
875 # So we push the objects into the prospective new repo right
876 # away. If the hook declines, we decline, and the prospective
877 # repo is never installed.
879 policyhook(0, 'push-confirm', @policy_args, $destrepo);
884 printdebug "stunthook in $workrepo\n";
885 chdir $workrepo or die "chdir $workrepo: $!";
886 mkdir "dgit-tmp" or $!==EEXIST or die $!;
892 printdebug "stunthook done.\n";
895 #----- git-upload-pack -----
897 sub fixmissing__git_upload_pack () {
898 $destrepo = "$dgitrepos/_empty";
899 my $lfh = locksometree($destrepo);
900 return if stat_exists $destrepo;
901 rmtree "$destrepo.new";
902 mkemptyrepo "$destrepo.new", "0644";
903 rename "$destrepo.new", $destrepo or die $!;
904 unlink "$destrepo.lock" or die $!;
908 sub main__git_upload_pack () {
909 my $lfh = locksometree($destrepo);
910 printdebug "git-upload-pack in $destrepo\n";
911 chdir $destrepo or die "$destrepo: $!";
913 runcmd qw(git upload-pack), ".";
916 #----- arg parsing and main program -----
926 # keys are used for DGIT_DRS_XXX too
927 'repos' => \$dgitrepos,
928 'suites' => \$suitesfile,
929 'suites-master' => \$suitesformasterfile,
930 'policy-hook' => \$policyhook,
931 'dgit-live' => \$dgitlive,
934 our @hookenvs = qw(distro suitesfile suitesformasterfile policyhook
935 dgitlive keyrings dgitrepos distrodir);
937 # workrepo and destrepo handled ad-hoc
942 my $cmd = $ENV{'SSH_ORIGINAL_COMMAND'};
952 or reject "command string not understood";
958 my $mainfunc = $main::{"main__$funcn"};
960 reject "unknown method" unless $mainfunc;
962 policy_checkpackage();
964 if (stat_exists realdestrepo) {
965 $destrepo = realdestrepo;
967 printdebug " fixmissing $funcn\n";
968 my $fixfunc = $main::{"fixmissing__$funcn"};
972 printdebug " running main $funcn\n";
979 my $listfh = tempfile();
980 open STDOUT, ">&", $listfh or die $!;
981 policyhook(0,'check-list');
982 open STDOUT, ">&STDERR" or die $!;
984 seek $listfh, 0, 0 or die $!;
989 die unless m/^($package_re)$/;
992 policy_checkpackage();
994 die $! if $listfh->error;
997 sub parseargsdispatch () {
1000 delete $ENV{'GIT_DIR'}; # if not run via ssh, our parent git process
1001 delete $ENV{'GIT_PREFIX'}; # sets these and they mess things up
1003 if ($ENV{'DGIT_DRS_DEBUG'}) {
1007 if ($ARGV[0] eq '--pre-receive-hook') {
1010 printdebug "in stunthook ".(shellquote @ARGV)."\n";
1011 foreach my $k (sort keys %ENV) {
1012 printdebug "$k=$ENV{$k}\n" if $k =~ m/^DGIT/;
1017 $package = shift @ARGV;
1018 ${ $main::{$_} } = $ENV{"DGIT_DRS_\U$_"} foreach @hookenvs;
1019 defined($workrepo = $ENV{'DGIT_DRS_WORK'}) or die;
1020 defined($destrepo = $ENV{'DGIT_DRS_DEST'}) or die;
1021 open STDOUT, ">&STDERR" or die $!;
1026 recorderror "$@" or die;
1033 $distrodir = argval();
1034 $keyrings = argval();
1036 foreach my $dk (keys %indistrodir) {
1037 ${ $indistrodir{$dk} } = "$distrodir/$dk";
1040 while (@ARGV && $ARGV[0] =~ m/^--([-0-9a-z]+)=/ && $indistrodir{$1}) {
1041 ${ $indistrodir{$1} } = $'; #';
1045 $ENV{"DGIT_DRS_\U$_"} = ${ $main::{$_} } foreach @hookenvs;
1047 die unless @ARGV==1;
1049 my $mode = shift @ARGV;
1050 die unless $mode =~ m/^--(\w+)$/;
1051 my $fn = ${*::}{"mode_$1"};
1057 while (my $fh = pop @lockfhs) { close $fh; }
1062 if (!chdir "$dgitrepos/_tmp") {
1063 $!==ENOENT or die $!;
1066 foreach my $lf (<*.lock>) {
1068 $tree =~ s/\.lock$//;
1069 next unless acquirermtree($tree, 0);
1070 remove $lf or warn $!;
1075 parseargsdispatch();