X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=3c311400afeaec6ef64dccc64cbc5a4129e59c66;hp=f9e6d1bc7d9443c3c866e45d3cdf81f000a6e9d9;hb=1c920a62c188ff676127973a548855fa7b02841c;hpb=282db732c877da890e55e5664e43636f8a9647ad

diff --git a/dgit b/dgit
index f9e6d1bc..3c311400 100755
--- a/dgit
+++ b/dgit
@@ -29,9 +29,14 @@ use File::Basename;
 use Dpkg::Version;
 use POSIX;
 use IPC::Open2;
+use Digest::SHA;
+use Digest::MD5;
+use Config;
 
 our $our_version = 'UNRELEASED'; ###substituted###
 
+our $rpushprotovsn = 2;
+
 our $isuite = 'unstable';
 our $idistro;
 our $package;
@@ -57,6 +62,7 @@ our $suite_re = '[-+.0-9a-z]+';
 
 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);
@@ -69,7 +75,8 @@ our (@dpkggenchanges) = qw(dpkg-genchanges);
 our (@mergechanges) = qw(mergechanges -f);
 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,
@@ -113,9 +120,14 @@ 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");
 }
 
 our $us = 'dgit';
@@ -130,6 +142,23 @@ END {
     }
 };
 
+our @signames = split / /, $Config{sig_name};
+
+sub waitstatusmsg () {
+    if (!$?) {
+	return "terminated, reporting successful completion";
+    } elsif (!($? & 255)) {
+	return "failed with error exit status ".WEXITSTATUS($?);
+    } elsif (WIFSIGNALED($?)) {
+	my $signum=WTERMSIG($?);
+	return "died due to fatal signal ".
+	    ($signames[$signum] // "number $signum").
+	    ($? & 128 ? " (core dumped)" : ""); # POSIX(3pm) has no WCOREDUMP
+    } else {
+	return "failed with unknown wait status ".$?;
+    }
+}
+
 sub printdebug { print DEBUG $debugprefix, @_ or die $!; }
 
 sub fail { 
@@ -154,6 +183,13 @@ sub changedir ($) {
     chdir $newdir or die "chdir: $newdir: $!";
 }
 
+sub stat_exists ($) {
+    my ($f) = @_;
+    return 1 if stat $f;
+    return 0 if $!==&ENOENT;
+    die "stat $f: $!";
+}
+
 #---------- remote protocol support, common ----------
 
 # remote push initiator/responder protocol:
@@ -191,17 +227,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;
@@ -233,7 +291,7 @@ sub protocol_read_bytes ($$) {
     $nbytes =~ m/^[1-9]\d{0,5}$/ 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,10 +373,10 @@ 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();
+    return $r->decoded_content(charset => 'none');
 }
 
-our ($dscdata,$dscurl,$dsc,$skew_warning_vsn);
+our ($dscdata,$dscurl,$dsc,$dsc_checked,$skew_warning_vsn);
 
 sub shellquote {
     my @out;
@@ -347,10 +405,8 @@ 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 $?)";
+	fail "subprocess ".waitstatusmsg();
     } else {
 	fail "subprocess produced invalid output";
     }
@@ -460,17 +516,21 @@ our %defcfg = ('dgit.default.distro' => 'debian',
 	       'dgit.default.username' => '',
 	       'dgit.default.archive-query-default-component' => 'main',
 	       'dgit.default.ssh' => 'ssh',
+	       'dgit.default.archive-query' => 'madison:',
+	       'dgit.default.sshpsql-dbname' => 'service=projectb',
+	       'dgit-distro.debian.archive-query' => 'sshpsql:',
 	       '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' => 'coccia.debian.org',
-	       'dgit-distro.debian.sshpsql-dbname' => 'service=projectb',
+	       'dgit-distro.debian.sshpsql-host' => 'mirror.ftp-master.debian.org',
 	       '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*',
  'dgit-distro.debian-backports.mirror' => 'http://backports.debian.org/debian-backports/',
+	       'dgit-distro.ubuntu.git-check' => 'false',
+ 'dgit-distro.ubuntu.mirror' => 'http://archive.ubuntu.com/ubuntu',
 	       'dgit-distro.test-dummy.ssh' => "$td/ssh",
 	       'dgit-distro.test-dummy.username' => "alice",
 	       'dgit-distro.test-dummy.git-check' => "ssh-cmd",
@@ -505,12 +565,16 @@ sub cfg {
 }
 
 sub access_basedistro () {
-    return cfg("dgit-suite.$isuite.distro",
-	       "dgit.default.distro");
+    if (defined $idistro) {
+	return $idistro;
+    } else {	
+	return cfg("dgit-suite.$isuite.distro",
+		   "dgit.default.distro");
+    }
 }
 
 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');
@@ -524,22 +588,52 @@ 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:
+    #    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 if defined $quirkdistro;
+
+    return @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;
 }
 
@@ -572,22 +666,43 @@ 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');
     }
     return "$url/$package.git";
 }	       
 
