chiark / gitweb /
po4a: pairwise-pocheck: Force it to be run sometimes
[dgit.git] / dgit
diff --git a/dgit b/dgit
index e0ebfbadd1c230f94466f420b5dad7e1ee2996e4..e10483894bb1084ae5693cf94c1347d959216c1a 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 %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';
 
 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;
        }
            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
        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;
        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 $!";
     }
     PF->error and die "$ourfn $!";
-    print $fh "data-end\n" or die $!;
+    print $fh "data-end\n" or confess $!;
     close PF;
 }
 
     close PF;
 }
 
@@ -541,9 +549,9 @@ sub protocol_receive_file ($$) {
        } $fh;
        last unless $y;
        my $d = protocol_read_bytes $fh, $l;
        } $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 ----------
 }
 
 #---------- 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";
     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 ($$) {
 }    
 
 sub responder_send_file ($$) {
@@ -588,8 +596,8 @@ sub initiator_expect (&) {
 sub progress {
     if ($we_are_responder) {
        my $m = join '', @_;
 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";
     }
     } else {
        print @_, "\n";
     }
@@ -604,7 +612,7 @@ sub url_get {
     }
     my $what = $_[$#_];
     progress "downloading $what...";
     }
     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;
     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 {
 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;
 }
 
     finish 8;
 }
 
@@ -681,7 +689,7 @@ sub pre_help () {
     not_necessarily_a_tree();
 }
 sub cmd_help () {
     not_necessarily_a_tree();
 }
 sub cmd_help () {
-    print __ $helpmsg or die $!;
+    print __ $helpmsg or confess $!;
     finish 0;
 }
 
     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==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;
        return $l->[0];
     }
     return undef;
@@ -928,8 +939,8 @@ sub supplementary_message ($) {
        return;
     } elsif ($protovsn >= 3) {
        responder_send_command "supplementary-message ".length($msg)
        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 () {
 }
 
 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;
     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')
        access_cfg('mirror'),
        $aptsuites,
        access_cfg('aptget-components')
-       or die $!;
+       or confess $!;
 
     ensuredir "$aptget_base/cache";
     ensuredir "$aptget_base/lists";
 
 
     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";
     print CONF <<END;
 Debug::NoLocking "true";
 APT::Get::List-Cleanup "false";
@@ -1314,10 +1325,10 @@ END
                        Dir::Etc::preferencesparts
                      )) {
        ensuredir "$aptget_base/$key";
                        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];
     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;
     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;
     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;
               " 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");
     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;
     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>) {
     {
        local $/="\0";
        while (<GITS>) {
@@ -2220,18 +2231,18 @@ sub generate_commits_from_dsc () {
 
        printdebug "considering saving $f: ";
 
 
        printdebug "considering saving $f: ";
 
-       if (link $f, $upper_f) {
+       if (rename_link_xf 1, $f, $upper_f) {
            printdebug "linked.\n";
            printdebug "linked.\n";
-       } elsif ((printdebug "($!) "),
+       } elsif ((printdebug "($@) "),
                 $! != EEXIST) {
                 $! != EEXIST) {
-           fail f_ "saving %s: %s", "$buildproductsdir/$f", $!;
+           fail f_ "saving %s: %s", "$buildproductsdir/$f", $@;
        } elsif (!$refetched) {
            printdebug "no need.\n";
        } 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";
            printdebug "linked (using ...,fetch).\n";
-       } elsif ((printdebug "($!) "),
+       } elsif ((printdebug "($@) "),
                 $! != EEXIST) {
                 $! != EEXIST) {
-           fail f_ "saving %s: %s", "$buildproductsdir/$f,fetch", $!;
+           fail f_ "saving %s: %s", "$buildproductsdir/$f,fetch", $@;
        } else {
            printdebug "cannot.\n";
        }
        } 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;
                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) {
            if (!$compr_pid) {
-               open STDIN, "<&", $input or die $!;
+               open STDIN, "<&", $input or confess $!;
                exec @compr_cmd;
                die "dgit (child): exec $compr_cmd[0]: $!\n";
            }
                exec @compr_cmd;
                die "dgit (child): exec $compr_cmd[0]: $!\n";
            }
@@ -2288,23 +2299,23 @@ sub generate_commits_from_dsc () {
        }
 
        rmtree "_unpack-tar";
        }
 
        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 @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) {
        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], $!;
        }
            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)
        !$? 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
 
        # finally, we have the results in "tarball", but maybe
        # with the wrong permissions
 
