dgit: Improve -DDDD config debugging

[dgit.git] / dgit

diff --git a/dgit b/dgit
index bd9dd3967945f290c6f92eaed60c3dc02f0f7448..d524bd2de0885bf2f2d1d5f5b8f145573259f845 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -69,6 +69,8 @@ our $rmchanges;
 our $overwrite_version; # undef: not specified; '': check changelog
 our $quilt_mode;
 our $quilt_modes_re = 'linear|smash|auto|nofix|nocheck|gbp|dpm|unapplied';
 our $overwrite_version; # undef: not specified; '': check changelog
 our $quilt_mode;
 our $quilt_modes_re = 'linear|smash|auto|nofix|nocheck|gbp|dpm|unapplied';

+our $dodep14tag;
+our $dodep14tag_re = 'want|no|always';

 our $split_brain_save;
 our $we_are_responder;
 our $initiator_tempdir;
 our $split_brain_save;
 our $we_are_responder;
 our $initiator_tempdir;


@@ -94,6 +96,7 @@ our $orig_f_tail_re = "$orig_f_comp_re\\.tar(?:\\.\\w+)?(?:$orig_f_sig_re)?";
 
 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';

+our $rewritemap = 'dgit-rewrite/map';

 
 our (@git) = qw(git);
 our (@dget) = qw(dget);
 
 our (@git) = qw(git);
 our (@dget) = qw(dget);


@@ -139,7 +142,7 @@ our %opts_cfg_insertpos = map {
     scalar @{ $opts_opt_map{$_} }
 } keys %opts_opt_map;
 
     scalar @{ $opts_opt_map{$_} }
 } keys %opts_opt_map;
 

-sub finalise_opts_opts();
+sub parseopts_late_defaults();

 
 our $keyid;
 
 
 our $keyid;
 