-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;
 }
 
@@ -646,16 +761,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 = $'; #';
@@ -668,17 +773,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* \|
@@ -697,12 +806,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;".
@@ -712,6 +821,10 @@ sub canonicalise_suite_madison ($$) {
 
 sub sshpsql ($$) {
     my ($data,$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;
@@ -743,7 +856,7 @@ sub archive_query_sshpsql ($$) {
     my ($proto,$data) = @_;
     sql_injection_check $isuite, $package;
     my @rows = sshpsql($data, <<END);
-        SELECT source.version, component.name, files.filename
+        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
@@ -755,10 +868,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;
 }
@@ -812,7 +926,7 @@ 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;
 }
 
 sub canonicalise_suite () {
@@ -828,19 +942,28 @@ 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);
+	$dsc = parsecontrolfh($dscfh,$dscurl,1);
 	printdebug Dumper($dsc) if $debug>1;
 	my $fmt = getfield $dsc, 'Format';
 	fail "unsupported source format $fmt, sorry" unless $format_ok{$fmt};
+	$dsc_checked = !!$digester;
 	return;
     }
     $dsc = undef;
@@ -859,6 +982,8 @@ sub check_for_git () {
 	return $r+0;
     } elsif ($how eq 'true') {
 	return 1;
+    } elsif ($how eq 'false') {
+	return 0;
     } else {
 	badcfg "unknown git-check \`$how'";
     }
@@ -888,6 +1013,12 @@ sub prep_ud () {
     mkdir $ud or die $!;
 }
 
+sub mktree_in_ud_here () {
+    runcmd qw(git init -q);
+    rmtree('.git/objects');
+    symlink '../../../../objects','.git/objects' or die $!;
+}
+
 sub mktree_in_ud_from_only_subdir () {
     # changes into the subdir
     my (@dirs) = <*/.>;
@@ -895,11 +1026,12 @@ sub mktree_in_ud_from_only_subdir () {
     $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 $!;
+    fail "source package contains .git directory" if stat_exists '.git';
+    mktree_in_ud_here();
+    my $format=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 ?";
@@ -937,9 +1069,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 ($) {
@@ -962,20 +1097,34 @@ sub clogp_authline ($) {
 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
 	    or $!==&ENOENT
 	    or die "$f $!";
+
+	complete_file_from_dsc('.', $fi);
+
+	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();
     runcmd qw(sh -ec), 'dpkg-parsechangelog >../changelog.tmp';
     my $clogp = parsecontrol('../changelog.tmp',"commit's changelog");
@@ -1001,7 +1150,7 @@ END
 	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 $!;
@@ -1036,30 +1185,45 @@ END
     return $outputhash;
 }
 
+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/^${package}_/;
+	die "$f ?" if $f =~ m#/#;
+	runcmd_ordryrun_local @curl,qw(-o),$tf,'--',"$furl";
+	next if !act_local();
+	$downloaded = 1;
+    }
+
+    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?)");
+}
+
 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}_/;
-	die "$f ?" if $f =~ m#/#;
-	runcmd_ordryrun_local shell_cmd 'cd ..', @dget,'--',$origurl;
+	complete_file_from_dsc('..', $fi);
     }
 }
 