@@ -2461,14 +2472,14 @@ END_T
 
     printdebug "import main commit\n";
 
 
     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
 tree $tree
 END
-    print C <<END or die $! foreach @tartrees;
+    print C <<END or confess $! foreach @tartrees;
 parent $_->{Commit}
 END
 parent $_->{Commit}
 END
-    print C <<END or die $!;
+    print C <<END or confess $!;
 author $authline
 committer $authline
 
 author $authline
 committer $authline
 
@@ -2477,7 +2488,7 @@ $changes
 [dgit import $treeimporthow $package $cversion]
 END
 
 [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}) {
     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
                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
            }
            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
 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,
             @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);
        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};
     };
        $got = $fi->{Digester}->hexdigest();
        return $got eq $fi->{Hash};
     };
@@ -2752,7 +2763,7 @@ sub git_lrfetch_sane {
        debugcmd "|",@lcmd;
 
        my %wantr;
        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 $_ ?";
        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;
            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;
        }
            }
            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
 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
            @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
 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) {
     } 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
 
 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 $!";
 
        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};
 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
 
 parent $_->{Commit}
 END
 
-       print MC <<END or die $!;
+       print MC <<END or confess $!;
 author $author
 committer $author
 
 END
 
        if (defined $compat_info->{Message}) {
 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 {
        } 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
 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}
                my ($mi) = (@_);
                my $mversion = mergeinfo_version $mi;
                printf MC "  %-20s %s\n", $mversion, $mi->{Info}
-                   or die $!;
+                   or confess $!;
            };
 
            $message_add_info->($mergeinputs[0]);
            };
 
            $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];
        }
 
 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};
        $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) {
        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
 
 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};
        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;
     }
        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';
     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;
     }
        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;
 }    
     printdebug "is_gitattrs_setup: found nothing\n";
     return undef;
 }    
@@ -3488,8 +3499,8 @@ END
     my $af = "$maindir_gitcommon/info/attributes";
     ensuredir "$maindir_gitcommon/info";
 
     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
 *      dgit-defuse-attrs
 $new
 END
@@ -3503,11 +3514,11 @@ ENDT
                $_ = $new;
            }
            chomp;
                $_ = $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, $!;
 }
 
     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;
     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;
     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;
     # 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;
     if (!$pid) {
        forkcheck_setup();
        $isuite = $tsuite;
@@ -3559,17 +3570,17 @@ sub multisuite_suite_child ($$$) {
        $debugprefix .= " ";
        progress f_ "fetching %s...", $tsuite;
        canonicalise_suite();
        $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;
     }
        $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;
     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>;
     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;
     if ($? == 256*4) {
        printdebug "multisuite $tsuite missing\n";
        return $csuite;
@@ -3712,9 +3723,9 @@ sub fork_for_multisuite ($) {
 }
 
 sub clone_set_head () {
 }
 
 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) = @_;
 }
 sub clone_finish ($) {
     my ($dstdir) = @_;
@@ -3813,12 +3824,25 @@ sub pull () {
 }
 
 sub check_not_dirty () {
 }
 
 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();
     return if $includedirty;
 
     git_check_unmodified();
@@ -3880,18 +3904,18 @@ sub get_source_format () {
                $options{$_} = 1;
            }
        }
                $options{$_} = 1;
            }
        }
-       F->error and die $!;
+       F->error and confess $!;
        close F;
     } else {
        close F;
     } else {
-       die $! unless $!==&ENOENT;
+       confess $! unless $!==&ENOENT;
     }
 
     if (!open F, "debian/source/format") {
     }
 
     if (!open F, "debian/source/format") {
-       die $! unless $!==&ENOENT;
+       confess $! unless $!==&ENOENT;
        return '';
     }
     $_ = <F>;
        return '';
     }
     $_ = <F>;
