X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=7e642c037b8dedef77c9f62c9750efccf73fe5e4;hp=41a7fe2f466c430cbbcb74b759aff74fa57f13c8;hb=eab588a83905122af678182876c2f800e4b6fa77;hpb=979ce26f5de342743c7b6fa207cd22c66f55af1d

diff --git a/dgit b/dgit
index 41a7fe2f..7e642c03 100755
--- a/dgit
+++ b/dgit
@@ -33,6 +33,8 @@ use Digest::SHA;
 use Digest::MD5;
 use Config;
 
+use Debian::Dgit;
+
 our $our_version = 'UNRELEASED'; ###substituted###
 
 our $rpushprotovsn = 2;
@@ -48,11 +50,13 @@ our $changesfile;
 our $buildproductsdir = '..';
 our $new_package = 0;
 our $ignoredirty = 0;
-our $noquilt = 0;
 our $rmonerror = 1;
+our @deliberatelies;
 our $existing_package = 'dpkg';
 our $cleanmode = 'dpkg-source';
 our $changes_since_version;
+our $quilt_mode;
+our $quilt_modes_re = 'linear|smash|auto|nofix|nocheck';
 our $we_are_responder;
 our $initiator_tempdir;
 
@@ -102,17 +106,13 @@ our $remotename = 'dgit';
 our @ourdscfield = qw(Dgit Vcs-Dgit-Master);
 our $branchprefix = 'dgit';
 our $csuite;
+our $instead_distro;
 
 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 stripepoch ($) {
     my ($vsn) = @_;
@@ -162,7 +162,10 @@ sub waitstatusmsg () {
 sub printdebug { print DEBUG $debugprefix, @_ or die $!; }
 
 sub fail { 
-    die $us.($we_are_responder ? " (build host)" : "").": @_\n";
+    my $s = "@_\n";
+    my $prefix = $us.($we_are_responder ? " (build host)" : "").": ";
+    $s =~ s/^/$prefix/gm;
+    die $s;
 }
 
 sub badcfg { print STDERR "$us: invalid configuration: @_\n"; exit 12; }
@@ -190,6 +193,10 @@ sub stat_exists ($) {
     die "stat $f: $!";
 }
 
+sub deliberately ($) {
+    return !!grep { $_[0] eq $_ } @deliberatelies;
+}
+
 #---------- remote protocol support, common ----------
 
 # remote push initiator/responder protocol:
@@ -516,13 +523,24 @@ 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.default.archive-query' => 'madison:',
+	       'dgit.default.sshpsql-dbname' => 'service=projectb',
+	       'dgit-distro.debian.archive-query' => 'sshpsql:',
+	       'dgit-distro.debian.git-host' => 'dgit-git.debian.net',
+	       'dgit-distro.debian.git-user-force' => 'dgit',
 	       'dgit-distro.debian.git-proto' => 'git+ssh://',
-	       'dgit-distro.debian.git-path' => '/git/dgit-repos/repos',
+	       'dgit-distro.debian.git-path' => '/dgit/debian/repos',
+ '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',
+	       'dgit-distro.debian.diverts.alioth' => '/alioth',
+	       'dgit-distro.debian/alioth.git-host' => 'git.debian.org',
+	       'dgit-distro.debian/alioth.git-user-force' => '',
+	       'dgit-distro.debian/alioth.git-proto' => 'git+ssh://',
+	       'dgit-distro.debian/alioth.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-distro.debian.upload-host' => 'ftp-master', # for dput
 	       'dgit-distro.debian.mirror' => 'http://ftp.debian.org/debian/',
  'dgit-distro.debian.backports-quirk' => '(squeeze)-backports*',
@@ -564,9 +582,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");
@@ -574,7 +590,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');
@@ -588,22 +604,53 @@ sub access_quirk () {
 	    return ('backports',"$basedistro-backports",$1);
 	}
     }
-    return ('none',$basedistro);
+    return ('none',undef);
 }
 
-sub access_distro () {
-    return (access_quirk())[1];
+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;
+    return grep { defined } @l;
 }
 
 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;
+    # 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;
+    my $value = cfg(@cfgs);
     return $value;
 }
 
@@ -625,9 +672,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;
 }
@@ -636,11 +690,14 @@ 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 $proto = access_cfg('git-proto', 'RETURN-UNDEF');
+	return undef unless defined $proto;
 	$url =
