chiark / gitweb /
Improve error message for .dsc having already been signed (iff using libdpkg-perl...
[dgit.git] / dgit
diff --git a/dgit b/dgit
index 0908105..ebeb880 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -24,11 +24,12 @@ use Data::Dumper;
 use LWP::UserAgent;
 use Dpkg::Control::Hash;
 use File::Path;
+use File::Temp qw(tempdir);
 use File::Basename;
 use Dpkg::Version;
 use POSIX;
 use IPC::Open2;
-use File::Temp;
+use Digest::SHA;
 
 our $our_version = 'UNRELEASED'; ###substituted###
 
@@ -38,24 +39,31 @@ our $package;
 our @ropts;
 
 our $sign = 1;
-our $dryrun = 0;
+our $dryrun_level = 0;
 our $changesfile;
+our $buildproductsdir = '..';
 our $new_package = 0;
 our $ignoredirty = 0;
 our $noquilt = 0;
+our $rmonerror = 1;
 our $existing_package = 'dpkg';
 our $cleanmode = 'dpkg-source';
+our $changes_since_version;
 our $we_are_responder;
+our $initiator_tempdir;
 
 our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
 
+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);
 our (@sbuild) = qw(sbuild -A);
-our (@ssh) = qw(ssh);
+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);
@@ -63,7 +71,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,
@@ -76,11 +85,15 @@ our %opts_opt_map = ('dget' => \@dget,
                      'ch' => \@changesopts,
                      'mergechanges' => \@mergechanges);
 
+our %opts_opt_cmdonly = ('gpg' => 1);
+
 our $keyid;
 
 our $debug = 0;
 open DEBUG, ">/dev/null" or die $!;
 
+autoflush STDOUT 1;
+
 our $remotename = 'dgit';
 our @ourdscfield = qw(Dgit Vcs-Dgit-Master);
 our $branchprefix = 'dgit';
@@ -108,11 +121,23 @@ sub dscfn ($) {
     return "${package}_".(stripepoch $vsn).".dsc";
 }
 
