X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=dgit;h=53ccd724b821a9dcd59355f08011ff804f4951d7;hb=dce35223f0ded3dfaa1acb4a6ad62d8ab840ddf9;hp=d587527cb73c32c271b8d576a846bd3e5061515e;hpb=27770bb8b01de8961513430402d3efa68873b5e6;p=dgit.git

diff --git a/dgit b/dgit
index d587527c..53ccd724 100755
--- a/dgit
+++ b/dgit
@@ -2,7 +2,7 @@
 # dgit
 # Integration between git and Debian-style archives
 #
-# Copyright (C)2013 Ian Jackson
+# Copyright (C)2013-2015 Ian Jackson
 #
 # 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
@@ -19,6 +19,9 @@
 
 use strict;
 
+use Debian::Dgit;
+setup_sigwarn();
+
 use IO::Handle;
 use Data::Dumper;
 use LWP::UserAgent;
@@ -29,9 +32,18 @@ use File::Basename;
 use Dpkg::Version;
 use POSIX;
 use IPC::Open2;
+use Digest::SHA;
+use Digest::MD5;
+use List::Util qw(any);
+use List::MoreUtils qw(pairwise);
+
+use Debian::Dgit;
 
 our $our_version = 'UNRELEASED'; ###substituted###
 
+our @rpushprotovsn_support = qw(4 3 2); # 4 is new tag format
+our $protovsn;
+
 our $isuite = 'unstable';
 our $idistro;
 our $package;
@@ -43,69 +55,106 @@ our $changesfile;
 our $buildproductsdir = '..';
 our $new_package = 0;
 our $ignoredirty = 0;
-our $noquilt = 0;
 our $rmonerror = 1;
+our @deliberatelies;
+our %previously;
 our $existing_package = 'dpkg';
-our $cleanmode = 'dpkg-source';
+our $cleanmode;
 our $changes_since_version;
+our $rmchanges;
+our $quilt_mode;
+our $quilt_modes_re = 'linear|smash|auto|nofix|nocheck|gbp|unapplied';
 our $we_are_responder;
 our $initiator_tempdir;
+our $patches_applied_dirtily = 00;
+our $tagformat_want;
+our $tagformat;
+our $tagformatfn;
 
 our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
 
 our $suite_re = '[-+.0-9a-z]+';
+our $cleanmode_re = 'dpkg-source(?:-d)?|git|git-ff|check|none';
+
+our $git_authline_re = '^([^<>]+) \<(\S+)\> (\d+ [-+]\d+)$';
+our $splitbraincache = 'dgit-intern/quilt-cache';
 
 our (@git) = qw(git);
 our (@dget) = qw(dget);
+our (@curl) = qw(curl -f);
 our (@dput) = qw(dput);
 our (@debsign) = qw(debsign);
 our (@gpg) = qw(gpg);
-our (@sbuild) = qw(sbuild -A);
+our (@sbuild) = qw(sbuild);
 our (@ssh) = 'ssh';
 our (@dgit) = qw(dgit);
 our (@dpkgbuildpackage) = qw(dpkg-buildpackage -i\.git/ -I.git);
 our (@dpkgsource) = qw(dpkg-source -i\.git/ -I.git);
 our (@dpkggenchanges) = qw(dpkg-genchanges);
 our (@mergechanges) = qw(mergechanges -f);
+our (@gbp) = qw(gbp);
 our (@changesopts) = ('');
 
