X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=5fa500c65cc7ff2393d0ceb6fdce458b52446954;hp=7ca97c57f018f5b59df7ca92aa6868f8fa8ee503;hb=37913654d58e03354aa4d5a6aa5afb9c5aeca6b7;hpb=50048b4c1c41e1471cdc7054bed02ff30418ea44

diff --git a/dgit b/dgit
index 7ca97c57..5fa500c6 100755
--- a/dgit
+++ b/dgit
@@ -73,6 +73,8 @@ our $tagformat_want;
 our $tagformat;
 our $tagformatfn;
 
+our %forceopts = map { $_=>0 } qw(unrepresentable);
+
 our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
 
 our $suite_re = '[-+.0-9a-z]+';
@@ -86,7 +88,7 @@ our $splitbraincache = 'dgit-intern/quilt-cache';
 
 our (@git) = qw(git);
 our (@dget) = qw(dget);
-our (@curl) = qw(curl -f);
+our (@curl) = qw(curl);
 our (@dput) = qw(dput);
 our (@debsign) = qw(debsign);
 our (@gpg) = qw(gpg);
@@ -222,6 +224,12 @@ END {
 
 sub badcfg { print STDERR "$us: invalid configuration: @_\n"; exit 12; }
 
+sub forceable_fail ($$) {
+    my ($forceoptsl, $msg) = @_;
+    fail $msg unless grep { $forceopts{$_} } @$forceoptsl;
+    print STDERR "warning: overriding problem due to --force:\n". $msg;
+}
+
 sub no_such_package () {
     print STDERR "$us: package $package does not exist in suite $isuite\n";
     exit 4;
@@ -551,7 +559,7 @@ our %defcfg = ('dgit.default.distro' => 'debian',
 	       'dgit.default.ssh' => 'ssh',
 	       'dgit.default.archive-query' => 'madison:',
 	       'dgit.default.sshpsql-dbname' => 'service=projectb',
-	       'dgit.default.dgit-tag-format' => 'old,new,maint',
+	       'dgit.default.dgit-tag-format' => 'new,old,maint',
 	       # old means "repo server accepts pushes with old dgit tags"
 	       # new means "repo server accepts pushes with new dgit tags"
 	       # maint means "repo server accepts split brain pushes"
@@ -955,7 +963,7 @@ sub pool_dsc_subpath ($$) {
 
 sub archive_api_query_cmd ($) {
     my ($subpath) = @_;
-    my @cmd = qw(curl -sS);
+    my @cmd = (@curl, qw(-sS));
     my $url = access_cfg('archive-query-url');
     if ($url =~ m#^https://([-.0-9a-z]+)/#) {
 	my $host = $1;
@@ -989,7 +997,16 @@ sub api_query ($$) {
     badcfg "ftpmasterapi archive query method takes no data part"
 	if length $data;
     my @cmd = archive_api_query_cmd($subpath);
+    my $url = $cmd[$#cmd];
+    push @cmd, qw(-w %{http_code});
     my $json = cmdoutput @cmd;
+    unless ($json =~ s/\d+\d+\d$//) {
+	failedcmd_report_cmd undef, @cmd;
+	fail "curl failed to print 3-digit HTTP code";
+    }
+    my $code = $&;
+    fail "fetch of $url gave HTTP code $code"
+	unless $url =~ m#^file://# or $code =~ m/^2/;
     return decode_json($json);
 }
 
@@ -1321,7 +1338,7 @@ sub check_for_git () {
 	my $suffix = access_cfg('git-check-suffix','git-suffix',
 				'RETURN-UNDEF') // '.git';
 	my $url = "$prefix/$package$suffix";
-	my @cmd = (qw(curl -sS -I), $url);
+	my @cmd = (@curl, qw(-sS -I), $url);
 	my $result = cmdoutput @cmd;
 	$result =~ s/^\S+ 200 .*\n\r?\n//;
 	# curl -sS -I with https_proxy prints
@@ -2007,7 +2024,7 @@ sub complete_file_from_dsc ($$) {
 	$furl .= "/$f";
 	die "$f ?" unless $f =~ m/^\Q${package}\E_/;
 	die "$f ?" if $f =~ m#/#;
-	runcmd_ordryrun_local @curl,qw(-o),$tf,'--',"$furl";
+	runcmd_ordryrun_local @curl,qw(-f -o),$tf,'--',"$furl";
 	return 0 if !act_local();
 	$downloaded = 1;
     }
@@ -3909,7 +3926,7 @@ Commit patch to update .gitignore
 END
     }
 
-    my $dgitview = git_rev_parse 'refs/heads/dgit-view';
+    my $dgitview = git_rev_parse 'HEAD';
 
     changedir '../../../..';
     # When we no longer need to support squeeze, use --create-reflog
@@ -4596,7 +4613,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
     }
@@ -4608,7 +4625,7 @@ END
         push @failsuggestion, "This might be a patches-applied branch.";
     }
     push @failsuggestion, "Maybe you need to specify one of".
-        " --quilt=gbp --quilt=dpm --quilt=unapplied ?";
+        " --[quilt=]gbp --[quilt=]dpm --quilt=unapplied ?";
 
     if (quiltmode_splitbrain()) {
 	quiltify_splitbrain($clogp, $unapplied, $headref,
@@ -5010,6 +5027,7 @@ sub cmd_archive_api_query {
     badusage "need only 1 subpath argument" unless @ARGV==1;
     my ($subpath) = @ARGV;
     my @cmd = archive_api_query_cmd($subpath);
+    push @cmd, qw(-f);
     debugcmd ">",@cmd;
     exec @cmd or fail "exec curl: $!\n";
 }
@@ -5142,6 +5160,9 @@ sub parseopts () {
 		     ($om = $opts_opt_map{$1})) {
 		push @ropts, $_;
 		push @$om, $2;
+	    } elsif (m/^--(gbp|dpm)$/s) {
+		push @ropts, "--quilt=$1";
+		$quilt_mode = $1;
 	    } elsif (m/^--ignore-dirty$/s) {
 		push @ropts, $_;
 		$ignoredirty = 1;
@@ -5163,6 +5184,10 @@ sub parseopts () {
 	    } elsif (m/^--deliberately-($deliberately_re)$/s) {
 		push @ropts, $_;
 		push @deliberatelies, $&;
+	    } elsif (m/^--force-(.*)/ && defined $forceopts{$1}) {
+		push @ropts, $&;
+		$forceopts{$1} = 1;
+		$_='';
 	    } elsif (m/^--dgit-tag-format=(old|new)$/s) {
 		# undocumented, for testing
 		push @ropts, $_;