chiark / gitweb /
dgit: Remove redundant use of List::Util qw(any). Closes:#851280.
[dgit.git] / dgit
diff --git a/dgit b/dgit
index 9d3584fb7e0abd96b420e70a3f24def0b78ee20e..fbf844e08370225f191f4bdc3a63ce602c80d703 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -34,7 +34,6 @@ use POSIX;
 use IPC::Open2;
 use Digest::SHA;
 use Digest::MD5;
 use IPC::Open2;
 use Digest::SHA;
 use Digest::MD5;
-use List::Util qw(any);
 use List::MoreUtils qw(pairwise);
 use Text::Glob qw(match_glob);
 use Fcntl qw(:DEFAULT :flock);
 use List::MoreUtils qw(pairwise);
 use Text::Glob qw(match_glob);
 use Fcntl qw(:DEFAULT :flock);
@@ -48,7 +47,7 @@ our $absurdity = undef; ###substituted###
 our @rpushprotovsn_support = qw(4 3 2); # 4 is new tag format
 our $protovsn;
 
 our @rpushprotovsn_support = qw(4 3 2); # 4 is new tag format
 our $protovsn;
 
-our $isuite = 'unstable';
+our $isuite;
 our $idistro;
 our $package;
 our @ropts;
 our $idistro;
 our $package;
 our @ropts;
@@ -70,14 +69,15 @@ 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 $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 $split_brain_save;
 our $we_are_responder;
+our $we_are_initiator;
 our $initiator_tempdir;
 our $patches_applied_dirtily = 00;
 our $tagformat_want;
 our $tagformat;
 our $tagformatfn;
 our $initiator_tempdir;
 our $patches_applied_dirtily = 00;
 our $tagformat_want;
 our $tagformat;
 our $tagformatfn;
