chiark
/
gitweb
/
~ianmdlvl
/
dgit.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
wip changes for remote push - fixes
[dgit.git]
/
dgit
diff --git
a/dgit
b/dgit
index 66f08c1d87eb6ed1b71c7c1941742cf146ad29da..b551eacd1e9c7a6fa73d49a612b72e1e088efc13 100755
(executable)
--- a/
dgit
+++ b/
dgit
@@
-28,6
+28,7
@@
use File::Basename;
use Dpkg::Version;
use POSIX;
use IPC::Open2;
use Dpkg::Version;
use POSIX;
use IPC::Open2;
+use File::Temp;
our $our_version = 'UNRELEASED'; ###substituted###
our $our_version = 'UNRELEASED'; ###substituted###
@@
-125,7
+126,7
@@
sub fetchspec () {
return "+".rrref().":".lrref();
}
return "+".rrref().":".lrref();
}
-our $ua;
+#---------- remote protocol support, common ----------
# remote push initiator/responder protocol:
# < dgit-remote-push-ready [optional extra info ignored by old initiators]
# remote push initiator/responder protocol:
# < dgit-remote-push-ready [optional extra info ignored by old initiators]
@@
-160,24
+161,6
@@
our $ua;
#
# > complete
#
# > complete
-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 $!;
-}
-
-sub progress {
- if ($we_are_responder) {
- my $m = join '', @_;
- responder_send_command "progress ".length($m) or die $!;
- print $m or die $!;
- } else {
- print @_, "\n";
- }
-}
-
sub badproto ($$) {
my ($fh, $m) = @_;
fail "connection lost: $!" if $fh->error;
sub badproto ($$) {
my ($fh, $m) = @_;
fail "connection lost: $!" if $fh->error;
@@
-209,23
+192,40
@@
sub protocol_send_file ($$) {
close PF;
}
close PF;
}
+sub protocol_read_bytes ($$) {
+ my ($fh, $nbytes) = @_;
+ $nbytes =~ m/^\d{1,6}$/ or badproto \*RO, "bad byte count";
+ my $d;
+ my $got = read $fh, $d, $nbytes;
+ $got==$nbytes or badproto $fh, "eof during data block";
+ return $d;
+}
+
sub protocol_receive_file ($$) {
my ($fh, $ourfn) = @_;
open PF, ">", $ourfn or die "$ourfn: $!";
for (;;) {
sub protocol_receive_file ($$) {
my ($fh, $ourfn) = @_;
open PF, ">", $ourfn or die "$ourfn: $!";
for (;;) {
- protocol_expect \*STDIN, { m/^data-block (
\d{1,6
})$|data-end$/ };
+ protocol_expect \*STDIN, { m/^data-block (
.*
})$|data-end$/ };
length $1 or last;
length $1 or last;
- my $d;
- my $got = read $fh, $d, $1;
- $got==$1 or badproto $fh, "eof during data block";
+ my $d = protocol_read_bytes \*STDIN, $1;
print PF $d or die $!;
}
}
print PF $d or die $!;
}
}
+#---------- remote protocol support, responder ----------
+
+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 $!;
+}
+
sub responder_send_file ($$) {
my ($keyword, $ourfn) = @_;
return unless $we_are_responder;
sub responder_send_file ($$) {
my ($keyword, $ourfn) = @_;
return unless $we_are_responder;
- responder_send_command "file
begin $cmdprefix
";
+ responder_send_command "file
-begin $keyword
";
protocol_send_file \*STDOUT, $ourfn;
}
protocol_send_file \*STDOUT, $ourfn;
}
@@
-239,6
+239,27
@@
sub responder_receive_files ($@) {
protocol_expect \*STDIN, { m/^files-end$/ };
}
protocol_expect \*STDIN, { m/^files-end$/ };
}
+#---------- remote protocol support, initiator ----------
+
+sub initiator_expect (&) {
+ my ($match) = @_;
+ protocol_expect \*RO, &$match;
+}
+
+#---------- end remote code ----------
+
+sub progress {
+ if ($we_are_responder) {
+ my $m = join '', @_;
+ responder_send_command "progress ".length($m) or die $!;
+ print $m or die $!;
+ } else {
+ print @_, "\n";
+ }
+}
+
+our $ua;
+
sub url_get {
if (!$ua) {
$ua = LWP::UserAgent->new();
sub url_get {
if (!$ua) {
$ua = LWP::UserAgent->new();
@@
-1325,6
+1346,8
@@
sub cmd_push {
dopush();
}
dopush();
}
+#---------- remote commands' implementation ----------
+
sub cmd_remote_push_responder {
my ($nrargs) = shift @ARGV;
my (@rargs) = @ARGV[0..$nrargs-1];
sub cmd_remote_push_responder {
my ($nrargs) = shift @ARGV;
my (@rargs) = @ARGV[0..$nrargs-1];
@@
-1338,6
+1361,21
@@
sub cmd_remote_push_responder {
&cmd_push;
}
&cmd_push;
}
+our $i_tmp;
+
+sub i_cleanup {
+ local ($@);
+ return unless defined $i_tmp;
+ chdir "/" or die $!;
+ eval { rmtree $i_tmp; };
+}
+
+sub i_method {
+ my ($base,$selector,@args) = @_;
+ $selector =~ s/\-/_/g;
+ { no strict qw(refs); &{"${base}_${selector}"}(@args); }
+}
+
sub cmd_rpush {
my $host = nextarg;
my $dir;
sub cmd_rpush {
my $host = nextarg;
my $dir;
@@
-1356,15
+1394,23
@@
sub cmd_rpush {
push @rdgit, @ARGV;
my @cmd = (@ssh, $host, shellquote @rdgit);
my $pid = open2(\*RO, \*RI, @cmd);
push @rdgit, @ARGV;
my @cmd = (@ssh, $host, shellquote @rdgit);
my $pid = open2(\*RO, \*RI, @cmd);
- initiator_expect { m/^dgit-remote-push-ready/ };
- for (;;) {
- initiator_expect { m/^(\S+)\s+(.*)$/ };
- my ($icmd,$iargs) = ($1, $2);
- $icmd =~ s/\-/_/g;
- { no strict qw(refs); &{"i_resp_$icmd"}($iargs); }
+ eval {
+ $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_cleanup();
+ die $@;
}
}
}
}
+#---------- building etc. ----------
+
our $version;
our $sourcechanges;
our $dscfn;
our $version;
our $sourcechanges;
our $dscfn;
@@
-1533,6
+1579,8
@@
sub cmd_quilt_fixup {
build_maybe_quilt_fixup();
}
build_maybe_quilt_fixup();
}
+#---------- argument parsing and main program ----------
+
sub cmd_version {
print "dgit version $our_version\n" or die $!;
exit 0;
sub cmd_version {
print "dgit version $our_version\n" or die $!;
exit 0;