-    F->error and die $!;
+    F->error and confess $!;
     chomp;
     return ($_, \%options);
 }
     chomp;
     return ($_, \%options);
 }
@@ -4012,7 +4036,7 @@ END
 sub pseudomerge_make_commit ($$$$ $$) {
     my ($clogp, $dgitview, $archive_hash, $i_arch_v,
        $msg_cmd, $msg_msg) = @_;
 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}:";
                 $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 $!";
     # 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
 tree $tree
 parent $dgitview
 parent $archive_hash
@@ -4039,7 +4063,7 @@ $msg_msg
 
 [$msg_cmd]
 END
 
 [$msg_cmd]
 END
-    close MC or die $!;
+    close MC or confess $!;
 
     return make_commit($pmf);
 }
 
     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) {
     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;
     }
 
     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->{$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)) {
 
     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};
 
        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
 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
            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) {
 [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
            }
 [dgit previously:$ref=$previously{$ref}]
 END
            }
@@ -4269,12 +4293,12 @@ END
 (maintainer view tag generated by dgit --quilt=%s)
 END
                $quilt_mode
 (maintainer view tag generated by dgit --quilt=%s)
 END
                $quilt_mode
-               or die $!;
+               or confess $!;
        } else {
            confess Dumper($tw)."?";
        }
 
        } else {
            confess Dumper($tw)."?";
        }
 
-       close TO or die $!;
+       close TO or confess $!;
 
        my $tagobjfn = $tfn->('.tmp');
        if ($sign) {
 
        my $tagobjfn = $tfn->('.tmp');
        if ($sign) {
@@ -4284,7 +4308,7 @@ END
            if (!defined $keyid) {
                $keyid = getfield $clogp, 'Maintainer';
            }
            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');
            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)],
     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)],
            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)],
            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)";
 
     $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;
     autoflush PO 1;
-    open STDOUT, ">&STDERR" or die $!;
+    open STDOUT, ">&STDERR" or confess $!;
     autoflush STDOUT 1;
 
     $vsnwant //= 1;
     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;
     $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();
     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;
     }
     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);
 }
 
 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/;
     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
 From: $author
 ${xinfo}Subject: $msg
 ---
 
 END
-    close O or die $!;
+    close O or confess $!;
 
     {
        local $ENV{'EDITOR'} = cmdoutput qw(realpath --), $0;
 
     {
        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;
         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;
         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
        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),
            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;
            my $patchstackchange = cmdoutput @cmd;
            if (length $patchstackchange) {
                $patchstackchange =~ s/\n/,/g;
@@ -5597,15 +5622,16 @@ sub quiltify ($$$$) {
            my ($what) = @_;
 
            eval {
            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 $@;
            };
            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;
        };
 
            return undef;
        };
 
@@ -5633,7 +5659,7 @@ sub quiltify ($$$$) {
                $patchname = $translitname;
            };
            print STDERR
                $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;
                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++) { }
        for ($index='';
             stat "debian/patches/$patchname$index";
             $index++) { }
-       $!==ENOENT or die "$patchname$index $!";
+       $!==ENOENT or confess "$patchname$index $!";
 
        runcmd @git, qw(checkout -q), $cc;
 
 
        runcmd @git, qw(checkout -q), $cc;
 
@@ -5714,7 +5740,10 @@ END
        if (act_local()) {
            debugcmd "+",@cmd;
            $!=0; $?=-1;
        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;
        }
        } else {
            dryrun_report @cmd;
        }
@@ -5740,7 +5769,7 @@ END
 sub unpack_playtree_mkwork ($) {
     my ($headref) = @_;
 
 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;
     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);
 
 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
 
 Commit removal of .pc (quilt series tracking data)
 END
 
@@ -5780,7 +5809,7 @@ ENDU
 sub quilt_fixup_singlepatch ($$$) {
     my ($clogp, $headref, $upstreamversion) = @_;
 
 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
 
     # 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"), 
     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();
 
     changedir "work";
     commit_quilty_patch();
@@ -5807,8 +5838,8 @@ sub quilt_make_fake_dsc ($) {
 
     my $fakeversion="$upstreamversion-~~DGITFAKE";
 
 
     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
 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 $!";
        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);
        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);
     };
 
     unpack_playtree_linkorigs($upstreamversion, $dscaddfile);
