chiark / gitweb /
po4a: pairwise-pocheck: Force it to be run sometimes
[dgit.git] / dgit
diff --git a/dgit b/dgit
index e0ebfba..e104838 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -101,7 +101,11 @@ our %forceopts = map { $_=>0 }
 our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
 
 our $suite_re = '[-+.0-9a-z]+';
-our $cleanmode_re = 'dpkg-source(?:-d)?|git|git-ff|check|none';
+our $cleanmode_re = qr{(?: dpkg-source (?: -d )? (?: ,no-check | ,all-check )?
+                         | git | git-ff
+                         | check (?: ,ignores )?
+                         | none
+                         )}x;
 
 our $git_authline_re = '^([^<>]+) \<(\S+)\> (\d+ [-+]\d+)$';
 our $splitbraincache = 'dgit-intern/quilt-cache';
@@ -379,6 +383,10 @@ sub branch_is_gdr ($) {
            printdebug "branch_is_gdr  $walk ?-octopus NO\n";
            return 0;
        }
+       if (!@parents) {
+           printdebug "branch_is_gdr  $walk origin\n";
+           return 0;
+       }
        if ($get_patches->($walk) ne $tip_patches) {
            # Our parent added, removed, or edited patches, and wasn't
            # a gdr make-patches commit.  gdr make-patches probably
@@ -512,11 +520,11 @@ sub protocol_send_file ($$) {
        my $got = read PF, $d, 65536;
        die "$ourfn: $!" unless defined $got;
        last if !$got;
-       print $fh "data-block ".length($d)."\n" or die $!;
-       print $fh $d or die $!;
+       print $fh "data-block ".length($d)."\n" or confess $!;
+       print $fh $d or confess $!;
     }
     PF->error and die "$ourfn $!";
-    print $fh "data-end\n" or die $!;
+    print $fh "data-end\n" or confess $!;
     close PF;
 }
 
@@ -541,9 +549,9 @@ sub protocol_receive_file ($$) {
        } $fh;
        last unless $y;
        my $d = protocol_read_bytes $fh, $l;
-       print PF $d or die $!;
+       print PF $d or confess $!;
     }
-    close PF or die $!;
+    close PF or confess $!;
 }
 
 #---------- remote protocol support, responder ----------
