chiark / gitweb /
git fetching: git_lrfetch_sane: Support multiple calls
[dgit.git] / infra / dgit-repos-server
index 1be6e78d26613f27ce3a172cd2bbb0962d5780da..eb4b377334d017807e7f22d70a22946be0707b9e 100755 (executable)
@@ -1,6 +1,23 @@
 #!/usr/bin/perl -w
 # dgit-repos-server
 #
+# git protocol proxy to check dgit pushes etc.
+#
+# Copyright (C) 2014-2016  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 <http://www.gnu.org/licenses/>.
+
 # usages:
 #   dgit-repos-server DISTRO DISTRO-DIR AUTH-SPEC [<settings>] --ssh
 #   dgit-repos-server DISTRO DISTRO-DIR AUTH-SPEC [<settings>] --cron
@@ -9,8 +26,10 @@
 #   --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 and to pass to policy hook)
+# (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
 #
 # (With --cron AUTH-SPEC is not used and may be the empty string.)
 
 use strict;
-$SIG{__WARN__} = sub { die $_[0]; };
+
+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)
@@ -65,7 +87,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/DISTRO/* 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
@@ -82,7 +104,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/<version> (massaged as needed)
+#        * the tag name must be [archive/]debian/<version> (massaged as needed)
 #        * the suite is one of those permitted
 #        * the signed tag has a suitable name
 #        * run the "push" policy hook
@@ -119,7 +141,7 @@ $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 scripts are invoked like this:
 #   POLICY-HOOK-SCRIPT DISTRO DGIT-REPOS-DIR DGIT-LIVE-DIR DISTRO-DIR ACTION...
 # ie.
 #   POLICY-HOOK-SCRIPT ... check-list [...]
@@ -131,12 +153,16 @@ $SIG{__WARN__} = sub { die $_[0]; };
 #
 # DELIBERATELIES is like this: --deliberately-foo,--deliberately-bar,...
 #
-# Exit status is a bitmask.  Bit weight constants are defined in Dgit.pm.
+# 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)
 # 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"
@@ -168,15 +194,24 @@ $SIG{__WARN__} = sub { die $_[0]; };
 # If policy hook wants to run dgit (or something else in the dgit
 # 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;
@@ -186,6 +221,7 @@ our $distro;
 our $suitesfile;
 our $suitesformasterfile;
 our $policyhook;
+our $mirrorhook;
 our $dgitlive;
 our $distrodir;
 our $destrepo;
@@ -278,7 +314,7 @@ sub policyhook {
     # => ($exitstatuspolicybitmap);
     die if $policyallowbits & ~0x3e;
     my @cmd = ($policyhook,$distro,$dgitrepos,$dgitlive,$distrodir,@polargs);
-    debugcmd '+',@cmd;
+    debugcmd '+M',@cmd;
     my $r = system @cmd;
     die "system: $!" if $r < 0;
     die "dgit-repos-server: policy hook failed (or rejected) ($?)\n"
@@ -327,7 +363,8 @@ sub movetogarbage () {
 
     ensuredir "$dgitrepos/_removed-tags";
     open PREVIOUS, ">>", removedtagsfile or die removedtagsfile." $!";
-    git_for_each_ref('refs/tags/'.debiantag('*',$distro), sub {
+    git_for_each_ref([ map { 'refs/tags/'.$_ } debiantags('*',$distro) ],
+                    sub {
        my ($objid,$objtype,$fullrefname,$reftail) = @_;
        print PREVIOUS "\n$objid $reftail .\n" or die $!;
     }, $real);
@@ -390,6 +427,23 @@ sub dealwithfreshrepo () {
     $destrepo = $freshrepo;
 }
 
+sub mirrorhook {
+    my @cmd = ($mirrorhook,$distrodir,@_);
+    debugcmd '+',@cmd;
+    return unless stat_exists $mirrorhook;
+    my $r = system @cmd;
+    if ($r) {
+       printf STDERR <<END,
+dgit-repos-server: warning: mirror hook failed: %s
+dgit-repos-server: push complete but may not fully visible.
+END
+            ($r < 0 ? "exec: $!" :
+            $r == (124 << 8) ? "exited status 124 (timeout?)" :
+            !($r & ~0xff00) ? "exited ".($? >> 8) :
+            "wait status $?");
+    }
+}
+
 sub maybeinstallprospective () {
     return if $destrepo eq realdestrepo;
 
@@ -412,23 +466,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 (<SR>) {
        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();
 
@@ -447,27 +503,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 (<STDIN>) {
        chomp or die;
        printdebug " upd.| $_\n";
        m/^(\S+) (\S+) (\S+)$/ or die "$_ ?";
        my ($old, $sha1, $refname) = ($1, $2, $3);
-       if ($refname =~ m{^refs/tags/(?=$distro/)}) {
-           reject "pushing multiple tags!" if defined $tagname;
-           $tagname = $'; #';
-           $tagval = $sha1;
-           $tagexists_error= "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/}) {
@@ -481,7 +539,19 @@ 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 @newtags = grep { m#^archive/# } keys %tags;
+    my @omtags = grep { !m#^archive/# } keys %tags;
+    reject "pushing too many similar tags" if @newtags>1 || @omtags>1;
+    if (@newtags) {
+       ($tagname) = @newtags;
+       ($maint_tagname) = @omtags;
+    } else {
+       ($tagname) = @omtags or die;
+    }
+    $tagval = $tags{$tagname};
+    $maint_tagval = $tags{$maint_tagname // ''};
+
     reject "push is missing head ref update" unless defined $suite;
     printdebug " updates ok.\n";
 }
@@ -591,7 +661,7 @@ sub dm_txt_check ($$) {
     printdebug " dm_txt_check $keyid $dmtxtfn\n";
     open DT, '<', $dmtxtfn or die "$dmtxtfn $!";
     while (<DT>) {
-       m/^fingerprint:\s+$keyid$/oi
+       m/^fingerprint:\s+\Q$keyid\E$/oi
            ..0 or next;
        if (s/^allow:/ /i..0) {
        } else {
@@ -788,9 +858,16 @@ sub checks () {
     tagh1('object') eq $commit or reject "tag refers to wrong commit";
     tagh1('tag') eq $tagname or reject "tag name in tag is wrong";
 
-    my $expecttagname = debiantag $version, $distro;
-    printdebug "expected tag $expecttagname\n";
-    $tagname eq $expecttagname 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 (pushed with differing dgit version)".
+           " already exists -".
+           " not replacing previously-pushed version"
+           if git_get_ref "refs/tags/".$othertag;
+    }
 
     lockrealtree();
 
@@ -816,6 +893,27 @@ sub checks () {
        chomp $mb;
        $mb eq $oldcommit or reject "not fast forward on dgit branch";
     }
+
+    # defend against commits generated by #849041
+    if (!($policy & NOCOMMITCHECK)) {
+       my @checks = qw(%an %ae %at
+                       %cn %ce %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 (<CHK>) {
+           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) {
        # It's a bit late to be discovering this here, isn't it ?
        #
@@ -842,6 +940,8 @@ sub onwardpush () {
     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;
@@ -928,11 +1028,12 @@ our %indistrodir = (
     'suites' => \$suitesfile,
     'suites-master' => \$suitesformasterfile,
     'policy-hook' => \$policyhook,
+    'mirror-hook' => \$mirrorhook,
     'dgit-live' => \$dgitlive,
     );
 
 our @hookenvs = qw(distro suitesfile suitesformasterfile policyhook
-                   dgitlive keyrings dgitrepos distrodir);
+                   mirrorhook dgitlive keyrings dgitrepos distrodir);
 
 # workrepo and destrepo handled ad-hoc