X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=0f372f21a3b33c690c1a1a5a7004da788f98a08f;hp=b6d815870165667d72513da46194b0dea42c2dfc;hb=6bd3129e4a21d8eeb44442f078d81187aa388ba0;hpb=863475c001c7846fe4de4310f517207bd8178871

diff --git a/dgit b/dgit
index b6d81587..0f372f21 100755
--- a/dgit
+++ b/dgit
@@ -38,14 +38,16 @@ our $package;
 our @ropts;
 
 our $sign = 1;
-our $dryrun = 0;
+our $dryrun_level = 0;
 our $changesfile;
 our $new_package = 0;
 our $ignoredirty = 0;
 our $noquilt = 0;
 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)");
 
@@ -83,6 +85,8 @@ 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';
@@ -110,14 +114,14 @@ sub dscfn ($) {
     return "${package}_".(stripepoch $vsn).".dsc";
 }
 
-sub changesopts () { return @changesopts[1..$#changesopts]; }
-
 our $us = 'dgit';
-our $debugprefix = ' ';
+our $debugprefix = '';
 
 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; }
 
@@ -131,6 +135,12 @@ 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:
@@ -171,7 +181,6 @@ 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";
 }
 
@@ -197,17 +206,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";
@@ -216,17 +226,19 @@ sub protocol_read_bytes ($$) {
 
 sub protocol_receive_file ($$) {
     my ($fh, $ourfn) = @_;
+    printdebug "() $ourfn\n";
     open PF, ">", $ourfn or die "$ourfn: $!";
     for (;;) {
 	my ($y,$l) = protocol_expect {
-	    m/^data-block (.*})$|data-end$/;
-	    length $1 ? (1,$1) : (0);
-	} \*STDIN;
+	    m/^data-block (.*)$/ ? (1,$1) :
+	    m/^data-end$/ ? (0,) :
+	    ();
+	} $fh;
 	last unless $y;
-	my $d = protocol_read_bytes \*STDIN, $1;
+	my $d = protocol_read_bytes $fh, $l;
 	print PF $d or die $!;
     }
-    printdebug "received into $ourfn\n";
+    close PF or die $!;
 }
 
 #---------- remote protocol support, responder ----------
@@ -235,27 +247,28 @@ sub responder_send_command ($) {
     my ($command) = @_;
     return unless $we_are_responder;
     # called even without $we_are_responder
-    printdebug "<< $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;
-    printdebug "[[ $keyword $ourfn\n";
+    printdebug "]] $keyword $ourfn\n";
     responder_send_command "file $keyword";
-    protocol_send_file \*STDOUT, $ourfn;
+    protocol_send_file \*PO, $ourfn;
 }
 
 sub responder_receive_files ($@) {
     my ($keyword, @ourfns) = @_;
     die unless $we_are_responder;
-    printdebug "]] $keyword @ourfns\n";
+    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 { m/^files-end$/ } \*STDIN;
+    printdebug "[[\$\n";
+    protocol_expect { m/^files-end$/ } \*PI;
 }
 
 #---------- remote protocol support, initiator ----------
@@ -271,7 +284,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";
     }
