X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=e12bfdc86b6b0d78a647110388a407d41b1bdba1;hp=b1ed90447748bb25d95f75f9575badc26e00aa08;hb=63b3ec362791edff468f2f3b70240c94eb306b4b;hpb=41e0ec2b26cba9b3d4016b195ec8795ca1bd40f4

diff --git a/dgit b/dgit
index b1ed9044..e12bfdc8 100755
--- a/dgit
+++ b/dgit
@@ -46,6 +46,7 @@ our $noquilt = 0;
 our $existing_package = 'dpkg';
 our $cleanmode = 'dpkg-source';
 our $we_are_responder;
+our $initiator_tempdir;
 
 our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
 
@@ -115,7 +116,7 @@ sub dscfn ($) {
 sub changesopts () { return @changesopts[1..$#changesopts]; }
 
 our $us = 'dgit';
-our $debugprefix = ' ';
+our $debugprefix = '';
 
 sub printdebug { print DEBUG $debugprefix, @_ or die $!; }
 
@@ -133,6 +134,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:
@@ -223,9 +230,9 @@ sub protocol_receive_file ($$) {
 	my ($y,$l) = protocol_expect {
 	    m/^data-block (.*})$|data-end$/;
 	    length $1 ? (1,$1) : (0);
-	} \*STDIN;
+	} $fh;
 	last unless $y;
-	my $d = protocol_read_bytes \*STDIN, $1;
+	my $d = protocol_read_bytes $fh, $1;
 	print PF $d or die $!;
     }
     printdebug "received into $ourfn\n";
@@ -714,7 +721,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);
@@ -781,7 +788,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$#;
@@ -847,7 +854,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;
@@ -1021,7 +1028,7 @@ sub clone ($) {
     canonicalise_suite();
     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 $!;
@@ -1213,11 +1220,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;
@@ -1410,9 +1417,9 @@ 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 = ' ';
+    changedir $dir;
+    $we_are_responder = 1;
     autoflush STDOUT 1;
     responder_send_command("dgit-remote-push-ready");
     &cmd_push;
@@ -1423,7 +1430,8 @@ our $i_tmp;
 sub i_cleanup {
     local ($@);
     return unless defined $i_tmp;
-    chdir "/" or die $!;
+    return if defined $initiator_tempdir;
+    changedir "/";
     eval { rmtree $i_tmp; };
 }
 
@@ -1452,9 +1460,15 @@ sub cmd_rpush {
     my @cmd = (@ssh, $host, shellquote @rdgit);
     printcmd \*DEBUG,$debugprefix."+",@cmd;
     eval {
-	$i_tmp = tempdir();
+	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 $!";
+	changedir $i_tmp;
 	initiator_expect { m/^dgit-remote-push-ready/ };
 	for (;;) {
 	    my ($icmd,$iargs) = initiator_expect {
@@ -1667,9 +1681,9 @@ sub build_source {
 	}
 	my $pwd = cmdoutput qw(env - pwd);
 	my $leafdir = basename $pwd;
-	chdir ".." or die $!;
+	changedir "..";
 	runcmd_ordryrun_local @dpkgsource, qw(-b --), $leafdir;
-	chdir $pwd or die $!;
+	changedir $pwd;
 	runcmd_ordryrun_local qw(sh -ec),
 	    'exec >$1; shift; exec "$@"','x',
 	    "../$sourcechanges",
@@ -1685,7 +1699,7 @@ sub cmd_build_source {
 
 sub cmd_sbuild {
     build_source();
-    chdir ".." or die $!;
+    changedir "..";
     my $pat = "${package}_".(stripepoch $version)."_*.changes";
     if (act_local()) {
 	stat $dscfn or fail "$dscfn (in parent directory): $!";
@@ -1761,6 +1775,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;