X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=2c72213a56bd04ace2af90aaa6514ee164de5a9e;hp=0b66d390ea6adc6f5bd102fd4480f81e639d8933;hb=e17b7eb17ed4aa309c1a1b3757db1e0fc123df68;hpb=cb99709100a32fdb6a1544f4bf9aac8c5f2b4804

diff --git a/dgit b/dgit
index 0b66d390..2c72213a 100755
--- a/dgit
+++ b/dgit
@@ -59,6 +59,7 @@ our %previously;
 our $existing_package = 'dpkg';
 our $cleanmode;
 our $changes_since_version;
+our $rmchanges;
 our $quilt_mode;
 our $quilt_modes_re = 'linear|smash|auto|nofix|nocheck';
 our $we_are_responder;
@@ -112,6 +113,7 @@ our $keyid;
 autoflush STDOUT 1;
 
 our $supplementary_message = '';
+our $need_split_build_invocation = 0;
 
 END {
     local ($@, $?);
@@ -147,6 +149,11 @@ sub dscfn ($) {
     return srcfn($vsn,".dsc");
 }
 
+sub changespat ($;$) {
+    my ($vsn, $arch) = @_;
+    return "${package}_".(stripepoch $vsn)."_".($arch//'*').".changes";
+}
+
 our $us = 'dgit';
 initdebug('');
 
@@ -1202,10 +1209,12 @@ our ($dsc_hash,$lastpush_hash);
 
 our $ud = '.git/dgit/unpack';
 
-sub prep_ud () {
-    rmtree($ud);
+sub prep_ud (;$) {
+    my ($d) = @_;
+    $d //= $ud;
+    rmtree($d);
     mkpath '.git/dgit';
-    mkdir $ud or die $!;
+    mkdir $d or die $!;
 }
 
 sub mktree_in_ud_here () {
@@ -1970,6 +1979,7 @@ END
     my $format = getfield $dsc, 'Format';
     printdebug "format $format\n";
     if (madformat($format)) {
+	# user might have not used dgit build, so maybe do this now:
 	commit_quilty_patch();
     }
     check_not_dirty();
@@ -1997,19 +2007,13 @@ END
     }
     my $head = git_rev_parse('HEAD');
     if (!$changesfile) {
-	my $multi = "$buildproductsdir/".
-	    "${package}_".(stripepoch $cversion)."_multi.changes";
-	if (stat_exists "$multi") {
-	    $changesfile = $multi;
-	} else {
-	    my $pat = "${package}_".(stripepoch $cversion)."_*.changes";
-	    my @cs = glob "$buildproductsdir/$pat";
-	    fail "failed to find unique changes file".
-		" (looked for $pat in $buildproductsdir, or $multi);".
-		" perhaps you need to use dgit -C"
-		unless @cs==1;
-	    ($changesfile) = @cs;
-	}
+	my $pat = changespat $cversion;
+	my @cs = glob "$buildproductsdir/$pat";
+	fail "failed to find unique changes file".
+	    " (looked for $pat in $buildproductsdir);".
+	    " perhaps you need to use dgit -C"
+	    unless @cs==1;
+	($changesfile) = @cs;
     } else {
 	$changesfile = "$buildproductsdir/$changesfile";
     }
@@ -2506,14 +2510,15 @@ END
     }
 }
 
-sub quiltify_trees_differ ($$) {
-    my ($x,$y) = @_;
+sub quiltify_trees_differ ($$;$) {
+    my ($x,$y,$ignoregitignore) = @_;
     # returns 1 iff the two tree objects differ other than in debian/
     local $/=undef;
     my @cmd = (@git, qw(diff-tree --name-only -z), $x, $y);
     my $diffs= cmdoutput @cmd;
     foreach my $f (split /\0/, $diffs) {
 	next if $f eq 'debian';
+	next if $f eq '.gitignore' && $ignoregitignore;
 	return 1;
     }
     return 0;
@@ -2528,8 +2533,15 @@ sub quiltify_tree_sentinelfiles ($) {
     return $r;
 }
 
-sub quiltify ($$) {
-    my ($clogp,$target) = @_;
+sub quilt_could_gbp ($$$) {
+    my ($userhead,$unapplied,$applied) = @_;
+    return
+	!quiltify_trees_differ($userhead,$unapplied,1) &&
+	quiltify_trees_differ($userhead,$applied,1);
+}
+
+sub quiltify ($$$$) {
+    my ($clogp,$target,$unapplied,$oldtiptree) = @_;
 
     # Quilt patchification algorithm
     #
@@ -2555,14 +2567,6 @@ sub quiltify ($$) {
     # After traversing PT, we git commit the changes which
     # should be contained within debian/patches.
 
-    changedir '../fake';
-    remove_stray_gits();
-    mktree_in_ud_here();
-    rmtree '.pc';
-    runcmd @git, qw(add -Af .);
-    my $oldtiptree=git_write_tree();
-    changedir '../work';
-
     # The search for the path S..T is breadth-first.  We maintain a
     # todo list containing search nodes.  A search node identifies a
     # commit, and looks something like this:
@@ -2675,6 +2679,12 @@ sub quiltify ($$) {
 	    foreach my $notp (@nots) {
 		print STDERR "$us:  ", $reportnot->($notp), "\n";
 	    }
+	    if (quilt_could_gbp($target,$unapplied,$oldtiptree)) {
+		print STDERR <<END;
+$us: Tree looks like a patches-unapplied git branch.
+$us: Maybe you forgot --quilt=gbp (aka --quilt=apply) ?
+END
+	    }
 	    fail "quilt fixup naive history linearisation failed.\n".
  "Use dpkg-source --commit by hand; or, --quilt=smash for one ugly patch";
 	} elsif ($quilt_mode eq 'smash') {
@@ -2779,7 +2789,7 @@ sub quilt_fixup_mkwork ($) {
     mkdir "work" or die $!;
     changedir "work";
     mktree_in_ud_here();
-    runcmd @git, qw(reset --hard), $headref;
+    runcmd @git, qw(reset -q --hard), $headref;
 }
 
 sub quilt_fixup_linkorigs ($$) {
@@ -2880,6 +2890,31 @@ sub quilt_fixup_multipatch ($$$) {
     #     5. If we had a .pc in-tree, delete it, and git-commit
     #     6. Back in the main tree, fast forward to the new HEAD
 
+    # Another situation we may have to cope with is gbp-style
+    # patches-unapplied trees.
+    #
+    # We would want to detect these, so we know to escape into
+    # quilt_fixup_gbp.  However, this is in general not possible.
+    # Consider a package with a one patch which the dgit user reverts
+    # (with git-revert or the moral equivalent).
+    #
+    # That is indistinguishable in contents from a patches-unapplied
+    # tree.  And looking at the history to distinguish them is not
+    # useful because the user might have made a confusing-looking git
+    # history structure (which ought to produce an error if dgit can't
+    # cope, not a silent reintroduction of an unwanted patch).
+    #
+    # So gbp users will have to pass an option.  But we can usually
+    # detect their failure to do so: if the tree is not a clean
+    # patches-applied tree, quilt linearisation fails, but the tree
+    # _is_ a clean patches-unapplied tree, we can suggest that maybe
+    # they want --quilt=unapplied.
+    #
+    # To help detect this, when we are extracting the fake dsc, we
+    # first extract it with --skip-patches, and then apply the patches
+    # afterwards with dpkg-source --before-build.  That lets us save a
+    # tree object corresponding to .origs.
+
     my $fakeversion="$upstreamversion-~~DGITFAKE";
 
     my $fakedsc=new IO::File 'fake.dsc', '>' or die $!;
@@ -2905,7 +2940,8 @@ END
 
     quilt_fixup_linkorigs($upstreamversion, $dscaddfile);
 
-    my @files=qw(debian/source/format debian/rules);
+    my @files=qw(debian/source/format debian/rules
+                 debian/control debian/changelog);
     foreach my $maybe (qw(debian/patches debian/source/options)) {
         next unless stat_exists "../../../$maybe";
         push @files, $maybe;
@@ -2917,11 +2953,30 @@ END
     $dscaddfile->($debtar);
     close $fakedsc or die $!;
 
-    runcmd qw(sh -ec), 'exec dpkg-source --no-check -x fake.dsc >/dev/null';
+    runcmd qw(sh -ec),
+        'exec dpkg-source --no-check --skip-patches -x fake.dsc >/dev/null';
 
     my $fakexdir= $package.'-'.(stripepoch $upstreamversion);
     rename $fakexdir, "fake" or die "$fakexdir $!";
 
+    changedir 'fake';
+
+    remove_stray_gits();
+    mktree_in_ud_here();
+
+    rmtree '.pc';
+
+    runcmd @git, qw(add -Af .);
+    my $unapplied=git_write_tree();
+    printdebug "fake orig tree object $unapplied\n";
+
+    ensuredir '.pc';
+
+    runcmd qw(sh -ec),
+        'exec dpkg-source --before-build . >/dev/null';
+
+    changedir '..';
+
     quilt_fixup_mkwork($headref);
 
     my $mustdeletepc=0;
@@ -2933,7 +2988,13 @@ END
         rename '../fake/.pc','.pc' or die $!;
     }
 
-    quiltify($clogp,$headref);
+    changedir '../fake';
+    rmtree '.pc';
+    runcmd @git, qw(add -Af .);
+    my $oldtiptree=git_write_tree();
+    changedir '../work';
+
+    quiltify($clogp,$headref,$unapplied,$oldtiptree);
 
     if (!open P, '>>', ".pc/applied-patches") {
 	$!==&ENOENT or die $!;
@@ -3009,6 +3070,16 @@ sub build_prep () {
     $package = getfield $clogp, 'Source';
     $version = getfield $clogp, 'Version';
     build_maybe_quilt_fixup();
+    if ($rmchanges) {
+	my $pat = changespat $version;
+	foreach my $f (glob "$buildproductsdir/$pat") {
+	    if (act_local()) {
+		unlink $f or fail "remove old changes file $f: $!";
+	    } else {
+		progress "would remove $f";
+	    }
+	}
+    }
 }
 
 sub changesopts_initial () {
@@ -3048,33 +3119,73 @@ sub changesopts () {
 
 sub massage_dbp_args ($;$) {
     my ($cmd,$xargs) = @_;
-    if ($cleanmode eq 'dpkg-source') {
+    # We need to:
+    #
+    #  - if we're going to split the source build out so we can
+    #    do strange things to it, massage the arguments to dpkg-buildpackage
+    #    so that the main build doessn't build source (or add an argument
+    #    to stop it building source by default).
+    #
+    #  - add -nc to stop dpkg-source cleaning the source tree,
+    #    unless we're not doing a split build and want dpkg-source
+    #    as cleanmode, in which case we can do nothing
+    #
+    # return values:
+    #    0 - source will NOT need to be built separately by caller
+    #   +1 - source will need to be built separately by caller
+    #   +2 - source will need to be built separately by caller AND
+    #        dpkg-buildpackage should not in fact be run at all!
+    debugcmd '#massaging#', @$cmd if $debuglevel>1;
+#print STDERR "MASS0 ",Dumper($cmd, $xargs, $need_split_build_invocation);
+    if ($cleanmode eq 'dpkg-source' && !$need_split_build_invocation) {
 	$suppress_clean = 1;
-	return;
+	return 0;
     }
-    debugcmd '#massaging#', @$cmd if $debuglevel>1;
-    my @newcmd = shift @$cmd;
     # -nc has the side effect of specifying -b if nothing else specified
-    push @newcmd, '-nc';
     # and some combinations of -S, -b, et al, are errors, rather than
-    # later simply overriding earlier
-    push @newcmd, '-F' unless grep { m/^-[bBASF]$/ } (@$cmd, @$xargs);
-    push @newcmd, @$cmd;
-    @$cmd = @newcmd;
+    # later simply overriding earlie.  So we need to:
+    #  - search the command line for these options
+    #  - pick the last one
+    #  - perhaps add our own as a default
+    #  - perhaps adjust it to the corresponding non-source-building version
+    my $dmode = '-F';
+    foreach my $l ($cmd, $xargs) {
+	next unless $l;
+	@$l = grep { !(m/^-[SgGFABb]$/s and $dmode=$_) } @$l;
+    }
+    push @$cmd, '-nc';
+#print STDERR "MASS1 ",Dumper($cmd, $xargs, $dmode);
+    my $r = 0;
+    if ($need_split_build_invocation) {
+	$r = $dmode =~ m/[S]/     ? +2 :
+	     $dmode =~ y/gGF/ABb/ ? +1 :
+	     $dmode =~ m/[ABb]/   ?  0 :
+	     die "$dmode ?";
+    }
+    push @$cmd, $dmode;
+#print STDERR "MASS2 ",Dumper($cmd, $xargs, $r);
+    return $r;
 }
 
 sub cmd_build {
     my @dbp = (@dpkgbuildpackage, qw(-us -uc), changesopts_initial(), @ARGV);
-    massage_dbp_args \@dbp;
-    build_prep();
-    push @dbp, changesopts_version();
-    runcmd_ordryrun_local @dbp;
+    my $wantsrc = massage_dbp_args \@dbp;
+    if ($wantsrc > 0) {
+	build_source();
+    } else {
+	build_prep();
+    }
+    if ($wantsrc < 2) {
+	push @dbp, changesopts_version();
+	runcmd_ordryrun_local @dbp;
+    }
     printdone "build successful\n";
 }
 
 sub cmd_gbp_build {
     my @dbp = @dpkgbuildpackage;
-    massage_dbp_args \@dbp, \@ARGV;
+
+    my $wantsrc = massage_dbp_args \@dbp, \@ARGV;
 
     my @cmd;
     if (length executable_on_path('git-buildpackage')) {
@@ -3084,18 +3195,22 @@ sub cmd_gbp_build {
     }
     push @cmd, (qw(-us -uc --git-no-sign-tags), "--git-builder=@dbp");
 
-    if ($cleanmode eq 'dpkg-source') {
-	$suppress_clean = 1;
+    if ($wantsrc > 0) {
+	build_source();
     } else {
-	push @cmd, '--git-cleaner=true';
+	if (!$suppress_clean) {
+	    push @cmd, '--git-cleaner=true';
+	}
+	build_prep();
     }
-    build_prep();
-    unless (grep { m/^--git-debian-branch|^--git-ignore-branch/ } @ARGV) {
-	canonicalise_suite();
-	push @cmd, "--git-debian-branch=".lbranch();
+    if ($wantsrc < 2) {
+	unless (grep { m/^--git-debian-branch|^--git-ignore-branch/ } @ARGV) {
+	    canonicalise_suite();
+	    push @cmd, "--git-debian-branch=".lbranch();
+	}
+	push @cmd, changesopts();
+	runcmd_ordryrun_local @cmd, @ARGV;
     }
-    push @cmd, changesopts();
-    runcmd_ordryrun_local @cmd, @ARGV;
     printdone "build successful\n";
 }
 sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0
@@ -3106,14 +3221,18 @@ sub build_source {
 	$suppress_clean = 1;
     }
     build_prep();
-    $sourcechanges = "${package}_".(stripepoch $version)."_source.changes";
+    $sourcechanges = changespat $version,'source';
+    if (act_local()) {
+	unlink "../$sourcechanges" or $!==ENOENT
+	    or fail "remove $sourcechanges: $!";
+    }
     $dscfn = dscfn($version);
     if ($cleanmode eq 'dpkg-source') {
-	runcmd_ordryrun_local (@dpkgbuildpackage, qw(-us -uc -S)),
-	    changesopts();
+	runcmd_ordryrun_local @dpkgbuildpackage, qw(-us -uc -S),
+			       changesopts();
     } elsif ($cleanmode eq 'dpkg-source-d') {
-	runcmd_ordryrun_local (@dpkgbuildpackage, qw(-us -uc -S -d)),
-	    changesopts();
+	runcmd_ordryrun_local @dpkgbuildpackage, qw(-us -uc -S -d),
+			       changesopts();
     } else {
 	my $pwd = must_getcwd();
 	my $leafdir = basename $pwd;
@@ -3135,16 +3254,20 @@ sub cmd_build_source {
 
 sub cmd_sbuild {
     build_source();
+    my $pat = changespat $version;
+    if (!$rmchanges) {
+	my @unwanted = map { s#^\.\./##; $_; } glob "../$pat";
+	@unwanted = grep { $_ ne changespat $version,'source' } @unwanted;
+	fail "changes files other than source matching $pat".
+	    " already present (@unwanted);".
+	    " building would result in ambiguity about the intended results"
+	    if @unwanted;
+    }
     changedir "..";
-    my $pat = "${package}_".(stripepoch $version)."_*.changes";
     if (act_local()) {
 	stat_exists $dscfn or fail "$dscfn (in parent directory): $!";
 	stat_exists $sourcechanges
 	    or fail "$sourcechanges (in parent directory): $!";
-	foreach my $cf (glob $pat) {
-	    next if $cf eq $sourcechanges;
-	    unlink $cf or fail "remove $cf: $!";
-	}
     }
     runcmd_ordryrun_local @sbuild, qw(-d), $isuite, @ARGV, $dscfn;
     my @changesfiles = glob $pat;
@@ -3153,11 +3276,20 @@ sub cmd_sbuild {
 	    or $a cmp $b
     } @changesfiles;
     fail "wrong number of different changes files (@changesfiles)"
-	unless @changesfiles;
+	unless @changesfiles==2;
+    my $binchanges = parsecontrol($changesfiles[1], "binary changes file");
+    foreach my $l (split /\n/, getfield $binchanges, 'Files') {
+	fail "$l found in binaries changes file $binchanges"
+	    if $l =~ m/\.dsc$/;
+    }
     runcmd_ordryrun_local @mergechanges, @changesfiles;
-    my $multichanges = "${package}_".(stripepoch $version)."_multi.changes";
+    my $multichanges = changespat $version,'multi';
     if (act_local()) {
 	stat_exists $multichanges or fail "$multichanges: $!";
+	foreach my $cf (glob $pat) {
+	    next if $cf eq $multichanges;
+	    rename "$cf", "$cf.inmulti" or fail "$cf\{,.inmulti}: $!";
+	}
     }
     printdone "build successful, results in $multichanges\n" or die $!;
 }    
@@ -3319,9 +3451,16 @@ sub parseopts () {
 	    } elsif (m/^--no-rm-on-error$/s) {
 		push @ropts, $_;
 		$rmonerror = 0;
+	    } elsif (m/^--(no-)?rm-old-changes$/s) {
+		push @ropts, $_;
+		$rmchanges = !$1;
 	    } elsif (m/^--deliberately-($deliberately_re)$/s) {
 		push @ropts, $_;
 		push @deliberatelies, $&;
+	    } elsif (m/^--always-split-source-build$/s) {
+		# undocumented, for testing
+		push @ropts, $_;
+		$need_split_build_invocation = 1;
 	    } elsif (m/^(--[-0-9a-z]+)(=|$)/ && ($oi = $valopts_long{$1})) {
 		$val = $2 ? $' : undef; #';
 		$valopt->($oi->{Long});
@@ -3425,6 +3564,11 @@ if (!@ARGV) {
 my $cmd = shift @ARGV;
 $cmd =~ y/-/_/;
 
+if (!defined $rmchanges) {
+    local $access_forpush;
+    $rmchanges = access_cfg_bool(0, 'rm-old-changes');
+}
+
 if (!defined $quilt_mode) {
     local $access_forpush;
     $quilt_mode = cfg('dgit.force.quilt-mode', 'RETURN-UNDEF')