-	    access_cfg('git-proto').
+	    $proto.
 	    access_gituserhost().
 	    access_cfg('git-path');
     }
@@ -723,21 +780,32 @@ sub must_getcwd () {
     return $d;
 }
 
+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;
+	    }
+	    push @cmd, "--ca-certificate=$key", "--ca-directory=/dev/enoent";
+	    last;
+	}
+    }
+    push @cmd, $url.$subpath;
+    return @cmd;
+}
+
 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 = $'; #';
@@ -750,17 +818,21 @@ sub pool_dsc_subpath ($$) {
     return "/pool/$component/$prefix/$package/".dscfn($vsn);
 }
 
-sub archive_query_madison ($$) {
+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* \|
@@ -782,9 +854,9 @@ sub madison_parse ($) {
     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;".
@@ -792,13 +864,19 @@ sub canonicalise_suite_madison ($$) {
     return $r[0][2];
 }
 
-sub sshpsql ($$) {
-    my ($data,$sql) = @_;
+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);
+	       access_runeinfo("ssh-psql $runeinfo").
+	       " export LANG=C;".
+	       " ".shellquote qw(psql -A), $dbname, qw(-c), $sql);
     printcmd(\*DEBUG,$debugprefix."|",@cmd) if $debug>0;
     open P, "-|", @cmd or die $!;
     while (<P>) {
@@ -818,13 +896,13 @@ 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);
+    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
@@ -849,7 +927,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
@@ -938,15 +1016,25 @@ sub get_archive_dsc () {
     $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;
+	if ($r =~ m/^divert (\w+)$/) {
+	    my $divert=$1;
+	    my ($usedistro,) = access_distros();
+	    $instead_distro= cfg("dgit-distro.$usedistro.diverts.$divert");
+	    $instead_distro =~ s{^/}{ access_basedistro()."/" }e;
+	    printdebug "diverting $divert so using distro $instead_distro\n";
+	    return check_for_git();
+	}
 	failedcmd @cmd unless $r =~ m/^[01]$/;
 	return $r+0;
     } elsif ($how eq 'true') {
@@ -963,6 +1051,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') {
@@ -988,6 +1077,12 @@ sub mktree_in_ud_here () {
     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 mktree_in_ud_from_only_subdir () {
     # changes into the subdir
     my (@dirs) = <*/.>;
@@ -1002,8 +1097,7 @@ sub mktree_in_ud_from_only_subdir () {
 	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);
 }
 
@@ -1324,15 +1418,19 @@ sub clone ($) {
     my ($dstdir) = @_;
     canonicalise_suite();
     badusage "dry run makes no sense with clone" unless act_local();
+    my $hasgit = check_for_git();
     mkdir $dstdir or die "$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) {
+	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', $giturl;
+    }
+    if ($hasgit) {
 	progress "fetching existing git history";
 	git_fetch_us();
 	runcmd_ordryrun_local @git, qw(fetch origin);
@@ -1341,6 +1439,7 @@ sub clone ($) {
     }
     fetch_from_archive() or no_such_package;
     my $vcsgiturl = $dsc->{'Vcs-Git'};
+    $vcsgiturl =~ s/\s+-b\s+\S+//g;
     if (length $vcsgiturl) {
 	runcmd @git, qw(remote add vcs-git), $vcsgiturl;
     }
@@ -1414,7 +1513,7 @@ sub get_source_format () {
 sub madformat ($) {
     my ($format) = @_;
     return 0 unless $format eq '3.0 (quilt)';
-    if ($noquilt) {
+    if ($quilt_mode eq 'nocheck') {
 	progress "Not doing any fixup of \`$format' due to --no-quilt-fixup";
 	return 0;
     }
@@ -1470,6 +1569,7 @@ 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;
+    my $delibs = join(" ", "",@deliberatelies);
     open TO, '>', $tfn->('.tmp') or die $!;
     print TO <<END or die $!;
 object $head
@@ -1478,6 +1578,7 @@ tag $tag
 tagger $authline
 
 $package release $cversion for $clogsuite ($csuite) [dgit]
+[dgit distro=$distro$delibs]
 END
     close TO or die $!;
 
@@ -1966,8 +2067,276 @@ our $version;
 our $sourcechanges;
 our $dscfn;
 
+#----- `3.0 (quilt)' handling -----
+
 our $fakeeditorenv = 'DGIT_FAKE_EDITOR_QUILT';
 
+sub quiltify_dpkg_commit ($$$;$) {
+    my ($patchname,$author,$msg, $xinfo) = @_;
+    $xinfo //= '';
+
+    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: $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;
+    }
+}
+
+sub quiltify_trees_differ ($$) {
+    my ($x,$y) = @_;
+    # returns 1 iff the two tree objects differ other than in debian/
+    local $/=undef;
+    my @cmd = (@git, qw(diff-tree --name-only -z), $x, $y);
+    my $diffs= cmdoutput @cmd;
+    foreach my $f (split /\0/, $diffs) {
+	next if $f eq 'debian';
+	return 1;
+    }
+    return 0;
+}
+
+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 ($$) {
+    my ($clogp,$target) = @_;
+
+    # 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.
+
+    changedir '../fake';
+    mktree_in_ud_here();
+    rmtree '.pc';
+    runcmd @git, 'add', '.';
+    my $oldtiptree=git_write_tree();
+    changedir '../work';
+
+    # 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 $;
+	};
+	my $reportnot = sub {
+	    my ($notp) = @_;
+	    my $s = $abbrev->($notp);
+	    my $c = $notp->{Child};
+	    $s .= "..".$abbrev->($c) if $c;
+	    $s .= ": ".$c->{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";
+	    }
+	    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 = time;
+	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=get_source_format;
     return unless madformat $format;
@@ -2086,33 +2455,7 @@ END
         rename '../fake/.pc','.pc' or die $!;
     }
 
-    my $author = getfield $clogp, 'Maintainer';
-    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/\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
-Author: $author
-
----
-
-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;
-    }
+    quiltify($clogp,$headref);
 
     if (!open P, '>>', ".pc/applied-patches") {
 	$!==&ENOENT or die $!;
@@ -2150,6 +2493,8 @@ sub quilt_fixup_editor () {
     exit 0;
 }
 
+#----- other building -----
+
 sub clean_tree () {
     if ($cleanmode eq 'dpkg-source') {
 	runcmd_ordryrun_local @dpkgbuildpackage, qw(-T clean);
@@ -2287,6 +2632,13 @@ sub cmd_quilt_fixup {
     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);
+    exec @cmd or fail "exec curl: $!\n";
+}
+
 #---------- argument parsing and main program ----------
 
 sub cmd_version {
@@ -2356,15 +2708,23 @@ sub parseopts () {
 		$cleanmode = $1;
 	    } elsif (m/^--clean=(.*)$/s) {
 		badusage "unknown cleaning mode \`$1'";
+	    } elsif (m/^--quilt=($quilt_modes_re)$/s) {
+		push @ropts, $_;
+		$quilt_mode = $1;
+	    } elsif (m/^--quilt=(.*)$/s) {
+		badusage "unknown quilt fixup 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/^--deliberately-($suite_re)$/s) {
+		push @ropts, $_;
+		push @deliberatelies, $&;
 	    } else {
 		badusage "unknown long option \`$_'";
 	    }
@@ -2396,24 +2756,27 @@ sub parseopts () {
 		} elsif (s/^-c(.*=.*)//s) {
 		    push @ropts, $&;
 		    push @git, '-c', $1;
-		} elsif (s/^-d(.*)//s) {
+		} elsif (s/^-d(.+)//s) {
 		    push @ropts, $&;
 		    $idistro = $1;
-		} elsif (s/^-C(.*)//s) {
+		} elsif (s/^-C(.+)//s) {
 		    push @ropts, $&;
 		    $changesfile = $1;
 		    if ($changesfile =~ s#^(.*)/##) {
 			$buildproductsdir = $1;
 		    }
-		} elsif (s/^-k(.*)//s) {
+		} elsif (s/^-k(.+)//s) {
 		    $keyid=$1;
-		} elsif (s/^-wn//s) {
+		} elsif (m/^-[vdCk]$/) {
+		    badusage
+ "option \`$_' requires an argument (and no space before the argument)";
+		} 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/^-wd$//s) {
 		    push @ropts, $&;
 		    $cleanmode = 'dpkg-source';
 		} else {
@@ -2439,6 +2802,15 @@ if (!@ARGV) {
 my $cmd = shift @ARGV;
 $cmd =~ y/-/_/;
 
+if (!defined $quilt_mode) {
+    $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;
+}
+
 my $fn = ${*::}{"cmd_$cmd"};
 $fn or badusage "unknown operation $cmd";
 $fn->();