@@ -553,7 +561,7 @@ sub responder_send_command ($) {
     return unless $we_are_responder;
     # called even without $we_are_responder
     printdebug ">> $command\n";
-    print PO $command, "\n" or die $!;
+    print PO $command, "\n" or confess $!;
 }    
 
 sub responder_send_file ($$) {
@@ -588,8 +596,8 @@ sub initiator_expect (&) {
 sub progress {
     if ($we_are_responder) {
        my $m = join '', @_;
-       responder_send_command "progress ".length($m) or die $!;
-       print PO $m or die $!;
+       responder_send_command "progress ".length($m) or confess $!;
+       print PO $m or confess $!;
     } else {
        print @_, "\n";
     }
@@ -604,7 +612,7 @@ sub url_get {
     }
     my $what = $_[$#_];
     progress "downloading $what...";
-    my $r = $ua->get(@_) or die $!;
+    my $r = $ua->get(@_) or confess $!;
     return undef if $r->code == 404;
     $r->is_success or fail f_ "failed to fetch %s: %s",
        $what, $r->status_line;
@@ -668,7 +676,7 @@ Perhaps the upload is stuck in incoming.  Using the version from git.
 END
 
 sub badusage {
-    print STDERR f_ "%s: %s\n%s", $us, "@_", __ $helpmsg or die $!;
+    print STDERR f_ "%s: %s\n%s", $us, "@_", __ $helpmsg or confess $!;
     finish 8;
 }
 
@@ -681,7 +689,7 @@ sub pre_help () {
     not_necessarily_a_tree();
 }
 sub cmd_help () {
-    print __ $helpmsg or die $!;
+    print __ $helpmsg or confess $!;
     finish 0;
 }
 
@@ -786,6 +794,9 @@ sub git_get_config ($) {
        @$l==1 or badcfg
            f_ "multiple values for %s (in %s git config)", $c, $src
            if @$l > 1;
+       $l->[0] =~ m/\n/ and badcfg f_
+ "value for config option %s (in %s git config) contains newline(s)!",
+            $c, $src;
        return $l->[0];
     }
     return undef;
@@ -928,8 +939,8 @@ sub supplementary_message ($) {
        return;
     } elsif ($protovsn >= 3) {
        responder_send_command "supplementary-message ".length($msg)
-           or die $!;
-       print PO $msg or die $!;
+           or confess $!;
+       print PO $msg or confess $!;
     }
 }
 
@@ -1066,7 +1077,7 @@ sub commit_getclogp ($) {
 }
 
 sub parse_dscdata () {
-    my $dscfh = new IO::File \$dscdata, '<' or die $!;
+    my $dscfh = new IO::File \$dscdata, '<' or confess $!;
     printdebug Dumper($dscdata) if $debuglevel>1;
     $dsc = parsecontrolfh($dscfh,$dscurl,1);
     printdebug Dumper($dsc) if $debuglevel>1;
@@ -1289,12 +1300,12 @@ sub aptget_prep ($) {
        access_cfg('mirror'),
        $aptsuites,
        access_cfg('aptget-components')
-       or die $!;
+       or confess $!;
 
     ensuredir "$aptget_base/cache";
     ensuredir "$aptget_base/lists";
 
-    open CONF, ">", $aptget_configpath or die $!;
+    open CONF, ">", $aptget_configpath or confess $!;
     print CONF <<END;
 Debug::NoLocking "true";
 APT::Get::List-Cleanup "false";
@@ -1314,10 +1325,10 @@ END
                        Dir::Etc::preferencesparts
                      )) {
        ensuredir "$aptget_base/$key";
-       print CONF "$key \"$quoted_base/$key\";\n" or die $!;
+       print CONF "$key \"$quoted_base/$key\";\n" or confess $!;
     };
 
-    my $oldatime = (time // die $!) - 1;
+    my $oldatime = (time // confess $!) - 1;
     foreach my $oldlist (<$aptget_base/lists/*Release>) {
        next unless stat_exists $oldlist;
        my ($mtime) = (stat _)[9];
@@ -1417,7 +1428,7 @@ sub dummycatapi_run_in_mirror ($@) {
     my @cmd = (qw(sh -ec), 'cd "$1"; shift'."\n".$rune,
               qw(x), $mirror, @$argl);
     debugcmd "-|", @cmd;
-    open FIA, "-|", @cmd or die $!;
+    open FIA, "-|", @cmd or confess $!;
     my $r = $fn->();
     close FIA or ($!==0 && $?==141) or die failedcmd @cmd;
     return $r;
@@ -1520,7 +1531,7 @@ sub sshpsql ($$$) {
               " export LC_MESSAGES=C; export LC_CTYPE=C;".
               " ".shellquote qw(psql -A), $dbname, qw(-c), $sql);
     debugcmd "|",@cmd;
-    open P, "-|", @cmd or die $!;
+    open P, "-|", @cmd or confess $!;
     while (<P>) {
        chomp or die;
        printdebug(">|$_|\n");
@@ -1821,7 +1832,7 @@ sub remove_stray_gits ($) {
     my ($what) = @_;
     my @gitscmd = qw(find -name .git -prune -print0);
     debugcmd "|",@gitscmd;
-    open GITS, "-|", @gitscmd or die $!;
+    open GITS, "-|", @gitscmd or confess $!;
     {
        local $/="\0";
        while (<GITS>) {
@@ -2220,18 +2231,18 @@ sub generate_commits_from_dsc () {
 
        printdebug "considering saving $f: ";
 
-       if (link $f, $upper_f) {
+       if (rename_link_xf 1, $f, $upper_f) {
            printdebug "linked.\n";
-       } elsif ((printdebug "($!) "),
+       } elsif ((printdebug "($@) "),
                 $! != EEXIST) {
-           fail f_ "saving %s: %s", "$buildproductsdir/$f", $!;
+           fail f_ "saving %s: %s", "$buildproductsdir/$f", $@;
        } elsif (!$refetched) {
            printdebug "no need.\n";
-       } elsif (link $f, "$upper_f,fetch") {
+       } elsif (rename_link_xf 1, $f, "$upper_f,fetch") {
            printdebug "linked (using ...,fetch).\n";
-       } elsif ((printdebug "($!) "),
+       } elsif ((printdebug "($@) "),
                 $! != EEXIST) {
-           fail f_ "saving %s: %s", "$buildproductsdir/$f,fetch", $!;
+           fail f_ "saving %s: %s", "$buildproductsdir/$f,fetch", $@;
        } else {
            printdebug "cannot.\n";
        }
@@ -2278,9 +2289,9 @@ sub generate_commits_from_dsc () {
                new Dpkg::Compression::Process compression => $cname;
            @compr_cmd = $compr_proc->get_uncompress_cmdline();
            my $compr_fh = new IO::Handle;
-           my $compr_pid = open $compr_fh, "-|" // die $!;
+           my $compr_pid = open $compr_fh, "-|" // confess $!;
            if (!$compr_pid) {
-               open STDIN, "<&", $input or die $!;
+               open STDIN, "<&", $input or confess $!;
                exec @compr_cmd;
                die "dgit (child): exec $compr_cmd[0]: $!\n";
            }
@@ -2288,23 +2299,23 @@ sub generate_commits_from_dsc () {
        }
 
        rmtree "_unpack-tar";
-       mkdir "_unpack-tar" or die $!;
+       mkdir "_unpack-tar" or confess $!;
        my @tarcmd = qw(tar -x -f -
                        --no-same-owner --no-same-permissions
                        --no-acls --no-xattrs --no-selinux);
-       my $tar_pid = fork // die $!;
+       my $tar_pid = fork // confess $!;
        if (!$tar_pid) {
-           chdir "_unpack-tar" or die $!;
-           open STDIN, "<&", $input or die $!;
+           chdir "_unpack-tar" or confess $!;
+           open STDIN, "<&", $input or confess $!;
            exec @tarcmd;
            die f_ "dgit (child): exec %s: %s", $tarcmd[0], $!;
        }
-       $!=0; (waitpid $tar_pid, 0) == $tar_pid or die $!;
+       $!=0; (waitpid $tar_pid, 0) == $tar_pid or confess $!;
        !$? or failedcmd @tarcmd;
 
        close $input or
            (@compr_cmd ? ($?==SIGPIPE || failedcmd @compr_cmd)
-            : die $!);
+            : confess $!);
        # finally, we have the results in "tarball", but maybe
        # with the wrong permissions
 
@@ -2461,14 +2472,14 @@ END_T
 
     printdebug "import main commit\n";
 
-    open C, ">../commit.tmp" or die $!;
-    print C <<END or die $!;
+    open C, ">../commit.tmp" or confess $!;
+    print C <<END or confess $!;
 tree $tree
 END
-    print C <<END or die $! foreach @tartrees;
+    print C <<END or confess $! foreach @tartrees;
 parent $_->{Commit}
 END
-    print C <<END or die $!;
+    print C <<END or confess $!;
 author $authline
 committer $authline
 
@@ -2477,7 +2488,7 @@ $changes
 [dgit import $treeimporthow $package $cversion]
 END
 
-    close C or die $!;
+    close C or confess $!;
     my $rawimport_hash = make_commit qw(../commit.tmp);
 
     if (madformat $dsc->{format}) {
@@ -2522,7 +2533,7 @@ END
                progress f_ "%s: trying slow absurd-git-apply...", $us;
                rename "../../gbp-pq-output","../../gbp-pq-output.0"
                    or $!==ENOENT
-                   or die $!;
+                   or confess $!;
            }
            eval {
                die "forbid absurd git-apply\n" if $use_absurd
@@ -2588,7 +2599,7 @@ Version actually in archive:   %s (older)
 Last version pushed with dgit: %s (newer or same)
 %s
 END
-               __ $later_warning_msg or die $!;
+               __ $later_warning_msg or confess $!;
             @output = $lastpush_mergeinput;
         } else {
            # Same version.  Use what's in the server git branch,
@@ -2618,7 +2629,7 @@ sub complete_file_from_dsc ($$;$) {
        open F, "<", "$tf" or die "$tf: $!";
        $fi->{Digester}->reset();
        $fi->{Digester}->addfile(*F);
-       F->error and die $!;
+       F->error and confess $!;
        $got = $fi->{Digester}->hexdigest();
        return $got eq $fi->{Hash};
     };
@@ -2752,7 +2763,7 @@ sub git_lrfetch_sane {
        debugcmd "|",@lcmd;
 
        my %wantr;
-       open GITLS, "-|", @lcmd or die $!;
+       open GITLS, "-|", @lcmd or confess $!;
        while (<GITLS>) {
            printdebug "=> ", $_;
            m/^(\w+)\s+(\S+)\n/ or die "ls-remote $_ ?";
@@ -3173,7 +3184,7 @@ sub fetch_from_archive () {
            printdebug "del_lrfetchrefs: $objid $fullrefname\n";
            if (!$gur) {
                $gur ||= new IO::Handle;
-               open $gur, "|-", qw(git update-ref --stdin) or die $!;
+               open $gur, "|-", qw(git update-ref --stdin) or confess $!;
            }
            printf $gur "delete %s %s\n", $fullrefname, $objid;
        }
@@ -3194,7 +3205,7 @@ Commit referred to by archive: %s
 Last version pushed with dgit: %s
 %s
 END
-               __ $later_warning_msg or die $!;
+               __ $later_warning_msg or confess $!;
            @mergeinputs = ($lastpush_mergeinput);
        } else {
            # Archive has .dsc which is not a descendant of the last dgit
@@ -3229,11 +3240,11 @@ END
 Package not found in the archive, but has allegedly been pushed using dgit.
 %s
 END
-           __ $later_warning_msg or die $!;
+           __ $later_warning_msg or confess $!;
     } else {
        printdebug "nothing found!\n";
        if (defined $skew_warning_vsn) {
-           print STDERR f_ <<END, $skew_warning_vsn or die $!;
+           print STDERR f_ <<END, $skew_warning_vsn or confess $!;
 
 Warning: relevant archive skew detected.
 Archive allegedly contains %s
@@ -3299,26 +3310,26 @@ END
 
        my $mcf = dgit_privdir()."/mergecommit";
        open MC, ">", $mcf or die "$mcf $!";
-       print MC <<END or die $!;
+       print MC <<END or confess $!;
 tree $tree
 END
 
        my @parents = grep { $_->{Commit} } @mergeinputs;
        @parents = reverse @parents if $compat_info->{ReverseParents};
-       print MC <<END or die $! foreach @parents;
+       print MC <<END or confess $! foreach @parents;
 parent $_->{Commit}
 END
 
-       print MC <<END or die $!;
+       print MC <<END or confess $!;
 author $author
 committer $author
 
 END
 
        if (defined $compat_info->{Message}) {
-           print MC $compat_info->{Message} or die $!;
+           print MC $compat_info->{Message} or confess $!;
        } else {
-           print MC f_ <<END, $package, $cversion, $csuite or die $!;
+           print MC f_ <<END, $package, $cversion, $csuite or confess $!;
 Record %s (%s) in archive suite %s
 
 Record that
@@ -3327,17 +3338,17 @@ END
                my ($mi) = (@_);
                my $mversion = mergeinfo_version $mi;
                printf MC "  %-20s %s\n", $mversion, $mi->{Info}
-                   or die $!;
+                   or confess $!;
            };
 
            $message_add_info->($mergeinputs[0]);
-           print MC __ <<END or die $!;
+           print MC __ <<END or confess $!;
 should be treated as descended from
 END
            $message_add_info->($_) foreach @mergeinputs[1..$#mergeinputs];
        }
 
-       close MC or die $!;
+       close MC or confess $!;
        $hash = make_commit $mcf;
     } else {
        $hash = $mergeinputs[0]{Commit};
@@ -3362,7 +3373,7 @@ END
        my $got_vsn = getfield $gotclogp, 'Version';
        printdebug "SKEW CHECK GOT $got_vsn\n";
        if (version_compare($got_vsn, $skew_warning_vsn) < 0) {
-           print STDERR f_ <<END, $skew_warning_vsn, $got_vsn or die $!;
+           print STDERR f_ <<END, $skew_warning_vsn, $got_vsn or confess $!;
 
 Warning: archive skew detected.  Using the available version:
 Archive allegedly contains    %s
@@ -3406,12 +3417,12 @@ sub setup_mergechangelogs (;$) {
        while (<ATTRS>) {
            chomp;
            next if m{^debian/changelog\s};
-           print NATTRS $_, "\n" or die $!;
+           print NATTRS $_, "\n" or confess $!;
        }
-       ATTRS->error and die $!;
+       ATTRS->error and confess $!;
        close ATTRS;
     }
-    print NATTRS "debian/changelog merge=$driver\n" or die $!;
+    print NATTRS "debian/changelog merge=$driver\n" or confess $!;
     close NATTRS;
 
     set_local_git_config "$cb.name", __ 'debian/changelog merge driver';
@@ -3467,7 +3478,7 @@ sub is_gitattrs_setup () {
        printdebug "is_gitattrs_setup: found old macro\n";
        return 0;
     }
-    $gai->error and die $!;
+    $gai->error and confess $!;
     printdebug "is_gitattrs_setup: found nothing\n";
     return undef;
 }    
@@ -3488,8 +3499,8 @@ END
     my $af = "$maindir_gitcommon/info/attributes";
     ensuredir "$maindir_gitcommon/info";
 
-    open GAO, "> $af.new" or die $!;
-    print GAO <<END, __ <<ENDT or die $! unless defined $already;
+    open GAO, "> $af.new" or confess $!;
+    print GAO <<END, __ <<ENDT or confess $! unless defined $already;
 *      dgit-defuse-attrs
 $new
 END
@@ -3503,11 +3514,11 @@ ENDT
                $_ = $new;
            }
            chomp;
-           print GAO $_, "\n" or die $!;
+           print GAO $_, "\n" or confess $!;
        }
-       $gai->error and die $!;
+       $gai->error and confess $!;
     }
-    close GAO or die $!;
+    close GAO or confess $!;
     rename "$af.new", "$af" or fail f_ "install %s: %s", $af, $!;
 }
 
@@ -3526,7 +3537,7 @@ sub check_gitattrs ($$) {
     my @cmd = (@git, qw(ls-tree -lrz --), "${treeish}:");
     debugcmd "|",@cmd;
     my $gafl = new IO::File;
-    open $gafl, "-|", @cmd or die $!;
+    open $gafl, "-|", @cmd or confess $!;
     while (<$gafl>) {
        chomp or die;
        s/^\d+\s+\w+\s+\w+\s+(\d+)\t// or die;
@@ -3551,7 +3562,7 @@ sub multisuite_suite_child ($$$) {
     # in child, sets things up, calls $fn->(), and returns undef
     # in parent, returns canonical suite name for $tsuite
     my $canonsuitefh = IO::File::new_tmpfile;
-    my $pid = fork // die $!;
+    my $pid = fork // confess $!;
     if (!$pid) {
        forkcheck_setup();
        $isuite = $tsuite;
@@ -3559,17 +3570,17 @@ sub multisuite_suite_child ($$$) {
        $debugprefix .= " ";
        progress f_ "fetching %s...", $tsuite;
        canonicalise_suite();
-       print $canonsuitefh $csuite, "\n" or die $!;
-       close $canonsuitefh or die $!;
+       print $canonsuitefh $csuite, "\n" or confess $!;
+       close $canonsuitefh or confess $!;
        $fn->();
        return undef;
     }
-    waitpid $pid,0 == $pid or die $!;
+    waitpid $pid,0 == $pid or confess $!;
     fail f_ "failed to obtain %s: %s", $tsuite, waitstatusmsg()
        if $? && $?!=256*4;
-    seek $canonsuitefh,0,0 or die $!;
+    seek $canonsuitefh,0,0 or confess $!;
     local $csuite = <$canonsuitefh>;
-    die $! unless defined $csuite && chomp $csuite;
+    confess $! unless defined $csuite && chomp $csuite;
     if ($? == 256*4) {
        printdebug "multisuite $tsuite missing\n";
        return $csuite;
@@ -3712,9 +3723,9 @@ sub fork_for_multisuite ($) {
 }
 
 sub clone_set_head () {
-    open H, "> .git/HEAD" or die $!;
-    print H "ref: ".lref()."\n" or die $!;
-    close H or die $!;
+    open H, "> .git/HEAD" or confess $!;
+    print H "ref: ".lref()."\n" or confess $!;
+    close H or confess $!;
 }
 sub clone_finish ($) {
     my ($dstdir) = @_;
@@ -3813,12 +3824,25 @@ sub pull () {
 }
 
 sub check_not_dirty () {
-    foreach my $f (qw(local-options local-patch-header)) {
-       if (stat_exists "debian/source/$f") {
-           fail f_ "git tree contains debian/source/%s", $f;
+    my @forbid = qw(local-options local-patch-header);
+    @forbid = map { "debian/source/$_" } @forbid;
+    foreach my $f (@forbid) {
+       if (stat_exists $f) {
+           fail f_ "git tree contains %s", $f;
        }
     }
 
+    my @cmd = (@git, qw(status -uall --ignored --porcelain));
+    push @cmd, qw(debian/source/format debian/source/options);
+    push @cmd, @forbid;
+
+    my $bad = cmdoutput @cmd;
+    if (length $bad) {
+       fail +(__
+ "you have uncommitted changes to critical files, cannot continue:\n").
+              $bad;
+    }
+
     return if $includedirty;
 
     git_check_unmodified();
@@ -3880,18 +3904,18 @@ sub get_source_format () {
                $options{$_} = 1;
            }
        }
-       F->error and die $!;
+       F->error and confess $!;
        close F;
     } else {
-       die $! unless $!==&ENOENT;
+       confess $! unless $!==&ENOENT;
     }
 
     if (!open F, "debian/source/format") {
-       die $! unless $!==&ENOENT;
+       confess $! unless $!==&ENOENT;
        return '';
     }
     $_ = <F>;
-    F->error and die $!;
+    F->error and confess $!;
     chomp;
     return ($_, \%options);
 }
@@ -4012,7 +4036,7 @@ END
 sub pseudomerge_make_commit ($$$$ $$) {
     my ($clogp, $dgitview, $archive_hash, $i_arch_v,
        $msg_cmd, $msg_msg) = @_;
-    progress f_ "Declaring that HEAD inciudes all changes in %s...",
+    progress f_ "Declaring that HEAD includes all changes in %s...",
                 $i_arch_v->[0];
 
     my $tree = cmdoutput qw(git rev-parse), "${dgitview}:";
@@ -4028,7 +4052,7 @@ sub pseudomerge_make_commit ($$$$ $$) {
     # git rev-list --first-parent DTRT.
     my $pmf = dgit_privdir()."/pseudomerge";
     open MC, ">", $pmf or die "$pmf $!";
-    print MC <<END or die $!;
+    print MC <<END or confess $!;
 tree $tree
 parent $dgitview
 parent $archive_hash
@@ -4039,7 +4063,7 @@ $msg_msg
 
 [$msg_cmd]
 END
-    close MC or die $!;
+    close MC or confess $!;
 
     return make_commit($pmf);
 }
@@ -4068,7 +4092,7 @@ sub splitbrain_pseudomerge ($$$$) {
     my $i_arch_v = pseudomerge_version_check($clogp, $archive_hash);
 
     if (!defined $overwrite_version) {
-       progress __ "Checking that HEAD inciudes all changes in archive...";
+       progress __ "Checking that HEAD includes all changes in archive...";
     }
 
     return $dgitview if is_fast_fwd $archive_hash, $dgitview;
@@ -4219,7 +4243,7 @@ sub push_mktags ($$ $$ $) {
     $dsc->{$ourdscfield[0]} = join " ",
        $tagwants->[0]{Objid}, $declaredistro, $tagwants->[0]{Tag},
        $reader_giturl;
-    $dsc->save("$dscfn.tmp") or die $!;
+    $dsc->save("$dscfn.tmp") or confess $!;
 
     my $changes = parsecontrol($changesfile,$changesfilewhat);
     foreach my $field (qw(Source Distribution Version)) {
@@ -4242,8 +4266,8 @@ sub push_mktags ($$ $$ $) {
        my $head = $tw->{Objid};
        my $tag = $tw->{Tag};
 
-       open TO, '>', $tfn->('.tmp') or die $!;
-       print TO <<END or die $!;
+       open TO, '>', $tfn->('.tmp') or confess $!;
+       print TO <<END or confess $!;
 object $head
 type commit
 tag $tag
@@ -4254,12 +4278,12 @@ END
            print TO f_ <<ENDT, $package, $cversion, $clogsuite, $csuite
 %s release %s for %s (%s) [dgit]
 ENDT
-               or die $!;
-           print TO <<END or die $!;
+               or confess $!;
+           print TO <<END or confess $!;
 [dgit distro=$declaredistro$delibs]
 END
            foreach my $ref (sort keys %previously) {
-               print TO <<END or die $!;
+               print TO <<END or confess $!;
 [dgit previously:$ref=$previously{$ref}]
 END
            }
@@ -4269,12 +4293,12 @@ END
 (maintainer view tag generated by dgit --quilt=%s)
 END
                $quilt_mode
-               or die $!;
+               or confess $!;
        } else {
            confess Dumper($tw)."?";
        }
 
-       close TO or die $!;
+       close TO or confess $!;
 
        my $tagobjfn = $tfn->('.tmp');
        if ($sign) {
@@ -4284,7 +4308,7 @@ END
            if (!defined $keyid) {
                $keyid = getfield $clogp, 'Maintainer';
            }
-           unlink $tfn->('.tmp.asc') or $!==&ENOENT or die $!;
+           unlink $tfn->('.tmp.asc') or $!==&ENOENT or confess $!;
            my @sign_cmd = (@gpg, qw(--detach-sign --armor));
            push @sign_cmd, qw(-u),$keyid if defined $keyid;
            push @sign_cmd, $tfn->('.tmp');
@@ -4519,11 +4543,11 @@ ENDT
     if ($sourceonlypolicy eq 'ok') {
     } elsif ($sourceonlypolicy eq 'always') {
        forceable_fail [qw(uploading-binaries)],
-           __ "uploading binaries, although distroy policy is source only"
+           __ "uploading binaries, although distro policy is source only"
            if $hasdebs;
     } elsif ($sourceonlypolicy eq 'never') {
        forceable_fail [qw(uploading-source-only)],
-           __ "source-only upload, although distroy policy requires .debs"
+           __ "source-only upload, although distro policy requires .debs"
            if !$hasdebs;
     } elsif ($sourceonlypolicy eq 'not-wholly-new') {
        forceable_fail [qw(uploading-source-only)],
@@ -4891,11 +4915,11 @@ sub pre_remote_push_build_host {
     $we_are_responder = 1;
     $us .= " (build host)";
 
-    open PI, "<&STDIN" or die $!;
-    open STDIN, "/dev/null" or die $!;
-    open PO, ">&STDOUT" or die $!;
+    open PI, "<&STDIN" or confess $!;
+    open STDIN, "/dev/null" or confess $!;
+    open PO, ">&STDOUT" or confess $!;
     autoflush PO 1;
-    open STDOUT, ">&STDERR" or die $!;
+    open STDOUT, ">&STDERR" or confess $!;
     autoflush STDOUT 1;
 
     $vsnwant //= 1;
@@ -5019,7 +5043,7 @@ sub i_resp_complete {
     $i_child_pid = undef; # prevents killing some other process with same pid
     printdebug "waiting for build host child $pid...\n";
     my $got = waitpid $pid, 0;
-    die $! unless $got == $pid;
+    confess $! unless $got == $pid;
     fail f_ "build host child failed: %s", waitstatusmsg() if $?;
 
     i_cleanup();
@@ -5075,7 +5099,7 @@ sub i_resp_want ($) {
     foreach my $localpath (@localpaths) {
        protocol_send_file \*RI, $localpath;
     }
-    print RI "files-end\n" or die $!;
+    print RI "files-end\n" or confess $!;
 }
 
 our ($i_clogp, $i_version, $i_dscfn, $i_changesfn, @i_buildinfos);
@@ -5182,13 +5206,13 @@ sub quiltify_dpkg_commit ($$$;$) {
     my $descfn = ".git/dgit/quilt-description.tmp";
     open O, '>', $descfn or confess "$descfn: $!";
     $msg =~ s/\n+/\n\n/;
-    print O <<END or die $!;
+    print O <<END or confess $!;
 From: $author
 ${xinfo}Subject: $msg
 ---
 
 END
-    close O or die $!;
+    close O or confess $!;
 
     {
        local $ENV{'EDITOR'} = cmdoutput qw(realpath --), $0;
@@ -5370,12 +5394,12 @@ ENDU
         close GIPATCH or die "$gipatch: $!";
         runcmd shell_cmd "exec >>$gipatch", @git, qw(diff),
             $unapplied, $headref, "--", sort keys %$editedignores;
-        open SERIES, "+>>", "debian/patches/series" or die $!;
-        defined seek SERIES, -1, 2 or $!==EINVAL or die $!;
+        open SERIES, "+>>", "debian/patches/series" or confess $!;
+        defined seek SERIES, -1, 2 or $!==EINVAL or confess $!;
         my $newline;
-        defined read SERIES, $newline, 1 or die $!;
-       print SERIES "\n" or die $! unless $newline eq "\n";
-       print SERIES "auto-gitignore\n" or die $!;
+        defined read SERIES, $newline, 1 or confess $!;
+       print SERIES "\n" or confess $! unless $newline eq "\n";
+       print SERIES "auto-gitignore\n" or confess $!;
        close SERIES or die  $!;
         runcmd @git, qw(add -f -- debian/patches/series), $gipatch;
         commit_admin +(__ <<END).<<ENDU
@@ -5499,7 +5523,8 @@ sub quiltify ($$$$) {
            printdebug "considering C=$c->{Commit} P=$p->{Commit}\n";
 
            my @cmd= (@git, qw(diff-tree -r --name-only),
-                     $p->{Commit},$c->{Commit}, qw(-- debian/patches .pc));
+                     $p->{Commit},$c->{Commit},
+                     qw(-- debian/patches .pc debian/source/format));
            my $patchstackchange = cmdoutput @cmd;
            if (length $patchstackchange) {
                $patchstackchange =~ s/\n/,/g;
@@ -5597,15 +5622,16 @@ sub quiltify ($$$$) {
            my ($what) = @_;
 
            eval {
-               die "contains unexpected slashes\n" if m{//} || m{/$};
-               die "contains leading punctuation\n" if m{^\W} || m{/\W};
-               die "contains bad character(s)\n" if m{[^-a-z0-9_.+=~/]}i;
-               die "is series file\n" if m{$series_filename_re}o;
-               die "too long\n" if length > 200;
+               die __ "contains unexpected slashes\n" if m{//} || m{/$};
+               die __ "contains leading punctuation\n" if m{^\W} || m{/\W};
+               die __ "contains bad character(s)\n" if m{[^-a-z0-9_.+=~/]}i;
+               die __ "is series file\n" if m{$series_filename_re}o;
+               die __ "too long\n" if length > 200;
            };
            return $_ unless $@;
-           print STDERR "quiltifying commit $cc:".
-               " ignoring/dropping Gbp-Pq $what: $@";
+           print STDERR f_
+               "quiltifying commit %s: ignoring/dropping Gbp-Pq %s: %s",
+               $cc, $what, $@;
            return undef;
        };
 
@@ -5633,7 +5659,7 @@ sub quiltify ($$$$) {
                $patchname = $translitname;
            };
            print STDERR
-               "dgit: patch title transliteration error: $@"
+               +(f_ "dgit: patch title transliteration error: %s", $@)
                if $@;
            $patchname =~ y/ A-Z/-a-z/;
            $patchname =~ y/-a-z0-9_.+=~//cd;
@@ -5655,7 +5681,7 @@ sub quiltify ($$$$) {
        for ($index='';
             stat "debian/patches/$patchname$index";
             $index++) { }
-       $!==ENOENT or die "$patchname$index $!";
+       $!==ENOENT or confess "$patchname$index $!";
 
        runcmd @git, qw(checkout -q), $cc;
 
@@ -5714,7 +5740,10 @@ END
        if (act_local()) {
            debugcmd "+",@cmd;
            $!=0; $?=-1;
-           failedcmd @cmd if system @cmd and $?!=7*256;
+           failedcmd @cmd
+               if system @cmd
+               and not ($? == 7*256 or
+                        $? == -1 && $!==ENOENT);
        } else {
            dryrun_report @cmd;
        }
@@ -5740,7 +5769,7 @@ END
 sub unpack_playtree_mkwork ($) {
     my ($headref) = @_;
 
-    mkdir "work" or die $!;
+    mkdir "work" or confess $!;
     changedir "work";
     mktree_in_ud_here();
     runcmd @git, qw(reset -q --hard), $headref;
@@ -5769,7 +5798,7 @@ sub unpack_playtree_linkorigs ($$) {
 
 sub quilt_fixup_delete_pc () {
     runcmd @git, qw(rm -rqf .pc);
-    commit_admin <<END.<<ENDU
+    commit_admin +(__ <<END).<<ENDU
 Commit removal of .pc (quilt series tracking data)
 END
 
@@ -5780,7 +5809,7 @@ ENDU
 sub quilt_fixup_singlepatch ($$$) {
     my ($clogp, $headref, $upstreamversion) = @_;
 
-    progress "starting quiltify (single-debian-patch)";
+    progress __ "starting quiltify (single-debian-patch)";
 
     # dpkg-source --commit generates new patches even if
     # single-debian-patch is in debian/source/options.  In order to
@@ -5796,7 +5825,9 @@ sub quilt_fixup_singlepatch ($$$) {
     changedir "..";
     runcmd @dpkgsource, qw(-x), (srcfn $version, ".dsc");
     rename srcfn("$upstreamversion", "/debian/patches"), 
-           "work/debian/patches";
+       "work/debian/patches"
+       or $!==ENOENT
+       or confess "install d/patches: $!";
 
     changedir "work";
     commit_quilty_patch();
@@ -5807,8 +5838,8 @@ sub quilt_make_fake_dsc ($) {
 
     my $fakeversion="$upstreamversion-~~DGITFAKE";
 
-    my $fakedsc=new IO::File 'fake.dsc', '>' or die $!;
-    print $fakedsc <<END or die $!;
+    my $fakedsc=new IO::File 'fake.dsc', '>' or confess $!;
+    print $fakedsc <<END or confess $!;
 Format: 3.0 (quilt)
 Source: $package
 Version: $fakeversion
@@ -5821,11 +5852,11 @@ END
        my $md = new Digest::MD5;
 
        my $fh = new IO::File $b, '<' or die "$b $!";
-       stat $fh or die $!;
+       stat $fh or confess $!;
        my $size = -s _;
 
        $md->addfile($fh);
-       print $fakedsc " ".$md->hexdigest." $size $b\n" or die $!;
+       print $fakedsc " ".$md->hexdigest." $size $b\n" or confess $!;
     };
 
     unpack_playtree_linkorigs($upstreamversion, $dscaddfile);
@@ -5842,7 +5873,7 @@ END
     runcmd qw(env GZIP=-1n tar -zcf), "./$debtar", qw(-C), $maindir, @files;
 
     $dscaddfile->($debtar);
-    close $fakedsc or die $!;
+    close $fakedsc or confess $!;
 }
 
 sub quilt_fakedsc2unapplied ($$) {
@@ -5858,7 +5889,7 @@ sub quilt_fakedsc2unapplied ($$) {
 
     changedir 'fake';
 
-    remove_stray_gits("source package");
+    remove_stray_gits(__ "source package");
     mktree_in_ud_here();
 
     rmtree '.pc';
@@ -5879,8 +5910,9 @@ sub quilt_check_splitbrain_cache ($$) {
 
     my $splitbrain_cachekey;
     
-    progress
- "dgit: split brain (separate dgit view) may be needed (--quilt=$quilt_mode).";
+    progress f_
+ "dgit: split brain (separate dgit view) may be needed (--quilt=%s).",
+                $quilt_mode;
     # we look in the reflog of dgit-intern/quilt-cache
     # we look for an entry whose message is the key for the cache lookup
     my @cachekey = (qw(dgit), $our_version);
@@ -5910,12 +5942,12 @@ sub quilt_check_splitbrain_cache ($$) {
        unpack_playtree_mkwork($headref);
        my $saved = maybe_split_brain_save $headref, $cachehit, "cache-hit";
        if ($cachehit ne $headref) {
-           progress "dgit view: found cached ($saved)";
+           progress f_ "dgit view: found cached (%s)", $saved;
            runcmd @git, qw(checkout -q -b dgit-view), $cachehit;
            $split_brain = 1;
            return ($cachehit, $splitbrain_cachekey);
        }
-       progress "dgit view: found cached, no changes required";
+       progress __ "dgit view: found cached, no changes required";
        return ($headref, $splitbrain_cachekey);
     }
 
@@ -5926,7 +5958,8 @@ sub quilt_check_splitbrain_cache ($$) {
 sub quilt_fixup_multipatch ($$$) {
     my ($clogp, $headref, $upstreamversion) = @_;
 
-    progress "examining quilt state (multiple patches, $quilt_mode mode)";
+    progress f_ "examining quilt state (multiple patches, %s mode)",
+               $quilt_mode;
 
     # Our objective is:
     #  - honour any existing .pc in case it has any strangeness
@@ -6015,7 +6048,7 @@ sub quilt_fixup_multipatch ($$$) {
     $!=0; $?=-1;
     if (system @bbcmd) {
        failedcmd @bbcmd if $? < 0;
-       fail <<END;
+       fail __ <<END;
 failed to apply your git tree's patch stack (from debian/patches/) to
  the corresponding upstream tarball(s).  Your source tree and .orig
  are probably too inconsistent.  dgit can only fix up certain kinds of
@@ -6030,10 +6063,10 @@ END
     my $mustdeletepc=0;
     if (stat_exists ".pc") {
         -d _ or die;
-       progress "Tree already contains .pc - will use it then delete it.";
+       progress __ "Tree already contains .pc - will use it then delete it.";
         $mustdeletepc=1;
     } else {
-        rename '../fake/.pc','.pc' or die $!;
+        rename '../fake/.pc','.pc' or confess $!;
     }
 
     changedir '../fake';
@@ -6066,39 +6099,40 @@ END
     }
     printdebug "differences \@dl @dl.\n";
 
-    progress sprintf
+    progress f_
 "%s: base trees orig=%.20s o+d/p=%.20s",
               $us, $unapplied, $oldtiptree;
-    progress sprintf
+    progress f_
 "%s: quilt differences: src:  %s orig %s     gitignores:  %s orig %s\n".
 "%s: quilt differences:      HEAD %s o+d/p               HEAD %s o+d/p",
   $us,                      $dl[0], $dl[1],              $dl[3], $dl[4],
   $us,                          $dl[2],                     $dl[5];
 
     if (@unrepres) {
-       print STDERR "dgit:  cannot represent change: $_->[1]: $_->[0]\n"
+       print STDERR f_ "dgit:  cannot represent change: %s: %s\n",
+                       $_->[1], $_->[0]
            foreach @unrepres;
-       forceable_fail [qw(unrepresentable)], <<END;
+       forceable_fail [qw(unrepresentable)], __ <<END;
 HEAD has changes to .orig[s] which are not representable by `3.0 (quilt)'
 END
     }
 
     my @failsuggestion;
     if (!($diffbits->{O2H} & $diffbits->{O2A})) {
-        push @failsuggestion, [ 'unapplied',
                             "This might be a patches-unapplied branch." ];
+        push @failsuggestion, [ 'unapplied', __
+ "This might be a patches-unapplied branch." ];
     } elsif (!($diffbits->{H2A} & $diffbits->{O2A})) {
-        push @failsuggestion, [ 'applied',
                              "This might be a patches-applied branch." ];
+        push @failsuggestion, [ 'applied', __
+ "This might be a patches-applied branch." ];
     }
-    push @failsuggestion, [ 'quilt-mode',
+    push @failsuggestion, [ 'quilt-mode', __
  "Maybe you need one of --[quilt=]gbp --[quilt=]dpm --quilt=unapplied ?" ];
 
-    push @failsuggestion, [ 'gitattrs',
+    push @failsuggestion, [ 'gitattrs', __
  "Warning: Tree has .gitattributes.  See GITATTRIBUTES in dgit(7)." ]
        if stat_exists '.gitattributes';
 
-    push @failsuggestion, [ 'origs',
+    push @failsuggestion, [ 'origs', __
  "Maybe orig tarball(s) are not identical to git representation?" ];
 
     if (quiltmode_splitbrain()) {
@@ -6108,11 +6142,11 @@ END
        return;
     }
 
-    progress "starting quiltify (multiple patches, $quilt_mode mode)";
+    progress f_ "starting quiltify (multiple patches, %s mode)", $quilt_mode;
     quiltify($clogp,$headref,$oldtiptree,\@failsuggestion);
 
     if (!open P, '>>', ".pc/applied-patches") {
-       $!==&ENOENT or die $!;
+       $!==&ENOENT or confess $!;
     } else {
        close P;
     }
@@ -6127,25 +6161,25 @@ END
 sub quilt_fixup_editor () {
     my $descfn = $ENV{$fakeeditorenv};
     my $editing = $ARGV[$#ARGV];
-    open I1, '<', $descfn or die "$descfn: $!";
-    open I2, '<', $editing or die "$editing: $!";
-    unlink $editing or die "$editing: $!";
-    open O, '>', $editing or die "$editing: $!";
-    while (<I1>) { print O or die $!; } I1->error and die $!;
+    open I1, '<', $descfn or confess "$descfn: $!";
+    open I2, '<', $editing or confess "$editing: $!";
+    unlink $editing or confess "$editing: $!";
+    open O, '>', $editing or confess "$editing: $!";
+    while (<I1>) { print O or confess $!; } I1->error and confess $!;
     my $copying = 0;
     while (<I2>) {
        $copying ||= m/^\-\-\- /;
        next unless $copying;
-       print O or die $!;
+       print O or confess $!;
     }
-    I2->error and die $!;
+    I2->error and confess $!;
     close O or die $1;
     finish 0;
 }
 
 sub maybe_apply_patches_dirtily () {
     return unless $quilt_mode =~ m/gbp|unapplied/;
-    print STDERR <<END or die $!;
+    print STDERR __ <<END or confess $!;
 
 dgit: Building, or cleaning with rules target, in patches-unapplied tree.
 dgit: Have to apply the patches - making the tree dirty.
@@ -6158,7 +6192,7 @@ END
 }
 
 sub maybe_unapply_patches_again () {
-    progress "dgit: Unapplying patches again to tidy up the tree."
+    progress __ "dgit: Unapplying patches again to tidy up the tree."
        if $patches_applied_dirtily;
     runcmd qw(dpkg-source --after-build .)
        if $patches_applied_dirtily & 01;
@@ -6169,38 +6203,76 @@ sub maybe_unapply_patches_again () {
 
 #----- other building -----
 
-our $clean_using_builder;
-# ^ tree is to be cleaned by dpkg-source's builtin idea that it should
-#   clean the tree before building (perhaps invoked indirectly by
-#   whatever we are using to run the build), rather than separately
-#   and explicitly by us.
+sub clean_tree_check_git ($$) {
+    my ($honour_ignores, $message) = @_;
+    my @cmd = (@git, qw(clean -dn));
+    push @cmd, qw(-x) unless $honour_ignores;
+    my $leftovers = cmdoutput @cmd;
+    if (length $leftovers) {
+       print STDERR $leftovers, "\n" or confess $!;
+       fail $message;
+    }
+}
+
+sub clean_tree_check_git_wd ($) {
+    my ($message) = @_;
+    return if $cleanmode =~ m{no-check};
+    return if $patches_applied_dirtily; # yuk
+    clean_tree_check_git +($cleanmode !~ m{all-check}),
+                         (f_ <<END, $message);
+%s
+If this is just missing .gitignore entries, use a different clean
+mode, eg --clean=dpkg-source,no-check (-wdu/-wddu) to ignore them
+or --clean=git (-wg/-wgf) to use \`git clean' instead.
+END
+}
+
+sub clean_tree_check () {
+    # Not yet fully implemented.
+    # This function needs to not care about modified but tracked files.
+    # That was done by check_not_dirty, and by now we may have run
+    # the rules clean target which might modify tracked files (!)
+    if ($cleanmode =~ m{^check}) {
+       clean_tree_check_git +($cleanmode =~ m{ignores}), __
+ "tree contains uncommitted files and --clean=check specified";
+    } elsif ($cleanmode =~ m{^dpkg-source}) {
+       clean_tree_check_git_wd __
+ "tree contains uncommitted files (NB dgit didn't run rules clean)";
+    } elsif ($cleanmode =~ m{^git}) {
+       # If we were actually cleaning these files would be summarily
+       # deleted.  Since we're not, and not using the working tree
+       # anyway, we can just ignore them - nothing will use them.
+    } elsif ($cleanmode eq 'none') {
+    } else {
+       confess "$cleanmode ?";
+    }
+}
 
 sub clean_tree () {
-    return if $clean_using_builder;
-    if ($cleanmode eq 'dpkg-source') {
-       maybe_apply_patches_dirtily();
-       runcmd_ordryrun_local @dpkgbuildpackage, qw(-T clean);
-    } elsif ($cleanmode eq 'dpkg-source-d') {
+    # We always clean the tree ourselves, rather than leave it to the
+    # builder (dpkg-source, or soemthing which calls dpkg-source).
+    if ($cleanmode =~ m{^dpkg-source}) {
+       my @cmd = @dpkgbuildpackage;
+       push @cmd, qw(-d) if $cleanmode =~ m{^dpkg-source-d};
+       push @cmd, qw(-T clean);
        maybe_apply_patches_dirtily();
-       runcmd_ordryrun_local @dpkgbuildpackage, qw(-d -T clean);
+       runcmd_ordryrun_local @cmd;
+       clean_tree_check_git_wd __
+ "tree contains uncommitted files (after running rules clean)";
     } elsif ($cleanmode eq 'git') {
        runcmd_ordryrun_local @git, qw(clean -xdf);
     } elsif ($cleanmode eq 'git-ff') {
        runcmd_ordryrun_local @git, qw(clean -xdff);
-    } elsif ($cleanmode eq 'check') {
-       my $leftovers = cmdoutput @git, qw(clean -xdn);
-       if (length $leftovers) {
-           print STDERR $leftovers, "\n" or die $!;
-           fail "tree contains uncommitted files and --clean=check specified";
-       }
+    } elsif ($cleanmode =~ m{^check}) {
+       clean_tree_check();
     } elsif ($cleanmode eq 'none') {
     } else {
-       die "$cleanmode ?";
+       confess "$cleanmode ?";
     }
 }
 
 sub cmd_clean () {
-    badusage "clean takes no additional arguments" if @ARGV;
+    badusage __ "clean takes no additional arguments" if @ARGV;
     notpushing();
     clean_tree();
     maybe_unapply_patches_again();
@@ -6213,7 +6285,8 @@ sub WANTSRC_BUILDER () { 02; } # caller should run dpkg-buildpackage
 sub build_or_push_prep_early () {
     our $build_or_push_prep_early_done //= 0;
     return if $build_or_push_prep_early_done++;
-    badusage "-p is not allowed with dgit $subcommand" if defined $package;
+    badusage f_ "-p is not allowed with dgit %s", $subcommand
+       if defined $package;
     my $clogp = parsechangelog();
     $isuite = getfield $clogp, 'Distribution';
     $package = getfield $clogp, 'Source';
@@ -6230,17 +6303,27 @@ sub build_prep_early () {
 sub build_prep ($) {
     my ($wantsrc) = @_;
     build_prep_early();
-    # clean the tree if we're trying to include dirty changes in the
-    # source package, or we are running the builder in $maindir
-    clean_tree() if $includedirty || ($wantsrc & WANTSRC_BUILDER);
+    if (!building_source_in_playtree() || ($wantsrc & WANTSRC_BUILDER)) {
+       # Clean the tree because we're going to use the contents of
+       # $maindir.  (We trying to include dirty changes in the source
+       # package, or we are running the builder in $maindir.)
+       clean_tree();
+    } else {
+       # We don't actually need to do anything in $maindir, but we
+       # should do some kind of cleanliness check because (i) the
+       # user may have forgotten a `git add', and (ii) if the user
+       # said -wc we should still do the check.
+       clean_tree_check();
+    }
     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: $!";
+               unlink $f or
+                   fail f_ "remove old changes file %s: %s", $f, $!;
            } else {
-               progress "would remove $f";
+               progress f_ "would remove %s", $f;
            }
        }
     }
@@ -6265,17 +6348,17 @@ sub changesopts_version () {
            1;
        }) {
            print STDERR $@;
-           fail
+           fail __
  "archive query failed (queried because --since-version not specified)";
        }
        if (@vsns) {
            @vsns = map { $_->[0] } @vsns;
            @vsns = sort { -version_compare($a, $b) } @vsns;
            $changes_since_version = $vsns[0];
-           progress "changelog will contain changes since $vsns[0]";
+           progress f_ "changelog will contain changes since %s", $vsns[0];
        } else {
            $changes_since_version = '_';
-           progress "package seems new, not specifying -v<version>";
+           progress __ "package seems new, not specifying -v<version>";
        }
     }
     if ($changes_since_version ne '_') {
@@ -6318,14 +6401,14 @@ sub massage_dbp_args ($;$) {
        $r |= WANTSRC_SOURCE  if grep { s/^full$/binary/ } @d;
        $r |= WANTSRC_SOURCE  if grep { s/^source$// } @d;
        $r |= WANTSRC_BUILDER if grep { m/./ } @d;
-       fail "Wanted to build nothing!" unless $r;
+       fail __ "Wanted to build nothing!" unless $r;
        $dmode = '--build='. join ',', grep m/./, @d;
     } else {
        $r =
          $dmode =~ m/[S]/     ?  WANTSRC_SOURCE :
          $dmode =~ y/gGF/ABb/ ?  WANTSRC_SOURCE | WANTSRC_BUILDER :
          $dmode =~ m/[ABb]/   ?                   WANTSRC_BUILDER :
-         die "$dmode ?";
+         confess "$dmode ?";
     }
     printdebug "massage done $r $dmode.\n";
     push @$cmd, $dmode;
@@ -6355,30 +6438,35 @@ sub postbuild_mergechanges ($) {
     } @changesfiles;
     my $result;
     if (@changesfiles==1) {
-       fail <<END.$msg_if_onlyone if defined $msg_if_onlyone;
-only one changes file from build (@changesfiles)
+       fail +(f_ <<END, "@changesfiles").$msg_if_onlyone
+only one changes file from build (%s)
 END
+           if defined $msg_if_onlyone;
        $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"
+           fail f_ "%s found in binaries changes file %s", $l, $binchanges
                if $l =~ m/\.dsc$/;
        }
        runcmd_ordryrun_local @mergechanges, @changesfiles;
        my $multichanges = changespat $version,'multi';
        if (act_local()) {
-           stat_exists $multichanges or fail "$multichanges: $!";
+           stat_exists $multichanges or fail f_
+               "%s unexpectedly not created by build", $multichanges;
            foreach my $cf (glob $pat) {
                next if $cf eq $multichanges;
-               rename "$cf", "$cf.inmulti" or fail "$cf\{,.inmulti}: $!";
+               rename "$cf", "$cf.inmulti" or fail f_
+                   "install new changes %s\{,.inmulti}: %s", $cf, $!;
            }
        }
        $result = $multichanges;
     } else {
-       fail "wrong number of different changes files (@changesfiles)";
+       fail f_ "wrong number of different changes files (%s)",
+               "@changesfiles";
     }
-    printdone "build successful, results in $result\n" or die $!;
+    printdone f_ "build successful, results in %s\n", $result
+       or confess $!;
 }
 
 sub midbuild_checkchanges () {
@@ -6389,9 +6477,9 @@ sub midbuild_checkchanges () {
        $_ ne changespat $version,'source' and
        $_ ne changespat $version,'multi'
     } @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.
+    fail +(f_ <<END, $pat, "@unwanted")
+changes files other than source matching %s already present; building would result in ambiguity about the intended results.
+Suggest you delete %s.
 END
        if @unwanted;
 }
@@ -6408,15 +6496,15 @@ sub postbuild_mergechanges_vanilla ($) {
            postbuild_mergechanges(undef);
        };
     } else {
-       printdone "build successful\n";
+       printdone __ "build successful\n";
     }
 }
 
 sub cmd_build {
     build_prep_early();
-    $buildproductsdir eq '..' or print STDERR <<END;
-$us: warning: build-products-dir set, but not supported by dpkg-buildpackage
-$us: warning: build-products-dir will be ignored; files will go to ..
+    $buildproductsdir eq '..' or print STDERR +(f_ <<END, $us, $us);
+%s: warning: build-products-dir set, but not supported by dpkg-buildpackage
+%s: warning: build-products-dir will be ignored; files will go to ..
 END
     $buildproductsdir = '..';
     my @dbp = (@dpkgbuildpackage, qw(-us -uc), changesopts_initial(), @ARGV);
@@ -6476,7 +6564,7 @@ sub cmd_gbp_build {
     if ($gbp_make_orig) {
        my $priv = dgit_privdir();
        my $ok = "$priv/origs-gen-ok";
-       unlink $ok or $!==&ENOENT or die $!;
+       unlink $ok or $!==&ENOENT or confess $!;
        my @origs_cmd = @cmd;
        push @origs_cmd, qw(--git-cleaner=true);
        push @origs_cmd, "--git-prebuild=".
@@ -6497,9 +6585,7 @@ sub cmd_gbp_build {
        build_source();
        midbuild_checkchanges_vanilla $wantsrc;
     } else {
-       if (!$clean_using_builder) {
-           push @cmd, '--git-cleaner=true';
-       }
+       push @cmd, '--git-cleaner=true';
     }
     maybe_unapply_patches_again();
     if ($wantsrc & WANTSRC_BUILDER) {
@@ -6527,7 +6613,7 @@ sub build_source {
     $sourcechanges = changespat $version,'source';
     if (act_local()) {
        unlink "$buildproductsdir/$sourcechanges" or $!==ENOENT
-           or fail "remove $sourcechanges: $!";
+           or fail f_ "remove %s: %s", $sourcechanges, $!;
     }
     my @cmd = (@dpkgsource, qw(-b --));
     my $leafdir;
@@ -6547,6 +6633,24 @@ sub build_source {
         }
     } else {
         $leafdir = basename $maindir;
+
+       if ($buildproductsdir ne '..') {
+           # Well, we are going to run dpkg-source -b which consumes
+           # origs from .. and generates output there.  To make this
+           # work when the bpd is not .. , we would have to (i) link
+           # origs from bpd to .. , (ii) check for files that
+           # dpkg-source -b would/might overwrite, and afterwards
+           # (iii) move all the outputs back to the bpd (iv) except
+           # for the origs which should be deleted from .. if they
+           # weren't there beforehand.  And if there is an error and
+           # we don't run to completion we would necessarily leave a
+           # mess.  This is too much.  The real way to fix this
+           # is for dpkg-source to have bpd support.
+           confess unless $includedirty;
+           fail __
+ "--include-dirty not supported with --build-products-dir, sorry";
+       }
+
         changedir '..';
     }
     runcmd_ordryrun_local @cmd, $leafdir;
@@ -6563,8 +6667,8 @@ sub build_source {
     my $mv = sub {
        my ($why, $l) = @_;
         printdebug " renaming ($why) $l\n";
-        rename "$l", bpd_abs()."/$l"
-           or fail "put in place new built file ($l): $!";
+        rename_link_xf 0, "$l", bpd_abs()."/$l"
+           or fail f_ "put in place new built file (%s): %s", $l, $@;
     };
     foreach my $l (split /\n/, getfield $dsc, 'Files') {
         $l =~ m/\S+$/ or next;
@@ -6577,28 +6681,31 @@ sub build_source {
 }
 
 sub cmd_build_source {
-    badusage "build-source takes no additional arguments" if @ARGV;
+    badusage __ "build-source takes no additional arguments" if @ARGV;
     build_prep(WANTSRC_SOURCE);
     build_source();
     maybe_unapply_patches_again();
-    printdone "source built, results in $dscfn and $sourcechanges";
+    printdone f_ "source built, results in %s and %s",
+                $dscfn, $sourcechanges;
 }
 
 sub cmd_push_source {
     prep_push();
-    fail "dgit push-source: --include-dirty/--ignore-dirty does not make".
-      "sense with push-source!" if $includedirty;
+    fail __
+       "dgit push-source: --include-dirty/--ignore-dirty does not make".
+       "sense with push-source!"
+       if $includedirty;
     build_maybe_quilt_fixup();
     if ($changesfile) {
         my $changes = parsecontrol("$buildproductsdir/$changesfile",
-                                   "source changes file");
+                                   __ "source changes file");
         unless (test_source_only_changes($changes)) {
-            fail "user-specified changes file is not source-only";
+            fail __ "user-specified changes file is not source-only";
         }
     } else {
         # Building a source package is very fast, so just do it
        build_source();
-       die "er, patches are applied dirtily but shouldn't be.."
+       confess "er, patches are applied dirtily but shouldn't be.."
            if $patches_applied_dirtily;
        $changesfile = $sourcechanges;
     }
@@ -6612,9 +6719,10 @@ sub binary_builder {
     midbuild_checkchanges();
     in_bpd {
        if (act_local()) {
-           stat_exists $dscfn or fail "$dscfn (in build products dir): $!";
-           stat_exists $sourcechanges
-               or fail "$sourcechanges (in build products dir): $!";
+           stat_exists $dscfn or fail f_
+               "%s (in build products dir): %s", $dscfn, $!;
+           stat_exists $sourcechanges or fail f_
+               "%s (in build products dir): %s", $sourcechanges, $!;
        }
        runcmd_ordryrun_local @$bbuilder, @args;
     };
@@ -6626,7 +6734,7 @@ sub binary_builder {
 
 sub cmd_sbuild {
     build_prep_early();
-    binary_builder(\@sbuild, <<END, qw(-d), $isuite, @ARGV, $dscfn);
+    binary_builder(\@sbuild, (__ <<END), qw(-d), $isuite, @ARGV, $dscfn);
 perhaps you need to pass -A ?  (sbuild's default is to build only
 arch-specific binaries; dgit 1.4 used to override that.)
 END
@@ -6638,11 +6746,13 @@ sub pbuilder ($) {
     # @ARGV is allowed to contain only things that should be passed to
     # pbuilder under debbuildopts; just massage those
     my $wantsrc = massage_dbp_args \@ARGV;
-    fail "you asked for a builder but your debbuildopts didn't ask for".
-      " any binaries -- is this really what you meant?"
-      unless $wantsrc & WANTSRC_BUILDER;
-    fail "we must build a .dsc to pass to the builder but your debbuiltopts".
-      " forbids the building of a source package; cannot continue"
+    fail __
+       "you asked for a builder but your debbuildopts didn't ask for".
+       " any binaries -- is this really what you meant?"
+       unless $wantsrc & WANTSRC_BUILDER;
+    fail __
+       "we must build a .dsc to pass to the builder but your debbuiltopts".
+       " forbids the building of a source package; cannot continue"
       unless $wantsrc & WANTSRC_SOURCE;
     # We do not want to include the verb "build" in @pbuilder because
     # the user can customise @pbuilder and they shouldn't be required
@@ -6671,7 +6781,8 @@ sub cmd_quilt_fixup {
 }
 
 sub cmd_print_unapplied_treeish {
-    badusage "incorrect arguments to dgit print-unapplied-treeish" if @ARGV;
+    badusage __ "incorrect arguments to dgit print-unapplied-treeish"
+       if @ARGV;
     my $headref = git_rev_parse('HEAD');
     my $clogp = commit_getclogp $headref;
     $package = getfield $clogp, 'Source';
@@ -6685,16 +6796,16 @@ sub cmd_print_unapplied_treeish {
     my $uv = upstreamversion $version;
     quilt_make_fake_dsc($uv);
     my $u = quilt_fakedsc2unapplied($headref, $uv);
-    print $u, "\n" or die $!;
+    print $u, "\n" or confess $!;
 }
 
 sub import_dsc_result {
     my ($dstref, $newhash, $what_log, $what_msg) = @_;
     my @cmd = (git_update_ref_cmd $what_log, $dstref, $newhash);
     runcmd @cmd;
-    check_gitattrs($newhash, "source tree");
+    check_gitattrs($newhash, __ "source tree");
 
-    progress "dgit: import-dsc: $what_msg";
+    progress f_ "dgit: import-dsc: %s", $what_msg;
 }
 
 sub cmd_import_dsc {
@@ -6707,14 +6818,16 @@ sub cmd_import_dsc {
        if (m/^--require-valid-signature$/) {
            $needsig = 1;
        } else {
-           badusage "unknown dgit import-dsc sub-option \`$_'";
+           badusage f_ "unknown dgit import-dsc sub-option \`%s'", $_;
        }
     }
 
-    badusage "usage: dgit import-dsc .../PATH/TO/.DSC BRANCH" unless @ARGV==2;
+    badusage __ "usage: dgit import-dsc .../PATH/TO/.DSC BRANCH"
+       unless @ARGV==2;
     my ($dscfn, $dstbranch) = @ARGV;
 
-    badusage "dry run makes no sense with import-dsc" unless act_local();
+    badusage __ "dry run makes no sense with import-dsc"
+       unless act_local();
 
     my $force = $dstbranch =~ s/^\+//   ? +1 :
                $dstbranch =~ s/^\.\.// ? -1 :
@@ -6730,14 +6843,14 @@ sub cmd_import_dsc {
     my $chead = cmdoutput_errok @symcmd;
     defined $chead or $?==256 or failedcmd @symcmd;
 
-    fail "$dstbranch is checked out - will not update it"
+    fail f_ "%s is checked out - will not update it", $dstbranch
        if defined $chead and $chead eq $dstbranch;
 
     my $oldhash = git_get_ref $dstbranch;
 
-    open D, "<", $dscfn or fail "open import .dsc ($dscfn): $!";
+    open D, "<", $dscfn or fail f_ "open import .dsc (%s): %s", $dscfn, $!;
     $dscdata = do { local $/ = undef; <D>; };
-    D->error and fail "read $dscfn: $!";
+    D->error and fail f_ "read %s: %s", $dscfn, $!;
     close C;
 
     # we don't normally need this so import it here
@@ -6748,13 +6861,13 @@ sub cmd_import_dsc {
        local $SIG{__WARN__} = sub {
            print STDERR $_[0];
            return unless $needsig;
-           fail "import-dsc signature check failed";
+           fail __ "import-dsc signature check failed";
        };
        if (!$dp->is_signed()) {
-           warn "$us: warning: importing unsigned .dsc\n";
+           warn f_ "%s: warning: importing unsigned .dsc\n", $us;
        } else {
            my $r = $dp->check_signature();
-           die "->check_signature => $r" if $needsig && $r;
+           confess "->check_signature => $r" if $needsig && $r;
        }
     }
 
@@ -6762,7 +6875,7 @@ sub cmd_import_dsc {
 
     $package = getfield $dsc, 'Source';
 
-    parse_dsc_field($dsc, "Dgit metadata in .dsc")
+    parse_dsc_field($dsc, __ "Dgit metadata in .dsc")
        unless forceing [qw(import-dsc-with-dgit-field)];
     parse_dsc_field_def_dsc_distro();
 
@@ -6772,7 +6885,8 @@ sub cmd_import_dsc {
     notpushing();
 
     if (defined $dsc_hash) {
-       progress "dgit: import-dsc of .dsc with Dgit field, using git hash";
+       progress __
+           "dgit: import-dsc of .dsc with Dgit field, using git hash";
        resolve_dsc_field_commit undef, undef;
     }
     if (defined $dsc_hash) {
@@ -6780,29 +6894,29 @@ sub cmd_import_dsc {
                   "echo $dsc_hash | git cat-file --batch-check");
        my $objgot = cmdoutput @cmd;
        if ($objgot =~ m#^\w+ missing\b#) {
-           fail <<END
-.dsc contains Dgit field referring to object $dsc_hash
+           fail f_ <<END, $dsc_hash
+.dsc contains Dgit field referring to object %s
 Your git tree does not have that object.  Try `git fetch' from a
-plausible server (browse.dgit.d.o? alioth?), and try the import-dsc again.
+plausible server (browse.dgit.d.o? salsa?), and try the import-dsc again.
 END
        }
        if ($oldhash && !is_fast_fwd $oldhash, $dsc_hash) {
            if ($force > 0) {
-               progress "Not fast forward, forced update.";
+               progress __ "Not fast forward, forced update.";
            } else {
-               fail "Not fast forward to $dsc_hash";
+               fail f_ "Not fast forward to %s", $dsc_hash;
            }
        }
        import_dsc_result $dstbranch, $dsc_hash,
            "dgit import-dsc (Dgit): $info",
-           "updated git ref $dstbranch";
+           f_ "updated git ref %s", $dstbranch;
        return 0;
     }
 
-    fail <<END
-Branch $dstbranch already exists
-Specify ..$specbranch for a pseudo-merge, binding in existing history
-Specify  +$specbranch to overwrite, discarding existing history
+    fail f_ <<END, $dstbranch, $specbranch, $specbranch
+Branch %s already exists
+Specify ..%s for a pseudo-merge, binding in existing history
+Specify  +%s to overwrite, discarding existing history
 END
        if $oldhash && !$force;
 
@@ -6812,24 +6926,29 @@ END
        my $here = "$buildproductsdir/$f";
        if (lstat $here) {
            next if stat $here;
-           fail "lstat $here works but stat gives $! !";
+           fail f_ "lstat %s works but stat gives %s !", $here, $!;
        }
-       fail "stat $here: $!" unless $! == ENOENT;
+       fail f_ "stat %s: %s", $here, $! unless $! == ENOENT;
        my $there = $dscfn;
        if ($dscfn =~ m#^(?:\./+)?\.\./+#) {
            $there = $';
        } elsif ($dscfn =~ m#^/#) {
            $there = $dscfn;
        } else {
-           fail "cannot import $dscfn which seems to be inside working tree!";
+           fail f_
+               "cannot import %s which seems to be inside working tree!",
+               $dscfn;
        }
-       $there =~ s#/+[^/]+$## or
-           fail "import $dscfn requires ../$f, but it does not exist";
+       $there =~ s#/+[^/]+$## or fail f_
+           "import %s requires .../%s, but it does not exist",
+           $dscfn, $f;
        $there .= "/$f";
        my $test = $there =~ m{^/} ? $there : "../$there";
-       stat $test or fail "import $dscfn requires $test, but: $!";
-       symlink $there, $here or fail "symlink $there to $here: $!";
-       progress "made symlink $here -> $there";
+       stat $test or fail f_
+           "import %s requires %s, but: %s", $dscfn, $test, $!;
+       symlink $there, $here or fail f_
+           "symlink %s to %s: %s", $there, $here, $!;
+       progress f_ "made symlink %s -> %s", $here, $there;
 #      print STDERR Dumper($fi);
     }
     my @mergeinputs = generate_commits_from_dsc();
@@ -6839,21 +6958,24 @@ END
 
     if ($oldhash) {
        if ($force > 0) {
-           progress "Import, forced update - synthetic orphan git history.";
+           progress __
+               "Import, forced update - synthetic orphan git history.";
        } elsif ($force < 0) {
-           progress "Import, merging.";
+           progress __ "Import, merging.";
            my $tree = cmdoutput @git, qw(rev-parse), "$newhash:";
            my $version = getfield $dsc, 'Version';
            my $clogp = commit_getclogp $newhash;
            my $authline = clogp_authline $clogp;
-           $newhash = make_commit_text <<END;
+           $newhash = make_commit_text <<ENDU
 tree $tree
 parent $newhash
 parent $oldhash
 author $authline
 committer $authline
 
-Merge $package ($version) import into $dstbranch
+ENDU
+               .(f_ <<END, $package, $version, $dstbranch);
+Merge %s (%s) import into %s
 END
        } else {
            die; # caught earlier
@@ -6862,20 +6984,20 @@ END
 
     import_dsc_result $dstbranch, $newhash,
        "dgit import-dsc: $info",
-       "results are in in git ref $dstbranch";
+       f_ "results are in git ref %s", $dstbranch;
 }
 
 sub pre_archive_api_query () {
     not_necessarily_a_tree();
 }
 sub cmd_archive_api_query {
-    badusage "need only 1 subpath argument" unless @ARGV==1;
+    badusage __ "need only 1 subpath argument" unless @ARGV==1;
     my ($subpath) = @ARGV;
     local $isuite = 'DGIT-API-QUERY-CMD';
     my @cmd = archive_api_query_cmd($subpath);
     push @cmd, qw(-f);
     debugcmd ">",@cmd;
-    exec @cmd or fail "exec curl: $!\n";
+    exec @cmd or fail f_ "exec curl: %s\n", $!;
 }
 
 sub repos_server_url () {
@@ -6889,53 +7011,56 @@ sub pre_clone_dgit_repos_server () {
     not_necessarily_a_tree();
 }
 sub cmd_clone_dgit_repos_server {
-    badusage "need destination argument" unless @ARGV==1;
+    badusage __ "need destination argument" unless @ARGV==1;
     my ($destdir) = @ARGV;
     my $url = repos_server_url();
     my @cmd = (@git, qw(clone), $url, $destdir);
     debugcmd ">",@cmd;
-    exec @cmd or fail "exec git clone: $!\n";
+    exec @cmd or fail f_ "exec git clone: %s\n", $!;
 }
 
 sub pre_print_dgit_repos_server_source_url () {
     not_necessarily_a_tree();
 }
 sub cmd_print_dgit_repos_server_source_url {
-    badusage "no arguments allowed to dgit print-dgit-repos-server-source-url"
+    badusage __
+       "no arguments allowed to dgit print-dgit-repos-server-source-url"
        if @ARGV;
     my $url = repos_server_url();
-    print $url, "\n" or die $!;
+    print $url, "\n" or confess $!;
 }
 
 sub pre_print_dpkg_source_ignores {
     not_necessarily_a_tree();
 }
 sub cmd_print_dpkg_source_ignores {
-    badusage "no arguments allowed to dgit print-dpkg-source-ignores"
+    badusage __
+       "no arguments allowed to dgit print-dpkg-source-ignores"
        if @ARGV;
-    print "@dpkg_source_ignores\n" or die $!;
+    print "@dpkg_source_ignores\n" or confess $!;
 }
 
 sub cmd_setup_mergechangelogs {
-    badusage "no arguments allowed to dgit setup-mergechangelogs" if @ARGV;
+    badusage __ "no arguments allowed to dgit setup-mergechangelogs"
+       if @ARGV;
     local $isuite = 'DGIT-SETUP-TREE';
     setup_mergechangelogs(1);
 }
 
 sub cmd_setup_useremail {
-    badusage "no arguments allowed to dgit setup-useremail" if @ARGV;
+    badusage __ "no arguments allowed to dgit setup-useremail" if @ARGV;
     local $isuite = 'DGIT-SETUP-TREE';
     setup_useremail(1);
 }
 
 sub cmd_setup_gitattributes {
-    badusage "no arguments allowed to dgit setup-useremail" if @ARGV;
+    badusage __ "no arguments allowed to dgit setup-useremail" if @ARGV;
     local $isuite = 'DGIT-SETUP-TREE';
     setup_gitattrs(1);
 }
 
 sub cmd_setup_new_tree {
-    badusage "no arguments allowed to dgit setup-tree" if @ARGV;
+    badusage __ "no arguments allowed to dgit setup-tree" if @ARGV;
     local $isuite = 'DGIT-SETUP-TREE';
     setup_new_tree();
 }
@@ -6943,7 +7068,7 @@ sub cmd_setup_new_tree {
 #---------- argument parsing and main program ----------
 
 sub cmd_version {
-    print "dgit version $our_version\n" or die $!;
+    print "dgit version $our_version\n" or confess $!;
     finish 0;
 }
 
@@ -6982,8 +7107,8 @@ defvalopt '', '-C', '.+', sub {
 defvalopt '--initiator-tempdir','','.*', sub {
     ($initiator_tempdir) = (@_);
     $initiator_tempdir =~ m#^/# or
-       badusage "--initiator-tempdir must be used specify an".
-       " absolute, not relative, directory."
+       badusage __ "--initiator-tempdir must be used specify an".
+                   " absolute, not relative, directory."
 };
 
 sub defoptmodes ($@) {
@@ -7021,11 +7146,11 @@ sub parseopts () {
        my ($what) = @_;
        @rvalopts = ($_);
        if (!defined $val) {
-           badusage "$what needs a value" unless @ARGV;
+           badusage f_ "%s needs a value", $what unless @ARGV;
            $val = shift @ARGV;
            push @rvalopts, $val;
        }
-       badusage "bad value \`$val' for $what" unless
+       badusage f_ "bad value \`%s' for %s", $val, $what unless
            $val =~ m/^$oi->{Re}$(?!\n)/s;
        my $how = $oi->{How};
        if (ref($how) eq 'SCALAR') {
@@ -7110,7 +7235,8 @@ sub parseopts () {
                $_='';
            } elsif (m/^--force-/) {
                print STDERR
-                   "$us: warning: ignoring unknown force option $_\n";
+                   f_ "%s: warning: ignoring unknown force option %s\n",
+                      $us, $_;
                $_='';
            } elsif (m/^--dgit-tag-format=(old|new)$/s) {
                # undocumented, for testing
@@ -7129,7 +7255,7 @@ sub parseopts () {
                push @ropts, $_;
                $funcopts_long{$_}();
            } else {
-               badusage "unknown long option \`$_'";
+               badusage f_ "unknown long option \`%s'", $_;
            }
        } else {
            while (m/^-./s) {
@@ -7161,15 +7287,18 @@ sub parseopts () {
                } elsif (s/^-wgf$//s) {
                    push @ropts, $&;
                    $cleanmode = 'git-ff';
-               } elsif (s/^-wd$//s) {
+               } elsif (s/^-wd(d?)([na]?)$//s) {
                    push @ropts, $&;
                    $cleanmode = 'dpkg-source';
-               } elsif (s/^-wdd$//s) {
-                   push @ropts, $&;
-                   $cleanmode = 'dpkg-source-d';
+                   $cleanmode .= '-d' if $1;
+                   $cleanmode .= ',no-check' if $2 eq 'n';
+                   $cleanmode .= ',all-check' if $2 eq 'a';
                } elsif (s/^-wc$//s) {
                    push @ropts, $&;
                    $cleanmode = 'check';
+               } elsif (s/^-wci$//s) {
+                   push @ropts, $&;
+                   $cleanmode = 'check,ignores';
                } elsif (s/^-c([^=]*)\=(.*)$//s) {
                    push @git, '-c', $&;
                    $gitcfgs{cmdline}{$1} = [ $2 ];
@@ -7182,7 +7311,7 @@ sub parseopts () {
                    $valopt->($oi->{Short});
                    $_ = '';
                } else {
-                   badusage "unknown short option \`$_'";
+                   badusage f_ "unknown short option \`%s'", $_;
                }
            }
        }
@@ -7191,23 +7320,24 @@ sub parseopts () {
 
 sub check_env_sanity () {
     my $blocked = new POSIX::SigSet;
-    sigprocmask SIG_UNBLOCK, $blocked, $blocked or die $!;
+    sigprocmask SIG_UNBLOCK, $blocked, $blocked or confess $!;
 
     eval {
        foreach my $name (qw(PIPE CHLD)) {
            my $signame = "SIG$name";
            my $signum = eval "POSIX::$signame" // die;
-           die "$signame is set to something other than SIG_DFL\n"
+           die f_ "%s is set to something other than SIG_DFL\n",
+               $signame
                if defined $SIG{$name} and $SIG{$name} ne 'DEFAULT';
            $blocked->ismember($signum) and
-               die "$signame is blocked\n";
+               die f_ "%s is blocked\n", $signame;
        }
     };
     return unless $@;
     chomp $@;
-    fail <<END;
-On entry to dgit, $@
-This is a bug produced by something in in your execution environment.
+    fail f_ <<END, $@;
+On entry to dgit, %s
+This is a bug produced by something in your execution environment.
 Giving up.
 END
 }
@@ -7223,7 +7353,7 @@ sub parseopts_late_defaults () {
 
        my $v = access_cfg("cmd-$k", 'RETURN-UNDEF');
        if (defined $v) {
-           badcfg "cannot set command for $k"
+           badcfg f_ "cannot set command for %s", $k
                unless length $om->[0];
            $om->[0] = $v;
        }
@@ -7236,7 +7366,7 @@ sub parseopts_late_defaults () {
            printdebug "CL $c ", (join " ", map { shellquote } @vl),
                "\n" if $debuglevel >= 4;
            next unless @vl;
-           badcfg "cannot configure options for $k"
+           badcfg f_ "cannot configure options for %s", $k
                if $opts_opt_cmdonly{$k};
            my $insertpos = $opts_cfg_insertpos{$k};
            @$om = ( @$om[0..$insertpos-1],
@@ -7256,7 +7386,7 @@ sub parseopts_late_defaults () {
            // access_cfg('quilt-mode', 'RETURN-UNDEF')
            // 'linear';
        $quilt_mode =~ m/^($quilt_modes_re)$/ 
-           or badcfg "unknown quilt-mode \`$quilt_mode'";
+           or badcfg f_ "unknown quilt-mode \`%s'", $quilt_mode;
        $quilt_mode = $1;
     }
 
@@ -7266,7 +7396,8 @@ sub parseopts_late_defaults () {
        next if defined $$vr;
        $$vr = access_cfg($moc->{Key}, 'RETURN-UNDEF') // $moc->{Default};
        my $v = $moc->{Vals}{$$vr};
-       badcfg "unknown $moc->{Key} setting \`$$vr'" unless defined $v;
+       badcfg f_ "unknown %s setting \`%s'", $moc->{Key}, $$vr
+           unless defined $v;
        $$vr = $v;
     }
 
@@ -7275,11 +7406,14 @@ sub parseopts_late_defaults () {
 
     if (!defined $cleanmode) {
        local $access_forpush;
-       $cleanmode = access_cfg('clean-mode', 'RETURN-UNDEF');
+       $cleanmode = access_cfg('clean-mode-newer', 'RETURN-UNDEF');
+       $cleanmode = undef if $cleanmode && $cleanmode !~ m/^$cleanmode_re$/;
+
+       $cleanmode //= access_cfg('clean-mode', 'RETURN-UNDEF');
        $cleanmode //= 'dpkg-source';
 
-       badcfg "unknown clean-mode \`$cleanmode'" unless
-           $cleanmode =~ m/^($cleanmode_re)$(?!\n)/s;
+       badcfg f_ "unknown clean-mode \`%s'", $cleanmode unless
+           $cleanmode =~ m/$cleanmode_re/;
     }
 
     $buildproductsdir //= access_cfg('build-products-dir', 'RETURN-UNDEF');
@@ -7299,11 +7433,11 @@ if ($ENV{$fakeeditorenv}) {
 parseopts();
 check_env_sanity();
 
-print STDERR "DRY RUN ONLY\n" if $dryrun_level > 1;
-print STDERR "DAMP RUN - WILL MAKE LOCAL (UNSIGNED) CHANGES\n"
+print STDERR __ "DRY RUN ONLY\n" if $dryrun_level > 1;
+print STDERR __ "DAMP RUN - WILL MAKE LOCAL (UNSIGNED) CHANGES\n"
     if $dryrun_level == 1;
 if (!@ARGV) {
-    print STDERR __ $helpmsg or die $!;
+    print STDERR __ $helpmsg or confess $!;
     finish 8;
 }
 $cmd = $subcommand = shift @ARGV;
@@ -7312,11 +7446,14 @@ $cmd =~ y/-/_/;
 my $pre_fn = ${*::}{"pre_$cmd"};
 $pre_fn->() if $pre_fn;
 
-record_maindir if $invoked_in_git_tree;
+if ($invoked_in_git_tree) {
+    changedir_git_toplevel();
+    record_maindir();
+}
 git_slurp_config();
 
 my $fn = ${*::}{"cmd_$cmd"};
-$fn or badusage "unknown operation $cmd";
+$fn or badusage f_ "unknown operation %s", $cmd;
 $fn->();
 
 finish 0;