Manpage formatting fix.

[dgit.git] / dgit

diff --git a/dgit b/dgit
index 573faa43e5bf327aac88d2b1046a3b8ad3877ef6..4e9afe0fe423ed590962adf4da16bcde574ed08a 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -28,6 +28,7 @@ use Dpkg::Version;
 use POSIX;
 
 our $isuite = 'unstable';
+our $idistro;
 our $package;
 
 our $sign = 1;
@@ -69,7 +70,11 @@ my $lbranch_re = '^refs/heads/'.$branchprefix.'/([^/.]+)$';
 sub lref () { return "refs/heads/".lbranch(); }
 sub lrref () { return "refs/remotes/$remotename/$csuite"; }
 sub rrref () { return "refs/$branchprefix/$csuite"; }
-sub debiantag ($) { return "debian/$_[0]"; }
+sub debiantag ($) { 
+    my ($v) = @_;
+    $v =~ y/~:/_%/;
+    return "debian/$v";
+}
 
 sub dscfn ($) { return "${package}_$_[0].dsc"; }
 
@@ -195,6 +200,10 @@ important dgit options:
   -c<name>=<value>    set git config option (used directly by dgit too)
 END
 
+our $later_warning_msg = <<END;
+Perhaps the upload is stuck in incoming.  Using the version from git.
+END
+
 sub badusage {
     print STDERR "$us: @_\n", $helpmsg or die $!;
     exit 8;
@@ -209,7 +218,7 @@ our %defcfg = ('dgit.default.distro' => 'debian',
               'dgit.default.username' => '',
               'dgit.default.archive-query-default-component' => 'main',
               'dgit.default.ssh' => 'ssh',
-              'dgit-distro.debian.git-host' => 'dgit.debian.net',
+              'dgit-distro.debian.git-host' => 'git.debian.org',
               'dgit-distro.debian.git-proto' => 'git+ssh://',
               'dgit-distro.debian.git-path' => '/git/dgit-repos',
               'dgit-distro.debian.git-check' => 'ssh-cmd',
@@ -246,7 +255,7 @@ sub access_distro () {
 
 sub access_cfg (@) {
     my (@keys) = @_;
-    my $distro = access_distro();
+    my $distro = $idistro || access_distro();
     my $value = cfg(map { ("dgit-distro.$distro.$_",
                           "dgit.default.$_") } @keys);
     return $value;
@@ -560,9 +569,10 @@ END
             $outputhash = make_commit qw(../commit2.tmp);
        } elsif ($vcmp > 0) {
            print STDERR <<END or die $!;
+
 Version actually in archive:    $cversion (older)
 Last allegedly pushed/uploaded: $oversion (newer or same)
-Perhaps the upload is stuck in incoming.  Using the version from git.
+$later_warning_msg
 END
             $outputhash = $upload_hash;
        } elsif ($outputhash ne $upload_hash) {
@@ -646,10 +656,20 @@ sub fetch_from_archive () {
            unless $upload_hash;
        $hash = $dsc_hash;
        ensure_we_have_orig();
+       if (is_fast_fwd($dsc_hash,$upload_hash)) {
+           print STDERR <<END or die $!;
+
+Git commit in archive is behind the last version allegedly pushed/uploaded.
+Commit referred to by archive:  $dsc_hash
+Last allegedly pushed/uploaded: $upload_hash
+$later_warning_msg
+END
+           $hash = $upload_hash;
+       }
     } else {
        $hash = generate_commit_from_dsc();
     }
-    print DEBUG "current hash $hash\n";
+    print DEBUG "current hash=$hash\n";
     if ($upload_hash) {
        fail "not fast forward on last upload branch!".
            " (archive's version left in DGIT_ARCHIVE)"
@@ -706,7 +726,15 @@ sub pull () {
 }
 
 sub check_not_dirty () {
-    runcmd @git, qw(diff --quiet HEAD);
+    my @cmd = (@git, qw(diff --quiet HEAD));
+    printcmd(\*DEBUG,"+",@cmd) if $debug>0;
+    $!=0; $?=0; system @cmd;
+    return if !$! && !$?;
+    if (!$! && $?==256) {
+       fail "working tree is dirty (does not match HEAD)";
+    } else {
+       failedcmd @cmd;
+    }
 }
 
 sub commit_quilty_patch ($) {
@@ -802,6 +830,9 @@ sub dopush () {
        print "[new .dsc left in $dscfn.tmp]\n";
     }
     if ($sign) {
+       if (!defined $keyid) {
+           $keyid = access_cfg('keyid','RETURN-UNDEF');
+       }
        my @tag_cmd = (@git, qw(tag -s -m),
                       "Release $dversion for $csuite [dgit]");
        push @tag_cmd, qw(-u),$keyid if defined $keyid;
@@ -899,8 +930,9 @@ sub cmd_push {
     if (fetch_from_archive()) {
        is_fast_fwd(lrref(), 'HEAD') or die;
     } else {
-       fail "package appears to be new in this suite;".
-           " if this is intentional, use --new";
+       $new_package or
+           fail "package appears to be new in this suite;".
+               " if this is intentional, use --new";
     }
     dopush();
 }
@@ -978,6 +1010,8 @@ sub parseopts () {
                push @$om, $2;
            } elsif (m/^--existing-package=(.*)/s) {
                $existing_package = $1;
+           } elsif (m/^--distro=(.*)/s) {
+               $idistro = $1;
            } else {
                badusage "unknown long option \`$_'";
            }
@@ -994,6 +1028,8 @@ sub parseopts () {
                    $new_package=1;
                } elsif (s/^-c(.*=.*)//s) {
                    push @git, '-c', $1;
+               } elsif (s/^-d(.*)//s) {
+                   $idistro = $1;
                } elsif (s/^-C(.*)//s) {
                    $changesfile = $1;
                } elsif (s/^-k(.*)//s) {