@@ -299,7 +312,8 @@ sub shellquote {
     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, $_;
@@ -335,8 +349,11 @@ sub runcmd {
     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)";
@@ -369,7 +386,15 @@ sub dryrun_report {
 }
 
 sub runcmd_ordryrun {
-    if (!$dryrun) {
+    if (act_scary()) {
+	runcmd @_;
+    } else {
+	dryrun_report @_;
+    }
+}
+
+sub runcmd_ordryrun_local {
+    if (act_local()) {
 	runcmd @_;
     } else {
 	dryrun_report @_;
@@ -391,6 +416,7 @@ main usages:
 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)
@@ -424,9 +450,8 @@ 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' => 'coccia.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/');
 
@@ -538,6 +563,23 @@ 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 '';
+    }
+}
+
 our %rmad;
 
 sub archive_query ($) {
@@ -546,9 +588,9 @@ sub archive_query ($) {
     if (!defined $query) {
 	my $distro = access_distro();
 	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";
 	}
@@ -559,6 +601,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';
@@ -568,28 +616,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;
@@ -608,14 +634,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".
@@ -624,12 +649,77 @@ 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 die "$! $?";
+    @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
+          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;
+    @rows = map {
+	my ($vsn,$component,$filename) = @$_;
+	[ $vsn, "/pool/$component/$filename" ];
+    } @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 () {
     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";
     }
 }
@@ -700,7 +790,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);
@@ -767,7 +857,7 @@ sub clogp_authline ($) {
 
 sub generate_commit_from_dsc () {
     prep_ud();
-    chdir $ud or die $!;
+    changedir $ud;
     my @files;
     foreach my $f (dsc_files()) {
 	die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#;
@@ -833,7 +923,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;
@@ -865,7 +955,7 @@ sub ensure_we_have_orig () {
 	$origurl .= "/$f";
 	die "$f ?" unless $f =~ m/^${package}_/;
 	die "$f ?" if $f =~ m#/#;
-	runcmd_ordryrun shell_cmd 'cd ..', @dget,'--',$origurl;
+	runcmd_ordryrun_local shell_cmd 'cd ..', @dget,'--',$origurl;
     }
 }
 
@@ -886,7 +976,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 () {
@@ -910,22 +1000,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 $!";
-    }
+    $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();
@@ -993,7 +1074,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;
@@ -1005,9 +1086,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 $!;
@@ -1017,7 +1098,7 @@ 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";
     }
@@ -1036,7 +1117,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";
 }
@@ -1057,25 +1138,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 ($) {
@@ -1093,7 +1169,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';
@@ -1111,13 +1187,13 @@ sub push_parse_dsc ($$$) {
     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) = @_;
 
@@ -1132,6 +1208,7 @@ sub push_mktag ($$$$$$$$) {
     }
 
     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
@@ -1143,7 +1220,7 @@ type commit
 tag $tag
 tagger $authline
 
-$package release $cversion for $csuite [dgit]
+$package release $cversion for $clogsuite [dgit]
 END
     close TO or die $!;
 
@@ -1157,7 +1234,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');
@@ -1204,11 +1281,11 @@ sub dopush () {
 	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";
     my ($tree,$dir) = mktree_in_ud_from_only_subdir();
-    chdir '../../../..' or die $!;
+    changedir '../../../..';
     my @diffcmd = (@git, qw(diff --exit-code), $tree);
     printcmd \*DEBUG,$debugprefix."+",@diffcmd;
     $!=0; $?=0;
@@ -1244,19 +1321,25 @@ sub dopush () {
     }
 
     responder_send_file('changes',$changesfile);
+    responder_send_command("param head $head");
 
     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,
+		       "../$dscfn",
+		       $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()) {
@@ -1266,7 +1349,7 @@ sub dopush () {
     runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), 'HEAD';
 
     if (!$we_are_responder) {
-	if (!$dryrun) {
+	if (act_local()) {
 	    rename "../$dscfn.tmp","../$dscfn" or die "$dscfn $!";
 	} else {
 	    progress "[new .dsc left in $dscfn.tmp]";
@@ -1274,7 +1357,7 @@ sub dopush () {
     }
 
     if ($we_are_responder) {
-	my $dryrunsuffix = $dryrun ? ".tmp" : "";
+	my $dryrunsuffix = act_local() ? "" : ".tmp";
 	responder_receive_files('signed-dsc-changes',
 				"../$dscfn$dryrunsuffix",
 				"$changesfile$dryrunsuffix");
@@ -1384,7 +1467,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;".
@@ -1401,23 +1484,39 @@ sub cmd_remote_push_responder {
     @ARGV = @ARGV[$nrargs..$#ARGV];
     die unless @rargs;
     my ($dir) = @rargs;
-    chdir $dir or die "$dir: $!";
-    $we_are_responder = 1;
     $debugprefix = ' ';
-    $|=1;
+    $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;
@@ -1442,21 +1541,24 @@ sub cmd_rpush {
     push @rdgit, @ARGV;
     my @cmd = (@ssh, $host, shellquote @rdgit);
     printcmd \*DEBUG,$debugprefix."+",@cmd;
-    eval {
+
+    if (defined $initiator_tempdir) {
+	rmtree $initiator_tempdir;
+	mkdir $initiator_tempdir, 0700 or die "$initiator_tempdir: $!";
+	$i_tmp = $initiator_tempdir;
+    } else {
 	$i_tmp = tempdir();
-	my $pid = open2(\*RO, \*RI, @cmd);
-	chdir $i_tmp or die "$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;
-	}
-    };
-    i_cleanup();
-    die $@;
+    }
+    $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 ($) {
@@ -1466,7 +1568,15 @@ 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";
+    my $got = waitpid $pid, 0;
+    die $! unless $got == $pid;
+    die "remote child failed $?" if $?;
+
     i_cleanup();
+    printdebug "all done\n";
     exit 0;
 }
 
@@ -1476,12 +1586,13 @@ sub i_resp_file ($) {
     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_param ($) {
-    $_[0] =~ m/^(\S+) (.*)$/;
+sub i_resp_param ($) {
+    $_[0] =~ m/^(\S+) (.*)$/ or badproto \*RO, "bad param spec";
     $i_param{$1} = $2;
 }
 
@@ -1491,44 +1602,60 @@ sub i_resp_want ($) {
     my ($keyword) = @_;
     die "$keyword ?" if $i_wanted{$keyword}++;
     my @localpaths = i_method "i_want", $keyword;
-    printdebug "]]  $keyword @localpaths\n";
+    printdebug "[[  $keyword @localpaths\n";
     foreach my $localpath (@localpaths) {
 	protocol_send_file \*RI, $localpath;
     }
-    print RI "end-files\n" or die $!;
+    print RI "files-end\n" or die $!;
 }
 
-our ($i_clogp, $i_version, $i_tag, $i_dscfn);
+our ($i_clogp, $i_version, $i_tag, $i_dscfn, $i_changesfn);
 
-sub i_localname_parsed_changelog { return "remote-changelog.822"; }
-sub i_localname_changes { return "remote.changes"; }
-sub i_localname_dsc {
+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 'remote-changelog.822';
+	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 {
-    defined $i_param{'head'} && defined $i_dscfn
-	or badproto \*RO, "sequencing error";
+    printdebug Dumper(\%i_param, $i_dscfn);
+    defined $i_param{'head'} && defined $i_dscfn && defined $i_clogp
+	or badproto \*RO, "premature desire for signed-tag";
     my $head = $i_param{'head'};
     die if $head =~ m/[^0-9a-f]/ || $head !~ m/^../;
 
-    push_parse_dsc $i_dscfn, 'remote dsc', 
+    push_parse_dsc $i_dscfn, 'remote dsc', $i_version;
 
-    push_mktag $head, $i_clogp, $i_tag,
-        $dsc, $i_dscfn,
-        'remote.changes', 'remote changes',
-        'tag.tag';
+    my $tagobjfn =
+	push_mktag $head, $i_clogp, $i_tag,
+	    $i_dscfn,
+	    $i_changesfn, 'remote changes',
+	    sub { "tag$_[0]"; };
 
-    return 'tag.tag';
+    return $tagobjfn;
 }
 
 sub i_want_signed_dsc_changes {
     rename "$i_dscfn.tmp","$i_dscfn" or die "$i_dscfn $!";
-    sign_changes 'remote.changes';
-    return ($i_dscfn, 'remote.changes');
+    sign_changes $i_changesfn;
+    return ($i_dscfn, $i_changesfn);
 }
 
 #---------- building etc. ----------
@@ -1577,7 +1704,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") {
@@ -1618,11 +1745,31 @@ 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');
+	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";
 }
 
@@ -1638,7 +1785,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";
 }
 
@@ -1647,20 +1794,21 @@ 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);
+	    runcmd_ordryrun_local @git, qw(clean -xdf);
 	} elsif ($cleanmode eq 'none') {
 	} else {
 	    die "$cleanmode ?";
 	}
 	my $pwd = cmdoutput qw(env - pwd);
 	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();
@@ -1675,9 +1823,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) {
@@ -1685,10 +1833,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 $!;
@@ -1724,7 +1879,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;
@@ -1735,12 +1893,15 @@ 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, $_;
@@ -1748,6 +1909,11 @@ sub parseopts () {
 	    } 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;
@@ -1768,18 +1934,25 @@ sub parseopts () {
 	} 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, $&;
 		    open DEBUG, ">&STDERR" or die $!;
+		    autoflush DEBUG 1;
 		    $debug++;
 		} elsif (s/^-N/-/) {
 		    push @ropts, $&;
 		    $new_package=1;
-		} elsif (m/^-[vm]/) {
+		} elsif (s/^-v([^_]+|_)$//s) {
+		    push @ropts, $&;
+		    $changes_since_version = $1;
+		} elsif (m/^-m/) {
 		    push @ropts, $&;
 		    push @changesopts, $_;
 		    $_ = '';
@@ -1818,7 +1991,9 @@ if ($ENV{$fakeeditorenv}) {
 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;