@@ -5842,7 +5873,7 @@ END
     runcmd qw(env GZIP=-1n tar -zcf), "./$debtar", qw(-C), $maindir, @files;
 
     $dscaddfile->($debtar);
     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 ($$) {
 }
 
 sub quilt_fakedsc2unapplied ($$) {
@@ -5858,7 +5889,7 @@ sub quilt_fakedsc2unapplied ($$) {
 
     changedir 'fake';
 
 
     changedir 'fake';
 
-    remove_stray_gits("source package");
+    remove_stray_gits(__ "source package");
     mktree_in_ud_here();
 
     rmtree '.pc';
     mktree_in_ud_here();
 
     rmtree '.pc';
@@ -5879,8 +5910,9 @@ sub quilt_check_splitbrain_cache ($$) {
 
     my $splitbrain_cachekey;
     
 
     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);
     # 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) {
        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);
        }
            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);
     }
 
        return ($headref, $splitbrain_cachekey);
     }
 
@@ -5926,7 +5958,8 @@ sub quilt_check_splitbrain_cache ($$) {
 sub quilt_fixup_multipatch ($$$) {
     my ($clogp, $headref, $upstreamversion) = @_;
 
 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
 
     # 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;
     $!=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
 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;
     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 {
         $mustdeletepc=1;
     } else {
-        rename '../fake/.pc','.pc' or die $!;
+        rename '../fake/.pc','.pc' or confess $!;
     }
 
     changedir '../fake';
     }
 
     changedir '../fake';
@@ -6066,39 +6099,40 @@ END
     }
     printdebug "differences \@dl @dl.\n";
 
     }
     printdebug "differences \@dl @dl.\n";
 
-    progress sprintf
+    progress f_
 "%s: base trees orig=%.20s o+d/p=%.20s",
               $us, $unapplied, $oldtiptree;
 "%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) {
 "%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;
            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})) {
 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})) {
     } 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 ?" ];
 
  "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';
 
  "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()) {
  "Maybe orig tarball(s) are not identical to git representation?" ];
 
     if (quiltmode_splitbrain()) {
@@ -6108,11 +6142,11 @@ END
        return;
     }
 
        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") {
     quiltify($clogp,$headref,$oldtiptree,\@failsuggestion);
 
     if (!open P, '>>', ".pc/applied-patches") {
-       $!==&ENOENT or die $!;
+       $!==&ENOENT or confess $!;
     } else {
        close P;
     }
     } else {
        close P;
     }
@@ -6127,25 +6161,25 @@ END
 sub quilt_fixup_editor () {
     my $descfn = $ENV{$fakeeditorenv};
     my $editing = $ARGV[$#ARGV];
 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;
     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/;
     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.
 
 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 () {
 }
 
 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;
        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 -----
 
 
 #----- 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 () {
 
 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();
        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 '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 {
     } elsif ($cleanmode eq 'none') {
     } else {
-       die "$cleanmode ?";
+       confess "$cleanmode ?";
     }
 }
 
 sub cmd_clean () {
     }
 }
 
 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();
     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++;
 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';
     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();
 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()) {
     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 {
            } else {
-               progress "would remove $f";
+               progress f_ "would remove %s", $f;
            }
        }
     }
            }
        }
     }
@@ -6265,17 +6348,17 @@ sub changesopts_version () {
            1;
        }) {
            print STDERR $@;
            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];
  "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 = '_';
        } 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 '_') {
        }
     }
     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;
        $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 :
        $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;
     }
     printdebug "massage done $r $dmode.\n";
     push @$cmd, $dmode;
@@ -6355,30 +6438,35 @@ sub postbuild_mergechanges ($) {
     } @changesfiles;
     my $result;
     if (@changesfiles==1) {
     } @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
 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') {
        $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()) {
                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;
            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 {
            }
        }
        $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 () {
 }
 
 sub midbuild_checkchanges () {
@@ -6389,9 +6477,9 @@ sub midbuild_checkchanges () {
        $_ ne changespat $version,'source' and
        $_ ne changespat $version,'multi'
     } @unwanted;
        $_ 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;
 }
 END
        if @unwanted;
 }
