chiark / gitweb /
dgit-user(7): work in progress
[dgit.git] / dgit
diff --git a/dgit b/dgit
index 04e61b82f6ae92de249fc599f1604111dcb55801..7508fe15a2493295e01f0d3cc7587472cc51b2f1 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -41,6 +41,7 @@ use Carp;
 use Debian::Dgit;
 
 our $our_version = 'UNRELEASED'; ###substituted###
+our $absurdity = undef; ###substituted###
 
 our @rpushprotovsn_support = qw(4 3 2); # 4 is new tag format
 our $protovsn;
@@ -73,6 +74,12 @@ our $tagformat_want;
 our $tagformat;
 our $tagformatfn;
 
+our %forceopts = map { $_=>0 }
+    qw(unrepresentable unsupported-source-format
+       dsc-changes-mismatch
+       import-gitapply-absurd
+       import-gitapply-no-absurd);
+
 our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
 
 our $suite_re = '[-+.0-9a-z]+';
@@ -86,7 +93,7 @@ our $splitbraincache = 'dgit-intern/quilt-cache';
 
 our (@git) = qw(git);
 our (@dget) = qw(dget);
-our (@curl) = qw(curl -f);
+our (@curl) = qw(curl);
 our (@dput) = qw(dput);
 our (@debsign) = qw(debsign);
 our (@gpg) = qw(gpg);
@@ -144,6 +151,11 @@ our @ourdscfield = qw(Dgit Vcs-Dgit-Master);
 our $csuite;
 our $instead_distro;
 
