X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=dgit;h=1f065dd3bbc9436804f53a52bfa50fb117553dc0;hb=ae3881653a4639a9c3017ffdb187b49ebe9fcea3;hp=3420d5ca9715ebf26a6b4eeebf9d0c5e4aba45ca;hpb=58c8f2001ffd3e7525c719d2b11197d96cf23785;p=dgit.git

diff --git a/dgit b/dgit
index 3420d5ca..1f065dd3 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);
@@ -94,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)?";
 
@@ -113,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);
@@ -132,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,
@@ -152,6 +158,7 @@ sub parseopts_late_defaults();
 sub setup_gitattrs(;$);
 sub check_gitattrs($$);
 
+our $playground;
 our $keyid;
 
 autoflush STDOUT 1;
@@ -234,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) = @_;
@@ -252,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 ($) {
@@ -285,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:
@@ -528,11 +561,6 @@ sub runcmd_ordryrun_local {
     }
 }
 
-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]
@@ -540,6 +568,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
@@ -556,7 +585,7 @@ END
 
 sub badusage {
     print STDERR "$us: @_\n", $helpmsg or die $!;
-    exit 8;
+    finish 8;
 }
 
 sub nextarg {
@@ -569,7 +598,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";
@@ -1681,7 +1710,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 () {
@@ -3359,38 +3388,57 @@ sub open_main_gitattrs () {
     return $gai;
 }
 
+our $gitattrs_ourmacro_re = qr{^\[attr\]dgit-defuse-attrs\s};
+
 sub is_gitattrs_setup () {
+    # return values:
+    #  trueish
+    #     1: gitattributes set up and should be left alone
+    #  falseish
+    #     0: there is a dgit-defuse-attrs but it needs fixing
+    #     undef: there is none
     my $gai = open_main_gitattrs();
     return 0 unless $gai;
     while (<$gai>) {
-	return 1 if m{^\[attr\]dgit-defuse-attrs\s};
+	next unless m{$gitattrs_ourmacro_re};
+	return 1 if m{\s-working-tree-encoding\s};
+	printdebug "is_gitattrs_setup: found old macro\n";
+	return 0;
     }
     $gai->error and die $!;
-    return 0;
+    printdebug "is_gitattrs_setup: found nothing\n";
+    return undef;
 }    
 
 sub setup_gitattrs (;$) {
     my ($always) = @_;
     return unless $always || access_cfg_bool(1, 'setup-gitattributes');
 
-    if (is_gitattrs_setup()) {
+    my $already = is_gitattrs_setup();
+    if ($already) {
 	progress <<END;
-[attr]dgit-defuse-attrs already found in .git/info/attributes
+[attr]dgit-defuse-attrs already found, and proper, in .git/info/attributes
  not doing further gitattributes setup
 END
 	return;
     }
+    my $new = "[attr]dgit-defuse-attrs	$negate_harmful_gitattrs";
     my $af = "$maindir_gitcommon/info/attributes";
     ensuredir "$maindir_gitcommon/info";
+
     open GAO, "> $af.new" or die $!;
-    print GAO <<END or die $!;
+    print GAO <<END or die $! unless defined $already;
 *	dgit-defuse-attrs
-[attr]dgit-defuse-attrs	$negate_harmful_gitattrs
+$new
 # ^ see GITATTRIBUTES in dgit(7) and dgit setup-new-tree in dgit(1)
 END
     my $gai = open_main_gitattrs();
     if ($gai) {
 	while (<$gai>) {
+	    if (m{$gitattrs_ourmacro_re}) {
+		die unless defined $already;
+		$_ = $new;
+	    }
 	    chomp;
 	    print GAO $_, "\n" or die $!;
 	}
@@ -3425,7 +3473,7 @@ sub check_gitattrs ($$) {
 	# oh dear, found one
 	print STDERR <<END;
 dgit: warning: $what contains .gitattributes
-dgit: .gitattributes have not been defused.  Recommended: dgit setup-new-tree.
+dgit: .gitattributes not (fully) defused.  Recommended: dgit setup-new-tree.
 END
 	close $gafl;
 	return;
@@ -3505,7 +3553,7 @@ sub fork_for_multisuite ($) {
 					       sub {
             @end = ();
             fetch();
-	    exit 0;
+	    finish 0;
 	});
 	# xxx collecte the ref here
 
@@ -3689,15 +3737,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 ($) {
@@ -3706,12 +3746,21 @@ 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;
     foreach my $l (split /\n/, $output) {
 	next unless $l =~ m/\S/;
-	if ($l =~ m{^(?:\?\?| M) (.pc|debian/patches)}) {
+	if ($l =~ m{^(?:\?\?| [MADRC]) (.pc|debian/patches)}) {
 	    $adds{$1}++;
 	}
     }
@@ -3720,6 +3769,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
@@ -3880,6 +3930,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 $!;
@@ -4208,7 +4260,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;
 
@@ -4508,13 +4567,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;
@@ -4545,7 +4599,7 @@ sub cmd_fetch {
     parseopts();
     fetchpullargs();
     my $multi_fetched = fork_for_multisuite(sub { });
-    exit 0 if $multi_fetched;
+    finish 0 if $multi_fetched;
     fetch();
 }
 
@@ -4592,6 +4646,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 {
@@ -4739,7 +4808,7 @@ sub i_resp_complete {
 
     i_cleanup();
     printdebug "all done\n";
-    exit 0;
+    finish 0;
 }
 
 sub i_resp_file ($) {
@@ -5189,11 +5258,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;
@@ -5407,6 +5472,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;
@@ -5570,7 +5661,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 $!;
     }
@@ -5696,6 +5787,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";
@@ -5822,7 +5914,7 @@ sub quilt_fixup_editor () {
     }
     I2->error and die $!;
     close O or die $1;
-    exit 0;
+    finish 0;
 }
 
 sub maybe_apply_patches_dirtily () {
@@ -5926,13 +6018,21 @@ sub changesopts_initial () {
 
 sub changesopts_version () {
     if (!defined $changes_since_version) {
-	my @vsns = archive_query('archive_query');
-	my @quirk = access_quirk();
-	if ($quirk[0] eq 'backports') {
-	    local $isuite = $quirk[2];
-	    local $csuite;
-	    canonicalise_suite();
-	    push @vsns, archive_query('archive_query');
+	my @vsns;
+	unless (eval {
+	    @vsns = archive_query('archive_query');
+	    my @quirk = access_quirk();
+	    if ($quirk[0] eq 'backports') {
+		local $isuite = $quirk[2];
+		local $csuite;
+		canonicalise_suite();
+		push @vsns, archive_query('archive_query');
+	    }
+	    1;
+	}) {
+	    print STDERR $@;
+	    fail
+ "archive query failed (queried because --since-version not specified)";
 	}
 	if (@vsns) {
 	    @vsns = map { $_->[0] } @vsns;
@@ -6177,6 +6277,12 @@ 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();
     build_prep();
@@ -6433,6 +6539,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;
@@ -6505,7 +6612,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);
@@ -6857,7 +6964,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/-/_/;
@@ -6871,3 +6978,5 @@ git_slurp_config();
 my $fn = ${*::}{"cmd_$cmd"};
 $fn or badusage "unknown operation $cmd";
 $fn->();
+
+finish 0;