wip changes for remote push - support supplying gpg command

[dgit.git] / dgit

diff --git a/dgit b/dgit
index f77d349b400c344adf13945c6f5e9fd6db3e3b62..58567498f8ca50032cb67e1db29345d107c04c00 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -49,6 +49,9 @@ our (@git) = qw(git);
 our (@dget) = qw(dget);
 our (@dput) = qw(dput);
 our (@debsign) = qw(debsign);
+our (@gpg) = qw(gpg);
+fixme should be in manual
+fixme should pass this to debsign
 our (@sbuild) = qw(sbuild -A);
 our (@dpkgbuildpackage) = qw(dpkg-buildpackage -i\.git/ -I.git);
 our (@dpkgsource) = qw(dpkg-source -i\.git/ -I.git);
@@ -59,6 +62,7 @@ our (@changesopts) = ('');
 our %opts_opt_map = ('dget' => \@dget,
                     'dput' => \@dput,
                     'debsign' => \@debsign,
+                     'gpg' => \@gpg,
                      'sbuild' => \@sbuild,
                      'dpkg-source' => \@dpkgsource,
                      'dpkg-buildpackage' => \@dpkgbuildpackage,
@@ -131,7 +135,7 @@ sub url_get {
     return $r->decoded_content();
 }
 
-our ($dscdata,$dscurl,$dsc);
+our ($dscdata,$dscurl,$dsc,$skew_warning_vsn);
 
 sub printcmd {
     my $fh = shift @_;
@@ -209,6 +213,11 @@ sub runcmd_ordryrun {
     }
 }
 
+sub shell_cmd {
+    my ($first_shell, @cmd) = @_;
+    return qw(sh -ec), $first_shell.'; exec "$@"', 'x', @cmd;
+}
+
 our $helpmsg = <<END;
 main usages:
   dgit [dgit-opts] clone [dgit-opts] package [suite] [./dir|/dir]
@@ -335,7 +344,7 @@ sub getfield ($$) {
 sub parsechangelog {
     my $c = Dpkg::Control::Hash->new();
     my $p = new IO::Handle;
-    my @cmd = (qw(dpkg-parsechangelog));
+    my @cmd = (qw(dpkg-parsechangelog), @_);
     open $p, '-|', @cmd or die $!;
     $c->parse($p);
     $?=0; $!=0; close $p or failedcmd @cmd;
@@ -445,7 +454,10 @@ sub get_archive_dsc () {
        my ($vsn,$subpath) = @$vinfo;
        $dscurl = access_cfg('mirror').$subpath;
        $dscdata = url_get($dscurl);
-       next unless defined $dscdata;
+       if (!$dscdata) {
+           $skew_warning_vsn = $vsn if !defined $skew_warning_vsn;
+           next;
+       }
        my $dscfh = new IO::File \$dscdata, '<' or die $!;
        print DEBUG Dumper($dscdata) if $debug>1;
        $dsc = parsecontrolfh($dscfh,$dscurl, allow_pgp=>1);
@@ -660,8 +672,7 @@ sub ensure_we_have_orig () {
        $origurl .= "/$f";
        die "$f ?" unless $f =~ m/^${package}_/;
        die "$f ?" if $f =~ m#/#;
-       runcmd_ordryrun qw(sh -ec),'cd ..; exec "$@"','x',
-           @dget,'--',$origurl;
+       runcmd_ordryrun shell_cmd 'cd ..', @dget,'--',$origurl;
     }
 }
 
@@ -746,12 +757,20 @@ END
        $hash = $lastpush_hash;
        print STDERR <<END or die $!;
 
-Package not found in the archive, but has allegedly been
-pushed/uploaded using dgit.
+Package not found in the archive, but has allegedly been pushed using dgit.
 $later_warning_msg
 END
     } else {
        print DEBUG "nothing found!\n";
+       if (defined $skew_warning_vsn) {
+           print STDERR <<END or die $!;
+
+Warning: relevant archive skew detected.
+Archive allegedly contains $skew_warning_vsn
+But we were not able to obtain any version from the archive or git.
+
+END
+       }
        return 0;
     }
     print DEBUG "current hash=$hash\n";
@@ -760,6 +779,25 @@ END
            " (archive's version left in DGIT_ARCHIVE)"
            unless is_fast_fwd($lastpush_hash, $hash);
     }
+    if (defined $skew_warning_vsn) {
+       mkpath '.git/dgit';
+       print DEBUG "SKEW CHECK WANT $skew_warning_vsn\n";
+       my $clogf = ".git/dgit/changelog.tmp";
+       runcmd shell_cmd "exec >$clogf",
+           @git, qw(cat-file blob), "$hash:debian/changelog";
+       my $gotclogp = parsechangelog("-l$clogf");
+       my $got_vsn = getfield $gotclogp, 'Version';
+       print DEBUG "SKEW CHECK GOT $got_vsn\n";
+       if (version_compare_string($got_vsn, $skew_warning_vsn) < 0) {
+           print STDERR <<END or die $!;
+
+Warning: archive skew detected.  Using the available version:
+Archive allegedly contains    $skew_warning_vsn
+We were able to obtain only   $got_vsn
+
+END
+       }
+    }
     if ($lastpush_hash ne $hash) {
        my @upd_cmd = (@git, qw(update-ref -m), 'dgit fetch', lrref(), $hash);
        if (!$dryrun) {
@@ -902,7 +940,8 @@ sub dopush () {
 #    runcmd @git, qw(fetch -p ), "$alioth_git/$package.git",
 #        map { lref($_).":".rref($_) }
 #        (uploadbranch());
-    $dsc->{$ourdscfield[0]} = rev_parse('HEAD');
+    my $head = rev_parse('HEAD');
+    $dsc->{$ourdscfield[0]} = $head;
     $dsc->save("../$dscfn.tmp") or die $!;
     if (!$changesfile) {
        my $multi = "../${package}_".(stripepoch $cversion)."_multi.changes";
@@ -926,6 +965,7 @@ sub dopush () {
                " does not match changelog \`$clogp->{$field}'";
     }
     my $tag = debiantag($dversion);
+    runcmd @git, qw(check-ref-format), $tag;
     if (!check_for_git()) {
        create_remote_git_repo();
     }
@@ -940,11 +980,15 @@ sub dopush () {
        if (!defined $keyid) {
            $keyid = access_cfg('keyid','RETURN-UNDEF');
        }
-       my @tag_cmd = (@git, qw(tag -s -m),
+       my @tag_cmd = (@git, qw(tag -a -m),
                       "$package release $dversion for $csuite [dgit]");
-       push @tag_cmd, qw(-u),$keyid if defined $keyid;
        push @tag_cmd, $tag;
        runcmd_ordryrun @tag_cmd;
+       
+
+       push @tag_cmd, qw(-u),$keyid if defined $keyid;
+       push @tag_cmd, qw(-u),$keyid if defined $keyid;
+
        my @debsign_cmd = @debsign;
        push @debsign_cmd, "-k$keyid" if defined $keyid;
        push @debsign_cmd, $changesfile;