+our $chase_dsc_distro=1;
 
 our %forceopts = map { $_=>0 }
     qw(unrepresentable unsupported-source-format
 
 our %forceopts = map { $_=>0 }
     qw(unrepresentable unsupported-source-format
@@ -96,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);
@@ -141,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;
 
@@ -153,6 +154,7 @@ our $split_brain = 0;
 
 END {
     local ($@, $?);
 
 END {
     local ($@, $?);
+    return unless forkcheck_mainprocess();
     print STDERR "! $_\n" foreach $supplementary_message =~ m/^.+$/mg;
 }
 
     print STDERR "! $_\n" foreach $supplementary_message =~ m/^.+$/mg;
 }
 
@@ -184,30 +186,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+\://;
@@ -241,6 +219,7 @@ initdebug('');
 our @end;
 END { 
     local ($?);
 our @end;
 END { 
     local ($?);
+    return unless forkcheck_mainprocess();
     foreach my $f (@end) {
        eval { $f->(); };
        print STDERR "$us: cleanup: $@" if length $@;
     foreach my $f (@end) {
        eval { $f->(); };
        print STDERR "$us: cleanup: $@" if length $@;
@@ -587,6 +566,8 @@ sub cmd_help () {
 our $td = $ENV{DGIT_TEST_DUMMY_DIR} || "DGIT_TEST_DUMMY_DIR-unset";
 
 our %defcfg = ('dgit.default.distro' => 'debian',
 our $td = $ENV{DGIT_TEST_DUMMY_DIR} || "DGIT_TEST_DUMMY_DIR-unset";
 
 our %defcfg = ('dgit.default.distro' => 'debian',
+              'dgit.default.default-suite' => 'unstable',
+              'dgit.default.old-dsc-distro' => 'debian',
               'dgit-suite.*-security.distro' => 'debian-security',
               'dgit.default.username' => '',
               'dgit.default.archive-query-default-component' => 'main',
               'dgit-suite.*-security.distro' => 'debian-security',
               'dgit.default.username' => '',
               'dgit.default.archive-query-default-component' => 'main',
@@ -595,6 +576,10 @@ our %defcfg = ('dgit.default.distro' => 'debian',
               'dgit.default.sshpsql-dbname' => 'service=projectb',
               'dgit.default.aptget-components' => 'main',
               'dgit.default.dgit-tag-format' => 'new,old,maint',
               'dgit.default.sshpsql-dbname' => 'service=projectb',
               'dgit.default.aptget-components' => 'main',
               'dgit.default.dgit-tag-format' => 'new,old,maint',
+              'dgit.dsc-url-proto-ok.http'    => 'true',
+              'dgit.dsc-url-proto-ok.https'   => 'true',
+              'dgit.dsc-url-proto-ok.git'     => 'true',
+              'dgit.default.dsc-url-proto-ok' => 'false',
               # old means "repo server accepts pushes with old dgit tags"
               # new means "repo server accepts pushes with new dgit tags"
               # maint means "repo server accepts split brain pushes"
               # old means "repo server accepts pushes with old dgit tags"
               # new means "repo server accepts pushes with new dgit tags"
               # maint means "repo server accepts split brain pushes"
@@ -682,7 +667,10 @@ 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"
+       croak "$l $c" if $l && !ref $l;
+       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".
@@ -695,16 +683,20 @@ sub git_get_config ($) {
 sub cfg {
     foreach my $c (@_) {
        return undef if $c =~ /RETURN-UNDEF/;
 sub cfg {
     foreach my $c (@_) {
        return undef if $c =~ /RETURN-UNDEF/;
+       printdebug "C? $c\n" if $debuglevel >= 5;
        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";
 }
 
-sub access_basedistro () {
+sub access_basedistro__noalias () {
     if (defined $idistro) {
        return $idistro;
     } else {   
     if (defined $idistro) {
        return $idistro;
     } else {   
@@ -724,9 +716,18 @@ sub access_basedistro () {
     }
 }
 
     }
 }
 
+sub access_basedistro () {
+    my $noalias = access_basedistro__noalias();
+    my $canon = cfg("dgit-distro.$noalias.alias-canon",'RETURN-UNDEF');
+    return $canon // $noalias;
+}
+
 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 () {
@@ -790,11 +791,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 ($) {
@@ -1679,6 +1680,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';
 
@@ -2068,23 +2070,44 @@ sub generate_commits_from_dsc () {
     foreach my $fi (@dfi) {
        my $f = $fi->{Filename};
        die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#;
     foreach my $fi (@dfi) {
        my $f = $fi->{Filename};
        die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#;
+       my $upper_f = "../../../../$f";
+
+       printdebug "considering reusing $f: ";
+
+       if (link_ltarget "$upper_f,fetch", $f) {
+           printdebug "linked (using ...,fetch).\n";
+       } elsif ((printdebug "($!) "),
+                $! != ENOENT) {
+           fail "accessing ../$f,fetch: $!";
+       } elsif (link_ltarget $upper_f, $f) {
+           printdebug "linked.\n";
+       } elsif ((printdebug "($!) "),
+                $! != ENOENT) {
+           fail "accessing ../$f: $!";
+       } else {
+           printdebug "absent.\n";
+       }
 
 
-       printdebug "considering linking $f: ";
-
-       link_ltarget "../../../../$f", $f
-           or ((printdebug "($!) "), 0)
-           or $!==&ENOENT
-           or die "$f $!";
-
-       printdebug "linked.\n";
-
-       complete_file_from_dsc('.', $fi)
+       my $refetched;
+       complete_file_from_dsc('.', $fi, \$refetched)
            or next;
 
            or next;
 
-       if (is_orig_file_in_dsc($f, \@dfi)) {
-           link $f, "../../../../$f"
-               or $!==&EEXIST
-               or die "$f $!";
+       printdebug "considering saving $f: ";
+
+       if (link $f, $upper_f) {
+           printdebug "linked.\n";
+       } elsif ((printdebug "($!) "),
+                $! != EEXIST) {
+           fail "saving ../$f: $!";
+       } elsif (!$refetched) {
+           printdebug "no need.\n";
+       } elsif (link $f, "$upper_f,fetch") {
+           printdebug "linked (using ...,fetch).\n";
+       } elsif ((printdebug "($!) "),
+                $! != EEXIST) {
+           fail "saving ../$f,fetch: $!";
+       } else {
+           printdebug "cannot.\n";
        }
     }
 
        }
     }
 
@@ -2455,39 +2478,56 @@ END
     return @output;
 }
 
     return @output;
 }
 
-sub complete_file_from_dsc ($$) {
-    our ($dstdir, $fi) = @_;
-    # Ensures that we have, in $dir, the file $fi, with the correct
+sub complete_file_from_dsc ($$;$) {
+    our ($dstdir, $fi, $refetched) = @_;
+    # Ensures that we have, in $dstdir, the file $fi, with the correct
     # contents.  (Downloading it from alongside $dscurl if necessary.)
     # contents.  (Downloading it from alongside $dscurl if necessary.)
+    # If $refetched is defined, can overwrite "$dstdir/$fi->{Filename}"
+    # and will set $$refetched=1 if it did so (or tried to).
 
     my $f = $fi->{Filename};
     my $tf = "$dstdir/$f";
     my $downloaded = 0;
 
 
     my $f = $fi->{Filename};
     my $tf = "$dstdir/$f";
     my $downloaded = 0;
 
+    my $got;
+    my $checkhash = sub {
+       open F, "<", "$tf" or die "$tf: $!";
+       $fi->{Digester}->reset();
+       $fi->{Digester}->addfile(*F);
+       F->error and die $!;
+       my $got = $fi->{Digester}->hexdigest();
+       return $got eq $fi->{Hash};
+    };
+
     if (stat_exists $tf) {
     if (stat_exists $tf) {
-       progress "using existing $f";
+       if ($checkhash->()) {
+           progress "using existing $f";
+           return 1;
+       }
+       if (!$refetched) {
+           fail "file $f has hash $got but .dsc".
+               " demands hash $fi->{Hash} ".
+               "(perhaps you should delete this file?)";
+       }
+       progress "need to fetch correct version of $f";
+       unlink $tf or die "$tf $!";
+       $$refetched = 1;
     } else {
        printdebug "$tf does not exist, need to fetch\n";
     } else {
        printdebug "$tf does not exist, need to fetch\n";
-       my $furl = $dscurl;
-       $furl =~ s{/[^/]+$}{};
-       $furl .= "/$f";
-       die "$f ?" unless $f =~ m/^\Q${package}\E_/;
-       die "$f ?" if $f =~ m#/#;
-       runcmd_ordryrun_local @curl,qw(-f -o),$tf,'--',"$furl";
-       return 0 if !act_local();
-       $downloaded = 1;
-    }
-
-    open F, "<", "$tf" or die "$tf: $!";
-    $fi->{Digester}->reset();
-    $fi->{Digester}->addfile(*F);
-    F->error and die $!;
-    my $got = $fi->{Digester}->hexdigest();
-    $got eq $fi->{Hash} or
+    }
+
+    my $furl = $dscurl;
+    $furl =~ s{/[^/]+$}{};
+    $furl .= "/$f";
+    die "$f ?" unless $f =~ m/^\Q${package}\E_/;
+    die "$f ?" if $f =~ m#/#;
+    runcmd_ordryrun_local @curl,qw(-f -o),$tf,'--',"$furl";
+    return 0 if !act_local();
+
+    $checkhash->() or
        fail "file $f has hash $got but .dsc".
            " demands hash $fi->{Hash} ".
        fail "file $f has hash $got but .dsc".
            " demands hash $fi->{Hash} ".
-           ($downloaded ? "(got wrong file from archive!)"
-            : "(perhaps you should delete this file?)");
+           "(got wrong file from archive!)";
 
     return 1;
 }
 
     return 1;
 }
@@ -2502,18 +2542,41 @@ 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, each 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 ($supplementary, @specs) = @_;
+    # Make a 'refs/'.lrfetchrefs.'/*' be just like on server,
+    # at least as regards @specs.  Also leave the results in
+    # %lrfetchrefs_f, and arrange for lrfetchref_used to be
+    # able to clean these up.
+    #
+    # With $supplementary==1, @specs must not contain wildcards
+    # and we add to our previous fetches (non-atomically).
 
     # 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 *,
@@ -2537,30 +2600,33 @@ 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";
+    my $url = access_giturl();
+
+    printdebug "git_lrfetch_sane suppl=$supplementary specs @specs\n";
 
     my $specre = join '|', map {
        my $x = $_;
        $x =~ s/\W/\\$&/g;
 
     my $specre = join '|', map {
        my $x = $_;
        $x =~ s/\W/\\$&/g;
-       $x =~ s/\\\*$/.*/;
+       my $wildcard = $x =~ s/\\\*$/.*/;
+       die if $wildcard && $supplementary;
        "(?:refs/$x)";
     } @specs;
        "(?:refs/$x)";
     } @specs;
-    printdebug "git_fetch_us specre=$specre\n";
+    printdebug "git_lrfetch_sane specre=$specre\n";
     my $wanted_rref = sub {
        local ($_) = @_;
     my $wanted_rref = sub {
        local ($_) = @_;
-       return m/^(?:$specre)$/o;
+       return m/^(?:$specre)$/;
     };
 
     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!";
        }
 
        my @look = map { "refs/$_" } @specs;
         if (++$fetch_iteration > 10) {
            fail "too many iterations trying to get sane fetch!";
        }
 
        my @look = map { "refs/$_" } @specs;
-       my @lcmd = (@git, qw(ls-remote -q --refs), access_giturl(), @look);
+       my @lcmd = (@git, qw(ls-remote -q --refs), $url, @look);
        debugcmd "|",@lcmd;
 
        my %wantr;
        debugcmd "|",@lcmd;
 
        my %wantr;
@@ -2586,13 +2652,14 @@ 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(),
-           @fspecs;
+       my @fcmd = (@git, qw(fetch -p -n -q), $url, @fspecs);
+       runcmd_ordryrun_local @fcmd if @fspecs;
 
 
-       %lrfetchrefs_f = ();
+       if (!$supplementary) {
+           %lrfetchrefs_f = ();
+       }
        my %objgot;
 
        git_for_each_ref(lrfetchrefs, sub {
        my %objgot;
 
        git_for_each_ref(lrfetchrefs, sub {
@@ -2601,6 +2668,10 @@ END
            $objgot{$objid} = 1;
        });
 
            $objgot{$objid} = 1;
        });
 
+       if ($supplementary) {
+           last;
+       }
+
        foreach my $lrefname (sort keys %lrfetchrefs_f) {
            my $rrefname = 'refs'.substr($lrefname, length lrfetchrefs);
            if (!exists $wantr{$rrefname}) {
        foreach my $lrefname (sort keys %lrfetchrefs_f) {
            my $rrefname = 'refs'.substr($lrefname, length lrfetchrefs);
            if (!exists $wantr{$rrefname}) {
@@ -2642,8 +2713,35 @@ END
        }
        last;
     }
        }
        last;
     }
-    printdebug "git_fetch_us: git fetch --no-insane emulation complete\n",
+
+    if (defined $csuite) {
+       printdebug "git_lrfetch_sane: tidying any old suite lrfetchrefs\n";
+       git_for_each_ref("refs/dgit-fetch/$csuite", sub {
+           my ($objid,$objtype,$lrefname,$reftail) = @_;
+           next if $lrfetchrefs_f{$lrefname}; # $csuite eq $distro ?
+           runcmd_ordryrun_local @git, qw(update-ref -d), $lrefname;
+       });
+    }
+
+    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 0, @specs;
 
     my %here;
     my @tagpats = debiantags('*',access_nomdistro);
 
     my %here;
     my @tagpats = debiantags('*',access_nomdistro);
@@ -2664,12 +2762,14 @@ END
        } elsif ($here{$lref} eq $objid) {
            lrfetchref_used $fullrefname;
        } else {
        } elsif ($here{$lref} eq $objid) {
            lrfetchref_used $fullrefname;
        } else {
-           print STDERR \
-               "Not updateting $lref from $here{$lref} to $objid.\n";
+           print STDERR
+               "Not updating $lref from $here{$lref} to $objid.\n";
        }
     });
 }
 
        }
     });
 }
 
+#---------- 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) = @_;
@@ -2698,6 +2798,132 @@ sub fetch_from_archive_record_2 ($) {
     }
 }
 
     }
 }
 
+sub parse_dsc_field_def_dsc_distro () {
+    $dsc_distro //= cfg qw(dgit.default.old-dsc-distro
+                          dgit.default.distro);
+}
+
+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";
+       parse_dsc_field_def_dsc_distro();
+    } elsif (($dsc_hash, $dsc_distro, $dsc_hint_tag, $dsc_hint_url)
+            = $f =~ m/^(\w+)\s+($distro_re)\s+($versiontag_re)\s+(\S+)(?:\s|$)/) {
+       progress "$what: specified git info ($dsc_distro)";
+       $dsc_hint_tag = [ $dsc_hint_tag ];
+    } elsif ($f =~ m/^\w+\s*$/) {
+       $dsc_hash = $&;
+       parse_dsc_field_def_dsc_distro();
+       $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 $mapref =
+       defined $already_mapref &&
+       ($already_distro eq $dsc_distro || !$chase_dsc_distro)
+       ? $already_mapref : undef;
+
+    my $do_fetch;
+    $do_fetch = sub {
+       my ($what, @fetch) = @_;
+
+       local $idistro = $dsc_distro;
+       my $lrf = lrfetchrefs;
+
+       if (!$chase_dsc_distro) {
+           progress
+               "not chasing .dsc distro $dsc_distro: not fetching $what";
+           return 0;
+       }
+
+       progress
+           ".dsc names distro $dsc_distro: fetching $what";
+
+       my $url = access_giturl();
+       if (!defined $url) {
+           defined $dsc_hint_url or fail <<END;
+.dsc Dgit metadata is in context of distro $dsc_distro
+for which we have no configured url and .dsc provides no hint
+END
+           my $proto =
+               $dsc_hint_url =~ m#^([-+0-9a-zA-Z]+):# ? $1 :
+               $dsc_hint_url =~ m#^/# ? 'file' : 'bad-syntax';
+           parse_cfg_bool "dsc-url-proto-ok", 'false',
+               cfg("dgit.dsc-url-proto-ok.$proto",
+                   "dgit.default.dsc-url-proto-ok")
+               or fail <<END;
+.dsc Dgit metadata is in context of distro $dsc_distro
+for which we have no configured url;
+.dsc provices hinted url with protocol $proto which is unsafe.
+(can be overridden by config - consult documentation)
+END
+           $url = $dsc_hint_url;
+       }
+
+       git_lrfetch_sane 1, @fetch;
+
+       return $lrf;
+    };
+
+    my $rewrite_enable = do {
+       local $idistro = $dsc_distro;
+       access_cfg('rewrite-map-enable', 'RETURN-UNDEF');
+    };
+
+    if (parse_cfg_bool 'rewrite-map-enable', 'true', $rewrite_enable) {
+       if (!defined $mapref) {
+           my $lrf = $do_fetch->("rewrite map", $rewritemap) or return;
+           $mapref = $lrf.'/'.$rewritemap;
+       }
+       my $rewritemapdata = git_cat_file $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";
+           }
+       }
+    }
+
+    if (!defined git_cat_file $dsc_hash) {
+       my @tags = map { "tags/".$_ } @$dsc_hint_tag;
+       my $lrf = $do_fetch->("additional commits", @tags) &&
+           defined git_cat_file $dsc_hash
+           or fail <<END;
+.dsc Dgit metadata requires commit $dsc_hash
+but we could not obtain that object anywhere.
+END
+       foreach my $t (@tags) {
+           my $fullrefname = $lrf.'/'.$t;
+#          print STDERR "CHK $t $fullrefname ".Dumper(\%lrfetchrefs_f);
+           next unless $lrfetchrefs_f{$fullrefname};
+           next unless is_fast_fwd "$fullrefname~0", $dsc_hash;
+           lrfetchref_used $fullrefname;
+       }
+    }
+}
+
 sub fetch_from_archive () {
     ensure_setup_existing_tree();
 
 sub fetch_from_archive () {
     ensure_setup_existing_tree();
 
@@ -2709,17 +2935,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";
     }
@@ -3109,6 +3327,7 @@ sub multisuite_suite_child ($$$) {
     my $canonsuitefh = IO::File::new_tmpfile;
     my $pid = fork // die $!;
     if (!$pid) {
     my $canonsuitefh = IO::File::new_tmpfile;
     my $pid = fork // die $!;
     if (!$pid) {
+       forkcheck_setup();
        $isuite = $tsuite;
        $us .= " [$isuite]";
        $debugprefix .= " ";
        $isuite = $tsuite;
        $us .= " [$isuite]";
        $debugprefix .= " ";
@@ -3645,8 +3864,12 @@ sub push_parse_changelog ($) {
     fail "-p specified $package but changelog specified $clogpackage"
        unless $package eq $clogpackage;
     my $cversion = getfield $clogp, 'Version';
     fail "-p specified $package but changelog specified $clogpackage"
        unless $package eq $clogpackage;
     my $cversion = getfield $clogp, 'Version';
-    my $tag = debiantag($cversion, access_nomdistro);
-    runcmd @git, qw(check-ref-format), $tag;
+
+    if (!$we_are_initiator) {
+       # rpush initiator can't do this because it doesn't have $isuite yet
+       my $tag = debiantag($cversion, access_nomdistro);
+       runcmd @git, qw(check-ref-format), $tag;
+    }
 
     my $dscfn = dscfn($cversion);
 
 
     my $dscfn = dscfn($cversion);
 
@@ -3709,7 +3932,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);
@@ -3726,7 +3953,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) = @_;
@@ -3828,6 +4054,7 @@ END
     prep_ud();
 
     access_giturl(); # check that success is vaguely likely
     prep_ud();
 
     access_giturl(); # check that success is vaguely likely
+    rpush_handle_protovsn_bothends() if $we_are_initiator;
     select_tagformat();
 
     my $clogpfn = ".git/dgit/changelog.822.tmp";
     select_tagformat();
 
     my $clogpfn = ".git/dgit/changelog.822.tmp";
@@ -3956,6 +4183,7 @@ END
     responder_send_file('changes',$changesfile);
     responder_send_command("param head $dgithead");
     responder_send_command("param csuite $csuite");
     responder_send_file('changes',$changesfile);
     responder_send_command("param head $dgithead");
     responder_send_command("param csuite $csuite");
+    responder_send_command("param isuite $isuite");
     responder_send_command("param tagformat $tagformat");
     if (defined $maintviewhead) {
        die unless ($protovsn//4) >= 4;
     responder_send_command("param tagformat $tagformat");
     if (defined $maintviewhead) {
        die unless ($protovsn//4) >= 4;
@@ -4062,7 +4290,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;
@@ -4077,8 +4304,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";
     }
@@ -4117,7 +4345,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';
@@ -4126,13 +4353,15 @@ sub fetchpullargs () {
        $isuite = branchsuite();
        if (!$isuite) {
            my $clogp = parsechangelog();
        $isuite = branchsuite();
        if (!$isuite) {
            my $clogp = parsechangelog();
-           $isuite = getfield $clogp, 'Distribution';
+           my $clogsuite = getfield $clogp, 'Distribution';
+           $isuite= $clogsuite if $clogsuite ne 'UNRELEASED';
        }
     } elsif (@ARGV==1) {
        ($isuite) = @ARGV;
     } else {
        badusage "incorrect arguments to dgit fetch or dgit pull";
     }
        }
     } elsif (@ARGV==1) {
        ($isuite) = @ARGV;
     } else {
        badusage "incorrect arguments to dgit fetch or dgit pull";
     }
+    notpushing();
 }
 
 sub cmd_fetch {
 }
 
 sub cmd_fetch {
@@ -4157,7 +4386,6 @@ END
 
 sub cmd_push {
     parseopts();
 
 sub cmd_push {
     parseopts();
-    pushing();
     badusage "-p is not allowed with dgit push" if defined $package;
     check_not_dirty();
     my $clogp = parsechangelog();
     badusage "-p is not allowed with dgit push" if defined $package;
     check_not_dirty();
     my $clogp = parsechangelog();
@@ -4170,6 +4398,7 @@ sub cmd_push {
        badusage "incorrect arguments to dgit push";
     }
     $isuite = getfield $clogp, 'Distribution';
        badusage "incorrect arguments to dgit push";
     }
     $isuite = getfield $clogp, 'Distribution';
+    pushing();
     if ($new_package) {
        local ($package) = $existing_package; # this is a hack
        canonicalise_suite();
     if ($new_package) {
        local ($package) = $existing_package; # this is a hack
        canonicalise_suite();
@@ -4200,8 +4429,6 @@ sub cmd_remote_push_build_host {
     $we_are_responder = 1;
     $us .= " (build host)";
 
     $we_are_responder = 1;
     $us .= " (build host)";
 
-    pushing();
-
     open PI, "<&STDIN" or die $!;
     open STDIN, "/dev/null" or die $!;
     open PO, ">&STDOUT" or die $!;
     open PI, "<&STDIN" or die $!;
     open STDIN, "/dev/null" or die $!;
     open PO, ">&STDOUT" or die $!;
@@ -4220,7 +4447,6 @@ sub cmd_remote_push_build_host {
        unless defined $protovsn;
 
     responder_send_command("dgit-remote-push-ready $protovsn");
        unless defined $protovsn;
 
     responder_send_command("dgit-remote-push-ready $protovsn");
-    rpush_handle_protovsn_bothends();
     changedir $dir;
     &cmd_push;
 }
     changedir $dir;
     &cmd_push;
 }
@@ -4253,7 +4479,10 @@ sub i_cleanup {
     }
 }
 
     }
 }
 
-END { i_cleanup(); }
+END {
+    return unless forkcheck_mainprocess();
+    i_cleanup();
+}
 
 sub i_method {
     my ($base,$selector,@args) = @_;
 
 sub i_method {
     my ($base,$selector,@args) = @_;
@@ -4262,7 +4491,6 @@ sub i_method {
 }
 
 sub cmd_rpush {
 }
 
 sub cmd_rpush {
-    pushing();
     my $host = nextarg;
     my $dir;
     if ($host =~ m/^((?:[^][]|\[[^][]*\])*)\:/) {
     my $host = nextarg;
     my $dir;
     if ($host =~ m/^((?:[^][]|\[[^][]*\])*)\:/) {
@@ -4282,6 +4510,8 @@ sub cmd_rpush {
     my @cmd = (@ssh, $host, shellquote @rdgit);
     debugcmd "+",@cmd;
 
     my @cmd = (@ssh, $host, shellquote @rdgit);
     debugcmd "+",@cmd;
 
+    $we_are_initiator=1;
+
     if (defined $initiator_tempdir) {
        rmtree $initiator_tempdir;
        mkdir $initiator_tempdir, 0700 or die "$initiator_tempdir: $!";
     if (defined $initiator_tempdir) {
        rmtree $initiator_tempdir;
        mkdir $initiator_tempdir, 0700 or die "$initiator_tempdir: $!";
@@ -4295,11 +4525,6 @@ sub cmd_rpush {
     die "$protovsn ?" unless grep { $_ eq $protovsn } @rpushprotovsn_support;
     $supplementary_message = '' unless $protovsn >= 3;
 
     die "$protovsn ?" unless grep { $_ eq $protovsn } @rpushprotovsn_support;
     $supplementary_message = '' unless $protovsn >= 3;
 
-    fail "rpush negotiated protocol version $protovsn".
-       " which does not support quilt mode $quilt_mode"
-       if quiltmode_splitbrain;
-
-    rpush_handle_protovsn_bothends();
     for (;;) {
        my ($icmd,$iargs) = initiator_expect {
            m/^(\S+)(?: (.*))?$/;
     for (;;) {
        my ($icmd,$iargs) = initiator_expect {
            m/^(\S+)(?: (.*))?$/;
@@ -4363,6 +4588,18 @@ our %i_wanted;
 sub i_resp_want ($) {
     my ($keyword) = @_;
     die "$keyword ?" if $i_wanted{$keyword}++;
 sub i_resp_want ($) {
     my ($keyword) = @_;
     die "$keyword ?" if $i_wanted{$keyword}++;
+    
+    defined $i_param{'csuite'} or badproto \*RO, "premature desire, no csuite";
+    $isuite = $i_param{'isuite'} // $i_param{'csuite'};
+    die unless $isuite =~ m/^$suite_re$/;
+
+    pushing();
+    rpush_handle_protovsn_bothends();
+
+    fail "rpush negotiated protocol version $protovsn".
+       " which does not support quilt mode $quilt_mode"
+       if quiltmode_splitbrain;
+
     my @localpaths = i_method "i_want", $keyword;
     printdebug "[[  $keyword @localpaths\n";
     foreach my $localpath (@localpaths) {
     my @localpaths = i_method "i_want", $keyword;
     printdebug "[[  $keyword @localpaths\n";
     foreach my $localpath (@localpaths) {
@@ -5241,6 +5478,7 @@ sub quilt_fixup_multipatch ($$$) {
 
     rmtree '.pc';
 
 
     rmtree '.pc';
 
+    runcmd @git, qw(checkout -f), $headref, qw(-- debian);
     my $unapplied=git_add_write_tree();
     printdebug "fake orig tree object $unapplied\n";
 
     my $unapplied=git_add_write_tree();
     printdebug "fake orig tree object $unapplied\n";
 
@@ -5435,12 +5673,12 @@ sub cmd_clean () {
 sub build_prep_early () {
     our $build_prep_early_done //= 0;
     return if $build_prep_early_done++;
 sub build_prep_early () {
     our $build_prep_early_done //= 0;
     return if $build_prep_early_done++;
-    notpushing();
     badusage "-p is not allowed when building" if defined $package;
     my $clogp = parsechangelog();
     $isuite = getfield $clogp, 'Distribution';
     $package = getfield $clogp, 'Source';
     $version = getfield $clogp, 'Version';
     badusage "-p is not allowed when building" if defined $package;
     my $clogp = parsechangelog();
     $isuite = getfield $clogp, 'Distribution';
     $package = getfield $clogp, 'Source';
     $version = getfield $clogp, 'Version';
+    notpushing();
     check_not_dirty();
 }
 
     check_not_dirty();
 }
 
@@ -5623,6 +5861,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) {
@@ -5715,6 +5954,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
@@ -5775,6 +6015,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();
@@ -5803,10 +6044,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();
 }
@@ -5874,30 +6112,41 @@ 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";
+    $package = getfield $dsc, 'Source';
+
+    parse_dsc_field($dsc, "Dgit metadata in .dsc")
+       unless forceing [qw(import-dsc-with-dgit-field)];
+    parse_dsc_field_def_dsc_distro();
+
+    $isuite = 'DGIT-IMPORT-DSC';
+    $idistro //= $dsc_distro;
+
+    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) {
        my @cmd = (qw(sh -ec),
        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;
@@ -5910,7 +6159,6 @@ Specify  +$specbranch to overwrite, discarding existing history
 END
        if $oldhash && !$force;
 
 END
        if $oldhash && !$force;
 
-    $package = getfield $dsc, 'Source';
     my @dfi = dsc_files_info();
     foreach my $fi (@dfi) {
        my $f = $fi->{Filename};
     my @dfi = dsc_files_info();
     foreach my $fi (@dfi) {
        my $f = $fi->{Filename};
@@ -5979,18 +6227,28 @@ sub cmd_clone_dgit_repos_server {
     badusage "need destination argument" unless @ARGV==1;
     my ($destdir) = @ARGV;
     $package = '_dgit-repos-server';
     badusage "need destination argument" unless @ARGV==1;
     my ($destdir) = @ARGV;
     $package = '_dgit-repos-server';
+    local $access_forpush = 0;
     my @cmd = (@git, qw(clone), access_giturl(), $destdir);
     debugcmd ">",@cmd;
     exec @cmd or fail "exec git clone: $!\n";
 }
 
     my @cmd = (@git, qw(clone), access_giturl(), $destdir);
     debugcmd ">",@cmd;
     exec @cmd or fail "exec git clone: $!\n";
 }
 
+sub cmd_print_dgit_repos_server_source_url {
+    badusage "no arguments allowed to dgit print-dgit-repos-server-source-url"
+       if @ARGV;
+    $package = '_dgit-repos-server';
+    local $access_forpush = 0;
+    my $url = access_giturl();
+    print $url, "\n" or die $!;
+}
+
 sub cmd_setup_mergechangelogs {
     badusage "no arguments allowed to dgit setup-mergechangelogs" if @ARGV;
     setup_mergechangelogs(1);
 }
 
 sub cmd_setup_useremail {
 sub cmd_setup_mergechangelogs {
     badusage "no arguments allowed to dgit setup-mergechangelogs" if @ARGV;
     setup_mergechangelogs(1);
 }
 
 sub cmd_setup_useremail {
-    badusage "no arguments allowed to dgit setup-mergechangelogs" if @ARGV;
+    badusage "no arguments allowed to dgit setup-useremail" if @ARGV;
     setup_useremail(1);
 }
 
     setup_useremail(1);
 }
 
@@ -6007,7 +6265,9 @@ sub cmd_version {
 }
 
 our (%valopts_long, %valopts_short);
 }
 
 our (%valopts_long, %valopts_short);
+our (%funcopts_long);
 our @rvalopts;
 our @rvalopts;
+our (@modeopt_cfgs);
 
 sub defvalopt ($$$$) {
     my ($long,$short,$val_re,$how) = @_;
 
 sub defvalopt ($$$$) {
     my ($long,$short,$val_re,$how) = @_;
@@ -6043,6 +6303,26 @@ defvalopt '--initiator-tempdir','','.*', sub {
        " absolute, not relative, directory."
 };
 
        " absolute, not relative, directory."
 };
 
+sub defoptmodes ($@) {
+    my ($varref, $cfgkey, $default, %optmap) = @_;
+    my %permit;
+    while (my ($opt,$val) = each %optmap) {
+       $funcopts_long{$opt} = sub { $$varref = $val; };
+       $permit{$val} = $val;
+    }
+    push @modeopt_cfgs, {
+        Var => $varref,
+        Key => $cfgkey,
+        Default => $default,
+        Vals => \%permit
+    };
+}
+
+defoptmodes \$dodep14tag, qw( dep14tag          want
+                             --dep14tag        want
+                             --no-dep14tag     no
+                             --always-dep14tag always );
+
 sub parseopts () {
     my $om;
 
 sub parseopts () {
     my $om;
 
@@ -6116,21 +6396,15 @@ sub parseopts () {
            } elsif (m/^--no-rm-on-error$/s) {
                push @ropts, $_;
                $rmonerror = 0;
            } elsif (m/^--no-rm-on-error$/s) {
                push @ropts, $_;
                $rmonerror = 0;
+           } elsif (m/^--no-chase-dsc-distro$/s) {
+               push @ropts, $_;
+               $chase_dsc_distro = 0;
            } elsif (m/^--overwrite$/s) {
                push @ropts, $_;
                $overwrite_version = '';
            } elsif (m/^--overwrite=(.+)$/s) {
                push @ropts, $_;
                $overwrite_version = $1;
            } elsif (m/^--overwrite$/s) {
                push @ropts, $_;
                $overwrite_version = '';
            } 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, $_;
@@ -6161,9 +6435,17 @@ sub parseopts () {
                # undocumented, for testing
                push @ropts, $_;
                $need_split_build_invocation = 1;
                # undocumented, for testing
                push @ropts, $_;
                $need_split_build_invocation = 1;
+           } elsif (m/^--config-lookup-explode=(.+)$/s) {
+               # undocumented, for testing
+               push @ropts, $_;
+               $gitcfgs{cmdline}{$1} = 'CONFIG-LOOKUP-EXPLODE';
+               # ^ it's supposed to be an array ref
            } elsif (m/^(--[-0-9a-z]+)(=|$)/ && ($oi = $valopts_long{$1})) {
                $val = $2 ? $' : undef; #';
                $valopt->($oi->{Long});
            } elsif (m/^(--[-0-9a-z]+)(=|$)/ && ($oi = $valopts_long{$1})) {
                $val = $2 ? $' : undef; #';
                $valopt->($oi->{Long});
+           } elsif ($funcopts_long{$_}) {
+               push @ropts, $_;
+               $funcopts_long{$_}();
            } else {
                badusage "unknown long option \`$_'";
            }
            } else {
                badusage "unknown long option \`$_'";
            }
@@ -6249,7 +6531,11 @@ END
 }
 
 
 }
 
 
-sub finalise_opts_opts () {
+sub parseopts_late_defaults () {
+    $isuite //= cfg("dgit-distro.$idistro.default-suite", 'RETURN-UNDEF')
+       if defined $idistro;
+    $isuite //= cfg('dgit.default.default-suite');
+
     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};
 
@@ -6276,6 +6562,42 @@ 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;
+    }
+
+    foreach my $moc (@modeopt_cfgs) {
+       local $access_forpush;
+       my $vr = $moc->{Var};
+       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;
+       $$vr = $v;
+    }
+
+    $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}) {
@@ -6300,40 +6622,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;
-}
-
-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;
-}
-
 my $fn = ${*::}{"cmd_$cmd"};
 $fn or badusage "unknown operation $cmd";
 $fn->();
 my $fn = ${*::}{"cmd_$cmd"};
 $fn or badusage "unknown operation $cmd";
 $fn->();