@@ -1166,7 +1330,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:
@@ -1194,11 +1358,14 @@ sub clone ($) {
     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();
+    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 (check_for_git()) {
 	progress "fetching existing git history";
 	git_fetch_us();
@@ -1207,6 +1374,10 @@ sub clone ($) {
 	progress "starting new git history";
     }
     fetch_from_archive() or no_such_package;
+    my $vcsgiturl = $dsc->{'Vcs-Git'};
+    if (length $vcsgiturl) {
+	runcmd @git, qw(remote add vcs-git), $vcsgiturl;
+    }
     runcmd @git, qw(reset --hard), lrref();
     printdone "ready for work in $dstdir";
 }
@@ -1239,6 +1410,12 @@ sub check_not_dirty () {
     }
 }
 
+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;
@@ -1248,24 +1425,34 @@ 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;
+    commit_admin "Commit Debian 3.0 (quilt) metadata";
+}
+
+sub get_source_format () {
+    if (!open F, "debian/source/format") {
+	die $! unless $!==&ENOENT;
+	return '';
+    }
+    $_ = <F>;
+    F->error and die $!;
+    chomp;
+    return $_;
 }
 
 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";
 	return 0;
     }
+    progress "Format \`$format', checking/updating patch stack";
     return 1;
 }
 
