dgit-repos-server: tag2upload: Check changelog info

[dgit.git] / infra / dgit-repos-server

diff --git a/infra/dgit-repos-server b/infra/dgit-repos-server
index c090f7dc1e4c595de0fc392c6a331c8fe874e218..d8dc8574bd2157a4a5d4b4e7e53984448ad1ebcf 100755 (executable)
--- a/infra/dgit-repos-server
+++ b/infra/dgit-repos-server
@@ -1149,7 +1149,6 @@ sub mode_tag2upload () {
 
     # This is for us.  From now on, we will capture errors to
     # be emailed to the tagger.
-    # TODO: failures to git fetch from salsa will burn a version
 
     open H, ">>dgit-tmp/tagupl.email" or die $!;
     print H <<END or die $!;
@@ -1196,7 +1195,8 @@ END
     open STDOUT, ">&STDERR" or die $!;
     open DEBUG, ">&STDERR" if $debuglevel;
 
-    die "$tagmversion != $version " unless $tagmversion eq $version;
+    reject "version mismatch $tagmversion != $version "
+       unless $tagmversion eq $version;
 
     my %need = map { $_ => 1 } qw(please-upload split);
     my ($upstreamc, $upstreamt);
@@ -1224,15 +1224,15 @@ END
        $distro_ok ||= $gotdistro eq $distro;
     };
 
-    $quit->("other distro") unless $distro_ok;
+    $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;
 
-    verifytag();
-
     my @dgit;
     push @dgit, $ENV{DGIT_DRS_DGIT} // 'dgit';
     push @dgit, '-wn';
@@ -1244,7 +1244,6 @@ END
 
     my @fetch = qw(git fetch origin --unshallow);
     if (defined $upstreamt) {
-       runcmd qw(git check-ref-format), "refs/tags/$upstreamt";
        runcmd qw(git check-ref-format), "refs/tags/$upstreamt";
        my $utagref = "refs/tags/$upstreamt";
        push @fetch, "$utagref:$utagref";
@@ -1253,6 +1252,16 @@ END
 
     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(fetch), $suite);
     debugcmd "+",@_;
     $!=0; $?=-1;
@@ -1261,7 +1270,9 @@ END
     }
     # this is just to get the orig, so we don't really care about the ref
     if (defined $upstreamc) {
-       $upstreamc eq git_rev_parse "refs/tags/$upstreamt" or die;
+       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";
     }