-sub changesopts () { return @changesopts[1..$#changesopts]; }
-
 our $us = 'dgit';
+our $debugprefix = '';
+
+our @end;
+END { 
+    local ($?);
+    foreach my $f (@end) {
+       eval { $f->(); };
+       warn "$us: cleanup: $@" if length $@;
+    }
+};
+
+sub printdebug { print DEBUG $debugprefix, @_ or die $!; }
 
-sub fail { die "$us: @_\n"; }
+sub fail { 
+    die $us.($we_are_responder ? " (build host)" : "").": @_\n";
+}
 
 sub badcfg { print STDERR "$us: invalid configuration: @_\n"; exit 12; }
 
@@ -126,24 +151,32 @@ sub fetchspec () {
     return  "+".rrref().":".lrref();
 }
 
+sub changedir ($) {
+    my ($newdir) = @_;
+    printdebug "CD $newdir\n";
+    chdir $newdir or die "chdir: $newdir: $!";
+}
+
 #---------- remote protocol support, common ----------
 
 # remote push initiator/responder protocol:
 #  < dgit-remote-push-ready [optional extra info ignored by old initiators]
 #
-#  > file begin parsed-changelog
+#  > file parsed-changelog
 #  [indicates that output of dpkg-parsechangelog follows]
 #  > data-block NBYTES
 #  > [NBYTES bytes of data (no newline)]
 #  [maybe some more blocks]
 #  > data-end
 #
-#  > file begin dsc
+#  > file dsc
 #  [etc]
 #
-#  > file begin changes
+#  > file changes
 #  [etc]
 #
+#  > param head HEAD
+#
 #  > want signed-tag
 #  [indicates that signed tag is wanted]
 #  < data-block NBYTES
@@ -152,11 +185,11 @@ sub fetchspec () {
 #  < data-end
 #  < files-end
 #
-#  > want signed-changes-dsc
-#  < data-block NBYTES    [transfer of signed changes]
-#  [etc]
+#  > want signed-dsc-changes
 #  < data-block NBYTES    [transfer of signed dsc]
 #  [etc]
+#  < data-block NBYTES    [transfer of signed changes]
+#  [etc]
 #  < files-end
 #
 #  > complete
@@ -164,16 +197,21 @@ sub fetchspec () {
 sub badproto ($$) {
     my ($fh, $m) = @_;
     fail "connection lost: $!" if $fh->error;
-    fail "connection terminated" if $fh->eof;
     fail "protocol violation; $m not expected";
 }
 
-sub protocol_expect ($&) {
-    my ($fh, $match) = @_;
+sub protocol_expect (&$) {
+    my ($match, $fh) = @_;
     local $_;
     $_ = <$fh>;
     defined && chomp or badproto $fh, "eof";
-    return if &$match;
+    if (wantarray) {
+       my @r = &$match;
+       return @r if @r;
+    } else {
+       my $r = &$match;
+       return $r if $r;
+    }
     badproto $fh, "\`$_'";
 }
 
@@ -184,17 +222,18 @@ sub protocol_send_file ($$) {
        my $d;
        my $got = read PF, $d, 65536;
        die "$ourfn: $!" unless defined $got;
-       last if $got;
+       last if !$got;
        print $fh "data-block ".length($d)."\n" or die $!;
-       print $d or die $!;
+       print $fh $d or die $!;
     }
+    PF->error and die "$ourfn $!";
     print $fh "data-end\n" or die $!;
     close PF;
 }
 
 sub protocol_read_bytes ($$) {
     my ($fh, $nbytes) = @_;
-    $nbytes =~ m/^\d{1,6}$/ or badproto \*RO, "bad byte count";
+    $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";
@@ -203,13 +242,19 @@ sub protocol_read_bytes ($$) {
 
 sub protocol_receive_file ($$) {
     my ($fh, $ourfn) = @_;
+    printdebug "() $ourfn\n";
     open PF, ">", $ourfn or die "$ourfn: $!";
     for (;;) {
-       protocol_expect \*STDIN, { m/^data-block (.*})$|data-end$/ };
-       length $1 or last;
-       my $d = protocol_read_bytes \*STDIN, $1;
+       my ($y,$l) = protocol_expect {
+           m/^data-block (.*)$/ ? (1,$1) :
+           m/^data-end$/ ? (0,) :
+           ();
+       } $fh;
+       last unless $y;
+       my $d = protocol_read_bytes $fh, $l;
        print PF $d or die $!;
     }
+    close PF or die $!;
 }
 
 #---------- remote protocol support, responder ----------
@@ -218,32 +263,35 @@ sub responder_send_command ($) {
     my ($command) = @_;
     return unless $we_are_responder;
     # called even without $we_are_responder
-    print DEBUG "<< $command\n";
-    print $command, "\n" or die $!;
+    printdebug ">> $command\n";
+    print PO $command, "\n" or die $!;
 }    
 
 sub responder_send_file ($$) {
     my ($keyword, $ourfn) = @_;
     return unless $we_are_responder;
-    responder_send_command "file begin $cmdprefix";
-    protocol_send_file \*STDOUT, $ourfn;
+    printdebug "]] $keyword $ourfn\n";
+    responder_send_command "file $keyword";
+    protocol_send_file \*PO, $ourfn;
 }
 
 sub responder_receive_files ($@) {
     my ($keyword, @ourfns) = @_;
     die unless $we_are_responder;
+    printdebug "[[ $keyword @ourfns\n";
     responder_send_command "want $keyword";
     foreach my $fn (@ourfns) {
-       protocol_receive_file \*STDIN, $fn;
+       protocol_receive_file \*PI, $fn;
     }
-    protocol_expect \*STDIN, { m/^files-end$/ };
+    printdebug "[[\$\n";
+    protocol_expect { m/^files-end$/ } \*PI;
 }
 
 #---------- remote protocol support, initiator ----------
 
 sub initiator_expect (&) {
     my ($match) = @_;
-    protocol_expect \*RO, &$match;
+    protocol_expect { &$match } \*RO;
 }
 
 #---------- end remote code ----------
@@ -252,7 +300,7 @@ sub progress {
     if ($we_are_responder) {
        my $m = join '', @_;
        responder_send_command "progress ".length($m) or die $!;
-       print $m or die $!;
+       print PO $m or die $!;
     } else {
        print @_, "\n";
     }
@@ -270,35 +318,36 @@ 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;
     local $_;
     foreach my $a (@_) {
        $_ = $a;
-       if (s{['\\]}{\\$&}g || m{\s} || m{[^-_./0-9a-z]}i) {
+       if (m{[^-=_./0-9a-z]}i) {
+           s{['\\]}{'\\$&'}g;
            push @out, "'$_'";
        } else {
            push @out, $_;
        }
     }
-    return join '', @out;
+    return join ' ', @out;
 }
 
 sub printcmd {
     my $fh = shift @_;
     my $intro = shift @_;
-    print $fh $intro or die $!;
+    print $fh $intro," " or die $!;
     print $fh shellquote @_ or die $!;
     print $fh "\n" or die $!;
 }
 
 sub failedcmd {
-    { local ($!); printcmd \*STDERR, "$_[0]: failed command:", @_ or die $!; };
+    { local ($!); printcmd \*STDERR, "$us: failed command:", @_ or die $!; };
     if ($!) {
        fail "failed to fork/exec: $!";
     } elsif (!($? & 0xff)) {
@@ -311,13 +360,16 @@ sub failedcmd {
 }
 
 sub runcmd {
-    printcmd(\*DEBUG,"+",@_) if $debug>0;
+    printcmd(\*DEBUG,$debugprefix."+",@_) if $debug>0;
     $!=0; $?=0;
     failedcmd @_ if system @_;
 }
 
+sub act_local () { return $dryrun_level <= 1; }
+sub act_scary () { return !$dryrun_level; }
+
 sub printdone {
-    if (!$dryrun) {
+    if (!$dryrun_level) {
        progress "dgit ok: @_";
     } else {
        progress "would be ok: @_ (but dry run only)";
@@ -326,16 +378,16 @@ sub printdone {
 
 sub cmdoutput_errok {
     die Dumper(\@_)." ?" if grep { !defined } @_;
-    printcmd(\*DEBUG,"|",@_) if $debug>0;
+    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) { print DEBUG "=>!$?\n" if $debug>0; return undef; }
+    if (!close P) { printdebug "=>!$?\n" if $debug>0; return undef; }
     chomp $d;
     $d =~ m/^.*/;
-    print DEBUG "=> \`$&'",(length $' ? '...' : ''),"\n" if $debug>0; #';
+    printdebug "=> \`$&'",(length $' ? '...' : ''),"\n" if $debug>0; #';
     return $d;
 }
 
@@ -346,11 +398,19 @@ sub cmdoutput {
 }
 
 sub dryrun_report {
-    printcmd(\*STDERR,"#",@_);
+    printcmd(\*STDERR,$debugprefix."#",@_);
 }
 
 sub runcmd_ordryrun {
-    if (!$dryrun) {
+    if (act_scary()) {
+       runcmd @_;
+    } else {
+       dryrun_report @_;
+    }
+}
+
+sub runcmd_ordryrun_local {
+    if (act_local()) {
        runcmd @_;
     } else {
        dryrun_report @_;
@@ -368,9 +428,11 @@ main usages:
   dgit [dgit-opts] fetch|pull [dgit-opts] [suite]
   dgit [dgit-opts] build [git-buildpackage-opts|dpkg-buildpackage-opts]
   dgit [dgit-opts] push [dgit-opts] [suite]
+  dgit [dgit-opts] rpush build-host:build-dir ...
 important dgit options:
   -k<keyid>           sign tag and package with <keyid> instead of default
   --dry-run -n        do not change anything, but go through the motions
+  --damp-run -L       like --dry-run but make local changes, without signing
   --new -N            allow introducing a new package
   --debug -D          increase debug level
   -c<name>=<value>    set git config option (used directly by dgit too)
@@ -395,6 +457,8 @@ sub cmd_help () {
     exit 0;
 }
 
+our $td = $ENV{DGIT_TEST_DUMMY_DIR} || "DGIT_TEST_DUMMY_DIR-unset";
+
 our %defcfg = ('dgit.default.distro' => 'debian',
               'dgit.default.username' => '',
               'dgit.default.archive-query-default-component' => 'main',
@@ -404,11 +468,25 @@ our %defcfg = ('dgit.default.distro' => 'debian',
               '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.sshdakls-host' => 'coccia.debian.org',
-              'dgit-distro.debian.sshdakls-dir' =>
-                  '/srv/ftp-master.debian.org/ftp/dists',
+              '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.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",
+              'dgit-distro.test-dummy.git-create' => "ssh-cmd",
+              '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.mirror' => "file://$td/mirror/",
+              'dgit-distro.test-dummy.upload-host' => 'test-dummy',
+               );
 
 sub cfg {
     foreach my $c (@_) {
@@ -427,22 +505,73 @@ sub cfg {
        my $dv = $defcfg{$c};
        return $dv if defined $dv;
     }
-    badcfg "need value for one of: @_";
+    badcfg "need value for one of: @_\n".
+       "$us: distro or suite appears not to be (properly) supported";
+}
+
+sub access_basedistro () {
+    if (defined $idistro) {
+       return cfg("dgit-distro.basedistro.distro",
+                  "dgit-suite.$isuite.distro",
+                  'RETURN-UNDEF') // $idistro;
+    } else {   
+       return cfg("dgit-suite.$isuite.distro",
+                  "dgit.default.distro");
+    }
+}
+
+sub access_quirk () {
+    # returns (quirk name, distro to use instead, quirk-specific info)
+    my $basedistro = access_basedistro();
+    my $backports_quirk = cfg("dgit-distro.$basedistro.backports-quirk",
+                             'RETURN-UNDEF');
+    if (defined $backports_quirk) {
+       my $re = $backports_quirk;
+       $re =~ s/[^-0-9a-z_\%*()]/\\$&/ig;
+       $re =~ s/\*/.*/g;
+       $re =~ s/\%/([-0-9a-z_]+)/
+           or $re =~ m/[()]/ or badcfg "backports-quirk needs \% or ( )";
+       if ($isuite =~ m/^$re$/) {
+           return ('backports',"$basedistro-backports",$1);
+       }
+    }
+    return ('none',$basedistro);
 }
 
 sub access_distro () {
-    return cfg("dgit-suite.$isuite.distro",
-              "dgit.default.distro");
+    return (access_quirk())[1];
 }
 
 sub access_cfg (@) {
     my (@keys) = @_;
+    my $basedistro = access_basedistro();
     my $distro = $idistro || access_distro();
-    my $value = cfg(map { ("dgit-distro.$distro.$_",
-                          "dgit.default.$_") } @keys);
+    my $value = cfg(map {
+       ("dgit-distro.$distro.$_",
+        "dgit-distro.$basedistro.$_",
+        "dgit.default.$_")
+                   } @keys);
     return $value;
 }
 
+sub string_to_ssh ($) {
+    my ($spec) = @_;
+    if ($spec =~ m/\s/) {
+       return qw(sh -ec), 'exec '.$spec.' "$@"', 'x';
+    } else {
+       return ($spec);
+    }
+}
+
+sub access_cfg_ssh () {
+    my $gitssh = access_cfg('ssh', 'RETURN-UNDEF');
+    if (!defined $gitssh) {
+       return @ssh;
+    } else {
+       return string_to_ssh $gitssh;
+    }
+}
+
 sub access_someuserhost ($) {
     my ($some) = @_;
     my $user = access_cfg("$some-user",'username');
@@ -465,11 +594,30 @@ sub access_giturl () {
     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;
+print STDERR Dumper(\%opts);
+       $c = Dpkg::Control::Hash->new(%opts);
+       $c->parse($fh) 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;
 }
 
@@ -500,17 +648,40 @@ 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: $!";
+    return $d;
+}
+
 our %rmad;
 
 sub archive_query ($) {
     my ($method) = @_;
     my $query = access_cfg('archive-query','RETURN-UNDEF');
     if (!defined $query) {
-       my $distro = access_distro();
+       my $distro = access_basedistro();
        if ($distro eq 'debian') {
-           $query = "sshdakls:".
-               access_someuserhost('sshdakls').':'.
-               access_cfg('sshdakls-dir');
+           $query = "sshpsql:".
+               access_someuserhost('sshpsql').':'.
+               access_cfg('sshpsql-dbname');
        } else {
            $query = "madison:$distro";
        }
@@ -521,6 +692,12 @@ sub archive_query ($) {
     { no strict qw(refs); &{"${method}_${proto}"}($proto,$data); }
 }
 
+sub pool_dsc_subpath ($$) {
+    my ($vsn,$component) = @_; # $package is implict arg
+    my $prefix = substr($package, 0, $package =~ m/^l/ ? 4 : 1);
+    return "/pool/$component/$prefix/$package/".dscfn($vsn);
+}
+
 sub archive_query_madison ($$) {
     my ($proto,$data) = @_;
     die unless $proto eq 'madison';
@@ -530,28 +707,6 @@ sub archive_query_madison ($$) {
     return madison_parse($rmad);
 }
 
-sub archive_query_sshdakls ($$) {
-    my ($proto,$data) = @_;
-    $data =~ s/:.*// or badcfg "invalid sshdakls method string \`$data'";
-    my $dakls = cmdoutput
-       access_cfg('ssh'), $data, qw(dak ls -asource),"-s$isuite",$package;
-    return madison_parse($dakls);
-}
-
-sub canonicalise_suite_sshdakls ($$) {
-    my ($proto,$data) = @_;
-    $data =~ m/:/ or badcfg "invalid sshdakls method string \`$data'";
-    my @cmd =
-       (access_cfg('ssh'), $`,
-        "set -e; cd $';".
-        " if test -h $isuite; then readlink $isuite; exit 0; fi;".
-        " if test -d $isuite; then echo $isuite; exit 0; fi;".
-        " exit 1");
-    my $dakls = cmdoutput @cmd;
-    failedcmd @cmd unless $dakls =~ m/^\w/;
-    return $dakls;
-}
-
 sub madison_parse ($) {
     my ($rmad) = @_;
     my @out;
@@ -559,7 +714,7 @@ sub madison_parse ($) {
        $l =~ m{^ \s*( [^ \t|]+ )\s* \|
                   \s*( [^ \t|]+ )\s* \|
                   \s*( [^ \t|/]+ )(?:/([^ \t|/]+))? \s* \|
-                  \s*( [^ \t|]+ )\s* }x or die "$rmad $?";
+                  \s*( [^ \t|]+ )\s* }x or die "$rmad ?";
        $1 eq $package or die "$rmad $package ?";
        my $vsn = $2;
        my $newsuite = $3;
@@ -570,14 +725,13 @@ sub madison_parse ($) {
            $component = access_cfg('archive-query-default-component');
        }
        $5 eq 'source' or die "$rmad ?";
-       my $prefix = substr($package, 0, $package =~ m/^l/ ? 4 : 1);
-       my $subpath = "/pool/$component/$prefix/$package/".dscfn($vsn);
-       push @out, [$vsn,$subpath,$newsuite];
+       push @out, [$vsn,pool_dsc_subpath($vsn,$component),$newsuite];
     }
     return sort { -version_compare_string($a->[0],$b->[0]); } @out;
 }
 
 sub canonicalise_suite_madison ($$) {
+    # madison canonicalises for us
     my @r = archive_query_madison($_[0],$_[1]);
     @r or fail
        "unable to canonicalise suite using package $package".
@@ -586,12 +740,117 @@ sub canonicalise_suite_madison ($$) {
     return $r[0][2];
 }
 
+sub sshpsql ($$) {
+    my ($data,$sql) = @_;
+    $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;
+    open P, "-|", @cmd or die $!;
+    while (<P>) {
+       chomp or die;
+       printdebug("$debugprefix>|$_|\n");
+       push @rows, $_;
+    }
+    $!=0; $?=0; close P or failedcmd @cmd;
+    @rows or die;
+    my $nrows = pop @rows;
+    $nrows =~ s/^\((\d+) rows?\)$/$1/ or die "$nrows ?";
+    @rows == $nrows+1 or die "$nrows ".(scalar @rows)." ?";
+    @rows = map { [ split /\|/, $_ ] } @rows;
+    my $ncols = scalar @{ shift @rows };
+    die if grep { scalar @$_ != $ncols } @rows;
+    return @rows;
+}
+
+sub sql_injection_check {
+    foreach (@_) { die "$_ $& ?" if m/[']/; }
+}
+
+sub archive_query_sshpsql ($$) {
+    my ($proto,$data) = @_;
+    sql_injection_check $isuite, $package;
+    my @rows = sshpsql($data, <<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
+          JOIN dsc_files ON dsc_files.source = source.id
+          JOIN files_archive_map ON files_archive_map.file_id = dsc_files.file
+          JOIN component ON component.id = files_archive_map.component_id
+          JOIN files ON files.id = dsc_files.file
+         WHERE ( suite.suite_name='$isuite' OR suite.codename='$isuite' )
+           AND source.source='$package'
+           AND files.filename LIKE '%.dsc';
+END
+    @rows = sort { -version_compare_string($a->[0],$b->[0]) } @rows;
+    my $digester = Digest::SHA->new(256);
+    @rows = map {
+       my ($vsn,$component,$filename,$sha256sum) = @$_;
+       [ $vsn, "/pool/$component/$filename",$digester,$sha256sum ];
+    } @rows;
+    return @rows;
+}
+
+sub canonicalise_suite_sshpsql ($$) {
+    my ($proto,$data) = @_;
+    sql_injection_check $isuite;
+    my @rows = sshpsql($data, <<END);
+        SELECT suite.codename
+          FROM suite where suite_name='$isuite' or codename='$isuite';
+END
+    @rows = map { $_->[0] } @rows;
+    fail "unknown suite $isuite" unless @rows;
+    die "ambiguous $isuite: @rows ?" if @rows>1;
+    return $rows[0];
+}
+
+sub canonicalise_suite_dummycat ($$) {
+    my ($proto,$data) = @_;
+    my $dpath = "$data/suite.$isuite";
+    if (!open C, "<", $dpath) {
+       $!==ENOENT or die "$dpath: $!";
+       printdebug "dummycat canonicalise_suite $isuite $dpath ENOENT\n";
+       return $isuite;
+    }
+    $!=0; $_ = <C>;
+    chomp or die "$dpath: $!";
+    close C;
+    printdebug "dummycat canonicalise_suite $isuite $dpath = $_\n";
+    return $_;
+}
+
+sub archive_query_dummycat ($$) {
+    my ($proto,$data) = @_;
+    canonicalise_suite();
+    my $dpath = "$data/package.$csuite.$package";
+    if (!open C, "<", $dpath) {
+       $!==ENOENT or die "$dpath: $!";
+       printdebug "dummycat query $csuite $package $dpath ENOENT\n";
+       return ();
+    }
+    my @rows;
+    while (<C>) {
+       next if m/^\#/;
+       next unless m/\S/;
+       die unless chomp;
+       printdebug "dummycat query $csuite $package $dpath | $_\n";
+       my @row = split /\s+/, $_;
+       @row==2 or die "$dpath: $_ ?";
+       push @rows, \@row;
+    }
+    C->error and die "$dpath: $!";
+    close C;
+    return sort { -version_compare_string($a->[0],$b->[0]); } @rows;
+}
+
 sub canonicalise_suite () {
     return if defined $csuite;
     fail "cannot operate on $isuite suite" if $isuite eq 'UNRELEASED';
     $csuite = archive_query('canonicalise_suite');
     if ($isuite ne $csuite) {
-       # madison canonicalises for us
        progress "canonical suite name for $isuite is $csuite";
     }
 }
@@ -600,19 +859,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 $!;
-       print DEBUG Dumper($dscdata) if $debug>1;
-       $dsc = parsecontrolfh($dscfh,$dscurl, allow_pgp=>1);
-       print DEBUG Dumper($dsc) if $debug>1;
+       printdebug Dumper($dscdata) if $debug>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;
@@ -623,12 +891,16 @@ sub check_for_git () {
     my $how = access_cfg('git-check');
     if ($how eq 'ssh-cmd') {
        my @cmd =
-           (access_cfg('ssh'),access_gituserhost(),
+           (access_cfg_ssh, access_gituserhost(),
             " 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]$/;
        return $r+0;
+    } elsif ($how eq 'true') {
+       return 1;
+    } elsif ($how eq 'false') {
+       return 0;
     } else {
        badcfg "unknown git-check \`$how'";
     }
@@ -638,9 +910,11 @@ sub create_remote_git_repo () {
     my $how = access_cfg('git-create');
     if ($how eq 'ssh-cmd') {
        runcmd_ordryrun
-           (access_cfg('ssh'),access_gituserhost(),
+           (access_cfg_ssh, access_gituserhost(),
             "set -e; cd ".access_cfg('git-path').";".
             " cp -a _template $package.git");
+    } elsif ($how eq 'true') {
+       # nothing to do
     } else {
        badcfg "unknown git-create \`$how'";
     }
@@ -662,7 +936,7 @@ sub mktree_in_ud_from_only_subdir () {
     die unless @dirs==1;
     $dirs[0] =~ m#^([^/]+)/\.$# or die;
     my $dir = $1;
-    chdir $dir or die "$dir $!";
+    changedir $dir;
     fail "source package contains .git directory" if stat '.git';
     die $! unless $!==&ENOENT;
     runcmd qw(git init -q);
@@ -729,21 +1003,35 @@ sub clogp_authline ($) {
 
 sub generate_commit_from_dsc () {
     prep_ud();
-    chdir $ud or die $!;
-    my @files;
-    foreach my $f (dsc_files()) {
+    changedir $ud;
+
+    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");
@@ -795,7 +1083,7 @@ END
            $outputhash = $lastpush_hash;
        }
     }
-    chdir '../../../..' or die $!;
+    changedir '../../../..';
     runcmd @git, qw(update-ref -m),"dgit fetch import $cversion",
             'DGIT_ARCHIVE', $outputhash;
     cmdoutput @git, qw(log -n2), $outputhash;
@@ -804,30 +1092,47 @@ 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 $tf) {
+       progress "using existing $f";
+    } else {
+       die "$tf $!" unless $!==&ENOENT;
+
+       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 shell_cmd 'cd ..', @dget,'--',$origurl;
+       complete_file_from_dsc('..', $fi);
     }
 }
 
@@ -848,7 +1153,7 @@ sub is_fast_fwd ($$) {
 }
 
 sub git_fetch_us () {
-    runcmd_ordryrun @git, qw(fetch),access_giturl(),fetchspec();
+    runcmd_ordryrun_local @git, qw(fetch),access_giturl(),fetchspec();
 }
 
 sub fetch_from_archive () {
@@ -872,22 +1177,13 @@ sub fetch_from_archive () {
        progress "no version available from the archive";
     }
 
-    my $lrref_fn = ".git/".lrref();
-    if (open H, $lrref_fn) {
-       $lastpush_hash = <H>;
-       chomp $lastpush_hash;
-       die "$lrref_fn $lastpush_hash ?" unless $lastpush_hash =~ m/^\w+$/;
-    } elsif ($! == &ENOENT) {
-       $lastpush_hash = '';
-    } else {
-       die "$lrref_fn $!";
-    }
-    print DEBUG "previous reference hash=$lastpush_hash\n";
+    $lastpush_hash = git_get_ref(lrref());
+    printdebug "previous reference hash=$lastpush_hash\n";
     my $hash;
     if (defined $dsc_hash) {
-       fail "missing git history even though dsc has hash -".
-           " could not find commit $dsc_hash".
-           " (should be in ".access_giturl()."#".rrref().")"
+       fail "missing remote git history even though dsc has hash -".
+           " could not find ref ".lrref().
+           " (should have been fetched from ".access_giturl()."#".rrref().")"
            unless $lastpush_hash;
        $hash = $dsc_hash;
        ensure_we_have_orig();
@@ -916,7 +1212,7 @@ Package not found in the archive, but has allegedly been pushed using dgit.
 $later_warning_msg
 END
     } else {
-       print DEBUG "nothing found!\n";
+       printdebug "nothing found!\n";
        if (defined $skew_warning_vsn) {
            print STDERR <<END or die $!;
 
@@ -928,7 +1224,7 @@ END
        }
        return 0;
     }
-    print DEBUG "current hash=$hash\n";
+    printdebug "current hash=$hash\n";
     if ($lastpush_hash) {
        fail "not fast forward on last upload branch!".
            " (archive's version left in DGIT_ARCHIVE)"
@@ -936,13 +1232,13 @@ END
     }
     if (defined $skew_warning_vsn) {
        mkpath '.git/dgit';
-       print DEBUG "SKEW CHECK WANT $skew_warning_vsn\n";
+       printdebug "SKEW CHECK WANT $skew_warning_vsn\n";
        my $clogf = ".git/dgit/changelog.tmp";
        runcmd shell_cmd "exec >$clogf",
            @git, qw(cat-file blob), "$hash:debian/changelog";
        my $gotclogp = parsechangelog("-l$clogf");
        my $got_vsn = getfield $gotclogp, 'Version';
-       print DEBUG "SKEW CHECK GOT $got_vsn\n";
+       printdebug "SKEW CHECK GOT $got_vsn\n";
        if (version_compare_string($got_vsn, $skew_warning_vsn) < 0) {
            print STDERR <<END or die $!;
 
@@ -955,7 +1251,7 @@ END
     }
     if ($lastpush_hash ne $hash) {
        my @upd_cmd = (@git, qw(update-ref -m), 'dgit fetch', lrref(), $hash);
-       if (!$dryrun) {
+       if (act_local()) {
            cmdoutput @upd_cmd;
        } else {
            dryrun_report @upd_cmd;
@@ -967,9 +1263,9 @@ END
 sub clone ($) {
     my ($dstdir) = @_;
     canonicalise_suite();
-    badusage "dry run makes no sense with clone" if $dryrun;
+    badusage "dry run makes no sense with clone" unless act_local();
     mkdir $dstdir or die "$dstdir $!";
-    chdir "$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 $!;
@@ -979,11 +1275,15 @@ sub clone ($) {
     if (check_for_git()) {
        progress "fetching existing git history";
        git_fetch_us();
-       runcmd_ordryrun @git, qw(fetch origin);
+       runcmd_ordryrun_local @git, qw(fetch origin);
     } else {
        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";
 }
@@ -998,7 +1298,7 @@ sub fetch () {
 
 sub pull () {
     fetch();
-    runcmd_ordryrun @git, qw(merge -m),"Merge from $csuite [dgit]",
+    runcmd_ordryrun_local @git, qw(merge -m),"Merge from $csuite [dgit]",
         lrref();
     printdone "fetched to ".lrref()." and merged into HEAD";
 }
@@ -1006,7 +1306,7 @@ sub pull () {
 sub check_not_dirty () {
     return if $ignoredirty;
     my @cmd = (@git, qw(diff --quiet HEAD));
-    printcmd(\*DEBUG,"+",@cmd) if $debug>0;
+    printcmd(\*DEBUG,$debugprefix."+",@cmd) if $debug>0;
     $!=0; $?=0; system @cmd;
     return if !$! && !$?;
     if (!$! && $?==256) {
@@ -1019,25 +1319,20 @@ sub check_not_dirty () {
 sub commit_quilty_patch () {
     my $output = cmdoutput @git, qw(status --porcelain);
     my %adds;
-    my $bad=0;
     foreach my $l (split /\n/, $output) {
        next unless $l =~ m/\S/;
        if ($l =~ m{^(?:\?\?| M) (.pc|debian/patches)}) {
            $adds{$1}++;
-       } else {
-           print STDERR "git status: $l\n";
-           $bad++;
        }
     }
-    fail "unexpected output from git status (is tree clean?)" if $bad;
     if (!%adds) {
        progress "nothing quilty to commit, ok.";
        return;
     }
-    runcmd_ordryrun @git, qw(add), sort keys %adds;
+    runcmd_ordryrun_local @git, qw(add), sort keys %adds;
     my $m = "Commit Debian 3.0 (quilt) metadata";
     progress "$m";
-    runcmd_ordryrun @git, qw(commit -m), $m;
+    runcmd_ordryrun_local @git, qw(commit -m), $m;
 }
 
 sub madformat ($) {
@@ -1055,7 +1350,7 @@ sub push_parse_changelog ($) {
     my ($clogpfn) = @_;
 
     my $clogp = Dpkg::Control::Hash->new();
-    $clogp->load($clogpfn);
+    $clogp->load($clogpfn) or die;
 
     $package = getfield $clogp, 'Source';
     my $cversion = getfield $clogp, 'Version';
@@ -1067,19 +1362,19 @@ sub push_parse_changelog ($) {
     return ($clogp, $cversion, $tag, $dscfn);
 }
 
-sub push_parse_dsc ($$) {
+sub push_parse_dsc ($$$) {
     my ($dscfn,$dscfnwhat, $cversion) = @_;
     $dsc = parsecontrol($dscfn,$dscfnwhat);
     my $dversion = getfield $dsc, 'Version';
     my $dscpackage = getfield $dsc, 'Source';
     ($dscpackage eq $package && $dversion eq $cversion) or
-       fail "$dsc is for $dscpackage $dversion".
+       fail "$dscfn is for $dscpackage $dversion".
            " but debian/changelog is for $package $cversion";
 }
 
-sub push_mktag ($$$$$$$$) {
+sub push_mktag ($$$$$$$) {
     my ($head,$clogp,$tag,
-       $dsc,$dscfn,
+       $dscfn,
        $changesfile,$changesfilewhat,
        $tfn) = @_;
 
@@ -1093,6 +1388,9 @@ sub push_mktag ($$$$$$$$) {
                " does not match changelog \`$clogp->{$field}'";
     }
 
+    my $cversion = getfield $clogp, 'Version';
+    my $clogsuite = getfield $clogp, 'Distribution';
+
     # 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;
@@ -1103,7 +1401,7 @@ type commit
 tag $tag
 tagger $authline
 
-$package release $cversion for $csuite [dgit]
+$package release $cversion for $clogsuite ($csuite) [dgit]
 END
     close TO or die $!;
 
@@ -1117,7 +1415,7 @@ END
        push @sign_cmd, qw(-u),$keyid if defined $keyid;
        push @sign_cmd, $tfn->('.tmp');
        runcmd_ordryrun @sign_cmd;
-       if (!$dryrun) {
+       if (act_scary()) {
            $tagobjfn = $tfn->('.signed.tmp');
            runcmd shell_cmd "exec >$tagobjfn", qw(cat --),
                $tfn->('.tmp'), $tfn->('.tmp.asc');
@@ -1127,10 +1425,23 @@ END
     return ($tagobjfn);
 }
 
+sub sign_changes ($) {
+    my ($changesfile) = @_;
+    if ($sign) {
+       my @debsign_cmd = @debsign;
+       push @debsign_cmd, "-k$keyid" if defined $keyid;
+       push @debsign_cmd, "-p$gpg[0]" if $gpg[0] ne 'gpg';
+       push @debsign_cmd, $changesfile;
+       runcmd_ordryrun @debsign_cmd;
+    }
+}
+
 sub dopush () {
-    print DEBUG "actually entering push\n";
+    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);
 
@@ -1139,32 +1450,38 @@ sub dopush () {
     my ($clogp, $cversion, $tag, $dscfn) =
        push_parse_changelog("$clogpfn");
 
-    stat "../$dscfn" or
+    my $dscpath = "$buildproductsdir/$dscfn";
+    stat $dscpath or
        fail "looked for .dsc $dscfn, but $!;".
            " maybe you forgot to build";
 
-    responder_send_file('dsc', "../$dscfn");
+    responder_send_file('dsc', $dscpath);
 
-    push_parse_dsc("../$dscfn", $dscfn, $cversion);
+    push_parse_dsc($dscpath, $dscfn, $cversion);
 
     my $format = getfield $dsc, 'Format';
-    print DEBUG "format $format\n";
+    printdebug "format $format\n";
     if (madformat($format)) {
        commit_quilty_patch();
     }
     check_not_dirty();
-    chdir $ud or die $!;
+    changedir $ud;
     progress "checking that $dscfn corresponds to HEAD";
-    runcmd qw(dpkg-source -x --), "../../../../$dscfn";
+    runcmd qw(dpkg-source -x --),
+        $dscpath =~ m#^/# ? $dscpath : "../../../$dscpath";
     my ($tree,$dir) = mktree_in_ud_from_only_subdir();
-    chdir '../../../..' or die $!;
-    printcmd \*DEBUG,"+",@_;
-    my @diffcmd = (@git, qw(diff --exit-code), $tree);
+    changedir '../../../..';
+    my $diffopt = $debug>0 ? '--exit-code' : '--quiet';
+    my @diffcmd = (@git, qw(diff), $diffopt, $tree);
+    printcmd \*DEBUG,$debugprefix."+",@diffcmd;
     $!=0; $?=0;
-    if (system @diffcmd) {
-       if ($! && $?==256) {
+    my $r = system @diffcmd;
+    if ($r) {
+       if ($r==256) {
            fail "$dscfn specifies a different tree to your HEAD commit;".
-               " perhaps you forgot to build";
+               " perhaps you forgot to build".
+               ($diffopt eq '--exit-code' ? "" :
+                " (run with -D to see full diff output)");
        } else {
            failedcmd @diffcmd;
        }
@@ -1177,65 +1494,68 @@ sub dopush () {
 #        (uploadbranch());
     my $head = rev_parse('HEAD');
     if (!$changesfile) {
-       my $multi = "../${package}_".(stripepoch $cversion)."_multi.changes";
+       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 "../$pat";
+           my @cs = glob "$buildproductsdir/$pat";
            fail "failed to find unique changes file".
-               " (looked for $pat in .., or $multi);".
+               " (looked for $pat in $buildproductsdir, or $multi);".
                " perhaps you need to use dgit -C"
                unless @cs==1;
            ($changesfile) = @cs;
        }
+    } else {
+       $changesfile = "$buildproductsdir/$changesfile";
     }
 
-    responder_send_file('changes',$changesfn);
+    responder_send_file('changes',$changesfile);
+    responder_send_command("param head $head");
+    responder_send_command("param csuite $csuite");
 
     my $tfn = sub { ".git/dgit/tag$_[0]"; };
-    my ($tagobjfn) =
-       $we_are_responder
-       ? responder_receive_files('signed-tag', $tfn->('.signed.tmp'))
-       : push_mktag($head,$clogp,$tag,
-                    $dsc,"../$dscfn",
-                    $changesfile,$changesfile,
-                                $tfn);
+    my $tagobjfn;
+
+    if ($we_are_responder) {
+       $tagobjfn = $tfn->('.signed.tmp');
+       responder_receive_files('signed-tag', $tagobjfn);
+    } else {
+       $tagobjfn =
+           push_mktag($head,$clogp,$tag,
+                      $dscpath,
+                      $changesfile,$changesfile,
+                      $tfn);
+    }
 
     my $tag_obj_hash = cmdoutput @git, qw(hash-object -w -t tag), $tagobjfn;
     runcmd_ordryrun @git, qw(verify-tag), $tag_obj_hash;
-    runcmd_ordryrun @git, qw(update-ref), "refs/tags/$tag", $tag_obj_hash;
+    runcmd_ordryrun_local @git, qw(update-ref), "refs/tags/$tag", $tag_obj_hash;
     runcmd_ordryrun @git, qw(tag -v --), $tag;
 
     if (!check_for_git()) {
        create_remote_git_repo();
     }
-    runcmd_ordryrun @git, qw(push),access_giturl(),"HEAD:".rrref();
+    runcmd_ordryrun @git, qw(push),access_giturl(),
+        "HEAD:".rrref(), "refs/tags/$tag";
     runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), 'HEAD';
 
-    if (!$we_are_responder) {
-       if (!$dryrun) {
-           rename "../$dscfn.tmp","../$dscfn" or die "$dscfn $!";
+    if ($we_are_responder) {
+       my $dryrunsuffix = act_local() ? "" : ".tmp";
+       responder_receive_files('signed-dsc-changes',
+                               "$dscpath$dryrunsuffix",
+                               "$changesfile$dryrunsuffix");
+    } else {
+       if (act_local()) {
+           rename "$dscpath.tmp",$dscpath or die "$dscfn $!";
        } else {
-           progress "[new .dsc left in $dscfn.tmp]";
+           progress "[new .dsc left in $dscpath.tmp]";
        }
+       sign_changes $changesfile;
     }
 
-    if ($sign) {
-       if ($we_are_responder) {
-           my $dryrunsuffix = $dryrun ? ".tmp" : "";
-           responder_receive_files('signed-changes-dsc',
-                                   "$changesfile$dryrunsuffix",
-                                   "../$dscfn$dryrunsuffix");
-       } else {
-           my @debsign_cmd = @debsign;
-           push @debsign_cmd, "-k$keyid" if defined $keyid;
-           push @debsign_cmd, $changesfile;
-           runcmd_ordryrun @debsign_cmd;
-       }
-    }
-    runcmd_ordryrun @git, qw(push),access_giturl(),"refs/tags/$tag";
     my $host = access_cfg('upload-host','RETURN-UNDEF');
     my @hostarg = defined($host) ? ($host,) : ();
     runcmd_ordryrun @dput, @hostarg, $changesfile;
@@ -1261,7 +1581,28 @@ sub cmd_clone {
        badusage "incorrect arguments to dgit clone";
     }
     $dstdir ||= "$package";
+
+    if (stat $dstdir) {
+       fail "$dstdir already exists";
+    } elsif ($! != &ENOENT) {
+       die "$dstdir: $!";
+    }
+
+    my $cwd_remove;
+    if ($rmonerror && !$dryrun_level) {
+       $cwd_remove= getcwd();
+       unshift @end, sub { 
+           return unless defined $cwd_remove;
+           if (!chdir "$cwd_remove") {
+               return if $!==&ENOENT;
+               die "chdir $cwd_remove: $!";
+           }
+           rmtree($dstdir) or die "remove $dstdir: $!\n";
+       };
+    }
+
     clone($dstdir);
+    $cwd_remove = undef;
 }
 
 sub branchsuite () {
@@ -1337,7 +1678,7 @@ sub cmd_push {
        is_fast_fwd(lrref(), 'HEAD') or
            fail "dgit push: HEAD is not a descendant".
                " of the archive's version.\n".
-               "$us: To overwrite it, use git-merge -s ours ".lrref().".";
+               "$us: To overwrite it, use git merge -s ours ".lrref().".";
     } else {
        $new_package or
            fail "package appears to be new in this suite;".
@@ -1354,22 +1695,39 @@ sub cmd_remote_push_responder {
     @ARGV = @ARGV[$nrargs..$#ARGV];
     die unless @rargs;
     my ($dir) = @rargs;
-    chdir $dir or die "$dir: $!";
-    $we_are_remote = 1;
-    $|=1;
+    $debugprefix = ' ';
+    $we_are_responder = 1;
+
+    open PI, "<&STDIN" or die $!;
+    open STDIN, "/dev/null" or die $!;
+    open PO, ">&STDOUT" or die $!;
+    autoflush PO 1;
+    open STDOUT, ">&STDERR" or die $!;
+    autoflush STDOUT 1;
+
     responder_send_command("dgit-remote-push-ready");
+
+    changedir $dir;
     &cmd_push;
 }
 
 our $i_tmp;
+our $i_child_pid;
 
 sub i_cleanup {
     local ($@);
-    return unless defined $i_tmp;
-    chdir "/" or die $!;
-    eval { rmtree $i_tmp; };
+    if ($i_child_pid) {
+       printdebug "(killing remote child $i_child_pid)\n";
+       kill 15, $i_child_pid;
+    }
+    if (defined $i_tmp && !defined $initiator_tempdir) {
+       changedir "/";
+       eval { rmtree $i_tmp; };
+    }
 }
 
+END { i_cleanup(); }
+
 sub i_method {
     my ($base,$selector,@args) = @_;
     $selector =~ s/\-/_/g;
@@ -1388,25 +1746,130 @@ sub cmd_rpush {
     $dir =~ s{^-}{./-};
     my @rargs = ($dir);
     my @rdgit;
-    push @rdgit, @dgit
+    push @rdgit, @dgit;
     push @rdgit, @ropts;
-    push @rdgit, (scalar @rargs), @rargs;
+    push @rdgit, qw(remote-push-responder), (scalar @rargs), @rargs;
     push @rdgit, @ARGV;
     my @cmd = (@ssh, $host, shellquote @rdgit);
-    my $pid = open2(\*RO, \*RI, @cmd);
-    eval {
+    printcmd \*DEBUG,$debugprefix."+",@cmd;
+
+    if (defined $initiator_tempdir) {
+       rmtree $initiator_tempdir;
+       mkdir $initiator_tempdir, 0700 or die "$initiator_tempdir: $!";
+       $i_tmp = $initiator_tempdir;
+    } else {
        $i_tmp = tempdir();
-       chdir $i_tmp or die "$i_tmp $!";
-       initiator_expect { m/^dgit-remote-push-ready/ };
-       for (;;) {
-           initiator_expect { m/^(\S+)(?: (.*))?$/ };
-           my ($icmd,$iargs) = ($1, $2);
-           i_method "i_resp_", $icmd, $iargs;
-       }
-    };
+    }
+    $i_child_pid = open2(\*RO, \*RI, @cmd);
+    changedir $i_tmp;
+    initiator_expect { m/^dgit-remote-push-ready/ };
+    for (;;) {
+       my ($icmd,$iargs) = initiator_expect {
+           m/^(\S+)(?: (.*))?$/;
+           ($1,$2);
+       };
+       i_method "i_resp", $icmd, $iargs;
+    }
+}
+
+sub i_resp_progress ($) {
+    my ($rhs) = @_;
+    my $msg = protocol_read_bytes \*RO, $rhs;
+    progress $msg;
+}
+
+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";
+    my $got = waitpid $pid, 0;
+    die $! unless $got == $pid;
+    die "remote child failed $?" if $?;
+
     i_cleanup();
-    die $@;
+    printdebug "all done\n";
+    exit 0;
+}
+
+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";
+    protocol_receive_file \*RO, $localpath;
+    i_method "i_file", $keyword;
+}
+
+our %i_param;
+
+sub i_resp_param ($) {
+    $_[0] =~ m/^(\S+) (.*)$/ or badproto \*RO, "bad param spec";
+    $i_param{$1} = $2;
+}
+
+our %i_wanted;
+
+sub i_resp_want ($) {
+    my ($keyword) = @_;
+    die "$keyword ?" if $i_wanted{$keyword}++;
+    my @localpaths = i_method "i_want", $keyword;
+    printdebug "[[  $keyword @localpaths\n";
+    foreach my $localpath (@localpaths) {
+       protocol_send_file \*RI, $localpath;
     }
+    print RI "files-end\n" or die $!;
+}
+
+our ($i_clogp, $i_version, $i_tag, $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) =
+       push_parse_changelog "$i_tmp/remote-changelog.822";
+    die if $i_dscfn =~ m#/|^\W#;
+}
+
+sub i_localname_dsc {
+    defined $i_dscfn or badproto \*RO, "dsc (before parsed-changelog)";
+    return $i_dscfn;
+}
+sub i_file_dsc { }
+
+sub i_localname_changes {
+    defined $i_dscfn or badproto \*RO, "dsc (before parsed-changelog)";
+    $i_changesfn = $i_dscfn;
+    $i_changesfn =~ s/\.dsc$/_dgit.changes/ or die;
+    return $i_changesfn;
+}
+sub i_file_changes { }
+
+sub i_want_signed_tag {
+    printdebug Dumper(\%i_param, $i_dscfn);
+    defined $i_param{'head'} && defined $i_dscfn && defined $i_clogp
+       && defined $i_param{'csuite'}
+       or badproto \*RO, "premature desire for signed-tag";
+    my $head = $i_param{'head'};
+    die if $head =~ m/[^0-9a-f]/ || $head !~ m/^../;
+
+    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]"; };
+
+    return $tagobjfn;
+}
+
+sub i_want_signed_dsc_changes {
+    rename "$i_dscfn.tmp","$i_dscfn" or die "$i_dscfn $!";
+    sign_changes $i_changesfn;
+    return ($i_dscfn, $i_changesfn);
 }
 
 #---------- building etc. ----------
@@ -1427,6 +1890,17 @@ sub build_maybe_quilt_fixup () {
     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.";
+    }
+
     my $clogp = parsechangelog();
     my $version = getfield $clogp, 'Version';
     my $author = getfield $clogp, 'Maintainer';
@@ -1455,7 +1929,7 @@ END
        local $ENV{'EDITOR'} = cmdoutput qw(realpath --), $0;
        local $ENV{'VISUAL'} = $ENV{'EDITOR'};
        local $ENV{$fakeeditorenv} = cmdoutput qw(realpath --), $descfn;
-       runcmd_ordryrun @dpkgsource, qw(--commit .), $patchname;
+       runcmd_ordryrun_local @dpkgsource, qw(--commit .), $patchname;
     }
 
     if (!open P, '>>', ".pc/applied-patches") {
@@ -1486,9 +1960,26 @@ sub quilt_fixup_editor () {
     exit 0;
 }
 
+sub clean_tree () {
+    if ($cleanmode eq 'dpkg-source') {
+       runcmd_ordryrun_local @dpkgbuildpackage, qw(-T clean);
+    } elsif ($cleanmode eq 'git') {
+       runcmd_ordryrun_local @git, qw(clean -xdf);
+    } elsif ($cleanmode eq 'none') {
+    } else {
+       die "$cleanmode ?";
+    }
+}
+
+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();
+    clean_tree();
     my $clogp = parsechangelog();
     $isuite = getfield $clogp, 'Distribution';
     $package = getfield $clogp, 'Source';
@@ -1496,17 +1987,40 @@ sub build_prep () {
     build_maybe_quilt_fixup();
 }
 
+sub changesopts () {
+    my @opts =@changesopts[1..$#changesopts];
+    if (!defined $changes_since_version) {
+       my @vsns = archive_query('archive_query');
+       my @quirk = access_quirk();
+       if ($quirk[0] eq 'backports') {
+           local $isuite = $quirk[2];
+           local $csuite;
+           canonicalise_suite();
+           push @vsns, archive_query('archive_query');
+       }
+       if (@vsns) {
+           @vsns = map { $_->[0] } @vsns;
+           @vsns = sort { -version_compare_string($a, $b) } @vsns;
+           $changes_since_version = $vsns[0];
+           progress "changelog will contain changes since $vsns[0]";
+       } else {
+           $changes_since_version = '_';
+           progress "package seems new, not specifying -v<version>";
+       }
+    }
+    if ($changes_since_version ne '_') {
+       unshift @opts, "-v$changes_since_version";
+    }
+    return @opts;
+}
+
 sub cmd_build {
-    badusage "dgit build implies --clean=dpkg-source"
-       if $cleanmode ne 'dpkg-source';
     build_prep();
-    runcmd_ordryrun @dpkgbuildpackage, qw(-us -uc), changesopts(), @ARGV;
+    runcmd_ordryrun_local @dpkgbuildpackage, qw(-us -uc), changesopts(), @ARGV;
     printdone "build successful\n";
 }
 
 sub cmd_git_build {
-    badusage "dgit git-build implies --clean=dpkg-source"
-       if $cleanmode ne 'dpkg-source';
     build_prep();
     my @cmd =
        (qw(git-buildpackage -us -uc --git-no-sign-tags),
@@ -1516,7 +2030,7 @@ sub cmd_git_build {
        push @cmd, "--git-debian-branch=".lbranch();
     }
     push @cmd, changesopts();
-    runcmd_ordryrun @cmd, @ARGV;
+    runcmd_ordryrun_local @cmd, @ARGV;
     printdone "build successful\n";
 }
 
@@ -1525,20 +2039,15 @@ sub build_source {
     $sourcechanges = "${package}_".(stripepoch $version)."_source.changes";
     $dscfn = dscfn($version);
     if ($cleanmode eq 'dpkg-source') {
-       runcmd_ordryrun (@dpkgbuildpackage, qw(-us -uc -S)), changesopts();
+       runcmd_ordryrun_local (@dpkgbuildpackage, qw(-us -uc -S)),
+           changesopts();
     } else {
-       if ($cleanmode eq 'git') {
-           runcmd_ordryrun @git, qw(clean -xdf);
-       } elsif ($cleanmode eq 'none') {
-       } else {
-           die "$cleanmode ?";
-       }
-       my $pwd = cmdoutput qw(env - pwd);
+       my $pwd = must_getcwd();
        my $leafdir = basename $pwd;
-       chdir ".." or die $!;
-       runcmd_ordryrun @dpkgsource, qw(-b --), $leafdir;
-       chdir $pwd or die $!;
-       runcmd_ordryrun qw(sh -ec),
+       changedir "..";
+       runcmd_ordryrun_local @dpkgsource, qw(-b --), $leafdir;
+       changedir $pwd;
+       runcmd_ordryrun_local qw(sh -ec),
            'exec >$1; shift; exec "$@"','x',
            "../$sourcechanges",
            @dpkggenchanges, qw(-S), changesopts();
@@ -1553,9 +2062,9 @@ sub cmd_build_source {
 
 sub cmd_sbuild {
     build_source();
-    chdir ".." or die $!;
+    changedir "..";
     my $pat = "${package}_".(stripepoch $version)."_*.changes";
-    if (!$dryrun) {
+    if (act_local()) {
        stat $dscfn or fail "$dscfn (in parent directory): $!";
        stat $sourcechanges or fail "$sourcechanges (in parent directory): $!";
        foreach my $cf (glob $pat) {
@@ -1563,10 +2072,17 @@ sub cmd_sbuild {
            unlink $cf or fail "remove $cf: $!";
        }
     }
-    runcmd_ordryrun @sbuild, @ARGV, qw(-d), $isuite, $dscfn;
-    runcmd_ordryrun @mergechanges, glob $pat;
+    runcmd_ordryrun_local @sbuild, @ARGV, qw(-d), $isuite, $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;
+    runcmd_ordryrun_local @mergechanges, @changesfiles;
     my $multichanges = "${package}_".(stripepoch $version)."_multi.changes";
-    if (!$dryrun) {
+    if (act_local()) {
        stat $multichanges or fail "$multichanges: $!";
     }
     printdone "build successful, results in $multichanges\n" or die $!;
@@ -1588,6 +2104,13 @@ sub cmd_version {
 
 sub parseopts () {
     my $om;
+
+    if (defined $ENV{'DGIT_SSH'}) {
+       @ssh = string_to_ssh $ENV{'DGIT_SSH'};
+    } elsif (defined $ENV{'GIT_SSH'}) {
+       @ssh = ($ENV{'GIT_SSH'});
+    }
+
     while (@ARGV) {
        last unless $ARGV[0] =~ m/^-/;
        $_ = shift @ARGV;
@@ -1595,7 +2118,10 @@ sub parseopts () {
        if (m/^--/) {
            if (m/^--dry-run$/) {
                push @ropts, $_;
-               $dryrun=1;
+               $dryrun_level=2;
+           } elsif (m/^--damp-run$/) {
+               push @ropts, $_;
+               $dryrun_level=1;
            } elsif (m/^--no-sign$/) {
                push @ropts, $_;
                $sign=0;
@@ -1606,21 +2132,33 @@ sub parseopts () {
            } elsif (m/^--new$/) {
                push @ropts, $_;
                $new_package=1;
-           } elsif (m/^--(\w+)=(.*)/s &&
+           } elsif (m/^--since-version=([^_]+|_)$/) {
+               push @ropts, $_;
+               $changes_since_version = $1;
+           } elsif (m/^--([-0-9a-z]+)=(.*)/s &&
                     ($om = $opts_opt_map{$1}) &&
                     length $om->[0]) {
                push @ropts, $_;
                $om->[0] = $2;
-           } elsif (m/^--(\w+):(.*)/s &&
+           } elsif (m/^--([-0-9a-z]+):(.*)/s &&
+                    !$opts_opt_cmdonly{$1} &&
                     ($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;
@@ -1632,46 +2170,59 @@ sub parseopts () {
            } elsif (m/^--no-quilt-fixup$/s) {
                push @ropts, $_;
                $noquilt = 1;
+           } elsif (m/^--no-rm-on-error$/s) {
+               push @ropts, $_;
+               $rmonerror = 0;
            } else {
                badusage "unknown long option \`$_'";
            }
        } else {
            while (m/^-./s) {
                if (s/^-n/-/) {
-                   push @ropts, $_;
-                   $dryrun=1;
+                   push @ropts, $&;
+                   $dryrun_level=2;
+               } elsif (s/^-L/-/) {
+                   push @ropts, $&;
+                   $dryrun_level=1;
                } elsif (s/^-h/-/) {
                    cmd_help();
                } elsif (s/^-D/-/) {
-                   push @ropts, $_;
+                   push @ropts, $&;
                    open DEBUG, ">&STDERR" or die $!;
+                   autoflush DEBUG 1;
                    $debug++;
                } elsif (s/^-N/-/) {
-                   push @ropts, $_;
+                   push @ropts, $&;
                    $new_package=1;
-               } elsif (m/^-[vm]/) {
-                   push @ropts, $_;
+               } elsif (s/^-v([^_]+|_)$//s) {
+                   push @ropts, $&;
+                   $changes_since_version = $1;
+               } elsif (m/^-m/) {
+                   push @ropts, $&;
                    push @changesopts, $_;
                    $_ = '';
                } elsif (s/^-c(.*=.*)//s) {
-                   push @ropts, $_;
+                   push @ropts, $&;
                    push @git, '-c', $1;
                } elsif (s/^-d(.*)//s) {
-                   push @ropts, $_;
+                   push @ropts, $&;
                    $idistro = $1;
                } elsif (s/^-C(.*)//s) {
-                   push @ropts, $_;
+                   push @ropts, $&;
                    $changesfile = $1;
+                   if ($changesfile =~ s#^(.*)/##) {
+                       $buildproductsdir = $1;
+                   }
                } elsif (s/^-k(.*)//s) {
                    $keyid=$1;
                } elsif (s/^-wn//s) {
-                   push @ropts, $_;
+                   push @ropts, $&;
                    $cleanmode = 'none';
                } elsif (s/^-wg//s) {
-                   push @ropts, $_;
+                   push @ropts, $&;
                    $cleanmode = 'git';
                } elsif (s/^-wd//s) {
-                   push @ropts, $_;
+                   push @ropts, $&;
                    $cleanmode = 'dpkg-source';
                } else {
                    badusage "unknown short option \`$_'";
@@ -1685,14 +2236,17 @@ if ($ENV{$fakeeditorenv}) {
     quilt_fixup_editor();
 }
 
-delete $ENV{'DGET_UNPACK'};
-
 parseopts();
-print STDERR "DRY RUN ONLY\n" if $dryrun;
+print STDERR "DRY RUN ONLY\n" if $dryrun_level > 1;
+print STDERR "DAMP RUN - WILL MAKE LOCAL (UNSIGNED) CHANGES\n"
+    if $dryrun_level == 1;
 if (!@ARGV) {
     print STDERR $helpmsg or die $!;
     exit 8;
 }
 my $cmd = shift @ARGV;
 $cmd =~ y/-/_/;
-{ no strict qw(refs); &{"cmd_$cmd"}(); }
+
+my $fn = ${*::}{"cmd_$cmd"};
+$fn or badusage "unknown operation $cmd";
+$fn->();