chiark / gitweb /
test suite: gdr-new-upstream: Check changelog is exactly right
[dgit.git] / dgit
diff --git a/dgit b/dgit
index bbfaea1..3962134 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -2,8 +2,8 @@
 # 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
@@ -63,9 +63,10 @@ our @ropts;
 our $sign = 1;
 our $dryrun_level = 0;
 our $changesfile;
-our $buildproductsdir = '..';
+our $buildproductsdir;
+our $bpd_glob;
 our $new_package = 0;
-our $ignoredirty = 0;
+our $includedirty = 0;
 our $rmonerror = 1;
 our @deliberatelies;
 our %previously;
@@ -77,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 $split_brain_save;
+our %internal_object_save;
 our $we_are_responder;
 our $we_are_initiator;
 our $initiator_tempdir;
@@ -90,6 +91,7 @@ our $chase_dsc_distro=1;
 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);
@@ -98,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 $orig_f_comp_re = qr{orig(?:-$extra_orig_namepart_re)?};
-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';
@@ -127,6 +126,8 @@ our (@mergechanges) = qw(mergechanges -f);
 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,
@@ -146,7 +147,9 @@ our %opts_opt_map = ('dget' => \@dget, # accept for compatibility
                      '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 {
@@ -164,7 +167,6 @@ our $keyid;
 autoflush STDOUT 1;
 
 our $supplementary_message = '';
-our $need_split_build_invocation = 0;
 our $split_brain = 0;
 
 END {
@@ -188,11 +190,6 @@ sub debiantag ($$) {
     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"; }
@@ -201,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 stripepoch ($) {
-    my ($vsn) = @_;
-    $vsn =~ s/^\d+\://;
-    return $vsn;
-}
-
 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 ($) {
@@ -222,12 +217,6 @@ sub changespat ($;$) {
     return "${package}_".(stripepoch $vsn)."_".($arch//'*').".changes";
 }
 
-sub upstreamversion ($) {
-    my ($vsn) = @_;
-    $vsn =~ s/-[^-]+$//;
-    return $vsn;
-}
-
 our $us = 'dgit';
 initdebug('');
 
@@ -278,20 +267,36 @@ sub quiltmode_splitbrain () {
 }
 
 sub opts_opt_multi_cmd {
+    my $extra = shift;
     my @cmd;
     push @cmd, split /\s+/, shift @_;
+    push @cmd, @$extra;
     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 bpd_abs () {
+    my $r = $buildproductsdir;
+    $r = "$maindir/$r" unless $r =~ m{^/};
+    return $r;
+}
+
+sub get_tree_of_commit ($) {
+    my ($commitish) = @_;
+    my $cdata = cmdoutput @git, qw(cat-file commit), $commitish;
+    $cdata =~ m/\n\n/;  $cdata = $`;
+    $cdata =~ m/^tree (\w+)$/m or confess "cdata $cdata ?";
+    return $1;
+}
+
 sub branch_gdr_info ($$) {
     my ($symref, $head) = @_;
     my ($status, $msg, $current, $ffq_prev, $gdrlast) =
@@ -303,21 +308,91 @@ sub branch_gdr_info ($$) {
     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 0 unless !defined $ancestor or is_fast_fwd $ancestor, $ffq_prev;
     return 1;
 }
 
+sub branch_is_gdr ($) {
+    my ($head) = @_;
+    # This is quite like git-debrebase's keycommits.
+    # We have our own implementation because:
+    #  - our algorighm can do fewer tests so is faster
+    #  - it saves testing to see if gdr is installed
+
+    # NB we use this jsut for deciding whether to run gdr make-patches
+    # Before reusing this algorithm for somthing else, its
+    # suitability should be reconsidered.
+
+    my $walk = $head;
+    local $Debian::Dgit::debugcmd_when_debuglevel = 3;
+    printdebug "branch_is_gdr $head...\n";
+    my $get_patches = sub {
+       my $t = git_cat_file "$_[0]:debian/patches", [qw(missing tree)];
+       return $t // '';
+    };
+    my $tip_patches = $get_patches->($head);
+  WALK:
+    for (;;) {
+       my $cdata = git_cat_file $walk, 'commit';
+       my ($hdrs,$msg) = $cdata =~ m{\n\n} ? ($`,$') : ($cdata,'');
+       if ($msg =~ m{^\[git-debrebase\ (
+                         anchor | changelog | make-patches | 
+                         merged-breakwater | pseudomerge
+                     ) [: ] }mx) {
+           # no need to analyse this - it's sufficient
+           # (gdr classifications: Anchor, MergedBreakwaters)
+           # (made by gdr: Pseudomerge, Changelog)
+           printdebug "branch_is_gdr  $walk gdr $1 YES\n";
+           return 1;
+       }
+       my @parents = ($hdrs =~ m/^parent (\w+)$/gm);
+       if (@parents==2) {
+           my $walk_tree = get_tree_of_commit $walk;
+           foreach my $p (@parents) {
+               my $p_tree = get_tree_of_commit $p;
+               if ($p_tree eq $walk_tree) { # pseudomerge contriburor
+                   # (gdr classification: Pseudomerge; not made by gdr)
+                   printdebug "branch_is_gdr  $walk unmarked pseudomerge\n"
+                       if $debuglevel >= 2;
+                   $walk = $p;
+                   next WALK;
+               }
+           }
+           # some other non-gdr merge
+           # (gdr classification: VanillaMerge, DgitImportUnpatched, ?)
+           printdebug "branch_is_gdr  $walk ?-2-merge NO\n";
+           return 0;
+       }
+       if (@parents>2) {
+           # (gdr classification: ?)
+           printdebug "branch_is_gdr  $walk ?-octopus NO\n";
+           return 0;
+       }
+       if ($get_patches->($walk) ne $tip_patches) {
+           # Our parent added, removed, or edited patches, and wasn't
+           # a gdr make-patches commit.  gdr make-patches probably
+           # won't do that well, then.
+           # (gdr classification of parent: AddPatches or ?)
+           printdebug "branch_is_gdr  $walk ?-patches NO\n";
+           return 0;
+       }
+       if ($tip_patches eq '' and
+           !defined git_cat_file "$walk:debian") {
+           # (gdr classification of parent: BreakwaterStart
+           printdebug "branch_is_gdr  $walk unmarked BreakwaterStart YES\n";
+           return 1;
+       }
+       # (gdr classification: Upstream Packaging Mixed Changelog)
+       printdebug "branch_is_gdr  $walk plain\n"
+           if $debuglevel >= 2;
+       $walk = $parents[0];
+    }
+}
+
 #---------- remote protocol support, common ----------
 
 # remote push initiator/responder protocol:
@@ -567,6 +642,7 @@ main usages:
   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 ...
@@ -614,6 +690,7 @@ 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.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',
@@ -628,6 +705,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.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',
@@ -813,7 +891,8 @@ sub access_forpush () {
 }
 
 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;
@@ -959,59 +1038,6 @@ sub access_giturl (;$) {
     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) = @_;
@@ -1130,7 +1156,7 @@ sub canonicalise_suite_ftpmasterapi {
        } 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";
@@ -1179,6 +1205,12 @@ sub file_in_archive_ftpmasterapi {
     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;
@@ -1286,7 +1318,14 @@ END
     }
     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;
@@ -1342,34 +1381,55 @@ sub archive_query_aptget {
 }
 
 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 @_; }
 
-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 @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 $!;
-    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;
 }
 
+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 {
@@ -1420,6 +1480,7 @@ sub canonicalise_suite_madison {
 }
 
 sub file_in_archive_madison { return undef; }
+sub package_not_wholly_new_madison { return undef; }
 
 #---------- `sshpsql' archive query method ----------
 
@@ -1497,6 +1558,7 @@ END
 }
 
 sub file_in_archive_sshpsql ($$$) { return undef; }
+sub package_not_wholly_new_sshpsql ($$$) { return undef; }
 
 #---------- `dummycat' archive query method ----------
 
@@ -1541,6 +1603,7 @@ sub archive_query_dummycat ($$) {
 }
 
 sub file_in_archive_dummycat () { return undef; }
+sub package_not_wholly_new_dummycat () { return undef; }
 
 #---------- tag format handling ----------
 
@@ -1871,13 +1934,6 @@ sub is_orig_file_in_dsc ($$) {
     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.
@@ -1975,12 +2031,12 @@ END
            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;
-               $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< ?"
@@ -2013,28 +2069,6 @@ sub make_commit ($) {
     return cmdoutput @git, qw(hash-object -w -t commit), $file;
 }
 
-sub make_commit_text ($) {
-    my ($text) = @_;
-    my ($out, $in);
-    my @cmd = (@git, qw(hash-object -w -t commit --stdin));
-    debugcmd "|",@cmd;
-    print Dumper($text) if $debuglevel > 1;
-    my $child = open2($out, $in, @cmd) or die $!;
-    my $h;
-    eval {
-       print $in $text or die $!;
-       close $in or die $!;
-       $h = <$out>;
-       $h =~ m/^\w+$/ or die;
-       $h = $&;
-       printdebug "=> $h\n";
-    };
-    close $out;
-    waitpid $child, 0 == $child or die "$child $!";
-    $? and failedcmd @cmd;
-    return $h;
-}
-
 sub clogp_authline ($) {
     my ($clogp) = @_;
     my $author = getfield $clogp, 'Maintainer';
@@ -2130,7 +2164,7 @@ sub generate_commits_from_dsc () {
     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: ";
 
@@ -2138,12 +2172,12 @@ sub generate_commits_from_dsc () {
            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) {
-           fail "accessing ../$f: $!";
+           fail "accessing $buildproductsdir/$f: $!";
        } else {
            printdebug "absent.\n";
        }
@@ -2158,14 +2192,14 @@ sub generate_commits_from_dsc () {
            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) {
-           fail "saving ../$f,fetch: $!";
+           fail "saving $buildproductsdir/$f,fetch: $!";
        } else {
            printdebug "cannot.\n";
        }
@@ -2309,22 +2343,14 @@ sub generate_commits_from_dsc () {
     }
 
     my @clogcmd = qw(dpkg-parsechangelog --format rfc822 --all);
-    debugcmd "|",@clogcmd;
-    open CLOGS, "-|", @clogcmd or die $!;
-
     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";
@@ -2350,7 +2376,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
-       # 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";
@@ -2359,9 +2385,7 @@ sub generate_commits_from_dsc () {
        $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!";
 
@@ -2602,7 +2626,7 @@ sub ensure_we_have_orig () {
     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;
     }
 }
@@ -3218,10 +3242,7 @@ END
        # here we go, then:
        my $tree_commit = $mergeinputs[0]{Commit};
 
-       my $tree = cmdoutput @git, qw(cat-file commit), $tree_commit;
-       $tree =~ m/\n\n/;  $tree = $`;
-       $tree =~ m/^tree (\w+)$/m or die "$dsc_hash tree ?";
-       $tree = $1;
+       my $tree = get_tree_of_commit $tree_commit;;
 
        # We use the changelog author of the package in question the
        # author of this pseudo-merge.  This is (roughly) correct if
@@ -3489,7 +3510,7 @@ END
 
 
 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;
@@ -3516,7 +3537,7 @@ sub multisuite_suite_child ($$$) {
        return $csuite;
     }
     printdebug "multisuite $tsuite ok (canon=$csuite)\n";
-    push @$merginputs, {
+    push @$mergeinputs, {
         Ref => lrref,
         Info => $csuite,
     };
@@ -3557,10 +3578,9 @@ sub fork_for_multisuite ($) {
        my $csubsuite = multisuite_suite_child($tsuite, \@mergeinputs,
                                               sub {
             @end = ();
-            fetch();
+            fetch_one();
            finish 0;
        });
-       # xxx collecte the ref here
 
        $csubsuite =~ s/^\Q$cbasesuite\E-/-/;
        push @csuites, $csubsuite;
@@ -3715,7 +3735,7 @@ sub clone ($) {
     clone_finish($dstdir);
 }
 
-sub fetch () {
+sub fetch_one () {
     canonicalise_suite();
     if (check_for_git()) {
        git_fetch_us();
@@ -3738,10 +3758,14 @@ END
     printdone "fetched into ".lrref();
 }
 
-sub pull () {
+sub dofetch () {
     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";
@@ -3754,7 +3778,7 @@ sub check_not_dirty () {
        }
     }
 
-    return if $ignoredirty;
+    return if $includedirty;
 
     git_check_unmodified();
 }
@@ -3775,11 +3799,11 @@ sub quiltify_nofix_bail ($$) {
 }
 
 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/;
-       if ($l =~ m{^(?:\?\?| [MADRC]) (.pc|debian/patches)}) {
+       if ($l =~ m{^(?:[?!][?!]| [MADRC]) (.pc|debian/patches)}) {
            $adds{$1}++;
        }
     }
@@ -3847,13 +3871,14 @@ sub madformat_wantfixup ($) {
 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,
               git_update_ref_cmd
               "dgit --dgit-view-save $msg HEAD=$headref",
-              $split_brain_save, $dgitview);
+              $save, $dgitview);
     runcmd @cmd;
-    return "and left in $split_brain_save";
+    return "and left in $save";
 }
 
 # An "infopair" is a tuple [ $thing, $what ]
@@ -4013,10 +4038,12 @@ sub splitbrain_pseudomerge ($$$$) {
        infopair_cond_ff($i_dep14, [ $maintview, 'HEAD' ]);
        1;
     }) {
+        $@ =~ s/^\n//; chomp $@;
        print STDERR <<END;
-$us: check failed (maybe --overwrite is needed, consult documentation)
+$@
+| Not fast forward; maybe --overwrite is needed ?  Please see dgit(1).
 END
-       die "$@";
+       finish -1;
     }
 
     my $r = pseudomerge_make_commit
@@ -4283,6 +4310,15 @@ END
     my $actualhead = git_rev_parse('HEAD');
 
     if (branch_is_gdr_unstitched_ff($symref, $actualhead, $archive_hash)) {
+       if (quiltmode_splitbrain()) {
+           my ($ffq_prev, $gdrlast) = branch_gdr_info($symref, $actualhead);
+           fail <<END;
+Branch is managed by git-debrebase ($ffq_prev
+exists), but quilt mode ($quilt_mode) implies a split view.
+Pass the right --quilt option or adjust your git config.
+Or, maybe, run git-debrebase forget-was-ever-debrebase.
+END
+       }
        runcmd_ordryrun_local @git_debrebase, 'stitch';
        $actualhead = git_rev_parse('HEAD');
     }
@@ -4412,6 +4448,29 @@ END
     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)
@@ -4425,7 +4484,8 @@ END
     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");
     }
 
@@ -4500,9 +4560,8 @@ END
     supplementary_message(<<'END');
 Push failed, while obtaining signatures on the .changes and .dsc.
 If it was just that the signature failed, you may try again by using
-debsign by hand to sign the changes
-   $changesfile
-and then dput to complete the upload.
+debsign by hand to sign the changes file (see the command dgit tried,
+above), and then dput that changes file to complete the upload.
 If you need to change the package, you must use a new version number.
 END
     if ($we_are_responder) {
@@ -4595,11 +4654,15 @@ sub branchsuite () {
     }
 }
 
-sub fetchpullargs () {
+sub package_from_d_control () {
     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) {
@@ -4618,9 +4681,7 @@ sub fetchpullargs () {
 sub cmd_fetch {
     parseopts();
     fetchpullargs();
-    my $multi_fetched = fork_for_multisuite(sub { });
-    finish 0 if $multi_fetched;
-    fetch();
+    dofetch();
 }
 
 sub cmd_pull {
@@ -4635,6 +4696,40 @@ END
     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/^-/) {
@@ -4652,11 +4747,10 @@ sub cmd_update_vcs_git () {
        }
     }
 
-    my $sourcep = parsecontrol 'debian/control', 'debian/control';
-    $package = getfield $sourcep, 'Source';
+    package_from_d_control();
     my $ctrl;
     if ($specsuite eq '.') {
-       $ctrl = $sourcep;
+       $ctrl = parsecontrol 'debian/control', 'debian/control';
     } else {
        $isuite = $specsuite;
        get_archive_dsc();
@@ -4713,21 +4807,6 @@ sub cmd_push {
     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 {
@@ -5221,7 +5300,7 @@ END
        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
 
@@ -5232,29 +5311,7 @@ END
     my $dgitview = git_rev_parse 'HEAD';
 
     changedir $maindir;
-    # When we no longer need to support squeeze, use --create-reflog
-    # instead of this:
-    ensuredir "$maindir_gitcommon/logs/refs/dgit-intern";
-    my $makelogfh = new IO::File "$maindir_gitcommon/logs/refs/$splitbraincache", '>>'
-      or die $!;
-
-    my $oldcache = git_get_ref "refs/$splitbraincache";
-    if ($oldcache eq $dgitview) {
-       my $tree = cmdoutput qw(git rev-parse), "$dgitview:";
-       # git update-ref doesn't always update, in this case.  *sigh*
-       my $dummy = make_commit_text <<END;
-tree $tree
-parent $dgitview
-author Dgit <dgit\@example.com> 1000000000 +0000
-committer Dgit <dgit\@example.com> 1000000000 +0000
-
-Dummy commit - do not use
-END
-       runcmd @git, qw(update-ref -m), "dgit $our_version - dummy",
-           "refs/$splitbraincache", $dummy;
-    }
-    runcmd @git, qw(update-ref -m), $cachekey, "refs/$splitbraincache",
-       $dgitview;
+    reflog_cache_insert "refs/$splitbraincache", $cachekey, $dgitview;
 
     changedir "$playground/work";
 
@@ -5394,12 +5451,20 @@ sub quiltify ($$$$) {
        };
        if ($quilt_mode eq 'linear') {
            print STDERR "\n$us: error: quilt fixup cannot be linear.  Stopped at:\n";
+           my $all_gdr = !!@nots;
            foreach my $notp (@nots) {
                print STDERR "$us:  ", $reportnot->($notp), "\n";
+               $all_gdr &&= $notp->{Child} &&
+                   (git_cat_file $notp->{Child}{Commit}, 'commit')
+                   =~ m{^\[git-debrebase(?! split[: ]).*\]$}m;
            }
-           print STDERR "$us: $_\n" foreach @$failsuggestion;
-           fail "quilt fixup naive history linearisation failed.\n".
- "Use dpkg-source --commit by hand; or, --quilt=smash for one ugly patch";
+           print STDERR "\n";
+           $failsuggestion =
+               [ grep { $_->[0] ne 'quilt-mode' } @$failsuggestion ]
+               if $all_gdr;
+           print STDERR "$us: $_->[1]\n" foreach @$failsuggestion;
+           fail
+ "quilt history linearisation failed.  Search \`quilt fixup' in dgit(7).\n";
        } elsif ($quilt_mode eq 'smash') {
        } elsif ($quilt_mode eq 'auto') {
            progress "quilt fixup cannot be linear, smashing...";
@@ -5553,7 +5618,7 @@ END
 
     if ($quilt_mode eq 'linear'
        && !$fopts->{'single-debian-patch'}
-       && branch_is_gdr($symref, $headref)) {
+       && branch_is_gdr($headref)) {
        # This is much faster.  It also makes patches that gdr
        # likes better for future updates without laundering.
        #
@@ -5588,14 +5653,12 @@ END
        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);
 }
 
-sub quilt_fixup_mkwork ($) {
+sub unpack_playtree_mkwork ($) {
     my ($headref) = @_;
 
     mkdir "work" or die $!;
@@ -5604,12 +5667,14 @@ sub quilt_fixup_mkwork ($) {
     runcmd @git, qw(reset -q --hard), $headref;
 }
 
-sub quilt_fixup_linkorigs ($$) {
+sub unpack_playtree_linkorigs ($$) {
     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";
@@ -5619,6 +5684,8 @@ sub quilt_fixup_linkorigs ($$) {
        link_ltarget $f, $b or die "$b $!";
         $fn->($b);
     }
+    die "$buildproductsdir: $!" if $!;
+    closedir QFD;
 }
 
 sub quilt_fixup_delete_pc () {
@@ -5640,8 +5707,8 @@ sub quilt_fixup_singlepatch ($$$) {
     # 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");
 
@@ -5681,7 +5748,7 @@ END
        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);
@@ -5698,6 +5765,31 @@ END
     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.
@@ -5729,27 +5821,13 @@ sub quilt_check_splitbrain_cache ($$) {
     push @cachekey, $srcshash->hexdigest();
     $splitbrain_cachekey = "@cachekey";
 
-    my @cmd = (@git, qw(log -g), '--pretty=format:%H %gs',
-              $splitbraincache);
     printdebug "splitbrain cachekey $splitbrain_cachekey\n";
-    debugcmd "|(probably)",@cmd;
-    my $child = open GC, "-|";  defined $child or die $!;
-    if (!$child) {
-       chdir $maindir or die $!;
-       if (!stat "$maindir_gitcommon/logs/refs/$splitbraincache") {
-           $! == ENOENT or die $!;
-           printdebug ">(no reflog)\n";
-           finish 0;
-       }
-       exec @cmd; die $!;
-    }
-    while (<GC>) {
-       chomp;
-       printdebug ">| ", $_, "\n" if $debuglevel > 1;
-       next unless m/^(\w+) (\S.*\S)$/ && $2 eq $splitbrain_cachekey;
-           
-       my $cachehit = $1;
-       quilt_fixup_mkwork($headref);
+
+    my $cachehit = reflog_cache_lookup
+       "refs/$splitbraincache", $splitbrain_cachekey;
+
+    if ($cachehit) {
+       unpack_playtree_mkwork($headref);
        my $saved = maybe_split_brain_save $headref, $cachehit, "cache-hit";
        if ($cachehit ne $headref) {
            progress "dgit view: found cached ($saved)";
@@ -5760,8 +5838,6 @@ sub quilt_check_splitbrain_cache ($$) {
        progress "dgit view: found cached, no changes required";
        return ($headref, $splitbrain_cachekey);
     }
-    die $! if GC->error;
-    failedcmd unless close GC;
 
     printdebug "splitbrain cache miss\n";
     return (undef, $splitbrain_cachekey);
@@ -5851,24 +5927,7 @@ sub quilt_fixup_multipatch ($$$) {
            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';
-
-    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";
+    my $unapplied=quilt_fakedsc2unapplied($headref, $upstreamversion);
 
     ensuredir '.pc';
 
@@ -5880,13 +5939,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
- 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 '..';
 
-    quilt_fixup_mkwork($headref);
+    unpack_playtree_mkwork($headref);
 
     my $mustdeletepc=0;
     if (stat_exists ".pc") {
@@ -5946,12 +6005,21 @@ END
 
     my @failsuggestion;
     if (!($diffbits->{O2H} & $diffbits->{O2A})) {
-        push @failsuggestion, "This might be a patches-unapplied branch.";
-    }  elsif (!($diffbits->{H2A} & $diffbits->{O2A})) {
-        push @failsuggestion, "This might be a patches-applied branch.";
+        push @failsuggestion, [ 'unapplied',
+                              "This might be a patches-unapplied branch." ];
+    } elsif (!($diffbits->{H2A} & $diffbits->{O2A})) {
+        push @failsuggestion, [ 'applied',
+                               "This might be a patches-applied branch." ];
     }
-    push @failsuggestion, "Maybe you need to specify one of".
-        " --[quilt=]gbp --[quilt=]dpm --quilt=unapplied ?";
+    push @failsuggestion, [ 'quilt-mode',
+ "Maybe you need one of --[quilt=]gbp --[quilt=]dpm --quilt=unapplied ?" ];
+
+    push @failsuggestion, [ 'gitattrs',
+ "Warning: Tree has .gitattributes.  See GITATTRIBUTES in dgit(7)." ]
+       if stat_exists '.gitattributes';
+
+    push @failsuggestion, [ 'origs',
+ "Maybe orig tarball(s) are not identical to git representation?" ];
 
     if (quiltmode_splitbrain()) {
        quiltify_splitbrain($clogp, $unapplied, $headref, $oldtiptree,
@@ -6058,6 +6126,10 @@ sub cmd_clean () {
     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++;
@@ -6066,6 +6138,7 @@ sub build_or_push_prep_early () {
     $isuite = getfield $clogp, 'Distribution';
     $package = getfield $clogp, 'Source';
     $version = getfield $clogp, 'Version';
+    $dscfn = dscfn($version);
 }
 
 sub build_prep_early () {
@@ -6074,9 +6147,12 @@ sub build_prep_early () {
     check_not_dirty();
 }
 
-sub build_prep () {
+sub build_prep ($) {
+    my ($wantsrc) = @_;
     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;
@@ -6135,28 +6211,11 @@ sub changesopts () {
 
 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;
-#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:
@@ -6171,35 +6230,34 @@ sub massage_dbp_args ($;$) {
     }
     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;
 }
 
-sub in_parent (&) {
+sub in_bpd (&) {
     my ($fn) = @_;
     my $wasdir = must_getcwd();
-    changedir "..";
+    changedir $buildproductsdir;
     $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 @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
@@ -6235,8 +6293,11 @@ END
 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.
@@ -6246,13 +6307,13 @@ END
 
 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) = @_;
-    if ($wantsrc == 1) {
-       in_parent {
+    if ($wantsrc == (WANTSRC_SOURCE|WANTSRC_BUILDER)) {
+       in_bpd {
            postbuild_mergechanges(undef);
        };
     } else {
@@ -6262,15 +6323,18 @@ sub postbuild_mergechanges_vanilla ($) {
 
 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;
-    if ($wantsrc > 0) {
+    build_prep($wantsrc);
+    if ($wantsrc & WANTSRC_SOURCE) {
        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;
@@ -6294,12 +6358,11 @@ sub cmd_gbp_build {
     # 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
-       $need_split_build_invocation = 1;
     }
 
     my @dbp = @dpkgbuildpackage;
@@ -6313,7 +6376,7 @@ sub cmd_gbp_build {
            $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));
@@ -6337,17 +6400,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_prep();
     }
     maybe_unapply_patches_again();
-    if ($wantsrc < 2) {
+    if ($wantsrc & WANTSRC_BUILDER) {
        push @cmd, changesopts();
        runcmd_ordryrun_local @cmd, @ARGV;
     }
@@ -6355,77 +6418,158 @@ sub cmd_gbp_build {
 }
 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 {
-    build_prep_early();
-    build_prep();
     $sourcechanges = changespat $version,'source';
     if (act_local()) {
-       unlink "../$sourcechanges" or $!==ENOENT
+       unlink "$buildproductsdir/$sourcechanges" or $!==ENOENT
            or fail "remove $sourcechanges: $!";
     }
-    $dscfn = dscfn($version);
     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;
-        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 {
-        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),
-      'exec >$1; shift; exec "$@"','x',
-      "../$sourcechanges",
+      'exec >../$1; shift; exec "$@"','x', $sourcechanges,
       @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 {
-    build_prep_early();
     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";
 }
 
-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();
-    in_parent {
+    in_bpd {
        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
-               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();
-    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
-    };
-}    
+}
+
+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;
@@ -6434,6 +6578,24 @@ sub cmd_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) = @_;
     my @cmd = (git_update_ref_cmd $what_log, $dstref, $newhash);
@@ -6555,7 +6717,7 @@ END
     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 $! !";
@@ -6816,9 +6978,9 @@ sub parseopts () {
            } 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, $_;
-               $ignoredirty = 1;
+               $includedirty = 1;
            } elsif (m/^--no-quilt-fixup$/s) {
                push @ropts, $_;
                $quilt_mode = 'nocheck';
@@ -6837,10 +6999,13 @@ sub parseopts () {
            } 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, $_;
-               $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;
@@ -6860,10 +7025,6 @@ sub parseopts () {
                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, $_;
@@ -6944,8 +7105,8 @@ sub check_env_sanity () {
        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";
        }
@@ -7017,7 +7178,8 @@ sub parseopts_late_defaults () {
        $$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;
@@ -7027,6 +7189,11 @@ sub parseopts_late_defaults () {
        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}) {