chiark / gitweb /
test suite: Test dput-ng compatibility.
[dgit.git] / dgit
diff --git a/dgit b/dgit
index 4535d8c3e67e5eab5e23cc493240ae7db0d17921..00da67d7ed6af8988d265ee039bbe0d62cfd45d9 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -617,6 +617,7 @@ our %defcfg = ('dgit.default.distro' => 'debian',
               'dgit.dsc-url-proto-ok.http'    => 'true',
               'dgit.dsc-url-proto-ok.https'   => 'true',
               'dgit.dsc-url-proto-ok.git'     => 'true',
+              'dgit.vcs-git.suites',          => 'sid', # ;-separated
               'dgit.default.dsc-url-proto-ok' => 'false',
               # old means "repo server accepts pushes with old dgit tags"
               # new means "repo server accepts pushes with new dgit tags"
@@ -1974,12 +1975,12 @@ END
            if ($found_same) {
                # in archive, delete from .changes if it's there
                $changed{$file} = "removed" if
-                   $changes->{$fname} =~ s/^.* \Q$file\E$(?:)\n//m;
-           } elsif ($changes->{$fname} =~ m/^.* \Q$file\E$(?:)\n/m) {
+                   $changes->{$fname} =~ s/\n.* \Q$file\E$(?:)$//m;
+           } elsif ($changes->{$fname} =~ m/^.* \Q$file\E$(?:)$/m) {
                # not in archive, but it's here in the .changes
            } else {
                my $dsc_data = getfield $dsc, $fname;
-               $dsc_data =~ m/^(.* \Q$file\E$)\n/m or die "$dsc_data $file ?";
+               $dsc_data =~ m/^(.* \Q$file\E$)$/m or die "$dsc_data $file ?";
                my $extra = $1;
                $extra =~ s/ \d+ /$&$placementinfo /
                    or die "$fname $extra >$dsc_data< ?"
@@ -2757,6 +2758,11 @@ END
            my $want = $wantr{$rrefname};
            next if $got eq $want;
            if (!defined $objgot{$want}) {
+               fail <<END unless act_local();
+--dry-run specified but we actually wanted the results of git fetch,
+so this is not going to work.  Try running dgit fetch first,
+or using --damp-run instead of --dry-run.
+END
                print STDERR <<END;
 warning: git ls-remote suggests we want $lrefname
 warning:  and it should refer to $want
@@ -2845,15 +2851,14 @@ sub mergeinfo_version ($) {
 
 sub fetch_from_archive_record_1 ($) {
     my ($hash) = @_;
-    runcmd @git, qw(update-ref -m), "dgit fetch $csuite",
-           'DGIT_ARCHIVE', $hash;
+    runcmd git_update_ref_cmd "dgit fetch $csuite", 'DGIT_ARCHIVE', $hash;
     cmdoutput @git, qw(log -n2), $hash;
     # ... gives git a chance to complain if our commit is malformed
 }
 
 sub fetch_from_archive_record_2 ($) {
     my ($hash) = @_;
-    my @upd_cmd = (@git, qw(update-ref -m), 'dgit fetch', lrref(), $hash);
+    my @upd_cmd = (git_update_ref_cmd 'dgit fetch', lrref(), $hash);
     if (act_local()) {
        cmdoutput @upd_cmd;
     } else {
@@ -3552,7 +3557,7 @@ sub fork_for_multisuite ($) {
        my $csubsuite = multisuite_suite_child($tsuite, \@mergeinputs,
                                               sub {
             @end = ();
-            fetch();
+            fetch_one();
            finish 0;
        });
        # xxx collecte the ref here
@@ -3710,19 +3715,37 @@ sub clone ($) {
     clone_finish($dstdir);
 }
 
-sub fetch () {
+sub fetch_one () {
     canonicalise_suite();
     if (check_for_git()) {
        git_fetch_us();
     }
     fetch_from_archive() or no_such_package();
+    
+    my $vcsgiturl = $dsc && $dsc->{'Vcs-Git'};
+    if (length $vcsgiturl and
+       (grep { $csuite eq $_ }
+        split /\;/,
+        cfg 'dgit.vcs-git.suites')) {
+       my $current = cfg 'remote.vcs-git.url', 'RETURN-UNDEF';
+       if (defined $current && $current ne $vcsgiturl) {
+           print STDERR <<END;
+FYI: Vcs-Git in $csuite has different url to your vcs-git remote.
+ Your vcs-git remote url may be out of date.  Use dgit update-vcs-git ?
+END
+       }
+    }
     printdone "fetched into ".lrref();
 }
 
-sub pull () {
+sub dofetch () {
     my $multi_fetched = fork_for_multisuite(sub { });
-    fetch() unless $multi_fetched; # parent
-    return if $multi_fetched eq '0'; # child
+    fetch_one() unless $multi_fetched; # parent
+    finish 0 if $multi_fetched eq '0'; # child
+}
+
+sub pull () {
+    dofetch();
     runcmd_ordryrun_local @git, qw(merge -m),"Merge from $csuite [dgit]",
         lrref();
     printdone "fetched to ".lrref()." and merged into HEAD";
@@ -3830,7 +3853,7 @@ sub maybe_split_brain_save ($$$) {
     # => message fragment "$saved" describing disposition of $dgitview
     return "commit id $dgitview" unless defined $split_brain_save;
     my @cmd = (shell_cmd 'cd "$1"; shift', $maindir,
-              @git, qw(update-ref -m),
+              git_update_ref_cmd
               "dgit --dgit-view-save $msg HEAD=$headref",
               $split_brain_save, $dgitview);
     runcmd @cmd;
@@ -3994,10 +4017,12 @@ sub splitbrain_pseudomerge ($$$$) {
        infopair_cond_ff($i_dep14, [ $maintview, 'HEAD' ]);
        1;
     }) {
+        $@ =~ s/^\n//; chomp $@;
        print STDERR <<END;
-$us: check failed (maybe --overwrite is needed, consult documentation)
+$@
+| Not fast forward; maybe --overwrite is needed, see dgit(1)
 END
-       die "$@";
+       finish -1;
     }
 
     my $r = pseudomerge_make_commit
@@ -4030,7 +4055,7 @@ sub plain_overwrite_pseudomerge ($$$) {
        $clogp, $head, $archive_hash, $i_arch_v,
        "dgit", $m;
 
-    runcmd @git, qw(update-ref -m), $m, 'HEAD', $r, $head;
+    runcmd git_update_ref_cmd $m, 'HEAD', $r, $head;
 
     progress "Make pseudo-merge of $i_arch_v->[0] into your HEAD.";
     return $r;
@@ -4296,7 +4321,8 @@ END
        }
     }
 
-    if (defined $overwrite_version && !defined $maintviewhead) {
+    if (defined $overwrite_version && !defined $maintviewhead
+       && $archive_hash) {
        $dgithead = plain_overwrite_pseudomerge($clogp,
                                                $dgithead,
                                                $archive_hash);
@@ -4475,7 +4501,7 @@ END
 
     runcmd_ordryrun @git,
        qw(-c push.followTags=false push), access_giturl(), @pushrefs;
-    runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), $dgithead;
+    runcmd_ordryrun git_update_ref_cmd 'dgit push', lrref(), $dgithead;
 
     supplementary_message(<<'END');
 Push failed, while obtaining signatures on the .changes and .dsc.
@@ -4575,11 +4601,15 @@ sub branchsuite () {
     }
 }
 
-sub fetchpullargs () {
+sub package_from_d_control () {
     if (!defined $package) {
        my $sourcep = parsecontrol('debian/control','debian/control');
        $package = getfield $sourcep, 'Source';
     }
+}
+
+sub fetchpullargs () {
+    package_from_d_control();
     if (@ARGV==0) {
        $isuite = branchsuite();
        if (!$isuite) {
@@ -4598,9 +4628,7 @@ sub fetchpullargs () {
 sub cmd_fetch {
     parseopts();
     fetchpullargs();
-    my $multi_fetched = fork_for_multisuite(sub { });
-    finish 0 if $multi_fetched;
-    fetch();
+    dofetch();
 }
 
 sub cmd_pull {
@@ -4615,6 +4643,86 @@ END
     pull();
 }
 
+sub cmd_checkout {
+    parseopts();
+    package_from_d_control();
+    @ARGV==1 or badusage "dgit checkout needs a suite argument";
+    ($isuite) = @ARGV;
+    notpushing();
+
+    foreach my $canon (qw(0 1)) {
+       if (!$canon) {
+           $csuite= $isuite;
+       } else {
+           undef $csuite;
+           canonicalise_suite();
+       }
+       if (length git_get_ref lref()) {
+           # local branch already exists, yay
+           last;
+       }
+       if (!length git_get_ref lrref()) {
+           if (!$canon) {
+               # nope
+               next;
+           }
+           dofetch();
+       }
+       # now lrref exists
+       runcmd (@git, qw(update-ref), lref(), lrref(), '');
+       last;
+    }
+    local $ENV{GIT_REFLOG_ACTION} = git_reflog_action_msg
+        "dgit checkout $isuite";
+    runcmd (@git, qw(checkout), lbranch());
+}
+
+sub cmd_update_vcs_git () {
+    my $specsuite;
+    if (@ARGV==0 || $ARGV[0] =~ m/^-/) {
+       ($specsuite,) = split /\;/, cfg 'dgit.vcs-git.suites';
+    } else {
+       ($specsuite) = (@ARGV);
+       shift @ARGV;
+    }
+    my $dofetch=1;
+    if (@ARGV) {
+       if ($ARGV[0] eq '-') {
+           $dofetch = 0;
+       } elsif ($ARGV[0] eq '-') {
+           shift;
+       }
+    }
+
+    package_from_d_control();
+    my $ctrl;
+    if ($specsuite eq '.') {
+       $ctrl = parsecontrol 'debian/control', 'debian/control';
+    } else {
+       $isuite = $specsuite;
+       get_archive_dsc();
+       $ctrl = $dsc;
+    }
+    my $url = getfield $ctrl, 'Vcs-Git';
+
+    my @cmd;
+    my $orgurl = cfg 'remote.vcs-git.url', 'RETURN-UNDEF';
+    if (!defined $orgurl) {
+       print STDERR "setting up vcs-git: $url\n";
+       @cmd = (@git, qw(remote add vcs-git), $url);
+    } elsif ($orgurl eq $url) {
+       print STDERR "vcs git already configured: $url\n";
+    } else {
+       print STDERR "changing vcs-git url to: $url\n";
+       @cmd = (@git, qw(remote set-url vcs-git), $url);
+    }
+    runcmd_ordryrun_local @cmd;
+    if ($dofetch) {
+       print "fetching (@ARGV)\n";
+       runcmd_ordryrun_local @git, qw(fetch vcs-git), @ARGV;
+    }
+}
+
 sub prep_push () {
     parseopts();
     build_or_push_prep_early();
@@ -5065,10 +5173,12 @@ sub quiltify_splitbrain_needed () {
 sub quiltify_splitbrain ($$$$$$$) {
     my ($clogp, $unapplied, $headref, $oldtiptree, $diffbits,
        $editedignores, $cachekey) = @_;
+    my $gitignore_special = 1;
     if ($quilt_mode !~ m/gbp|dpm/) {
        # treat .gitignore just like any other upstream file
        $diffbits = { %$diffbits };
        $_ = !!$_ foreach values %$diffbits;
+       $gitignore_special = 0;
     }
     # We would like any commits we generate to be reproducible
     my @authline = clogp_authline($clogp);
@@ -5079,11 +5189,19 @@ sub quiltify_splitbrain ($$$$$$$) {
     local $ENV{GIT_AUTHOR_EMAIL} = $authline[1];
     local $ENV{GIT_AUTHOR_DATE} =  $authline[2];
 
+    my $fulldiffhint = sub {
+       my ($x,$y) = @_;
+       my $cmd = "git diff $x $y -- :/ ':!debian'";
+       $cmd .= " ':!/.gitignore' ':!*/.gitignore'" if $gitignore_special;
+       return "\nFor full diff showing the problem(s), type:\n $cmd\n";
+    };
+
     if ($quilt_mode =~ m/gbp|unapplied/ &&
        ($diffbits->{O2H} & 01)) {
        my $msg =
  "--quilt=$quilt_mode specified, implying patches-unapplied git tree\n".
  " but git tree differs from orig in upstream files.";
+       $msg .= $fulldiffhint->($unapplied, 'HEAD');
        if (!stat_exists "debian/patches") {
            $msg .=
  "\n ... debian/patches is missing; perhaps this is a patch queue branch?";
@@ -5092,7 +5210,7 @@ sub quiltify_splitbrain ($$$$$$$) {
     }
     if ($quilt_mode =~ m/dpm/ &&
        ($diffbits->{H2A} & 01)) {
-       fail <<END;
+       fail <<END. $fulldiffhint->($oldtiptree,'HEAD');
 --quilt=$quilt_mode specified, implying patches-applied git tree
  but git tree differs from result of applying debian/patches to upstream
 END
@@ -5108,7 +5226,7 @@ END
     }
     if ($quilt_mode =~ m/gbp|dpm/ &&
        ($diffbits->{O2A} & 02)) {
-       fail <<END
+       fail <<END;
 --quilt=$quilt_mode specified, implying that HEAD is for use with a
  tool which does not create patches for changes to upstream
  .gitignores: but, such patches exist in debian/patches.
@@ -5316,12 +5434,13 @@ sub quiltify ($$$$) {
            return $s;
        };
        if ($quilt_mode eq 'linear') {
-           print STDERR "$us: quilt fixup cannot be linear.  Stopped at:\n";
+           print STDERR "\n$us: error: quilt fixup cannot be linear.  Stopped at:\n";
            foreach my $notp (@nots) {
                print STDERR "$us:  ", $reportnot->($notp), "\n";
            }
            print STDERR "$us: $_\n" foreach @$failsuggestion;
-           fail "quilt fixup naive history linearisation failed.\n".
+           fail
+ "quilt history linearisation failed.  Search \`quilt fixup' in dgit(7).\n".
  "Use dpkg-source --commit by hand; or, --quilt=smash for one ugly patch";
        } elsif ($quilt_mode eq 'smash') {
        } elsif ($quilt_mode eq 'auto') {
@@ -5491,8 +5610,9 @@ END
                      make-patches --quiet-would-amend));
        # We tolerate soe snags that gdr wouldn't, by default.
        if (act_local()) {
+           debugcmd "+",@cmd;
            $!=0; $?=-1;
-           failedcmd @cmd if system @cmd and $?!=7;
+           failedcmd @cmd if system @cmd and $?!=7*256;
        } else {
            dryrun_report @cmd;
        }
@@ -6358,7 +6478,7 @@ sub cmd_quilt_fixup {
 
 sub import_dsc_result {
     my ($dstref, $newhash, $what_log, $what_msg) = @_;
-    my @cmd = (@git, qw(update-ref -m), $what_log, $dstref, $newhash);
+    my @cmd = (git_update_ref_cmd $what_log, $dstref, $newhash);
     runcmd @cmd;
     check_gitattrs($newhash, "source tree");