X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=ebf44de800ed399aa56644928f01461c9694d67a;hp=9834d03b8d682b75108beb9f489b9cd56b2982b4;hb=b6dbb3499dcc417cfbba0eb886d3df74b136e865;hpb=0929e8c0d79bd140a1a3d459042045c0d4a2b011

diff --git a/dgit b/dgit
index 9834d03b..ebf44de8 100755
--- a/dgit
+++ b/dgit
@@ -2,7 +2,8 @@
 # dgit
 # Integration between git and Debian-style archives
 #
-# Copyright (C)2013-2016 Ian Jackson
+# Copyright (C)2013-2017 Ian Jackson
+# Copyright (C)2017 Sean Whitton
 #
 # 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
@@ -17,6 +18,9 @@
 # You should have received a copy of the GNU General Public License
 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
+END { $? = $Debian::Dgit::ExitStatus::desired // -1; };
+use Debian::Dgit::ExitStatus;
+
 use strict;
 
 use Debian::Dgit qw(:DEFAULT :playground);
@@ -30,6 +34,8 @@ use File::Path;
 use File::Temp qw(tempdir);
 use File::Basename;
 use Dpkg::Version;
+use Dpkg::Compression;
+use Dpkg::Compression::Process;
 use POSIX;
 use IPC::Open2;
 use Digest::SHA;
@@ -92,7 +98,7 @@ our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
 
 our $suite_re = '[-+.0-9a-z]+';
 our $cleanmode_re = 'dpkg-source(?:-d)?|git|git-ff|check|none';
-our $orig_f_comp_re = 'orig(?:-[-0-9a-z]+)?';
+our $orig_f_comp_re = qr{orig(?:-$extra_orig_namepart_re)?};
 our $orig_f_sig_re = '\\.(?:asc|gpg|pgp)';
 our $orig_f_tail_re = "$orig_f_comp_re\\.tar(?:\\.\\w+)?(?:$orig_f_sig_re)?";
 
@@ -100,7 +106,7 @@ our $git_authline_re = '^([^<>]+) \<(\S+)\> (\d+ [-+]\d+)$';
 our $splitbraincache = 'dgit-intern/quilt-cache';
 our $rewritemap = 'dgit-rewrite/map';
 
-our @dpkg_source_ignores = qw(-i\.git/ -I.git);
+our @dpkg_source_ignores = qw(-i(?:^|/)\.git(?:/|$) -I.git);
 
 our (@git) = qw(git);
 our (@dget) = qw(dget);
@@ -111,6 +117,7 @@ our (@gpg) = qw(gpg);
 our (@sbuild) = qw(sbuild);
 our (@ssh) = 'ssh';
 our (@dgit) = qw(dgit);
+our (@git_debrebase) = qw(git-debrebase);
 our (@aptget) = qw(apt-get);
 our (@aptcache) = qw(apt-cache);
 our (@dpkgbuildpackage) = (qw(dpkg-buildpackage), @dpkg_source_ignores);
@@ -130,6 +137,7 @@ our %opts_opt_map = ('dget' => \@dget, # accept for compatibility
                      'ssh' => \@ssh,
                      'dgit' => \@dgit,
                      'git' => \@git,
+		     'git-debrebase' => \@git_debrebase,
                      'apt-get' => \@aptget,
                      'apt-cache' => \@aptcache,
                      'dpkg-source' => \@dpkgsource,
@@ -150,6 +158,7 @@ sub parseopts_late_defaults();
 sub setup_gitattrs(;$);
 sub check_gitattrs($$);
 
+our $playground;
 our $keyid;
 
 autoflush STDOUT 1;
@@ -232,7 +241,7 @@ END {
     }
 };
 
-sub badcfg { print STDERR "$us: invalid configuration: @_\n"; exit 12; }
+sub badcfg { print STDERR "$us: invalid configuration: @_\n"; finish 12; }
 
 sub forceable_fail ($$) {
     my ($forceoptsl, $msg) = @_;
@@ -250,7 +259,7 @@ sub forceing ($) {
 
 sub no_such_package () {
     print STDERR "$us: package $package does not exist in suite $isuite\n";
-    exit 4;
+    finish 4;
 }
 
 sub deliberately ($) {
@@ -283,6 +292,32 @@ sub dgit_privdir () {
     our $dgit_privdir_made //= ensure_a_playground 'dgit';
 }
 
+sub branch_gdr_info ($$) {
+    my ($symref, $head) = @_;
+    my ($status, $msg, $current, $ffq_prev, $gdrlast) =
+	gdr_ffq_prev_branchinfo($symref);
+    return () unless $status eq 'branch';
+    $ffq_prev = git_get_ref $ffq_prev;
+    $gdrlast  = git_get_ref $gdrlast;
+    $gdrlast &&= is_fast_fwd $gdrlast, $head;
+    return ($ffq_prev, $gdrlast);
+}
+
+sub branch_is_gdr ($$) {
+    my ($symref, $head) = @_;
+    my ($ffq_prev, $gdrlast) = branch_gdr_info($symref, $head);
+    return 0 unless $ffq_prev || $gdrlast;
+    return 1;
+}
+
+sub branch_is_gdr_unstitched_ff ($$$) {
+    my ($symref, $head, $ancestor) = @_;
+    my ($ffq_prev, $gdrlast) = branch_gdr_info($symref, $head);
+    return 0 unless $ffq_prev;
+    return 0 unless is_fast_fwd $ancestor, $ffq_prev;
+    return 1;
+}
+
 #---------- remote protocol support, common ----------
 
 # remote push initiator/responder protocol:
@@ -538,6 +573,7 @@ main usages:
   dgit [dgit-opts] build [dpkg-buildpackage-opts]
   dgit [dgit-opts] sbuild [sbuild-opts]
   dgit [dgit-opts] push [dgit-opts] [suite]
+  dgit [dgit-opts] push-source [dgit-opts] [suite]
   dgit [dgit-opts] rpush build-host:build-dir ...
 important dgit options:
   -k<keyid>           sign tag and package with <keyid> instead of default
@@ -554,7 +590,7 @@ END
 
 sub badusage {
     print STDERR "$us: @_\n", $helpmsg or die $!;
-    exit 8;
+    finish 8;
 }
 
 sub nextarg {
@@ -567,7 +603,7 @@ sub pre_help () {
 }
 sub cmd_help () {
     print $helpmsg or die $!;
-    exit 0;
+    finish 0;
 }
 
 our $td = $ENV{DGIT_TEST_DUMMY_DIR} || "DGIT_TEST_DUMMY_DIR-unset";
@@ -986,7 +1022,7 @@ sub commit_getclogp ($) {
     our %commit_getclogp_memo;
     my $memo = $commit_getclogp_memo{$objid};
     return $memo if $memo;
-    
+
     my $mclog = dgit_privdir()."clog";
     runcmd shell_cmd "exec >$mclog", @git, qw(cat-file blob),
 	"$objid:debian/changelog";
@@ -1679,7 +1715,7 @@ our ($dsc_distro, $dsc_hint_tag, $dsc_hint_url);
 
 sub prep_ud () {
     dgit_privdir(); # ensures that $dgit_privdir_made is based on $maindir
-    fresh_playground 'dgit/unpack';
+    $playground = fresh_playground 'dgit/unpack';
 }
 
 sub mktree_in_ud_here () {
@@ -1846,6 +1882,40 @@ sub is_orig_file_of_vsn ($$) {
     return 1;
 }
 
+# This function determines whether a .changes file is source-only from
+# the point of view of dak.  Thus, it permits *_source.buildinfo
+# files.
+#
+# It does not, however, permit any other buildinfo files.  After a
+# source-only upload, the buildds will try to upload files like
+# foo_1.2.3_amd64.buildinfo.  If the package maintainer included files
+# named like this in their (otherwise) source-only upload, the uploads
+# of the buildd can be rejected by dak.  Fixing the resultant
+# situation can require manual intervention.  So we block such
+# .buildinfo files when the user tells us to perform a source-only
+# upload (such as when using the push-source subcommand with the -C
+# option, which calls this function).
+#
+# Note, though, that when dgit is told to prepare a source-only
+# upload, such as when subcommands like build-source and push-source
+# without -C are used, dgit has a more restrictive notion of
+# source-only .changes than dak: such uploads will never include
+# *_source.buildinfo files.  This is because there is no use for such
+# files when using a tool like dgit to produce the source package, as
+# dgit ensures the source is identical to git HEAD.
+sub test_source_only_changes ($) {
+    my ($changes) = @_;
+    foreach my $l (split /\n/, getfield $changes, 'Files') {
+        $l =~ m/\S+$/ or next;
+        # \.tar\.[a-z0-9]+ covers orig.tar and the tarballs in native packages
+        unless ($& =~ m/(?:\.dsc|\.diff\.gz|\.tar\.[a-z0-9]+|_source\.buildinfo)$/) {
+            print "purportedly source-only changes polluted by $&\n";
+            return 0;
+        }
+    }
+    return 1;
+}
+
 sub changes_update_origs_from_dsc ($$$$) {
     my ($dsc, $changes, $upstreamvsn, $changesfile) = @_;
     my %changes_f;
@@ -2383,7 +2453,7 @@ END
 	local $ENV{GIT_AUTHOR_DATE} =  $authline[2];
 
 	my $path = $ENV{PATH} or die;
-	
+
 	# we use ../../gbp-pq-output, which (given that we are in
 	# $playground/PLAYTREE, and $playground is .git/dgit/unpack,
 	# is .git/dgit.
@@ -3469,7 +3539,7 @@ sub fork_for_multisuite ($) {
 					       sub {
             @end = ();
             fetch();
-	    exit 0;
+	    finish 0;
 	});
 	# xxx collecte the ref here
 
@@ -3653,15 +3723,7 @@ sub check_not_dirty () {
 
     return if $ignoredirty;
 
-    my @cmd = (@git, qw(diff --quiet HEAD));
-    debugcmd "+",@cmd;
-    $!=0; $?=-1; system @cmd;
-    return if !$?;
-    if ($?==256) {
-	fail "working tree is dirty (does not match HEAD)";
-    } else {
-	failedcmd @cmd;
-    }
+    git_check_unmodified();
 }
 
 sub commit_admin ($) {
@@ -3670,6 +3732,15 @@ sub commit_admin ($) {
     runcmd_ordryrun_local @git, qw(commit -m), $m;
 }
 
+sub quiltify_nofix_bail ($$) {
+    my ($headinfo, $xinfo) = @_;
+    if ($quilt_mode eq 'nofix') {
+	fail "quilt fixup required but quilt mode is \`nofix'\n".
+	    "HEAD commit".$headinfo." differs from tree implied by ".
+	    " debian/patches".$xinfo;
+    }
+}
+
 sub commit_quilty_patch () {
     my $output = cmdoutput @git, qw(status --porcelain);
     my %adds;
@@ -3684,6 +3755,7 @@ sub commit_quilty_patch () {
 	progress "nothing quilty to commit, ok.";
 	return;
     }
+    quiltify_nofix_bail "", " (wanted to commit patch update)";
     my @adds = map { s/[][*?\\]/\\$&/g; $_; } sort keys %adds;
     runcmd_ordryrun_local @git, qw(add -f), @adds;
     commit_admin <<END
@@ -3844,6 +3916,8 @@ sub pseudomerge_make_commit ($$$$ $$) {
 	: !length  $overwrite_version ? " --overwrite"
 	: " --overwrite=".$overwrite_version;
 
+    # Contributing parent is the first parent - that makes
+    # git rev-list --first-parent DTRT.
     my $pmf = dgit_privdir()."/pseudomerge";
     open MC, ">", $pmf or die "$pmf $!";
     print MC <<END or die $!;
@@ -4172,7 +4246,14 @@ END
     my $format = getfield $dsc, 'Format';
     printdebug "format $format\n";
 
+    my $symref = git_get_symref();
     my $actualhead = git_rev_parse('HEAD');
+
+    if (branch_is_gdr_unstitched_ff($symref, $actualhead, $archive_hash)) {
+	runcmd_ordryrun_local @git_debrebase, 'stitch';
+	$actualhead = git_rev_parse('HEAD');
+    }
+
     my $dgithead = $actualhead;
     my $maintviewhead = undef;
 
@@ -4188,7 +4269,7 @@ END
 		quilt_check_splitbrain_cache($actualhead, $upstreamversion);
 	    $dgithead or fail
  "--quilt=$quilt_mode but no cached dgit view:
- perhaps tree changed since dgit build[-source] ?";
+ perhaps HEAD changed since dgit build[-source] ?";
 	    $split_brain = 1;
 	    $dgithead = splitbrain_pseudomerge($clogp,
 					       $actualhead, $dgithead,
@@ -4238,13 +4319,42 @@ END
     my $r = system @diffcmd;
     if ($r) {
 	if ($r==256) {
+	    my $referent = $split_brain ? $dgithead : 'HEAD';
 	    my $diffs = cmdoutput @git, qw(diff --stat), $tree, $dgithead;
-	    fail <<END
+
+	    my @mode_changes;
+	    my $raw = cmdoutput @git,
+		qw(diff --no-renames -z -r --raw), $tree, $dgithead;
+	    my $changed;
+	    foreach (split /\0/, $raw) {
+		if (defined $changed) {
+		    push @mode_changes, "$changed: $_\n" if $changed;
+		    $changed = undef;
+		    next;
+		} elsif (m/^:0+ 0+ /) {
+		    $changed = '';
+		} elsif (m/^:(?:10*)?(\d+) (?:10*)?(\d+) /) {
+		    $changed = "Mode change from $1 to $2"
+		} else {
+		    die "$_ ?";
+		}
+	    }
+	    if (@mode_changes) {
+		fail <<END.(join '', @mode_changes).<<END;
+HEAD specifies a different tree to $dscfn:
+$diffs
+END
+There is a problem with your source tree (see dgit(7) for some hints).
+To see a full diff, run git diff $tree $referent
+END
+	    }
+
+	    fail <<END;
 HEAD specifies a different tree to $dscfn:
 $diffs
 Perhaps you forgot to build.  Or perhaps there is a problem with your
  source tree (see dgit(7) for some hints).  To see a full diff, run
-   git diff $tree HEAD
+   git diff $tree $referent
 END
 	} else {
 	    failedcmd @diffcmd;
@@ -4443,13 +4553,8 @@ sub cmd_clone {
 }
 
 sub branchsuite () {
-    my @cmd = (@git, qw(symbolic-ref -q HEAD));
-    my $branch = cmdoutput_errok @cmd;
-    if (!defined $branch) {
-	$?==256 or failedcmd @cmd;
-	return undef;
-    }
-    if ($branch =~ m#$lbranch_re#o) {
+    my $branch = git_get_symref();
+    if (defined $branch && $branch =~ m#$lbranch_re#o) {
 	return $1;
     } else {
 	return undef;
@@ -4480,7 +4585,7 @@ sub cmd_fetch {
     parseopts();
     fetchpullargs();
     my $multi_fetched = fork_for_multisuite(sub { });
-    exit 0 if $multi_fetched;
+    finish 0 if $multi_fetched;
     fetch();
 }
 
@@ -4527,6 +4632,21 @@ sub cmd_push {
     dopush();
 }
 
+sub cmd_push_source {
+    prep_push();
+    if ($changesfile) {
+        my $changes = parsecontrol("$buildproductsdir/$changesfile",
+                                   "source changes file");
+        unless (test_source_only_changes($changes)) {
+            fail "user-specified changes file is not source-only";
+        }
+    } else {
+        # Building a source package is very fast, so just do it
+        build_source_for_push();
+    }
+    dopush();
+}
+
 #---------- remote commands' implementation ----------
 
 sub pre_remote_push_build_host {
@@ -4674,7 +4794,7 @@ sub i_resp_complete {
 
     i_cleanup();
     printdebug "all done\n";
-    exit 0;
+    finish 0;
 }
 
 sub i_resp_file ($) {
@@ -5124,11 +5244,7 @@ sub quiltify ($$$$) {
 	    last;
 	}
 
-	if ($quilt_mode eq 'nofix') {
-	    fail "quilt fixup required but quilt mode is \`nofix'\n".
-		"HEAD commit $c->{Commit} differs from tree implied by ".
-		" debian/patches (tree object $oldtiptree)";
-	}
+	quiltify_nofix_bail " $c->{Commit}", " (tree object $oldtiptree)";
 	if ($quilt_mode eq 'smash') {
 	    printdebug " search quitting smash\n";
 	    last;
@@ -5342,6 +5458,32 @@ END
 
     my $clogp = parsechangelog();
     my $headref = git_rev_parse('HEAD');
+    my $symref = git_get_symref();
+
+    if ($quilt_mode eq 'linear'
+	&& !$fopts->{'single-debian-patch'}
+	&& branch_is_gdr($symref, $headref)) {
+	# This is much faster.  It also makes patches that gdr
+	# likes better for future updates without laundering.
+	#
+	# However, it can fail in some casses where we would
+	# succeed: if there are existing patches, which correspond
+	# to a prefix of the branch, but are not in gbp/gdr
+	# format, gdr will fail (exiting status 7), but we might
+	# be able to figure out where to start linearising.  That
+	# will be slower so hopefully there's not much to do.
+	my @cmd = (@git_debrebase,
+		   qw(--noop-ok -funclean-mixed -funclean-ordering
+		      make-patches --quiet-would-amend));
+	# We tolerate soe snags that gdr wouldn't, by default.
+	if (act_local()) {
+	    $!=0; $?=-1;
+	    failedcmd @cmd if system @cmd and $?!=7;
+	} else {
+	    dryrun_report @cmd;
+	}
+	$headref = git_rev_parse('HEAD');
+    }
 
     prep_ud();
     changedir $playground;
@@ -5505,7 +5647,7 @@ sub quilt_check_splitbrain_cache ($$) {
 	if (!stat "$maindir_gitcommon/logs/refs/$splitbraincache") {
 	    $! == ENOENT or die $!;
 	    printdebug ">(no reflog)\n";
-	    exit 0;
+	    finish 0;
 	}
 	exec @cmd; die $!;
     }
@@ -5631,6 +5773,7 @@ sub quilt_fixup_multipatch ($$$) {
 
     rmtree '.pc';
 
+    rmtree 'debian'; # git checkout commitish paths does not delete!
     runcmd @git, qw(checkout -f), $headref, qw(-- debian);
     my $unapplied=git_add_write_tree();
     printdebug "fake orig tree object $unapplied\n";
@@ -5757,7 +5900,7 @@ sub quilt_fixup_editor () {
     }
     I2->error and die $!;
     close O or die $1;
-    exit 0;
+    finish 0;
 }
 
 sub maybe_apply_patches_dirtily () {
@@ -6112,21 +6255,14 @@ sub cmd_gbp_build {
 }
 sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0
 
+sub build_source_for_push {
+    build_source();
+    maybe_unapply_patches_again();
+    $changesfile = $sourcechanges;
+}
+
 sub build_source {
     build_prep_early();
-    my $our_cleanmode = $cleanmode;
-    if ($need_split_build_invocation) {
-	# Pretend that clean is being done some other way.  This
-	# forces us not to try to use dpkg-buildpackage to clean and
-	# build source all in one go; and instead we run dpkg-source
-	# (and build_prep() will do the clean since $clean_using_builder
-	# is false).
-	$our_cleanmode = 'ELSEWHERE';
-    }
-    if ($our_cleanmode =~ m/^dpkg-source/) {
-	# dpkg-source invocation (below) will clean, so build_prep shouldn't
-	$clean_using_builder = 1;
-    }
     build_prep();
     $sourcechanges = changespat $version,'source';
     if (act_local()) {
@@ -6134,43 +6270,33 @@ sub build_source {
 	    or fail "remove $sourcechanges: $!";
     }
     $dscfn = dscfn($version);
-    if ($our_cleanmode eq 'dpkg-source') {
-	maybe_apply_patches_dirtily();
-	runcmd_ordryrun_local @dpkgbuildpackage, qw(-us -uc -S),
-	    changesopts();
-    } elsif ($our_cleanmode eq 'dpkg-source-d') {
-	maybe_apply_patches_dirtily();
-	runcmd_ordryrun_local @dpkgbuildpackage, qw(-us -uc -S -d),
-	    changesopts();
+    my @cmd = (@dpkgsource, qw(-b --));
+    if ($split_brain) {
+        changedir $playground;
+        runcmd_ordryrun_local @cmd, "work";
+        my @udfiles = <${package}_*>;
+        changedir $maindir;
+        foreach my $f (@udfiles) {
+            printdebug "source copy, found $f\n";
+            next unless
+              $f eq $dscfn or
+              ($f =~ m/\.debian\.tar(?:\.\w+)$/ &&
+               $f eq srcfn($version, $&));
+            printdebug "source copy, found $f - renaming\n";
+            rename "$playground/$f", "../$f" or $!==ENOENT
+              or fail "put in place new source file ($f): $!";
+        }
     } else {
-	my @cmd = (@dpkgsource, qw(-b --));
-	if ($split_brain) {
-	    changedir $playground;
-	    runcmd_ordryrun_local @cmd, "work";
-	    my @udfiles = <${package}_*>;
-	    changedir $maindir;
-	    foreach my $f (@udfiles) {
-		printdebug "source copy, found $f\n";
-		next unless
-		    $f eq $dscfn or
-		    ($f =~ m/\.debian\.tar(?:\.\w+)$/ &&
-		     $f eq srcfn($version, $&));
-		printdebug "source copy, found $f - renaming\n";
-		rename "$playground/$f", "../$f" or $!==ENOENT
-		    or fail "put in place new source file ($f): $!";
-	    }
-	} else {
-	    my $pwd = must_getcwd();
-	    my $leafdir = basename $pwd;
-	    changedir "..";
-	    runcmd_ordryrun_local @cmd, $leafdir;
-	    changedir $pwd;
-	}
-	runcmd_ordryrun_local qw(sh -ec),
-	    'exec >$1; shift; exec "$@"','x',
-	    "../$sourcechanges",
-	    @dpkggenchanges, qw(-S), changesopts();
+        my $pwd = must_getcwd();
+        my $leafdir = basename $pwd;
+        changedir "..";
+        runcmd_ordryrun_local @cmd, $leafdir;
+        changedir $pwd;
     }
+    runcmd_ordryrun_local qw(sh -ec),
+      'exec >$1; shift; exec "$@"','x',
+      "../$sourcechanges",
+      @dpkggenchanges, qw(-S), changesopts();
 }
 
 sub cmd_build_source {
@@ -6391,6 +6517,7 @@ sub pre_archive_api_query () {
 sub cmd_archive_api_query {
     badusage "need only 1 subpath argument" unless @ARGV==1;
     my ($subpath) = @ARGV;
+    local $isuite = 'DGIT-API-QUERY-CMD';
     my @cmd = archive_api_query_cmd($subpath);
     push @cmd, qw(-f);
     debugcmd ">",@cmd;
@@ -6463,7 +6590,7 @@ sub cmd_setup_new_tree {
 
 sub cmd_version {
     print "dgit version $our_version\n" or die $!;
-    exit 0;
+    finish 0;
 }
 
 our (%valopts_long, %valopts_short);
@@ -6815,7 +6942,7 @@ print STDERR "DAMP RUN - WILL MAKE LOCAL (UNSIGNED) CHANGES\n"
     if $dryrun_level == 1;
 if (!@ARGV) {
     print STDERR $helpmsg or die $!;
-    exit 8;
+    finish 8;
 }
 $cmd = $subcommand = shift @ARGV;
 $cmd =~ y/-/_/;
@@ -6829,3 +6956,5 @@ git_slurp_config();
 my $fn = ${*::}{"cmd_$cmd"};
 $fn or badusage "unknown operation $cmd";
 $fn->();
+
+finish 0;