chiark / gitweb /
~ianmdlvl / dgit.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
test suite: Honour DGIT_SCHROOT_CHROOT to set the schroot to use for the sbuild tests.
[dgit.git] / dgit
diff --git a/dgit b/dgit
index 7242c78244d93aa642eb470765075f51dcc46176..3afaf193a4127e320ce611162b9f5f896086350f 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -63,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;
@@ -90,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);
@@ -164,7 +166,7 @@ our $keyid;
 autoflush STDOUT 1;
 
 our $supplementary_message = '';
 autoflush STDOUT 1;
 
 our $supplementary_message = '';
-our $need_split_build_invocation = 0;
+our $need_split_build_invocation = 1;
 our $split_brain = 0;
 
 END {
 our $split_brain = 0;
 
 END {
@@ -188,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"; }
@@ -292,6 +289,12 @@ sub dgit_privdir () {
     our $dgit_privdir_made //= ensure_a_playground 'dgit';
 }
 
     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) =
 sub branch_gdr_info ($$) {
     my ($symref, $head) = @_;
     my ($status, $msg, $current, $ffq_prev, $gdrlast) =
@@ -614,6 +617,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.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',
@@ -628,6 +632,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',
@@ -959,59 +964,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) = @_;
@@ -1179,6 +1131,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;
@@ -1286,7 +1244,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;
@@ -1342,34 +1307,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 {
@@ -1420,6 +1406,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 ----------
 
@@ -1497,6 +1484,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 ----------
 
@@ -1541,6 +1529,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 ----------
 
@@ -2130,7 +2119,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: ";
 
@@ -2138,12 +2127,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";
        }
@@ -2158,14 +2147,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";
        }
@@ -2309,22 +2298,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";
@@ -2350,7 +2331,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";
@@ -2359,9 +2340,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!";
 
@@ -2602,7 +2581,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;
     }
 }
@@ -3738,10 +3717,14 @@ END
     printdone "fetched into ".lrref();
 }
 
     printdone "fetched into ".lrref();
 }
 
-sub pull () {
+sub dofetch () {
     my $multi_fetched = fork_for_multisuite(sub { });
     fetch_one() unless $multi_fetched; # parent
     finish 0 if $multi_fetched eq '0'; # child
     my $multi_fetched = fork_for_multisuite(sub { });
     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";
@@ -3754,7 +3737,7 @@ sub check_not_dirty () {
        }
     }
 
        }
     }
 
-    return if $ignoredirty;
+    return if $includedirty;
 
     git_check_unmodified();
 }
 
     git_check_unmodified();
 }
@@ -3775,11 +3758,11 @@ sub quiltify_nofix_bail ($$) {
 }
 
 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{^(?:\?\?| [MADRC]) (.pc|debian/patches)}) {
+       if ($l =~ m{^(?:[?!][?!]| [MADRC]) (.pc|debian/patches)}) {
            $adds{$1}++;
        }
     }
            $adds{$1}++;
        }
     }
@@ -4016,7 +3999,7 @@ sub splitbrain_pseudomerge ($$$$) {
         $@ =~ s/^\n//; chomp $@;
        print STDERR <<END;
 $@
         $@ =~ s/^\n//; chomp $@;
        print STDERR <<END;
 $@
-| Not fast forward; maybe --overwrite is needed, see dgit(1)
+| Not fast forward; maybe --overwrite is needed ?  Please see dgit(1).
 END
        finish -1;
     }
 END
        finish -1;
     }
