chiark / gitweb /
po4a: pairwise-pocheck: Force it to be run sometimes
[dgit.git] / dgit
diff --git a/dgit b/dgit
index 32b024eca090ee82f0271d5b94ac4819618409d5..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
@@ -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;
@@ -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";
        }
@@ -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();
@@ -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}:";
@@ -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;
@@ -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)],
@@ -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;
@@ -5715,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;
        }
@@ -5797,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();
@@ -6173,34 +6203,71 @@ 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') {
+    # 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(-T clean);
-    } elsif ($cleanmode eq 'dpkg-source-d') {
-       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 confess $!;
-           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 ?";
     }
 }
 
     }
 }
 
@@ -6236,9 +6303,18 @@ 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;
     build_maybe_quilt_fixup();
     if ($rmchanges) {
        my $pat = changespat $version;
@@ -6509,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) {
@@ -6559,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;
@@ -6575,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 f_ "put in place new built file (%s): %s", $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;
@@ -6805,7 +6897,7 @@ sub cmd_import_dsc {
            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
            fail f_ <<END, $dsc_hash
 .dsc contains Dgit field referring to object %s
 Your git tree does not have that object.  Try `git fetch' from a
-plausible server (browse.dgit.d.o? alioth?), and try the import-dsc again.
+plausible server (browse.dgit.d.o? salsa?), and try the import-dsc again.
 END
        }
        if ($oldhash && !is_fast_fwd $oldhash, $dsc_hash) {
 END
        }
        if ($oldhash && !is_fast_fwd $oldhash, $dsc_hash) {
@@ -6848,13 +6940,15 @@ END
                $dscfn;
        }
        $there =~ s#/+[^/]+$## or fail f_
                $dscfn;
        }
        $there =~ s#/+[^/]+$## or fail f_
-           "import %s requires ../%s, but it does not exist",
+           "import %s requires .../%s, but it does not exist",
            $dscfn, $f;
        $there .= "/$f";
        my $test = $there =~ m{^/} ? $there : "../$there";
            $dscfn, $f;
        $there .= "/$f";
        my $test = $there =~ m{^/} ? $there : "../$there";
-       stat $test or fail "import $dscfn requires $test, but: $!";
-       symlink $there, $here or fail "symlink $there to $here: $!";
-       progress "made symlink $here -> $there";
+       stat $test or fail f_
+           "import %s requires %s, but: %s", $dscfn, $test, $!;
+       symlink $there, $here or fail f_
+           "symlink %s to %s: %s", $there, $here, $!;
+       progress f_ "made symlink %s -> %s", $here, $there;
 #      print STDERR Dumper($fi);
     }
     my @mergeinputs = generate_commits_from_dsc();
 #      print STDERR Dumper($fi);
     }
     my @mergeinputs = generate_commits_from_dsc();
@@ -6864,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
@@ -6887,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 () {
@@ -6914,19 +7011,20 @@ 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();
     print $url, "\n" or confess $!;
        if @ARGV;
     my $url = repos_server_url();
     print $url, "\n" or confess $!;
@@ -6936,31 +7034,33 @@ sub pre_print_dpkg_source_ignores {
     not_necessarily_a_tree();
 }
 sub cmd_print_dpkg_source_ignores {
     not_necessarily_a_tree();
 }
 sub cmd_print_dpkg_source_ignores {
-    badusage "no arguments allowed to dgit print-dpkg-source-ignores"
+    badusage __
+       "no arguments allowed to dgit print-dpkg-source-ignores"
        if @ARGV;
     print "@dpkg_source_ignores\n" or confess $!;
 }
 
 sub cmd_setup_mergechangelogs {
        if @ARGV;
     print "@dpkg_source_ignores\n" or confess $!;
 }
 
 sub cmd_setup_mergechangelogs {
-    badusage "no arguments allowed to dgit setup-mergechangelogs" if @ARGV;
+    badusage __ "no arguments allowed to dgit setup-mergechangelogs"
+       if @ARGV;
     local $isuite = 'DGIT-SETUP-TREE';
     setup_mergechangelogs(1);
 }
 
 sub cmd_setup_useremail {
     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();
 }
@@ -7007,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 ($@) {
@@ -7046,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') {
@@ -7135,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
@@ -7154,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) {
@@ -7186,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 ];
@@ -7207,7 +7311,7 @@ sub parseopts () {
                    $valopt->($oi->{Short});
                    $_ = '';
                } else {
                    $valopt->($oi->{Short});
                    $_ = '';
                } else {
-                   badusage "unknown short option \`$_'";
+                   badusage f_ "unknown short option \`%s'", $_;
                }
            }
        }
                }
            }
        }
@@ -7222,17 +7326,18 @@ sub check_env_sanity () {
        foreach my $name (qw(PIPE CHLD)) {
            my $signame = "SIG$name";
            my $signum = eval "POSIX::$signame" // die;
        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
 }
@@ -7248,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;
        }
@@ -7261,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],
@@ -7281,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;
     }
 
@@ -7291,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;
     }
 
@@ -7300,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');
@@ -7324,8 +7433,8 @@ 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) {
     print STDERR __ $helpmsg or confess $!;
     if $dryrun_level == 1;
 if (!@ARGV) {
     print STDERR __ $helpmsg or confess $!;
@@ -7337,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;