-our %opts_opt_map = ('dget' => \@dget,
+our %opts_opt_map = ('dget' => \@dget, # accept for compatibility
+		     'curl' => \@curl,
 		     'dput' => \@dput,
 		     'debsign' => \@debsign,
                      'gpg' => \@gpg,
                      'sbuild' => \@sbuild,
                      'ssh' => \@ssh,
                      'dgit' => \@dgit,
+                     'git' => \@git,
                      'dpkg-source' => \@dpkgsource,
                      'dpkg-buildpackage' => \@dpkgbuildpackage,
                      'dpkg-genchanges' => \@dpkggenchanges,
+                     'gbp' => \@gbp,
                      'ch' => \@changesopts,
                      'mergechanges' => \@mergechanges);
 
-our %opts_opt_cmdonly = ('gpg' => 1);
+our %opts_opt_cmdonly = ('gpg' => 1, 'git' => 1);
+our %opts_cfg_insertpos = map {
+    $_,
+    scalar @{ $opts_opt_map{$_} }
+} keys %opts_opt_map;
 
-our $keyid;
+sub finalise_opts_opts();
 
-our $debug = 0;
-open DEBUG, ">/dev/null" or die $!;
+our $keyid;
 
 autoflush STDOUT 1;
 
+our $supplementary_message = '';
+our $need_split_build_invocation = 0;
+our $split_brain = 0;
+
+END {
+    local ($@, $?);
+    print STDERR "! $_\n" foreach $supplementary_message =~ m/^.+$/mg;
+}
+
 our $remotename = 'dgit';
 our @ourdscfield = qw(Dgit Vcs-Dgit-Master);
-our $branchprefix = 'dgit';
 our $csuite;
+our $instead_distro;
+
+sub debiantag ($$) {
+    my ($v,$distro) = @_;
+    return $tagformatfn->($v, $distro);
+}
+
+sub debiantag_maintview ($$) { 
+    my ($v,$distro) = @_;
+    $v =~ y/~:/_%/;
+    return "$distro/$v";
+}
 
 sub lbranch () { return "$branchprefix/$csuite"; }
 my $lbranch_re = '^refs/heads/'.$branchprefix.'/([^/.]+)$';
 sub lref () { return "refs/heads/".lbranch(); }
-sub lrref () { return "refs/remotes/$remotename/$branchprefix/$csuite"; }
-sub rrref () { return "refs/$branchprefix/$csuite"; }
-sub debiantag ($) { 
-    my ($v) = @_;
-    $v =~ y/~:/_%/;
-    return "debian/$v";
-}
+sub lrref () { return "refs/remotes/$remotename/".server_branch($csuite); }
+sub rrref () { return server_ref($csuite); }
+
+sub lrfetchrefs () { return "refs/dgit-fetch/$csuite"; }
 
 sub stripepoch ($) {
     my ($vsn) = @_;
@@ -113,29 +162,33 @@ sub stripepoch ($) {
     return $vsn;
 }
 
+sub srcfn ($$) {
+    my ($vsn,$sfx) = @_;
+    return "${package}_".(stripepoch $vsn).$sfx
+}
+
 sub dscfn ($) {
     my ($vsn) = @_;
-    return "${package}_".(stripepoch $vsn).".dsc";
+    return srcfn($vsn,".dsc");
+}
+
+sub changespat ($;$) {
+    my ($vsn, $arch) = @_;
+    return "${package}_".(stripepoch $vsn)."_".($arch//'*').".changes";
 }
 
 our $us = 'dgit';
-our $debugprefix = '';
+initdebug('');
 
 our @end;
 END { 
     local ($?);
     foreach my $f (@end) {
 	eval { $f->(); };
-	warn "$us: cleanup: $@" if length $@;
+	print STDERR "$us: cleanup: $@" if length $@;
     }
 };
 
-sub printdebug { print DEBUG $debugprefix, @_ or die $!; }
-
-sub fail { 
-    die $us.($we_are_responder ? " (build host)" : "").": @_\n";
-}
-
 sub badcfg { print STDERR "$us: invalid configuration: @_\n"; exit 12; }
 
 sub no_such_package () {
@@ -154,10 +207,37 @@ sub changedir ($) {
     chdir $newdir or die "chdir: $newdir: $!";
 }
 
+sub deliberately ($) {
+    my ($enquiry) = @_;
+    return !!grep { $_ eq "--deliberately-$enquiry" } @deliberatelies;
+}
+
+sub deliberately_not_fast_forward () {
+    foreach (qw(not-fast-forward fresh-repo)) {
+	return 1 if deliberately($_) || deliberately("TEST-dgit-only-$_");
+    }
+}
+
+sub quiltmode_splitbrain () {
+    $quilt_mode =~ m/gbp|dpm|unapplied/;
+}
+
 #---------- remote protocol support, common ----------
 
 # remote push initiator/responder protocol:
-#  < dgit-remote-push-ready [optional extra info ignored by old initiators]
+#  $ dgit remote-push-build-host <n-rargs> <rargs>... <push-args>...
+#  where <rargs> is <push-host-dir> <supported-proto-vsn>,... ...
+#  < dgit-remote-push-ready <actual-proto-vsn>
+#
+# occasionally:
+#
+#  > progress NBYTES
+#  [NBYTES message]
+#
+#  > supplementary-message NBYTES          # $protovsn >= 3
+#  [NBYTES message]
+#
+# main sequence:
 #
 #  > file parsed-changelog
 #  [indicates that output of dpkg-parsechangelog follows]
@@ -172,7 +252,13 @@ sub changedir ($) {
 #  > file changes
 #  [etc]
 #
-#  > param head HEAD
+#  > param head DGIT-VIEW-HEAD
+#  > param csuite SUITE
+#  > param tagformat old|new
+#  > param maint-view MAINT-VIEW-HEAD
+#
+#  > previously REFNAME=OBJNAME       # if --deliberately-not-fast-forward
+#                                     # goes into tag, for replay prevention
 #
 #  > want signed-tag
 #  [indicates that signed tag is wanted]
@@ -191,17 +277,39 @@ sub changedir ($) {
 #
 #  > complete
 
+our $i_child_pid;
+
+sub i_child_report () {
+    # Sees if our child has died, and reap it if so.  Returns a string
+    # describing how it died if it failed, or undef otherwise.
+    return undef unless $i_child_pid;
+    my $got = waitpid $i_child_pid, WNOHANG;
+    return undef if $got <= 0;
+    die unless $got == $i_child_pid;
+    $i_child_pid = undef;
+    return undef unless $?;
+    return "build host child ".waitstatusmsg();
+}
+
 sub badproto ($$) {
     my ($fh, $m) = @_;
     fail "connection lost: $!" if $fh->error;
     fail "protocol violation; $m not expected";
 }
 
+sub badproto_badread ($$) {
+    my ($fh, $wh) = @_;
+    fail "connection lost: $!" if $!;
+    my $report = i_child_report();
+    fail $report if defined $report;
+    badproto $fh, "eof (reading $wh)";
+}
+
 sub protocol_expect (&$) {
     my ($match, $fh) = @_;
     local $_;
     $_ = <$fh>;
-    defined && chomp or badproto $fh, "eof";
+    defined && chomp or badproto_badread $fh, "protocol message";
     if (wantarray) {
 	my @r = &$match;
 	return @r if @r;
@@ -230,10 +338,10 @@ sub protocol_send_file ($$) {
 
 sub protocol_read_bytes ($$) {
     my ($fh, $nbytes) = @_;
-    $nbytes =~ m/^[1-9]\d{0,5}$/ or badproto \*RO, "bad byte count";
+    $nbytes =~ m/^[1-9]\d{0,5}$|^0$/ or badproto \*RO, "bad byte count";
     my $d;
     my $got = read $fh, $d, $nbytes;
-    $got==$nbytes or badproto $fh, "eof during data block";
+    $got==$nbytes or badproto_badread $fh, "data block";
     return $d;
 }
 
@@ -315,50 +423,14 @@ sub url_get {
     my $r = $ua->get(@_) or die $!;
     return undef if $r->code == 404;
     $r->is_success or fail "failed to fetch $what: ".$r->status_line;
-    return $r->decoded_content();
-}
-
-our ($dscdata,$dscurl,$dsc,$skew_warning_vsn);
-
-sub shellquote {
-    my @out;
-    local $_;
-    foreach my $a (@_) {
-	$_ = $a;
-	if (m{[^-=_./0-9a-z]}i) {
-	    s{['\\]}{'\\$&'}g;
-	    push @out, "'$_'";
-	} else {
-	    push @out, $_;
-	}
-    }
-    return join ' ', @out;
-}
-
-sub printcmd {
-    my $fh = shift @_;
-    my $intro = shift @_;
-    print $fh $intro," " or die $!;
-    print $fh shellquote @_ or die $!;
-    print $fh "\n" or die $!;
+    return $r->decoded_content(charset => 'none');
 }
 
-sub failedcmd {
-    { local ($!); printcmd \*STDERR, "$us: failed command:", @_ or die $!; };
-    if ($!) {
-	fail "failed to fork/exec: $!";
-    } elsif (!($? & 0xff)) {
-	fail "subprocess failed with error exit status ".($?>>8);
-    } elsif ($?) {
-	fail "subprocess crashed (wait status $?)";
-    } else {
-	fail "subprocess produced invalid output";
-    }
-}
+our ($dscdata,$dscurl,$dsc,$dsc_checked,$skew_warning_vsn);
 
 sub runcmd {
-    printcmd(\*DEBUG,$debugprefix."+",@_) if $debug>0;
-    $!=0; $?=0;
+    debugcmd "+",@_;
+    $!=0; $?=-1;
     failedcmd @_ if system @_;
 }
 
@@ -373,27 +445,6 @@ sub printdone {
     }
 }
 
-sub cmdoutput_errok {
-    die Dumper(\@_)." ?" if grep { !defined } @_;
-    printcmd(\*DEBUG,$debugprefix."|",@_) if $debug>0;
-    open P, "-|", @_ or die $!;
-    my $d;
-    $!=0; $?=0;
-    { local $/ = undef; $d = <P>; }
-    die $! if P->error;
-    if (!close P) { printdebug "=>!$?\n" if $debug>0; return undef; }
-    chomp $d;
-    $d =~ m/^.*/;
-    printdebug "=> \`$&'",(length $' ? '...' : ''),"\n" if $debug>0; #';
-    return $d;
-}
-
-sub cmdoutput {
-    my $d = cmdoutput_errok @_;
-    defined $d or failedcmd @_;
-    return $d;
-}
-
 sub dryrun_report {
     printcmd(\*STDERR,$debugprefix."#",@_);
 }
@@ -423,7 +474,8 @@ our $helpmsg = <<END;
 main usages:
   dgit [dgit-opts] clone [dgit-opts] package [suite] [./dir|/dir]
   dgit [dgit-opts] fetch|pull [dgit-opts] [suite]
-  dgit [dgit-opts] build [git-buildpackage-opts|dpkg-buildpackage-opts]
+  dgit [dgit-opts] build [dpkg-buildpackage-opts]
+  dgit [dgit-opts] sbuild [sbuild-opts]
   dgit [dgit-opts] push [dgit-opts] [suite]
   dgit [dgit-opts] rpush build-host:build-dir ...
 important dgit options:
@@ -460,13 +512,33 @@ our %defcfg = ('dgit.default.distro' => 'debian',
 	       'dgit.default.username' => '',
 	       'dgit.default.archive-query-default-component' => 'main',
 	       'dgit.default.ssh' => 'ssh',
-	       'dgit-distro.debian.git-host' => 'git.debian.org',
-	       'dgit-distro.debian.git-proto' => 'git+ssh://',
-	       'dgit-distro.debian.git-path' => '/git/dgit-repos/repos',
-	       'dgit-distro.debian.git-check' => 'ssh-cmd',
-	       'dgit-distro.debian.git-create' => 'ssh-cmd',
-	       'dgit-distro.debian.sshpsql-host' => 'mirror.ftp-master.debian.org',
-	       'dgit-distro.debian.sshpsql-dbname' => 'service=projectb',
+	       'dgit.default.archive-query' => 'madison:',
+	       'dgit.default.sshpsql-dbname' => 'service=projectb',
+	       'dgit.default.dgit-tag-format' => 'old,new,maint',
+	       'dgit-distro.debian.archive-query' => 'ftpmasterapi:',
+	       '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' => 'old',
+	       '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-proto' => 'git+ssh://',
+	       'dgit-distro.debian/push.git-path' => '/dgit/debian/repos',
+	       'dgit-distro.debian/push.git-create' => 'true',
+	       'dgit-distro.debian/push.git-check' => 'ssh-cmd',
+ 'dgit-distro.debian.archive-query-url', 'https://api.ftp-master.debian.org/',
+# 'dgit-distro.debian.archive-query-tls-key',
+#    '/etc/ssl/certs/%HOST%.pem:/etc/dgit/%HOST%.pem',
+# ^ this does not work because curl is broken nowadays
+# Fixing #790093 properly will involve providing providing the key
+# in some pacagke and maybe updating these paths.
+#
+# 'dgit-distro.debian.archive-query-tls-curl-args',
+#   '--ca-path=/etc/ssl/ca-debian',
+# ^ this is a workaround but works (only) on DSA-administered machines
+	       'dgit-distro.debian.git-url' => 'https://git.dgit.debian.org',
+	       'dgit-distro.debian.git-url-suffix' => '',
 	       'dgit-distro.debian.upload-host' => 'ftp-master', # for dput
 	       'dgit-distro.debian.mirror' => 'http://ftp.debian.org/debian/',
  'dgit-distro.debian.backports-quirk' => '(squeeze)-backports*',
@@ -480,25 +552,49 @@ our %defcfg = ('dgit.default.distro' => 'debian',
 	       'dgit-distro.test-dummy.git-url' => "$td/git",
 	       'dgit-distro.test-dummy.git-host' => "git",
 	       'dgit-distro.test-dummy.git-path' => "$td/git",
-	       'dgit-distro.test-dummy.archive-query' => "dummycat:$td/aq",
+	       'dgit-distro.test-dummy.archive-query' => "ftpmasterapi:",
+	       'dgit-distro.test-dummy.archive-query-url' => "file://$td/aq/",
 	       'dgit-distro.test-dummy.mirror' => "file://$td/mirror/",
 	       'dgit-distro.test-dummy.upload-host' => 'test-dummy',
                );
 
+our %gitcfg;
+
+sub git_slurp_config () {
+    local ($debuglevel) = $debuglevel-2;
+    local $/="\0";
+
+    my @cmd = (@git, qw(config -z --get-regexp .*));
+    debugcmd "|",@cmd;
+
+    open GITS, "-|", @cmd or die $!;
+    while (<GITS>) {
+	chomp or die;
+	printdebug "=> ", (messagequote $_), "\n";
+	m/\n/ or die "$_ ?";
+	push @{ $gitcfg{$`} }, $'; #';
+    }
+    $!=0; $?=0;
+    close GITS
+	or ($!==0 && $?==256)
+	or failedcmd @cmd;
+}
+
+sub git_get_config ($) {
+    my ($c) = @_;
+    my $l = $gitcfg{$c};
+    printdebug"C $c ".(defined $l ? messagequote "'$l'" : "undef")."\n"
+	if $debuglevel >= 4;
+    $l or return undef;
+    @$l==1 or badcfg "multiple values for $c" if @$l > 1;
+    return $l->[0];
+}
+
 sub cfg {
     foreach my $c (@_) {
 	return undef if $c =~ /RETURN-UNDEF/;
-	my @cmd = (@git, qw(config --), $c);
-	my $v;
-	{
-	    local ($debug) = $debug-1;
-	    $v = cmdoutput_errok @cmd;
-	};
-	if ($?==0) {
-	    return $v;
-	} elsif ($?!=256) {
-	    failedcmd @cmd;
-	}
+	my $v = git_get_config($c);
+	return $v if defined $v;
 	my $dv = $defcfg{$c};
 	return $dv if defined $dv;
     }
@@ -508,9 +604,7 @@ sub cfg {
 
 sub access_basedistro () {
     if (defined $idistro) {
-	return cfg("dgit-distro.basedistro.distro",
-		   "dgit-suite.$isuite.distro",
-		   'RETURN-UNDEF') // $idistro;
+	return $idistro;
     } else {	
 	return cfg("dgit-suite.$isuite.distro",
 		   "dgit.default.distro");
@@ -518,7 +612,7 @@ sub access_basedistro () {
 }
 
 sub access_quirk () {
-    # returns (quirk name, distro to use instead, quirk-specific info)
+    # returns (quirk name, distro to use instead or undef, quirk-specific info)
     my $basedistro = access_basedistro();
     my $backports_quirk = cfg("dgit-distro.$basedistro.backports-quirk",
 			      'RETURN-UNDEF');
@@ -532,25 +626,134 @@ sub access_quirk () {
 	    return ('backports',"$basedistro-backports",$1);
 	}
     }
-    return ('none',$basedistro);
+    return ('none',undef);
+}
+
+our $access_forpush;
+
+sub parse_cfg_bool ($$$) {
+    my ($what,$def,$v) = @_;
+    $v //= $def;
+    return
+	$v =~ m/^[ty1]/ ? 1 :
+	$v =~ m/^[fn0]/ ? 0 :
+	badcfg "$what needs t (true, y, 1) or f (false, n, 0) not \`$v'";
+}	
+
+sub access_forpush_config () {
+    my $d = access_basedistro();
+
+    return 1 if
+	$new_package &&
+	parse_cfg_bool('new-private-pushers', 0,
+		       cfg("dgit-distro.$d.new-private-pushers",
+			   'RETURN-UNDEF'));
+
+    my $v = cfg("dgit-distro.$d.readonly", 'RETURN-UNDEF');
+    $v //= 'a';
+    return
+	$v =~ m/^[ty1]/ ? 0 : # force readonly,    forpush = 0
+	$v =~ m/^[fn0]/ ? 1 : # force nonreadonly, forpush = 1
+	$v =~ m/^[a]/  ? '' : # auto,              forpush = ''
+	badcfg "readonly needs t (true, y, 1) or f (false, n, 0) or a (auto)";
+}
+
+sub access_forpush () {
+    $access_forpush //= access_forpush_config();
+    return $access_forpush;
+}
+
+sub pushing () {
+    die "$access_forpush ?" if ($access_forpush // 1) ne 1;
+    badcfg "pushing but distro is configured readonly"
+	if access_forpush_config() eq '0';
+    $access_forpush = 1;
+    $supplementary_message = <<'END' unless $we_are_responder;
+Push failed, before we got started.
+You can retry the push, after fixing the problem, if you like.
+END
+    finalise_opts_opts();
+}
+
+sub notpushing () {
+    finalise_opts_opts();
+}
+
+sub supplementary_message ($) {
+    my ($msg) = @_;
+    if (!$we_are_responder) {
+	$supplementary_message = $msg;
+	return;
+    } elsif ($protovsn >= 3) {
+	responder_send_command "supplementary-message ".length($msg)
+	    or die $!;
+	print PO $msg or die $!;
+    }
+}
+
+sub access_distros () {
+    # Returns list of distros to try, in order
+    #
+    # We want to try:
+    #    0. `instead of' distro name(s) we have been pointed to
+    #    1. the access_quirk distro, if any
+    #    2a. the user's specified distro, or failing that  } basedistro
+    #    2b. the distro calculated from the suite          }
+    my @l = access_basedistro();
+
+    my (undef,$quirkdistro) = access_quirk();
+    unshift @l, $quirkdistro;
+    unshift @l, $instead_distro;
+    @l = grep { defined } @l;
+
+    if (access_forpush()) {
+	@l = map { ("$_/push", $_) } @l;
+    }
+    @l;
 }
 
-sub access_distro () {
-    return (access_quirk())[1];
+sub access_cfg_cfgs (@) {
+    my (@keys) = @_;
+    my @cfgs;
+    # The nesting of these loops determines the search order.  We put
+    # the key loop on the outside so that we search all the distros
+    # for each key, before going on to the next key.  That means that
+    # if access_cfg is called with a more specific, and then a less
+    # specific, key, an earlier distro can override the less specific
+    # without necessarily overriding any more specific keys.  (If the
+    # distro wants to override the more specific keys it can simply do
+    # so; whereas if we did the loop the other way around, it would be
+    # impossible to for an earlier distro to override a less specific
+    # key but not the more specific ones without restating the unknown
+    # values of the more specific keys.
+    my @realkeys;
+    my @rundef;
+    # We have to deal with RETURN-UNDEF specially, so that we don't
+    # terminate the search prematurely.
+    foreach (@keys) {
+	if (m/RETURN-UNDEF/) { push @rundef, $_; last; }
+	push @realkeys, $_
+    }
+    foreach my $d (access_distros()) {
+	push @cfgs, map { "dgit-distro.$d.$_" } @realkeys;
+    }
+    push @cfgs, map { "dgit.default.$_" } @realkeys;
+    push @cfgs, @rundef;
+    return @cfgs;
 }
 
 sub access_cfg (@) {
     my (@keys) = @_;
-    my $basedistro = access_basedistro();
-    my $distro = $idistro || access_distro();
-    my $value = cfg(map {
-	("dgit-distro.$distro.$_",
-	 "dgit-distro.$basedistro.$_",
-	 "dgit.default.$_")
-		    } @keys);
+    my (@cfgs) = access_cfg_cfgs(@keys);
+    my $value = cfg(@cfgs);
     return $value;
 }
 
+sub access_cfg_bool ($$) {
+    my ($def, @keys) = @_;
+    parse_cfg_bool($keys[0], $def, access_cfg(@keys, 'RETURN-UNDEF'));
+}
+
 sub string_to_ssh ($) {
     my ($spec) = @_;
     if ($spec =~ m/\s/) {
@@ -569,9 +772,16 @@ sub access_cfg_ssh () {
     }
 }
 
+sub access_runeinfo ($) {
+    my ($info) = @_;
+    return ": dgit ".access_basedistro()." $info ;";
+}
+
 sub access_someuserhost ($) {
     my ($some) = @_;
-    my $user = access_cfg("$some-user",'username');
+    my $user = access_cfg("$some-user-force", 'RETURN-UNDEF');
+    defined($user) && length($user) or
+	$user = access_cfg("$some-user",'username');
     my $host = access_cfg("$some-host");
     return length($user) ? "$user\@$host" : $host;
 }
@@ -580,22 +790,47 @@ sub access_gituserhost () {
     return access_someuserhost('git');
 }
 
-sub access_giturl () {
+sub access_giturl (;$) {
+    my ($optional) = @_;
     my $url = access_cfg('git-url','RETURN-UNDEF');
-    if (!defined $url) {
+    my $suffix;
+    if (!length $url) {
+	my $proto = access_cfg('git-proto', 'RETURN-UNDEF');
+	return undef unless defined $proto;
 	$url =
-	    access_cfg('git-proto').
+	    $proto.
 	    access_gituserhost().
 	    access_cfg('git-path');
+    } else {
+	$suffix = access_cfg('git-url-suffix','RETURN-UNDEF');
     }
-    return "$url/$package.git";
+    $suffix //= '.git';
+    return "$url/$package$suffix";
 }	       
 
-sub parsecontrolfh ($$@) {
-    my ($fh, $desc, @opts) = @_;
-    my %opts = ('name' => $desc, @opts);
-    my $c = Dpkg::Control::Hash->new(%opts);
-    $c->parse($fh) or die "parsing of $desc failed";
+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;
 }
 
@@ -626,23 +861,6 @@ sub parsechangelog {
     return $c;
 }
 
-sub git_get_ref ($) {
-    my ($refname) = @_;
-    my $got = cmdoutput_errok @git, qw(show-ref --), $refname;
-    if (!defined $got) {
-	$?==256 or fail "git show-ref failed (status $?)";
-	printdebug "ref $refname= [show-ref exited 1]\n";
-	return '';
-    }
-    if ($got =~ m/^(\w+) \Q$refname\E$/m) {
-	printdebug "ref $refname=$1\n";
-	return $1;
-    } else {
-	printdebug "ref $refname= [no match]\n";
-	return '';
-    }
-}
-
 sub must_getcwd () {
     my $d = getcwd();
     defined $d or fail "getcwd failed: $!";
@@ -654,16 +872,6 @@ our %rmad;
 sub archive_query ($) {
     my ($method) = @_;
     my $query = access_cfg('archive-query','RETURN-UNDEF');
-    if (!defined $query) {
-	my $distro = access_basedistro();
-	if ($distro eq 'debian') {
-	    $query = "sshpsql:".
-		access_someuserhost('sshpsql').':'.
-	        access_cfg('sshpsql-dbname');
-	} else {
-	    $query = "madison:$distro";
-	}
-    }
     $query =~ s/^(\w+):// or badcfg "invalid archive-query method \`$query'";
     my $proto = $1;
     my $data = $'; #';
@@ -676,17 +884,116 @@ sub pool_dsc_subpath ($$) {
     return "/pool/$component/$prefix/$package/".dscfn($vsn);
 }
 
-sub archive_query_madison ($$) {
+#---------- `ftpmasterapi' archive query method (nascent) ----------
+
+sub archive_api_query_cmd ($) {
+    my ($subpath) = @_;
+    my @cmd = qw(curl -sS);
+    my $url = access_cfg('archive-query-url');
+    if ($url =~ m#^https://([-.0-9a-z]+)/#) {
+	my $host = $1;
+	my $keys = access_cfg('archive-query-tls-key','RETURN-UNDEF') //'';
+	foreach my $key (split /\:/, $keys) {
+	    $key =~ s/\%HOST\%/$host/g;
+	    if (!stat $key) {
+		fail "for $url: stat $key: $!" unless $!==ENOENT;
+		next;
+	    }
+	    fail "config requested specific TLS key but do not know".
+		" how to get curl to use exactly that EE key ($key)";
+#	    push @cmd, "--cacert", $key, "--capath", "/dev/enoent";
+#           # Sadly the above line does not work because of changes
+#           # to gnutls.   The real fix for #790093 may involve
+#           # new curl options.
+	    last;
+	}
+	# Fixing #790093 properly will involve providing a value
+	# for this on clients.
+	my $kargs = access_cfg('archive-query-tls-curl-ca-args','RETURN-UNDEF');
+	push @cmd, split / /, $kargs if defined $kargs;
+    }
+    push @cmd, $url.$subpath;
+    return @cmd;
+}
+
+sub api_query ($$) {
+    use JSON;
+    my ($data, $subpath) = @_;
+    badcfg "ftpmasterapi archive query method takes no data part"
+	if length $data;
+    my @cmd = archive_api_query_cmd($subpath);
+    my $json = cmdoutput @cmd;
+    return decode_json($json);
+}
+
+sub canonicalise_suite_ftpmasterapi () {
+    my ($proto,$data) = @_;
+    my $suites = api_query($data, 'suites');
+    my @matched;
+    foreach my $entry (@$suites) {
+	next unless grep { 
+	    my $v = $entry->{$_};
+	    defined $v && $v eq $isuite;
+	} qw(codename name);
+	push @matched, $entry;
+    }
+    fail "unknown suite $isuite" unless @matched;
+    my $cn;
+    eval {
+	@matched==1 or die "multiple matches for suite $isuite\n";
+	$cn = "$matched[0]{codename}";
+	defined $cn or die "suite $isuite info has no codename\n";
+	$cn =~ m/^$suite_re$/ or die "suite $isuite maps to bad codename\n";
+    };
+    die "bad ftpmaster api response: $@\n".Dumper(\@matched)
+	if length $@;
+    return $cn;
+}
+
+sub archive_query_ftpmasterapi () {
+    my ($proto,$data) = @_;
+    my $info = api_query($data, "dsc_in_suite/$isuite/$package");
+    my @rows;
+    my $digester = Digest::SHA->new(256);
+    foreach my $entry (@$info) {
+	eval {
+	    my $vsn = "$entry->{version}";
+	    my ($ok,$msg) = version_check $vsn;
+	    die "bad version: $msg\n" unless $ok;
+	    my $component = "$entry->{component}";
+	    $component =~ m/^$component_re$/ or die "bad component";
+	    my $filename = "$entry->{filename}";
+	    $filename && $filename !~ m#[^-+:._~0-9a-zA-Z/]|^[/.]|/[/.]#
+		or die "bad filename";
+	    my $sha256sum = "$entry->{sha256sum}";
+	    $sha256sum =~ m/^[0-9a-f]+$/ or die "bad sha256sum";
+	    push @rows, [ $vsn, "/pool/$component/$filename",
+			  $digester, $sha256sum ];
+	};
+	die "bad ftpmaster api response: $@\n".Dumper($entry)
+	    if length $@;
+    }
+    @rows = sort { -version_compare($a->[0],$b->[0]) } @rows;
+    return @rows;
+}
+
+#---------- `madison' archive query method ----------
+
+sub archive_query_madison {
+    return map { [ @$_[0..1] ] } madison_get_parse(@_);
+}
+
+sub madison_get_parse {
     my ($proto,$data) = @_;
     die unless $proto eq 'madison';
-    $rmad{$package} ||= cmdoutput
+    if (!length $data) {
+	$data= access_cfg('madison-distro','RETURN-UNDEF');
+	$data //= access_basedistro();
+    }
+    $rmad{$proto,$data,$package} ||= cmdoutput
 	qw(rmadison -asource),"-s$isuite","-u$data",$package;
-    my $rmad = $rmad{$package};
-    return madison_parse($rmad);
-}
+    my $rmad = $rmad{$proto,$data,$package};
 
-sub madison_parse ($) {
-    my ($rmad) = @_;
     my @out;
     foreach my $l (split /\n/, $rmad) {
 	$l =~ m{^ \s*( [^ \t|]+ )\s* \|
@@ -705,12 +1012,12 @@ sub madison_parse ($) {
 	$5 eq 'source' or die "$rmad ?";
 	push @out, [$vsn,pool_dsc_subpath($vsn,$component),$newsuite];
     }
-    return sort { -version_compare_string($a->[0],$b->[0]); } @out;
+    return sort { -version_compare($a->[0],$b->[0]); } @out;
 }
 
-sub canonicalise_suite_madison ($$) {
+sub canonicalise_suite_madison {
     # madison canonicalises for us
-    my @r = archive_query_madison($_[0],$_[1]);
+    my @r = madison_get_parse(@_);
     @r or fail
 	"unable to canonicalise suite using package $package".
 	" which does not appear to exist in suite $isuite;".
@@ -718,18 +1025,26 @@ sub canonicalise_suite_madison ($$) {
     return $r[0][2];
 }
 
-sub sshpsql ($$) {
-    my ($data,$sql) = @_;
+#---------- `sshpsql' archive query method ----------
+
+sub sshpsql ($$$) {
+    my ($data,$runeinfo,$sql) = @_;
+    if (!length $data) {
+	$data= access_someuserhost('sshpsql').':'.
+	    access_cfg('sshpsql-dbname');
+    }
     $data =~ m/:/ or badcfg "invalid sshpsql method string \`$data'";
     my ($userhost,$dbname) = ($`,$'); #';
     my @rows;
     my @cmd = (access_cfg_ssh, $userhost,
-	       "export LANG=C; ".shellquote qw(psql -A), $dbname, qw(-c), $sql);
-    printcmd(\*DEBUG,$debugprefix."|",@cmd) if $debug>0;
+	       access_runeinfo("ssh-psql $runeinfo").
+	       " export LC_MESSAGES=C; export LC_CTYPE=C;".
+	       " ".shellquote qw(psql -A), $dbname, qw(-c), $sql);
+    debugcmd "|",@cmd;
     open P, "-|", @cmd or die $!;
     while (<P>) {
 	chomp or die;
-	printdebug("$debugprefix>|$_|\n");
+	printdebug(">|$_|\n");
 	push @rows, $_;
     }
     $!=0; $?=0; close P or failedcmd @cmd;
@@ -744,14 +1059,14 @@ sub sshpsql ($$) {
 }
 
 sub sql_injection_check {
-    foreach (@_) { die "$_ $& ?" if m/[']/; }
+    foreach (@_) { die "$_ $& ?" if m{[^-+=:_.,/0-9a-zA-Z]}; }
 }
 
 sub archive_query_sshpsql ($$) {
     my ($proto,$data) = @_;
     sql_injection_check $isuite, $package;
-    my @rows = sshpsql($data, <<END);
-        SELECT source.version, component.name, files.filename
+    my @rows = sshpsql($data, "archive-query $isuite $package", <<END);
+        SELECT source.version, component.name, files.filename, files.sha256sum
           FROM source
           JOIN src_associations ON source.id = src_associations.source
           JOIN suite ON suite.id = src_associations.suite
@@ -763,10 +1078,11 @@ sub archive_query_sshpsql ($$) {
            AND source.source='$package'
            AND files.filename LIKE '%.dsc';
 END
-    @rows = sort { -version_compare_string($a->[0],$b->[0]) } @rows;
+    @rows = sort { -version_compare($a->[0],$b->[0]) } @rows;
+    my $digester = Digest::SHA->new(256);
     @rows = map {
-	my ($vsn,$component,$filename) = @$_;
-	[ $vsn, "/pool/$component/$filename" ];
+	my ($vsn,$component,$filename,$sha256sum) = @$_;
+	[ $vsn, "/pool/$component/$filename",$digester,$sha256sum ];
     } @rows;
     return @rows;
 }
@@ -774,7 +1090,7 @@ END
 sub canonicalise_suite_sshpsql ($$) {
     my ($proto,$data) = @_;
     sql_injection_check $isuite;
-    my @rows = sshpsql($data, <<END);
+    my @rows = sshpsql($data, "canonicalise-suite $isuite", <<END);
         SELECT suite.codename
           FROM suite where suite_name='$isuite' or codename='$isuite';
 END
@@ -784,6 +1100,8 @@ END
     return $rows[0];
 }
 
+#---------- `dummycat' archive query method ----------
+
 sub canonicalise_suite_dummycat ($$) {
     my ($proto,$data) = @_;
     my $dpath = "$data/suite.$isuite";
@@ -820,9 +1138,53 @@ sub archive_query_dummycat ($$) {
     }
     C->error and die "$dpath: $!";
     close C;
-    return sort { -version_compare_string($a->[0],$b->[0]); } @rows;
+    return sort { -version_compare($a->[0],$b->[0]); } @rows;
+}
+
+#---------- tag format handling ----------
+
+sub access_cfg_tagformats () {
+    split /\,/, access_cfg('dgit-tag-format');
+}
+
+sub need_tagformat ($$) {
+    my ($fmt, $why) = @_;
+    fail "need to use tag format $fmt ($why) but also need".
+	" to use tag format $tagformat_want->[0] ($tagformat_want->[1])".
+	" - no way to proceed"
+	if $tagformat_want && $tagformat_want->[0] ne $fmt;
+    $tagformat_want = [$fmt, $why, $tagformat_want->[2] // 0];
+}
+
+sub select_tagformat () {
+    # sets $tagformatfn
+    return if $tagformatfn && !$tagformat_want;
+    die 'bug' if $tagformatfn && $tagformat_want;
+    # ... $tagformat_want assigned after previous select_tagformat
+
+    my (@supported) = grep { $_ ne 'maint' } access_cfg_tagformats();
+    printdebug "select_tagformat supported @supported\n";
+
+    $tagformat_want //= [ $supported[0], "distro access configuration", 0 ];
+    printdebug "select_tagformat specified @$tagformat_want\n";
+
+    my ($fmt,$why,$override) = @$tagformat_want;
+
+    fail "target distro supports tag formats @supported".
+	" but have to use $fmt ($why)"
+	unless $override
+	    or grep { $_ eq $fmt } @supported;
+
+    $tagformat_want = undef;
+    $tagformat = $fmt;
+    $tagformatfn = ${*::}{"debiantag_$fmt"};
+
+    fail "trying to use unknown tag format \`$fmt' ($why) !"
+	unless $tagformatfn;
 }
 
+#---------- archive query entrypoints and rest of program ----------
+
 sub canonicalise_suite () {
     return if defined $csuite;
     fail "cannot operate on $isuite suite" if $isuite eq 'UNRELEASED';
@@ -836,35 +1198,76 @@ sub get_archive_dsc () {
     canonicalise_suite();
     my @vsns = archive_query('archive_query');
     foreach my $vinfo (@vsns) {
-	my ($vsn,$subpath) = @$vinfo;
+	my ($vsn,$subpath,$digester,$digest) = @$vinfo;
 	$dscurl = access_cfg('mirror').$subpath;
 	$dscdata = url_get($dscurl);
 	if (!$dscdata) {
 	    $skew_warning_vsn = $vsn if !defined $skew_warning_vsn;
 	    next;
 	}
+	if ($digester) {
+	    $digester->reset();
+	    $digester->add($dscdata);
+	    my $got = $digester->hexdigest();
+	    $got eq $digest or
+		fail "$dscurl has hash $got but".
+		    " archive told us to expect $digest";
+	}
 	my $dscfh = new IO::File \$dscdata, '<' or die $!;
-	printdebug Dumper($dscdata) if $debug>1;
-	$dsc = parsecontrolfh($dscfh,$dscurl, allow_pgp=>1);
-	printdebug Dumper($dsc) if $debug>1;
+	printdebug Dumper($dscdata) if $debuglevel>1;
+	$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};
+	$dsc_checked = !!$digester;
 	return;
     }
     $dsc = undef;
 }
 
+sub check_for_git ();
 sub check_for_git () {
     # returns 0 or 1
     my $how = access_cfg('git-check');
     if ($how eq 'ssh-cmd') {
 	my @cmd =
 	    (access_cfg_ssh, access_gituserhost(),
+	     access_runeinfo("git-check $package").
 	     " set -e; cd ".access_cfg('git-path').";".
 	     " if test -d $package.git; then echo 1; else echo 0; fi");
 	my $r= cmdoutput @cmd;
-	failedcmd @cmd unless $r =~ m/^[01]$/;
+	if (defined $r and $r =~ m/^divert (\w+)$/) {
+	    my $divert=$1;
+	    my ($usedistro,) = access_distros();
+	    # NB that if we are pushing, $usedistro will be $distro/push
+	    $instead_distro= cfg("dgit-distro.$usedistro.diverts.$divert");
+	    $instead_distro =~ s{^/}{ access_basedistro()."/" }e;
+	    progress "diverting to $divert (using config for $instead_distro)";
+	    return check_for_git();
+	}
+	failedcmd @cmd unless defined $r and $r =~ m/^[01]$/;
 	return $r+0;
+    } elsif ($how eq 'url') {
+	my $prefix = access_cfg('git-check-url','git-url');
+	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 $result = cmdoutput @cmd;
+	$result =~ s/^\S+ 200 .*\n\r?\n//;
+	# curl -sS -I with https_proxy prints
+	# HTTP/1.0 200 Connection established
+	$result =~ m/^\S+ (404|200) /s or
+	    fail "unexpected results from git check query - ".
+	        Dumper($prefix, $result);
+	my $code = $1;
+	if ($code eq '404') {
+	    return 0;
+	} elsif ($code eq '200') {
+	    return 1;
+	} else {
+	    die;
+	}
     } elsif ($how eq 'true') {
 	return 1;
     } elsif ($how eq 'false') {
@@ -879,6 +1282,7 @@ sub create_remote_git_repo () {
     if ($how eq 'ssh-cmd') {
 	runcmd_ordryrun
 	    (access_cfg_ssh, access_gituserhost(),
+	     access_runeinfo("git-create $package").
 	     "set -e; cd ".access_cfg('git-path').";".
 	     " cp -a _template $package.git");
     } elsif ($how eq 'true') {
@@ -892,27 +1296,58 @@ our ($dsc_hash,$lastpush_hash);
 
 our $ud = '.git/dgit/unpack';
 
-sub prep_ud () {
-    rmtree($ud);
+sub prep_ud (;$) {
+    my ($d) = @_;
+    $d //= $ud;
+    rmtree($d);
     mkpath '.git/dgit';
-    mkdir $ud or die $!;
+    mkdir $d or die $!;
+}
+
+sub mktree_in_ud_here () {
+    runcmd qw(git init -q);
+    rmtree('.git/objects');
+    symlink '../../../../objects','.git/objects' or die $!;
+}
+
+sub git_write_tree () {
+    my $tree = cmdoutput @git, qw(write-tree);
+    $tree =~ m/^\w+$/ or die "$tree ?";
+    return $tree;
+}
+
+sub remove_stray_gits () {
+    my @gitscmd = qw(find -name .git -prune -print0);
+    debugcmd "|",@gitscmd;
+    open GITS, "-|", @gitscmd or die $!;
+    {
+	local $/="\0";
+	while (<GITS>) {
+	    chomp or die;
+	    print STDERR "$us: warning: removing from source package: ",
+		(messagequote $_), "\n";
+	    rmtree $_;
+	}
+    }
+    $!=0; $?=0; close GITS or failedcmd @gitscmd;
 }
 
 sub mktree_in_ud_from_only_subdir () {
     # changes into the subdir
     my (@dirs) = <*/.>;
-    die unless @dirs==1;
+    die "@dirs ?" unless @dirs==1;
     $dirs[0] =~ m#^([^/]+)/\.$# or die;
     my $dir = $1;
     changedir $dir;
-    fail "source package contains .git directory" if stat '.git';
-    die $! unless $!==&ENOENT;
-    runcmd qw(git init -q);
-    rmtree('.git/objects');
-    symlink '../../../../objects','.git/objects' or die $!;
+
+    remove_stray_gits();
+    mktree_in_ud_here();
+    my ($format, $fopts) = get_source_format();
+    if (madformat($format)) {
+	rmtree '.pc';
+    }
     runcmd @git, qw(add -Af);
-    my $tree = cmdoutput @git, qw(write-tree);
-    $tree =~ m/^\w+$/ or die "$tree ?";
+    my $tree=git_write_tree();
     return ($tree,$dir);
 }
 
@@ -947,9 +1382,12 @@ sub dsc_files () {
     map { $_->{Filename} } dsc_files_info();
 }
 
-sub is_orig_file ($) {
-    local ($_) = @_;
-    m/\.orig(?:-\w+)?\.tar\.\w+$/;
+sub is_orig_file ($;$) {
+    local ($_) = $_[0];
+    my $base = $_[1];
+    m/\.orig(?:-\w+)?\.tar\.\w+$/ or return 0;
+    defined $base or return 1;
+    return $` eq $base;
 }
 
 sub make_commit ($) {
@@ -963,30 +1401,110 @@ sub clogp_authline ($) {
     $author =~ s#,.*##ms;
     my $date = cmdoutput qw(date), '+%s %z', qw(-d), getfield($clogp,'Date');
     my $authline = "$author $date";
-    $authline =~ m/^[^<>]+ \<\S+\> \d+ [-+]\d+$/ or
+    $authline =~ m/$git_authline_re/o or
 	fail "unexpected commit author line format \`$authline'".
 	" (was generated from changelog Maintainer field)";
+    return ($1,$2,$3) if wantarray;
     return $authline;
 }
 
+sub vendor_patches_distro ($$) {
+    my ($checkdistro, $what) = @_;
+    return unless defined $checkdistro;
+
+    my $series = "debian/patches/\L$checkdistro\E.series";
+    printdebug "checking for vendor-specific $series ($what)\n";
+
+    if (!open SERIES, "<", $series) {
+	die "$series $!" unless $!==ENOENT;
+	return;
+    }
+    while (<SERIES>) {
+	next unless m/\S/;
+	next if m/^\s+\#/;
+
+	print STDERR <<END;
+
+Unfortunately, this source package uses a feature of dpkg-source where
+the same source package unpacks to different source code on different
+distros.  dgit cannot safely operate on such packages on affected
+distros, because the meaning of source packages is not stable.
+
+Please ask the distro/maintainer to remove the distro-specific series
+files and use a different technique (if necessary, uploading actually
+different packages, if different distros are supposed to have
+different code).
+
+END
+	fail "Found active distro-specific series file for".
+	    " $checkdistro ($what): $series, cannot continue";
+    }
+    die "$series $!" if SERIES->error;
+    close SERIES;
+}
+
+sub check_for_vendor_patches () {
+    # This dpkg-source feature doesn't seem to be documented anywhere!
+    # But it can be found in the changelog (reformatted):
+
+    #   commit  4fa01b70df1dc4458daee306cfa1f987b69da58c
+    #   Author: Raphael Hertzog <hertzog@debian.org>
+    #   Date: Sun  Oct  3  09:36:48  2010 +0200
+
+    #   dpkg-source: correctly create .pc/.quilt_series with alternate
+    #   series files
+    #   
+    #   If you have debian/patches/ubuntu.series and you were
+    #   unpacking the source package on ubuntu, quilt was still
+    #   directed to debian/patches/series instead of
+    #   debian/patches/ubuntu.series.
+    #   
+    #   debian/changelog                        |    3 +++
+    #   scripts/Dpkg/Source/Package/V3/quilt.pm |    4 +++-
+    #   2 files changed, 6 insertions(+), 1 deletion(-)
+
+    use Dpkg::Vendor;
+    vendor_patches_distro($ENV{DEB_VENDOR}, "DEB_VENDOR");
+    vendor_patches_distro(Dpkg::Vendor::get_current_vendor(),
+			 "Dpkg::Vendor \`current vendor'");
+    vendor_patches_distro(access_basedistro(),
+			  "distro being accessed");
+}
+
 sub generate_commit_from_dsc () {
     prep_ud();
     changedir $ud;
-    my @files;
-    foreach my $f (dsc_files()) {
+
+    foreach my $fi (dsc_files_info()) {
+	my $f = $fi->{Filename};
 	die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#;
-	push @files, $f;
-	link "../../../$f", $f
+
+	link_ltarget "../../../$f", $f
 	    or $!==&ENOENT
 	    or die "$f $!";
+
+	complete_file_from_dsc('.', $fi)
+	    or next;
+
+	if (is_orig_file($f)) {
+	    link $f, "../../../../$f"
+		or $!==&EEXIST
+		or die "$f $!";
+	}
     }
-    runcmd @dget, qw(--), $dscurl;
-    foreach my $f (grep { is_orig_file($_) } @files) {
-	link $f, "../../../../$f"
-	    or $!==&EEXIST
-	    or die "$f $!";
-    }
+
+    my $dscfn = "$package.dsc";
+
+    open D, ">", $dscfn or die "$dscfn: $!";
+    print D $dscdata or die "$dscfn: $!";
+    close D or die "$dscfn: $!";
+    my @cmd = qw(dpkg-source);
+    push @cmd, '--no-check' if $dsc_checked;
+    push @cmd, qw(-x --), $dscfn;
+    runcmd @cmd;
+
     my ($tree,$dir) = mktree_in_ud_from_only_subdir();
+    check_for_vendor_patches() if madformat($dsc->{format});
     runcmd qw(sh -ec), 'dpkg-parsechangelog >../changelog.tmp';
     my $clogp = parsecontrol('../changelog.tmp',"commit's changelog");
     my $authline = clogp_authline $clogp;
@@ -1006,12 +1524,12 @@ END
     my $cversion = getfield $clogp, 'Version';
     progress "synthesised git commit from .dsc $cversion";
     if ($lastpush_hash) {
-	runcmd @git, qw(reset --hard), $lastpush_hash;
+	runcmd @git, qw(reset -q --hard), $lastpush_hash;
 	runcmd qw(sh -ec), 'dpkg-parsechangelog >>../changelogold.tmp';
 	my $oldclogp = parsecontrol('../changelogold.tmp','previous changelog');
 	my $oversion = getfield $oldclogp, 'Version';
 	my $vcmp =
-	    version_compare_string($oversion, $cversion);
+	    version_compare($oversion, $cversion);
 	if ($vcmp < 0) {
 	    # git upload/ is earlier vsn than archive, use archive
 	    open C, ">../commit2.tmp" or die $!;
@@ -1046,51 +1564,79 @@ END
     return $outputhash;
 }
 
-sub ensure_we_have_orig () {
-    foreach my $fi (dsc_files_info()) {
-	my $f = $fi->{Filename};
-	next unless is_orig_file($f);
-	if (open F, "<", "../$f") {
-	    $fi->{Digester}->reset();
-	    $fi->{Digester}->addfile(*F);
-	    F->error and die $!;
-	    my $got = $fi->{Digester}->hexdigest();
-	    $got eq $fi->{Hash} or
-		fail "existing file $f has hash $got but .dsc".
-		    " demands hash $fi->{Hash}".
-		    " (perhaps you should delete this file?)";
-	    progress "using existing $f";
-	    next;
-	} else {
-	    die "$f $!" unless $!==&ENOENT;
-	}
-	my $origurl = $dscurl;
-	$origurl =~ s{/[^/]+$}{};
-	$origurl .= "/$f";
-	die "$f ?" unless $f =~ m/^${package}_/;
+sub complete_file_from_dsc ($$) {
+    our ($dstdir, $fi) = @_;
+    # Ensures that we have, in $dir, the file $fi, with the correct
+    # contents.  (Downloading it from alongside $dscurl if necessary.)
+
+    my $f = $fi->{Filename};
+    my $tf = "$dstdir/$f";
+    my $downloaded = 0;
+
+    if (stat_exists $tf) {
+	progress "using existing $f";
+    } else {
+	my $furl = $dscurl;
+	$furl =~ s{/[^/]+$}{};
+	$furl .= "/$f";
+	die "$f ?" unless $f =~ m/^\Q${package}\E_/;
 	die "$f ?" if $f =~ m#/#;
-	runcmd_ordryrun_local shell_cmd 'cd ..', @dget,'--',$origurl;
+	runcmd_ordryrun_local @curl,qw(-o),$tf,'--',"$furl";
+	return 0 if !act_local();
+	$downloaded = 1;
     }
-}
 
-sub rev_parse ($) {
-    return cmdoutput @git, qw(rev-parse), "$_[0]~0";
+    open F, "<", "$tf" or die "$tf: $!";
+    $fi->{Digester}->reset();
+    $fi->{Digester}->addfile(*F);
+    F->error and die $!;
+    my $got = $fi->{Digester}->hexdigest();
+    $got eq $fi->{Hash} or
+	fail "file $f has hash $got but .dsc".
+	    " demands hash $fi->{Hash} ".
+	    ($downloaded ? "(got wrong file from archive!)"
+	     : "(perhaps you should delete this file?)");
+
+    return 1;
 }
 
-sub is_fast_fwd ($$) {
-    my ($ancestor,$child) = @_;
-    my @cmd = (@git, qw(merge-base), $ancestor, $child);
-    my $mb = cmdoutput_errok @cmd;
-    if (defined $mb) {
-	return rev_parse($mb) eq rev_parse($ancestor);
-    } else {
-	$?==256 or failedcmd @cmd;
-	return 0;
+sub ensure_we_have_orig () {
+    foreach my $fi (dsc_files_info()) {
+	my $f = $fi->{Filename};
+	next unless is_orig_file($f);
+	complete_file_from_dsc('..', $fi)
+	    or next;
     }
 }
 
 sub git_fetch_us () {
-    runcmd_ordryrun_local @git, qw(fetch),access_giturl(),fetchspec();
+    my @specs = (fetchspec());
+    push @specs,
+        map { "+refs/$_/*:".lrfetchrefs."/$_/*" }
+        qw(tags heads);
+    runcmd_ordryrun_local @git, qw(fetch -p -n -q), access_giturl(), @specs;
+
+    my %here;
+    my @tagpats = debiantags('*',access_basedistro);
+
+    git_for_each_ref([map { "refs/tags/$_" } @tagpats], sub {
+	my ($objid,$objtype,$fullrefname,$reftail) = @_;
+	printdebug "currently $fullrefname=$objid\n";
+	$here{$fullrefname} = $objid;
+    });
+    git_for_each_ref([map { lrfetchrefs."/tags/".$_ } @tagpats], sub {
+	my ($objid,$objtype,$fullrefname,$reftail) = @_;
+	my $lref = "refs".substr($fullrefname, length lrfetchrefs);
+	printdebug "offered $lref=$objid\n";
+	if (!defined $here{$lref}) {
+	    my @upd = (@git, qw(update-ref), $lref, $objid, '');
+	    runcmd_ordryrun_local @upd;
+	} elsif ($here{$lref} eq $objid) {
+	} else {
+	    print STDERR \
+		"Not updateting $lref from $here{$lref} to $objid.\n";
+	}
+    });
 }
 
 sub fetch_from_archive () {
@@ -1135,8 +1681,8 @@ $later_warning_msg
 END
 	    $hash = $lastpush_hash;
 	} else {
-	    fail "archive's .dsc refers to ".$dsc_hash.
-		" but this is an ancestor of ".$lastpush_hash;
+	    fail "git head (".lrref()."=$lastpush_hash) is not a ".
+		"descendant of archive's .dsc hash ($dsc_hash)";
 	}
     } elsif ($dsc) {
 	$hash = generate_commit_from_dsc();
@@ -1176,7 +1722,7 @@ END
 	my $gotclogp = parsechangelog("-l$clogf");
 	my $got_vsn = getfield $gotclogp, 'Version';
 	printdebug "SKEW CHECK GOT $got_vsn\n";
-	if (version_compare_string($got_vsn, $skew_warning_vsn) < 0) {
+	if (version_compare($got_vsn, $skew_warning_vsn) < 0) {
 	    print STDERR <<END or die $!;
 
 Warning: archive skew detected.  Using the available version:
@@ -1197,19 +1743,78 @@ END
     return 1;
 }
 
+sub set_local_git_config ($$) {
+    my ($k, $v) = @_;
+    runcmd @git, qw(config), $k, $v;
+}
+
+sub setup_mergechangelogs (;$) {
+    my ($always) = @_;
+    return unless $always || access_cfg_bool(1, 'setup-mergechangelogs');
+
+    my $driver = 'dpkg-mergechangelogs';
+    my $cb = "merge.$driver";
+    my $attrs = '.git/info/attributes';
+    ensuredir '.git/info';
+
+    open NATTRS, ">", "$attrs.new" or die "$attrs.new $!";
+    if (!open ATTRS, "<", $attrs) {
+	$!==ENOENT or die "$attrs: $!";
+    } else {
+	while (<ATTRS>) {
+	    chomp;
+	    next if m{^debian/changelog\s};
+	    print NATTRS $_, "\n" or die $!;
+	}
+	ATTRS->error and die $!;
+	close ATTRS;
+    }
+    print NATTRS "debian/changelog merge=$driver\n" or die $!;
+    close NATTRS;
+
+    set_local_git_config "$cb.name", 'debian/changelog merge driver';
+    set_local_git_config "$cb.driver", 'dpkg-mergechangelogs -m %O %A %B %A';
+
+    rename "$attrs.new", "$attrs" or die "$attrs: $!";
+}
+
+sub setup_useremail (;$) {
+    my ($always) = @_;
+    return unless $always || access_cfg_bool(1, 'setup-useremail');
+
+    my $setup = sub {
+	my ($k, $envvar) = @_;
+	my $v = access_cfg("user-$k", 'RETURN-UNDEF') // $ENV{$envvar};
+	return unless defined $v;
+	set_local_git_config "user.$k", $v;
+    };
+
+    $setup->('email', 'DEBEMAIL');
+    $setup->('name', 'DEBFULLNAME');
+}
+
+sub setup_new_tree () {
+    setup_mergechangelogs();
+    setup_useremail();
+}
+
 sub clone ($) {
     my ($dstdir) = @_;
     canonicalise_suite();
     badusage "dry run makes no sense with clone" unless act_local();
-    mkdir $dstdir or die "$dstdir $!";
+    my $hasgit = check_for_git();
+    mkdir $dstdir or fail "create \`$dstdir': $!";
     changedir $dstdir;
     runcmd @git, qw(init -q);
-    runcmd @git, qw(config), "remote.$remotename.fetch", fetchspec();
-    open H, "> .git/HEAD" or die $!;
-    print H "ref: ".lref()."\n" or die $!;
-    close H or die $!;
-    runcmd @git, qw(remote add), 'origin', access_giturl();
-    if (check_for_git()) {
+    my $giturl = access_giturl(1);
+    if (defined $giturl) {
+	set_local_git_config "remote.$remotename.fetch", fetchspec();
+	open H, "> .git/HEAD" or die $!;
+	print H "ref: ".lref()."\n" or die $!;
+	close H or die $!;
+	runcmd @git, qw(remote add), 'origin', $giturl;
+    }
+    if ($hasgit) {
 	progress "fetching existing git history";
 	git_fetch_us();
 	runcmd_ordryrun_local @git, qw(fetch origin);
@@ -1217,6 +1822,12 @@ sub clone ($) {
 	progress "starting new git history";
     }
     fetch_from_archive() or no_such_package;
+    my $vcsgiturl = $dsc->{'Vcs-Git'};
+    if (length $vcsgiturl) {
+	$vcsgiturl =~ s/\s+-b\s+\S+//g;
+	runcmd @git, qw(remote add vcs-git), $vcsgiturl;
+    }
+    setup_new_tree();
     runcmd @git, qw(reset --hard), lrref();
     printdone "ready for work in $dstdir";
 }
@@ -1237,18 +1848,31 @@ sub pull () {
 }
 
 sub check_not_dirty () {
+    foreach my $f (qw(local-options local-patch-header)) {
+	if (stat_exists "debian/source/$f") {
+	    fail "git tree contains debian/source/$f";
+	}
+    }
+
     return if $ignoredirty;
+
     my @cmd = (@git, qw(diff --quiet HEAD));
-    printcmd(\*DEBUG,$debugprefix."+",@cmd) if $debug>0;
-    $!=0; $?=0; system @cmd;
-    return if !$! && !$?;
-    if (!$! && $?==256) {
+    debugcmd "+",@cmd;
+    $!=0; $?=-1; system @cmd;
+    return if !$?;
+    if ($?==256) {
 	fail "working tree is dirty (does not match HEAD)";
     } else {
 	failedcmd @cmd;
     }
 }
 
+sub commit_admin ($) {
+    my ($m) = @_;
+    progress "$m";
+    runcmd_ordryrun_local @git, qw(commit -m), $m;
+}
+
 sub commit_quilty_patch () {
     my $output = cmdoutput @git, qw(status --porcelain);
     my %adds;
@@ -1258,24 +1882,59 @@ sub commit_quilty_patch () {
 	    $adds{$1}++;
 	}
     }
+    delete $adds{'.pc'}; # if there wasn't one before, don't add it
     if (!%adds) {
 	progress "nothing quilty to commit, ok.";
 	return;
     }
-    runcmd_ordryrun_local @git, qw(add), sort keys %adds;
-    my $m = "Commit Debian 3.0 (quilt) metadata";
-    progress "$m";
-    runcmd_ordryrun_local @git, qw(commit -m), $m;
+    my @adds = map { s/[][*?\\]/\\$&/g; $_; } sort keys %adds;
+    runcmd_ordryrun_local @git, qw(add -f), @adds;
+    commit_admin "Commit Debian 3.0 (quilt) metadata";
+}
+
+sub get_source_format () {
+    my %options;
+    if (open F, "debian/source/options") {
+	while (<F>) {
+	    next if m/^\s*\#/;
+	    next unless m/\S/;
+	    s/\s+$//; # ignore missing final newline
+	    if (m/\s*\#\s*/) {
+		my ($k, $v) = ($`, $'); #');
+		$v =~ s/^"(.*)"$/$1/;
+		$options{$k} = $v;
+	    } else {
+		$options{$_} = 1;
+	    }
+	}
+	F->error and die $!;
+	close F;
+    } else {
+	die $! unless $!==&ENOENT;
+    }
+
+    if (!open F, "debian/source/format") {
+	die $! unless $!==&ENOENT;
+	return '';
+    }
+    $_ = <F>;
+    F->error and die $!;
+    chomp;
+    return ($_, \%options);
 }
 
 sub madformat ($) {
     my ($format) = @_;
     return 0 unless $format eq '3.0 (quilt)';
-    progress "Format \`$format', urgh";
-    if ($noquilt) {
-	progress "Not doing any fixup of \`$format' due to --no-quilt-fixup";
+    our $quilt_mode_warned;
+    if ($quilt_mode eq 'nocheck') {
+	progress "Not doing any fixup of \`$format' due to".
+	    " ----no-quilt-fixup or --quilt=nocheck"
+	    unless $quilt_mode_warned++;
 	return 0;
     }
+    progress "Format \`$format', need to check/update patch stack"
+	unless $quilt_mode_warned++;
     return 1;
 }
 
@@ -1287,12 +1946,12 @@ sub push_parse_changelog ($) {
 
     $package = getfield $clogp, 'Source';
     my $cversion = getfield $clogp, 'Version';
-    my $tag = debiantag($cversion);
+    my $tag = debiantag($cversion, access_basedistro);
     runcmd @git, qw(check-ref-format), $tag;
 
     my $dscfn = dscfn($cversion);
 
-    return ($clogp, $cversion, $tag, $dscfn);
+    return ($clogp, $cversion, $dscfn);
 }
 
 sub push_parse_dsc ($$$) {
@@ -1305,13 +1964,38 @@ sub push_parse_dsc ($$$) {
 	    " but debian/changelog is for $package $cversion";
 }
 
-sub push_mktag ($$$$$$$) {
-    my ($head,$clogp,$tag,
-	$dscfn,
+sub push_tagwants ($$$$) {
+    my ($cversion, $dgithead, $maintviewhead, $tfbase) = @_;
+    my @tagwants;
+    push @tagwants, {
+        TagFn => \&debiantag,
+	Objid => $dgithead,
+        TfSuffix => '',
+        View => 'dgit',
+    };
+    if (defined $maintviewhead) {
+	push @tagwants, {
+            TagFn => \&debiantag_maintview,
+	    Objid => $maintviewhead,
+	    TfSuffix => '-maintview',
+            View => 'maint',
+        };
+    }
+    foreach my $tw (@tagwants) {
+	$tw->{Tag} = $tw->{TagFn}($cversion, access_basedistro);
+	$tw->{Tfn} = sub { $tfbase.$tw->{TfSuffix}.$_[0]; };
+    }
+    return @tagwants;
+}
+
+sub push_mktags ($$ $$ $) {
+    my ($clogp,$dscfn,
 	$changesfile,$changesfilewhat,
-	$tfn) = @_;
+        $tagwants) = @_;
+
+    die unless $tagwants->[0]{View} eq 'dgit';
 
-    $dsc->{$ourdscfield[0]} = $head;
+    $dsc->{$ourdscfield[0]} = $tagwants->[0]{Objid};
     $dsc->save("$dscfn.tmp") or die $!;
 
     my $changes = parsecontrol($changesfile,$changesfilewhat);
@@ -1327,35 +2011,68 @@ sub push_mktag ($$$$$$$) {
     # We make the git tag by hand because (a) that makes it easier
     # to control the "tagger" (b) we can do remote signing
     my $authline = clogp_authline $clogp;
-    open TO, '>', $tfn->('.tmp') or die $!;
-    print TO <<END or die $!;
+    my $delibs = join(" ", "",@deliberatelies);
+    my $declaredistro = access_basedistro();
+
+    my $mktag = sub {
+	my ($tw) = @_;
+	my $tfn = $tw->{Tfn};
+	my $head = $tw->{Objid};
+	my $tag = $tw->{Tag};
+
+	open TO, '>', $tfn->('.tmp') or die $!;
+	print TO <<END or die $!;
 object $head
 type commit
 tag $tag
 tagger $authline
 
+END
+	if ($tw->{View} eq 'dgit') {
+	    print TO <<END or die $!;
 $package release $cversion for $clogsuite ($csuite) [dgit]
+[dgit distro=$declaredistro$delibs]
 END
-    close TO or die $!;
-
-    my $tagobjfn = $tfn->('.tmp');
-    if ($sign) {
-	if (!defined $keyid) {
-	    $keyid = access_cfg('keyid','RETURN-UNDEF');
+	    foreach my $ref (sort keys %previously) {
+		print TO <<END or die $!;
+[dgit previously:$ref=$previously{$ref}]
+END
+	    }
+	} elsif ($tw->{View} eq 'maint') {
+	    print TO <<END or die $!;
+$package release $cversion for $clogsuite ($csuite)
+(maintainer view tag generated by dgit --quilt=$quilt_mode)
+END
+	} else {
+	    die Dumper($tw)."?";
 	}
-	unlink $tfn->('.tmp.asc') or $!==&ENOENT or die $!;
-	my @sign_cmd = (@gpg, qw(--detach-sign --armor));
-	push @sign_cmd, qw(-u),$keyid if defined $keyid;
-	push @sign_cmd, $tfn->('.tmp');
-	runcmd_ordryrun @sign_cmd;
-	if (act_scary()) {
-	    $tagobjfn = $tfn->('.signed.tmp');
-	    runcmd shell_cmd "exec >$tagobjfn", qw(cat --),
-	        $tfn->('.tmp'), $tfn->('.tmp.asc');
+
+	close TO or die $!;
+
+	my $tagobjfn = $tfn->('.tmp');
+	if ($sign) {
+	    if (!defined $keyid) {
+		$keyid = access_cfg('keyid','RETURN-UNDEF');
+	    }
+	    if (!defined $keyid) {
+		$keyid = getfield $clogp, 'Maintainer';
+	    }
+	    unlink $tfn->('.tmp.asc') or $!==&ENOENT or die $!;
+	    my @sign_cmd = (@gpg, qw(--detach-sign --armor));
+	    push @sign_cmd, qw(-u),$keyid if defined $keyid;
+	    push @sign_cmd, $tfn->('.tmp');
+	    runcmd_ordryrun @sign_cmd;
+	    if (act_scary()) {
+		$tagobjfn = $tfn->('.signed.tmp');
+		runcmd shell_cmd "exec >$tagobjfn", qw(cat --),
+		    $tfn->('.tmp'), $tfn->('.tmp.asc');
+	    }
 	}
-    }
+	return $tagobjfn;
+    };
 
-    return ($tagobjfn);
+    my @r = map { $mktag->($_); } @$tagwants;
+    return @r;
 }
 
 sub sign_changes ($) {
@@ -1369,22 +2086,32 @@ sub sign_changes ($) {
     }
 }
 
-sub dopush () {
+sub dopush ($) {
+    my ($forceflag) = @_;
     printdebug "actually entering push\n";
+    supplementary_message(<<'END');
+Push failed, while preparing your push.
+You can retry the push, after fixing the problem, if you like.
+END
+
+    need_tagformat 'new', "quilt mode $quilt_mode"
+        if quiltmode_splitbrain;
+
     prep_ud();
 
     access_giturl(); # check that success is vaguely likely
+    select_tagformat();
 
     my $clogpfn = ".git/dgit/changelog.822.tmp";
     runcmd shell_cmd "exec >$clogpfn", qw(dpkg-parsechangelog);
 
     responder_send_file('parsed-changelog', $clogpfn);
 
-    my ($clogp, $cversion, $tag, $dscfn) =
+    my ($clogp, $cversion, $dscfn) =
 	push_parse_changelog("$clogpfn");
 
     my $dscpath = "$buildproductsdir/$dscfn";
-    stat $dscpath or
+    stat_exists $dscpath or
 	fail "looked for .dsc $dscfn, but $!;".
 	    " maybe you forgot to build";
 
@@ -1394,20 +2121,45 @@ sub dopush () {
 
     my $format = getfield $dsc, 'Format';
     printdebug "format $format\n";
+
+    my $actualhead = git_rev_parse('HEAD');
+    my $dgithead = $actualhead;
+    my $maintviewhead = undef;
+
     if (madformat($format)) {
-	commit_quilty_patch();
+	# user might have not used dgit build, so maybe do this now:
+	if (quiltmode_splitbrain()) {
+	    my $upstreamversion = $clogp->{Version};
+	    $upstreamversion =~ s/-[^-]*$//;
+	    changedir $ud;
+	    quilt_make_fake_dsc($upstreamversion);
+	    my ($dgitview, $cachekey) =
+		quilt_check_splitbrain_cache($actualhead, $upstreamversion);
+	    $dgitview or fail
+ "--quilt=$quilt_mode but no cached dgit view:
+ perhaps tree changed since dgit build[-source] ?";
+	    $split_brain = 1;
+	    $dgithead = $dgitview;
+	    $maintviewhead = $actualhead;
+	    changedir '../../../..';
+	    prep_ud(); # so _only_subdir() works, below
+	} else {
+	    commit_quilty_patch();
+	}
     }
+
     check_not_dirty();
     changedir $ud;
     progress "checking that $dscfn corresponds to HEAD";
     runcmd qw(dpkg-source -x --),
         $dscpath =~ m#^/# ? $dscpath : "../../../$dscpath";
     my ($tree,$dir) = mktree_in_ud_from_only_subdir();
+    check_for_vendor_patches() if madformat($dsc->{format});
     changedir '../../../..';
-    my $diffopt = $debug>0 ? '--exit-code' : '--quiet';
-    my @diffcmd = (@git, qw(diff), $diffopt, $tree);
-    printcmd \*DEBUG,$debugprefix."+",@diffcmd;
-    $!=0; $?=0;
+    my $diffopt = $debuglevel>0 ? '--exit-code' : '--quiet';
+    my @diffcmd = (@git, qw(diff), $diffopt, $tree, $dgithead);
+    debugcmd "+",@diffcmd;
+    $!=0; $?=-1;
     my $r = system @diffcmd;
     if ($r) {
 	if ($r==256) {
@@ -1419,62 +2171,93 @@ sub dopush () {
 	    failedcmd @diffcmd;
 	}
     }
-#fetch from alioth
-#do fast forward check and maybe fake merge
-#    if (!is_fast_fwd(mainbranch
-#    runcmd @git, qw(fetch -p ), "$alioth_git/$package.git",
-#        map { lref($_).":".rref($_) }
-#        (uploadbranch());
-    my $head = rev_parse('HEAD');
     if (!$changesfile) {
-	my $multi = "$buildproductsdir/".
-	    "${package}_".(stripepoch $cversion)."_multi.changes";
-	if (stat "$multi") {
-	    $changesfile = $multi;
-	} else {
-	    $!==&ENOENT or die "$multi: $!";
-	    my $pat = "${package}_".(stripepoch $cversion)."_*.changes";
-	    my @cs = glob "$buildproductsdir/$pat";
-	    fail "failed to find unique changes file".
-		" (looked for $pat in $buildproductsdir, or $multi);".
-		" perhaps you need to use dgit -C"
-		unless @cs==1;
-	    ($changesfile) = @cs;
-	}
+	my $pat = changespat $cversion;
+	my @cs = glob "$buildproductsdir/$pat";
+	fail "failed to find unique changes file".
+	    " (looked for $pat in $buildproductsdir);".
+	    " perhaps you need to use dgit -C"
+	    unless @cs==1;
+	($changesfile) = @cs;
     } else {
 	$changesfile = "$buildproductsdir/$changesfile";
     }
 
     responder_send_file('changes',$changesfile);
-    responder_send_command("param head $head");
+    responder_send_command("param head $dgithead");
     responder_send_command("param csuite $csuite");
+    responder_send_command("param tagformat $tagformat");
+    if (quiltmode_splitbrain) {
+	die unless ($protovsn//4) >= 4;
+	responder_send_command("param maint-view $maintviewhead");
+    }
+
+    if (deliberately_not_fast_forward) {
+	git_for_each_ref(lrfetchrefs, sub {
+	    my ($objid,$objtype,$lrfetchrefname,$reftail) = @_;
+	    my $rrefname= substr($lrfetchrefname, length(lrfetchrefs) + 1);
+	    responder_send_command("previously $rrefname=$objid");
+	    $previously{$rrefname} = $objid;
+	});
+    }
 
-    my $tfn = sub { ".git/dgit/tag$_[0]"; };
-    my $tagobjfn;
+    my @tagwants = push_tagwants($cversion, $dgithead, $maintviewhead,
+				 ".git/dgit/tag");
+    my @tagobjfns;
 
+    supplementary_message(<<'END');
+Push failed, while signing the tag.
+You can retry the push, after fixing the problem, if you like.
+END
+    # If we manage to sign but fail to record it anywhere, it's fine.
     if ($we_are_responder) {
-	$tagobjfn = $tfn->('.signed.tmp');
-	responder_receive_files('signed-tag', $tagobjfn);
+	@tagobjfns = map { $_->{Tfn}('.signed-tmp') } @tagwants;
+	responder_receive_files('signed-tag', @tagobjfns);
     } else {
-	$tagobjfn =
-	    push_mktag($head,$clogp,$tag,
-		       $dscpath,
-		       $changesfile,$changesfile,
-		       $tfn);
+	@tagobjfns = push_mktags($clogp,$dscpath,
+			      $changesfile,$changesfile,
+			      \@tagwants);
     }
+    supplementary_message(<<'END');
+Push failed, *after* signing the tag.
+If you want to try again, you should use a new version number.
+END
 
-    my $tag_obj_hash = cmdoutput @git, qw(hash-object -w -t tag), $tagobjfn;
-    runcmd_ordryrun @git, qw(verify-tag), $tag_obj_hash;
-    runcmd_ordryrun_local @git, qw(update-ref), "refs/tags/$tag", $tag_obj_hash;
-    runcmd_ordryrun @git, qw(tag -v --), $tag;
+    pairwise { $a->{TagObjFn} = $b } @tagwants, @tagobjfns;
 
+    foreach my $tw (@tagwants) {
+	my $tag = $tw->{Tag};
+	my $tagobjfn = $tw->{TagObjFn};
+	my $tag_obj_hash =
+	    cmdoutput @git, qw(hash-object -w -t tag), $tagobjfn;
+	runcmd_ordryrun @git, qw(verify-tag), $tag_obj_hash;
+	runcmd_ordryrun_local
+	    @git, qw(update-ref), "refs/tags/$tag", $tag_obj_hash;
+    }
+
+    supplementary_message(<<'END');
+Push failed, while updating the remote git repository - see messages above.
+If you want to try again, you should use a new version number.
+END
     if (!check_for_git()) {
 	create_remote_git_repo();
     }
-    runcmd_ordryrun @git, qw(push),access_giturl(),
-        "HEAD:".rrref(), "refs/tags/$tag";
-    runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), 'HEAD';
 
+    my @pushrefs = $forceflag."HEAD:".rrref();
+    foreach my $tw (@tagwants) {
+	my $view = $tw->{View};
+	next unless $view eq 'dgit'
+	    or any { $_ eq $view } access_cfg_tagformats();
+	push @pushrefs, $forceflag."refs/tags/$tw->{Tag}";
+    }
+
+    runcmd_ordryrun @git, qw(push),access_giturl(), @pushrefs;
+    runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), $dgithead;
+
+    supplementary_message(<<'END');
+Push failed, after updating the remote git repository.
+If you want to try again, you must use a new version number.
+END
     if ($we_are_responder) {
 	my $dryrunsuffix = act_local() ? "" : ".tmp";
 	responder_receive_files('signed-dsc-changes',
@@ -1489,16 +2272,25 @@ sub dopush () {
 	sign_changes $changesfile;
     }
 
+    supplementary_message(<<END);
+Push failed, while uploading package(s) to the archive server.
+You can retry the upload of exactly these same files with dput of:
+  $changesfile
+If that .changes file is broken, you will need to use a new version
+number for your next attempt at the upload.
+END
     my $host = access_cfg('upload-host','RETURN-UNDEF');
     my @hostarg = defined($host) ? ($host,) : ();
     runcmd_ordryrun @dput, @hostarg, $changesfile;
     printdone "pushed and uploaded $cversion";
 
+    supplementary_message('');
     responder_send_command("complete");
 }
 
 sub cmd_clone {
     parseopts();
+    notpushing();
     my $dstdir;
     badusage "-p is not allowed with clone; specify as argument instead"
 	if defined $package;
@@ -1515,10 +2307,8 @@ sub cmd_clone {
     }
     $dstdir ||= "$package";
 
-    if (stat $dstdir) {
+    if (stat_exists $dstdir) {
 	fail "$dstdir already exists";
-    } elsif ($! != &ENOENT) {
-	die "$dstdir: $!";
     }
 
     my $cwd_remove;
@@ -1530,7 +2320,13 @@ sub cmd_clone {
 		return if $!==&ENOENT;
 		die "chdir $cwd_remove: $!";
 	    }
-	    rmtree($dstdir) or die "remove $dstdir: $!\n";
+	    if (stat $dstdir) {
+		rmtree($dstdir) or die "remove $dstdir: $!\n";
+	    } elsif (!grep { $! == $_ }
+		     (ENOENT, ENOTDIR, EACCES, EPERM, ELOOP)) {
+	    } else {
+		print STDERR "check whether to remove $dstdir: $!\n";
+	    }
 	};
     }
 
@@ -1548,6 +2344,7 @@ sub branchsuite () {
 }
 
 sub fetchpullargs () {
+    notpushing();
     if (!defined $package) {
 	my $sourcep = parsecontrol('debian/control','debian/control');
 	$package = getfield $sourcep, 'Source';
@@ -1582,6 +2379,7 @@ sub cmd_pull {
 
 sub cmd_push {
     parseopts();
+    pushing();
     badusage "-p is not allowed with dgit push" if defined $package;
     check_not_dirty();
     my $clogp = parsechangelog();
@@ -1597,39 +2395,60 @@ sub cmd_push {
     if ($new_package) {
 	local ($package) = $existing_package; # this is a hack
 	canonicalise_suite();
-    }
-    if (defined $specsuite && $specsuite ne $isuite) {
+    } else {
 	canonicalise_suite();
-	$csuite eq $specsuite or
+    }
+    if (defined $specsuite &&
+	$specsuite ne $isuite &&
+	$specsuite ne $csuite) {
 	    fail "dgit push: changelog specifies $isuite ($csuite)".
 	        " but command line specifies $specsuite";
     }
+    supplementary_message(<<'END');
+Push failed, while checking state of the archive.
+You can retry the push, after fixing the problem, if you like.
+END
     if (check_for_git()) {
 	git_fetch_us();
     }
+    my $forceflag = '';
     if (fetch_from_archive()) {
-	is_fast_fwd(lrref(), 'HEAD') or
+	if (is_fast_fwd(lrref(), 'HEAD')) {
+	    # ok
+	} elsif (deliberately_not_fast_forward) {
+	    $forceflag = '+';
+	} else {
 	    fail "dgit push: HEAD is not a descendant".
 	        " of the archive's version.\n".
-		"$us: To overwrite it, use git merge -s ours ".lrref().".";
+		"dgit: To overwrite its contents,".
+		" use git merge -s ours ".lrref().".\n".
+		"dgit: To rewind history, if permitted by the archive,".
+		" use --deliberately-not-fast-forward";
+	}
     } else {
 	$new_package or
 	    fail "package appears to be new in this suite;".
 	        " if this is intentional, use --new";
     }
-    dopush();
+    dopush($forceflag);
 }
 
 #---------- remote commands' implementation ----------
 
-sub cmd_remote_push_responder {
+sub cmd_remote_push_build_host {
     my ($nrargs) = shift @ARGV;
     my (@rargs) = @ARGV[0..$nrargs-1];
     @ARGV = @ARGV[$nrargs..$#ARGV];
     die unless @rargs;
-    my ($dir) = @rargs;
+    my ($dir,$vsnwant) = @rargs;
+    # vsnwant is a comma-separated list; we report which we have
+    # chosen in our ready response (so other end can tell if they
+    # offered several)
     $debugprefix = ' ';
     $we_are_responder = 1;
+    $us .= " (build host)";
+
+    pushing();
 
     open PI, "<&STDIN" or die $!;
     open STDIN, "/dev/null" or die $!;
@@ -1638,19 +2457,42 @@ sub cmd_remote_push_responder {
     open STDOUT, ">&STDERR" or die $!;
     autoflush STDOUT 1;
 
-    responder_send_command("dgit-remote-push-ready");
+    $vsnwant //= 1;
+    ($protovsn) = grep {
+	$vsnwant =~ m{^(?:.*,)?$_(?:,.*)?$}
+    } @rpushprotovsn_support;
+
+    fail "build host has dgit rpush protocol versions ".
+	(join ",", @rpushprotovsn_support).
+        " but invocation host has $vsnwant"
+	unless defined $protovsn;
 
+    responder_send_command("dgit-remote-push-ready $protovsn");
+    rpush_handle_protovsn_bothends();
     changedir $dir;
     &cmd_push;
 }
 
+sub cmd_remote_push_responder { cmd_remote_push_build_host(); }
+# ... for compatibility with proto vsn.1 dgit (just so that user gets
+#     a good error message)
+
+sub rpush_handle_protovsn_bothends () {
+    if ($protovsn < 4) {
+	need_tagformat 'old', "rpush negotiated protocol $protovsn";
+    }
+    select_tagformat();
+}
+
 our $i_tmp;
-our $i_child_pid;
 
 sub i_cleanup {
-    local ($@);
-    if ($i_child_pid) {
-	printdebug "(killing remote child $i_child_pid)\n";
+    local ($@, $?);
+    my $report = i_child_report();
+    if (defined $report) {
+	printdebug "($report)\n";
+    } elsif ($i_child_pid) {
+	printdebug "(killing build host child $i_child_pid)\n";
 	kill 15, $i_child_pid;
     }
     if (defined $i_tmp && !defined $initiator_tempdir) {
@@ -1668,6 +2510,7 @@ sub i_method {
 }
 
 sub cmd_rpush {
+    pushing();
     my $host = nextarg;
     my $dir;
     if ($host =~ m/^((?:[^][]|\[[^][]*\])*)\:/) {
@@ -1678,13 +2521,14 @@ sub cmd_rpush {
     }
     $dir =~ s{^-}{./-};
     my @rargs = ($dir);
+    push @rargs, join ",", @rpushprotovsn_support;
     my @rdgit;
     push @rdgit, @dgit;
     push @rdgit, @ropts;
-    push @rdgit, qw(remote-push-responder), (scalar @rargs), @rargs;
+    push @rdgit, qw(remote-push-build-host), (scalar @rargs), @rargs;
     push @rdgit, @ARGV;
     my @cmd = (@ssh, $host, shellquote @rdgit);
-    printcmd \*DEBUG,$debugprefix."+",@cmd;
+    debugcmd "+",@cmd;
 
     if (defined $initiator_tempdir) {
 	rmtree $initiator_tempdir;
@@ -1695,7 +2539,15 @@ sub cmd_rpush {
     }
     $i_child_pid = open2(\*RO, \*RI, @cmd);
     changedir $i_tmp;
-    initiator_expect { m/^dgit-remote-push-ready/ };
+    ($protovsn) = initiator_expect { m/^dgit-remote-push-ready (\S+)/ };
+    die "$protovsn ?" unless grep { $_ eq $protovsn } @rpushprotovsn_support;
+    $supplementary_message = '' unless $protovsn >= 3;
+
+    fail "rpush negotiated protocol version $protovsn".
+	" which does not support quilt mode $quilt_mode"
+	if quiltmode_splitbrain;
+
+    rpush_handle_protovsn_bothends();
     for (;;) {
 	my ($icmd,$iargs) = initiator_expect {
 	    m/^(\S+)(?: (.*))?$/;
@@ -1711,13 +2563,18 @@ sub i_resp_progress ($) {
     progress $msg;
 }
 
+sub i_resp_supplementary_message ($) {
+    my ($rhs) = @_;
+    $supplementary_message = protocol_read_bytes \*RO, $rhs;
+}
+
 sub i_resp_complete {
     my $pid = $i_child_pid;
     $i_child_pid = undef; # prevents killing some other process with same pid
-    printdebug "waiting for remote child $pid...\n";
+    printdebug "waiting for build host child $pid...\n";
     my $got = waitpid $pid, 0;
     die $! unless $got == $pid;
-    die "remote child failed $?" if $?;
+    die "build host child failed $?" if $?;
 
     i_cleanup();
     printdebug "all done\n";
@@ -1728,7 +2585,8 @@ sub i_resp_file ($) {
     my ($keyword) = @_;
     my $localname = i_method "i_localname", $keyword;
     my $localpath = "$i_tmp/$localname";
-    stat $localpath and badproto \*RO, "file $keyword ($localpath) twice";
+    stat_exists $localpath and
+	badproto \*RO, "file $keyword ($localpath) twice";
     protocol_receive_file \*RO, $localpath;
     i_method "i_file", $keyword;
 }
@@ -1740,6 +2598,14 @@ sub i_resp_param ($) {
     $i_param{$1} = $2;
 }
 
+sub i_resp_previously ($) {
+    $_[0] =~ m#^(refs/tags/\S+)=(\w+)$#
+	or badproto \*RO, "bad previously spec";
+    my $r = system qw(git check-ref-format), $1;
+    die "bad previously ref spec ($r)" if $r;
+    $previously{$1} = $2;
+}
+
 our %i_wanted;
 
 sub i_resp_want ($) {
@@ -1753,13 +2619,13 @@ sub i_resp_want ($) {
     print RI "files-end\n" or die $!;
 }
 
-our ($i_clogp, $i_version, $i_tag, $i_dscfn, $i_changesfn);
+our ($i_clogp, $i_version, $i_dscfn, $i_changesfn);
 
 sub i_localname_parsed_changelog {
     return "remote-changelog.822";
 }
 sub i_file_parsed_changelog {
-    ($i_clogp, $i_version, $i_tag, $i_dscfn) =
+    ($i_clogp, $i_version, $i_dscfn) =
 	push_parse_changelog "$i_tmp/remote-changelog.822";
     die if $i_dscfn =~ m#/|^\W#;
 }
@@ -1786,17 +2652,26 @@ sub i_want_signed_tag {
     my $head = $i_param{'head'};
     die if $head =~ m/[^0-9a-f]/ || $head !~ m/^../;
 
+    my $maintview = $i_param{'maint-view'};
+    die if defined $maintview && $maintview =~ m/[^0-9a-f]/;
+
+    select_tagformat();
+    if ($protovsn >= 4) {
+	my $p = $i_param{'tagformat'} // '<undef>';
+	$p eq $tagformat
+	    or badproto \*RO, "tag format mismatch: $p vs. $tagformat";
+    }
+
     die unless $i_param{'csuite'} =~ m/^$suite_re$/;
     $csuite = $&;
     push_parse_dsc $i_dscfn, 'remote dsc', $i_version;
 
-    my $tagobjfn =
-	push_mktag $head, $i_clogp, $i_tag,
-	    $i_dscfn,
-	    $i_changesfn, 'remote changes',
-	    sub { "tag$_[0]"; };
+    my @tagwants = push_tagwants $i_version, $head, $maintview, "tag";
 
-    return $tagobjfn;
+    return
+	push_mktags $i_clogp, $i_dscfn,
+	    $i_changesfn, 'remote changes',
+	    \@tagwants;
 }
 
 sub i_want_signed_dsc_changes {
@@ -1811,60 +2686,742 @@ our $version;
 our $sourcechanges;
 our $dscfn;
 
+#----- `3.0 (quilt)' handling -----
+
 our $fakeeditorenv = 'DGIT_FAKE_EDITOR_QUILT';
 
-sub build_maybe_quilt_fixup () {
-    if (!open F, "debian/source/format") {
-	die $! unless $!==&ENOENT;
-	return;
-    }
-    $_ = <F>;
-    F->error and die $!;
-    chomp;
-    return unless madformat($_);
-    # sigh
-    
-    my @cmd = (@git, qw(ls-files --exclude-standard -iodm));
-    my $problems = cmdoutput @cmd;
-    if (length $problems) {
-	print STDERR "problematic files:\n";
-	print STDERR "  $_\n" foreach split /\n/, $problems;
-	fail "Cannot do quilt fixup in tree containing ignored files.  ".
-	    "Perhaps your package's clean target is broken, in which".
-	    " case -wg (which says to use git-clean -xdf) may help.";
-    }
+sub quiltify_dpkg_commit ($$$;$) {
+    my ($patchname,$author,$msg, $xinfo) = @_;
+    $xinfo //= '';
 
-    my $clogp = parsechangelog();
-    my $version = getfield $clogp, 'Version';
-    my $author = getfield $clogp, 'Maintainer';
-    my $headref = rev_parse('HEAD');
-    my $time = time;
-    my $ncommits = 3;
-    my $patchname = "auto-$version-$headref-$time";
-    my $msg = cmdoutput @git, qw(log), "-n$ncommits";
     mkpath '.git/dgit';
     my $descfn = ".git/dgit/quilt-description.tmp";
     open O, '>', $descfn or die "$descfn: $!";
+    $msg =~ s/\s+$//g;
     $msg =~ s/\n/\n /g;
     $msg =~ s/^\s+$/ ./mg;
     print O <<END or die $!;
-Description: Automatically generated patch ($clogp->{Version})
- Last (up to) $ncommits git changes, FYI:
- .
- $msg
+Description: $msg
 Author: $author
-
+$xinfo
 ---
 
 END
     close O or die $!;
+
     {
 	local $ENV{'EDITOR'} = cmdoutput qw(realpath --), $0;
 	local $ENV{'VISUAL'} = $ENV{'EDITOR'};
 	local $ENV{$fakeeditorenv} = cmdoutput qw(realpath --), $descfn;
-	runcmd_ordryrun_local @dpkgsource, qw(--commit .), $patchname;
+	runcmd @dpkgsource, qw(--commit .), $patchname;
+    }
+}
+
+sub quiltify_trees_differ ($$;$$) {
+    my ($x,$y,$finegrained,$ignorenamesr) = @_;
+    # returns true iff the two tree objects differ other than in debian/
+    # with $finegrained,
+    # returns bitmask 01 - differ in upstream files except .gitignore
+    #                 02 - differ in .gitignore
+    # if $ignorenamesr is defined, $ingorenamesr->{$fn}
+    #  is set for each modified .gitignore filename $fn
+    local $/=undef;
+    my @cmd = (@git, qw(diff-tree --name-only -z));
+    push @cmd, qw(-r) if $finegrained;
+    push @cmd, $x, $y;
+    my $diffs= cmdoutput @cmd;
+    my $r = 0;
+    foreach my $f (split /\0/, $diffs) {
+	next if $f =~ m#^debian(?:/.*)?$#s;
+	my $isignore = $f =~ m#^(?:.*/)?.gitignore$#s;
+	$r |= $isignore ? 02 : 01;
+	$ignorenamesr->{$f}=1 if $ignorenamesr && $isignore;
+    }
+    printdebug "quiltify_trees_differ $x $y => $r\n";
+    return $r;
+}
+
+sub quiltify_tree_sentinelfiles ($) {
+    # lists the `sentinel' files present in the tree
+    my ($x) = @_;
+    my $r = cmdoutput @git, qw(ls-tree --name-only), $x,
+        qw(-- debian/rules debian/control);
+    $r =~ s/\n/,/g;
+    return $r;
+}
+
+sub quiltify_splitbrain_needed () {
+    if (!$split_brain) {
+	progress "dgit view: changes are required...";
+	runcmd @git, qw(checkout -q -b dgit-view);
+	$split_brain = 1;
+    }
+}
+
+sub quiltify_splitbrain ($$$$$$) {
+    my ($clogp, $unapplied, $headref, $diffbits,
+	$editedignores, $cachekey) = @_;
+    if ($quilt_mode !~ m/gbp|dpm/) {
+	# treat .gitignore just like any other upstream file
+	$diffbits = { %$diffbits };
+	$_ = !!$_ foreach values %$diffbits;
+    }
+    # We would like any commits we generate to be reproducible
+    my @authline = clogp_authline($clogp);
+    local $ENV{GIT_COMMITTER_NAME} =  $authline[0];
+    local $ENV{GIT_COMMITTER_EMAIL} = $authline[1];
+    local $ENV{GIT_COMMITTER_DATE} =  $authline[2];
+	
+    if ($quilt_mode =~ m/gbp|unapplied/ &&
+	($diffbits->{H2O} & 01)) {
+	my $msg =
+ "--quilt=$quilt_mode specified, implying patches-unapplied git tree\n".
+ " but git tree differs from orig in upstream files.";
+	if (!stat_exists "debian/patches") {
+	    $msg .=
+ "\n ... debian/patches is missing; perhaps this is a patch queue branch?";
+	}  
+	fail $msg;
+    }
+    if ($quilt_mode =~ m/gbp|unapplied/ &&
+	($diffbits->{O2A} & 01)) { # some patches
+	quiltify_splitbrain_needed();
+	progress "dgit view: creating patches-applied version using gbp pq";
+	runcmd shell_cmd 'exec >/dev/null', @gbp, qw(pq import);
+	# gbp pq import creates a fresh branch; push back to dgit-view
+	runcmd @git, qw(update-ref refs/heads/dgit-view HEAD);
+	runcmd @git, qw(checkout -q dgit-view);
+    }
+    if (($diffbits->{H2O} & 02) && # user has modified .gitignore
+	!($diffbits->{O2A} & 02)) { # patches do not change .gitignore
+	quiltify_splitbrain_needed();
+	progress "dgit view: creating patch to represent .gitignore changes";
+        ensuredir "debian/patches";
+	my $gipatch = "debian/patches/auto-gitignore";
+	open GIPATCH, ">>", "$gipatch" or die "$gipatch: $!";
+	stat GIPATCH or die "$gipatch: $!";
+	fail "$gipatch already exists; but want to create it".
+	    " to record .gitignore changes" if (stat _)[7];
+	print GIPATCH <<END or die "$gipatch: $!";
+Subject: Update .gitignore from Debian packaging branch
+
+The Debian packaging git branch contains these updates to the upstream
+.gitignore file(s).  This patch is autogenerated, to provide these
+updates to users of the official Debian archive view of the package.
+
+[dgit version $our_version]
+---
+END
+        close GIPATCH or die "$gipatch: $!";
+        runcmd shell_cmd "exec >>$gipatch", @git, qw(diff),
+            $unapplied, $headref, "--", sort keys %$editedignores;
+        open SERIES, "+>>", "debian/patches/series" or die $!;
+        defined seek SERIES, -1, 2 or $!==EINVAL or die $!;
+        my $newline;
+        defined read SERIES, $newline, 1 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;
+        commit_admin "Commit patch to update .gitignore";
+    }
+
+    my $dgitview = git_rev_parse 'refs/heads/dgit-view';
+
+    changedir '../../../..';
+    ensuredir ".git/logs/refs/dgit-intern";
+    my $makelogfh = new IO::File ".git/logs/refs/$splitbraincache", '>>'
+      or die $!;
+    runcmd @git, qw(update-ref -m), $cachekey, "refs/$splitbraincache",
+	$dgitview;
+
+    progress "dgit view: created (commit id $dgitview)";
+
+    changedir '.git/dgit/unpack/work';
+}
+
+sub quiltify ($$$$) {
+    my ($clogp,$target,$oldtiptree,$failsuggestion) = @_;
+
+    # Quilt patchification algorithm
+    #
+    # We search backwards through the history of the main tree's HEAD
+    # (T) looking for a start commit S whose tree object is identical
+    # to to the patch tip tree (ie the tree corresponding to the
+    # current dpkg-committed patch series).  For these purposes
+    # `identical' disregards anything in debian/ - this wrinkle is
+    # necessary because dpkg-source treates debian/ specially.
+    #
+    # We can only traverse edges where at most one of the ancestors'
+    # trees differs (in changes outside in debian/).  And we cannot
+    # handle edges which change .pc/ or debian/patches.  To avoid
+    # going down a rathole we avoid traversing edges which introduce
+    # debian/rules or debian/control.  And we set a limit on the
+    # number of edges we are willing to look at.
+    #
+    # If we succeed, we walk forwards again.  For each traversed edge
+    # PC (with P parent, C child) (starting with P=S and ending with
+    # C=T) to we do this:
+    #  - git checkout C
+    #  - dpkg-source --commit with a patch name and message derived from C
+    # After traversing PT, we git commit the changes which
+    # should be contained within debian/patches.
+
+    # The search for the path S..T is breadth-first.  We maintain a
+    # todo list containing search nodes.  A search node identifies a
+    # commit, and looks something like this:
+    #  $p = {
+    #      Commit => $git_commit_id,
+    #      Child => $c,                          # or undef if P=T
+    #      Whynot => $reason_edge_PC_unsuitable, # in @nots only
+    #      Nontrivial => true iff $p..$c has relevant changes
+    #  };
+
+    my @todo;
+    my @nots;
+    my $sref_S;
+    my $max_work=100;
+    my %considered; # saves being exponential on some weird graphs
+
+    my $t_sentinels = quiltify_tree_sentinelfiles $target;
+
+    my $not = sub {
+	my ($search,$whynot) = @_;
+	printdebug " search NOT $search->{Commit} $whynot\n";
+	$search->{Whynot} = $whynot;
+	push @nots, $search;
+	no warnings qw(exiting);
+	next;
+    };
+
+    push @todo, {
+	Commit => $target,
+    };
+
+    while (@todo) {
+	my $c = shift @todo;
+	next if $considered{$c->{Commit}}++;
+
+	$not->($c, "maximum search space exceeded") if --$max_work <= 0;
+
+	printdebug "quiltify investigate $c->{Commit}\n";
+
+	# are we done?
+	if (!quiltify_trees_differ $c->{Commit}, $oldtiptree) {
+	    printdebug " search finished hooray!\n";
+	    $sref_S = $c;
+	    last;
+	}
+
+	if ($quilt_mode eq 'nofix') {
+	    fail "quilt fixup required but quilt mode is \`nofix'\n".
+		"HEAD commit $c->{Commit} differs from tree implied by ".
+		" debian/patches (tree object $oldtiptree)";
+	}
+	if ($quilt_mode eq 'smash') {
+	    printdebug " search quitting smash\n";
+	    last;
+	}
+
+	my $c_sentinels = quiltify_tree_sentinelfiles $c->{Commit};
+	$not->($c, "has $c_sentinels not $t_sentinels")
+	    if $c_sentinels ne $t_sentinels;
+
+	my $commitdata = cmdoutput @git, qw(cat-file commit), $c->{Commit};
+	$commitdata =~ m/\n\n/;
+	$commitdata =~ $`;
+	my @parents = ($commitdata =~ m/^parent (\w+)$/gm);
+	@parents = map { { Commit => $_, Child => $c } } @parents;
+
+	$not->($c, "root commit") if !@parents;
+
+	foreach my $p (@parents) {
+	    $p->{Nontrivial}= quiltify_trees_differ $p->{Commit},$c->{Commit};
+	}
+	my $ndiffers = grep { $_->{Nontrivial} } @parents;
+	$not->($c, "merge ($ndiffers nontrivial parents)") if $ndiffers > 1;
+
+	foreach my $p (@parents) {
+	    printdebug "considering C=$c->{Commit} P=$p->{Commit}\n";
+
+	    my @cmd= (@git, qw(diff-tree -r --name-only),
+		      $p->{Commit},$c->{Commit}, qw(-- debian/patches .pc));
+	    my $patchstackchange = cmdoutput @cmd;
+	    if (length $patchstackchange) {
+		$patchstackchange =~ s/\n/,/g;
+		$not->($p, "changed $patchstackchange");
+	    }
+
+	    printdebug " search queue P=$p->{Commit} ",
+	        ($p->{Nontrivial} ? "NT" : "triv"),"\n";
+	    push @todo, $p;
+	}
     }
 
+    if (!$sref_S) {
+	printdebug "quiltify want to smash\n";
+
+	my $abbrev = sub {
+	    my $x = $_[0]{Commit};
+	    $x =~ s/(.*?[0-9a-z]{8})[0-9a-z]*$/$1/;
+	    return $x;
+	};
+	my $reportnot = sub {
+	    my ($notp) = @_;
+	    my $s = $abbrev->($notp);
+	    my $c = $notp->{Child};
+	    $s .= "..".$abbrev->($c) if $c;
+	    $s .= ": ".$notp->{Whynot};
+	    return $s;
+	};
+	if ($quilt_mode eq 'linear') {
+	    print STDERR "$us: quilt fixup cannot be linear.  Stopped at:\n";
+	    foreach my $notp (@nots) {
+		print STDERR "$us:  ", $reportnot->($notp), "\n";
+	    }
+	    print STDERR "$us: $_\n" foreach @$failsuggestion;
+	    fail "quilt fixup naive history linearisation failed.\n".
+ "Use dpkg-source --commit by hand; or, --quilt=smash for one ugly patch";
+	} elsif ($quilt_mode eq 'smash') {
+	} elsif ($quilt_mode eq 'auto') {
+	    progress "quilt fixup cannot be linear, smashing...";
+	} else {
+	    die "$quilt_mode ?";
+	}
+
+	my $time = $ENV{'GIT_COMMITTER_DATE'} || time;
+	$time =~ s/\s.*//; # trim timezone from GIT_COMMITTER_DATE
+	my $ncommits = 3;
+	my $msg = cmdoutput @git, qw(log), "-n$ncommits";
+
+	quiltify_dpkg_commit "auto-$version-$target-$time",
+	    (getfield $clogp, 'Maintainer'),
+	    "Automatically generated patch ($clogp->{Version})\n".
+	    "Last (up to) $ncommits git changes, FYI:\n\n". $msg;
+	return;
+    }
+
+    progress "quiltify linearisation planning successful, executing...";
+
+    for (my $p = $sref_S;
+	 my $c = $p->{Child};
+	 $p = $p->{Child}) {
+	printdebug "quiltify traverse $p->{Commit}..$c->{Commit}\n";
+	next unless $p->{Nontrivial};
+
+	my $cc = $c->{Commit};
+
+	my $commitdata = cmdoutput @git, qw(cat-file commit), $cc;
+	$commitdata =~ m/\n\n/ or die "$c ?";
+	$commitdata = $`;
+	my $msg = $'; #';
+	$commitdata =~ m/^author (.*) \d+ [-+0-9]+$/m or die "$cc ?";
+	my $author = $1;
+
+	$msg =~ s/^(.*)\n*/$1\n/ or die "$cc $msg ?";
+
+	my $title = $1;
+	my $patchname = $title;
+	$patchname =~ s/[.:]$//;
+	$patchname =~ y/ A-Z/-a-z/;
+	$patchname =~ y/-a-z0-9_.+=~//cd;
+	$patchname =~ s/^\W/x-$&/;
+	$patchname = substr($patchname,0,40);
+	my $index;
+	for ($index='';
+	     stat "debian/patches/$patchname$index";
+	     $index++) { }
+	$!==ENOENT or die "$patchname$index $!";
+
+	runcmd @git, qw(checkout -q), $cc;
+
+	# We use the tip's changelog so that dpkg-source doesn't
+	# produce complaining messages from dpkg-parsechangelog.  None
+	# of the information dpkg-source gets from the changelog is
+	# actually relevant - it gets put into the original message
+	# which dpkg-source provides our stunt editor, and then
+	# overwritten.
+	runcmd @git, qw(checkout -q), $target, qw(debian/changelog);
+
+	quiltify_dpkg_commit "$patchname$index", $author, $msg,
+	    "X-Dgit-Generated: $clogp->{Version} $cc\n";
+
+	runcmd @git, qw(checkout -q), $cc, qw(debian/changelog);
+    }
+
+    runcmd @git, qw(checkout -q master);
+}
+
+sub build_maybe_quilt_fixup () {
+    my ($format,$fopts) = get_source_format;
+    return unless madformat $format;
+    # sigh
+
+    check_for_vendor_patches();
+
+    my $clogp = parsechangelog();
+    my $headref = git_rev_parse('HEAD');
+
+    prep_ud();
+    changedir $ud;
+
+    my $upstreamversion=$version;
+    $upstreamversion =~ s/-[^-]*$//;
+
+    if ($fopts->{'single-debian-patch'}) {
+	quilt_fixup_singlepatch($clogp, $headref, $upstreamversion);
+    } else {
+	quilt_fixup_multipatch($clogp, $headref, $upstreamversion);
+    }
+
+    die 'bug' if $split_brain && !$need_split_build_invocation;
+
+    changedir '../../../..';
+    runcmd_ordryrun_local
+        @git, qw(pull --ff-only -q .git/dgit/unpack/work master);
+}
+
+sub quilt_fixup_mkwork ($) {
+    my ($headref) = @_;
+
+    mkdir "work" or die $!;
+    changedir "work";
+    mktree_in_ud_here();
+    runcmd @git, qw(reset -q --hard), $headref;
+}
+
+sub quilt_fixup_linkorigs ($$) {
+    my ($upstreamversion, $fn) = @_;
+    # calls $fn->($leafname);
+
+    foreach my $f (<../../../../*>) { #/){
+	my $b=$f; $b =~ s{.*/}{};
+	{
+	    local ($debuglevel) = $debuglevel-1;
+	    printdebug "QF linkorigs $b, $f ?\n";
+	}
+	next unless is_orig_file $b, srcfn $upstreamversion,'';
+	printdebug "QF linkorigs $b, $f Y\n";
+	link_ltarget $f, $b or die "$b $!";
+        $fn->($b);
+    }
+}
+
+sub quilt_fixup_delete_pc () {
+    runcmd @git, qw(rm -rqf .pc);
+    commit_admin "Commit removal of .pc (quilt series tracking data)";
+}
+
+sub quilt_fixup_singlepatch ($$$) {
+    my ($clogp, $headref, $upstreamversion) = @_;
+
+    progress "starting quiltify (single-debian-patch)";
+
+    # dpkg-source --commit generates new patches even if
+    # single-debian-patch is in debian/source/options.  In order to
+    # 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);
+
+    rmtree("debian/patches");
+
+    runcmd @dpkgsource, qw(-b .);
+    chdir "..";
+    runcmd @dpkgsource, qw(-x), (srcfn $version, ".dsc");
+    rename srcfn("$upstreamversion", "/debian/patches"), 
+           "work/debian/patches";
+
+    chdir "work";
+    commit_quilty_patch();
+}
+
+sub quilt_make_fake_dsc ($) {
+    my ($upstreamversion) = @_;
+
+    my $fakeversion="$upstreamversion-~~DGITFAKE";
+
+    my $fakedsc=new IO::File 'fake.dsc', '>' or die $!;
+    print $fakedsc <<END or die $!;
+Format: 3.0 (quilt)
+Source: $package
+Version: $fakeversion
+Files:
+END
+
+    my $dscaddfile=sub {
+        my ($b) = @_;
+        
+	my $md = new Digest::MD5;
+
+	my $fh = new IO::File $b, '<' or die "$b $!";
+	stat $fh or die $!;
+	my $size = -s _;
+
+	$md->addfile($fh);
+	print $fakedsc " ".$md->hexdigest." $size $b\n" or die $!;
+    };
+
+    quilt_fixup_linkorigs($upstreamversion, $dscaddfile);
+
+    my @files=qw(debian/source/format debian/rules
+                 debian/control debian/changelog);
+    foreach my $maybe (qw(debian/patches debian/source/options
+                          debian/tests/control)) {
+        next unless stat_exists "../../../$maybe";
+        push @files, $maybe;
+    }
+
+    my $debtar= srcfn $fakeversion,'.debian.tar.gz';
+    runcmd qw(env GZIP=-1n tar -zcf), "./$debtar", qw(-C ../../..), @files;
+
+    $dscaddfile->($debtar);
+    close $fakedsc or die $!;
+}
+
+sub quilt_check_splitbrain_cache ($$) {
+    my ($headref, $upstreamversion) = @_;
+    # Called only if we are in (potentially) split brain mode.
+    # Called in $ud.
+    # Computes the cache key and looks in the cache.
+    # Returns ($dgit_view_commitid, $cachekey) or (undef, $cachekey)
+
+    my $splitbrain_cachekey;
+    
+    progress
+ "dgit: split brain (separate dgit view) may be needed (--quilt=$quilt_mode).";
+    # we look in the reflog of dgit-intern/quilt-cache
+    # we look for an entry whose message is the key for the cache lookup
+    my @cachekey = (qw(dgit), $our_version);
+    push @cachekey, $upstreamversion;
+    push @cachekey, $quilt_mode;
+    push @cachekey, $headref;
+
+    push @cachekey, hashfile('fake.dsc');
+
+    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};
+	$srcshash->add($sfk,"  ");
+	$srcshash->add(hashfile($sfs{$sfk}));
+	$srcshash->add("\n");
+    }
+    push @cachekey, $srcshash->hexdigest();
+    $splitbrain_cachekey = "@cachekey";
+
+    my @cmd = (@git, qw(reflog), '--pretty=format:%H %gs',
+	       $splitbraincache);
+    printdebug "splitbrain cachekey $splitbrain_cachekey\n";
+    debugcmd "|(probably)",@cmd;
+    my $child = open GC, "-|";  defined $child or die $!;
+    if (!$child) {
+	chdir '../../..' or die $!;
+	if (!stat ".git/logs/refs/$splitbraincache") {
+	    $! == ENOENT or die $!;
+	    printdebug ">(no reflog)\n";
+	    exit 0;
+	}
+	exec @cmd; die $!;
+    }
+    while (<GC>) {
+	chomp;
+	printdebug ">| ", $_, "\n" if $debuglevel > 1;
+	next unless m/^(\w+) (\S.*\S)$/ && $2 eq $splitbrain_cachekey;
+	    
+	my $cachehit = $1;
+	quilt_fixup_mkwork($headref);
+	if ($cachehit ne $headref) {
+	    progress "dgit view: found cached (commit id $cachehit)";
+	    runcmd @git, qw(checkout -q -b dgit-view), $cachehit;
+	    $split_brain = 1;
+	    return ($cachehit, $splitbrain_cachekey);
+	}
+	progress "dgit view: found cached, no changes required";
+	return ($headref, $splitbrain_cachekey);
+    }
+    die $! if GC->error;
+    failedcmd unless close GC;
+
+    printdebug "splitbrain cache miss\n";
+    return (undef, $splitbrain_cachekey);
+}
+
+sub quilt_fixup_multipatch ($$$) {
+    my ($clogp, $headref, $upstreamversion) = @_;
+
+    progress "examining quilt state (multiple patches, $quilt_mode mode)";
+
+    # Our objective is:
+    #  - honour any existing .pc in case it has any strangeness
+    #  - determine the git commit corresponding to the tip of
+    #    the patch stack (if there is one)
+    #  - if there is such a git commit, convert each subsequent
+    #    git commit into a quilt patch with dpkg-source --commit
+    #  - otherwise convert all the differences in the tree into
+    #    a single git commit
+    #
+    # To do this we:
+
+    # Our git tree doesn't necessarily contain .pc.  (Some versions of
+    # dgit would include the .pc in the git tree.)  If there isn't
+    # one, we need to generate one by unpacking the patches that we
+    # have.
+    #
+    # We first look for a .pc in the git tree.  If there is one, we
+    # will use it.  (This is not the normal case.)
+    #
+    # Otherwise need to regenerate .pc so that dpkg-source --commit
+    # can work.  We do this as follows:
+    #     1. Collect all relevant .orig from parent directory
+    #     2. Generate a debian.tar.gz out of
+    #         debian/{patches,rules,source/format,source/options}
+    #     3. Generate a fake .dsc containing just these fields:
+    #          Format Source Version Files
+    #     4. Extract the fake .dsc
+    #        Now the fake .dsc has a .pc directory.
+    # (In fact we do this in every case, because in future we will
+    # want to search for a good base commit for generating patches.)
+    #
+    # Then we can actually do the dpkg-source --commit
+    #     1. Make a new working tree with the same object
+    #        store as our main tree and check out the main
+    #        tree's HEAD.
+    #     2. Copy .pc from the fake's extraction, if necessary
+    #     3. Run dpkg-source --commit
+    #     4. If the result has changes to debian/, then
+    #          - git-add them them
+    #          - git-add .pc if we had a .pc in-tree
+    #          - git-commit
+    #     5. If we had a .pc in-tree, delete it, and git-commit
+    #     6. Back in the main tree, fast forward to the new HEAD
+
+    # Another situation we may have to cope with is gbp-style
+    # patches-unapplied trees.
+    #
+    # We would want to detect these, so we know to escape into
+    # quilt_fixup_gbp.  However, this is in general not possible.
+    # Consider a package with a one patch which the dgit user reverts
+    # (with git-revert or the moral equivalent).
+    #
+    # That is indistinguishable in contents from a patches-unapplied
+    # tree.  And looking at the history to distinguish them is not
+    # useful because the user might have made a confusing-looking git
+    # history structure (which ought to produce an error if dgit can't
+    # cope, not a silent reintroduction of an unwanted patch).
+    #
+    # So gbp users will have to pass an option.  But we can usually
+    # detect their failure to do so: if the tree is not a clean
+    # patches-applied tree, quilt linearisation fails, but the tree
+    # _is_ a clean patches-unapplied tree, we can suggest that maybe
+    # they want --quilt=unapplied.
+    #
+    # To help detect this, when we are extracting the fake dsc, we
+    # first extract it with --skip-patches, and then apply the patches
+    # afterwards with dpkg-source --before-build.  That lets us save a
+    # tree object corresponding to .origs.
+
+    my $splitbrain_cachekey;
+
+    quilt_make_fake_dsc($upstreamversion);
+
+    if (quiltmode_splitbrain()) {
+	my $cachehit;
+	($cachehit, $splitbrain_cachekey) =
+	    quilt_check_splitbrain_cache($headref, $upstreamversion);
+	return if $cachehit;
+    }
+
+    runcmd qw(sh -ec),
+        'exec dpkg-source --no-check --skip-patches -x fake.dsc >/dev/null';
+
+    my $fakexdir= $package.'-'.(stripepoch $upstreamversion);
+    rename $fakexdir, "fake" or die "$fakexdir $!";
+
+    changedir 'fake';
+
+    remove_stray_gits();
+    mktree_in_ud_here();
+
+    rmtree '.pc';
+
+    runcmd @git, qw(add -Af .);
+    my $unapplied=git_write_tree();
+    printdebug "fake orig tree object $unapplied\n";
+
+    ensuredir '.pc';
+
+    runcmd qw(sh -ec),
+        'exec dpkg-source --before-build . >/dev/null';
+
+    changedir '..';
+
+    quilt_fixup_mkwork($headref);
+
+    my $mustdeletepc=0;
+    if (stat_exists ".pc") {
+        -d _ or die;
+	progress "Tree already contains .pc - will use it then delete it.";
+        $mustdeletepc=1;
+    } else {
+        rename '../fake/.pc','.pc' or die $!;
+    }
+
+    changedir '../fake';
+    rmtree '.pc';
+    runcmd @git, qw(add -Af .);
+    my $oldtiptree=git_write_tree();
+    printdebug "fake o+d/p tree object $unapplied\n";
+    changedir '../work';
+
+
+    # We calculate some guesswork now about what kind of tree this might
+    # be.  This is mostly for error reporting.
+
+    my %editedignores;
+    my $diffbits = {
+        # H = user's HEAD
+        # O = orig, without patches applied
+        # A = "applied", ie orig with H's debian/patches applied
+        H2O => quiltify_trees_differ($headref,  $unapplied, 1,\%editedignores),
+        H2A => quiltify_trees_differ($headref,  $oldtiptree,1),
+        O2A => quiltify_trees_differ($unapplied,$oldtiptree,1),
+    };
+
+    my @dl;
+    foreach my $b (qw(01 02)) {
+        foreach my $v (qw(H2O O2A H2A)) {
+            push @dl, ($diffbits->{$v} & $b) ? '##' : '==';
+        }
+    }
+    printdebug "differences \@dl @dl.\n";
+
+    progress sprintf
+"$us: quilt differences: src:  %s orig %s     gitignores:  %s orig %s\n".
+"$us: quilt differences:      HEAD %s o+d/p               HEAD %s o+d/p",
+                             $dl[0], $dl[1],              $dl[3], $dl[4],
+                                 $dl[2],                     $dl[5];
+
+    my @failsuggestion;
+    if (!($diffbits->{H2O} & $diffbits->{O2A})) {
+        push @failsuggestion, "This might be a patches-unapplied branch.";
+    }  elsif (!($diffbits->{H2A} & $diffbits->{O2A})) {
+        push @failsuggestion, "This might be a patches-applied branch.";
+    }
+    push @failsuggestion, "Maybe you need to specify one of".
+        " --quilt=gbp --quilt=dpm --quilt=unapplied ?";
+
+    if (quiltmode_splitbrain()) {
+	quiltify_splitbrain($clogp, $unapplied, $headref,
+                            $diffbits, \%editedignores,
+			    $splitbrain_cachekey);
+	return;
+    }
+
+    progress "starting quiltify (multiple patches, $quilt_mode mode)";
+    quiltify($clogp,$headref,$oldtiptree,\@failsuggestion);
+
     if (!open P, '>>', ".pc/applied-patches") {
 	$!==&ENOENT or die $!;
     } else {
@@ -1872,6 +3429,10 @@ END
     }
 
     commit_quilty_patch();
+
+    if ($mustdeletepc) {
+        quilt_fixup_delete_pc();
+    }
 }
 
 sub quilt_fixup_editor () {
@@ -1893,18 +3454,70 @@ sub quilt_fixup_editor () {
     exit 0;
 }
 
+sub maybe_apply_patches_dirtily () {
+    return unless $quilt_mode =~ m/gbp|unapplied/;
+    print STDERR <<END or die $!;
+
+dgit: Building, or cleaning with rules target, in patches-unapplied tree.
+dgit: Have to apply the patches - making the tree dirty.
+dgit: (Consider specifying --clean=git and (or) using dgit sbuild.)
+
+END
+    $patches_applied_dirtily = 01;
+    $patches_applied_dirtily |= 02 unless stat_exists '.pc';
+    runcmd qw(dpkg-source --before-build .);
+}
+
+sub maybe_unapply_patches_again () {
+    progress "dgit: Unapplying patches again to tidy up the tree."
+	if $patches_applied_dirtily;
+    runcmd qw(dpkg-source --after-build .)
+	if $patches_applied_dirtily & 01;
+    rmtree '.pc'
+	if $patches_applied_dirtily & 02;
+}
+
+#----- other building -----
+
+our $clean_using_builder;
+# ^ tree is to be cleaned by dpkg-source's builtin idea that it should
+#   clean the tree before building (perhaps invoked indirectly by
+#   whatever we are using to run the build), rather than separately
+#   and explicitly by us.
+
 sub clean_tree () {
+    return if $clean_using_builder;
     if ($cleanmode eq 'dpkg-source') {
+	maybe_apply_patches_dirtily();
 	runcmd_ordryrun_local @dpkgbuildpackage, qw(-T clean);
+    } elsif ($cleanmode eq 'dpkg-source-d') {
+	maybe_apply_patches_dirtily();
+	runcmd_ordryrun_local @dpkgbuildpackage, qw(-d -T clean);
     } elsif ($cleanmode eq 'git') {
 	runcmd_ordryrun_local @git, qw(clean -xdf);
+    } elsif ($cleanmode eq 'git-ff') {
+	runcmd_ordryrun_local @git, qw(clean -xdff);
+    } elsif ($cleanmode eq 'check') {
+	my $leftovers = cmdoutput @git, qw(clean -xdn);
+	if (length $leftovers) {
+	    print STDERR $leftovers, "\n" or die $!;
+	    fail "tree contains uncommitted files and --clean=check specified";
+	}
     } elsif ($cleanmode eq 'none') {
     } else {
 	die "$cleanmode ?";
     }
 }
 
+sub cmd_clean () {
+    badusage "clean takes no additional arguments" if @ARGV;
+    notpushing();
+    clean_tree();
+    maybe_unapply_patches_again();
+}
+
 sub build_prep () {
+    notpushing();
     badusage "-p is not allowed when building" if defined $package;
     check_not_dirty();
     clean_tree();
@@ -1913,10 +3526,23 @@ sub build_prep () {
     $package = getfield $clogp, 'Source';
     $version = getfield $clogp, 'Version';
     build_maybe_quilt_fixup();
+    if ($rmchanges) {
+	my $pat = changespat $version;
+	foreach my $f (glob "$buildproductsdir/$pat") {
+	    if (act_local()) {
+		unlink $f or fail "remove old changes file $f: $!";
+	    } else {
+		progress "would remove $f";
+	    }
+	}
+    }
 }
 
-sub changesopts () {
+sub changesopts_initial () {
     my @opts =@changesopts[1..$#changesopts];
+}
+
+sub changesopts_version () {
     if (!defined $changes_since_version) {
 	my @vsns = archive_query('archive_query');
 	my @quirk = access_quirk();
@@ -1928,7 +3554,7 @@ sub changesopts () {
 	}
 	if (@vsns) {
 	    @vsns = map { $_->[0] } @vsns;
-	    @vsns = sort { -version_compare_string($a, $b) } @vsns;
+	    @vsns = sort { -version_compare($a, $b) } @vsns;
 	    $changes_since_version = $vsns[0];
 	    progress "changelog will contain changes since $vsns[0]";
 	} else {
@@ -1937,44 +3563,173 @@ sub changesopts () {
 	}
     }
     if ($changes_since_version ne '_') {
-	unshift @opts, "-v$changes_since_version";
+	return ("-v$changes_since_version");
+    } else {
+	return ();
+    }
+}
+
+sub changesopts () {
+    return (changesopts_initial(), changesopts_version());
+}
+
+sub massage_dbp_args ($;$) {
+    my ($cmd,$xargs) = @_;
+    # We need to:
+    #
+    #  - if we're going to split the source build out so we can
+    #    do strange things to it, massage the arguments to dpkg-buildpackage
+    #    so that the main build doessn't build source (or add an argument
+    #    to stop it building source by default).
+    #
+    #  - add -nc to stop dpkg-source cleaning the source tree,
+    #    unless we're not doing a split build and want dpkg-source
+    #    as cleanmode, in which case we can do nothing
+    #
+    # return values:
+    #    0 - source will NOT need to be built separately by caller
+    #   +1 - source will need to be built separately by caller
+    #   +2 - source will need to be built separately by caller AND
+    #        dpkg-buildpackage should not in fact be run at all!
+    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 @opts;
+    # -nc has the side effect of specifying -b if nothing else specified
+    # and some combinations of -S, -b, et al, are errors, rather than
+    # later simply overriding earlie.  So we need to:
+    #  - search the command line for these options
+    #  - pick the last one
+    #  - perhaps add our own as a default
+    #  - perhaps adjust it to the corresponding non-source-building version
+    my $dmode = '-F';
+    foreach my $l ($cmd, $xargs) {
+	next unless $l;
+	@$l = grep { !(m/^-[SgGFABb]$/s and $dmode=$_) } @$l;
+    }
+    push @$cmd, '-nc';
+#print STDERR "MASS1 ",Dumper($cmd, $xargs, $dmode);
+    my $r = 0;
+    if ($need_split_build_invocation) {
+	printdebug "massage split $dmode.\n";
+	$r = $dmode =~ m/[S]/     ? +2 :
+	     $dmode =~ y/gGF/ABb/ ? +1 :
+	     $dmode =~ m/[ABb]/   ?  0 :
+	     die "$dmode ?";
+    }
+    printdebug "massage done $r $dmode.\n";
+    push @$cmd, $dmode;
+#print STDERR "MASS2 ",Dumper($cmd, $xargs, $r);
+    return $r;
 }
 
 sub cmd_build {
-    build_prep();
-    runcmd_ordryrun_local @dpkgbuildpackage, qw(-us -uc), changesopts(), @ARGV;
+    my @dbp = (@dpkgbuildpackage, qw(-us -uc), changesopts_initial(), @ARGV);
+    my $wantsrc = massage_dbp_args \@dbp;
+    if ($wantsrc > 0) {
+	build_source();
+    } else {
+	build_prep();
+    }
+    if ($wantsrc < 2) {
+	push @dbp, changesopts_version();
+	maybe_apply_patches_dirtily();
+	runcmd_ordryrun_local @dbp;
+    }
+    maybe_unapply_patches_again();
     printdone "build successful\n";
 }
 
-sub cmd_git_build {
-    build_prep();
-    my @cmd =
-	(qw(git-buildpackage -us -uc --git-no-sign-tags),
-	 "--git-builder=@dpkgbuildpackage");
-    unless (grep { m/^--git-debian-branch|^--git-ignore-branch/ } @ARGV) {
-	canonicalise_suite();
-	push @cmd, "--git-debian-branch=".lbranch();
+sub cmd_gbp_build {
+    my @dbp = @dpkgbuildpackage;
+
+    my $wantsrc = massage_dbp_args \@dbp, \@ARGV;
+
+    my @cmd;
+    if (length executable_on_path('git-buildpackage')) {
+	@cmd = qw(git-buildpackage);
+    } else {
+	@cmd = qw(gbp buildpackage);
     }
-    push @cmd, changesopts();
-    runcmd_ordryrun_local @cmd, @ARGV;
+    push @cmd, (qw(-us -uc --git-no-sign-tags), "--git-builder=@dbp");
+
+    if ($wantsrc > 0) {
+	build_source();
+    } else {
+	if (!$clean_using_builder) {
+	    push @cmd, '--git-cleaner=true';
+	}
+	build_prep();
+    }
+    if ($wantsrc < 2) {
+	unless (grep { m/^--git-debian-branch|^--git-ignore-branch/ } @ARGV) {
+	    canonicalise_suite();
+	    push @cmd, "--git-debian-branch=".lbranch();
+	}
+	push @cmd, changesopts();
+	maybe_apply_patches_dirtily();
+	runcmd_ordryrun_local @cmd, @ARGV;
+    }
+    maybe_unapply_patches_again();
     printdone "build successful\n";
 }
+sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0
 
 sub build_source {
+    my $our_cleanmode = $cleanmode;
+    if ($need_split_build_invocation) {
+	# Pretend that clean is being done some other way.  This
+	# forces us not to try to use dpkg-buildpackage to clean and
+	# build source all in one go; and instead we run dpkg-source
+	# (and build_prep() will do the clean since $clean_using_builder
+	# is false).
+	$our_cleanmode = 'ELSEWHERE';
+    }
+    if ($our_cleanmode =~ m/^dpkg-source/) {
+	# dpkg-source invocation (below) will clean, so build_prep shouldn't
+	$clean_using_builder = 1;
+    }
     build_prep();
-    $sourcechanges = "${package}_".(stripepoch $version)."_source.changes";
+    $sourcechanges = changespat $version,'source';
+    if (act_local()) {
+	unlink "../$sourcechanges" or $!==ENOENT
+	    or fail "remove $sourcechanges: $!";
+    }
     $dscfn = dscfn($version);
-    if ($cleanmode eq 'dpkg-source') {
-	runcmd_ordryrun_local (@dpkgbuildpackage, qw(-us -uc -S)),
+    if ($our_cleanmode eq 'dpkg-source') {
+	maybe_apply_patches_dirtily();
+	runcmd_ordryrun_local @dpkgbuildpackage, qw(-us -uc -S),
+	    changesopts();
+    } elsif ($our_cleanmode eq 'dpkg-source-d') {
+	maybe_apply_patches_dirtily();
+	runcmd_ordryrun_local @dpkgbuildpackage, qw(-us -uc -S -d),
 	    changesopts();
     } else {
-	my $pwd = must_getcwd();
-	my $leafdir = basename $pwd;
-	changedir "..";
-	runcmd_ordryrun_local @dpkgsource, qw(-b --), $leafdir;
-	changedir $pwd;
+	my @cmd = (@dpkgsource, qw(-b --));
+	if ($split_brain) {
+	    changedir $ud;
+	    runcmd_ordryrun_local @cmd, "work";
+	    my @udfiles = <${package}_*>;
+	    changedir "../../..";
+	    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 "$ud/$f", "../$f" or $!==ENOENT
+		    or fail "put in place new source file ($f): $!";
+	    }
+	} else {
+	    my $pwd = must_getcwd();
+	    my $leafdir = basename $pwd;
+	    changedir "..";
+	    runcmd_ordryrun_local @cmd, $leafdir;
+	    changedir $pwd;
+	}
 	runcmd_ordryrun_local qw(sh -ec),
 	    'exec >$1; shift; exec "$@"','x',
 	    "../$sourcechanges",
@@ -1985,34 +3740,50 @@ sub build_source {
 sub cmd_build_source {
     badusage "build-source takes no additional arguments" if @ARGV;
     build_source();
+    maybe_unapply_patches_again();
     printdone "source built, results in $dscfn and $sourcechanges";
 }
 
 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 "changes files other than source matching $pat".
+	    " already present (@unwanted);".
+	    " building would result in ambiguity about the intended results"
+	    if @unwanted;
+    }
     changedir "..";
-    my $pat = "${package}_".(stripepoch $version)."_*.changes";
     if (act_local()) {
-	stat $dscfn or fail "$dscfn (in parent directory): $!";
-	stat $sourcechanges or fail "$sourcechanges (in parent directory): $!";
-	foreach my $cf (glob $pat) {
-	    next if $cf eq $sourcechanges;
-	    unlink $cf or fail "remove $cf: $!";
-	}
+	stat_exists $dscfn or fail "$dscfn (in parent directory): $!";
+	stat_exists $sourcechanges
+	    or fail "$sourcechanges (in parent directory): $!";
     }
-    runcmd_ordryrun_local @sbuild, @ARGV, qw(-d), $isuite, $dscfn;
+    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 "wrong number of different changes files (@changesfiles)"
-	unless @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 = "${package}_".(stripepoch $version)."_multi.changes";
+    my $multichanges = changespat $version,'multi';
     if (act_local()) {
-	stat $multichanges or fail "$multichanges: $!";
+	stat_exists $multichanges or fail "$multichanges: $!";
+	foreach my $cf (glob $pat) {
+	    next if $cf eq $multichanges;
+	    rename "$cf", "$cf.inmulti" or fail "$cf\{,.inmulti}: $!";
+	}
     }
+    maybe_unapply_patches_again();
     printdone "build successful, results in $multichanges\n" or die $!;
 }    
 
@@ -2020,9 +3791,44 @@ sub cmd_quilt_fixup {
     badusage "incorrect arguments to dgit quilt-fixup" if @ARGV;
     my $clogp = parsechangelog();
     $version = getfield $clogp, 'Version';
+    $package = getfield $clogp, 'Source';
+    check_not_dirty();
+    clean_tree();
     build_maybe_quilt_fixup();
 }
 
+sub cmd_archive_api_query {
+    badusage "need only 1 subpath argument" unless @ARGV==1;
+    my ($subpath) = @ARGV;
+    my @cmd = archive_api_query_cmd($subpath);
+    debugcmd ">",@cmd;
+    exec @cmd or fail "exec curl: $!\n";
+}
+
+sub cmd_clone_dgit_repos_server {
+    badusage "need destination argument" unless @ARGV==1;
+    my ($destdir) = @ARGV;
+    $package = '_dgit-repos-server';
+    my @cmd = (@git, qw(clone), access_giturl(), $destdir);
+    debugcmd ">",@cmd;
+    exec @cmd or fail "exec git clone: $!\n";
+}
+
+sub cmd_setup_mergechangelogs {
+    badusage "no arguments allowed to dgit setup-mergechangelogs" if @ARGV;
+    setup_mergechangelogs(1);
+}
+
+sub cmd_setup_useremail {
+    badusage "no arguments allowed to dgit setup-mergechangelogs" if @ARGV;
+    setup_useremail(1);
+}
+
+sub cmd_setup_new_tree {
+    badusage "no arguments allowed to dgit setup-tree" if @ARGV;
+    setup_new_tree();
+}
+
 #---------- argument parsing and main program ----------
 
 sub cmd_version {
@@ -2030,6 +3836,44 @@ sub cmd_version {
     exit 0;
 }
 
+our (%valopts_long, %valopts_short);
+our @rvalopts;
+
+sub defvalopt ($$$$) {
+    my ($long,$short,$val_re,$how) = @_;
+    my $oi = { Long => $long, Short => $short, Re => $val_re, How => $how };
+    $valopts_long{$long} = $oi;
+    $valopts_short{$short} = $oi;
+    # $how subref should:
+    #   do whatever assignemnt or thing it likes with $_[0]
+    #   if the option should not be passed on to remote, @rvalopts=()
+    # or $how can be a scalar ref, meaning simply assign the value
+}
+
+defvalopt '--since-version', '-v', '[^_]+|_', \$changes_since_version;
+defvalopt '--distro',        '-d', '.+',      \$idistro;
+defvalopt '',                '-k', '.+',      \$keyid;
+defvalopt '--existing-package','', '.*',      \$existing_package;
+defvalopt '--build-products-dir','','.*',     \$buildproductsdir;
+defvalopt '--clean',       '', $cleanmode_re, \$cleanmode;
+defvalopt '--quilt',     '', $quilt_modes_re, \$quilt_mode;
+
+defvalopt '', '-c', '.*=.*', sub { push @git, '-c', @_; };
+
+defvalopt '', '-C', '.+', sub {
+    ($changesfile) = (@_);
+    if ($changesfile =~ s#^(.*)/##) {
+	$buildproductsdir = $1;
+    }
+};
+
+defvalopt '--initiator-tempdir','','.*', sub {
+    ($initiator_tempdir) = (@_);
+    $initiator_tempdir =~ m#^/# or
+	badusage "--initiator-tempdir must be used specify an".
+	" absolute, not relative, directory."
+};
+
 sub parseopts () {
     my $om;
 
@@ -2039,6 +3883,27 @@ sub parseopts () {
 	@ssh = ($ENV{'GIT_SSH'});
     }
 
+    my $oi;
+    my $val;
+    my $valopt = sub {
+	my ($what) = @_;
+	@rvalopts = ($_);
+	if (!defined $val) {
+	    badusage "$what needs a value" unless @ARGV;
+	    $val = shift @ARGV;
+	    push @rvalopts, $val;
+	}
+	badusage "bad value \`$val' for $what" unless
+	    $val =~ m/^$oi->{Re}$(?!\n)/s;
+	my $how = $oi->{How};
+	if (ref($how) eq 'SCALAR') {
+	    $$how = $val;
+	} else {
+	    $how->($val);
+	}
+	push @ropts, @rvalopts;
+    };
+
     while (@ARGV) {
 	last unless $ARGV[0] =~ m/^-/;
 	$_ = shift @ARGV;
@@ -2060,10 +3925,7 @@ sub parseopts () {
 	    } elsif (m/^--new$/) {
 		push @ropts, $_;
 		$new_package=1;
-	    } elsif (m/^--since-version=([^_]+|_)$/) {
-		push @ropts, $_;
-		$changes_since_version = $1;
-	    } elsif (m/^--([-0-9a-z]+)=(.*)/s &&
+	    } elsif (m/^--([-0-9a-z]+)=(.+)/s &&
 		     ($om = $opts_opt_map{$1}) &&
 		     length $om->[0]) {
 		push @ropts, $_;
@@ -2073,34 +3935,33 @@ sub parseopts () {
 		     ($om = $opts_opt_map{$1})) {
 		push @ropts, $_;
 		push @$om, $2;
-	    } elsif (m/^--existing-package=(.*)/s) {
-		push @ropts, $_;
-		$existing_package = $1;
-	    } elsif (m/^--initiator-tempdir=(.*)/s) {
-		$initiator_tempdir = $1;
-		$initiator_tempdir =~ m#^/# or
-		    badusage "--initiator-tempdir must be used specify an".
-		        " absolute, not relative, directory."
-	    } elsif (m/^--distro=(.*)/s) {
-		push @ropts, $_;
-		$idistro = $1;
-	    } elsif (m/^--build-products-dir=(.*)/s) {
-		push @ropts, $_;
-		$buildproductsdir = $1;
-	    } elsif (m/^--clean=(dpkg-source|git|none)$/s) {
-		push @ropts, $_;
-		$cleanmode = $1;
-	    } elsif (m/^--clean=(.*)$/s) {
-		badusage "unknown cleaning mode \`$1'";
 	    } elsif (m/^--ignore-dirty$/s) {
 		push @ropts, $_;
 		$ignoredirty = 1;
 	    } elsif (m/^--no-quilt-fixup$/s) {
 		push @ropts, $_;
-		$noquilt = 1;
+		$quilt_mode = 'nocheck';
 	    } elsif (m/^--no-rm-on-error$/s) {
 		push @ropts, $_;
 		$rmonerror = 0;
+	    } elsif (m/^--(no-)?rm-old-changes$/s) {
+		push @ropts, $_;
+		$rmchanges = !$1;
+	    } elsif (m/^--deliberately-($deliberately_re)$/s) {
+		push @ropts, $_;
+		push @deliberatelies, $&;
+	    } elsif (m/^--dgit-tag-format=(old|new)$/s) {
+		# undocumented, for testing
+		push @ropts, $_;
+		$tagformat_want = [ $1, 'command line', 1 ];
+		# 1 menas overrides distro configuration
+	    } elsif (m/^--always-split-source-build$/s) {
+		# undocumented, for testing
+		push @ropts, $_;
+		$need_split_build_invocation = 1;
+	    } elsif (m/^(--[-0-9a-z]+)(=|$)/ && ($oi = $valopts_long{$1})) {
+		$val = $2 ? $' : undef; #';
+		$valopt->($oi->{Long});
 	    } else {
 		badusage "unknown long option \`$_'";
 	    }
@@ -2116,42 +3977,38 @@ sub parseopts () {
 		    cmd_help();
 		} elsif (s/^-D/-/) {
 		    push @ropts, $&;
-		    open DEBUG, ">&STDERR" or die $!;
-		    autoflush DEBUG 1;
-		    $debug++;
+		    $debuglevel++;
+		    enabledebug();
 		} elsif (s/^-N/-/) {
 		    push @ropts, $&;
 		    $new_package=1;
-		} elsif (s/^-v([^_]+|_)$//s) {
-		    push @ropts, $&;
-		    $changes_since_version = $1;
 		} elsif (m/^-m/) {
 		    push @ropts, $&;
 		    push @changesopts, $_;
 		    $_ = '';
-		} elsif (s/^-c(.*=.*)//s) {
-		    push @ropts, $&;
-		    push @git, '-c', $1;
-		} elsif (s/^-d(.*)//s) {
-		    push @ropts, $&;
-		    $idistro = $1;
-		} elsif (s/^-C(.*)//s) {
-		    push @ropts, $&;
-		    $changesfile = $1;
-		    if ($changesfile =~ s#^(.*)/##) {
-			$buildproductsdir = $1;
-		    }
-		} elsif (s/^-k(.*)//s) {
-		    $keyid=$1;
-		} elsif (s/^-wn//s) {
+		} elsif (s/^-wn$//s) {
 		    push @ropts, $&;
 		    $cleanmode = 'none';
-		} elsif (s/^-wg//s) {
+		} elsif (s/^-wg$//s) {
 		    push @ropts, $&;
 		    $cleanmode = 'git';
-		} elsif (s/^-wd//s) {
+		} elsif (s/^-wgf$//s) {
+		    push @ropts, $&;
+		    $cleanmode = 'git-ff';
+		} elsif (s/^-wd$//s) {
 		    push @ropts, $&;
 		    $cleanmode = 'dpkg-source';
+		} elsif (s/^-wdd$//s) {
+		    push @ropts, $&;
+		    $cleanmode = 'dpkg-source-d';
+		} elsif (s/^-wc$//s) {
+		    push @ropts, $&;
+		    $cleanmode = 'check';
+		} elsif (m/^-[a-zA-Z]/ && ($oi = $valopts_short{$&})) {
+		    $val = $'; #';
+		    $val = undef unless length $val;
+		    $valopt->($oi->{Short});
+		    $_ = '';
 		} else {
 		    badusage "unknown short option \`$_'";
 		}
@@ -2160,13 +4017,41 @@ sub parseopts () {
     }
 }
 
+sub finalise_opts_opts () {
+    foreach my $k (keys %opts_opt_map) {
+	my $om = $opts_opt_map{$k};
+
+	my $v = access_cfg("cmd-$k", 'RETURN-UNDEF');
+	if (defined $v) {
+	    badcfg "cannot set command for $k"
+		unless length $om->[0];
+	    $om->[0] = $v;
+	}
+
+	foreach my $c (access_cfg_cfgs("opts-$k")) {
+	    my $vl = $gitcfg{$c};
+	    printdebug "CL $c ",
+	        ($vl ? join " ", map { shellquote } @$vl : ""),
+	        "\n" if $debuglevel >= 4;
+	    next unless $vl;
+	    badcfg "cannot configure options for $k"
+		if $opts_opt_cmdonly{$k};
+	    my $insertpos = $opts_cfg_insertpos{$k};
+	    @$om = ( @$om[0..$insertpos-1],
+		     @$vl,
+		     @$om[$insertpos..$#$om] );
+	}
+    }
+}
+
 if ($ENV{$fakeeditorenv}) {
+    git_slurp_config();
     quilt_fixup_editor();
 }
 
-delete $ENV{'DGET_UNPACK'};
-
 parseopts();
+git_slurp_config();
+
 print STDERR "DRY RUN ONLY\n" if $dryrun_level > 1;
 print STDERR "DAMP RUN - WILL MAKE LOCAL (UNSIGNED) CHANGES\n"
     if $dryrun_level == 1;
@@ -2176,4 +4061,33 @@ if (!@ARGV) {
 }
 my $cmd = shift @ARGV;
 $cmd =~ y/-/_/;
-{ no strict qw(refs); &{"cmd_$cmd"}(); }
+
+if (!defined $rmchanges) {
+    local $access_forpush;
+    $rmchanges = access_cfg_bool(0, 'rm-old-changes');
+}
+
+if (!defined $quilt_mode) {
+    local $access_forpush;
+    $quilt_mode = cfg('dgit.force.quilt-mode', 'RETURN-UNDEF')
+	// access_cfg('quilt-mode', 'RETURN-UNDEF')
+	// 'linear';
+    $quilt_mode =~ m/^($quilt_modes_re)$/ 
+	or badcfg "unknown quilt-mode \`$quilt_mode'";
+    $quilt_mode = $1;
+}
+
+$need_split_build_invocation ||= quiltmode_splitbrain();
+
+if (!defined $cleanmode) {
+    local $access_forpush;
+    $cleanmode = access_cfg('clean-mode', 'RETURN-UNDEF');
+    $cleanmode //= 'dpkg-source';
+
+    badcfg "unknown clean-mode \`$cleanmode'" unless
+	$cleanmode =~ m/^($cleanmode_re)$(?!\n)/s;
+}
+
+my $fn = ${*::}{"cmd_$cmd"};
+$fn or badusage "unknown operation $cmd";
+$fn->();