X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=6a153935ca4cfe1535ace227517bc57ddf24e745;hp=9edc6577a4feb3a46129321570bac783ade70c11;hb=a9561076491b74351adbf62c153fb22ea79ba255;hpb=41a084b412bdfd571a9d48d8e15604dbb72e6470

diff --git a/dgit b/dgit
index 9edc6577..6a153935 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;
@@ -147,6 +148,11 @@ sub dscfn ($) {
     return srcfn($vsn,".dsc");
 }
 
+sub changespat ($;$) {
+    my ($vsn, $arch) = @_;
+    return "${package}_".(stripepoch $vsn)."_".($arch//'*').".changes";
+}
+
 our $us = 'dgit';
 initdebug('');
 
@@ -155,7 +161,7 @@ END {
     local ($?);
     foreach my $f (@end) {
 	eval { $f->(); };
-	warn "$us: cleanup: $@" if length $@;
+	print STDERR "$us: cleanup: $@" if length $@;
     }
 };
 
@@ -1706,7 +1712,7 @@ sub clone ($) {
     canonicalise_suite();
     badusage "dry run makes no sense with clone" unless act_local();
     my $hasgit = check_for_git();
-    mkdir $dstdir or die "$dstdir $!";
+    mkdir $dstdir or fail "create \`$dstdir': $!";
     changedir $dstdir;
     runcmd @git, qw(init -q);
     my $giturl = access_giturl(1);
@@ -1997,19 +2003,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";
     }
@@ -2083,7 +2083,7 @@ END
 	sign_changes $changesfile;
     }
 
-    supplementary_message(<<'END');
+    supplementary_message(<<END);
 Push failed, while uploading package(s) to the archive server.
 You can retry the upload of exactly these same files with dput of:
   $changesfile
@@ -2131,7 +2131,13 @@ sub cmd_clone {
 		return if $!==&ENOENT;
 		die "chdir $cwd_remove: $!";
 	    }
-	    rmtree($dstdir) or die "remove $dstdir: $!\n";
+	    if (stat $dstdir) {
+		rmtree($dstdir) or die "remove $dstdir: $!\n";
+	    } elsif (!grep { $! == $_ }
+		     (ENOENT, ENOTDIR, EACCES, EPERM, ELOOP)) {
+	    } else {
+		print STDERR "check whether to remove $dstdir: $!\n";
+	    }
 	};
     }
 
@@ -2773,7 +2779,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 ($$) {
@@ -3003,6 +3009,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 () {
@@ -3052,7 +3068,7 @@ sub massage_dbp_args ($;$) {
     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, '-F' unless grep { m/^-[bBASFgG]$/ } (@$cmd, @$xargs);
     push @newcmd, @$cmd;
     @$cmd = @newcmd;
 }
@@ -3100,14 +3116,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;
@@ -3129,16 +3149,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;
@@ -3147,11 +3171,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 $!;
 }    
@@ -3313,6 +3346,9 @@ 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, $&;
@@ -3419,6 +3455,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')