@@ -6408,15 +6496,15 @@ sub postbuild_mergechanges_vanilla ($) {
            postbuild_mergechanges(undef);
        };
     } else {
            postbuild_mergechanges(undef);
        };
     } else {
-       printdone "build successful\n";
+       printdone __ "build successful\n";
     }
 }
 
 sub cmd_build {
     build_prep_early();
     }
 }
 
 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);
 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";
     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=".
        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 {
        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) {
     }
     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
     $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;
     }
     my @cmd = (@dpkgsource, qw(-b --));
     my $leafdir;
@@ -6547,6 +6633,24 @@ sub build_source {
         }
     } else {
         $leafdir = basename $maindir;
         }
     } 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;
         changedir '..';
     }
     runcmd_ordryrun_local @cmd, $leafdir;
@@ -6563,8 +6667,8 @@ sub build_source {
     my $mv = sub {
        my ($why, $l) = @_;
         printdebug " renaming ($why) $l\n";
     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;
     };
     foreach my $l (split /\n/, getfield $dsc, 'Files') {
         $l =~ m/\S+$/ or next;
@@ -6577,28 +6681,31 @@ sub build_source {
 }
 
 sub cmd_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();
     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();
 }
 
 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",
     build_maybe_quilt_fixup();
     if ($changesfile) {
         my $changes = parsecontrol("$buildproductsdir/$changesfile",
-                                   "source changes file");
+                                   __ "source changes file");
         unless (test_source_only_changes($changes)) {
         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();
         }
     } 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;
     }
            if $patches_applied_dirtily;
        $changesfile = $sourcechanges;
     }
@@ -6612,9 +6719,10 @@ sub binary_builder {
     midbuild_checkchanges();
     in_bpd {
        if (act_local()) {
     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;
     };
        }
        runcmd_ordryrun_local @$bbuilder, @args;
     };
@@ -6626,7 +6734,7 @@ sub binary_builder {
 
 sub cmd_sbuild {
     build_prep_early();
 
 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
 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;
     # @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
       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 {
 }
 
 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';
     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);
     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;
 }
 
 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 {
 }
 
 sub cmd_import_dsc {
@@ -6707,14 +6818,16 @@ sub cmd_import_dsc {
        if (m/^--require-valid-signature$/) {
            $needsig = 1;
        } else {
        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;
 
     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 :
 
     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;
 
     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;
 
        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>; };
     $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
     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;
        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()) {
        };
        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();
        } 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';
 
 
     $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();
 
        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) {
     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) {
        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#) {
                   "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
 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) {
 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 {
            } 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",
            }
        }
        import_dsc_result $dstbranch, $dsc_hash,
            "dgit import-dsc (Dgit): $info",
-           "updated git ref $dstbranch";
+           f_ "updated git ref %s", $dstbranch;
        return 0;
     }
 
        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;
 
 END
        if $oldhash && !$force;
 
