X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=7508fe15a2493295e01f0d3cc7587472cc51b2f1;hp=f821299f4d06e129de1be4ba6093fac50c867789;hb=7b98714769cf69198c85113476b65f07455305e8;hpb=05db7ab051736bb106467e7f83b9e45684dd227c

diff --git a/dgit b/dgit
index f821299f..7508fe15 100755
--- a/dgit
+++ b/dgit
@@ -74,7 +74,11 @@ our $tagformat_want;
 our $tagformat;
 our $tagformatfn;
 
-our %forceopts = map { $_=>0 } qw(unrepresentable);
+our %forceopts = map { $_=>0 }
+    qw(unrepresentable unsupported-source-format
+       dsc-changes-mismatch
+       import-gitapply-absurd
+       import-gitapply-no-absurd);
 
 our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
 
@@ -236,6 +240,14 @@ sub forceable_fail ($$) {
     print STDERR "warning: overriding problem due to --force:\n". $msg;
 }
 
+sub forceing ($) {
+    my ($forceoptsl) = @_;
+    my @got = grep { $forceopts{$_} } @$forceoptsl;
+    return 0 unless @got;
+    print STDERR
+ "warning: skipping checks or functionality due to --force-$got[0]\n";
+}
+
 sub no_such_package () {
     print STDERR "$us: package $package does not exist in suite $isuite\n";
     exit 4;
@@ -1308,7 +1320,9 @@ sub get_archive_dsc () {
 	$dsc = parsecontrolfh($dscfh,$dscurl,1);
 	printdebug Dumper($dsc) if $debuglevel>1;
 	my $fmt = getfield $dsc, 'Format';
-	fail "unsupported source format $fmt, sorry" unless $format_ok{$fmt};
+	$format_ok{$fmt} or forceable_fail [qw(unsupported-source-format)],
+	    "unsupported source format $fmt, sorry";
+	    
 	$dsc_checked = !!$digester;
 	printdebug "get_archive_dsc: Version ".(getfield $dsc, 'Version')."\n";
 	return;
@@ -1964,9 +1978,15 @@ END
 		$path = "$absurdity:$path";
 		progress "$us: trying slow absurd-git-apply...";
 		rename "../../gbp-pq-output","../../gbp-pq-output.0"
+		    or $!==ENOENT
 		    or die $!;
 	    }
 	    eval {
+		die "forbid absurd git-apply\n" if $use_absurd
+		    && forceing [qw(import-gitapply-no-absurd)];
+		die "only absurd git-apply!\n" if !$use_absurd
+		    && forceing [qw(import-gitapply-absurd)];
+
 		local $ENV{PATH} = $path if $use_absurd;
 
 		my @showcmd = (gbp_pq, qw(import));
@@ -3288,7 +3308,8 @@ END
 
     # Check that changes and .dsc agree enough
     $changesfile =~ m{[^/]*$};
-    files_compare_inputs($dsc, parsecontrol($changesfile,$&));
+    files_compare_inputs($dsc, parsecontrol($changesfile,$&))
+	unless forceing [qw(dsc-changes-mismatch)];
 
     # Checks complete, we're going to try and go ahead:
 
@@ -4870,11 +4891,87 @@ sub massage_dbp_args ($;$) {
     return $r;
 }
 
+sub in_parent (&) {
+    my ($fn) = @_;
+    my $wasdir = must_getcwd();
+    changedir "..";
+    $fn->();
+    changedir $wasdir;
+}    
+
+sub postbuild_mergechanges ($) { # must run with CWD=.. (eg in in_parent)
+    my ($msg_if_onlyone) = @_;
+    # If there is only one .changes file, fail with $msg_if_onlyone,
+    # or if that is undef, be a no-op.
+    # Returns the changes file to report to the user.
+    my $pat = changespat $version;
+    my @changesfiles = glob $pat;
+    @changesfiles = sort {
+	($b =~ m/_source\.changes$/ <=> $a =~ m/_source\.changes$/)
+	    or $a cmp $b
+    } @changesfiles;
+    my $result;
+    if (@changesfiles==1) {
+	fail <<END.$msg_if_onlyone if defined $msg_if_onlyone;
+only one changes file from build (@changesfiles)
+END
+	$result = $changesfiles[0];
+    } elsif (@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 = 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}: $!";
+	    }
+	}
+	$result = $multichanges;
+    } else {
+	fail "wrong number of different changes files (@changesfiles)";
+    }
+    printdone "build successful, results in $result\n" or die $!;
+}
+
+sub midbuild_checkchanges () {
+    my $pat = changespat $version;
+    return if $rmchanges;
+    my @unwanted = map { s#^\.\./##; $_; } glob "../$pat";
+    @unwanted = grep { $_ ne changespat $version,'source' } @unwanted;
+    fail <<END
+changes files other than source matching $pat already present; building would result in ambiguity about the intended results.
+Suggest you delete @unwanted.
+END
+	if @unwanted;
+}
+
+sub midbuild_checkchanges_vanilla ($) {
+    my ($wantsrc) = @_;
+    midbuild_checkchanges() if $wantsrc == 1;
+}
+
+sub postbuild_mergechanges_vanilla ($) {
+    my ($wantsrc) = @_;
+    if ($wantsrc == 1) {
+	in_parent {
+	    postbuild_mergechanges(undef);
+	};
+    } else {
+	printdone "build successful\n";
+    }
+}
+
 sub cmd_build {
     my @dbp = (@dpkgbuildpackage, qw(-us -uc), changesopts_initial(), @ARGV);
     my $wantsrc = massage_dbp_args \@dbp;
     if ($wantsrc > 0) {
 	build_source();
+	midbuild_checkchanges_vanilla $wantsrc;
     } else {
 	build_prep();
     }
@@ -4884,7 +4981,7 @@ sub cmd_build {
 	runcmd_ordryrun_local @dbp;
     }
     maybe_unapply_patches_again();
-    printdone "build successful\n";
+    postbuild_mergechanges_vanilla $wantsrc;
 }
 
 sub pre_gbp_build {
@@ -4909,6 +5006,7 @@ sub cmd_gbp_build {
 
     if ($wantsrc > 0) {
 	build_source();
+	midbuild_checkchanges_vanilla $wantsrc;
     } else {
 	if (!$clean_using_builder) {
 	    push @cmd, '--git-cleaner=true';
@@ -4920,7 +5018,7 @@ sub cmd_gbp_build {
 	push @cmd, changesopts();
 	runcmd_ordryrun_local @cmd, @ARGV;
     }
-    printdone "build successful\n";
+    postbuild_mergechanges_vanilla $wantsrc;
 }
 sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0
 
@@ -4993,53 +5091,22 @@ 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 <<END
-changes files other than source matching $pat already present; building would result in ambiguity about the intended results.
-Suggest you delete @unwanted.
-END
-	    if @unwanted;
-    }
-    my $wasdir = must_getcwd();
-    changedir "..";
-    if (act_local()) {
-	stat_exists $dscfn or fail "$dscfn (in parent directory): $!";
-	stat_exists $sourcechanges
-	    or fail "$sourcechanges (in parent directory): $!";
-    }
-    runcmd_ordryrun_local @sbuild, qw(-d), $isuite, @ARGV, $dscfn;
-    my @changesfiles = glob $pat;
-    @changesfiles = sort {
-	($b =~ m/_source\.changes$/ <=> $a =~ m/_source\.changes$/)
-	    or $a cmp $b
-    } @changesfiles;
-    fail <<END if @changesfiles==1;
-only one changes file from sbuild (@changesfiles)
+    midbuild_checkchanges();
+    in_parent {
+	if (act_local()) {
+	    stat_exists $dscfn or fail "$dscfn (in parent directory): $!";
+	    stat_exists $sourcechanges
+		or fail "$sourcechanges (in parent directory): $!";
+	}
+	runcmd_ordryrun_local @sbuild, qw(-d), $isuite, @ARGV, $dscfn;
+    };
+    maybe_unapply_patches_again();
+    in_parent {
+	postbuild_mergechanges(<<END);
 perhaps you need to pass -A ?  (sbuild's default is to build only
 arch-specific binaries; dgit 1.4 used to override that.)
 END
-    fail "wrong number of different changes files (@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 = 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}: $!";
-	}
-    }
-    changedir $wasdir;
-    maybe_unapply_patches_again();
-    printdone "build successful, results in $multichanges\n" or die $!;
+    };
 }    
 
 sub cmd_quilt_fixup {
@@ -5217,6 +5284,10 @@ sub parseopts () {
 		push @ropts, $&;
 		$forceopts{$1} = 1;
 		$_='';
+	    } elsif (m/^--force-/) {
+		print STDERR
+		    "$us: warning: ignoring unknown force option $_\n";
+		$_='';
 	    } elsif (m/^--dgit-tag-format=(old|new)$/s) {
 		# undocumented, for testing
 		push @ropts, $_;