chiark / gitweb /
directory refactoring: Rename no_local_git_cfg
[dgit.git] / dgit
diff --git a/dgit b/dgit
index afdf2c5..9aadaf0 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -19,7 +19,7 @@
 
 use strict;
 
-use Debian::Dgit;
+use Debian::Dgit qw(:DEFAULT :playground);
 setup_sigwarn();
 
 use IO::Handle;
@@ -34,7 +34,6 @@ use POSIX;
 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);
@@ -48,6 +47,8 @@ our $absurdity = undef; ###substituted###
 our @rpushprotovsn_support = qw(4 3 2); # 4 is new tag format
 our $protovsn;
 
+our $cmd;
+our $subcommand;
 our $isuite;
 our $idistro;
 our $package;
@@ -70,7 +71,6 @@ 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 $we_are_initiator;
@@ -102,7 +102,7 @@ our $rewritemap = 'dgit-rewrite/map';
 
 our (@git) = qw(git);
 our (@dget) = qw(dget);
-our (@curl) = qw(curl);
+our (@curl) = (qw(curl --proto-redir), '-all,http,https', qw(-L));
 our (@dput) = qw(dput);
 our (@debsign) = qw(debsign);
 our (@gpg) = qw(gpg);
@@ -145,6 +145,8 @@ our %opts_cfg_insertpos = map {
 } keys %opts_opt_map;
 
 sub parseopts_late_defaults();
+sub setup_gitattrs(;$);
+sub check_gitattrs($$);
 
 our $keyid;
 
@@ -249,12 +251,6 @@ sub no_such_package () {
     exit 4;
 }
 