@@ -6812,24 +6926,29 @@ END
        my $here = "$buildproductsdir/$f";
        if (lstat $here) {
            next if stat $here;
        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 {
        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";
        $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();
 #      print STDERR Dumper($fi);
     }
     my @mergeinputs = generate_commits_from_dsc();
@@ -6839,21 +6958,24 @@ END
 
     if ($oldhash) {
        if ($force > 0) {
 
     if ($oldhash) {
        if ($force > 0) {
-           progress "Import, forced update - synthetic orphan git history.";
+           progress __
+               "Import, forced update - synthetic orphan git history.";
        } elsif ($force < 0) {
        } 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;
            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
 
 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
 END
        } else {
            die; # caught earlier
@@ -6862,20 +6984,20 @@ END
 
     import_dsc_result $dstbranch, $newhash,
        "dgit import-dsc: $info",
 
     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 {
 }
 
 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;
     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 () {
 }
 
 sub repos_server_url () {
@@ -6889,53 +7011,56 @@ sub pre_clone_dgit_repos_server () {
     not_necessarily_a_tree();
 }
 sub cmd_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;
     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 {
 }
 
 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();
        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 {
 }
 
 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;
        if @ARGV;
-    print "@dpkg_source_ignores\n" or die $!;
+    print "@dpkg_source_ignores\n" or confess $!;
 }
 
 sub cmd_setup_mergechangelogs {
 }
 
 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 {
     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 {
     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 {
     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();
 }
     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 {
 #---------- 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;
 }
 
     finish 0;
 }
 
@@ -6982,8 +7107,8 @@ defvalopt '', '-C', '.+', sub {
 defvalopt '--initiator-tempdir','','.*', sub {
     ($initiator_tempdir) = (@_);
     $initiator_tempdir =~ m#^/# or
 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 ($@) {
 };
 
 sub defoptmodes ($@) {
@@ -7021,11 +7146,11 @@ sub parseopts () {
        my ($what) = @_;
        @rvalopts = ($_);
        if (!defined $val) {
        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;
        }
            $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') {
            $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
                $_='';
            } 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
                $_='';
            } elsif (m/^--dgit-tag-format=(old|new)$/s) {
                # undocumented, for testing
@@ -7129,7 +7255,7 @@ sub parseopts () {
                push @ropts, $_;
                $funcopts_long{$_}();
            } else {
                push @ropts, $_;
                $funcopts_long{$_}();
            } else {
-               badusage "unknown long option \`$_'";
+               badusage f_ "unknown long option \`%s'", $_;
            }
        } else {
            while (m/^-./s) {
            }
        } else {
            while (m/^-./s) {
@@ -7161,15 +7287,18 @@ sub parseopts () {
                } elsif (s/^-wgf$//s) {
                    push @ropts, $&;
                    $cleanmode = 'git-ff';
                } elsif (s/^-wgf$//s) {
                    push @ropts, $&;
                    $cleanmode = 'git-ff';
-               } elsif (s/^-wd$//s) {
+               } elsif (s/^-wd(d?)([na]?)$//s) {
                    push @ropts, $&;
                    $cleanmode = 'dpkg-source';
                    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/^-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 ];
                } elsif (s/^-c([^=]*)\=(.*)$//s) {
                    push @git, '-c', $&;
                    $gitcfgs{cmdline}{$1} = [ $2 ];
@@ -7182,7 +7311,7 @@ sub parseopts () {
                    $valopt->($oi->{Short});
                    $_ = '';
                } else {
                    $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;
 
 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;
 
     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
                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 $@;
        }
     };
     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
 }
 Giving up.
 END
 }
@@ -7223,7 +7353,7 @@ sub parseopts_late_defaults () {
 
        my $v = access_cfg("cmd-$k", 'RETURN-UNDEF');
        if (defined $v) {
 
        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;
        }
                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;
            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],
                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)$/ 
            // 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;
     }
 
        $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};
        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;
     }
 
        $$vr = $v;
     }
 
@@ -7275,11 +7406,14 @@ sub parseopts_late_defaults () {
 
     if (!defined $cleanmode) {
        local $access_forpush;
 
     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';
 
        $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');
     }
 
     $buildproductsdir //= access_cfg('build-products-dir', 'RETURN-UNDEF');
@@ -7299,11 +7433,11 @@ if ($ENV{$fakeeditorenv}) {
 parseopts();
 check_env_sanity();
 
 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) {
     if $dryrun_level == 1;
 if (!@ARGV) {
-    print STDERR __ $helpmsg or die $!;
+    print STDERR __ $helpmsg or confess $!;
     finish 8;
 }
 $cmd = $subcommand = shift @ARGV;
     finish 8;
 }
 $cmd = $subcommand = shift @ARGV;
@@ -7312,11 +7446,14 @@ $cmd =~ y/-/_/;
 my $pre_fn = ${*::}{"pre_$cmd"};
 $pre_fn->() if $pre_fn;
 
 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"};
 git_slurp_config();
 
 my $fn = ${*::}{"cmd_$cmd"};
-$fn or badusage "unknown operation $cmd";
+$fn or badusage f_ "unknown operation %s", $cmd;
 $fn->();
 
 finish 0;
 $fn->();
 
 finish 0;