git-debrebase: walk: Reintroduce the local $read_tree_upstream sub

[dgit.git] / dgit

diff --git a/dgit b/dgit
index aaafefb736a05d88258e7c5d4f0023c174f37cf3..51cac14844f120eba0b52ac8883dfa79891bdb30 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -2,8 +2,8 @@
 # dgit
 # Integration between git and Debian-style archives
 #
 # dgit
 # Integration between git and Debian-style archives
 #

-# Copyright (C)2013-2017 Ian Jackson
-# Copyright (C)2017 Sean Whitton
+# Copyright (C)2013-2018 Ian Jackson
+# Copyright (C)2017-2018 Sean Whitton

 #
 # This program is free software: you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
 #
 # This program is free software: you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by


@@ -18,6 +18,9 @@
 # You should have received a copy of the GNU General Public License
 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 # You should have received a copy of the GNU General Public License
 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
 

+END { $? = $Debian::Dgit::ExitStatus::desired // -1; };
+use Debian::Dgit::ExitStatus;
+

 use strict;
 
 use Debian::Dgit qw(:DEFAULT :playground);
 use strict;
 
 use Debian::Dgit qw(:DEFAULT :playground);


@@ -60,9 +63,10 @@ our @ropts;
 our $sign = 1;
 our $dryrun_level = 0;
 our $changesfile;
 our $sign = 1;
 our $dryrun_level = 0;
 our $changesfile;

-our $buildproductsdir = '..';
+our $buildproductsdir;
+our $bpd_glob;

 our $new_package = 0;
 our $new_package = 0;

-our $ignoredirty = 0;
+our $includedirty = 0;

 our $rmonerror = 1;
 our @deliberatelies;
 our %previously;
 our $rmonerror = 1;
 our @deliberatelies;
 our %previously;


@@ -74,7 +78,7 @@ 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 $split_brain_save;
+our %internal_object_save;

 our $we_are_responder;
 our $we_are_initiator;
 our $initiator_tempdir;
 our $we_are_responder;
 our $we_are_initiator;
 our $initiator_tempdir;


@@ -87,6 +91,7 @@ our $chase_dsc_distro=1;
 our %forceopts = map { $_=>0 }
     qw(unrepresentable unsupported-source-format
        dsc-changes-mismatch changes-origs-exactly
 our %forceopts = map { $_=>0 }
     qw(unrepresentable unsupported-source-format
        dsc-changes-mismatch changes-origs-exactly

+       uploading-binaries uploading-source-only

        import-gitapply-absurd
        import-gitapply-no-absurd
        import-dsc-with-dgit-field);
        import-gitapply-absurd
        import-gitapply-no-absurd
        import-dsc-with-dgit-field);


@@ -95,9 +100,6 @@ our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
 
 our $suite_re = '[-+.0-9a-z]+';
 our $cleanmode_re = 'dpkg-source(?:-d)?|git|git-ff|check|none';
 
 our $suite_re = '[-+.0-9a-z]+';
 our $cleanmode_re = 'dpkg-source(?:-d)?|git|git-ff|check|none';

-our $orig_f_comp_re = 'orig(?:-[-0-9a-z]+)?';
-our $orig_f_sig_re = '\\.(?:asc|gpg|pgp)';
-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';


@@ -114,6 +116,7 @@ our (@gpg) = qw(gpg);
 our (@sbuild) = qw(sbuild);
 our (@ssh) = 'ssh';
 our (@dgit) = qw(dgit);
 our (@sbuild) = qw(sbuild);
 our (@ssh) = 'ssh';
 our (@dgit) = qw(dgit);

+our (@git_debrebase) = qw(git-debrebase);

 our (@aptget) = qw(apt-get);
 our (@aptcache) = qw(apt-cache);
 our (@dpkgbuildpackage) = (qw(dpkg-buildpackage), @dpkg_source_ignores);
 our (@aptget) = qw(apt-get);
 our (@aptcache) = qw(apt-cache);
 our (@dpkgbuildpackage) = (qw(dpkg-buildpackage), @dpkg_source_ignores);


@@ -123,6 +126,8 @@ our (@mergechanges) = qw(mergechanges -f);
 our (@gbp_build) = ('');
 our (@gbp_pq) = ('gbp pq');
 our (@changesopts) = ('');
 our (@gbp_build) = ('');
 our (@gbp_pq) = ('gbp pq');
 our (@changesopts) = ('');

+our (@pbuilder) = ("sudo -E pbuilder");
+our (@cowbuilder) = ("sudo -E cowbuilder");

 
 our %opts_opt_map = ('dget' => \@dget, # accept for compatibility
                     'curl' => \@curl,
 
 our %opts_opt_map = ('dget' => \@dget, # accept for compatibility
                     'curl' => \@curl,


@@ -133,6 +138,7 @@ our %opts_opt_map = ('dget' => \@dget, # accept for compatibility
                      'ssh' => \@ssh,
                      'dgit' => \@dgit,
                      'git' => \@git,
                      'ssh' => \@ssh,
                      'dgit' => \@dgit,
                      'git' => \@git,

+                    'git-debrebase' => \@git_debrebase,

                      'apt-get' => \@aptget,
                      'apt-cache' => \@aptcache,
                      'dpkg-source' => \@dpkgsource,
                      'apt-get' => \@aptget,
                      'apt-cache' => \@aptcache,
                      'dpkg-source' => \@dpkgsource,


@@ -141,7 +147,9 @@ our %opts_opt_map = ('dget' => \@dget, # accept for compatibility
                      'gbp-build' => \@gbp_build,
                      'gbp-pq' => \@gbp_pq,
                      'ch' => \@changesopts,
                      'gbp-build' => \@gbp_build,
                      'gbp-pq' => \@gbp_pq,
                      'ch' => \@changesopts,

-                     'mergechanges' => \@mergechanges);
+                     'mergechanges' => \@mergechanges,
+                     'pbuilder' => \@pbuilder,
+                     'cowbuilder' => \@cowbuilder);

 
 our %opts_opt_cmdonly = ('gpg' => 1, 'git' => 1);
 our %opts_cfg_insertpos = map {
 
 our %opts_opt_cmdonly = ('gpg' => 1, 'git' => 1);
 our %opts_cfg_insertpos = map {


@@ -159,7 +167,6 @@ our $keyid;
 autoflush STDOUT 1;
 
 our $supplementary_message = '';
 autoflush STDOUT 1;
 
 our $supplementary_message = '';

-our $need_split_build_invocation = 0;

 our $split_brain = 0;
 
 END {
 our $split_brain = 0;
 
 END {


@@ -183,11 +190,6 @@ sub debiantag ($$) {
     return $tagformatfn->($v, $distro);
 }
 
     return $tagformatfn->($v, $distro);
 }
 

-sub debiantag_maintview ($$) { 
-    my ($v,$distro) = @_;
-    return "$distro/".dep14_version_mangle $v;
-}
-

 sub madformat ($) { $_[0] eq '3.0 (quilt)' }
 
 sub lbranch () { return "$branchprefix/$csuite"; }
 sub madformat ($) { $_[0] eq '3.0 (quilt)' }
 
 sub lbranch () { return "$branchprefix/$csuite"; }


@@ -196,15 +198,13 @@ 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 stripepoch ($) {
-    my ($vsn) = @_;
-    $vsn =~ s/^\d+\://;
-    return $vsn;
-}
-

 sub srcfn ($$) {
 sub srcfn ($$) {

-    my ($vsn,$sfx) = @_;
-    return "${package}_".(stripepoch $vsn).$sfx
+    my ($vsn, $sfx) = @_;
+    return &source_file_leafname($package, $vsn, $sfx);
+}
+sub is_orig_file_of_vsn ($$) {
+    my ($f, $upstreamvsn) = @_;
+    return is_orig_file_of_p_v($f, $package, $upstreamvsn);

 }
 
 sub dscfn ($) {
 }
 
 sub dscfn ($) {


@@ -217,12 +217,6 @@ sub changespat ($;$) {
     return "${package}_".(stripepoch $vsn)."_".($arch//'*').".changes";
 }
 
     return "${package}_".(stripepoch $vsn)."_".($arch//'*').".changes";
 }
 

-sub upstreamversion ($) {
-    my ($vsn) = @_;
-    $vsn =~ s/-[^-]+$//;
-    return $vsn;
-}
-

 our $us = 'dgit';
 initdebug('');
 
 our $us = 'dgit';
 initdebug('');
 


@@ -236,7 +230,7 @@ END {
     }
 };
 
     }
 };
 

-sub badcfg { print STDERR "$us: invalid configuration: @_\n"; exit 12; }
+sub badcfg { print STDERR "$us: invalid configuration: @_\n"; finish 12; }

 
 sub forceable_fail ($$) {
     my ($forceoptsl, $msg) = @_;
 
 sub forceable_fail ($$) {
     my ($forceoptsl, $msg) = @_;


@@ -254,7 +248,7 @@ sub forceing ($) {
 
 sub no_such_package () {
     print STDERR "$us: package $package does not exist in suite $isuite\n";
 
 sub no_such_package () {
     print STDERR "$us: package $package does not exist in suite $isuite\n";

-    exit 4;
+    finish 4;

 }
 
 sub deliberately ($) {
 }
 
 sub deliberately ($) {


@@ -273,20 +267,54 @@ sub quiltmode_splitbrain () {
 }
 
 sub opts_opt_multi_cmd {
 }
 
 sub opts_opt_multi_cmd {

+    my $extra = shift;

     my @cmd;
     push @cmd, split /\s+/, shift @_;
     my @cmd;
     push @cmd, split /\s+/, shift @_;

+    push @cmd, @$extra;

     push @cmd, @_;
     @cmd;
 }
 
 sub gbp_pq {
     push @cmd, @_;
     @cmd;
 }
 
 sub gbp_pq {

-    return opts_opt_multi_cmd @gbp_pq;
+    return opts_opt_multi_cmd [], @gbp_pq;

 }
 
 sub dgit_privdir () {
     our $dgit_privdir_made //= ensure_a_playground 'dgit';
 }
 
 }
 
 sub dgit_privdir () {
     our $dgit_privdir_made //= ensure_a_playground 'dgit';
 }
 

+sub bpd_abs () {
+    my $r = $buildproductsdir;
+    $r = "$maindir/$r" unless $r =~ m{^/};
+    return $r;
+}
+
+sub branch_gdr_info ($$) {
+    my ($symref, $head) = @_;
+    my ($status, $msg, $current, $ffq_prev, $gdrlast) =
+       gdr_ffq_prev_branchinfo($symref);
+    return () unless $status eq 'branch';
+    $ffq_prev = git_get_ref $ffq_prev;
+    $gdrlast  = git_get_ref $gdrlast;
+    $gdrlast &&= is_fast_fwd $gdrlast, $head;
+    return ($ffq_prev, $gdrlast);
+}
+
+sub branch_is_gdr ($$) {
+    my ($symref, $head) = @_;
+    my ($ffq_prev, $gdrlast) = branch_gdr_info($symref, $head);
+    return 0 unless $ffq_prev || $gdrlast;
+    return 1;
+}
+
+sub branch_is_gdr_unstitched_ff ($$$) {
+    my ($symref, $head, $ancestor) = @_;
+    my ($ffq_prev, $gdrlast) = branch_gdr_info($symref, $head);
+    return 0 unless $ffq_prev;
+    return 0 unless is_fast_fwd $ancestor, $ffq_prev;
+    return 1;
+}
+

 #---------- remote protocol support, common ----------
 
 # remote push initiator/responder protocol:
 #---------- remote protocol support, common ----------
 
 # remote push initiator/responder protocol:


@@ -530,17 +558,13 @@ sub runcmd_ordryrun_local {
     }
 }
 
     }
 }
 

-sub shell_cmd {
-    my ($first_shell, @cmd) = @_;
-    return qw(sh -ec), $first_shell.'; exec "$@"', 'x', @cmd;
-}
-

 our $helpmsg = <<END;
 main usages:
   dgit [dgit-opts] clone [dgit-opts] package [suite] [./dir|/dir]
   dgit [dgit-opts] fetch|pull [dgit-opts] [suite]
   dgit [dgit-opts] build [dpkg-buildpackage-opts]
   dgit [dgit-opts] sbuild [sbuild-opts]
 our $helpmsg = <<END;
 main usages:
   dgit [dgit-opts] clone [dgit-opts] package [suite] [./dir|/dir]
   dgit [dgit-opts] fetch|pull [dgit-opts] [suite]
   dgit [dgit-opts] build [dpkg-buildpackage-opts]
   dgit [dgit-opts] sbuild [sbuild-opts]

+  dgit [dgit-opts] pbuilder|cowbuilder [debbuildopts]

   dgit [dgit-opts] push [dgit-opts] [suite]
   dgit [dgit-opts] push-source [dgit-opts] [suite]
   dgit [dgit-opts] rpush build-host:build-dir ...
   dgit [dgit-opts] push [dgit-opts] [suite]
   dgit [dgit-opts] push-source [dgit-opts] [suite]
   dgit [dgit-opts] rpush build-host:build-dir ...


@@ -559,7 +583,7 @@ END
 
 sub badusage {
     print STDERR "$us: @_\n", $helpmsg or die $!;
 
 sub badusage {
     print STDERR "$us: @_\n", $helpmsg or die $!;

-    exit 8;
+    finish 8;

 }
 
 sub nextarg {
 }
 
 sub nextarg {


@@ -572,7 +596,7 @@ sub pre_help () {
 }
 sub cmd_help () {
     print $helpmsg or die $!;
 }
 sub cmd_help () {
     print $helpmsg or die $!;

-    exit 0;
+    finish 0;

 }
 
 our $td = $ENV{DGIT_TEST_DUMMY_DIR} || "DGIT_TEST_DUMMY_DIR-unset";
 }
 
 our $td = $ENV{DGIT_TEST_DUMMY_DIR} || "DGIT_TEST_DUMMY_DIR-unset";


@@ -588,9 +612,11 @@ 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.default.source-only-uploads' => 'ok',

               'dgit.dsc-url-proto-ok.http'    => 'true',
               'dgit.dsc-url-proto-ok.https'   => 'true',
               'dgit.dsc-url-proto-ok.git'     => 'true',
               'dgit.dsc-url-proto-ok.http'    => 'true',
               'dgit.dsc-url-proto-ok.https'   => 'true',
               'dgit.dsc-url-proto-ok.git'     => 'true',

+              'dgit.vcs-git.suites',          => 'sid', # ;-separated

               '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"
               '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"


@@ -601,6 +627,7 @@ our %defcfg = ('dgit.default.distro' => 'debian',
               'dgit-distro.debian.git-check' => 'url',
               'dgit-distro.debian.git-check-suffix' => '/info/refs',
               'dgit-distro.debian.new-private-pushers' => 't',
               'dgit-distro.debian.git-check' => 'url',
               'dgit-distro.debian.git-check-suffix' => '/info/refs',
               'dgit-distro.debian.new-private-pushers' => 't',

+              'dgit-distro.debian.source-only-uploads' => 'not-wholly-new',

               'dgit-distro.debian/push.git-url' => '',
               'dgit-distro.debian/push.git-host' => 'push.dgit.debian.org',
               'dgit-distro.debian/push.git-user-force' => 'dgit',
               'dgit-distro.debian/push.git-url' => '',
               'dgit-distro.debian/push.git-host' => 'push.dgit.debian.org',
               'dgit-distro.debian/push.git-user-force' => 'dgit',


@@ -786,7 +813,8 @@ sub access_forpush () {
 }
 
 sub pushing () {
 }
 
 sub pushing () {

-    die "$access_forpush ?" if ($access_forpush // 1) ne 1;
+    confess 'internal error '.Dumper($access_forpush)," ?" if
+       defined $access_forpush and !$access_forpush;

     badcfg "pushing but distro is configured readonly"
        if access_forpush_config() eq '0';
     $access_forpush = 1;
     badcfg "pushing but distro is configured readonly"
        if access_forpush_config() eq '0';
     $access_forpush = 1;


@@ -932,59 +960,6 @@ sub access_giturl (;$) {
     return "$url/$package$suffix";
 }             
 
     return "$url/$package$suffix";
 }             
 

-sub parsecontrolfh ($$;$) {
-    my ($fh, $desc, $allowsigned) = @_;
-    our $dpkgcontrolhash_noissigned;
-    my $c;
-    for (;;) {
-       my %opts = ('name' => $desc);
-       $opts{allow_pgp}= $allowsigned || !$dpkgcontrolhash_noissigned;
-       $c = Dpkg::Control::Hash->new(%opts);
-       $c->parse($fh,$desc) or die "parsing of $desc failed";
-       last if $allowsigned;
-       last if $dpkgcontrolhash_noissigned;
-       my $issigned= $c->get_option('is_pgp_signed');
-       if (!defined $issigned) {
-           $dpkgcontrolhash_noissigned= 1;
-           seek $fh, 0,0 or die "seek $desc: $!";
-       } elsif ($issigned) {
-           fail "control file $desc is (already) PGP-signed. ".
-               " Note that dgit push needs to modify the .dsc and then".
-               " do the signature itself";
-       } else {
-           last;
-       }
-    }
-    return $c;
-}
-
-sub parsecontrol {
-    my ($file, $desc, $allowsigned) = @_;
-    my $fh = new IO::Handle;
-    open $fh, '<', $file or die "$file: $!";
-    my $c = parsecontrolfh($fh,$desc,$allowsigned);
-    $fh->error and die $!;
-    close $fh;
-    return $c;
-}
-
-sub getfield ($$) {
-    my ($dctrl,$field) = @_;
-    my $v = $dctrl->{$field};
-    return $v if defined $v;
-    fail "missing field $field in ".$dctrl->get_option('name');
-}
-
-sub parsechangelog {
-    my $c = Dpkg::Control::Hash->new(name => 'parsed changelog');
-    my $p = new IO::Handle;
-    my @cmd = (qw(dpkg-parsechangelog), @_);
-    open $p, '-|', @cmd or die $!;
-    $c->parse($p);
-    $?=0; $!=0; close $p or failedcmd @cmd;
-    return $c;
-}
-

 sub commit_getclogp ($) {
     # Returns the parsed changelog hashref for a particular commit
     my ($objid) = @_;
 sub commit_getclogp ($) {
     # Returns the parsed changelog hashref for a particular commit
     my ($objid) = @_;


@@ -1103,7 +1078,7 @@ sub canonicalise_suite_ftpmasterapi {
        } qw(codename name);
        push @matched, $entry;
     }
        } qw(codename name);
        push @matched, $entry;
     }

-    fail "unknown suite $isuite" unless @matched;
+    fail "unknown suite $isuite, maybe -d would help" unless @matched;

     my $cn;
     eval {
        @matched==1 or die "multiple matches for suite $isuite\n";
     my $cn;
     eval {
        @matched==1 or die "multiple matches for suite $isuite\n";


@@ -1152,6 +1127,12 @@ sub file_in_archive_ftpmasterapi {
     my $info = api_query($data, "file_in_archive/$pat", 1);
 }
 
     my $info = api_query($data, "file_in_archive/$pat", 1);
 }
 

+sub package_not_wholly_new_ftpmasterapi {
+    my ($proto,$data,$pkg) = @_;
+    my $info = api_query($data,"madison?package=${pkg}&f=json");
+    return !!@$info;
+}
+

 #---------- `aptget' archive query method ----------
 
 our $aptget_base;
 #---------- `aptget' archive query method ----------
 
 our $aptget_base;


@@ -1259,7 +1240,14 @@ END
     }
     my @inreleasefiles = grep { m#/InRelease$# } @releasefiles;
     @releasefiles = @inreleasefiles if @inreleasefiles;
     }
     my @inreleasefiles = grep { m#/InRelease$# } @releasefiles;
     @releasefiles = @inreleasefiles if @inreleasefiles;

-    die "apt updated wrong number of Release files (@releasefiles), erk"
+    if (!@releasefiles) {
+       fail <<END;
+apt seemed to not to update dgit's cached Release files for $isuite.
+(Perhaps $cache
+ is on a filesystem mounted `noatime'; if so, please use `relatime'.)
+END
+    }
+    die "apt updated too many Release files (@releasefiles), erk"

        unless @releasefiles == 1;
 
     ($aptget_releasefile) = @releasefiles;
        unless @releasefiles == 1;
 
     ($aptget_releasefile) = @releasefiles;


@@ -1315,34 +1303,55 @@ sub archive_query_aptget {
 }
 
 sub file_in_archive_aptget () { return undef; }
 }
 
 sub file_in_archive_aptget () { return undef; }

+sub package_not_wholly_new_aptget () { return undef; }

 
 #---------- `dummyapicat' archive query method ----------
 
 sub archive_query_dummycatapi { archive_query_ftpmasterapi @_; }
 sub canonicalise_suite_dummycatapi { canonicalise_suite_ftpmasterapi @_; }
 
 
 #---------- `dummyapicat' archive query method ----------
 
 sub archive_query_dummycatapi { archive_query_ftpmasterapi @_; }
 sub canonicalise_suite_dummycatapi { canonicalise_suite_ftpmasterapi @_; }
 

-sub file_in_archive_dummycatapi ($$$) {
-    my ($proto,$data,$filename) = @_;
+sub dummycatapi_run_in_mirror ($@) {
+    # runs $fn with FIA open onto rune
+    my ($rune, $argl, $fn) = @_;
+

     my $mirror = access_cfg('mirror');
     $mirror =~ s#^file://#/# or die "$mirror ?";
     my $mirror = access_cfg('mirror');
     $mirror =~ s#^file://#/# or die "$mirror ?";

-    my @out;
-    my @cmd = (qw(sh -ec), '
-            cd "$1"
-            find -name "$2" -print0 |
-            xargs -0r sha256sum
-        ', qw(x), $mirror, $filename);
+    my @cmd = (qw(sh -ec), 'cd "$1"; shift'."\n".$rune,
+              qw(x), $mirror, @$argl);

     debugcmd "-|", @cmd;
     open FIA, "-|", @cmd or die $!;
     debugcmd "-|", @cmd;
     open FIA, "-|", @cmd or die $!;

-    while (<FIA>) {
-       chomp or die;
-       printdebug "| $_\n";
-       m/^(\w+)  (\S+)$/ or die "$_ ?";
-       push @out, { sha256sum => $1, filename => $2 };
-    }
-    close FIA or die failedcmd @cmd;
+    my $r = $fn->();
+    close FIA or ($!==0 && $?==141) or die failedcmd @cmd;
+    return $r;
+}
+
+sub file_in_archive_dummycatapi ($$$) {
+    my ($proto,$data,$filename) = @_;
+    my @out;
+    dummycatapi_run_in_mirror '
+            find -name "$1" -print0 |
+            xargs -0r sha256sum
+    ', [$filename], sub {
+       while (<FIA>) {
+           chomp or die;
+           printdebug "| $_\n";
+           m/^(\w+)  (\S+)$/ or die "$_ ?";
+           push @out, { sha256sum => $1, filename => $2 };
+       }
+    };

     return \@out;
 }
 
     return \@out;
 }
 

+sub package_not_wholly_new_dummycatapi {
+    my ($proto,$data,$pkg) = @_;
+    dummycatapi_run_in_mirror "
+            find -name ${pkg}_*.dsc
+    ", [], sub {
+       local $/ = undef;
+       !!<FIA>;
+    };
+}
+

 #---------- `madison' archive query method ----------
 
 sub archive_query_madison {
 #---------- `madison' archive query method ----------
 
 sub archive_query_madison {


@@ -1393,6 +1402,7 @@ sub canonicalise_suite_madison {
 }
 
 sub file_in_archive_madison { return undef; }
 }
 
 sub file_in_archive_madison { return undef; }

+sub package_not_wholly_new_madison { return undef; }

 
 #---------- `sshpsql' archive query method ----------
 
 
 #---------- `sshpsql' archive query method ----------
 


@@ -1470,6 +1480,7 @@ END
 }
 
 sub file_in_archive_sshpsql ($$$) { return undef; }
 }
 
 sub file_in_archive_sshpsql ($$$) { return undef; }

+sub package_not_wholly_new_sshpsql ($$$) { return undef; }

 
 #---------- `dummycat' archive query method ----------
 
 
 #---------- `dummycat' archive query method ----------
 


@@ -1514,6 +1525,7 @@ sub archive_query_dummycat ($$) {
 }
 
 sub file_in_archive_dummycat () { return undef; }
 }
 
 sub file_in_archive_dummycat () { return undef; }

+sub package_not_wholly_new_dummycat () { return undef; }

 
 #---------- tag format handling ----------
 
 
 #---------- tag format handling ----------
 


@@ -1844,13 +1856,6 @@ sub is_orig_file_in_dsc ($$) {
     return 1;
 }
 
     return 1;
 }
 

-sub is_orig_file_of_vsn ($$) {
-    my ($f, $upstreamvsn) = @_;
-    my $base = srcfn $upstreamvsn, '';
-    return 0 unless $f =~ m/^\Q$base\E\.$orig_f_tail_re$/;
-    return 1;
-}
-

 # This function determines whether a .changes file is source-only from
 # the point of view of dak.  Thus, it permits *_source.buildinfo
 # files.
 # This function determines whether a .changes file is source-only from
 # the point of view of dak.  Thus, it permits *_source.buildinfo
 # files.


@@ -1948,12 +1953,12 @@ END
            if ($found_same) {
                # in archive, delete from .changes if it's there
                $changed{$file} = "removed" if
            if ($found_same) {
                # in archive, delete from .changes if it's there
                $changed{$file} = "removed" if

-                   $changes->{$fname} =~ s/^.* \Q$file\E$(?:)\n//m;
-           } elsif ($changes->{$fname} =~ m/^.* \Q$file\E$(?:)\n/m) {
+                   $changes->{$fname} =~ s/\n.* \Q$file\E$(?:)$//m;
+           } elsif ($changes->{$fname} =~ m/^.* \Q$file\E$(?:)$/m) {

                # not in archive, but it's here in the .changes
            } else {
                my $dsc_data = getfield $dsc, $fname;
                # not in archive, but it's here in the .changes
            } else {
                my $dsc_data = getfield $dsc, $fname;

-               $dsc_data =~ m/^(.* \Q$file\E$)\n/m or die "$dsc_data $file ?";
+               $dsc_data =~ m/^(.* \Q$file\E$)$/m or die "$dsc_data $file ?";

                my $extra = $1;
                $extra =~ s/ \d+ /$&$placementinfo /
                    or die "$fname $extra >$dsc_data< ?"
                my $extra = $1;
                $extra =~ s/ \d+ /$&$placementinfo /
                    or die "$fname $extra >$dsc_data< ?"


@@ -2103,7 +2108,7 @@ 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 = "$maindir/../$f";
+       my $upper_f = (bpd_abs()."/$f");

 
        printdebug "considering reusing $f: ";
 
 
        printdebug "considering reusing $f: ";
 


@@ -2111,12 +2116,12 @@ sub generate_commits_from_dsc () {
            printdebug "linked (using ...,fetch).\n";
        } elsif ((printdebug "($!) "),
                 $! != ENOENT) {
            printdebug "linked (using ...,fetch).\n";
        } elsif ((printdebug "($!) "),
                 $! != ENOENT) {

-           fail "accessing ../$f,fetch: $!";
+           fail "accessing $buildproductsdir/$f,fetch: $!";

        } elsif (link_ltarget $upper_f, $f) {
            printdebug "linked.\n";
        } elsif ((printdebug "($!) "),
                 $! != ENOENT) {
        } elsif (link_ltarget $upper_f, $f) {
            printdebug "linked.\n";
        } elsif ((printdebug "($!) "),
                 $! != ENOENT) {

-           fail "accessing ../$f: $!";
+           fail "accessing $buildproductsdir/$f: $!";

        } else {
            printdebug "absent.\n";
        }
        } else {
            printdebug "absent.\n";
        }


@@ -2131,14 +2136,14 @@ sub generate_commits_from_dsc () {
            printdebug "linked.\n";
        } elsif ((printdebug "($!) "),
                 $! != EEXIST) {
            printdebug "linked.\n";
        } elsif ((printdebug "($!) "),
                 $! != EEXIST) {

-           fail "saving ../$f: $!";
+           fail "saving $buildproductsdir/$f: $!";

        } elsif (!$refetched) {
            printdebug "no need.\n";
        } elsif (link $f, "$upper_f,fetch") {
            printdebug "linked (using ...,fetch).\n";
        } elsif ((printdebug "($!) "),
                 $! != EEXIST) {
        } elsif (!$refetched) {
            printdebug "no need.\n";
        } elsif (link $f, "$upper_f,fetch") {
            printdebug "linked (using ...,fetch).\n";
        } elsif ((printdebug "($!) "),
                 $! != EEXIST) {

-           fail "saving ../$f,fetch: $!";
+           fail "saving $buildproductsdir/$f,fetch: $!";

        } else {
            printdebug "cannot.\n";
        }
        } else {
            printdebug "cannot.\n";
        }


@@ -2282,22 +2287,14 @@ sub generate_commits_from_dsc () {
     }
 
     my @clogcmd = qw(dpkg-parsechangelog --format rfc822 --all);
     }
 
     my @clogcmd = qw(dpkg-parsechangelog --format rfc822 --all);

-    debugcmd "|",@clogcmd;
-    open CLOGS, "-|", @clogcmd or die $!;
-

     my $clogp;
     my $r1clogp;
 
     printdebug "import clog search...\n";
     my $clogp;
     my $r1clogp;
 
     printdebug "import clog search...\n";

+    parsechangelog_loop \@clogcmd, "package changelog", sub {
+       my ($thisstanza, $desc) = @_;
+       no warnings qw(exiting);

 
 

-    for (;;) {
-       my $stanzatext = do { local $/=""; <CLOGS>; };
-       printdebug "import clogp ".Dumper($stanzatext) if $debuglevel>1;
-       last if !defined $stanzatext;
-
-       my $desc = "package changelog, entry no.$.";
-       open my $stanzafh, "<", \$stanzatext or die;
-       my $thisstanza = parsecontrolfh $stanzafh, $desc, 1;

        $clogp //= $thisstanza;
 
        printdebug "import clog $thisstanza->{version} $desc...\n";
        $clogp //= $thisstanza;
 
        printdebug "import clog $thisstanza->{version} $desc...\n";


@@ -2323,7 +2320,7 @@ sub generate_commits_from_dsc () {
        # version).  Then it remains to choose between the physically
        # last entry in the file, and the one with the lowest version
        # number.  If these are not the same, we guess that the
        # version).  Then it remains to choose between the physically
        # last entry in the file, and the one with the lowest version
        # number.  If these are not the same, we guess that the

-       # versions were created in a non-monotic order rather than
+       # versions were created in a non-monotonic order rather than

        # that the changelog entries have been misordered.
 
        printdebug "import clog $thisstanza->{version} vs $upstreamv...\n";
        # that the changelog entries have been misordered.
 
        printdebug "import clog $thisstanza->{version} vs $upstreamv...\n";


@@ -2332,9 +2329,7 @@ sub generate_commits_from_dsc () {
        $r1clogp = $thisstanza;
 
        printdebug "import clog $r1clogp->{version} becomes r1\n";
        $r1clogp = $thisstanza;
 
        printdebug "import clog $r1clogp->{version} becomes r1\n";

-    }
-    die $! if CLOGS->error;
-    close CLOGS or $?==SIGPIPE or failedcmd @clogcmd;
+    };

 
     $clogp or fail "package changelog has no entries!";
 
 
     $clogp or fail "package changelog has no entries!";
 


@@ -2575,7 +2570,7 @@ sub ensure_we_have_orig () {
     foreach my $fi (@dfi) {
        my $f = $fi->{Filename};
        next unless is_orig_file_in_dsc($f, \@dfi);
     foreach my $fi (@dfi) {
        my $f = $fi->{Filename};
        next unless is_orig_file_in_dsc($f, \@dfi);

-       complete_file_from_dsc('..', $fi)
+       complete_file_from_dsc($buildproductsdir, $fi)

            or next;
     }
 }
            or next;
     }
 }


@@ -2731,6 +2726,11 @@ END
            my $want = $wantr{$rrefname};
            next if $got eq $want;
            if (!defined $objgot{$want}) {
            my $want = $wantr{$rrefname};
            next if $got eq $want;
            if (!defined $objgot{$want}) {

+               fail <<END unless act_local();
+--dry-run specified but we actually wanted the results of git fetch,
+so this is not going to work.  Try running dgit fetch first,
+or using --damp-run instead of --dry-run.
+END

                print STDERR <<END;
 warning: git ls-remote suggests we want $lrefname
 warning:  and it should refer to $want
                print STDERR <<END;
 warning: git ls-remote suggests we want $lrefname
 warning:  and it should refer to $want


@@ -2819,15 +2819,14 @@ sub mergeinfo_version ($) {
 
 sub fetch_from_archive_record_1 ($) {
     my ($hash) = @_;
 
 sub fetch_from_archive_record_1 ($) {
     my ($hash) = @_;

-    runcmd @git, qw(update-ref -m), "dgit fetch $csuite",
-           'DGIT_ARCHIVE', $hash;
+    runcmd git_update_ref_cmd "dgit fetch $csuite", 'DGIT_ARCHIVE', $hash;

     cmdoutput @git, qw(log -n2), $hash;
     # ... gives git a chance to complain if our commit is malformed
 }
 
 sub fetch_from_archive_record_2 ($) {
     my ($hash) = @_;
     cmdoutput @git, qw(log -n2), $hash;
     # ... gives git a chance to complain if our commit is malformed
 }
 
 sub fetch_from_archive_record_2 ($) {
     my ($hash) = @_;

-    my @upd_cmd = (@git, qw(update-ref -m), 'dgit fetch', lrref(), $hash);
+    my @upd_cmd = (git_update_ref_cmd 'dgit fetch', lrref(), $hash);

     if (act_local()) {
        cmdoutput @upd_cmd;
     } else {
     if (act_local()) {
        cmdoutput @upd_cmd;
     } else {


@@ -3362,38 +3361,57 @@ sub open_main_gitattrs () {
     return $gai;
 }
 
     return $gai;
 }
 

+our $gitattrs_ourmacro_re = qr{^\[attr\]dgit-defuse-attrs\s};
+

 sub is_gitattrs_setup () {
 sub is_gitattrs_setup () {

+    # return values:
+    #  trueish
+    #     1: gitattributes set up and should be left alone
+    #  falseish
+    #     0: there is a dgit-defuse-attrs but it needs fixing
+    #     undef: there is none

     my $gai = open_main_gitattrs();
     return 0 unless $gai;
     while (<$gai>) {
     my $gai = open_main_gitattrs();
     return 0 unless $gai;
     while (<$gai>) {

-       return 1 if m{^\[attr\]dgit-defuse-attrs\s};
+       next unless m{$gitattrs_ourmacro_re};
+       return 1 if m{\s-working-tree-encoding\s};
+       printdebug "is_gitattrs_setup: found old macro\n";
+       return 0;

     }
     $gai->error and die $!;
     }
     $gai->error and die $!;

-    return 0;
+    printdebug "is_gitattrs_setup: found nothing\n";
+    return undef;

 }    
 
 sub setup_gitattrs (;$) {
     my ($always) = @_;
     return unless $always || access_cfg_bool(1, 'setup-gitattributes');
 
 }    
 
 sub setup_gitattrs (;$) {
     my ($always) = @_;
     return unless $always || access_cfg_bool(1, 'setup-gitattributes');
 

-    if (is_gitattrs_setup()) {
+    my $already = is_gitattrs_setup();
+    if ($already) {

        progress <<END;
        progress <<END;

-[attr]dgit-defuse-attrs already found in .git/info/attributes
+[attr]dgit-defuse-attrs already found, and proper, in .git/info/attributes

  not doing further gitattributes setup
 END
        return;
     }
  not doing further gitattributes setup
 END
        return;
     }

+    my $new = "[attr]dgit-defuse-attrs $negate_harmful_gitattrs";

     my $af = "$maindir_gitcommon/info/attributes";
     ensuredir "$maindir_gitcommon/info";
     my $af = "$maindir_gitcommon/info/attributes";
     ensuredir "$maindir_gitcommon/info";

+

     open GAO, "> $af.new" or die $!;
     open GAO, "> $af.new" or die $!;

-    print GAO <<END or die $!;
+    print GAO <<END or die $! unless defined $already;

 *      dgit-defuse-attrs
 *      dgit-defuse-attrs

-[attr]dgit-defuse-attrs        $negate_harmful_gitattrs
+$new

 # ^ see GITATTRIBUTES in dgit(7) and dgit setup-new-tree in dgit(1)
 END
     my $gai = open_main_gitattrs();
     if ($gai) {
        while (<$gai>) {
 # ^ see GITATTRIBUTES in dgit(7) and dgit setup-new-tree in dgit(1)
 END
     my $gai = open_main_gitattrs();
     if ($gai) {
        while (<$gai>) {

+           if (m{$gitattrs_ourmacro_re}) {
+               die unless defined $already;
+               $_ = $new;
+           }

            chomp;
            print GAO $_, "\n" or die $!;
        }
            chomp;
            print GAO $_, "\n" or die $!;
        }


@@ -3428,7 +3446,7 @@ sub check_gitattrs ($$) {
        # oh dear, found one
        print STDERR <<END;
 dgit: warning: $what contains .gitattributes
        # oh dear, found one
        print STDERR <<END;
 dgit: warning: $what contains .gitattributes

-dgit: .gitattributes have not been defused.  Recommended: dgit setup-new-tree.
+dgit: .gitattributes not (fully) defused.  Recommended: dgit setup-new-tree.

 END
        close $gafl;
        return;
 END
        close $gafl;
        return;


@@ -3439,7 +3457,7 @@ END
 
 
 sub multisuite_suite_child ($$$) {
 
 
 sub multisuite_suite_child ($$$) {

-    my ($tsuite, $merginputs, $fn) = @_;
+    my ($tsuite, $mergeinputs, $fn) = @_;

     # in child, sets things up, calls $fn->(), and returns undef
     # in parent, returns canonical suite name for $tsuite
     my $canonsuitefh = IO::File::new_tmpfile;
     # in child, sets things up, calls $fn->(), and returns undef
     # in parent, returns canonical suite name for $tsuite
     my $canonsuitefh = IO::File::new_tmpfile;


@@ -3466,7 +3484,7 @@ sub multisuite_suite_child ($$$) {
        return $csuite;
     }
     printdebug "multisuite $tsuite ok (canon=$csuite)\n";
        return $csuite;
     }
     printdebug "multisuite $tsuite ok (canon=$csuite)\n";

-    push @$merginputs, {
+    push @$mergeinputs, {

         Ref => lrref,
         Info => $csuite,
     };
         Ref => lrref,
         Info => $csuite,
     };


@@ -3507,10 +3525,9 @@ sub fork_for_multisuite ($) {
        my $csubsuite = multisuite_suite_child($tsuite, \@mergeinputs,
                                               sub {
             @end = ();
        my $csubsuite = multisuite_suite_child($tsuite, \@mergeinputs,
                                               sub {
             @end = ();

-            fetch();
-           exit 0;
+            fetch_one();
+           finish 0;

        });
        });

-       # xxx collecte the ref here

 
        $csubsuite =~ s/^\Q$cbasesuite\E-/-/;
        push @csuites, $csubsuite;
 
        $csubsuite =~ s/^\Q$cbasesuite\E-/-/;
        push @csuites, $csubsuite;


@@ -3665,19 +3682,37 @@ sub clone ($) {
     clone_finish($dstdir);
 }
 
     clone_finish($dstdir);
 }
 

-sub fetch () {
+sub fetch_one () {

     canonicalise_suite();
     if (check_for_git()) {
        git_fetch_us();
     }
     fetch_from_archive() or no_such_package();
     canonicalise_suite();
     if (check_for_git()) {
        git_fetch_us();
     }
     fetch_from_archive() or no_such_package();

+    
+    my $vcsgiturl = $dsc && $dsc->{'Vcs-Git'};
+    if (length $vcsgiturl and
+       (grep { $csuite eq $_ }
+        split /\;/,
+        cfg 'dgit.vcs-git.suites')) {
+       my $current = cfg 'remote.vcs-git.url', 'RETURN-UNDEF';
+       if (defined $current && $current ne $vcsgiturl) {
+           print STDERR <<END;
+FYI: Vcs-Git in $csuite has different url to your vcs-git remote.
+ Your vcs-git remote url may be out of date.  Use dgit update-vcs-git ?
+END
+       }
+    }

     printdone "fetched into ".lrref();
 }
 
     printdone "fetched into ".lrref();
 }
 

-sub pull () {
+sub dofetch () {

     my $multi_fetched = fork_for_multisuite(sub { });
     my $multi_fetched = fork_for_multisuite(sub { });

-    fetch() unless $multi_fetched; # parent
-    return if $multi_fetched eq '0'; # child
+    fetch_one() unless $multi_fetched; # parent
+    finish 0 if $multi_fetched eq '0'; # child
+}
+
+sub pull () {
+    dofetch();

     runcmd_ordryrun_local @git, qw(merge -m),"Merge from $csuite [dgit]",
         lrref();
     printdone "fetched to ".lrref()." and merged into HEAD";
     runcmd_ordryrun_local @git, qw(merge -m),"Merge from $csuite [dgit]",
         lrref();
     printdone "fetched to ".lrref()." and merged into HEAD";


@@ -3690,17 +3725,9 @@ sub check_not_dirty () {
        }
     }
 
        }
     }
 

-    return if $ignoredirty;
+    return if $includedirty;

 
 

-    my @cmd = (@git, qw(diff --quiet HEAD));
-    debugcmd "+",@cmd;
-    $!=0; $?=-1; system @cmd;
-    return if !$?;
-    if ($?==256) {
-       fail "working tree is dirty (does not match HEAD)";
-    } else {
-       failedcmd @cmd;
-    }
+    git_check_unmodified();

 }
 
 sub commit_admin ($) {
 }
 
 sub commit_admin ($) {


@@ -3709,12 +3736,21 @@ sub commit_admin ($) {
     runcmd_ordryrun_local @git, qw(commit -m), $m;
 }
 
     runcmd_ordryrun_local @git, qw(commit -m), $m;
 }
 

+sub quiltify_nofix_bail ($$) {
+    my ($headinfo, $xinfo) = @_;
+    if ($quilt_mode eq 'nofix') {
+       fail "quilt fixup required but quilt mode is \`nofix'\n".
+           "HEAD commit".$headinfo." differs from tree implied by ".
+           " debian/patches".$xinfo;
+    }
+}
+

 sub commit_quilty_patch () {
 sub commit_quilty_patch () {

-    my $output = cmdoutput @git, qw(status --porcelain);
+    my $output = cmdoutput @git, qw(status --ignored --porcelain);

     my %adds;
     foreach my $l (split /\n/, $output) {
        next unless $l =~ m/\S/;
     my %adds;
     foreach my $l (split /\n/, $output) {
        next unless $l =~ m/\S/;

-       if ($l =~ m{^(?:\?\?| M) (.pc|debian/patches)}) {
+       if ($l =~ m{^(?:[?!][?!]| [MADRC]) (.pc|debian/patches)}) {

            $adds{$1}++;
        }
     }
            $adds{$1}++;
        }
     }


@@ -3723,6 +3759,7 @@ sub commit_quilty_patch () {
        progress "nothing quilty to commit, ok.";
        return;
     }
        progress "nothing quilty to commit, ok.";
        return;
     }

+    quiltify_nofix_bail "", " (wanted to commit patch update)";

     my @adds = map { s/[][*?\\]/\\$&/g; $_; } sort keys %adds;
     runcmd_ordryrun_local @git, qw(add -f), @adds;
     commit_admin <<END
     my @adds = map { s/[][*?\\]/\\$&/g; $_; } sort keys %adds;
     runcmd_ordryrun_local @git, qw(add -f), @adds;
     commit_admin <<END


@@ -3781,13 +3818,14 @@ sub madformat_wantfixup ($) {
 sub maybe_split_brain_save ($$$) {
     my ($headref, $dgitview, $msg) = @_;
     # => message fragment "$saved" describing disposition of $dgitview
 sub maybe_split_brain_save ($$$) {
     my ($headref, $dgitview, $msg) = @_;
     # => message fragment "$saved" describing disposition of $dgitview

-    return "commit id $dgitview" unless defined $split_brain_save;
+    my $save = $internal_object_save{'dgit-view'};
+    return "commit id $dgitview" unless defined $save;

     my @cmd = (shell_cmd 'cd "$1"; shift', $maindir,
     my @cmd = (shell_cmd 'cd "$1"; shift', $maindir,

-              @git, qw(update-ref -m),
+              git_update_ref_cmd

               "dgit --dgit-view-save $msg HEAD=$headref",
               "dgit --dgit-view-save $msg HEAD=$headref",

-              $split_brain_save, $dgitview);
+              $save, $dgitview);

     runcmd @cmd;
     runcmd @cmd;

-    return "and left in $split_brain_save";
+    return "and left in $save";

 }
 
 # An "infopair" is a tuple [ $thing, $what ]
 }
 
 # An "infopair" is a tuple [ $thing, $what ]


@@ -3883,6 +3921,8 @@ sub pseudomerge_make_commit ($$$$ $$) {
        : !length  $overwrite_version ? " --overwrite"
        : " --overwrite=".$overwrite_version;
 
        : !length  $overwrite_version ? " --overwrite"
        : " --overwrite=".$overwrite_version;
 

+    # Contributing parent is the first parent - that makes
+    # git rev-list --first-parent DTRT.

     my $pmf = dgit_privdir()."/pseudomerge";
     open MC, ">", $pmf or die "$pmf $!";
     print MC <<END or die $!;
     my $pmf = dgit_privdir()."/pseudomerge";
     open MC, ">", $pmf or die "$pmf $!";
     print MC <<END or die $!;


@@ -3945,10 +3985,12 @@ sub splitbrain_pseudomerge ($$$$) {
        infopair_cond_ff($i_dep14, [ $maintview, 'HEAD' ]);
        1;
     }) {
        infopair_cond_ff($i_dep14, [ $maintview, 'HEAD' ]);
        1;
     }) {

+        $@ =~ s/^\n//; chomp $@;

        print STDERR <<END;
        print STDERR <<END;

-$us: check failed (maybe --overwrite is needed, consult documentation)
+$@
+| Not fast forward; maybe --overwrite is needed ?  Please see dgit(1).

 END
 END

-       die "$@";
+       finish -1;

     }
 
     my $r = pseudomerge_make_commit
     }
 
     my $r = pseudomerge_make_commit


@@ -3981,7 +4023,7 @@ sub plain_overwrite_pseudomerge ($$$) {
        $clogp, $head, $archive_hash, $i_arch_v,
        "dgit", $m;
 
        $clogp, $head, $archive_hash, $i_arch_v,
        "dgit", $m;
 

-    runcmd @git, qw(update-ref -m), $m, 'HEAD', $r, $head;
+    runcmd git_update_ref_cmd $m, 'HEAD', $r, $head;

 
     progress "Make pseudo-merge of $i_arch_v->[0] into your HEAD.";
     return $r;
 
     progress "Make pseudo-merge of $i_arch_v->[0] into your HEAD.";
     return $r;


@@ -4211,7 +4253,14 @@ END
     my $format = getfield $dsc, 'Format';
     printdebug "format $format\n";
 
     my $format = getfield $dsc, 'Format';
     printdebug "format $format\n";
 

+    my $symref = git_get_symref();

     my $actualhead = git_rev_parse('HEAD');
     my $actualhead = git_rev_parse('HEAD');

+
+    if (branch_is_gdr_unstitched_ff($symref, $actualhead, $archive_hash)) {
+       runcmd_ordryrun_local @git_debrebase, 'stitch';
+       $actualhead = git_rev_parse('HEAD');
+    }
+

     my $dgithead = $actualhead;
     my $maintviewhead = undef;
 
     my $dgithead = $actualhead;
     my $maintviewhead = undef;
 


@@ -4240,7 +4289,8 @@ END
        }
     }
 
        }
     }
 

-    if (defined $overwrite_version && !defined $maintviewhead) {
+    if (defined $overwrite_version && !defined $maintviewhead
+       && $archive_hash) {

        $dgithead = plain_overwrite_pseudomerge($clogp,
                                                $dgithead,
                                                $archive_hash);
        $dgithead = plain_overwrite_pseudomerge($clogp,
                                                $dgithead,
                                                $archive_hash);


@@ -4336,6 +4386,29 @@ END
     files_compare_inputs($dsc, $changes)
        unless forceing [qw(dsc-changes-mismatch)];
 
     files_compare_inputs($dsc, $changes)
        unless forceing [qw(dsc-changes-mismatch)];
 

+    # Check whether this is a source only upload
+    my $hasdebs = $changes->{Files} =~ m{\.deb$}m;
+    my $sourceonlypolicy = access_cfg 'source-only-uploads';
+    if ($sourceonlypolicy eq 'ok') {
+    } elsif ($sourceonlypolicy eq 'always') {
+       forceable_fail [qw(uploading-binaries)],
+           "uploading binaries, although distroy policy is source only"
+           if $hasdebs;
+    } elsif ($sourceonlypolicy eq 'never') {
+       forceable_fail [qw(uploading-source-only)],
+           "source-only upload, although distroy policy requires .debs"
+           if !$hasdebs;
+    } elsif ($sourceonlypolicy eq 'not-wholly-new') {
+       forceable_fail [qw(uploading-source-only)],
+           "source-only upload, even though package is entirely NEW\n".
+           "(this is contrary to policy in ".(access_nomdistro()).")"
+           if !$hasdebs
+           && $new_package
+           && !(archive_query('package_not_wholly_new', $package) // 1);
+    } else {
+       badcfg "unknown source-only-uploads policy \`$sourceonlypolicy'";
+    }
+

     # Perhaps adjust .dsc to contain right set of origs
     changes_update_origs_from_dsc($dsc, $changes, $upstreamversion,
                                  $changesfile)
     # Perhaps adjust .dsc to contain right set of origs
     changes_update_origs_from_dsc($dsc, $changes, $upstreamversion,
                                  $changesfile)


@@ -4349,7 +4422,8 @@ END
     responder_send_command("param isuite $isuite");
     responder_send_command("param tagformat $tagformat");
     if (defined $maintviewhead) {
     responder_send_command("param isuite $isuite");
     responder_send_command("param tagformat $tagformat");
     if (defined $maintviewhead) {

-       die unless ($protovsn//4) >= 4;
+       confess "internal error (protovsn=$protovsn)"
+           if defined $protovsn and $protovsn < 4;

        responder_send_command("param maint-view $maintviewhead");
     }
 
        responder_send_command("param maint-view $maintviewhead");
     }
 


@@ -4419,7 +4493,7 @@ END
 
     runcmd_ordryrun @git,
        qw(-c push.followTags=false push), access_giturl(), @pushrefs;
 
     runcmd_ordryrun @git,
        qw(-c push.followTags=false push), access_giturl(), @pushrefs;

-    runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), $dgithead;
+    runcmd_ordryrun git_update_ref_cmd 'dgit push', lrref(), $dgithead;

 
     supplementary_message(<<'END');
 Push failed, while obtaining signatures on the .changes and .dsc.
 
     supplementary_message(<<'END');
 Push failed, while obtaining signatures on the .changes and .dsc.


@@ -4519,11 +4593,15 @@ sub branchsuite () {
     }
 }
 
     }
 }
 

-sub fetchpullargs () {
+sub package_from_d_control () {

     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';
     }

+}
+
+sub fetchpullargs () {
+    package_from_d_control();

     if (@ARGV==0) {
        $isuite = branchsuite();
        if (!$isuite) {
     if (@ARGV==0) {
        $isuite = branchsuite();
        if (!$isuite) {


@@ -4542,9 +4620,7 @@ sub fetchpullargs () {
 sub cmd_fetch {
     parseopts();
     fetchpullargs();
 sub cmd_fetch {
     parseopts();
     fetchpullargs();

-    my $multi_fetched = fork_for_multisuite(sub { });
-    exit 0 if $multi_fetched;
-    fetch();
+    dofetch();

 }
 
 sub cmd_pull {
 }
 
 sub cmd_pull {


@@ -4559,6 +4635,86 @@ END
     pull();
 }
 
     pull();
 }
 

+sub cmd_checkout {
+    parseopts();
+    package_from_d_control();
+    @ARGV==1 or badusage "dgit checkout needs a suite argument";
+    ($isuite) = @ARGV;
+    notpushing();
+
+    foreach my $canon (qw(0 1)) {
+       if (!$canon) {
+           $csuite= $isuite;
+       } else {
+           undef $csuite;
+           canonicalise_suite();
+       }
+       if (length git_get_ref lref()) {
+           # local branch already exists, yay
+           last;
+       }
+       if (!length git_get_ref lrref()) {
+           if (!$canon) {
+               # nope
+               next;
+           }
+           dofetch();
+       }
+       # now lrref exists
+       runcmd (@git, qw(update-ref), lref(), lrref(), '');
+       last;
+    }
+    local $ENV{GIT_REFLOG_ACTION} = git_reflog_action_msg
+        "dgit checkout $isuite";
+    runcmd (@git, qw(checkout), lbranch());
+}
+
+sub cmd_update_vcs_git () {
+    my $specsuite;
+    if (@ARGV==0 || $ARGV[0] =~ m/^-/) {
+       ($specsuite,) = split /\;/, cfg 'dgit.vcs-git.suites';
+    } else {
+       ($specsuite) = (@ARGV);
+       shift @ARGV;
+    }
+    my $dofetch=1;
+    if (@ARGV) {
+       if ($ARGV[0] eq '-') {
+           $dofetch = 0;
+       } elsif ($ARGV[0] eq '-') {
+           shift;
+       }
+    }
+
+    package_from_d_control();
+    my $ctrl;
+    if ($specsuite eq '.') {
+       $ctrl = parsecontrol 'debian/control', 'debian/control';
+    } else {
+       $isuite = $specsuite;
+       get_archive_dsc();
+       $ctrl = $dsc;
+    }
+    my $url = getfield $ctrl, 'Vcs-Git';
+
+    my @cmd;
+    my $orgurl = cfg 'remote.vcs-git.url', 'RETURN-UNDEF';
+    if (!defined $orgurl) {
+       print STDERR "setting up vcs-git: $url\n";
+       @cmd = (@git, qw(remote add vcs-git), $url);
+    } elsif ($orgurl eq $url) {
+       print STDERR "vcs git already configured: $url\n";
+    } else {
+       print STDERR "changing vcs-git url to: $url\n";
+       @cmd = (@git, qw(remote set-url vcs-git), $url);
+    }
+    runcmd_ordryrun_local @cmd;
+    if ($dofetch) {
+       print "fetching (@ARGV)\n";
+       runcmd_ordryrun_local @git, qw(fetch vcs-git), @ARGV;
+    }
+}
+

 sub prep_push () {
     parseopts();
     build_or_push_prep_early();
 sub prep_push () {
     parseopts();
     build_or_push_prep_early();


@@ -4590,21 +4746,6 @@ sub cmd_push {
     dopush();
 }
 
     dopush();
 }
 

-sub cmd_push_source {
-    prep_push();
-    if ($changesfile) {
-        my $changes = parsecontrol("$buildproductsdir/$changesfile",
-                                   "source changes file");
-        unless (test_source_only_changes($changes)) {
-            fail "user-specified changes file is not source-only";
-        }
-    } else {
-        # Building a source package is very fast, so just do it
-        build_source_for_push();
-    }
-    dopush();
-}
-

 #---------- remote commands' implementation ----------
 
 sub pre_remote_push_build_host {
 #---------- remote commands' implementation ----------
 
 sub pre_remote_push_build_host {


@@ -4752,7 +4893,7 @@ sub i_resp_complete {
 
     i_cleanup();
     printdebug "all done\n";
 
     i_cleanup();
     printdebug "all done\n";

-    exit 0;
+    finish 0;

 }
 
 sub i_resp_file ($) {
 }
 
 sub i_resp_file ($) {


@@ -5006,13 +5147,15 @@ sub quiltify_splitbrain_needed () {
     }
 }
 
     }
 }
 

-sub quiltify_splitbrain ($$$$$$) {
-    my ($clogp, $unapplied, $headref, $diffbits,
+sub quiltify_splitbrain ($$$$$$$) {
+    my ($clogp, $unapplied, $headref, $oldtiptree, $diffbits,

        $editedignores, $cachekey) = @_;
        $editedignores, $cachekey) = @_;

+    my $gitignore_special = 1;

     if ($quilt_mode !~ m/gbp|dpm/) {
        # treat .gitignore just like any other upstream file
        $diffbits = { %$diffbits };
        $_ = !!$_ foreach values %$diffbits;
     if ($quilt_mode !~ m/gbp|dpm/) {
        # treat .gitignore just like any other upstream file
        $diffbits = { %$diffbits };
        $_ = !!$_ foreach values %$diffbits;

+       $gitignore_special = 0;

     }
     # We would like any commits we generate to be reproducible
     my @authline = clogp_authline($clogp);
     }
     # We would like any commits we generate to be reproducible
     my @authline = clogp_authline($clogp);


@@ -5023,11 +5166,19 @@ sub quiltify_splitbrain ($$$$$$) {
     local $ENV{GIT_AUTHOR_EMAIL} = $authline[1];
     local $ENV{GIT_AUTHOR_DATE} =  $authline[2];
 
     local $ENV{GIT_AUTHOR_EMAIL} = $authline[1];
     local $ENV{GIT_AUTHOR_DATE} =  $authline[2];
 

+    my $fulldiffhint = sub {
+       my ($x,$y) = @_;
+       my $cmd = "git diff $x $y -- :/ ':!debian'";
+       $cmd .= " ':!/.gitignore' ':!*/.gitignore'" if $gitignore_special;
+       return "\nFor full diff showing the problem(s), type:\n $cmd\n";
+    };
+

     if ($quilt_mode =~ m/gbp|unapplied/ &&
        ($diffbits->{O2H} & 01)) {
        my $msg =
  "--quilt=$quilt_mode specified, implying patches-unapplied git tree\n".
  " but git tree differs from orig in upstream files.";
     if ($quilt_mode =~ m/gbp|unapplied/ &&
        ($diffbits->{O2H} & 01)) {
        my $msg =
  "--quilt=$quilt_mode specified, implying patches-unapplied git tree\n".
  " but git tree differs from orig in upstream files.";

+       $msg .= $fulldiffhint->($unapplied, 'HEAD');

        if (!stat_exists "debian/patches") {
            $msg .=
  "\n ... debian/patches is missing; perhaps this is a patch queue branch?";
        if (!stat_exists "debian/patches") {
            $msg .=
  "\n ... debian/patches is missing; perhaps this is a patch queue branch?";


@@ -5036,7 +5187,7 @@ sub quiltify_splitbrain ($$$$$$) {
     }
     if ($quilt_mode =~ m/dpm/ &&
        ($diffbits->{H2A} & 01)) {
     }
     if ($quilt_mode =~ m/dpm/ &&
        ($diffbits->{H2A} & 01)) {

-       fail <<END;
+       fail <<END. $fulldiffhint->($oldtiptree,'HEAD');

 --quilt=$quilt_mode specified, implying patches-applied git tree
  but git tree differs from result of applying debian/patches to upstream
 END
 --quilt=$quilt_mode specified, implying patches-applied git tree
  but git tree differs from result of applying debian/patches to upstream
 END


@@ -5052,7 +5203,7 @@ END
     }
     if ($quilt_mode =~ m/gbp|dpm/ &&
        ($diffbits->{O2A} & 02)) {
     }
     if ($quilt_mode =~ m/gbp|dpm/ &&
        ($diffbits->{O2A} & 02)) {

-       fail <<END
+       fail <<END;

 --quilt=$quilt_mode specified, implying that HEAD is for use with a
  tool which does not create patches for changes to upstream
  .gitignores: but, such patches exist in debian/patches.
 --quilt=$quilt_mode specified, implying that HEAD is for use with a
  tool which does not create patches for changes to upstream
  .gitignores: but, such patches exist in debian/patches.


@@ -5088,7 +5239,7 @@ END
        print SERIES "\n" or die $! unless $newline eq "\n";
        print SERIES "auto-gitignore\n" or die $!;
        close SERIES or die  $!;
        print SERIES "\n" or die $! unless $newline eq "\n";
        print SERIES "auto-gitignore\n" or die $!;
        close SERIES or die  $!;

-        runcmd @git, qw(add -- debian/patches/series), $gipatch;
+        runcmd @git, qw(add -f -- debian/patches/series), $gipatch;

         commit_admin <<END
 Commit patch to update .gitignore
 
         commit_admin <<END
 Commit patch to update .gitignore
 


@@ -5202,11 +5353,7 @@ sub quiltify ($$$$) {
            last;
        }
 
            last;
        }
 

-       if ($quilt_mode eq 'nofix') {
-           fail "quilt fixup required but quilt mode is \`nofix'\n".
-               "HEAD commit $c->{Commit} differs from tree implied by ".
-               " debian/patches (tree object $oldtiptree)";
-       }
+       quiltify_nofix_bail " $c->{Commit}", " (tree object $oldtiptree)";

        if ($quilt_mode eq 'smash') {
            printdebug " search quitting smash\n";
            last;
        if ($quilt_mode eq 'smash') {
            printdebug " search quitting smash\n";
            last;


@@ -5264,12 +5411,13 @@ sub quiltify ($$$$) {
            return $s;
        };
        if ($quilt_mode eq 'linear') {
            return $s;
        };
        if ($quilt_mode eq 'linear') {

-           print STDERR "$us: quilt fixup cannot be linear.  Stopped at:\n";
+           print STDERR "\n$us: error: quilt fixup cannot be linear.  Stopped at:\n";

            foreach my $notp (@nots) {
                print STDERR "$us:  ", $reportnot->($notp), "\n";
            }
            print STDERR "$us: $_\n" foreach @$failsuggestion;
            foreach my $notp (@nots) {
                print STDERR "$us:  ", $reportnot->($notp), "\n";
            }
            print STDERR "$us: $_\n" foreach @$failsuggestion;

-           fail "quilt fixup naive history linearisation failed.\n".
+           fail
+ "quilt history linearisation failed.  Search \`quilt fixup' in dgit(7).\n".

  "Use dpkg-source --commit by hand; or, --quilt=smash for one ugly patch";
        } elsif ($quilt_mode eq 'smash') {
        } elsif ($quilt_mode eq 'auto') {
  "Use dpkg-source --commit by hand; or, --quilt=smash for one ugly patch";
        } elsif ($quilt_mode eq 'smash') {
        } elsif ($quilt_mode eq 'auto') {


@@ -5420,6 +5568,33 @@ END
 
     my $clogp = parsechangelog();
     my $headref = git_rev_parse('HEAD');
 
     my $clogp = parsechangelog();
     my $headref = git_rev_parse('HEAD');

+    my $symref = git_get_symref();
+
+    if ($quilt_mode eq 'linear'
+       && !$fopts->{'single-debian-patch'}
+       && branch_is_gdr($symref, $headref)) {
+       # This is much faster.  It also makes patches that gdr
+       # likes better for future updates without laundering.
+       #
+       # However, it can fail in some casses where we would
+       # succeed: if there are existing patches, which correspond
+       # to a prefix of the branch, but are not in gbp/gdr
+       # format, gdr will fail (exiting status 7), but we might
+       # be able to figure out where to start linearising.  That
+       # will be slower so hopefully there's not much to do.
+       my @cmd = (@git_debrebase,
+                  qw(--noop-ok -funclean-mixed -funclean-ordering
+                     make-patches --quiet-would-amend));
+       # We tolerate soe snags that gdr wouldn't, by default.
+       if (act_local()) {
+           debugcmd "+",@cmd;
+           $!=0; $?=-1;
+           failedcmd @cmd if system @cmd and $?!=7*256;
+       } else {
+           dryrun_report @cmd;
+       }
+       $headref = git_rev_parse('HEAD');
+    }

 
     prep_ud();
     changedir $playground;
 
     prep_ud();
     changedir $playground;


@@ -5432,14 +5607,12 @@ END
        quilt_fixup_multipatch($clogp, $headref, $upstreamversion);
     }
 
        quilt_fixup_multipatch($clogp, $headref, $upstreamversion);
     }
 

-    die 'bug' if $split_brain && !$need_split_build_invocation;
-

     changedir $maindir;
     runcmd_ordryrun_local
         @git, qw(pull --ff-only -q), "$playground/work", qw(master);
 }
 
     changedir $maindir;
     runcmd_ordryrun_local
         @git, qw(pull --ff-only -q), "$playground/work", qw(master);
 }
 

-sub quilt_fixup_mkwork ($) {
+sub unpack_playtree_mkwork ($) {

     my ($headref) = @_;
 
     mkdir "work" or die $!;
     my ($headref) = @_;
 
     mkdir "work" or die $!;


@@ -5448,12 +5621,14 @@ sub quilt_fixup_mkwork ($) {
     runcmd @git, qw(reset -q --hard), $headref;
 }
 
     runcmd @git, qw(reset -q --hard), $headref;
 }
 

-sub quilt_fixup_linkorigs ($$) {
+sub unpack_playtree_linkorigs ($$) {

     my ($upstreamversion, $fn) = @_;
     # calls $fn->($leafname);
 
     my ($upstreamversion, $fn) = @_;
     # calls $fn->($leafname);
 

-    foreach my $f (<$maindir/../*>) { #/){
-       my $b=$f; $b =~ s{.*/}{};
+    my $bpd_abs = bpd_abs();
+    opendir QFD, $bpd_abs or fail "buildproductsdir: $bpd_abs: $!";
+    while ($!=0, defined(my $b = readdir QFD)) {
+       my $f = bpd_abs()."/".$b;

        {
            local ($debuglevel) = $debuglevel-1;
            printdebug "QF linkorigs $b, $f ?\n";
        {
            local ($debuglevel) = $debuglevel-1;
            printdebug "QF linkorigs $b, $f ?\n";


@@ -5463,6 +5638,8 @@ sub quilt_fixup_linkorigs ($$) {
        link_ltarget $f, $b or die "$b $!";
         $fn->($b);
     }
        link_ltarget $f, $b or die "$b $!";
         $fn->($b);
     }

+    die "$buildproductsdir: $!" if $!;
+    closedir QFD;

 }
 
 sub quilt_fixup_delete_pc () {
 }
 
 sub quilt_fixup_delete_pc () {


@@ -5484,8 +5661,8 @@ sub quilt_fixup_singlepatch ($$$) {
     # get it to generate debian/patches/debian-changes, it is
     # necessary to build the source package.
 
     # get it to generate debian/patches/debian-changes, it is
     # necessary to build the source package.
 

-    quilt_fixup_linkorigs($upstreamversion, sub { });
-    quilt_fixup_mkwork($headref);
+    unpack_playtree_linkorigs($upstreamversion, sub { });
+    unpack_playtree_mkwork($headref);

 
     rmtree("debian/patches");
 
 
     rmtree("debian/patches");
 


@@ -5525,7 +5702,7 @@ END
        print $fakedsc " ".$md->hexdigest." $size $b\n" or die $!;
     };
 
        print $fakedsc " ".$md->hexdigest." $size $b\n" or die $!;
     };
 

-    quilt_fixup_linkorigs($upstreamversion, $dscaddfile);
+    unpack_playtree_linkorigs($upstreamversion, $dscaddfile);

 
     my @files=qw(debian/source/format debian/rules
                  debian/control debian/changelog);
 
     my @files=qw(debian/source/format debian/rules
                  debian/control debian/changelog);


@@ -5542,6 +5719,31 @@ END
     close $fakedsc or die $!;
 }
 
     close $fakedsc or die $!;
 }
 

+sub quilt_fakedsc2unapplied ($$) {
+    my ($headref, $upstreamversion) = @_;
+    # must be run in the playground
+    # quilt_make_fake_dsc must have been called
+
+    runcmd qw(sh -ec),
+        'exec dpkg-source --no-check --skip-patches -x fake.dsc >/dev/null';
+
+    my $fakexdir= $package.'-'.(stripepoch $upstreamversion);
+    rename $fakexdir, "fake" or die "$fakexdir $!";
+
+    changedir 'fake';
+
+    remove_stray_gits("source package");
+    mktree_in_ud_here();
+
+    rmtree '.pc';
+
+    rmtree 'debian'; # git checkout commitish paths does not delete!
+    runcmd @git, qw(checkout -f), $headref, qw(-- debian);
+    my $unapplied=git_add_write_tree();
+    printdebug "fake orig tree object $unapplied\n";
+    return $unapplied;
+}    
+

 sub quilt_check_splitbrain_cache ($$) {
     my ($headref, $upstreamversion) = @_;
     # Called only if we are in (potentially) split brain mode.
 sub quilt_check_splitbrain_cache ($$) {
     my ($headref, $upstreamversion) = @_;
     # Called only if we are in (potentially) split brain mode.


@@ -5583,7 +5785,7 @@ sub quilt_check_splitbrain_cache ($$) {
        if (!stat "$maindir_gitcommon/logs/refs/$splitbraincache") {
            $! == ENOENT or die $!;
            printdebug ">(no reflog)\n";
        if (!stat "$maindir_gitcommon/logs/refs/$splitbraincache") {
            $! == ENOENT or die $!;
            printdebug ">(no reflog)\n";

-           exit 0;
+           finish 0;

        }
        exec @cmd; die $!;
     }
        }
        exec @cmd; die $!;
     }


@@ -5593,7 +5795,7 @@ sub quilt_check_splitbrain_cache ($$) {
        next unless m/^(\w+) (\S.*\S)$/ && $2 eq $splitbrain_cachekey;
            
        my $cachehit = $1;
        next unless m/^(\w+) (\S.*\S)$/ && $2 eq $splitbrain_cachekey;
            
        my $cachehit = $1;

-       quilt_fixup_mkwork($headref);
+       unpack_playtree_mkwork($headref);

        my $saved = maybe_split_brain_save $headref, $cachehit, "cache-hit";
        if ($cachehit ne $headref) {
            progress "dgit view: found cached ($saved)";
        my $saved = maybe_split_brain_save $headref, $cachehit, "cache-hit";
        if ($cachehit ne $headref) {
            progress "dgit view: found cached ($saved)";


@@ -5695,23 +5897,7 @@ sub quilt_fixup_multipatch ($$$) {
            quilt_check_splitbrain_cache($headref, $upstreamversion);
        return if $cachehit;
     }
            quilt_check_splitbrain_cache($headref, $upstreamversion);
        return if $cachehit;
     }

-
-    runcmd qw(sh -ec),
-        'exec dpkg-source --no-check --skip-patches -x fake.dsc >/dev/null';
-
-    my $fakexdir= $package.'-'.(stripepoch $upstreamversion);
-    rename $fakexdir, "fake" or die "$fakexdir $!";
-
-    changedir 'fake';
-
-    remove_stray_gits("source package");
-    mktree_in_ud_here();
-
-    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=quilt_fakedsc2unapplied($headref, $upstreamversion);

 
     ensuredir '.pc';
 
 
     ensuredir '.pc';
 


@@ -5723,13 +5909,13 @@ sub quilt_fixup_multipatch ($$$) {
 failed to apply your git tree's patch stack (from debian/patches/) to
  the corresponding upstream tarball(s).  Your source tree and .orig
  are probably too inconsistent.  dgit can only fix up certain kinds of
 failed to apply your git tree's patch stack (from debian/patches/) to
  the corresponding upstream tarball(s).  Your source tree and .orig
  are probably too inconsistent.  dgit can only fix up certain kinds of

- anomaly (depending on the quilt mode).  See --quilt= in dgit(1).
+ anomaly (depending on the quilt mode).  Please see --quilt= in dgit(1).

 END
     }
 
     changedir '..';
 
 END
     }
 
     changedir '..';
 

-    quilt_fixup_mkwork($headref);
+    unpack_playtree_mkwork($headref);

 
     my $mustdeletepc=0;
     if (stat_exists ".pc") {
 
     my $mustdeletepc=0;
     if (stat_exists ".pc") {


@@ -5797,7 +5983,7 @@ END
         " --[quilt=]gbp --[quilt=]dpm --quilt=unapplied ?";
 
     if (quiltmode_splitbrain()) {
         " --[quilt=]gbp --[quilt=]dpm --quilt=unapplied ?";
 
     if (quiltmode_splitbrain()) {

-       quiltify_splitbrain($clogp, $unapplied, $headref,
+       quiltify_splitbrain($clogp, $unapplied, $headref, $oldtiptree,

                             $diffbits, \%editedignores,
                            $splitbrain_cachekey);
        return;
                             $diffbits, \%editedignores,
                            $splitbrain_cachekey);
        return;


@@ -5835,7 +6021,7 @@ sub quilt_fixup_editor () {
     }
     I2->error and die $!;
     close O or die $1;
     }
     I2->error and die $!;
     close O or die $1;

-    exit 0;
+    finish 0;

 }
 
 sub maybe_apply_patches_dirtily () {
 }
 
 sub maybe_apply_patches_dirtily () {


@@ -5901,6 +6087,10 @@ sub cmd_clean () {
     maybe_unapply_patches_again();
 }
 
     maybe_unapply_patches_again();
 }
 

+# return values from massage_dbp_args are one or both of these flags
+sub WANTSRC_SOURCE  () { 01; } # caller should build source (separately)
+sub WANTSRC_BUILDER () { 02; } # caller should run dpkg-buildpackage
+

 sub build_or_push_prep_early () {
     our $build_or_push_prep_early_done //= 0;
     return if $build_or_push_prep_early_done++;
 sub build_or_push_prep_early () {
     our $build_or_push_prep_early_done //= 0;
     return if $build_or_push_prep_early_done++;


@@ -5909,6 +6099,7 @@ sub build_or_push_prep_early () {
     $isuite = getfield $clogp, 'Distribution';
     $package = getfield $clogp, 'Source';
     $version = getfield $clogp, 'Version';
     $isuite = getfield $clogp, 'Distribution';
     $package = getfield $clogp, 'Source';
     $version = getfield $clogp, 'Version';

+    $dscfn = dscfn($version);

 }
 
 sub build_prep_early () {
 }
 
 sub build_prep_early () {


@@ -5917,9 +6108,12 @@ sub build_prep_early () {
     check_not_dirty();
 }
 
     check_not_dirty();
 }
 

-sub build_prep () {
+sub build_prep ($) {
+    my ($wantsrc) = @_;

     build_prep_early();
     build_prep_early();

-    clean_tree();
+    # clean the tree if we're trying to include dirty changes in the
+    # source package, or we are running the builder in $maindir
+    clean_tree() if $includedirty || ($wantsrc & WANTSRC_BUILDER);

     build_maybe_quilt_fixup();
     if ($rmchanges) {
        my $pat = changespat $version;
     build_maybe_quilt_fixup();
     if ($rmchanges) {
        my $pat = changespat $version;


@@ -5939,13 +6133,21 @@ sub changesopts_initial () {
 
 sub changesopts_version () {
     if (!defined $changes_since_version) {
 
 sub changesopts_version () {
     if (!defined $changes_since_version) {

-       my @vsns = archive_query('archive_query');
-       my @quirk = access_quirk();
-       if ($quirk[0] eq 'backports') {
-           local $isuite = $quirk[2];
-           local $csuite;
-           canonicalise_suite();
-           push @vsns, archive_query('archive_query');
+       my @vsns;
+       unless (eval {
+           @vsns = archive_query('archive_query');
+           my @quirk = access_quirk();
+           if ($quirk[0] eq 'backports') {
+               local $isuite = $quirk[2];
+               local $csuite;
+               canonicalise_suite();
+               push @vsns, archive_query('archive_query');
+           }
+           1;
+       }) {
+           print STDERR $@;
+           fail
+ "archive query failed (queried because --since-version not specified)";

        }
        if (@vsns) {
            @vsns = map { $_->[0] } @vsns;
        }
        if (@vsns) {
            @vsns = map { $_->[0] } @vsns;


@@ -5970,28 +6172,11 @@ sub changesopts () {
 
 sub massage_dbp_args ($;$) {
     my ($cmd,$xargs) = @_;
 
 sub massage_dbp_args ($;$) {
     my ($cmd,$xargs) = @_;

-    # We need to:
-    #
-    #  - if we're going to split the source build out so we can
-    #    do strange things to it, massage the arguments to dpkg-buildpackage
-    #    so that the main build doessn't build source (or add an argument
-    #    to stop it building source by default).
-    #
-    #  - add -nc to stop dpkg-source cleaning the source tree,
-    #    unless we're not doing a split build and want dpkg-source
-    #    as cleanmode, in which case we can do nothing
-    #
-    # return values:
-    #    0 - source will NOT need to be built separately by caller
-    #   +1 - source will need to be built separately by caller
-    #   +2 - source will need to be built separately by caller AND
-    #        dpkg-buildpackage should not in fact be run at all!
+    # Since we split the source build out so we can do strange things
+    # to it, massage the arguments to dpkg-buildpackage so that the
+    # main build doessn't build source (or add an argument to stop it
+    # building source by default).

     debugcmd '#massaging#', @$cmd if $debuglevel>1;
     debugcmd '#massaging#', @$cmd if $debuglevel>1;

-#print STDERR "MASS0 ",Dumper($cmd, $xargs, $need_split_build_invocation);
-    if ($cleanmode eq 'dpkg-source' && !$need_split_build_invocation) {
-       $clean_using_builder = 1;
-       return 0;
-    }

     # -nc has the side effect of specifying -b if nothing else specified
     # and some combinations of -S, -b, et al, are errors, rather than
     # later simply overriding earlie.  So we need to:
     # -nc has the side effect of specifying -b if nothing else specified
     # and some combinations of -S, -b, et al, are errors, rather than
     # later simply overriding earlie.  So we need to:


@@ -6006,35 +6191,34 @@ sub massage_dbp_args ($;$) {
     }
     push @$cmd, '-nc';
 #print STDERR "MASS1 ",Dumper($cmd, $xargs, $dmode);
     }
     push @$cmd, '-nc';
 #print STDERR "MASS1 ",Dumper($cmd, $xargs, $dmode);

-    my $r = 0;
-    if ($need_split_build_invocation) {
-       printdebug "massage split $dmode.\n";
-       $r = $dmode =~ m/[S]/     ? +2 :
-            $dmode =~ y/gGF/ABb/ ? +1 :
-            $dmode =~ m/[ABb]/   ?  0 :
-            die "$dmode ?";
-    }
+    my $r = WANTSRC_BUILDER;
+    printdebug "massage split $dmode.\n";
+    $r = $dmode =~ m/[S]/  ?  WANTSRC_SOURCE :
+      $dmode =~ y/gGF/ABb/ ?  WANTSRC_SOURCE | WANTSRC_BUILDER :
+      $dmode =~ m/[ABb]/   ?                   WANTSRC_BUILDER :
+      die "$dmode ?";

     printdebug "massage done $r $dmode.\n";
     push @$cmd, $dmode;
 #print STDERR "MASS2 ",Dumper($cmd, $xargs, $r);
     return $r;
 }
 
     printdebug "massage done $r $dmode.\n";
     push @$cmd, $dmode;
 #print STDERR "MASS2 ",Dumper($cmd, $xargs, $r);
     return $r;
 }
 

-sub in_parent (&) {
+sub in_bpd (&) {

     my ($fn) = @_;
     my $wasdir = must_getcwd();
     my ($fn) = @_;
     my $wasdir = must_getcwd();

-    changedir "..";
+    changedir $buildproductsdir;

     $fn->();
     changedir $wasdir;
 }    
 
     $fn->();
     changedir $wasdir;
 }    
 

-sub postbuild_mergechanges ($) { # must run with CWD=.. (eg in in_parent)
+# this sub must run with CWD=$buildproductsdir (eg in in_bpd)
+sub postbuild_mergechanges ($) {

     my ($msg_if_onlyone) = @_;
     # If there is only one .changes file, fail with $msg_if_onlyone,
     # or if that is undef, be a no-op.
     # Returns the changes file to report to the user.
     my $pat = changespat $version;
     my ($msg_if_onlyone) = @_;
     # If there is only one .changes file, fail with $msg_if_onlyone,
     # or if that is undef, be a no-op.
     # Returns the changes file to report to the user.
     my $pat = changespat $version;

-    my @changesfiles = glob $pat;
+    my @changesfiles = grep { !m/_multi\.changes/ } glob $pat;

     @changesfiles = sort {
        ($b =~ m/_source\.changes$/ <=> $a =~ m/_source\.changes$/)
            or $a cmp $b
     @changesfiles = sort {
        ($b =~ m/_source\.changes$/ <=> $a =~ m/_source\.changes$/)
            or $a cmp $b


@@ -6070,8 +6254,11 @@ END
 sub midbuild_checkchanges () {
     my $pat = changespat $version;
     return if $rmchanges;
 sub midbuild_checkchanges () {
     my $pat = changespat $version;
     return if $rmchanges;

-    my @unwanted = map { s#^\.\./##; $_; } glob "../$pat";
-    @unwanted = grep { $_ ne changespat $version,'source' } @unwanted;
+    my @unwanted = map { s#.*/##; $_; } glob "$bpd_glob/$pat";
+    @unwanted = grep {
+       $_ ne changespat $version,'source' and
+       $_ ne changespat $version,'multi'
+    } @unwanted;

     fail <<END
 changes files other than source matching $pat already present; building would result in ambiguity about the intended results.
 Suggest you delete @unwanted.
     fail <<END
 changes files other than source matching $pat already present; building would result in ambiguity about the intended results.
 Suggest you delete @unwanted.


@@ -6081,13 +6268,13 @@ END
 
 sub midbuild_checkchanges_vanilla ($) {
     my ($wantsrc) = @_;
 
 sub midbuild_checkchanges_vanilla ($) {
     my ($wantsrc) = @_;

-    midbuild_checkchanges() if $wantsrc == 1;
+    midbuild_checkchanges() if $wantsrc == (WANTSRC_SOURCE|WANTSRC_BUILDER);

 }
 
 sub postbuild_mergechanges_vanilla ($) {
     my ($wantsrc) = @_;
 }
 
 sub postbuild_mergechanges_vanilla ($) {
     my ($wantsrc) = @_;

-    if ($wantsrc == 1) {
-       in_parent {
+    if ($wantsrc == (WANTSRC_SOURCE|WANTSRC_BUILDER)) {
+       in_bpd {

            postbuild_mergechanges(undef);
        };
     } else {
            postbuild_mergechanges(undef);
        };
     } else {


@@ -6097,15 +6284,18 @@ sub postbuild_mergechanges_vanilla ($) {
 
 sub cmd_build {
     build_prep_early();
 
 sub cmd_build {
     build_prep_early();

+    $buildproductsdir eq '..' or print STDERR <<END;
+$us: warning: build-products-dir set, but not supported by dgit build
+$us: warning: things may go wrong or files may go to the wrong place
+END

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

-    if ($wantsrc > 0) {
+    build_prep($wantsrc);
+    if ($wantsrc & WANTSRC_SOURCE) {

        build_source();
        midbuild_checkchanges_vanilla $wantsrc;
        build_source();
        midbuild_checkchanges_vanilla $wantsrc;

-    } else {
-       build_prep();

     }
     }

-    if ($wantsrc < 2) {
+    if ($wantsrc & WANTSRC_BUILDER) {

        push @dbp, changesopts_version();
        maybe_apply_patches_dirtily();
        runcmd_ordryrun_local @dbp;
        push @dbp, changesopts_version();
        maybe_apply_patches_dirtily();
        runcmd_ordryrun_local @dbp;


@@ -6129,12 +6319,11 @@ sub cmd_gbp_build {
     # orig is absent.
     my $upstreamversion = upstreamversion $version;
     my $origfnpat = srcfn $upstreamversion, '.orig.tar.*';
     # orig is absent.
     my $upstreamversion = upstreamversion $version;
     my $origfnpat = srcfn $upstreamversion, '.orig.tar.*';

-    my $gbp_make_orig = $version =~ m/-/ && !(() = glob "../$origfnpat");
+    my $gbp_make_orig = $version =~ m/-/ && !(() = glob "$bpd_glob/$origfnpat");

 
     if ($gbp_make_orig) {
        clean_tree();
        $cleanmode = 'none'; # don't do it again
 
     if ($gbp_make_orig) {
        clean_tree();
        $cleanmode = 'none'; # don't do it again

-       $need_split_build_invocation = 1;

     }
 
     my @dbp = @dpkgbuildpackage;
     }
 
     my @dbp = @dpkgbuildpackage;


@@ -6148,7 +6337,7 @@ sub cmd_gbp_build {
            $gbp_build[0] = 'gbp buildpackage';
        }
     }
            $gbp_build[0] = 'gbp buildpackage';
        }
     }

-    my @cmd = opts_opt_multi_cmd @gbp_build;
+    my @cmd = opts_opt_multi_cmd [], @gbp_build;

 
     push @cmd, (qw(-us -uc --git-no-sign-tags),
                "--git-builder=".(shellquote @dbp));
 
     push @cmd, (qw(-us -uc --git-no-sign-tags),
                "--git-builder=".(shellquote @dbp));


@@ -6172,17 +6361,17 @@ sub cmd_gbp_build {
        }
     }
 
        }
     }
 

-    if ($wantsrc > 0) {
+    build_prep($wantsrc);
+    if ($wantsrc & WANTSRC_SOURCE) {

        build_source();
        midbuild_checkchanges_vanilla $wantsrc;
     } else {
        if (!$clean_using_builder) {
            push @cmd, '--git-cleaner=true';
        }
        build_source();
        midbuild_checkchanges_vanilla $wantsrc;
     } else {
        if (!$clean_using_builder) {
            push @cmd, '--git-cleaner=true';
        }

-       build_prep();

     }
     maybe_unapply_patches_again();
     }
     maybe_unapply_patches_again();

-    if ($wantsrc < 2) {
+    if ($wantsrc & WANTSRC_BUILDER) {

        push @cmd, changesopts();
        runcmd_ordryrun_local @cmd, @ARGV;
     }
        push @cmd, changesopts();
        runcmd_ordryrun_local @cmd, @ARGV;
     }


@@ -6190,77 +6379,158 @@ sub cmd_gbp_build {
 }
 sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0
 
 }
 sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0
 

-sub build_source_for_push {
-    build_source();
-    maybe_unapply_patches_again();
-    $changesfile = $sourcechanges;
+sub building_source_in_playtree {
+    # If $includedirty, we have to build the source package from the
+    # working tree, not a playtree, so that uncommitted changes are
+    # included (copying or hardlinking them into the playtree could
+    # cause trouble).
+    #
+    # Note that if we are building a source package in split brain
+    # mode we do not support including uncommitted changes, because
+    # that makes quilt fixup too hard.  I.e. ($split_brain && (dgit is
+    # building a source package)) => !$includedirty
+    return !$includedirty;

 }
 
 sub build_source {
 }
 
 sub build_source {

-    build_prep_early();
-    build_prep();

     $sourcechanges = changespat $version,'source';
     if (act_local()) {
     $sourcechanges = changespat $version,'source';
     if (act_local()) {

-       unlink "../$sourcechanges" or $!==ENOENT
+       unlink "$buildproductsdir/$sourcechanges" or $!==ENOENT

            or fail "remove $sourcechanges: $!";
     }
            or fail "remove $sourcechanges: $!";
     }

-    $dscfn = dscfn($version);

     my @cmd = (@dpkgsource, qw(-b --));
     my @cmd = (@dpkgsource, qw(-b --));

-    if ($split_brain) {
+    my $leafdir;
+    if (building_source_in_playtree()) {
+       $leafdir = 'work';
+        my $headref = git_rev_parse('HEAD');
+        # If we are in split brain, there is already a playtree with
+        # the thing we should package into a .dsc (thanks to quilt
+        # fixup).  If not, make a playtree
+        prep_ud() unless $split_brain;

         changedir $playground;
         changedir $playground;

-        runcmd_ordryrun_local @cmd, "work";
-        my @udfiles = <${package}_*>;
-        changedir $maindir;
-        foreach my $f (@udfiles) {
-            printdebug "source copy, found $f\n";
-            next unless
-              $f eq $dscfn or
-              ($f =~ m/\.debian\.tar(?:\.\w+)$/ &&
-               $f eq srcfn($version, $&));
-            printdebug "source copy, found $f - renaming\n";
-            rename "$playground/$f", "../$f" or $!==ENOENT
-              or fail "put in place new source file ($f): $!";
+        unless ($split_brain) {
+            my $upstreamversion = upstreamversion $version;
+            unpack_playtree_linkorigs($upstreamversion, sub { });
+            unpack_playtree_mkwork($headref);
+            changedir '..';

         }
     } else {
         }
     } else {

-        my $pwd = must_getcwd();
-        my $leafdir = basename $pwd;
-        changedir "..";
-        runcmd_ordryrun_local @cmd, $leafdir;
-        changedir $pwd;
+        $leafdir = basename $maindir;
+        changedir '..';

     }
     }

+    runcmd_ordryrun_local @cmd, $leafdir;
+
+    changedir $leafdir;

     runcmd_ordryrun_local qw(sh -ec),
     runcmd_ordryrun_local qw(sh -ec),

-      'exec >$1; shift; exec "$@"','x',
-      "../$sourcechanges",
+      'exec >../$1; shift; exec "$@"','x', $sourcechanges,

       @dpkggenchanges, qw(-S), changesopts();
       @dpkggenchanges, qw(-S), changesopts();

+    changedir '..';
+
+    printdebug "moving $dscfn, $sourcechanges, etc. to ".bpd_abs()."\n";
+    $dsc = parsecontrol($dscfn, "source package");
+
+    my $mv = sub {
+       my ($why, $l) = @_;
+        printdebug " renaming ($why) $l\n";
+        rename "$l", bpd_abs()."/$l"
+           or fail "put in place new built file ($l): $!";
+    };
+    foreach my $l (split /\n/, getfield $dsc, 'Files') {
+        $l =~ m/\S+$/ or next;
+       $mv->('Files', $&);
+    }
+    $mv->('dsc', $dscfn);
+    $mv->('changes', $sourcechanges);
+
+    changedir $maindir;

 }
 
 sub cmd_build_source {
 }
 
 sub cmd_build_source {

-    build_prep_early();

     badusage "build-source takes no additional arguments" if @ARGV;
     badusage "build-source takes no additional arguments" if @ARGV;

+    build_prep(WANTSRC_SOURCE);

     build_source();
     maybe_unapply_patches_again();
     printdone "source built, results in $dscfn and $sourcechanges";
 }
 
     build_source();
     maybe_unapply_patches_again();
     printdone "source built, results in $dscfn and $sourcechanges";
 }
 

-sub cmd_sbuild {
+sub cmd_push_source {
+    prep_push();
+    fail "dgit push-source: --include-dirty/--ignore-dirty does not make".
+      "sense with push-source!" if $includedirty;
+    build_maybe_quilt_fixup();
+    if ($changesfile) {
+        my $changes = parsecontrol("$buildproductsdir/$changesfile",
+                                   "source changes file");
+        unless (test_source_only_changes($changes)) {
+            fail "user-specified changes file is not source-only";
+        }
+    } else {
+        # Building a source package is very fast, so just do it
+       build_source();
+       die "er, patches are applied dirtily but shouldn't be.."
+           if $patches_applied_dirtily;
+       $changesfile = $sourcechanges;
+    }
+    dopush();
+}
+
+sub binary_builder {
+    my ($bbuilder, $pbmc_msg, @args) = @_;
+    build_prep(WANTSRC_SOURCE);

     build_source();
     midbuild_checkchanges();
     build_source();
     midbuild_checkchanges();

-    in_parent {
+    in_bpd {

        if (act_local()) {
        if (act_local()) {

-           stat_exists $dscfn or fail "$dscfn (in parent directory): $!";
+           stat_exists $dscfn or fail "$dscfn (in build products dir): $!";

            stat_exists $sourcechanges
            stat_exists $sourcechanges

-               or fail "$sourcechanges (in parent directory): $!";
+               or fail "$sourcechanges (in build products dir): $!";

        }
        }

-       runcmd_ordryrun_local @sbuild, qw(-d), $isuite, @ARGV, $dscfn;
+       runcmd_ordryrun_local @$bbuilder, @args;

     };
     maybe_unapply_patches_again();
     };
     maybe_unapply_patches_again();

-    in_parent {
-       postbuild_mergechanges(<<END);
+    in_bpd {
+       postbuild_mergechanges($pbmc_msg);
+    };
+}
+
+sub cmd_sbuild {
+    build_prep_early();
+    binary_builder(\@sbuild, <<END, qw(-d), $isuite, @ARGV, $dscfn);

 perhaps you need to pass -A ?  (sbuild's default is to build only
 arch-specific binaries; dgit 1.4 used to override that.)
 END
 perhaps you need to pass -A ?  (sbuild's default is to build only
 arch-specific binaries; dgit 1.4 used to override that.)
 END

-    };
-}    
+}
+
+sub pbuilder ($) {
+    my ($pbuilder) = @_;
+    build_prep_early();
+    # @ARGV is allowed to contain only things that should be passed to
+    # pbuilder under debbuildopts; just massage those
+    my $wantsrc = massage_dbp_args \@ARGV;
+    fail "you asked for a builder but your debbuildopts didn't ask for".
+      " any binaries -- is this really what you meant?"
+      unless $wantsrc & WANTSRC_BUILDER;
+    fail "we must build a .dsc to pass to the builder but your debbuiltopts".
+      " forbids the building of a source package; cannot continue"
+      unless $wantsrc & WANTSRC_SOURCE;
+    # We do not want to include the verb "build" in @pbuilder because
+    # the user can customise @pbuilder and they shouldn't be required
+    # to include "build" in their customised value.  However, if the
+    # user passes any additional args to pbuilder using the dgit
+    # option --pbuilder:foo, such args need to come after the "build"
+    # verb.  opts_opt_multi_cmd does all of that.
+    binary_builder([opts_opt_multi_cmd ["build"], @$pbuilder], undef,
+                   qw(--debbuildopts), "@ARGV", qw(--distribution), $isuite,
+                   $dscfn);
+}
+
+sub cmd_pbuilder {
+    pbuilder(\@pbuilder);
+}
+
+sub cmd_cowbuilder {
+    pbuilder(\@cowbuilder);
+}

 
 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;


@@ -6269,9 +6539,27 @@ sub cmd_quilt_fixup {
     build_maybe_quilt_fixup();
 }
 
     build_maybe_quilt_fixup();
 }
 

+sub cmd_print_unapplied_treeish {
+    badusage "incorrect arguments to dgit print-unapplied-treeish" if @ARGV;
+    my $headref = git_rev_parse('HEAD');
+    my $clogp = commit_getclogp $headref;
+    $package = getfield $clogp, 'Source';
+    $version = getfield $clogp, 'Version';
+    $isuite = getfield $clogp, 'Distribution';
+    $csuite = $isuite; # we want this to be offline!
+    notpushing();
+
+    prep_ud();
+    changedir $playground;
+    my $uv = upstreamversion $version;
+    quilt_make_fake_dsc($uv);
+    my $u = quilt_fakedsc2unapplied($headref, $uv);
+    print $u, "\n" or die $!;
+}
+

 sub import_dsc_result {
     my ($dstref, $newhash, $what_log, $what_msg) = @_;
 sub import_dsc_result {
     my ($dstref, $newhash, $what_log, $what_msg) = @_;

-    my @cmd = (@git, qw(update-ref -m), $what_log, $dstref, $newhash);
+    my @cmd = (git_update_ref_cmd $what_log, $dstref, $newhash);

     runcmd @cmd;
     check_gitattrs($newhash, "source tree");
 
     runcmd @cmd;
     check_gitattrs($newhash, "source tree");
 


@@ -6390,7 +6678,7 @@ END
     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};

-       my $here = "../$f";
+       my $here = "$buildproductsdir/$f";

        if (lstat $here) {
            next if stat $here;
            fail "lstat $here works but stat gives $! !";
        if (lstat $here) {
            next if stat $here;
            fail "lstat $here works but stat gives $! !";


@@ -6525,7 +6813,7 @@ sub cmd_setup_new_tree {
 
 sub cmd_version {
     print "dgit version $our_version\n" or die $!;
 
 sub cmd_version {
     print "dgit version $our_version\n" or die $!;

-    exit 0;
+    finish 0;

 }
 
 our (%valopts_long, %valopts_short);
 }
 
 our (%valopts_long, %valopts_short);


@@ -6651,9 +6939,9 @@ sub parseopts () {
            } elsif (m/^--(gbp|dpm)$/s) {
                push @ropts, "--quilt=$1";
                $quilt_mode = $1;
            } elsif (m/^--(gbp|dpm)$/s) {
                push @ropts, "--quilt=$1";
                $quilt_mode = $1;

-           } elsif (m/^--ignore-dirty$/s) {
+           } elsif (m/^--(?:ignore|include)-dirty$/s) {

                push @ropts, $_;
                push @ropts, $_;

-               $ignoredirty = 1;
+               $includedirty = 1;

            } elsif (m/^--no-quilt-fixup$/s) {
                push @ropts, $_;
                $quilt_mode = 'nocheck';
            } elsif (m/^--no-quilt-fixup$/s) {
                push @ropts, $_;
                $quilt_mode = 'nocheck';


@@ -6672,10 +6960,13 @@ sub parseopts () {
            } elsif (m/^--delayed=(\d+)$/s) {
                push @ropts, $_;
                push @dput, $_;
            } elsif (m/^--delayed=(\d+)$/s) {
                push @ropts, $_;
                push @dput, $_;

-           } elsif (m/^--dgit-view-save=(.+)$/s) {
+           } elsif (my ($k,$v) =
+                    m/^--save-(dgit-view)=(.+)$/s ||
+                    m/^--(dgit-view)-save=(.+)$/s
+                    ) {

                push @ropts, $_;
                push @ropts, $_;

-               $split_brain_save = $1;
-               $split_brain_save =~ s#^(?!refs/)#refs/heads/#;
+               $v =~ s#^(?!refs/)#refs/heads/#;
+               $internal_object_save{$k} = $v;

            } elsif (m/^--(no-)?rm-old-changes$/s) {
                push @ropts, $_;
                $rmchanges = !$1;
            } elsif (m/^--(no-)?rm-old-changes$/s) {
                push @ropts, $_;
                $rmchanges = !$1;


@@ -6695,10 +6986,6 @@ sub parseopts () {
                push @ropts, $_;
                $tagformat_want = [ $1, 'command line', 1 ];
                # 1 menas overrides distro configuration
                push @ropts, $_;
                $tagformat_want = [ $1, 'command line', 1 ];
                # 1 menas overrides distro configuration

-           } elsif (m/^--always-split-source-build$/s) {
-               # undocumented, for testing
-               push @ropts, $_;
-               $need_split_build_invocation = 1;

            } elsif (m/^--config-lookup-explode=(.+)$/s) {
                # undocumented, for testing
                push @ropts, $_;
            } elsif (m/^--config-lookup-explode=(.+)$/s) {
                # undocumented, for testing
                push @ropts, $_;


@@ -6779,8 +7066,8 @@ sub check_env_sanity () {
        foreach my $name (qw(PIPE CHLD)) {
            my $signame = "SIG$name";
            my $signum = eval "POSIX::$signame" // die;
        foreach my $name (qw(PIPE CHLD)) {
            my $signame = "SIG$name";
            my $signum = eval "POSIX::$signame" // die;

-           ($SIG{$name} // 'DEFAULT') eq 'DEFAULT' or
-               die "$signame is set to something other than SIG_DFL\n";
+           die "$signame is set to something other than SIG_DFL\n"
+               if defined $SIG{$name} and $SIG{$name} ne 'DEFAULT';

            $blocked->ismember($signum) and
                die "$signame is blocked\n";
        }
            $blocked->ismember($signum) and
                die "$signame is blocked\n";
        }


@@ -6852,7 +7139,8 @@ sub parseopts_late_defaults () {
        $$vr = $v;
     }
 
        $$vr = $v;
     }
 

-    $need_split_build_invocation ||= quiltmode_splitbrain();
+    fail "dgit: --include-dirty is not supported in split view quilt mode"
+       if $split_brain && $includedirty;

 
     if (!defined $cleanmode) {
        local $access_forpush;
 
     if (!defined $cleanmode) {
        local $access_forpush;


@@ -6862,6 +7150,11 @@ sub parseopts_late_defaults () {
        badcfg "unknown clean-mode \`$cleanmode'" unless
            $cleanmode =~ m/^($cleanmode_re)$(?!\n)/s;
     }
        badcfg "unknown clean-mode \`$cleanmode'" unless
            $cleanmode =~ m/^($cleanmode_re)$(?!\n)/s;
     }

+
+    $buildproductsdir //= access_cfg('build-products-dir', 'RETURN-UNDEF');
+    $buildproductsdir //= '..';
+    $bpd_glob = $buildproductsdir;
+    $bpd_glob =~ s#[][\\{}*?~]#\\$&#g;

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


@@ -6877,7 +7170,7 @@ print STDERR "DAMP RUN - WILL MAKE LOCAL (UNSIGNED) CHANGES\n"
     if $dryrun_level == 1;
 if (!@ARGV) {
     print STDERR $helpmsg or die $!;
     if $dryrun_level == 1;
 if (!@ARGV) {
     print STDERR $helpmsg or die $!;

-    exit 8;
+    finish 8;

 }
 $cmd = $subcommand = shift @ARGV;
 $cmd =~ y/-/_/;
 }
 $cmd = $subcommand = shift @ARGV;
 $cmd =~ y/-/_/;


@@ -6891,3 +7184,5 @@ git_slurp_config();
 my $fn = ${*::}{"cmd_$cmd"};
 $fn or badusage "unknown operation $cmd";
 $fn->();
 my $fn = ${*::}{"cmd_$cmd"};
 $fn or badusage "unknown operation $cmd";
 $fn->();

+
+finish 0;