-sub changedir ($) {
-    my ($newdir) = @_;
-    printdebug "CD $newdir\n";
-    chdir $newdir or confess "chdir: $newdir: $!";
-}
-
 sub deliberately ($) {
     my ($enquiry) = @_;
     return !!grep { $_ eq "--deliberately-$enquiry" } @deliberatelies;
@@ -316,6 +312,9 @@ sub gbp_pq {
 #  > param tagformat old|new
 #  > param maint-view MAINT-VIEW-HEAD
 #
+#  > param buildinfo-filename P_V_X.buildinfo   # zero or more times
+#  > file buildinfo                             # for buildinfos to sign
+#
 #  > previously REFNAME=OBJNAME       # if --deliberately-not-fast-forward
 #                                     # goes into tag, for replay prevention
 #
@@ -332,6 +331,9 @@ sub gbp_pq {
 #  [etc]
 #  < data-block NBYTES    [transfer of signed changes]
 #  [etc]
+#  < data-block NBYTES    [transfer of each signed buildinfo
+#  [etc]                   same number and order as "file buildinfo"]
+#  ...
 #  < files-end
 #
 #  > complete
@@ -487,12 +489,6 @@ sub url_get {
 
 our ($dscdata,$dscurl,$dsc,$dsc_checked,$skew_warning_vsn);
 
-sub runcmd {
-    debugcmd "+",@_;
-    $!=0; $?=-1;
-    failedcmd @_ if system @_;
-}
-
 sub act_local () { return $dryrun_level <= 1; }
 sub act_scary () { return !$dryrun_level; }
 
@@ -560,6 +556,9 @@ sub nextarg {
     return scalar shift @ARGV;
 }
 
+sub pre_help () {
+    not_necessarily_a_tree();
+}
 sub cmd_help () {
     print $helpmsg or die $!;
     exit 0;
@@ -638,30 +637,14 @@ our %gitcfgs;
 our @gitcfgsources = qw(cmdline local global system);
 
 sub git_slurp_config () {
-    local ($debuglevel) = $debuglevel-2;
-    local $/="\0";
-
     # This algoritm is a bit subtle, but this is needed so that for
     # options which we want to be single-valued, we allow the
     # different config sources to override properly.  See #835858.
     foreach my $src (@gitcfgsources) {
        next if $src eq 'cmdline';
        # we do this ourselves since git doesn't handle it
-       
-       my @cmd = (@git, qw(config -z --get-regexp), "--$src", qw(.*));
-       debugcmd "|",@cmd;
 
-       open GITS, "-|", @cmd or die $!;
-       while (<GITS>) {
-           chomp or die;
-           printdebug "=> ", (messagequote $_), "\n";
-           m/\n/ or die "$_ ?";
-           push @{ $gitcfgs{$src}{$`} }, $'; #';
-       }
-       $!=0; $?=0;
-       close GITS
-           or ($!==0 && $?==256)
-           or failedcmd @cmd;
+       $gitcfgs{$src} = git_slurp_config_src $src;
     }
 }
 
@@ -669,7 +652,7 @@ sub git_get_config ($) {
     my ($c) = @_;
     foreach my $src (@gitcfgsources) {
        my $l = $gitcfgs{$src}{$c};
-       croak "$l $c" if $l && !ref $l;
+       confess "internal error ($l $c)" if $l && !ref $l;
        printdebug"C $c ".(defined $l ?
                           join " ", map { messagequote "'$_'" } @$l :
                           "undef")."\n"
@@ -698,6 +681,11 @@ sub cfg {
        "$us: distro or suite appears not to be (properly) supported";
 }
 
+sub not_necessarily_a_tree () {
+    # needs to be called from pre_*
+    @gitcfgsources = grep { $_ ne 'local' } @gitcfgsources;
+}
+
 sub access_basedistro__noalias () {
     if (defined $idistro) {
        return $idistro;
@@ -997,12 +985,6 @@ sub commit_getclogp ($) {
     $commit_getclogp_memo{$objid} = parsechangelog("-l$mclog");
 }
 
-sub must_getcwd () {
-    my $d = getcwd();
-    defined $d or fail "getcwd failed: $!";
-    return $d;
-}
-
 sub parse_dscdata () {
     my $dscfh = new IO::File \$dscdata, '<' or die $!;
     printdebug Dumper($dscdata) if $debuglevel>1;
@@ -1319,6 +1301,8 @@ sub archive_query_aptget {
     return [ (getfield $pre_dsc, 'Version'), $uri ];
 }
 
+sub file_in_archive_aptget () { return undef; }
+
 #---------- `dummyapicat' archive query method ----------
 
 sub archive_query_dummycatapi { archive_query_ftpmasterapi @_; }
@@ -1684,21 +1668,13 @@ sub create_remote_git_repo () {
 our ($dsc_hash,$lastpush_mergeinput);
 our ($dsc_distro, $dsc_hint_tag, $dsc_hint_url);
 
-our $ud = '.git/dgit/unpack';
 
-sub prep_ud (;$) {
-    my ($d) = @_;
-    $d //= $ud;
-    rmtree($d);
-    mkpath '.git/dgit';
-    mkdir $d or die $!;
+sub prep_ud () {
+    fresh_playground 'dgit/unpack';
 }
 
 sub mktree_in_ud_here () {
-    runcmd qw(git init -q);
-    runcmd qw(git config gc.auto 0);
-    rmtree('.git/objects');
-    symlink '../../../../objects','.git/objects' or die $!;
+    playtree_setup $gitcfgs{local};
 }
 
 sub git_write_tree () {
@@ -1987,7 +1963,14 @@ sub make_commit_text ($) {
 sub clogp_authline ($) {
     my ($clogp) = @_;
     my $author = getfield $clogp, 'Maintainer';
-    $author =~ s#,.*##ms;
+    if ($author =~ m/^[^"\@]+\,/) {
+       # single entry Maintainer field with unquoted comma
+       $author = ($& =~ y/,//rd).$'; # strip the comma
+    }
+    # git wants a single author; any remaining commas in $author
+    # are by now preceded by @ (or ").  It seems safer to punt on
+    # "..." for now rather than attempting to dequote or something.
+    $author =~ s#,.*##ms unless $author =~ m/"/;
     my $date = cmdoutput qw(date), '+%s %z', qw(-d), getfield($clogp,'Date');
     my $authline = "$author $date";
     $authline =~ m/$git_authline_re/o or
@@ -2066,7 +2049,7 @@ sub generate_commits_from_dsc () {
     # See big comment in fetch_from_archive, below.
     # See also README.dsc-import.
     prep_ud();
-    changedir $ud;
+    changedir $playground;
 
     my @dfi = dsc_files_info();
     foreach my $fi (@dfi) {
@@ -2152,7 +2135,7 @@ sub generate_commits_from_dsc () {
                if defined $compr_ext && !defined $cname;
            my $compr_proc =
                new Dpkg::Compression::Process compression => $cname;
-           my @compr_cmd = $compr_proc->get_uncompress_cmdline();
+           @compr_cmd = $compr_proc->get_uncompress_cmdline();
            my $compr_fh = new IO::Handle;
            my $compr_pid = open $compr_fh, "-|" // die $!;
            if (!$compr_pid) {
@@ -2179,7 +2162,7 @@ sub generate_commits_from_dsc () {
        !$? or failedcmd @tarcmd;
 
        close $input or
-           (@compr_cmd ? failedcmd @compr_cmd
+           (@compr_cmd ? ($?==SIGPIPE || failedcmd @compr_cmd)
             : die $!);
        # finally, we have the results in "tarball", but maybe
        # with the wrong permissions
@@ -2309,6 +2292,7 @@ sub generate_commits_from_dsc () {
 
     my $authline = clogp_authline $clogp;
     my $changes = getfield $clogp, 'Changes';
+    $changes =~ s/^\n//; # Changes: \n
     my $cversion = getfield $clogp, 'Version';
 
     if (@tartrees) {
@@ -2475,8 +2459,8 @@ END
            @output = $lastpush_mergeinput;
        }
     }
-    changedir '../../../..';
-    rmtree($ud);
+    changedir $maindir;
+    rmtree $playground;
     return @output;
 }
 
@@ -2497,7 +2481,7 @@ sub complete_file_from_dsc ($$;$) {
        $fi->{Digester}->reset();
        $fi->{Digester}->addfile(*F);
        F->error and die $!;
-       my $got = $fi->{Digester}->hexdigest();
+       $got = $fi->{Digester}->hexdigest();
        return $got eq $fi->{Hash};
     };
 
@@ -2557,7 +2541,7 @@ sub lrfetchref () { return lrfetchrefs.'/'.server_branch($csuite); }
 # (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
+# 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.
 
@@ -2571,7 +2555,7 @@ sub lrfetchref_used ($) {
 }
 
 sub git_lrfetch_sane {
-    my ($supplementary, @specs) = @_;
+    my ($url, $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
@@ -2602,8 +2586,6 @@ sub git_lrfetch_sane {
     # git fetch to try to generate it.  If we don't manage to generate
     # the target state, we try again.
 
-    my $url = access_giturl();
-
     printdebug "git_lrfetch_sane suppl=$supplementary specs @specs\n";
 
     my $specre = join '|', map {
@@ -2743,7 +2725,8 @@ sub git_fetch_us () {
     push @specs, $rewritemap;
     push @specs, qw(heads/*) if deliberately_not_fast_forward;
 
-    git_lrfetch_sane 0, @specs;
+    my $url = access_giturl();
+    git_lrfetch_sane $url, 0, @specs;
 
     my %here;
     my @tagpats = debiantags('*',access_nomdistro);
@@ -2764,8 +2747,8 @@ sub git_fetch_us () {
        } 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";
        }
     });
 }
@@ -2800,6 +2783,11 @@ 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;
@@ -2807,16 +2795,17 @@ sub parse_dsc_field ($$) {
        $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 = $&;
-       $dsc_distro //= cfg qw(dgit.default.old-dsc-distro
-                              dgit.default.distro);
+       parse_dsc_field_def_dsc_distro();
        $dsc_hint_tag = [ debiantags +(getfield $dsc, 'Version'),
                          $dsc_distro ];
        progress "$what: specified git hash";
@@ -2866,13 +2855,13 @@ END
                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.
+.dsc provides 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;
+       git_lrfetch_sane $url, 1, @fetch;
 
        return $lrf;
     };
@@ -2912,7 +2901,7 @@ 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);
+#          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;
@@ -3250,6 +3239,8 @@ END
 
     lrfetchref_used lrfetchref();
 
+    check_gitattrs($hash, "fetched source tree");
+
     unshift @end, $del_lrfetchrefs;
     return $hash;
 }
@@ -3311,11 +3302,89 @@ sub ensure_setup_existing_tree () {
     set_local_git_config $k, 'true';
 }
 
+sub open_gitattrs () {
+    my $gai = new IO::File ".git/info/attributes"
+       or $!==ENOENT
+       or die "open .git/info/attributes: $!";
+    return $gai;
+}
+
+sub is_gitattrs_setup () {
+    my $gai = open_gitattrs();
+    return 0 unless $gai;
+    while (<$gai>) {
+       return 1 if m{^\[attr\]dgit-defuse-attrs\s};
+    }
+    $gai->error and die $!;
+    return 0;
+}    
+
+sub setup_gitattrs (;$) {
+    my ($always) = @_;
+    return unless $always || access_cfg_bool(1, 'setup-gitattributes');
+
+    if (is_gitattrs_setup()) {
+       progress <<END;
+[attr]dgit-defuse-attrs already found in .git/info/attributes
+ not doing further gitattributes setup
+END
+       return;
+    }
+    my $af = ".git/info/attributes";
+    ensuredir '.git/info';
+    open GAO, "> $af.new" or die $!;
+    print GAO <<END or die $!;
+*      dgit-defuse-attrs
+[attr]dgit-defuse-attrs        $negate_harmful_gitattrs
+# ^ see GITATTRIBUTES in dgit(7) and dgit setup-new-tree in dgit(1)
+END
+    my $gai = open_gitattrs();
+    if ($gai) {
+       while (<$gai>) {
+           chomp;
+           print GAO $_, "\n" or die $!;
+       }
+       $gai->error and die $!;
+    }
+    close GAO or die $!;
+    rename "$af.new", "$af" or die "install $af: $!";
+}
+
 sub setup_new_tree () {
     setup_mergechangelogs();
     setup_useremail();
+    setup_gitattrs();
 }
 
+sub check_gitattrs ($$) {
+    my ($treeish, $what) = @_;
+
+    return if is_gitattrs_setup;
+
+    local $/="\0";
+    my @cmd = (@git, qw(ls-tree -lrz --), "${treeish}:");
+    debugcmd "|",@cmd;
+    my $gafl = new IO::File;
+    open $gafl, "-|", @cmd or die $!;
+    while (<$gafl>) {
+       chomp or die;
+       s/^\d+\s+\w+\s+\w+\s+(\d+)\t// or die;
+       next if $1 == 0;
+       next unless m{(?:^|/)\.gitattributes$};
+
+       # oh dear, found one
+       print STDERR <<END;
+dgit: warning: $what contains .gitattributes
+dgit: .gitattributes have not been defused.  Recommended: dgit setup-new-tree.
+END
+       close $gafl;
+       return;
+    }
+    # tree contains no .gitattributes files
+    $?=0; $!=0; close $gafl or failedcmd @cmd;
+}
+
+
 sub multisuite_suite_child ($$$) {
     my ($tsuite, $merginputs, $fn) = @_;
     # in child, sets things up, calls $fn->(), and returns undef
@@ -3381,6 +3450,7 @@ sub fork_for_multisuite ($) {
     $before_fetch_merge->();
 
     foreach my $tsuite (@suites[1..$#suites]) {
+       $tsuite =~ s/^-/$cbasesuite-/;
        my $csubsuite = multisuite_suite_child($tsuite, \@mergeinputs,
                                               sub {
             @end = ();
@@ -3495,6 +3565,9 @@ END
 }
 
 sub clone ($) {
+    # in multisuite, returns twice!
+    # once in parent after first suite fetched,
+    # and then again in child after everything is finished
     my ($dstdir) = @_;
     badusage "dry run makes no sense with clone" unless act_local();
 
@@ -3506,7 +3579,7 @@ sub clone ($) {
         printdebug "multi clone after fetch merge\n";
        clone_set_head();
        clone_finish($dstdir);
-       exit 0;
+       return;
     }
     printdebug "clone main body\n";
 
@@ -3515,6 +3588,7 @@ sub clone ($) {
     mkdir $dstdir or fail "create \`$dstdir': $!";
     changedir $dstdir;
     runcmd @git, qw(init -q);
+    setup_new_tree();
     clone_set_head();
     my $giturl = access_giturl(1);
     if (defined $giturl) {
@@ -3533,7 +3607,6 @@ sub clone ($) {
        $vcsgiturl =~ s/\s+-b\s+\S+//g;
        runcmd @git, qw(remote add vcs-git), $vcsgiturl;
     }
-    setup_new_tree();
     clone_finish($dstdir);
 }
 
@@ -3712,18 +3785,28 @@ sub pseudomerge_version_check ($$) {
        } else {
            my $v = $i_arch_v->[0];
            progress "Checking package changelog for archive version $v ...";
+           my $cd;
            eval {
                my @xa = ("-f$v", "-t$v");
                my $vclogp = parsechangelog @xa;
-               my $cv = [ (getfield $vclogp, 'Version'),
-                          "Version field from dpkg-parsechangelog @xa" ];
+               my $gf = sub {
+                   my ($fn) = @_;
+                   [ (getfield $vclogp, $fn),
+                     "$fn field from dpkg-parsechangelog @xa" ];
+               };
+               my $cv = $gf->('Version');
                infopair_cond_equal($i_arch_v, $cv);
+               $cd = $gf->('Distribution');
            };
            if ($@) {
                $@ =~ s/^dgit: //gm;
                fail "$@".
                    "Perhaps debian/changelog does not mention $v ?";
            }
+           fail <<END if $cd->[0] =~ m/UNRELEASED/;
+$cd->[1] is $cd->[0]
+Your tree seems to based on earlier (not uploaded) $v.
+END
        }
     }
     
@@ -3781,6 +3864,7 @@ sub splitbrain_pseudomerge ($$$$) {
     #
 
     return $dgitview unless defined $archive_hash;
+    return $dgitview if deliberately_not_fast_forward();
 
     printdebug "splitbrain_pseudomerge...\n";
 
@@ -4082,7 +4166,7 @@ END
     if (madformat_wantfixup($format)) {
        # user might have not used dgit build, so maybe do this now:
        if (quiltmode_splitbrain()) {
-           changedir $ud;
+           changedir $playground;
            quilt_make_fake_dsc($upstreamversion);
            my $cachekey;
            ($dgithead, $cachekey) =
@@ -4095,7 +4179,7 @@ END
                                               $actualhead, $dgithead,
                                               $archive_hash);
            $maintviewhead = $actualhead;
-           changedir '../../../..';
+           changedir $maindir;
            prep_ud(); # so _only_subdir() works, below
        } else {
            commit_quilty_patch();
@@ -4126,13 +4210,13 @@ END
        }
     }
 
-    changedir $ud;
+    changedir $playground;
     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("source package");
     check_for_vendor_patches() if madformat($dsc->{format});
-    changedir '../../../..';
+    changedir $maindir;
     my @diffcmd = (@git, qw(diff --quiet), $tree, $dgithead);
     debugcmd "+",@diffcmd;
     $!=0; $?=-1;
@@ -4186,6 +4270,14 @@ END
        responder_send_command("param maint-view $maintviewhead");
     }
 
+    # Perhaps send buildinfo(s) for signing
+    my $changes_files = getfield $changes, 'Files';
+    my @buildinfos = ($changes_files =~ m/ .* (\S+\.buildinfo)$/mg);
+    foreach my $bi (@buildinfos) {
+       responder_send_command("param buildinfo-filename $bi");
+       responder_send_file('buildinfo', "$buildproductsdir/$bi");
+    }
+
     if (deliberately_not_fast_forward) {
        git_for_each_ref(lrfetchrefs, sub {
            my ($objid,$objtype,$lrfetchrefname,$reftail) = @_;
@@ -4256,9 +4348,10 @@ If you need to change the package, you must use a new version number.
 END
     if ($we_are_responder) {
        my $dryrunsuffix = act_local() ? "" : ".tmp";
+       my @rfiles = ($dscpath, $changesfile);
+       push @rfiles, map { "$buildproductsdir/$_" } @buildinfos;
        responder_receive_files('signed-dsc-changes',
-                               "$dscpath$dryrunsuffix",
-                               "$changesfile$dryrunsuffix");
+                               map { "$_$dryrunsuffix" } @rfiles);
     } else {
        if (act_local()) {
            rename "$dscpath.tmp",$dscpath or die "$dscfn $!";
@@ -4284,6 +4377,9 @@ END
     responder_send_command("complete");
 }
 
+sub pre_clone () {
+    not_necessarily_a_tree();
+}
 sub cmd_clone {
     parseopts();
     my $dstdir;
@@ -4332,7 +4428,12 @@ sub cmd_clone {
 }
 
 sub branchsuite () {
-    my $branch = cmdoutput_errok @git, qw(symbolic-ref HEAD);
+    my @cmd = (@git, qw(symbolic-ref -q HEAD));
+    my $branch = cmdoutput_errok @cmd;
+    if (!defined $branch) {
+       $?==256 or failedcmd @cmd;
+       return undef;
+    }
     if ($branch =~ m#$lbranch_re#o) {
        return $1;
     } else {
@@ -4380,21 +4481,18 @@ END
     pull();
 }
 
-sub cmd_push {
+sub prep_push () {
     parseopts();
-    badusage "-p is not allowed with dgit push" if defined $package;
+    build_or_push_prep_early();
+    pushing();
     check_not_dirty();
-    my $clogp = parsechangelog();
-    $package = getfield $clogp, 'Source';
     my $specsuite;
     if (@ARGV==0) {
     } elsif (@ARGV==1) {
        ($specsuite) = (@ARGV);
     } else {
-       badusage "incorrect arguments to dgit push";
+       badusage "incorrect arguments to dgit $subcommand";
     }
-    $isuite = getfield $clogp, 'Distribution';
-    pushing();
     if ($new_package) {
        local ($package) = $existing_package; # this is a hack
        canonicalise_suite();
@@ -4404,15 +4502,19 @@ sub cmd_push {
     if (defined $specsuite &&
        $specsuite ne $isuite &&
        $specsuite ne $csuite) {
-           fail "dgit push: changelog specifies $isuite ($csuite)".
+           fail "dgit $subcommand: changelog specifies $isuite ($csuite)".
                " but command line specifies $specsuite";
     }
+}
+
+sub cmd_push {
+    prep_push();
     dopush();
 }
 
 #---------- remote commands' implementation ----------
 
-sub cmd_remote_push_build_host {
+sub pre_remote_push_build_host {
     my ($nrargs) = shift @ARGV;
     my (@rargs) = @ARGV[0..$nrargs-1];
     @ARGV = @ARGV[$nrargs..$#ARGV];
@@ -4442,11 +4544,14 @@ sub cmd_remote_push_build_host {
         " but invocation host has $vsnwant"
        unless defined $protovsn;
 
-    responder_send_command("dgit-remote-push-ready $protovsn");
     changedir $dir;
+}
+sub cmd_remote_push_build_host {
+    responder_send_command("dgit-remote-push-ready $protovsn");
     &cmd_push;
 }
 
+sub pre_remote_push_responder { pre_remote_push_build_host(); }
 sub cmd_remote_push_responder { cmd_remote_push_build_host(); }
 # ... for compatibility with proto vsn.1 dgit (just so that user gets
 #     a good error message)
@@ -4486,6 +4591,9 @@ sub i_method {
     { no strict qw(refs); &{"${base}_${selector}"}(@args); }
 }
 
+sub pre_rpush () {
+    not_necessarily_a_tree();
+}
 sub cmd_rpush {
     my $host = nextarg;
     my $dir;
@@ -4604,7 +4712,7 @@ sub i_resp_want ($) {
     print RI "files-end\n" or die $!;
 }
 
-our ($i_clogp, $i_version, $i_dscfn, $i_changesfn);
+our ($i_clogp, $i_version, $i_dscfn, $i_changesfn, @i_buildinfos);
 
 sub i_localname_parsed_changelog {
     return "remote-changelog.822";
@@ -4621,6 +4729,31 @@ sub i_localname_dsc {
 }
 sub i_file_dsc { }
 
+sub i_localname_buildinfo ($) {
+    my $bi = $i_param{'buildinfo-filename'};
+    defined $bi or badproto \*RO, "buildinfo before filename";
+    defined $i_changesfn or badproto \*RO, "buildinfo before changes";
+    $bi =~ m{^\Q$package\E_[!-.0-~]*\.buildinfo$}s
+       or badproto \*RO, "improper buildinfo filename";
+    return $&;
+}
+sub i_file_buildinfo {
+    my $bi = $i_param{'buildinfo-filename'};
+    my $bd = parsecontrol "$i_tmp/$bi", $bi;
+    my $ch = parsecontrol "$i_tmp/$i_changesfn", 'changes';
+    if (!forceing [qw(buildinfo-changes-mismatch)]) {
+       files_compare_inputs($bd, $ch);
+       (getfield $bd, $_) eq (getfield $ch, $_) or
+           fail "buildinfo mismatch $_"
+           foreach qw(Source Version);
+       !defined $bd->{$_} or
+           fail "buildinfo contains $_"
+           foreach qw(Changes Changed-by Distribution);
+    }
+    push @i_buildinfos, $bi;
+    delete $i_param{'buildinfo-filename'};
+}
+
 sub i_localname_changes {
     defined $i_dscfn or badproto \*RO, "dsc (before parsed-changelog)";
     $i_changesfn = $i_dscfn;
@@ -4662,7 +4795,7 @@ sub i_want_signed_tag {
 sub i_want_signed_dsc_changes {
     rename "$i_dscfn.tmp","$i_dscfn" or die "$i_dscfn $!";
     sign_changes $i_changesfn;
-    return ($i_dscfn, $i_changesfn);
+    return ($i_dscfn, $i_changesfn, @i_buildinfos);
 }
 
 #---------- building etc. ----------
@@ -4711,7 +4844,7 @@ sub quiltify_trees_differ ($$;$$$) {
     #  a list of unrepresentable changes (removals of upstream files
     #  (as messages)
     local $/=undef;
-    my @cmd = (@git, qw(diff-tree -z));
+    my @cmd = (@git, qw(diff-tree -z --no-renames));
     push @cmd, qw(--name-only) unless $unrepres;
     push @cmd, qw(-r) if $finegrained || $unrepres;
     push @cmd, $x, $y;
@@ -4730,16 +4863,23 @@ sub quiltify_trees_differ ($$;$$$) {
 
        if ($unrepres) {
            eval {
-               die "not a plain file\n"
-                   unless $newmode =~ m/^10\d{4}$/ ||
-                          $oldmode =~ m/^10\d{4}$/;
+               die "not a plain file or symlink\n"
+                   unless $newmode =~ m/^(?:10|12)\d{4}$/ ||
+                          $oldmode =~ m/^(?:10|12)\d{4}$/;
                if ($oldmode =~ m/[^0]/ &&
                    $newmode =~ m/[^0]/) {
-                   die "mode changed\n" if $oldmode ne $newmode;
+                   # both old and new files exist
+                   die "mode or type changed\n" if $oldmode ne $newmode;
+                   die "modified symlink\n" unless $newmode =~ m/^10/;
+               } elsif ($oldmode =~ m/[^0]/) {
+                   # deletion
+                   die "deletion of symlink\n"
+                       unless $oldmode =~ m/^10/;
                } else {
-                   die "non-default mode\n"
-                       unless $newmode =~ m/^100644$/ ||
-                              $oldmode =~ m/^100644$/;
+                   # creation
+                   die "creation with non-default mode\n"
+                       unless $newmode =~ m/^100644$/ or
+                              $newmode =~ m/^120000$/;
                }
            };
            if ($@) {
@@ -4865,7 +5005,7 @@ END
 
     my $dgitview = git_rev_parse 'HEAD';
 
-    changedir '../../../..';
+    changedir $maindir;
     # When we no longer need to support squeeze, use --create-reflog
     # instead of this:
     ensuredir ".git/logs/refs/dgit-intern";
@@ -4890,7 +5030,7 @@ END
     runcmd @git, qw(update-ref -m), $cachekey, "refs/$splitbraincache",
        $dgitview;
 
-    changedir '.git/dgit/unpack/work';
+    changedir "$playground/work";
 
     my $saved = maybe_split_brain_save $headref, $dgitview, "converted";
     progress "dgit view: created ($saved)";
@@ -5094,6 +5234,7 @@ sub quiltify ($$$$) {
                die "contains unexpected slashes\n" if m{//} || m{/$};
                die "contains leading punctuation\n" if m{^\W} || m{/\W};
                die "contains bad character(s)\n" if m{[^-a-z0-9_.+=~/]}i;
+               die "is series file\n" if m{$series_filename_re}o;
                die "too long" if length > 200;
            };
            return $_ unless $@;
@@ -5132,6 +5273,7 @@ sub quiltify ($$$$) {
            $patchname =~ y/-a-z0-9_.+=~//cd;
            $patchname =~ s/^\W/x-$&/;
            $patchname = substr($patchname,0,40);
+           $patchname .= ".patch";
        }
        if (!defined $patchdir) {
            $patchdir = '';
@@ -5187,7 +5329,7 @@ END
     my $headref = git_rev_parse('HEAD');
 
     prep_ud();
-    changedir $ud;
+    changedir $playground;
 
     my $upstreamversion = upstreamversion $version;
 
@@ -5199,7 +5341,7 @@ END
 
     die 'bug' if $split_brain && !$need_split_build_invocation;
 
-    changedir '../../../..';
+    changedir $maindir;
     runcmd_ordryrun_local
         @git, qw(pull --ff-only -q .git/dgit/unpack/work master);
 }
@@ -5310,7 +5452,7 @@ END
 sub quilt_check_splitbrain_cache ($$) {
     my ($headref, $upstreamversion) = @_;
     # Called only if we are in (potentially) split brain mode.
-    # Called in $ud.
+    # Called in playground.
     # Computes the cache key and looks in the cache.
     # Returns ($dgit_view_commitid, $cachekey) or (undef, $cachekey)
 
@@ -5666,14 +5808,18 @@ sub cmd_clean () {
     maybe_unapply_patches_again();
 }
 
-sub build_prep_early () {
-    our $build_prep_early_done //= 0;
-    return if $build_prep_early_done++;
-    badusage "-p is not allowed when building" if defined $package;
+sub build_or_push_prep_early () {
+    our $build_or_push_prep_early_done //= 0;
+    return if $build_or_push_prep_early_done++;
+    badusage "-p is not allowed with dgit $subcommand" if defined $package;
     my $clogp = parsechangelog();
     $isuite = getfield $clogp, 'Distribution';
     $package = getfield $clogp, 'Source';
     $version = getfield $clogp, 'Version';
+}
+
+sub build_prep_early () {
+    build_or_push_prep_early();
     notpushing();
     check_not_dirty();
 }
@@ -5982,10 +6128,10 @@ sub build_source {
     } else {
        my @cmd = (@dpkgsource, qw(-b --));
        if ($split_brain) {
-           changedir $ud;
+           changedir $playground;
            runcmd_ordryrun_local @cmd, "work";
            my @udfiles = <${package}_*>;
-           changedir "../../..";
+           changedir $maindir;
            foreach my $f (@udfiles) {
                printdebug "source copy, found $f\n";
                next unless
@@ -5993,7 +6139,7 @@ sub build_source {
                    ($f =~ m/\.debian\.tar(?:\.\w+)$/ &&
                     $f eq srcfn($version, $&));
                printdebug "source copy, found $f - renaming\n";
-               rename "$ud/$f", "../$f" or $!==ENOENT
+               rename "$playground/$f", "../$f" or $!==ENOENT
                    or fail "put in place new source file ($f): $!";
            }
        } else {
@@ -6045,6 +6191,15 @@ sub cmd_quilt_fixup {
     build_maybe_quilt_fixup();
 }
 
+sub import_dsc_result {
+    my ($dstref, $newhash, $what_log, $what_msg) = @_;
+    my @cmd = (@git, qw(update-ref -m), $what_log, $dstref, $newhash);
+    runcmd @cmd;
+    check_gitattrs($newhash, "source tree");
+
+    progress "dgit: import-dsc: $what_msg";
+}
+
 sub cmd_import_dsc {
     my $needsig = 0;
 
@@ -6112,6 +6267,12 @@ sub cmd_import_dsc {
 
     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";
@@ -6135,10 +6296,9 @@ END
                fail "Not fast forward to $dsc_hash";
            }
        }
-       @cmd = (@git, qw(update-ref -m), "dgit import-dsc (Dgit): $info",
-               $dstbranch, $dsc_hash);
-       runcmd @cmd;
-       progress "dgit: import-dsc updated git ref $dstbranch";
+       import_dsc_result $dstbranch, $dsc_hash,
+           "dgit import-dsc (Dgit): $info",
+           "updated git ref $dstbranch";
        return 0;
     }
 
@@ -6149,13 +6309,14 @@ Specify  +$specbranch to overwrite, discarding existing history
 END
        if $oldhash && !$force;
 
-    notpushing();
-
     my @dfi = dsc_files_info();
     foreach my $fi (@dfi) {
        my $f = $fi->{Filename};
        my $here = "../$f";
-       next if lstat $here;
+       if (lstat $here) {
+           next if stat $here;
+           fail "lstat $here works but stat gives $! !";
+       }
        fail "stat $here: $!" unless $! == ENOENT;
        my $there = $dscfn;
        if ($dscfn =~ m#^(?:\./+)?\.\./+#) {
@@ -6166,8 +6327,10 @@ END
            fail "cannot import $dscfn which seems to be inside working tree!";
        }
        $there =~ s#/+[^/]+$## or
-           fail "cannot import $dscfn which seems to not have a basename";
+           fail "import $dscfn requires ../$f, but it does not exist";
        $there .= "/$f";
+       my $test = $there =~ m{^/} ? $there : "../$there";
+       stat $test or fail "import $dscfn requires $test, but: $!";
        symlink $there, $here or fail "symlink $there to $here: $!";
        progress "made symlink $here -> $there";
 #      print STDERR Dumper($fi);
@@ -6200,12 +6363,14 @@ END
        }
     }
 
-    my @cmd = (@git, qw(update-ref -m), "dgit import-dsc: $info",
-              $dstbranch, $newhash);
-    runcmd @cmd;
-    progress "dgit: import-dsc results are in in git ref $dstbranch";
+    import_dsc_result $dstbranch, $newhash,
+       "dgit import-dsc: $info",
+       "results are in in git ref $dstbranch";
 }
 
+sub pre_archive_api_query () {
+    not_necessarily_a_tree();
+}
 sub cmd_archive_api_query {
     badusage "need only 1 subpath argument" unless @ARGV==1;
     my ($subpath) = @ARGV;
@@ -6215,37 +6380,56 @@ sub cmd_archive_api_query {
     exec @cmd or fail "exec curl: $!\n";
 }
 
+sub repos_server_url () {
+    $package = '_dgit-repos-server';
+    local $access_forpush = 1;
+    local $isuite = 'DGIT-REPOS-SERVER';
+    my $url = access_giturl();
+}    
+
+sub pre_clone_dgit_repos_server () {
+    not_necessarily_a_tree();
+}
 sub cmd_clone_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);
+    my $url = repos_server_url();
+    my @cmd = (@git, qw(clone), $url, $destdir);
     debugcmd ">",@cmd;
     exec @cmd or fail "exec git clone: $!\n";
 }
 
+sub pre_print_dgit_repos_server_source_url () {
+    not_necessarily_a_tree();
+}
 sub cmd_print_dgit_repos_server_source_url {
     badusage "no arguments allowed to dgit print-dgit-repos-server-source-url"
        if @ARGV;
-    $package = '_dgit-repos-server';
-    local $access_forpush = 0;
-    my $url = access_giturl();
+    my $url = repos_server_url();
     print $url, "\n" or die $!;
 }
 
 sub cmd_setup_mergechangelogs {
     badusage "no arguments allowed to dgit setup-mergechangelogs" if @ARGV;
+    local $isuite = 'DGIT-SETUP-TREE';
     setup_mergechangelogs(1);
 }
 
 sub cmd_setup_useremail {
     badusage "no arguments allowed to dgit setup-useremail" if @ARGV;
+    local $isuite = 'DGIT-SETUP-TREE';
     setup_useremail(1);
 }
 
+sub cmd_setup_gitattributes {
+    badusage "no arguments allowed to dgit setup-useremail" if @ARGV;
+    local $isuite = 'DGIT-SETUP-TREE';
+    setup_gitattrs(1);
+}
+
 sub cmd_setup_new_tree {
     badusage "no arguments allowed to dgit setup-tree" if @ARGV;
+    local $isuite = 'DGIT-SETUP-TREE';
     setup_new_tree();
 }
 
@@ -6257,7 +6441,9 @@ sub cmd_version {
 }
 
 our (%valopts_long, %valopts_short);
+our (%funcopts_long);
 our @rvalopts;
+our (@modeopt_cfgs);
 
 sub defvalopt ($$$$) {
     my ($long,$short,$val_re,$how) = @_;
@@ -6293,6 +6479,26 @@ defvalopt '--initiator-tempdir','','.*', sub {
        " 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;
 
@@ -6375,15 +6581,6 @@ sub parseopts () {
            } 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, $_;
@@ -6422,6 +6619,9 @@ sub parseopts () {
            } 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 \`$_'";
            }
@@ -6554,12 +6754,14 @@ sub parseopts_late_defaults () {
        $quilt_mode = $1;
     }
 
-    if (!defined $dodep14tag) {
+    foreach my $moc (@modeopt_cfgs) {
        local $access_forpush;
-       $dodep14tag = access_cfg('dep14tag', 'RETURN-UNDEF') // 'want';
-       $dodep14tag =~ m/^($dodep14tag_re)$/ 
-           or badcfg "unknown dep14tag setting \`$dodep14tag'";
-       $dodep14tag = $1;
+       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();
@@ -6581,7 +6783,6 @@ if ($ENV{$fakeeditorenv}) {
 
 parseopts();
 check_env_sanity();
-git_slurp_config();
 
 print STDERR "DRY RUN ONLY\n" if $dryrun_level > 1;
 print STDERR "DAMP RUN - WILL MAKE LOCAL (UNSIGNED) CHANGES\n"
@@ -6590,12 +6791,14 @@ if (!@ARGV) {
     print STDERR $helpmsg or die $!;
     exit 8;
 }
-my $cmd = shift @ARGV;
+$cmd = $subcommand = shift @ARGV;
 $cmd =~ y/-/_/;
 
 my $pre_fn = ${*::}{"pre_$cmd"};
 $pre_fn->() if $pre_fn;
 
+git_slurp_config();
+
 my $fn = ${*::}{"cmd_$cmd"};
 $fn or badusage "unknown operation $cmd";
 $fn->();