X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=dgit;h=e22036b7d75ca308d3b605217a44ef71839b5505;hb=0065acabe8a273a32c30043fc41ee063166d29ce;hp=33306dade1b87c45c507964eb7199333946cb342;hpb=8e9303a546371cfa631ff5f16ea4d7fdcfa6fad8;p=dgit.git

diff --git a/dgit b/dgit
index 33306dad..e22036b7 100755
--- a/dgit
+++ b/dgit
@@ -41,6 +41,7 @@ use Carp;
 use Debian::Dgit;
 
 our $our_version = 'UNRELEASED'; ###substituted###
+our $absurdity = undef; ###substituted###
 
 our @rpushprotovsn_support = qw(4 3 2); # 4 is new tag format
 our $protovsn;
@@ -73,7 +74,9 @@ our $tagformat_want;
 our $tagformat;
 our $tagformatfn;
 
-our %forceopts = map { $_=>0 } ();
+our %forceopts = map { $_=>0 }
+    qw(unrepresentable unsupported-source-format
+       dsc-changes-mismatch);
 
 our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
 
@@ -146,6 +149,11 @@ our @ourdscfield = qw(Dgit Vcs-Dgit-Master);
 our $csuite;
 our $instead_distro;
 
+if (!defined $absurdity) {
+    $absurdity = $0;
+    $absurdity =~ s{/[^/]+$}{/absurd} or die;
+}
+
 sub debiantag ($$) {
     my ($v,$distro) = @_;
     return $tagformatfn->($v, $distro);
@@ -230,6 +238,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;
@@ -1302,7 +1318,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;
@@ -1948,25 +1966,48 @@ END
 	local $ENV{GIT_AUTHOR_EMAIL} = $authline[1];
 	local $ENV{GIT_AUTHOR_DATE} =  $authline[2];
 
-	eval {
-	    runcmd shell_cmd 'exec >/dev/null 2>../../gbp-pq-output',
-		gbp_pq, qw(import);
-	};
-	if ($@) {
-	    { local $@; eval { runcmd qw(cat ../../gbp-pq-output); }; }
-	    die $@;
-	}
+	my $path = $ENV{PATH} or die;
 
-	my $gapplied = git_rev_parse('HEAD');
-	my $gappliedtree = cmdoutput @git, qw(rev-parse HEAD:);
-	$gappliedtree eq $dappliedtree or
-	    fail <<END;
+	foreach my $use_absurd (qw(0 1)) {
+	    local $ENV{PATH} = $path;
+	    if ($use_absurd) {
+		chomp $@;
+		progress "warning: $@";
+		$path = "$absurdity:$path";
+		progress "$us: trying slow absurd-git-apply...";
+		rename "../../gbp-pq-output","../../gbp-pq-output.0"
+		    or die $!;
+	    }
+	    eval {
+		local $ENV{PATH} = $path if $use_absurd;
+
+		my @showcmd = (gbp_pq, qw(import));
+		my @realcmd = shell_cmd
+		    'exec >/dev/null 2>../../gbp-pq-output', @showcmd;
+		debugcmd "+",@realcmd;
+		if (system @realcmd) {
+		    die +(shellquote @showcmd).
+			" failed: ".
+			failedcmd_waitstatus()."\n";
+		}
+
+		my $gapplied = git_rev_parse('HEAD');
+		my $gappliedtree = cmdoutput @git, qw(rev-parse HEAD:);
+		$gappliedtree eq $dappliedtree or
+		    fail <<END;
 gbp-pq import and dpkg-source disagree!
  gbp-pq import gave commit $gapplied
  gbp-pq import gave tree $gappliedtree
  dpkg-source --before-build gave tree $dappliedtree
 END
-	$rawimport_hash = $gapplied;
+		$rawimport_hash = $gapplied;
+	    };
+	    last unless $@;
+	}
+	if ($@) {
+	    { local $@; eval { runcmd qw(cat ../../gbp-pq-output); }; }
+	    die $@;
+	}
     }
 
     progress "synthesised git commit from .dsc $cversion";
@@ -3259,7 +3300,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:
 
@@ -4613,7 +4655,7 @@ END
     if (@unrepres) {
 	print STDERR "dgit:  cannot represent change: $_->[1]: $_->[0]\n"
 	    foreach @unrepres;
-	fail <<END;
+	forceable_fail [qw(unrepresentable)], <<END;
 HEAD has changes to .orig[s] which are not representable by `3.0 (quilt)'
 END
     }