5 # .../dgit-repos-server DISTRO SUITES KEYRING-AUTH-SPEC \
6 # DGIT-REPOS-DIR POLICY-HOOK-SCRIPT --ssh
8 # .../dgit-repos-server --pre-receive-hook PACKAGE
10 # Invoked as the ssh restricted command
12 # Works like git-receive-pack
14 # SUITES is the name of a file which lists the permissible suites
15 # one per line (#-comments and blank lines ignored)
17 # KEYRING-AUTH-SPEC is a :-separated list of
18 # KEYRING.GPG,AUTH-SPEC
19 # where AUTH-SPEC is one of
26 # - extract the destination repo name
27 # - make a hardlink clone of the destination repo
28 # - provide the destination with a stunt pre-receive hook
29 # - run actual git-receive-pack with that new destination
30 # as a result of this the stunt pre-receive hook runs; it does this:
31 # + understand what refs we are allegedly updating and
32 # check some correspondences:
33 # * we are updating only refs/tags/debian/* and refs/dgit/*
34 # * and only one of each
35 # * and the tag does not already exist
37 # * recover the suite name from the destination refs/dgit/ ref
38 # + disassemble the signed tag into its various fields and signature
40 # * parsing the first line of the tag message to recover
41 # the package name, version and suite
42 # * checking that the package name corresponds to the dest repo name
43 # * checking that the suite name is as recovered above
44 # + verify the signature on the signed tag
45 # and if necessary check that the keyid and package are listed in dm.txt
46 # + check various correspondences:
47 # * the suite is one of those permitted
48 # * the signed tag must refer to a commit
49 # * the signed tag commit must be the refs/dgit value
50 # * the name in the signed tag must correspond to its ref name
51 # * the tag name must be debian/<version> (massaged as needed)
52 # * the signed tag has a suitable name
53 # * the commit is a fast forward
54 # + push the signed tag and new dgit branch to the actual repo
56 # If the destination repo does not already exist, we need to make
57 # sure that we create it reasonably atomically, and also that
58 # we don't every have a destination repo containing no refs at all
59 # (because such a thing causes git-fetch-pack to barf). So then we
60 # do as above, except:
61 # - before starting, we take out our own lock for the destination repo
62 # - we create a prospective new destination repo by making a copy
64 # - we use the prospective new destination repo instead of the
65 # actual new destination repo (since the latter doesn't exist)
66 # - we set up a post-receive hook as well, which
67 # + touches a stamp file
68 # - after git-receive-pack exits, we
69 # + check that the prospective repo contains a tag and head
70 # + rename the prospective destination repo into place
74 # - Temporary working trees and their locks are cleaned up
75 # opportunistically by a program which tries to take each lock and
76 # if successful deletes both the tree and the lockfile
77 # - Prospective working trees and their locks are cleaned up by
78 # a program which tries to take each lock and if successful
79 # deletes any prospective working tree and the lock (but not
80 # of course any actual tree)
81 # - It is forbidden to _remove_ the lockfile without removing
82 # the corresponding temporary tree, as the lockfile is also
83 # a stampfile whose presence indicates that there may be
88 use File::Path qw(rmtree);
90 use Debian::Dgit qw(:DEFAULT :policyflags);
92 open DEBUG, ">/dev/null" or die $!;
109 #----- utilities -----
112 print DEBUG "$debug @_\n";
115 sub acquirelock ($$) {
116 my ($lock, $must) = @_;
118 printf DEBUG "$debug locking %s %d\n", $lock, $must;
121 $fh = new IO::File $lock, ">" or die "open $lock: $!";
122 my $ok = flock $fh, $must ? LOCK_EX : (LOCK_EX|LOCK_NB);
124 die "flock $lock: $!" if $must;
125 debug " locking $lock failed";
128 next unless stat_exists $lock;
129 my $want = (stat _)[1];
131 my $got = (stat _)[1];
132 last if $got == $want;
137 sub acquiretree ($$) {
138 my ($tree, $must) = @_;
139 my $fh = acquirelock("$tree.lock", $must);
148 my $tmpdir = "$dgitrepos/_tmp";
149 return if mkdir $tmpdir;
150 return if $! == EEXIST;
154 sub recorderror ($) {
156 my $w = $ENV{'DGIT_DRS_WORK'}; # we are in stunthook
159 open ERR, ">", "$w/drs-error" or die $!;
160 print ERR $why, "\n" or die $!;
169 recorderror "reject: $why";
170 die "dgit-repos-server: reject: $why\n";
176 local $Data::Dumper::Indent = 0;
177 local $Data::Dumper::Terse = 1;
178 debug "|".Dumper(\@_);
186 die "@_ $? $!" if $r;
190 my ($policyallowbits, @polargs) = @_;
191 # => ($exitstatuspolicybitmap, $policylockfh);
192 die if $policyallowbits & ~0x3e;
193 my @cmd = ($policyhook,$distro,$repos,@polargs);
196 die "system: $!" if $r < 0;
197 die "hook (@cmd) failed ($?)" if $r & ~($policyallowbits << 8);
201 sub mkemptyrepo ($$) {
202 my ($dir,$sharedperm) = @_;
203 runcmd qw(git init --bare --quiet), "--shared=$sharedperm", $dir;
206 sub mkrepo_fromtemplate ($) {
208 my $template = "$dgitrepos/_template";
209 debug "copy tempalate $template -> $dir";
210 my $r = system qw(cp -a --), $template, $dir;
211 !$r or die "create new repo $dir failed: $r $!";
214 sub movetogarbage () {
215 my $garbagerepo = "$dgitrepos/${package}_garbage";
216 my $lfh =acquiretree($garbagerepo,1);
217 # We arrange to always keep at least one old tree, for anti-rewind
218 # purposes (and, I guess, recovery from mistakes). This is either
219 # $garbage or $garbage-old.
220 if (stat_exists "$garbagerepo") {
221 rmtree "$garbagerepo-tmp";
222 if (rename "$garbagerepo-old", "$garbagerepo-tmp") {
223 rmtree "$garbagerepo-tmp";
225 die "$garbagerepo $!" unless $!==ENOENT;
227 rename "$garbagerepo", "$garbagerepo-old" or die "$garbagerepo $!";
229 rename $realdestrepo, $garbagerepo
231 or die "$garbagerepo $!";
236 my @cmd = (qw(git send-pack), $destrepo);
237 push @cmd, qw(--force) if $policy & NOFFCHECK;
238 push @cmd, "$commit:refs/dgit/$suite",
239 "$tagval:refs/tags/$tagname");
243 !$r or die "onward push to $destrepo failed: $r $!";
246 #----- git-receive-pack -----
248 sub fixmissing__git_receive_pack () {
250 $destrepo = "$dgitrepos/_tmp/${package}_prospective";
251 acquiretree($destrepo, 1);
252 mkrepo_fromtemplate($destrepo);
255 sub makeworkingclone () {
257 $workrepo = "$dgitrepos/_tmp/${package}_incoming$$";
258 acquiretree($workrepo, 1);
259 runcmd qw(git clone -l -q --mirror), $destrepo, $workrepo;
260 rmtree "${workrepo}_fresh";
263 sub setupstunthook () {
264 my $prerecv = "$workrepo/hooks/pre-receive";
265 my $fh = new IO::File $prerecv, O_WRONLY|O_CREAT|O_TRUNC, 0777
266 or die "$prerecv: $!";
267 print $fh <<END or die "$prerecv: $!";
270 exec $0 --pre-receive-hook $package
272 close $fh or die "$prerecv: $!";
273 $ENV{'DGIT_DRS_WORK'}= $workrepo;
274 $ENV{'DGIT_DRS_DEST'}= $destrepo;
275 debug " stunt hook set up $prerecv";
278 sub dealwithfreshrepo () {
279 my $freshrepo = "${workrepo}_fresh";
280 return unless stat_exists $freshrepo;
281 $destrepo = $freshrepo;
284 sub maybeinstallprospective () {
285 return if $destrepo eq $realdestrepo;
287 if (open REJ, "<", "$workrepo/drs-error") {
290 REJ->error and die $!;
294 $!==&ENOENT or die $!;
297 debug " show-ref ($destrepo) ...";
299 my $child = open SR, "-|";
300 defined $child or die $!;
302 chdir $destrepo or die $!;
303 exec qw(git show-ref);
306 my %got = qw(tag 0 head 0);
309 debug " show-refs| $_";
310 s/^\S*[1-9a-f]\S* (\S+)$/$1/ or die;
312 m{^refs/tags/} ? 'tag' :
313 m{^refs/dgit/} ? 'head' :
317 $!=0; $?=0; close SR or $?==256 or die "$? $!";
319 debug "installprospective ?";
320 die Dumper(\%got)." -- missing refs in new repo"
321 if grep { !$_ } values %got;
323 movetogarbage; # in case of FRESHREPO
325 debug "install $destrepo => $realdestrepo";
326 rename $destrepo, $realdestrepo or die $!;
327 remove "$destrepo.lock" or die $!;
330 sub main__git_receive_pack () {
333 runcmd qw(git receive-pack), $workrepo;
335 maybeinstallprospective();
338 #----- stunt post-receive hook -----
340 our ($tagname, $tagval, $suite, $oldcommit, $commit);
341 our ($version, %tagh);
344 debug " updates ...";
348 m/^(\S+) (\S+) (\S+)$/ or die "$_ ?";
349 my ($old, $sha1, $refname) = ($1, $2, $3);
350 if ($refname =~ m{^refs/tags/(?=debian/)}) {
351 reject "pushing multiple tags!" if defined $tagname;
354 reject "tag $tagname already exists -".
355 " not replacing previously-pushed version"
357 } elsif ($refname =~ m{^refs/dgit/}) {
358 reject "pushing multiple heads!" if defined $suite;
363 reject "pushing unexpected ref!";
366 STDIN->error and die $!;
368 reject "push is missing tag ref update" unless defined $tagname;
369 reject "push is missing head ref update" unless defined $suite;
370 debug " updates ok.";
374 debug " parsetag...";
375 open PT, ">dgit-tmp/plaintext" or die $!;
376 open DS, ">dgit-tmp/plaintext.asc" or die $!;
377 open T, "-|", qw(git cat-file tag), $tagval or die $!;
379 $!=0; $_=<T>; defined or die $!;
381 if (m/^(\S+) (.*)/) {
382 push @{ $tagh{$1} }, $2;
389 $!=0; $_=<T>; defined or die $!;
390 m/^($package_re) release (\S+) for \S+ \((\S+)\) \[dgit\]$/ or
391 reject "tag message not in expected format";
393 die unless $1 eq $package;
395 die "$3 != $suite " unless $3 eq $suite;
399 $!=0; $_=<T>; defined or die "missing signature? $!";
400 if (m/^\[dgit ([^"].*)\]$/) { # [dgit "something"] is for future
403 if (s/^distro\=(\S+) //) {
404 die "$1 != $distro" unless $1 eq $distro;
405 } elsif (s/^(--deliberately-$package_re) //) {
406 push @deliberatelies, $1;
407 } elsif (s/^supersede:(\S+)=(\w+) //) {
408 die "supersede $1 twice" if defined $supersedes{$1};
409 $supersedes{$1} = $2;
410 } elsif (s/^[-+.=0-9a-z]\S* //) {
412 die "unknown dgit info in tag";
417 last if m/^-----BEGIN PGP/;
427 debug " parsetag ok.";
430 sub checksig_keyring ($) {
431 my ($keyringfile) = @_;
432 # returns primary-keyid if signed by a key in this keyring
434 # or dies on other errors
438 debug " checksig keyring $keyringfile...";
440 our @cmd = (qw(gpgv --status-fd=1 --keyring),
442 qw(dgit-tmp/plaintext.asc dgit-tmp/plaintext));
449 next unless s/^\[GNUPG:\] //;
451 debug " checksig| $_";
452 my @l = split / /, $_;
453 if ($l[0] eq 'NO_PUBKEY') {
455 } elsif ($l[0] eq 'VALIDSIG') {
457 $sigtype eq '00' or reject "signature is not of type 00!";
459 die unless defined $ok;
465 debug sprintf " checksig ok=%d", !!$ok;
470 sub dm_txt_check ($$) {
471 my ($keyid, $dmtxtfn) = @_;
472 debug " dm_txt_check $keyid $dmtxtfn";
473 open DT, '<', $dmtxtfn or die "$dmtxtfn $!";
475 m/^fingerprint:\s+$keyid$/oi
477 if (s/^allow:/ /i..0) {
480 or reject "key $keyid missing Allow section in permissions!";
485 or reject "package $package not allowed for key $keyid";
490 debug " dm_txt_check allow| $_";
491 foreach my $p (split /\s+/) {
492 if ($p eq $package) {
494 debug " dm_txt_check ok";
499 DT->error and die $!;
501 reject "key $keyid not in permissions list although in keyring!";
505 foreach my $kas (split /:/, $keyrings) {
506 debug "verifytag $kas...";
507 $kas =~ s/^([^,]+),// or die;
508 my $keyid = checksig_keyring $1;
509 if (defined $keyid) {
510 if ($kas =~ m/^a$/) {
511 debug "verifytag a ok";
513 } elsif ($kas =~ m/^m([^,]+)$/) {
514 dm_txt_check($keyid, $1);
515 debug "verifytag m ok";
522 reject "key not found in keyrings";
526 debug "checksuite ($suitesfile)";
527 open SUITES, "<", $suitesfile or die $!;
533 return if $_ eq $suite;
535 die $! if SUITES->error;
536 reject "unknown suite";
539 sub checktagnoreplay () {
540 # We check that the signed tag mentions the name and value of
541 # (a) in the case of FRESHREPO all tags in the repo;
542 # (b) in the case of just NOFFCHECK all tags referring to
543 # the current head for the suite (there must be at least one).
544 # This prevents a replay attack using an earlier signed tag.
545 return unless $policy & (FRESHREPO|NOFFCHECK);
547 my $garbagerepo = "$dgitrepos/${package}_garbage";
548 acquiretree($garbagerepo,1);
551 foreach my $garb ("$garbagerepo", "$garbagerepo-old") {
552 if (stat_exists $garb) {
553 $ENV{GIT_DIR} = $garb;
557 if (!defined $ENV{GIT_DIR}) {
558 # Nothing to overwrite so the FRESHREPO and NOFFCHECK were
559 # pointless. Oh well.
560 debug "checktagnoreplay - no garbage, ok";
565 if (!($policy & FRESHREPO)) {
566 my $branch = server_branch($suite);
568 `git for-each-ref --format='%(objectname)' '[r]efs/$branch'`;
569 defined or die "$branch $? $!";
570 $? and die "$branch $?";
572 # No such branch - NOFFCHECK was unnecessary. Oh well.
573 debug "checktagnoreplay - not FRESHREPO, new branch, ok";
576 m/^(\w+)\n$/ or die "$branch $_ ?";
578 debug "checktagnoreplay - not FRESHREPO,".
579 " checking for overwriting refs/$branch=$onlyreferring";
584 git_for_each_tag_referring($objreferring, sub {
585 my ($objid,$fullrefname,$tagname) = @_;
586 debug "checktagnoreplay - overwriting $fullrefname=$objid";
587 my $supers = $supersedes{$fullrefname};
588 if (!defined $supers) {
589 push @problems, "does not supersede $fullrefname";
590 } elsif ($supers ne $objid) {
592 "supersedes $fullrefname=$supers but previously $fullrefname=$objid";
599 reject "replay attack prevention check failed:".
600 " signed tag for $version: ".
601 join("; ", @problems).
604 debug "checktagnoreply - all ok"
609 my $vals = $tagh{$tag};
610 reject "missing header $tag in signed tag object" unless $vals;
611 reject "multiple headers $tag in signed tag object" unless @$vals == 1;
618 tagh1('type') eq 'commit' or reject "tag refers to wrong kind of object";
619 tagh1('object') eq $commit or reject "tag refers to wrong commit";
620 tagh1('tag') eq $tagname or reject "tag name in tag is wrong";
625 debug "translated version $v";
626 $tagname eq "debian/$v" or die;
628 $policy = policyhook(NOFFCHECK|FRESHREPO, 'push',$package,
629 $version,$suite,$tagname,
630 join(",",@delberatelies));
635 # check that our ref is being fast-forwarded
636 debug "oldcommit $oldcommit";
637 if (!($policy & NOFFCHECK) && $oldcommit =~ m/[^0]/) {
638 $?=0; $!=0; my $mb = `git merge-base $commit $oldcommit`;
640 $mb eq $oldcommit or reject "not fast forward on dgit branch";
643 if ($policy & FRESHREPO) {
644 # This is troublesome. We have been asked by the policy hook
645 # to receive the push into a fresh repo. But of course we
646 # have actually already mostly received the push into the working
647 # repo. (This is unavoidable because the instruction to use a new
648 # repo comes ultimately from the signed tag for the dgit push,
649 # which has to have been received into some repo.)
651 # So what we do is generate a fresh working repo right now and
652 # push the head and tag into it. The presence of this fresh
653 # working repo is detected by the parent, which responds by
654 # making a fresh master repo from the template.
656 $destrepo = "${workrepo}_fresh"; # workrepo lock covers
657 mkrepo_fromtemplate $destrepo;
663 chdir $workrepo or die "chdir $workrepo: $!";
664 mkdir "dgit-tmp" or $!==EEXIST or die $!;
670 debug "stunthook done.";
673 #----- git-upload-pack -----
675 sub fixmissing__git_upload_pack () {
676 $destrepo = "$dgitrepos/_empty";
677 my $lfh = acquiretree($destrepo,1);
678 return if stat_exists $destrepo;
679 rmtree "$destrepo.new";
680 mkemptyrepo "$destrepo.new", "0644";
681 rename "$destrepo.new", $destrepo or die $!;
682 unlink "$destrepo.lock" or die $!;
686 sub main__git_upload_pack () {
687 runcmd qw(git upload-pack), $destrepo;
690 #----- arg parsing and main program -----
699 sub parseargsdispatch () {
702 delete $ENV{'GIT_DIR'}; # if not run via ssh, our parent git process
703 delete $ENV{'GIT_PREFIX'}; # sets these and they mess things up
705 if ($ENV{'DGIT_DRS_DEBUG'}) {
707 open DEBUG, ">&STDERR" or die $!;
710 if ($ARGV[0] eq '--pre-receive-hook') {
711 if ($debug) { $debug.="="; }
714 $package = shift @ARGV;
715 defined($distro = $ENV{'DGIT_DRS_DISTRO'}) or die;
716 defined($suitesfile = $ENV{'DGIT_DRS_SUITES'}) or die;
717 defined($workrepo = $ENV{'DGIT_DRS_WORK'}) or die;
718 defined($destrepo = $ENV{'DGIT_DRS_DEST'}) or die;
719 defined($keyrings = $ENV{'DGIT_DRS_KEYRINGS'}) or die $!;
720 defined($policyhook = $ENV{'DGIT_DRS_POLICYHOOK'}) or die $!;
721 open STDOUT, ">&STDERR" or die $!;
726 recorderror "$@" or die;
732 $ENV{'DGIT_DRS_DISTRO'} = argval();
733 $ENV{'DGIT_DRS_SUITES'} = argval();
734 $ENV{'DGIT_DRS_KEYRINGS'} = argval();
735 $dgitrepos = argval();
736 $ENV{'DGIT_DRS_POLICYHOOK'} = $policyhook = argval();
738 die unless @ARGV==1 && $ARGV[0] eq '--ssh';
740 my $cmd = $ENV{'SSH_ORIGINAL_COMMAND'};
750 or reject "command string not understood";
753 $realdestrepo = "$dgitrepos/$package.git";
757 my $mainfunc = $main::{"main__$funcn"};
759 reject "unknown method" unless $mainfunc;
761 my ($policy, $pollock) = policyhook(FRESHREPO,'check-package',$package);
762 if ($policy & FRESHREPO) {
765 close $pollock or die $!;
767 if (stat_exists $realdestrepo) {
768 $destrepo = $realdestrepo;
770 debug " fixmissing $funcn";
771 my $fixfunc = $main::{"fixmissing__$funcn"};
775 debug " running main $funcn";
780 while (my $fh = pop @lockfhs) { close $fh; }
785 if (!chdir "$dgitrepos/_tmp") {
786 $!==ENOENT or die $!;
789 foreach my $lf (<*.lock>) {
791 $tree =~ s/\.lock$//;
792 next unless acquiretree($tree, 0);
793 remove $lf or warn $!;