--- /dev/null
+#! /usr/bin/perl -w
+use strict;
+
+use IPC::Open2;
+
+$ENV{LANG} = "C";
+
+# The protocol consists of repeated exchanges of the following:
+#
+# S: <filename>
+# S: <each line of file, with dot-stuffing as in SMTP>
+# S: .
+# C: [writes file]
+# C: <filename>
+# S: [unlinks file]
+
+my $server = 0;
+my $verbose = 0;
+my $nonint = 0;
+my $sshidentity;
+my $sshmovepath = 'ssh-move';
+my $fromdir;
+my $todir;
+
+while (@ARGV) {
+ local $_ = shift @ARGV;
+ if (/^--server$/) {
+ $server = 1;
+ } elsif (/^--verbose$/) {
+ $verbose = 1;
+ } elsif (/^--ssh-identity$/) {
+ $sshidentity = shift @ARGV;
+ } elsif (/^--ssh-move-path$/) {
+ $sshmovepath = shift @ARGV;
+ } elsif (/^--from-directory$/) {
+ $fromdir = shift @ARGV;
+ } elsif (/^--to-directory$/) {
+ $todir = shift @ARGV;
+ } elsif (/^--non-interactive$/) {
+ $nonint = 1;
+ } else {
+ unshift @ARGV, $_;
+ last;
+ }
+}
+
+local $| = 1;
+
+
+my ($in, $out) = (*STDIN, *STDOUT);
+
+unless ($nonint) {
+ my $servername = shift @ARGV;
+ local (*READER, *WRITER);
+
+ my @args = ('ssh');
+ push @args, '-i', $sshidentity if defined $sshidentity;
+
+ push @args, $servername, $sshmovepath;
+ push @args, '--server' unless ($server);
+ push @args, '--to-directory', $todir if (defined $todir && $server);
+ push @args, '--from-directory', $fromdir if (defined $fromdir && !$server);
+ push @args, '--non-interactive';
+ push @args, map quotemeta, @ARGV unless ($server);
+
+ my $pid = open2 (\*READER, \*WRITER, @args);
+
+ ($in, $out) = (*READER, *WRITER);
+}
+
+sub server ()
+{
+ chdir $fromdir if defined $fromdir;
+
+ my @files = map glob, @ARGV;
+
+ for my $file (@files) {
+ print $out "$file\n" or die "can't print to client: $!";
+ open FILE, "< $file" or die "can't open $file: $!\n";
+ local $_;
+ while (<FILE>) {
+ chomp;
+ $_ = ".$_" if /^\./;
+ print $out "$_\n" or die "can't print to client: $!";
+ }
+ print $out ".\n" or die "can't print to client: $!";
+
+ my $confirm = <$in>;
+ chomp $confirm if defined $confirm;
+ unlink $file if defined $confirm and $confirm eq $file;
+ }
+}
+
+sub client ()
+{
+ chdir $todir if defined $todir;
+
+ my $file;
+ while (defined ($file = <$in>)) {
+ chomp $file;
+ print STDERR $file if $verbose;
+ (my $tmpfile = $file) =~ s[.*/][];
+ $tmpfile .= ".$$.tmp";
+ # TODO: unlink $tmpfile if things go wrong
+ open TMP, "> $tmpfile" or die "can't open $tmpfile: $!";
+ local $_;
+ while (<$in>) {
+ chomp;
+ if ($_ eq '.') {
+ close TMP or die "can't close $tmpfile: $!";
+ rename $tmpfile, $file
+ or die "can't rename $tmpfile to $file: $!";
+ print $out "$file\n" or die "can't print to server: $!";
+ last;
+ } else {
+ s/^\.//;
+ print TMP "$_\n" or die "can't print to $tmpfile: $!";
+ }
+ }
+ print STDERR " ok\n" if $verbose;
+ }
+}
+
+if ($server) {
+ server ();
+} else {
+ client ();
+}