@@ -4414,6 +4397,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)
@@ -4624,9 +4630,7 @@ sub fetchpullargs () {
 sub cmd_fetch {
     parseopts();
     fetchpullargs();
 sub cmd_fetch {
     parseopts();
     fetchpullargs();
-    my $multi_fetched = fork_for_multisuite(sub { });
-    finish 0 if $multi_fetched;
-    fetch_one();
+    dofetch();
 }
 
 sub cmd_pull {
 }
 
 sub cmd_pull {
@@ -4641,6 +4645,40 @@ 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/^-/) {
 sub cmd_update_vcs_git () {
     my $specsuite;
     if (@ARGV==0 || $ARGV[0] =~ m/^-/) {
@@ -4720,6 +4758,8 @@ sub cmd_push {
 
 sub cmd_push_source {
     prep_push();
 
 sub cmd_push_source {
     prep_push();
+    fail "dgit push-source: --include-dirty/--ignore-dirty does not make".
+      "sense with push-source!" if $includedirty;
     if ($changesfile) {
         my $changes = parsecontrol("$buildproductsdir/$changesfile",
                                    "source changes file");
     if ($changesfile) {
         my $changes = parsecontrol("$buildproductsdir/$changesfile",
                                    "source changes file");
@@ -5226,7 +5266,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
 
@@ -5601,7 +5641,7 @@ END
         @git, qw(pull --ff-only -q), "$playground/work", qw(master);
 }
 
         @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 $!;
@@ -5610,12 +5650,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";
@@ -5625,6 +5667,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 () {
@@ -5646,8 +5690,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");
 
@@ -5687,7 +5731,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);
@@ -5755,7 +5799,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)";
@@ -5886,13 +5930,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") {
@@ -6064,6 +6108,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++;
@@ -6152,16 +6200,11 @@ sub massage_dbp_args ($;$) {
     #    unless we're not doing a split build and want dpkg-source
     #    as cleanmode, in which case we can do nothing
     #
     #    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!
     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;
     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;
+       return WANTSRC_BUILDER;
     }
     # -nc has the side effect of specifying -b if nothing else specified
     # and some combinations of -S, -b, et al, are errors, rather than
     }
     # -nc has the side effect of specifying -b if nothing else specified
     # and some combinations of -S, -b, et al, are errors, rather than
@@ -6177,12 +6220,12 @@ 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;
+    my $r = WANTSRC_BUILDER;
     if ($need_split_build_invocation) {
        printdebug "massage split $dmode.\n";
     if ($need_split_build_invocation) {
        printdebug "massage split $dmode.\n";
-       $r = $dmode =~ m/[S]/     ? +2 :
-            $dmode =~ y/gGF/ABb/ ? +1 :
-            $dmode =~ m/[ABb]/   ?  0 :
+       $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";
             die "$dmode ?";
     }
     printdebug "massage done $r $dmode.\n";
@@ -6191,21 +6234,22 @@ sub massage_dbp_args ($;$) {
     return $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
@@ -6241,8 +6285,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.
@@ -6252,13 +6299,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 {
@@ -6270,13 +6317,13 @@ sub cmd_build {
     build_prep_early();
     my @dbp = (@dpkgbuildpackage, qw(-us -uc), changesopts_initial(), @ARGV);
     my $wantsrc = massage_dbp_args \@dbp;
     build_prep_early();
     my @dbp = (@dpkgbuildpackage, qw(-us -uc), changesopts_initial(), @ARGV);
     my $wantsrc = massage_dbp_args \@dbp;
-    if ($wantsrc > 0) {
+    if ($wantsrc & WANTSRC_SOURCE) {
        build_source();
        midbuild_checkchanges_vanilla $wantsrc;
     } else {
        build_prep();
     }
        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;
@@ -6300,7 +6347,7 @@ 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();
 
     if ($gbp_make_orig) {
        clean_tree();
@@ -6343,7 +6390,7 @@ sub cmd_gbp_build {
        }
     }
 
        }
     }
 
-    if ($wantsrc > 0) {
+    if ($wantsrc & WANTSRC_SOURCE) {
        build_source();
        midbuild_checkchanges_vanilla $wantsrc;
     } else {
        build_source();
        midbuild_checkchanges_vanilla $wantsrc;
     } else {
@@ -6353,7 +6400,7 @@ sub cmd_gbp_build {
        build_prep();
     }
     maybe_unapply_patches_again();
        build_prep();
     }
     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;
     }
@@ -6372,7 +6419,7 @@ sub build_source {
     build_prep();
     $sourcechanges = changespat $version,'source';
     if (act_local()) {
     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);
            or fail "remove $sourcechanges: $!";
     }
     $dscfn = dscfn($version);
@@ -6389,7 +6436,7 @@ sub build_source {
               ($f =~ m/\.debian\.tar(?:\.\w+)$/ &&
                $f eq srcfn($version, $&));
             printdebug "source copy, found $f - renaming\n";
               ($f =~ m/\.debian\.tar(?:\.\w+)$/ &&
                $f eq srcfn($version, $&));
             printdebug "source copy, found $f - renaming\n";
-            rename "$playground/$f", "../$f" or $!==ENOENT
+            rename "$playground/$f", "$buildproductsdir/$f" or $!==ENOENT
               or fail "put in place new source file ($f): $!";
         }
     } else {
               or fail "put in place new source file ($f): $!";
         }
     } else {
@@ -6401,7 +6448,7 @@ sub build_source {
     }
     runcmd_ordryrun_local qw(sh -ec),
       'exec >$1; shift; exec "$@"','x',
     }
     runcmd_ordryrun_local qw(sh -ec),
       'exec >$1; shift; exec "$@"','x',
-      "../$sourcechanges",
+      "$buildproductsdir/$sourcechanges",
       @dpkggenchanges, qw(-S), changesopts();
 }
 
       @dpkggenchanges, qw(-S), changesopts();
 }
 
@@ -6416,7 +6463,7 @@ sub cmd_build_source {
 sub cmd_sbuild {
     build_source();
     midbuild_checkchanges();
 sub cmd_sbuild {
     build_source();
     midbuild_checkchanges();
-    in_parent {
+    in_bpd {
        if (act_local()) {
            stat_exists $dscfn or fail "$dscfn (in parent directory): $!";
            stat_exists $sourcechanges
        if (act_local()) {
            stat_exists $dscfn or fail "$dscfn (in parent directory): $!";
            stat_exists $sourcechanges
@@ -6425,7 +6472,7 @@ sub cmd_sbuild {
        runcmd_ordryrun_local @sbuild, qw(-d), $isuite, @ARGV, $dscfn;
     };
     maybe_unapply_patches_again();
        runcmd_ordryrun_local @sbuild, qw(-d), $isuite, @ARGV, $dscfn;
     };
     maybe_unapply_patches_again();
-    in_parent {
+    in_bpd {
        postbuild_mergechanges(<<END);
 perhaps you need to pass -A ?  (sbuild's default is to build only
 arch-specific binaries; dgit 1.4 used to override that.)
        postbuild_mergechanges(<<END);
 perhaps you need to pass -A ?  (sbuild's default is to build only
 arch-specific binaries; dgit 1.4 used to override that.)
@@ -6561,7 +6608,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 $! !";
@@ -6822,9 +6869,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';
@@ -7025,6 +7072,9 @@ sub parseopts_late_defaults () {
 
     $need_split_build_invocation ||= quiltmode_splitbrain();
 
 
     $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;
        $cleanmode = access_cfg('clean-mode', 'RETURN-UNDEF');
     if (!defined $cleanmode) {
        local $access_forpush;
        $cleanmode = access_cfg('clean-mode', 'RETURN-UNDEF');
@@ -7033,6 +7083,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}) {
Unnamed repository; edit this file 'description' to name the repository.