dgit: opts_opt_multi_cmd: New @$extra feature

[dgit.git] / dgit

diff --git a/dgit b/dgit
index 357adc98aac352197b771717cf3e0a6f017d36fc..1a4700ccfdb9af6e6ae544ff17cdd259475e9edb 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -2,8 +2,8 @@
 # dgit
 # Integration between git and Debian-style archives
 #
 # dgit
 # Integration between git and Debian-style archives
 #

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

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


@@ -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;


@@ -165,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 {


@@ -274,20 +275,28 @@ sub quiltmode_splitbrain () {
 }
 
 sub opts_opt_multi_cmd {
 }
 
 sub opts_opt_multi_cmd {

+    my $extra = shift;

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

+    push @cmd, @$extra;

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

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

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

+sub bpd_abs () {
+    my $r = $buildproductsdir;
+    $r = "$maindir/$r" unless $r =~ m{^/};
+    return $r;
+}
+

 sub branch_gdr_info ($$) {
     my ($symref, $head) = @_;
     my ($status, $msg, $current, $ffq_prev, $gdrlast) =
 sub branch_gdr_info ($$) {
     my ($symref, $head) = @_;
     my ($status, $msg, $current, $ffq_prev, $gdrlast) =


@@ -1237,7 +1246,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;


@@ -2105,7 +2121,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: ";
 


@@ -2113,12 +2129,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";
        }


@@ -2133,14 +2149,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";
        }


@@ -2567,7 +2583,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;
     }
 }


@@ -3723,7 +3739,7 @@ sub check_not_dirty () {
        }
     }
 
        }
     }
 

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

 
     git_check_unmodified();
 }
 
     git_check_unmodified();
 }


@@ -3985,7 +4001,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;
     }


@@ -4742,21 +4758,6 @@ sub cmd_push {
     dopush();
 }
 
     dopush();
 }
 

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

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


@@ -5625,7 +5626,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 $!;


@@ -5634,12 +5635,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";


@@ -5649,6 +5652,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 () {


@@ -5670,8 +5675,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");
 


@@ -5711,7 +5716,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);


@@ -5779,7 +5784,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)";


@@ -5910,13 +5915,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") {


@@ -6088,6 +6093,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++;


@@ -6104,9 +6113,12 @@ sub build_prep_early () {
     check_not_dirty();
 }
 
     check_not_dirty();
 }
 

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

     build_prep_early();
     build_prep_early();

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

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


@@ -6176,16 +6188,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


@@ -6201,12 +6208,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";


@@ -6215,21 +6222,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


@@ -6265,8 +6273,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.


@@ -6276,13 +6287,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 {


@@ -6294,13 +6305,12 @@ 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) {
+    build_prep($wantsrc);
+    if ($wantsrc & WANTSRC_SOURCE) {

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

-    } else {
-       build_prep();

     }
     }

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

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


@@ -6324,7 +6334,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 +6353,7 @@ sub cmd_gbp_build {
            $gbp_build[0] = 'gbp buildpackage';
        }
     }
            $gbp_build[0] = 'gbp buildpackage';
        }
     }

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

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


@@ -6367,17 +6377,17 @@ sub cmd_gbp_build {
        }
     }
 
        }
     }
 

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

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

-       build_prep();

     }
     maybe_unapply_patches_again();
     }
     maybe_unapply_patches_again();

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

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


@@ -6385,62 +6395,107 @@ sub cmd_gbp_build {
 }
 sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0
 
 }
 sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0
 

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

 }
 
 sub build_source {
 }
 
 sub build_source {

-    build_prep_early();
-    build_prep();

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

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

            or fail "remove $sourcechanges: $!";
     }
     $dscfn = dscfn($version);
     my @cmd = (@dpkgsource, qw(-b --));
            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;
         changedir $playground;

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

         }
     } else {
         }
     } else {

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

     }
     }

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

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

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

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

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

 }
 
 sub cmd_build_source {
 }
 
 sub cmd_build_source {

-    build_prep_early();

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

+    build_prep(WANTSRC_SOURCE);

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

+sub cmd_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 cmd_sbuild {
 sub cmd_sbuild {

+    build_prep(WANTSRC_SOURCE); # not BUILDER because sbuild uses the .dsc

     build_source();
     midbuild_checkchanges();
     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


@@ -6449,7 +6504,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.)


@@ -6585,7 +6640,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 $! !";


@@ -6846,9 +6901,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';


@@ -6891,7 +6946,7 @@ sub parseopts () {
                $tagformat_want = [ $1, 'command line', 1 ];
                # 1 menas overrides distro configuration
            } elsif (m/^--always-split-source-build$/s) {
                $tagformat_want = [ $1, 'command line', 1 ];
                # 1 menas overrides distro configuration
            } elsif (m/^--always-split-source-build$/s) {

-               # undocumented, for testing
+               # undocumented, was once for testing, now a no-op

                push @ropts, $_;
                $need_split_build_invocation = 1;
            } elsif (m/^--config-lookup-explode=(.+)$/s) {
                push @ropts, $_;
                $need_split_build_invocation = 1;
            } elsif (m/^--config-lookup-explode=(.+)$/s) {


@@ -7049,6 +7104,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');


@@ -7057,6 +7115,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}) {