@@ -1363,6 +1550,8 @@ sub dopush () {
     printdebug "actually entering push\n";
     prep_ud();
 
+    access_giturl(); # check that success is vaguely likely
+
     my $clogpfn = ".git/dgit/changelog.822.tmp";
     runcmd shell_cmd "exec >$clogpfn", qw(dpkg-parsechangelog);
 
@@ -1372,7 +1561,7 @@ sub dopush () {
 	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";
 
@@ -1417,10 +1606,9 @@ sub dopush () {
     if (!$changesfile) {
 	my $multi = "$buildproductsdir/".
 	    "${package}_".(stripepoch $cversion)."_multi.changes";
-	if (stat "$multi") {
+	if (stat_exists "$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".
@@ -1503,6 +1691,10 @@ sub cmd_clone {
     }
     $dstdir ||= "$package";
 
+    if (stat_exists $dstdir) {
+	fail "$dstdir already exists";
+    }
+
     my $cwd_remove;
     if ($rmonerror && !$dryrun_level) {
 	$cwd_remove= getcwd();
@@ -1604,12 +1796,15 @@ sub cmd_push {
 
 #---------- 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;
 
@@ -1620,19 +1815,30 @@ sub cmd_remote_push_responder {
     open STDOUT, ">&STDERR" or die $!;
     autoflush STDOUT 1;
 
-    responder_send_command("dgit-remote-push-ready");
+    $vsnwant //= 1;
+    fail "build host has dgit rpush protocol version".
+	" $rpushprotovsn but invocation host has $vsnwant"
+	unless grep { $rpushprotovsn eq $_ } split /,/, $vsnwant;
+
+    responder_send_command("dgit-remote-push-ready $rpushprotovsn");
 
     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)
+
 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) {
@@ -1659,11 +1865,11 @@ sub cmd_rpush {
 	$dir = nextarg;
     }
     $dir =~ s{^-}{./-};
-    my @rargs = ($dir);
+    my @rargs = ($dir,$rpushprotovsn);
     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;
@@ -1696,10 +1902,10 @@ sub i_resp_progress ($) {
 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";
@@ -1710,7 +1916,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;
 }
@@ -1796,30 +2003,124 @@ our $dscfn;
 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($_);
+    my $format=get_source_format;
+    return unless madformat $format;
     # 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.";
-    }
+
+    # 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}
+    #     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
 
     my $clogp = parsechangelog();
-    my $version = getfield $clogp, 'Version';
-    my $author = getfield $clogp, 'Maintainer';
     my $headref = rev_parse('HEAD');
+
+    prep_ud();
+    changedir $ud;
+
+    my $upstreamversion=$version;
+    $upstreamversion =~ s/-[^-]*$//;
+
+    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 $!;
+    };
+
+    foreach my $f (<../../../../*>) { #/){
+	my $b=$f; $b =~ s{.*/}{};
+	next unless is_orig_file $b, srcfn $upstreamversion,'';
+	link $f, $b or die "$b $!";
+        $dscaddfile->($b);
+    }
+
+    my @files=qw(debian/source/format debian/rules);
+    if (stat_exists '../../../debian/patches') {
+        push @files, 'debian/patches';
+    }
+
+    my $debtar= srcfn $fakeversion,'.debian.tar.gz';
+    runcmd qw(env GZIP=-1 tar -zcf), "./$debtar", qw(-C ../../..), @files;
+
+    $dscaddfile->($debtar);
+    close $fakedsc or die $!;
+
+    runcmd qw(sh -ec), 'exec dpkg-source --no-check -x fake.dsc >/dev/null';
+
+    my $fakexdir= $package.'-'.(stripepoch $upstreamversion);
+    rename $fakexdir, "fake" or die "$fakexdir $!";
+
+    mkdir "work" or die $!;
+    changedir "work";
+    mktree_in_ud_here();
+    runcmd @git, qw(reset --hard), $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 $!;
+    }
+
+    my $author = getfield $clogp, 'Maintainer';
     my $time = time;
     my $ncommits = 3;
     my $patchname = "auto-$version-$headref-$time";
@@ -1854,6 +2155,14 @@ END
     }
 
     commit_quilty_patch();
+
+    if ($mustdeletepc) {
+        runcmd @git, qw(rm -rq .pc);
+        commit_admin "Commit removal of .pc (quilt series tracking data)";
+    }
+
+    changedir '../../../..';
+    runcmd @git, qw(pull --ff-only -q .git/dgit/unpack/work master);
 }
 
 sub quilt_fixup_editor () {
@@ -1886,6 +2195,11 @@ sub clean_tree () {
     }
 }
 
+sub cmd_clean () {
+    badusage "clean takes no additional arguments" if @ARGV;
+    clean_tree();
+}
+
 sub build_prep () {
     badusage "-p is not allowed when building" if defined $package;
     check_not_dirty();
@@ -1910,7 +2224,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 {
@@ -1975,8 +2289,9 @@ sub cmd_sbuild {
     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): $!";
+	stat_exist $dscfn or fail "$dscfn (in parent directory): $!";
+	stat_exists $sourcechanges
+	    or fail "$sourcechanges (in parent directory): $!";
 	foreach my $cf (glob $pat) {
 	    next if $cf eq $sourcechanges;
 	    unlink $cf or fail "remove $cf: $!";
@@ -1993,7 +2308,7 @@ sub cmd_sbuild {
     runcmd_ordryrun_local @mergechanges, @changesfiles;
     my $multichanges = "${package}_".(stripepoch $version)."_multi.changes";
     if (act_local()) {
-	stat $multichanges or fail "$multichanges: $!";
+	stat_exists $multichanges or fail "$multichanges: $!";
     }
     printdone "build successful, results in $multichanges\n" or die $!;
 }    
@@ -2002,6 +2317,7 @@ sub cmd_quilt_fixup {
     badusage "incorrect arguments to dgit quilt-fixup" if @ARGV;
     my $clogp = parsechangelog();
     $version = getfield $clogp, 'Version';
+    $package = getfield $clogp, 'Source';
     build_maybe_quilt_fixup();
 }
 
@@ -2146,8 +2462,6 @@ if ($ENV{$fakeeditorenv}) {
     quilt_fixup_editor();
 }
 
-delete $ENV{'DGET_UNPACK'};
-
 parseopts();
 print STDERR "DRY RUN ONLY\n" if $dryrun_level > 1;
 print STDERR "DAMP RUN - WILL MAKE LOCAL (UNSIGNED) CHANGES\n"
@@ -2158,4 +2472,7 @@ if (!@ARGV) {
 }
 my $cmd = shift @ARGV;
 $cmd =~ y/-/_/;
-{ no strict qw(refs); &{"cmd_$cmd"}(); }
+
+my $fn = ${*::}{"cmd_$cmd"};
+$fn or badusage "unknown operation $cmd";
+$fn->();