+if (!defined $absurdity) {
+    $absurdity = $0;
+    $absurdity =~ s{/[^/]+$}{/absurd} or die;
+}
+
 sub debiantag ($$) {
     my ($v,$distro) = @_;
     return $tagformatfn->($v, $distro);
@@ -222,6 +234,20 @@ END {
 
 sub badcfg { print STDERR "$us: invalid configuration: @_\n"; exit 12; }
 
+sub forceable_fail ($$) {
+    my ($forceoptsl, $msg) = @_;
+    fail $msg unless grep { $forceopts{$_} } @$forceoptsl;
+    print STDERR "warning: overriding problem due to --force:\n". $msg;
+}
+
+sub forceing ($) {
+    my ($forceoptsl) = @_;
+    my @got = grep { $forceopts{$_} } @$forceoptsl;
+    return 0 unless @got;
+    print STDERR
+ "warning: skipping checks or functionality due to --force-$got[0]\n";
+}
+
 sub no_such_package () {
     print STDERR "$us: package $package does not exist in suite $isuite\n";
     exit 4;
@@ -551,7 +577,7 @@ our %defcfg = ('dgit.default.distro' => 'debian',
               'dgit.default.ssh' => 'ssh',
               'dgit.default.archive-query' => 'madison:',
               'dgit.default.sshpsql-dbname' => 'service=projectb',
-              'dgit.default.dgit-tag-format' => 'old,new,maint',
+              'dgit.default.dgit-tag-format' => 'new,old,maint',
               # old means "repo server accepts pushes with old dgit tags"
               # new means "repo server accepts pushes with new dgit tags"
               # maint means "repo server accepts split brain pushes"
@@ -561,7 +587,6 @@ 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.dgit-tag-format' => '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',
@@ -956,7 +981,7 @@ sub pool_dsc_subpath ($$) {
 
 sub archive_api_query_cmd ($) {
     my ($subpath) = @_;
-    my @cmd = qw(curl -sS);
+    my @cmd = (@curl, qw(-sS));
     my $url = access_cfg('archive-query-url');
     if ($url =~ m#^https://([-.0-9a-z]+)/#) {
        my $host = $1;
@@ -990,7 +1015,16 @@ sub api_query ($$) {
     badcfg "ftpmasterapi archive query method takes no data part"
        if length $data;
     my @cmd = archive_api_query_cmd($subpath);
+    my $url = $cmd[$#cmd];
+    push @cmd, qw(-w %{http_code});
     my $json = cmdoutput @cmd;
+    unless ($json =~ s/\d+\d+\d$//) {
+       failedcmd_report_cmd undef, @cmd;
+       fail "curl failed to print 3-digit HTTP code";
+    }
+    my $code = $&;
+    fail "fetch of $url gave HTTP code $code"
+       unless $url =~ m#^file://# or $code =~ m/^2/;
     return decode_json($json);
 }
 
@@ -1286,7 +1320,9 @@ sub get_archive_dsc () {
        $dsc = parsecontrolfh($dscfh,$dscurl,1);
        printdebug Dumper($dsc) if $debuglevel>1;
        my $fmt = getfield $dsc, 'Format';
-       fail "unsupported source format $fmt, sorry" unless $format_ok{$fmt};
+       $format_ok{$fmt} or forceable_fail [qw(unsupported-source-format)],
+           "unsupported source format $fmt, sorry";
+           
        $dsc_checked = !!$digester;
        printdebug "get_archive_dsc: Version ".(getfield $dsc, 'Version')."\n";
        return;
@@ -1322,7 +1358,7 @@ sub check_for_git () {
        my $suffix = access_cfg('git-check-suffix','git-suffix',
                                'RETURN-UNDEF') // '.git';
        my $url = "$prefix/$package$suffix";
-       my @cmd = (qw(curl -sS -I), $url);
+       my @cmd = (@curl, qw(-sS -I), $url);
        my $result = cmdoutput @cmd;
        $result =~ s/^\S+ 200 .*\n\r?\n//;
        # curl -sS -I with https_proxy prints
@@ -1846,7 +1882,7 @@ sub generate_commits_from_dsc () {
        printdebug "import clog $r1clogp->{version} becomes r1\n";
     }
     die $! if CLOGS->error;
-    close CLOGS or $?==(SIGPIPE<<8) or failedcmd @clogcmd;
+    close CLOGS or $?==SIGPIPE or failedcmd @clogcmd;
 
     $clogp or fail "package changelog has no entries!";
 
@@ -1932,25 +1968,54 @@ END
        local $ENV{GIT_AUTHOR_EMAIL} = $authline[1];
        local $ENV{GIT_AUTHOR_DATE} =  $authline[2];
 
-       eval {
-           runcmd shell_cmd 'exec >/dev/null 2>../../gbp-pq-output',
-               gbp_pq, qw(import);
-       };
-       if ($@) {
-           { local $@; eval { runcmd qw(cat ../../gbp-pq-output); }; }
-           die $@;
-       }
+       my $path = $ENV{PATH} or die;
+
+       foreach my $use_absurd (qw(0 1)) {
+           local $ENV{PATH} = $path;
+           if ($use_absurd) {
+               chomp $@;
+               progress "warning: $@";
+               $path = "$absurdity:$path";
+               progress "$us: trying slow absurd-git-apply...";
+               rename "../../gbp-pq-output","../../gbp-pq-output.0"
+                   or $!==ENOENT
+                   or die $!;
+           }
+           eval {
+               die "forbid absurd git-apply\n" if $use_absurd
+                   && forceing [qw(import-gitapply-no-absurd)];
+               die "only absurd git-apply!\n" if !$use_absurd
+                   && forceing [qw(import-gitapply-absurd)];
+
+               local $ENV{PATH} = $path if $use_absurd;
+
+               my @showcmd = (gbp_pq, qw(import));
+               my @realcmd = shell_cmd
+                   'exec >/dev/null 2>../../gbp-pq-output', @showcmd;
+               debugcmd "+",@realcmd;
+               if (system @realcmd) {
+                   die +(shellquote @showcmd).
+                       " failed: ".
+                       failedcmd_waitstatus()."\n";
+               }
 
-       my $gapplied = git_rev_parse('HEAD');
-       my $gappliedtree = cmdoutput @git, qw(rev-parse HEAD:);
-       $gappliedtree eq $dappliedtree or
-           fail <<END;
+               my $gapplied = git_rev_parse('HEAD');
+               my $gappliedtree = cmdoutput @git, qw(rev-parse HEAD:);
+               $gappliedtree eq $dappliedtree or
+                   fail <<END;
 gbp-pq import and dpkg-source disagree!
  gbp-pq import gave commit $gapplied
  gbp-pq import gave tree $gappliedtree
  dpkg-source --before-build gave tree $dappliedtree
 END
-       $rawimport_hash = $gapplied;
+               $rawimport_hash = $gapplied;
+           };
+           last unless $@;
+       }
+       if ($@) {
+           { local $@; eval { runcmd qw(cat ../../gbp-pq-output); }; }
+           die $@;
+       }
     }
 
     progress "synthesised git commit from .dsc $cversion";
@@ -2008,7 +2073,7 @@ sub complete_file_from_dsc ($$) {
        $furl .= "/$f";
        die "$f ?" unless $f =~ m/^\Q${package}\E_/;
        die "$f ?" if $f =~ m#/#;
-       runcmd_ordryrun_local @curl,qw(-o),$tf,'--',"$furl";
+       runcmd_ordryrun_local @curl,qw(-f -o),$tf,'--',"$furl";
        return 0 if !act_local();
        $downloaded = 1;
     }
@@ -2103,7 +2168,7 @@ sub git_fetch_us () {
            my ($objid,$rrefname) = ($1,$2);
            if (!$wanted_rref->($rrefname)) {
                print STDERR <<END;
-warning: git-ls-remote @look reported $rrefname; this is silly, ignoring it.
+warning: git ls-remote @look reported $rrefname; this is silly, ignoring it.
 END
                next;
            }
@@ -2136,11 +2201,11 @@ END
            if (!exists $wantr{$rrefname}) {
                if ($wanted_rref->($rrefname)) {
                    printdebug <<END;
-git-fetch @fspecs created $lrefname which git-ls-remote @look didn't list.
+git-fetch @fspecs created $lrefname which git ls-remote @look didn't list.
 END
                } else {
                    print STDERR <<END
-warning: git-fetch @fspecs created $lrefname; this is silly, deleting it.
+warning: git fetch @fspecs created $lrefname; this is silly, deleting it.
 END
                }
                runcmd_ordryrun_local @git, qw(update-ref -d), $lrefname;
@@ -2155,24 +2220,24 @@ END
            next if $got eq $want;
            if (!defined $objgot{$want}) {
                print STDERR <<END;
-warning: git-ls-remote suggests we want $lrefname
+warning: git ls-remote suggests we want $lrefname
 warning:  and it should refer to $want
-warning:  but git-fetch didn't fetch that object to any relevant ref.
+warning:  but git fetch didn't fetch that object to any relevant ref.
 warning:  This may be due to a race with someone updating the server.
 warning:  Will try again...
 END
                next FETCH_ITERATION;
            }
            printdebug <<END;
-git-fetch @fspecs made $lrefname=$got but want git-ls-remote @look says $want
+git-fetch @fspecs made $lrefname=$got but want git ls-remote @look says $want
 END
            runcmd_ordryrun_local @git, qw(update-ref -m),
-               "dgit fetch git-fetch fixup", $lrefname, $want;
+               "dgit fetch git fetch fixup", $lrefname, $want;
            $lrfetchrefs_f{$lrefname} = $want;
        }
        last;
     }
-    printdebug "git_fetch_us: git-fetch --no-insane emulation complete\n",
+    printdebug "git_fetch_us: git fetch --no-insane emulation complete\n",
        Dumper(\%lrfetchrefs_f);
 
     my %here;
@@ -2897,23 +2962,32 @@ sub splitbrain_pseudomerge ($$$$) {
 
     return $dgitview if is_fast_fwd $archive_hash, $dgitview;
 
-    my $t_dep14 = debiantag_maintview $i_arch_v->[0], access_basedistro;
-    my $i_dep14 = infopair_lrf_tag_lookup($t_dep14, "maintainer view tag");
-    my $t_dgit = debiantag_new $i_arch_v->[0], access_basedistro;
-    my $i_dgit = infopair_lrf_tag_lookup($t_dgit, "dgit view tag");
-    my $i_archive = [ $archive_hash, "current archive contents" ];
-
-    printdebug "splitbrain_pseudomerge i_archive @$i_archive\n";
-
-    infopair_cond_equal($i_dgit, $i_archive);
-    infopair_cond_ff($i_dep14, $i_dgit);
-    $overwrite_version // infopair_cond_ff($i_dep14, [ $maintview, 'HEAD' ]);
+    if (defined $overwrite_version) {
+    } elsif (!eval {
+       my $t_dep14 = debiantag_maintview $i_arch_v->[0], access_basedistro;
+       my $i_dep14 = infopair_lrf_tag_lookup($t_dep14, "maintainer view tag");
+       my $t_dgit = debiantag_new $i_arch_v->[0], access_basedistro;
+       my $i_dgit = infopair_lrf_tag_lookup($t_dgit, "dgit view tag");
+       my $i_archive = [ $archive_hash, "current archive contents" ];
+
+       printdebug "splitbrain_pseudomerge i_archive @$i_archive\n";
+
+       infopair_cond_equal($i_dgit, $i_archive);
+       infopair_cond_ff($i_dep14, $i_dgit);
+       infopair_cond_ff($i_dep14, [ $maintview, 'HEAD' ]);
+       1;
+    }) {
+       print STDERR <<END;
+$us: check failed (maybe --overwrite is needed, consult documentation)
+END
+       die "$@";
+    }
 
     my $r = pseudomerge_make_commit
        $clogp, $dgitview, $archive_hash, $i_arch_v,
        "dgit --quilt=$quilt_mode",
        (defined $overwrite_version ? <<END_OVERWR : <<END_MAKEFF);
-Declare fast forward from $overwrite_version
+Declare fast forward from $i_arch_v->[0]
 END_OVERWR
 Make fast forward from $i_arch_v->[0]
 END_MAKEFF
@@ -2929,16 +3003,6 @@ sub plain_overwrite_pseudomerge ($$$) {
 
     my $i_arch_v = pseudomerge_version_check($clogp, $archive_hash);
 
-    my @tagformats = access_cfg_tagformats();
-    my @t_overwr =
-       map { $_->($i_arch_v->[0], access_basedistro) }
-       (grep { m/^(?:old|hist)$/ } @tagformats)
-       ? \&debiantags : \&debiantag_new;
-    my $i_overwr = infopair_lrf_tag_lookup \@t_overwr, "previous version tag";
-    my $i_archive = [ $archive_hash, "current archive contents" ];
-
-    infopair_cond_equal($i_overwr, $i_archive);
-
     return $head if is_fast_fwd $archive_hash, $head;
 
     my $m = "Declare fast forward from $i_arch_v->[0]";
@@ -3163,14 +3227,15 @@ END
            $upstreamversion =~ s/-[^-]*$//;
            changedir $ud;
            quilt_make_fake_dsc($upstreamversion);
-           my ($dgitview, $cachekey) =
+           my $cachekey;
+           ($dgithead, $cachekey) =
                quilt_check_splitbrain_cache($actualhead, $upstreamversion);
-           $dgitview or fail
+           $dgithead or fail
  "--quilt=$quilt_mode but no cached dgit view:
  perhaps tree changed since dgit build[-source] ?";
            $split_brain = 1;
            $dgithead = splitbrain_pseudomerge($clogp,
-                                              $actualhead, $dgitview,
+                                              $actualhead, $dgithead,
                                               $archive_hash);
            $maintviewhead = $actualhead;
            changedir '../../../..';
@@ -3243,7 +3308,8 @@ END
 
     # Check that changes and .dsc agree enough
     $changesfile =~ m{[^/]*$};
-    files_compare_inputs($dsc, parsecontrol($changesfile,$&));
+    files_compare_inputs($dsc, parsecontrol($changesfile,$&))
+       unless forceing [qw(dsc-changes-mismatch)];
 
     # Checks complete, we're going to try and go ahead:
 
@@ -3910,12 +3976,30 @@ Commit patch to update .gitignore
 END
     }
 
-    my $dgitview = git_rev_parse 'refs/heads/dgit-view';
+    my $dgitview = git_rev_parse 'HEAD';
 
     changedir '../../../..';
+    # When we no longer need to support squeeze, use --create-reflog
+    # instead of this:
     ensuredir ".git/logs/refs/dgit-intern";
     my $makelogfh = new IO::File ".git/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;
 
@@ -4362,7 +4446,7 @@ sub quilt_check_splitbrain_cache ($$) {
     my $srcshash = Digest::SHA->new(256);
     my %sfs = ( %INC, '$0(dgit)' => $0 );
     foreach my $sfk (sort keys %sfs) {
-       next unless m/^\$0\b/ || m{^Debian/Dgit\b};
+       next unless $sfk =~ m/^\$0\b/ || $sfk =~ m{^Debian/Dgit\b};
        $srcshash->add($sfk,"  ");
        $srcshash->add(hashfile($sfs{$sfk}));
        $srcshash->add("\n");
@@ -4370,7 +4454,7 @@ sub quilt_check_splitbrain_cache ($$) {
     push @cachekey, $srcshash->hexdigest();
     $splitbrain_cachekey = "@cachekey";
 
-    my @cmd = (@git, qw(reflog), '--pretty=format:%H %gs',
+    my @cmd = (@git, qw(log -g), '--pretty=format:%H %gs',
               $splitbraincache);
     printdebug "splitbrain cachekey $splitbrain_cachekey\n";
     debugcmd "|(probably)",@cmd;
@@ -4579,7 +4663,7 @@ END
     if (@unrepres) {
        print STDERR "dgit:  cannot represent change: $_->[1]: $_->[0]\n"
            foreach @unrepres;
-       fail <<END;
+       forceable_fail [qw(unrepresentable)], <<END;
 HEAD has changes to .orig[s] which are not representable by `3.0 (quilt)'
 END
     }
@@ -4591,7 +4675,7 @@ END
         push @failsuggestion, "This might be a patches-applied branch.";
     }
     push @failsuggestion, "Maybe you need to specify one of".
-        " --quilt=gbp --quilt=dpm --quilt=unapplied ?";
+        " --[quilt=]gbp --[quilt=]dpm --quilt=unapplied ?";
 
     if (quiltmode_splitbrain()) {
        quiltify_splitbrain($clogp, $unapplied, $headref,
@@ -4807,11 +4891,87 @@ sub massage_dbp_args ($;$) {
     return $r;
 }
 
+sub in_parent (&) {
+    my ($fn) = @_;
+    my $wasdir = must_getcwd();
+    changedir "..";
+    $fn->();
+    changedir $wasdir;
+}    
+
+sub postbuild_mergechanges ($) { # must run with CWD=.. (eg in in_parent)
+    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;
+    @changesfiles = sort {
+       ($b =~ m/_source\.changes$/ <=> $a =~ m/_source\.changes$/)
+           or $a cmp $b
+    } @changesfiles;
+    my $result;
+    if (@changesfiles==1) {
+       fail <<END.$msg_if_onlyone if defined $msg_if_onlyone;
+only one changes file from build (@changesfiles)
+END
+       $result = $changesfiles[0];
+    } elsif (@changesfiles==2) {
+       my $binchanges = parsecontrol($changesfiles[1], "binary changes file");
+       foreach my $l (split /\n/, getfield $binchanges, 'Files') {
+           fail "$l found in binaries changes file $binchanges"
+               if $l =~ m/\.dsc$/;
+       }
+       runcmd_ordryrun_local @mergechanges, @changesfiles;
+       my $multichanges = changespat $version,'multi';
+       if (act_local()) {
+           stat_exists $multichanges or fail "$multichanges: $!";
+           foreach my $cf (glob $pat) {
+               next if $cf eq $multichanges;
+               rename "$cf", "$cf.inmulti" or fail "$cf\{,.inmulti}: $!";
+           }
+       }
+       $result = $multichanges;
+    } else {
+       fail "wrong number of different changes files (@changesfiles)";
+    }
+    printdone "build successful, results in $result\n" or die $!;
+}
+
+sub midbuild_checkchanges () {
+    my $pat = changespat $version;
+    return if $rmchanges;
+    my @unwanted = map { s#^\.\./##; $_; } glob "../$pat";
+    @unwanted = grep { $_ ne changespat $version,'source' } @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.
+END
+       if @unwanted;
+}
+
+sub midbuild_checkchanges_vanilla ($) {
+    my ($wantsrc) = @_;
+    midbuild_checkchanges() if $wantsrc == 1;
+}
+
+sub postbuild_mergechanges_vanilla ($) {
+    my ($wantsrc) = @_;
+    if ($wantsrc == 1) {
+       in_parent {
+           postbuild_mergechanges(undef);
+       };
+    } else {
+       printdone "build successful\n";
+    }
+}
+
 sub cmd_build {
     my @dbp = (@dpkgbuildpackage, qw(-us -uc), changesopts_initial(), @ARGV);
     my $wantsrc = massage_dbp_args \@dbp;
     if ($wantsrc > 0) {
        build_source();
+       midbuild_checkchanges_vanilla $wantsrc;
     } else {
        build_prep();
     }
@@ -4821,7 +4981,7 @@ sub cmd_build {
        runcmd_ordryrun_local @dbp;
     }
     maybe_unapply_patches_again();
-    printdone "build successful\n";
+    postbuild_mergechanges_vanilla $wantsrc;
 }
 
 sub pre_gbp_build {
@@ -4846,6 +5006,7 @@ sub cmd_gbp_build {
 
     if ($wantsrc > 0) {
        build_source();
+       midbuild_checkchanges_vanilla $wantsrc;
     } else {
        if (!$clean_using_builder) {
            push @cmd, '--git-cleaner=true';
@@ -4854,14 +5015,10 @@ sub cmd_gbp_build {
     }
     maybe_unapply_patches_again();
     if ($wantsrc < 2) {
-       unless (grep { m/^--git-debian-branch|^--git-ignore-branch/ } @ARGV) {
-           canonicalise_suite();
-           push @cmd, "--git-debian-branch=".lbranch();
-       }
        push @cmd, changesopts();
        runcmd_ordryrun_local @cmd, @ARGV;
     }
-    printdone "build successful\n";
+    postbuild_mergechanges_vanilla $wantsrc;
 }
 sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0
 
@@ -4934,53 +5091,22 @@ sub cmd_build_source {
 
 sub cmd_sbuild {
     build_source();
-    my $pat = changespat $version;
-    if (!$rmchanges) {
-       my @unwanted = map { s#^\.\./##; $_; } glob "../$pat";
-       @unwanted = grep { $_ ne changespat $version,'source' } @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.
-END
-           if @unwanted;
-    }
-    my $wasdir = must_getcwd();
-    changedir "..";
-    if (act_local()) {
-       stat_exists $dscfn or fail "$dscfn (in parent directory): $!";
-       stat_exists $sourcechanges
-           or fail "$sourcechanges (in parent directory): $!";
-    }
-    runcmd_ordryrun_local @sbuild, qw(-d), $isuite, @ARGV, $dscfn;
-    my @changesfiles = glob $pat;
-    @changesfiles = sort {
-       ($b =~ m/_source\.changes$/ <=> $a =~ m/_source\.changes$/)
-           or $a cmp $b
-    } @changesfiles;
-    fail <<END if @changesfiles==1;
-only one changes file from sbuild (@changesfiles)
+    midbuild_checkchanges();
+    in_parent {
+       if (act_local()) {
+           stat_exists $dscfn or fail "$dscfn (in parent directory): $!";
+           stat_exists $sourcechanges
+               or fail "$sourcechanges (in parent directory): $!";
+       }
+       runcmd_ordryrun_local @sbuild, qw(-d), $isuite, @ARGV, $dscfn;
+    };
+    maybe_unapply_patches_again();
+    in_parent {
+       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.)
 END
-    fail "wrong number of different changes files (@changesfiles)"
-       unless @changesfiles==2;
-    my $binchanges = parsecontrol($changesfiles[1], "binary changes file");
-    foreach my $l (split /\n/, getfield $binchanges, 'Files') {
-       fail "$l found in binaries changes file $binchanges"
-           if $l =~ m/\.dsc$/;
-    }
-    runcmd_ordryrun_local @mergechanges, @changesfiles;
-    my $multichanges = changespat $version,'multi';
-    if (act_local()) {
-       stat_exists $multichanges or fail "$multichanges: $!";
-       foreach my $cf (glob $pat) {
-           next if $cf eq $multichanges;
-           rename "$cf", "$cf.inmulti" or fail "$cf\{,.inmulti}: $!";
-       }
-    }
-    changedir $wasdir;
-    maybe_unapply_patches_again();
-    printdone "build successful, results in $multichanges\n" or die $!;
+    };
 }    
 
 sub cmd_quilt_fixup {
@@ -4997,6 +5123,7 @@ sub cmd_archive_api_query {
     badusage "need only 1 subpath argument" unless @ARGV==1;
     my ($subpath) = @ARGV;
     my @cmd = archive_api_query_cmd($subpath);
+    push @cmd, qw(-f);
     debugcmd ">",@cmd;
     exec @cmd or fail "exec curl: $!\n";
 }
@@ -5129,6 +5256,9 @@ sub parseopts () {
                     ($om = $opts_opt_map{$1})) {
                push @ropts, $_;
                push @$om, $2;
+           } elsif (m/^--(gbp|dpm)$/s) {
+               push @ropts, "--quilt=$1";
+               $quilt_mode = $1;
            } elsif (m/^--ignore-dirty$/s) {
                push @ropts, $_;
                $ignoredirty = 1;
@@ -5150,6 +5280,14 @@ sub parseopts () {
            } elsif (m/^--deliberately-($deliberately_re)$/s) {
                push @ropts, $_;
                push @deliberatelies, $&;
+           } elsif (m/^--force-(.*)/ && defined $forceopts{$1}) {
+               push @ropts, $&;
+               $forceopts{$1} = 1;
+               $_='';
+           } elsif (m/^--force-/) {
+               print STDERR
+                   "$us: warning: ignoring unknown force option $_\n";
+               $_='';
            } elsif (m/^--dgit-tag-format=(old|new)$/s) {
                # undocumented, for testing
                push @ropts, $_;
@@ -5223,6 +5361,30 @@ sub parseopts () {
     }
 }
 
+sub check_env_sanity () {
+    my $blocked = new POSIX::SigSet;
+    sigprocmask SIG_UNBLOCK, $blocked, $blocked or die $!;
+
+    eval {
+       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";
+           $blocked->ismember($signum) and
+               die "$signame is blocked\n";
+       }
+    };
+    return unless $@;
+    chomp $@;
+    fail <<END;
+On entry to dgit, $@
+This is a bug produced by something in in your execution environment.
+Giving up.
+END
+}
+
+
 sub finalise_opts_opts () {
     foreach my $k (keys %opts_opt_map) {
        my $om = $opts_opt_map{$k};
@@ -5258,6 +5420,7 @@ if ($ENV{$fakeeditorenv}) {
 }
 
 parseopts();
+check_env_sanity();
 git_slurp_config();
 
 print STDERR "DRY RUN ONLY\n" if $dryrun_level > 1;