@@ -171,8 +174,7 @@ sub debiantag ($$) {
 
 sub debiantag_maintview ($$) { 
     my ($v,$distro) = @_;
 
 sub debiantag_maintview ($$) { 
     my ($v,$distro) = @_;

-    $v =~ y/~:/_%/;
-    return "$distro/$v";
+    return "$distro/".dep14_version_mangle $v;

 }
 
 sub madformat ($) { $_[0] eq '3.0 (quilt)' }
 }
 
 sub madformat ($) { $_[0] eq '3.0 (quilt)' }


@@ -183,30 +185,6 @@ sub lref () { return "refs/heads/".lbranch(); }
 sub lrref () { return "refs/remotes/$remotename/".server_branch($csuite); }
 sub rrref () { return server_ref($csuite); }
 
 sub lrref () { return "refs/remotes/$remotename/".server_branch($csuite); }
 sub rrref () { return server_ref($csuite); }
 

-sub lrfetchrefs () { return "refs/dgit-fetch/$csuite"; }
-sub lrfetchref () { return lrfetchrefs.'/'.server_branch($csuite); }
-
-# We fetch some parts of lrfetchrefs/*.  Ideally we delete these
-# locally fetched refs because they have unhelpful names and clutter
-# up gitk etc.  So we track whether we have "used up" head ref (ie,
-# whether we have made another local ref which refers to this object).
-#
-# (If we deleted them unconditionally, then we might end up
-# re-fetching the same git objects each time dgit fetch was run.)
-#
-# So, leach use of lrfetchrefs needs to be accompanied by arrangements
-# in git_fetch_us to fetch the refs in question, and possibly a call
-# to lrfetchref_used.
-
-our (%lrfetchrefs_f, %lrfetchrefs_d);
-# $lrfetchrefs_X{lrfetchrefs."/heads/whatever"} = $objid
-
-sub lrfetchref_used ($) {
-    my ($fullrefname) = @_;
-    my $objid = $lrfetchrefs_f{$fullrefname};
-    $lrfetchrefs_d{$fullrefname} = $objid if defined $objid;
-}
-

 sub stripepoch ($) {
     my ($vsn) = @_;
     $vsn =~ s/^\d+\://;
 sub stripepoch ($) {
     my ($vsn) = @_;
     $vsn =~ s/^\d+\://;


@@ -681,7 +659,9 @@ sub git_get_config ($) {
     my ($c) = @_;
     foreach my $src (@gitcfgsources) {
        my $l = $gitcfgs{$src}{$c};
     my ($c) = @_;
     foreach my $src (@gitcfgsources) {
        my $l = $gitcfgs{$src}{$c};

-       printdebug"C $c ".(defined $l ? messagequote "'$l'" : "undef")."\n"
+       printdebug"C $c ".(defined $l ?
+                          join " ", map { messagequote "'$_'" } @$l :
+                          "undef")."\n"

            if $debuglevel >= 4;
        $l or next;
        @$l==1 or badcfg "multiple values for $c".
            if $debuglevel >= 4;
        $l or next;
        @$l==1 or badcfg "multiple values for $c".


@@ -697,7 +677,10 @@ sub cfg {
        my $v = git_get_config($c);
        return $v if defined $v;
        my $dv = $defcfg{$c};
        my $v = git_get_config($c);
        return $v if defined $v;
        my $dv = $defcfg{$c};

-       return $dv if defined $dv;
+       if (defined $dv) {
+           printdebug "CD $c $dv\n" if $debuglevel >= 4;
+           return $dv;
+       }

     }
     badcfg "need value for one of: @_\n".
        "$us: distro or suite appears not to be (properly) supported";
     }
     badcfg "need value for one of: @_\n".
        "$us: distro or suite appears not to be (properly) supported";


@@ -725,7 +708,10 @@ sub access_basedistro () {
 
 sub access_nomdistro () {
     my $base = access_basedistro();
 
 sub access_nomdistro () {
     my $base = access_basedistro();

-    return cfg("dgit-distro.$base.nominal-distro",'RETURN-UNDEF') // $base;
+    my $r = cfg("dgit-distro.$base.nominal-distro",'RETURN-UNDEF') // $base;
+    $r =~ m/^$distro_re$/ or badcfg
+ "bad syntax for (nominal) distro \`$r' (does not match /^$distro_re$/)";
+    return $r;

 }
 
 sub access_quirk () {
 }
 
 sub access_quirk () {


@@ -789,11 +775,11 @@ sub pushing () {
 Push failed, before we got started.
 You can retry the push, after fixing the problem, if you like.
 END
 Push failed, before we got started.
 You can retry the push, after fixing the problem, if you like.
 END

-    finalise_opts_opts();
+    parseopts_late_defaults();

 }
 
 sub notpushing () {
 }
 
 sub notpushing () {

-    finalise_opts_opts();
+    parseopts_late_defaults();

 }
 
 sub supplementary_message ($) {
 }
 
 sub supplementary_message ($) {


@@ -1010,6 +996,8 @@ our %rmad;
 
 sub archive_query ($;@) {
     my ($method) = shift @_;
 
 sub archive_query ($;@) {
     my ($method) = shift @_;

+    fail "this operation does not support multiple comma-separated suites"
+       if $isuite =~ m/,/;

     my $query = access_cfg('archive-query','RETURN-UNDEF');
     $query =~ s/^(\w+):// or badcfg "invalid archive-query method \`$query'";
     my $proto = $1;
     my $query = access_cfg('archive-query','RETURN-UNDEF');
     $query =~ s/^(\w+):// or badcfg "invalid archive-query method \`$query'";
     my $proto = $1;


@@ -1162,7 +1150,7 @@ sub aptget_aptcache () { return @aptcache, qw(-c), $aptget_configpath; }
 
 sub aptget_cache_clean {
     runcmd_ordryrun_local qw(sh -ec),
 
 sub aptget_cache_clean {
     runcmd_ordryrun_local qw(sh -ec),

-       'cd "$1"; pwd; find -atime +30 -type f -print0 | xargs -0r echo rm --',
+       'cd "$1"; find -atime +30 -type f -print0 | xargs -0r rm --',

        'x', $aptget_base;
 }
 
        'x', $aptget_base;
 }
 


@@ -1518,6 +1506,15 @@ sub access_cfg_tagformats () {
     split /\,/, access_cfg('dgit-tag-format');
 }
 
     split /\,/, access_cfg('dgit-tag-format');
 }
 

+sub access_cfg_tagformats_can_splitbrain () {
+    my %y = map { $_ => 1 } access_cfg_tagformats;
+    foreach my $needtf (qw(new maint)) {
+       next if $y{$needtf};
+       return 0;
+    }
+    return 1;
+}
+

 sub need_tagformat ($$) {
     my ($fmt, $why) = @_;
     fail "need to use tag format $fmt ($why) but also need".
 sub need_tagformat ($$) {
     my ($fmt, $why) = @_;
     fail "need to use tag format $fmt ($why) but also need".


@@ -1667,6 +1664,7 @@ sub create_remote_git_repo () {
 }
 
 our ($dsc_hash,$lastpush_mergeinput);
 }
 
 our ($dsc_hash,$lastpush_mergeinput);

+our ($dsc_distro, $dsc_hint_tag, $dsc_hint_url);

 
 our $ud = '.git/dgit/unpack';
 
 
 our $ud = '.git/dgit/unpack';
 


@@ -1691,7 +1689,13 @@ sub git_write_tree () {
     return $tree;
 }
 
     return $tree;
 }
 

-sub remove_stray_gits () {
+sub git_add_write_tree () {
+    runcmd @git, qw(add -Af .);
+    return git_write_tree();
+}
+
+sub remove_stray_gits ($) {
+    my ($what) = @_;

     my @gitscmd = qw(find -name .git -prune -print0);
     debugcmd "|",@gitscmd;
     open GITS, "-|", @gitscmd or die $!;
     my @gitscmd = qw(find -name .git -prune -print0);
     debugcmd "|",@gitscmd;
     open GITS, "-|", @gitscmd or die $!;


@@ -1699,7 +1703,7 @@ sub remove_stray_gits () {
        local $/="\0";
        while (<GITS>) {
            chomp or die;
        local $/="\0";
        while (<GITS>) {
            chomp or die;

-           print STDERR "$us: warning: removing from source package: ",
+           print STDERR "$us: warning: removing from $what: ",

                (messagequote $_), "\n";
            rmtree $_;
        }
                (messagequote $_), "\n";
            rmtree $_;
        }


@@ -1707,8 +1711,8 @@ sub remove_stray_gits () {
     $!=0; $?=0; close GITS or failedcmd @gitscmd;
 }
 
     $!=0; $?=0; close GITS or failedcmd @gitscmd;
 }
 

-sub mktree_in_ud_from_only_subdir (;$) {
-    my ($raw) = @_;
+sub mktree_in_ud_from_only_subdir ($;$) {
+    my ($what,$raw) = @_;

 
     # changes into the subdir
     my (@dirs) = <*/.>;
 
     # changes into the subdir
     my (@dirs) = <*/.>;


@@ -1717,7 +1721,7 @@ sub mktree_in_ud_from_only_subdir (;$) {
     my $dir = $1;
     changedir $dir;
 
     my $dir = $1;
     changedir $dir;
 

-    remove_stray_gits();
+    remove_stray_gits($what);

     mktree_in_ud_here();
     if (!$raw) {
        my ($format, $fopts) = get_source_format();
     mktree_in_ud_here();
     if (!$raw) {
        my ($format, $fopts) = get_source_format();


@@ -1726,8 +1730,7 @@ sub mktree_in_ud_from_only_subdir (;$) {
        }
     }
 
        }
     }
 

-    runcmd @git, qw(add -Af);
-    my $tree=git_write_tree();
+    my $tree=git_add_write_tree();

     return ($tree,$dir);
 }
 
     return ($tree,$dir);
 }
 


@@ -1889,7 +1892,8 @@ END
            push @found_differ, "archive $h->{filename}: ".join "; ", @differ
                if @differ;
        }
            push @found_differ, "archive $h->{filename}: ".join "; ", @differ
                if @differ;
        }

-       print "origs $file f.same=$found_same #f._differ=$#found_differ\n";
+       printdebug "origs $file f.same=$found_same".
+           " #f._differ=$#found_differ\n";

        if (@found_differ && !$found_same) {
            fail join "\n",
                "archive contains $file with different checksum",
        if (@found_differ && !$found_same) {
            fail join "\n",
                "archive contains $file with different checksum",


@@ -2120,14 +2124,14 @@ sub generate_commits_from_dsc () {
            $input = $compr_fh;
        }
 
            $input = $compr_fh;
        }
 

-       rmtree "../unpack-tar";
-       mkdir "../unpack-tar" or die $!;
+       rmtree "_unpack-tar";
+       mkdir "_unpack-tar" or die $!;

        my @tarcmd = qw(tar -x -f -
                        --no-same-owner --no-same-permissions
                        --no-acls --no-xattrs --no-selinux);
        my $tar_pid = fork // die $!;
        if (!$tar_pid) {
        my @tarcmd = qw(tar -x -f -
                        --no-same-owner --no-same-permissions
                        --no-acls --no-xattrs --no-selinux);
        my $tar_pid = fork // die $!;
        if (!$tar_pid) {

-           chdir "../unpack-tar" or die $!;
+           chdir "_unpack-tar" or die $!;

            open STDIN, "<&", $input or die $!;
            exec @tarcmd;
            die "dgit (child): exec $tarcmd[0]: $!";
            open STDIN, "<&", $input or die $!;
            exec @tarcmd;
            die "dgit (child): exec $tarcmd[0]: $!";


@@ -2141,11 +2145,21 @@ sub generate_commits_from_dsc () {
        # 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
 

-       runcmd qw(chmod -R +rwX ../unpack-tar);
-       changedir "../unpack-tar";
-       my ($tree) = mktree_in_ud_from_only_subdir(1);
-       changedir "../../unpack";
-       rmtree "../unpack-tar";
+       runcmd qw(chmod -R +rwX _unpack-tar);
+       changedir "_unpack-tar";
+       remove_stray_gits($f);
+       mktree_in_ud_here();
+       
+       my ($tree) = git_add_write_tree();
+       my $tentries = cmdoutput @git, qw(ls-tree -z), $tree;
+       if ($tentries =~ m/^\d+ tree (\w+)\t[^\000]+\000$/s) {
+           $tree = $1;
+           printdebug "one subtree $1\n";
+       } else {
+           printdebug "multiple subtrees\n";
+       }
+       changedir "..";
+       rmtree "_unpack-tar";

 
        my $ent = [ $f, $tree ];
        push @tartrees, {
 
        my $ent = [ $f, $tree ];
        push @tartrees, {


@@ -2184,7 +2198,7 @@ sub generate_commits_from_dsc () {
     push @cmd, qw(-x --), $dscfn;
     runcmd @cmd;
 
     push @cmd, qw(-x --), $dscfn;
     runcmd @cmd;
 

-    my ($tree,$dir) = mktree_in_ud_from_only_subdir();
+    my ($tree,$dir) = mktree_in_ud_from_only_subdir("source package");

     if (madformat $dsc->{format}) { 
        check_for_vendor_patches();
     }
     if (madformat $dsc->{format}) { 
        check_for_vendor_patches();
     }


@@ -2194,8 +2208,7 @@ sub generate_commits_from_dsc () {
        my @pcmd = qw(dpkg-source --before-build .);
        runcmd shell_cmd 'exec >/dev/null', @pcmd;
        rmtree '.pc';
        my @pcmd = qw(dpkg-source --before-build .);
        runcmd shell_cmd 'exec >/dev/null', @pcmd;
        rmtree '.pc';

-       runcmd @git, qw(add -Af);
-       $dappliedtree = git_write_tree();
+       $dappliedtree = git_add_write_tree();

     }
 
     my @clogcmd = qw(dpkg-parsechangelog --format rfc822 --all);
     }
 
     my @clogcmd = qw(dpkg-parsechangelog --format rfc822 --all);


@@ -2340,6 +2353,8 @@ END
        my $path = $ENV{PATH} or die;
 
        foreach my $use_absurd (qw(0 1)) {
        my $path = $ENV{PATH} or die;
 
        foreach my $use_absurd (qw(0 1)) {

+           runcmd @git, qw(checkout -q unpa);
+           runcmd @git, qw(update-ref -d refs/heads/patch-queue/unpa);

            local $ENV{PATH} = $path;
            if ($use_absurd) {
                chomp $@;
            local $ENV{PATH} = $path;
            if ($use_absurd) {
                chomp $@;


@@ -2356,11 +2371,12 @@ END
                die "only absurd git-apply!\n" if !$use_absurd
                    && forceing [qw(import-gitapply-absurd)];
 
                die "only absurd git-apply!\n" if !$use_absurd
                    && forceing [qw(import-gitapply-absurd)];
 

-               local $ENV{PATH} = $path if $use_absurd;
+               local $ENV{DGIT_ABSURD_DEBUG} = $debuglevel if $use_absurd;
+               local $ENV{PATH} = $path                    if $use_absurd;

 
                my @showcmd = (gbp_pq, qw(import));
                my @realcmd = shell_cmd
 
                my @showcmd = (gbp_pq, qw(import));
                my @realcmd = shell_cmd

-                   'exec >/dev/null 2>../../gbp-pq-output', @showcmd;
+                   'exec >/dev/null 2>>../../gbp-pq-output', @showcmd;

                debugcmd "+",@realcmd;
                if (system @realcmd) {
                    die +(shellquote @showcmd).
                debugcmd "+",@realcmd;
                if (system @realcmd) {
                    die +(shellquote @showcmd).


@@ -2472,18 +2488,34 @@ sub ensure_we_have_orig () {
     }
 }
 
     }
 }
 

-sub git_fetch_us () {
-    # Want to fetch only what we are going to use, unless
-    # deliberately-not-ff, in which case we must fetch everything.
+#---------- git fetch ----------

 
 

-    my @specs = deliberately_not_fast_forward ? qw(tags/*) :
-       map { "tags/$_" }
-       (quiltmode_splitbrain
-        ? (map { $_->('*',access_nomdistro) }
-           \&debiantag_new, \&debiantag_maintview)
-        : debiantags('*',access_nomdistro));
-    push @specs, server_branch($csuite);
-    push @specs, qw(heads/*) if deliberately_not_fast_forward;
+sub lrfetchrefs () { return "refs/dgit-fetch/".access_basedistro(); }
+sub lrfetchref () { return lrfetchrefs.'/'.server_branch($csuite); }
+
+# We fetch some parts of lrfetchrefs/*.  Ideally we delete these
+# locally fetched refs because they have unhelpful names and clutter
+# up gitk etc.  So we track whether we have "used up" head ref (ie,
+# whether we have made another local ref which refers to this object).
+#
+# (If we deleted them unconditionally, then we might end up
+# re-fetching the same git objects each time dgit fetch was run.)
+#
+# So, leach use of lrfetchrefs needs to be accompanied by arrangements
+# in git_fetch_us to fetch the refs in question, and possibly a call
+# to lrfetchref_used.
+
+our (%lrfetchrefs_f, %lrfetchrefs_d);
+# $lrfetchrefs_X{lrfetchrefs."/heads/whatever"} = $objid
+
+sub lrfetchref_used ($) {
+    my ($fullrefname) = @_;
+    my $objid = $lrfetchrefs_f{$fullrefname};
+    $lrfetchrefs_d{$fullrefname} = $objid if defined $objid;
+}
+
+sub git_lrfetch_sane {
+    my (@specs) = @_;

 
     # This is rather miserable:
     # When git fetch --prune is passed a fetchspec ending with a *,
 
     # This is rather miserable:
     # When git fetch --prune is passed a fetchspec ending with a *,


@@ -2507,7 +2539,7 @@ sub git_fetch_us () {
     # git fetch to try to generate it.  If we don't manage to generate
     # the target state, we try again.
 
     # git fetch to try to generate it.  If we don't manage to generate
     # the target state, we try again.
 

-    printdebug "git_fetch_us specs @specs\n";
+    printdebug "git_lrfetch_sane specs @specs\n";

 
     my $specre = join '|', map {
        my $x = $_;
 
     my $specre = join '|', map {
        my $x = $_;


@@ -2515,7 +2547,7 @@ sub git_fetch_us () {
        $x =~ s/\\\*$/.*/;
        "(?:refs/$x)";
     } @specs;
        $x =~ s/\\\*$/.*/;
        "(?:refs/$x)";
     } @specs;

-    printdebug "git_fetch_us specre=$specre\n";
+    printdebug "git_lrfetch_sane specre=$specre\n";

     my $wanted_rref = sub {
        local ($_) = @_;
        return m/^(?:$specre)$/o;
     my $wanted_rref = sub {
        local ($_) = @_;
        return m/^(?:$specre)$/o;


@@ -2524,7 +2556,7 @@ sub git_fetch_us () {
     my $fetch_iteration = 0;
     FETCH_ITERATION:
     for (;;) {
     my $fetch_iteration = 0;
     FETCH_ITERATION:
     for (;;) {

-       printdebug "git_fetch_us iteration $fetch_iteration\n";
+       printdebug "git_lrfetch_sane iteration $fetch_iteration\n";

         if (++$fetch_iteration > 10) {
            fail "too many iterations trying to get sane fetch!";
        }
         if (++$fetch_iteration > 10) {
            fail "too many iterations trying to get sane fetch!";
        }


@@ -2556,7 +2588,7 @@ END
            "+refs/$_:".lrfetchrefs."/$_";
        } @specs;
 
            "+refs/$_:".lrfetchrefs."/$_";
        } @specs;
 

-       printdebug "git_fetch_us fspecs @fspecs\n";
+       printdebug "git_lrfetch_sane fspecs @fspecs\n";

 
        my @fcmd = (@git, qw(fetch -p -n -q), access_giturl(), @fspecs);
        runcmd_ordryrun_local @git, qw(fetch -p -n -q), access_giturl(),
 
        my @fcmd = (@git, qw(fetch -p -n -q), access_giturl(), @fspecs);
        runcmd_ordryrun_local @git, qw(fetch -p -n -q), access_giturl(),


@@ -2612,8 +2644,25 @@ END
        }
        last;
     }
        }
        last;
     }

-    printdebug "git_fetch_us: git fetch --no-insane emulation complete\n",
+    printdebug "git_lrfetch_sane: git fetch --no-insane emulation complete\n",

        Dumper(\%lrfetchrefs_f);
        Dumper(\%lrfetchrefs_f);

+}
+
+sub git_fetch_us () {
+    # Want to fetch only what we are going to use, unless
+    # deliberately-not-ff, in which case we must fetch everything.
+
+    my @specs = deliberately_not_fast_forward ? qw(tags/*) :
+       map { "tags/$_" }
+       (quiltmode_splitbrain
+        ? (map { $_->('*',access_nomdistro) }
+           \&debiantag_new, \&debiantag_maintview)
+        : debiantags('*',access_nomdistro));
+    push @specs, server_branch($csuite);
+    push @specs, $rewritemap;
+    push @specs, qw(heads/*) if deliberately_not_fast_forward;
+
+    git_lrfetch_sane @specs;

 
     my %here;
     my @tagpats = debiantags('*',access_nomdistro);
 
     my %here;
     my @tagpats = debiantags('*',access_nomdistro);


@@ -2640,6 +2689,8 @@ END
     });
 }
 
     });
 }
 

+#---------- dsc and archive handling ----------
+

 sub mergeinfo_getclogp ($) {
     # Ensures thit $mi->{Clogp} exists and returns it
     my ($mi) = @_;
 sub mergeinfo_getclogp ($) {
     # Ensures thit $mi->{Clogp} exists and returns it
     my ($mi) = @_;


@@ -2668,6 +2719,49 @@ sub fetch_from_archive_record_2 ($) {
     }
 }
 
     }
 }
 

+sub parse_dsc_field ($$) {
+    my ($dsc, $what) = @_;
+    my $f;
+    foreach my $field (@ourdscfield) {
+       $f = $dsc->{$field};
+       last if defined $f;
+    }
+    if (!defined $f) {
+       progress "$what: NO git hash";
+    } elsif (($dsc_hash, $dsc_distro, $dsc_hint_tag, $dsc_hint_url)
+            = $f =~ m/^(\w+) ($distro_re) ($versiontag_re) (\S+)(?:\s|$)/) {
+       progress "$what: specified git info ($dsc_distro)";
+       $dsc_hint_tag = [ $dsc_hint_tag ];
+    } elsif ($f =~ m/^\w+\s*$/) {
+       $dsc_hash = $&;
+       $dsc_distro //= 'debian';
+       $dsc_hint_tag = [ debiantags +(getfield $dsc, 'Version'),
+                         $dsc_distro ];
+       progress "$what: specified git hash";
+    } else {
+       fail "$what: invalid Dgit info";
+    }
+}
+
+sub resolve_dsc_field_commit ($$) {
+    my ($already_distro, $already_mapref) = @_;
+
+    return unless defined $dsc_hash;
+
+    my $rewritemapdata = git_cat_file $already_mapref.':map';
+    if (defined $rewritemapdata
+       && $rewritemapdata =~ m/^$dsc_hash(?:[ \t](\w+))/m) {
+       progress "server's git history rewrite map contains a relevant entry!";
+
+       $dsc_hash = $1;
+       if (defined $dsc_hash) {
+           progress "using rewritten git hash in place of .dsc value";
+       } else {
+           progress "server data says .dsc hash is to be disregarded";
+       }
+    }
+}
+

 sub fetch_from_archive () {
     ensure_setup_existing_tree();
 
 sub fetch_from_archive () {
     ensure_setup_existing_tree();
 


@@ -2679,17 +2773,9 @@ sub fetch_from_archive () {
     get_archive_dsc();
 
     if ($dsc) {
     get_archive_dsc();
 
     if ($dsc) {

-       foreach my $field (@ourdscfield) {
-           $dsc_hash = $dsc->{$field};
-           last if defined $dsc_hash;
-       }
-       if (defined $dsc_hash) {
-           $dsc_hash =~ m/\w+/ or fail "invalid hash in .dsc \`$dsc_hash'";
-           $dsc_hash = $&;
-           progress "last upload to archive specified git hash";
-       } else {
-           progress "last upload to archive has NO git hash";
-       }
+       parse_dsc_field($dsc, 'last upload to archive');
+       resolve_dsc_field_commit access_basedistro,
+           lrfetchrefs."/".$rewritemap

     } else {
        progress "no version available from the archive";
     }
     } else {
        progress "no version available from the archive";
     }


@@ -3244,7 +3330,7 @@ sub clone_finish ($) {
     runcmd qw(bash -ec), <<'END';
         set -o pipefail
         git ls-tree -r --name-only -z HEAD | \
     runcmd qw(bash -ec), <<'END';
         set -o pipefail
         git ls-tree -r --name-only -z HEAD | \

-        xargs -0r touch -r . --
+        xargs -0r touch -h -r . --

 END
     printdone "ready for work in $dstdir";
 }
 END
     printdone "ready for work in $dstdir";
 }


@@ -3508,7 +3594,7 @@ tree $tree
 parent $dgitview
 parent $archive_hash
 author $authline
 parent $dgitview
 parent $archive_hash
 author $authline

-commiter $authline
+committer $authline

 
 $msg_msg
 
 
 $msg_msg
 


@@ -3649,7 +3735,21 @@ sub push_tagwants ($$$$) {
            TfSuffix => '-maintview',
             View => 'maint',
         };
            TfSuffix => '-maintview',
             View => 'maint',
         };

-    }
+    } elsif ($dodep14tag eq 'no' ? 0
+            : $dodep14tag eq 'want' ? access_cfg_tagformats_can_splitbrain
+            : $dodep14tag eq 'always'
+            ? (access_cfg_tagformats_can_splitbrain or fail <<END)
+--dep14tag-always (or equivalent in config) means server must support
+ both "new" and "maint" tag formats, but config says it doesn't.
+END
+           : die "$dodep14tag ?") {
+       push @tagwants, {
+           TagFn => \&debiantag_maintview,
+           Objid => $dgithead,
+           TfSuffix => '-dgit',
+           View => 'dgit',
+        };
+    };

     foreach my $tw (@tagwants) {
        $tw->{Tag} = $tw->{TagFn}($cversion, access_nomdistro);
        $tw->{Tfn} = sub { $tfbase.$tw->{TfSuffix}.$_[0]; };
     foreach my $tw (@tagwants) {
        $tw->{Tag} = $tw->{TagFn}($cversion, access_nomdistro);
        $tw->{Tfn} = sub { $tfbase.$tw->{TfSuffix}.$_[0]; };


@@ -3665,7 +3765,11 @@ sub push_mktags ($$ $$ $) {
 
     die unless $tagwants->[0]{View} eq 'dgit';
 
 
     die unless $tagwants->[0]{View} eq 'dgit';
 

-    $dsc->{$ourdscfield[0]} = $tagwants->[0]{Objid};
+    my $declaredistro = access_nomdistro();
+    my $reader_giturl = do { local $access_forpush=0; access_giturl(); };
+    $dsc->{$ourdscfield[0]} = join " ",
+       $tagwants->[0]{Objid}, $declaredistro, $tagwants->[0]{Tag},
+       $reader_giturl;

     $dsc->save("$dscfn.tmp") or die $!;
 
     my $changes = parsecontrol($changesfile,$changesfilewhat);
     $dsc->save("$dscfn.tmp") or die $!;
 
     my $changes = parsecontrol($changesfile,$changesfilewhat);


@@ -3682,7 +3786,6 @@ sub push_mktags ($$ $$ $) {
     # to control the "tagger" (b) we can do remote signing
     my $authline = clogp_authline $clogp;
     my $delibs = join(" ", "",@deliberatelies);
     # to control the "tagger" (b) we can do remote signing
     my $authline = clogp_authline $clogp;
     my $delibs = join(" ", "",@deliberatelies);

-    my $declaredistro = access_nomdistro();

 
     my $mktag = sub {
        my ($tw) = @_;
 
     my $mktag = sub {
        my ($tw) = @_;


@@ -3796,7 +3899,7 @@ END
 
     my $dscpath = "$buildproductsdir/$dscfn";
     stat_exists $dscpath or
 
     my $dscpath = "$buildproductsdir/$dscfn";
     stat_exists $dscpath or

-       fail "looked for .dsc $dscfn, but $!;".
+       fail "looked for .dsc $dscpath, but $!;".

            " maybe you forgot to build";
 
     responder_send_file('dsc', $dscpath);
            " maybe you forgot to build";
 
     responder_send_file('dsc', $dscpath);


@@ -3863,7 +3966,7 @@ END
     progress "checking that $dscfn corresponds to HEAD";
     runcmd qw(dpkg-source -x --),
         $dscpath =~ m#^/# ? $dscpath : "../../../$dscpath";
     progress "checking that $dscfn corresponds to HEAD";
     runcmd qw(dpkg-source -x --),
         $dscpath =~ m#^/# ? $dscpath : "../../../$dscpath";

-    my ($tree,$dir) = mktree_in_ud_from_only_subdir();
+    my ($tree,$dir) = mktree_in_ud_from_only_subdir("source package");

     check_for_vendor_patches() if madformat($dsc->{format});
     changedir '../../../..';
     my @diffcmd = (@git, qw(diff --quiet), $tree, $dgithead);
     check_for_vendor_patches() if madformat($dsc->{format});
     changedir '../../../..';
     my @diffcmd = (@git, qw(diff --quiet), $tree, $dgithead);


@@ -3979,8 +4082,12 @@ END
     runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), $dgithead;
 
     supplementary_message(<<'END');
     runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), $dgithead;
 
     supplementary_message(<<'END');

-Push failed, after updating the remote git repository.
-If you want to try again, you must use a new version number.
+Push failed, while obtaining signatures on the .changes and .dsc.
+If it was just that the signature failed, you may try again by using
+debsign by hand to sign the changes
+   $changesfile
+and then dput to complete the upload.
+If you need to change the package, you must use a new version number.

 END
     if ($we_are_responder) {
        my $dryrunsuffix = act_local() ? "" : ".tmp";
 END
     if ($we_are_responder) {
        my $dryrunsuffix = act_local() ? "" : ".tmp";


@@ -4014,7 +4121,6 @@ END
 
 sub cmd_clone {
     parseopts();
 
 sub cmd_clone {
     parseopts();

-    notpushing();

     my $dstdir;
     badusage "-p is not allowed with clone; specify as argument instead"
        if defined $package;
     my $dstdir;
     badusage "-p is not allowed with clone; specify as argument instead"
        if defined $package;


@@ -4029,8 +4135,9 @@ sub cmd_clone {
     } else {
        badusage "incorrect arguments to dgit clone";
     }
     } else {
        badusage "incorrect arguments to dgit clone";
     }

-    $dstdir ||= "$package";
+    notpushing();

 
 

+    $dstdir ||= "$package";

     if (stat_exists $dstdir) {
        fail "$dstdir already exists";
     }
     if (stat_exists $dstdir) {
        fail "$dstdir already exists";
     }


@@ -4069,7 +4176,6 @@ sub branchsuite () {
 }
 
 sub fetchpullargs () {
 }
 
 sub fetchpullargs () {

-    notpushing();

     if (!defined $package) {
        my $sourcep = parsecontrol('debian/control','debian/control');
        $package = getfield $sourcep, 'Source';
     if (!defined $package) {
        my $sourcep = parsecontrol('debian/control','debian/control');
        $package = getfield $sourcep, 'Source';


@@ -4085,6 +4191,7 @@ sub fetchpullargs () {
     } else {
        badusage "incorrect arguments to dgit fetch or dgit pull";
     }
     } else {
        badusage "incorrect arguments to dgit fetch or dgit pull";
     }

+    notpushing();

 }
 
 sub cmd_fetch {
 }
 
 sub cmd_fetch {


@@ -4414,7 +4521,7 @@ END
        local $ENV{'EDITOR'} = cmdoutput qw(realpath --), $0;
        local $ENV{'VISUAL'} = $ENV{'EDITOR'};
        local $ENV{$fakeeditorenv} = cmdoutput qw(realpath --), $descfn;
        local $ENV{'EDITOR'} = cmdoutput qw(realpath --), $0;
        local $ENV{'VISUAL'} = $ENV{'EDITOR'};
        local $ENV{$fakeeditorenv} = cmdoutput qw(realpath --), $descfn;

-       runcmd @dpkgsource, qw(--commit .), $patchname;
+       runcmd @dpkgsource, qw(--commit --include-removal .), $patchname;

     }
 }
 
     }
 }
 


@@ -4449,17 +4556,21 @@ sub quiltify_trees_differ ($$;$$$) {
 
        if ($unrepres) {
            eval {
 
        if ($unrepres) {
            eval {

-               die "deleted\n" unless $newmode =~ m/[^0]/;
-               die "not a plain file\n" unless $newmode =~ m/^10\d{4}$/;
-               if ($oldmode =~ m/[^0]/) {
+               die "not a plain file\n"
+                   unless $newmode =~ m/^10\d{4}$/ ||
+                          $oldmode =~ m/^10\d{4}$/;
+               if ($oldmode =~ m/[^0]/ &&
+                   $newmode =~ m/[^0]/) {

                    die "mode changed\n" if $oldmode ne $newmode;
                } else {
                    die "mode changed\n" if $oldmode ne $newmode;
                } else {

-                   die "non-default mode\n" unless $newmode =~ m/^100644$/;
+                   die "non-default mode\n"
+                       unless $newmode =~ m/^100644$/ ||
+                              $oldmode =~ m/^100644$/;

                }
            };
            if ($@) {
                local $/="\n"; chomp $@;
                }
            };
            if ($@) {
                local $/="\n"; chomp $@;

-               push @$unrepres, [ $f, $@ ];
+               push @$unrepres, [ $f, "$@ ($oldmode->$newmode)" ];

            }
        }
 
            }
        }
 


@@ -4892,13 +5003,10 @@ sub build_maybe_quilt_fixup () {
     check_for_vendor_patches();
 
     if (quiltmode_splitbrain) {
     check_for_vendor_patches();
 
     if (quiltmode_splitbrain) {

-       foreach my $needtf (qw(new maint)) {
-           next if grep { $_ eq $needtf } access_cfg_tagformats;
-           fail <<END
+       fail <<END unless access_cfg_tagformats_can_splitbrain;

 quilt mode $quilt_mode requires split view so server needs to support
  both "new" and "maint" tag formats, but config says it doesn't.
 END
 quilt mode $quilt_mode requires split view so server needs to support
  both "new" and "maint" tag formats, but config says it doesn't.
 END

-       }

     }
 
     my $clogp = parsechangelog();
     }
 
     my $clogp = parsechangelog();


@@ -5187,13 +5295,12 @@ sub quilt_fixup_multipatch ($$$) {
 
     changedir 'fake';
 
 
     changedir 'fake';
 

-    remove_stray_gits();
+    remove_stray_gits("source package");

     mktree_in_ud_here();
 
     rmtree '.pc';
 
     mktree_in_ud_here();
 
     rmtree '.pc';
 

-    runcmd @git, qw(add -Af .);
-    my $unapplied=git_write_tree();
+    my $unapplied=git_add_write_tree();

     printdebug "fake orig tree object $unapplied\n";
 
     ensuredir '.pc';
     printdebug "fake orig tree object $unapplied\n";
 
     ensuredir '.pc';


@@ -5225,8 +5332,7 @@ END
 
     changedir '../fake';
     rmtree '.pc';
 
     changedir '../fake';
     rmtree '.pc';

-    runcmd @git, qw(add -Af .);
-    my $oldtiptree=git_write_tree();
+    my $oldtiptree=git_add_write_tree();

     printdebug "fake o+d/p tree object $unapplied\n";
     changedir '../work';
 
     printdebug "fake o+d/p tree object $unapplied\n";
     changedir '../work';
 


@@ -5576,6 +5682,7 @@ sub postbuild_mergechanges_vanilla ($) {
 }
 
 sub cmd_build {
 }
 
 sub cmd_build {

+    build_prep_early();

     my @dbp = (@dpkgbuildpackage, qw(-us -uc), changesopts_initial(), @ARGV);
     my $wantsrc = massage_dbp_args \@dbp;
     if ($wantsrc > 0) {
     my @dbp = (@dpkgbuildpackage, qw(-us -uc), changesopts_initial(), @ARGV);
     my $wantsrc = massage_dbp_args \@dbp;
     if ($wantsrc > 0) {


@@ -5668,6 +5775,7 @@ sub cmd_gbp_build {
 sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0
 
 sub build_source {
 sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0
 
 sub build_source {

+    build_prep_early();

     my $our_cleanmode = $cleanmode;
     if ($need_split_build_invocation) {
        # Pretend that clean is being done some other way.  This
     my $our_cleanmode = $cleanmode;
     if ($need_split_build_invocation) {
        # Pretend that clean is being done some other way.  This


@@ -5728,6 +5836,7 @@ sub build_source {
 }
 
 sub cmd_build_source {
 }
 
 sub cmd_build_source {

+    build_prep_early();

     badusage "build-source takes no additional arguments" if @ARGV;
     build_source();
     maybe_unapply_patches_again();
     badusage "build-source takes no additional arguments" if @ARGV;
     build_source();
     maybe_unapply_patches_again();


@@ -5756,10 +5865,7 @@ END
 
 sub cmd_quilt_fixup {
     badusage "incorrect arguments to dgit quilt-fixup" if @ARGV;
 
 sub cmd_quilt_fixup {
     badusage "incorrect arguments to dgit quilt-fixup" if @ARGV;

-    my $clogp = parsechangelog();
-    $version = getfield $clogp, 'Version';
-    $package = getfield $clogp, 'Source';
-    check_not_dirty();
+    build_prep_early();

     clean_tree();
     build_maybe_quilt_fixup();
 }
     clean_tree();
     build_maybe_quilt_fixup();
 }


@@ -5827,30 +5933,30 @@ sub cmd_import_dsc {
 
     parse_dscdata();
 
 
     parse_dscdata();
 

-    my $dgit_commit = $dsc->{$ourdscfield[0]};
-    if (defined $dgit_commit && 
-       !forceing [qw(import-dsc-with-dgit-field)]) {
-       $dgit_commit =~ m/\w+/ or fail "invalid hash in .dsc";
+    parse_dsc_field($dsc, "Dgit metadata in .dsc");
+
+    if (defined $dsc_hash
+       && !forceing [qw(import-dsc-with-dgit-field)]) {

        progress "dgit: import-dsc of .dsc with Dgit field, using git hash";
        my @cmd = (qw(sh -ec),
        progress "dgit: import-dsc of .dsc with Dgit field, using git hash";
        my @cmd = (qw(sh -ec),

-                  "echo $dgit_commit | git cat-file --batch-check");
+                  "echo $dsc_hash | git cat-file --batch-check");

        my $objgot = cmdoutput @cmd;
        if ($objgot =~ m#^\w+ missing\b#) {
            fail <<END
        my $objgot = cmdoutput @cmd;
        if ($objgot =~ m#^\w+ missing\b#) {
            fail <<END

-.dsc contains Dgit field referring to object $dgit_commit
+.dsc contains Dgit field referring to object $dsc_hash

 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.
 END
        }
 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.
 END
        }

-       if ($oldhash && !is_fast_fwd $oldhash, $dgit_commit) {
+       if ($oldhash && !is_fast_fwd $oldhash, $dsc_hash) {

            if ($force > 0) {
                progress "Not fast forward, forced update.";
            } else {
            if ($force > 0) {
                progress "Not fast forward, forced update.";
            } else {

-               fail "Not fast forward to $dgit_commit";
+               fail "Not fast forward to $dsc_hash";

            }
        }
        @cmd = (@git, qw(update-ref -m), "dgit import-dsc (Dgit): $info",
            }
        }
        @cmd = (@git, qw(update-ref -m), "dgit import-dsc (Dgit): $info",

-               $dstbranch, $dgit_commit);
+               $dstbranch, $dsc_hash);

        runcmd @cmd;
        progress "dgit: import-dsc updated git ref $dstbranch";
        return 0;
        runcmd @cmd;
        progress "dgit: import-dsc updated git ref $dstbranch";
        return 0;


@@ -5883,7 +5989,7 @@ END
        $there .= "/$f";
        symlink $there, $here or fail "symlink $there to $here: $!";
        progress "made symlink $here -> $there";
        $there .= "/$f";
        symlink $there, $here or fail "symlink $there to $here: $!";
        progress "made symlink $here -> $there";

-       print STDERR Dumper($fi);
+#      print STDERR Dumper($fi);

     }
     my @mergeinputs = generate_commits_from_dsc();
     die unless @mergeinputs == 1;
     }
     my @mergeinputs = generate_commits_from_dsc();
     die unless @mergeinputs == 1;


@@ -5897,10 +6003,14 @@ END
            progress "Import, merging.";
            my $tree = cmdoutput @git, qw(rev-parse), "$newhash:";
            my $version = getfield $dsc, 'Version';
            progress "Import, merging.";
            my $tree = cmdoutput @git, qw(rev-parse), "$newhash:";
            my $version = getfield $dsc, 'Version';

+           my $clogp = commit_getclogp $newhash;
+           my $authline = clogp_authline $clogp;

            $newhash = make_commit_text <<END;
 tree $tree
 parent $newhash
 parent $oldhash
            $newhash = make_commit_text <<END;
 tree $tree
 parent $newhash
 parent $oldhash

+author $authline
+committer $authline

 
 Merge $package ($version) import into $dstbranch
 END
 
 Merge $package ($version) import into $dstbranch
 END


@@ -6071,6 +6181,15 @@ sub parseopts () {
            } elsif (m/^--overwrite=(.+)$/s) {
                push @ropts, $_;
                $overwrite_version = $1;
            } elsif (m/^--overwrite=(.+)$/s) {
                push @ropts, $_;
                $overwrite_version = $1;

+           } elsif (m/^--dep14tag$/s) {
+               push @ropts, $_;
+               $dodep14tag= 'want';
+           } elsif (m/^--no-dep14tag$/s) {
+               push @ropts, $_;
+               $dodep14tag= 'no';
+           } elsif (m/^--always-dep14tag$/s) {
+               push @ropts, $_;
+               $dodep14tag= 'always';

            } elsif (m/^--delayed=(\d+)$/s) {
                push @ropts, $_;
                push @dput, $_;
            } elsif (m/^--delayed=(\d+)$/s) {
                push @ropts, $_;
                push @dput, $_;


@@ -6189,7 +6308,7 @@ END
 }
 
 
 }
 
 

-sub finalise_opts_opts () {
+sub parseopts_late_defaults () {

     foreach my $k (keys %opts_opt_map) {
        my $om = $opts_opt_map{$k};
 
     foreach my $k (keys %opts_opt_map) {
        my $om = $opts_opt_map{$k};
 


@@ -6216,6 +6335,40 @@ sub finalise_opts_opts () {
                     @$om[$insertpos..$#$om] );
        }
     }
                     @$om[$insertpos..$#$om] );
        }
     }

+
+    if (!defined $rmchanges) {
+       local $access_forpush;
+       $rmchanges = access_cfg_bool(0, 'rm-old-changes');
+    }
+
+    if (!defined $quilt_mode) {
+       local $access_forpush;
+       $quilt_mode = cfg('dgit.force.quilt-mode', 'RETURN-UNDEF')
+           // access_cfg('quilt-mode', 'RETURN-UNDEF')
+           // 'linear';
+       $quilt_mode =~ m/^($quilt_modes_re)$/ 
+           or badcfg "unknown quilt-mode \`$quilt_mode'";
+       $quilt_mode = $1;
+    }
+
+    if (!defined $dodep14tag) {
+       local $access_forpush;
+       $dodep14tag = access_cfg('dep14tag', 'RETURN-UNDEF') // 'want';
+       $dodep14tag =~ m/^($dodep14tag_re)$/ 
+           or badcfg "unknown dep14tag setting \`$dodep14tag'";
+       $dodep14tag = $1;
+    }
+
+    $need_split_build_invocation ||= quiltmode_splitbrain();
+
+    if (!defined $cleanmode) {
+       local $access_forpush;
+       $cleanmode = access_cfg('clean-mode', 'RETURN-UNDEF');
+       $cleanmode //= 'dpkg-source';
+
+       badcfg "unknown clean-mode \`$cleanmode'" unless
+           $cleanmode =~ m/^($cleanmode_re)$(?!\n)/s;
+    }

 }
 
 if ($ENV{$fakeeditorenv}) {
 }
 
 if ($ENV{$fakeeditorenv}) {


@@ -6240,32 +6393,6 @@ $cmd =~ y/-/_/;
 my $pre_fn = ${*::}{"pre_$cmd"};
 $pre_fn->() if $pre_fn;
 
 my $pre_fn = ${*::}{"pre_$cmd"};
 $pre_fn->() if $pre_fn;
 

-if (!defined $rmchanges) {
-    local $access_forpush;
-    $rmchanges = access_cfg_bool(0, 'rm-old-changes');
-}
-
-if (!defined $quilt_mode) {
-    local $access_forpush;
-    $quilt_mode = cfg('dgit.force.quilt-mode', 'RETURN-UNDEF')
-       // access_cfg('quilt-mode', 'RETURN-UNDEF')
-       // 'linear';
-    $quilt_mode =~ m/^($quilt_modes_re)$/ 
-       or badcfg "unknown quilt-mode \`$quilt_mode'";
-    $quilt_mode = $1;
-}
-
-$need_split_build_invocation ||= quiltmode_splitbrain();
-
-if (!defined $cleanmode) {
-    local $access_forpush;
-    $cleanmode = access_cfg('clean-mode', 'RETURN-UNDEF');
-    $cleanmode //= 'dpkg-source';
-
-    badcfg "unknown clean-mode \`$cleanmode'" unless
-       $cleanmode =~ m/^($cleanmode_re)$(?!\n)/s;
-}
-

 my $fn = ${*::}{"cmd_$cmd"};
 $fn or badusage "unknown operation $cmd";
 $fn->();
 my $fn = ${*::}{"cmd_$cmd"};
 $fn or badusage "unknown operation $cmd";
 $fn->();