jrk/scpi.pl

## scpi.pl
#!/usr/bin/env perl

# Via: http://erdani.org/code/scpi.html
################################################################################
## Copyright (c) 2006 by Andrei Alexandrescu
## Permission to use, copy, modify, distribute and sell this software for any
##     purpose is hereby granted without fee, provided that the above copyright
##     notice appear in all copies and that both that copyright notice and this
##     permission notice appear in supporting documentation.
## The author makes no representations about the
##     suitability of this software for any purpose. It is provided "as is"
##     without express or implied warranty.
################################################################################

use strict;
use warnings;
use Pod::Usage;
use Getopt::Long qw(:config no_ignore_case bundling);
use IPC::Open2;
use File::Basename;
use Time::HiRes qw(time sleep);

sub CopySpec($$);
sub OpenCmdChannel($);
sub SysReadLine($);
sub FormatSize($;$);
sub CopyFile($$$$$);
sub ReadAll($\$);
sub ReadChunk($\$);
sub yap(@);

my @sshOptions = ("-e", "none");
my $batchMode = 0;
my $ssh = "ssh";
my $limitBandwidth = 2_000_000_000;
my $preserveTime = 0;
my $quiet = 0;
my $recursive = 0;
my $verbose = 0;
my $restMode = 0;
my $compress = "";
my $expand = "cat";
my ($srcRdr, $srcWtr, $dstRdr, $dstWtr);

my $sharedCode = q{
  my $bufSize = 32 * 1024;
  sub SysReadLine($) {
    my ($h) = @_;
    my $buf = "";
    while (sysread($h, my $c, 1)) {
      $buf .= $c;
      last if ($c eq "\n");
    }
    $buf;
  }
  sub ReadChunk($\$) {
    my ($h, $buf) = @_;
    $$buf = "";
    my $len = int(SysReadLine($h));
    while ((my $diff = $len - length($$buf)) > 0) {
      sysread($h, $$buf, $diff, length($$buf)) or die "Cannot read from stream";
    }
    $len;
  }
  sub WriteChunk($$) {
    my $h = $_[0];
    my $buf = \$_[1];
    my $len = length($$buf);
    syswrite($h, "$len\n") && syswrite($h, $$buf) == $len
      or die "Cannot write to stream";
    $len;
  }
};
eval($sharedCode);
die $@ if $@;

sub AddSSHOption($$) { push @sshOptions, "-$_[0]"; }
sub AddSSHOption2($$) { push @sshOptions, "-$_[0]", "$_[1]"; }
GetOptions(
  "h|help|?" => sub { pod2usage(1); },
  "1"  => \&AddSSHOption,
  "2"  => \&AddSSHOption,
  "4"  => \&AddSSHOption,
  "6"  => \&AddSSHOption,
  "B"  => \$batchMode,
  "C" => \&AddSSHOption,
  "c=s" => \&AddSSHOption2,
  "F=s" => \&AddSSHOption2,
  "i=s" => \&AddSSHOption2,
  "l=i" => sub { $limitBandwidth = 1024 * $_[1] },
  "o=s" => \&AddSSHOption2,
  "P=i" => sub { AddSSHOption2("p", $_[1]); },
  "p" => \$preserveTime,
  "q" => \$quiet,
  "r" => \$recursive,
  "S=s" => \$ssh,
  "v" => \&AddSSHOption,
  "R" => \$restMode,
  "b" => sub { $compress = "|bzip2"; $expand = "bunzip2" },
  "g" => sub { $compress = "|gzip"; $expand = "gunzip" },
  "n" => sub { $compress = ""; $expand = "cat" },
  "d" => sub { ++$verbose },
);

# main code starts here; scoped for the sake of symbol locality
{
  pod2usage(1) if (@ARGV < 2);
  my $dst = pop(@ARGV);
  my ($dstHost, $dstSpec) = ($dst =~ qr{(?:(.+?)\:)?(.*)});
  $dstHost = '' if !$dstHost;
  $dstSpec = '' if !$dstSpec;
  for my $src (@ARGV) {
    # Parse source
    my ($srcHost, $srcSpec) = ($src =~ qr{(?:(.+?)\:)?(.*)});
    $srcHost = '' if !$srcHost;
    yap("Source host: `$srcHost', target host: `$dstHost'\n");
    # Start communicating with the two hosts
    ($srcRdr, $srcWtr) = OpenCmdChannel($srcHost);
    ($dstRdr, $dstWtr) = OpenCmdChannel($dstHost);
    # Here's the meat
    CopySpec($srcSpec, $dstSpec);
    # Cleanuppa
    close($srcWtr) or warn("Cannot close source channel");
    close($dstWtr) or warn("Cannot close target channel");
  }
}

################################################################################

sub CopySpec($$) {
  my ($srcSpec, $dstSpec) = @_;
  # support spaces in destination, while allowing other metachars
  $srcSpec =~ s/(\s)/\\$1/g;
  yap("Source filespec: `$srcSpec', target filespec: `$dstSpec'\n");
  #my $fileInfoFormat = q{"q{%n}, %s, q{%A}, "};
  print $srcWtr qq{<stat --format="q{%n}, %s, q{%A}, "},
    qq{ -- $srcSpec 2>/dev/null\n};
  ReadAll($srcRdr, my $buf);
  yap("Source names, sizes, attributes: $buf\n");
  my @srcFiles = eval("($buf)");

  for (my $i = 0; $i < @srcFiles; $i += 3) {
    my $srcName = $srcFiles[$i];
    my $srcSize = $srcFiles[$i + 1];
    my $srcAttr = $srcFiles[$i + 2];
    if ($srcAttr =~ /^d/) {
      if (!$recursive) {
        print "Ignoring directory `$srcName'\n";
        next;
      }
      yap("Recursive copy\n");
      $dstSpec =~ s{/$}{};
      my $targetDir = "$dstSpec/" . basename($srcName) . '/';
      print $dstWtr qq{<mkdir --parents '$targetDir'; echo \$?\n};
      ReadAll($dstRdr, $buf);
      $buf = int($buf);
      if ($buf) {
        warn "Cannot create directory `$targetDir', error code $buf; skipping `$srcName'";
        next;
      }
      CopySpec($srcName . '/*', $targetDir);
      next;
    }
    my $dstName = $dstSpec;
    if ($dstName eq "" || $dstName =~ qr{/$} || $dstName =~ qr{(^|/)\.?\.$}) {
      # it's a directory
      $dstName =~ s{/?$}{/};
      $dstName .= basename($srcName);
    }
    my $dstSize = 0;
    if ($restMode) {
      print $dstWtr qq{<stat --format='%s' -- '$dstName' 2>/dev/null\n};
      ReadAll($dstRdr, $buf);
      yap("Size of destination file `$dstName': $buf\n");
      $dstSize = int($buf) if ($buf);
    }

    my $diff = $srcSize - $dstSize;
    #next if ($restMode && $diff == 0);
    yap("Copying '$srcName' to '$dstName' from byte $dstSize to byte $srcSize ",
      "(total: $diff bytes)\n");
    if ($restMode && $diff < 0) {
      print STDERR "Destination '$dstName' exists but is larger than ",
        "source '$srcName', give up on -R\n";
      next;
    }
    CopyFile($srcName, $srcSize, $dstSize, $dstName, $restMode);
  }
}

sub yap(@) {
  return if (!$verbose);
  print join('', @_);
}

sub OpenCmdChannel($) {
  my ($host) = @_;
  # The command above should have no single quote, sigh
  my $perlCmd = $sharedCode . q{
    use strict;
    use warnings;
    use bytes;
    my $buf;
    $| = 1;
    binmode(STDIN) or die "Cannot binmode stdin";
    binmode(STDOUT) or die "Cannot binmode stdout";
    while (my $ln = SysReadLine(\*STDIN)) {
      my $stream;
      if ($ln =~ /^</) {
        $ln = substr($ln, 1);
        open($stream, "$ln|") or die "Cannot open $ln: $!";
        binmode($stream) or die "Cannot binmode stream";
        while (sysread($stream, $buf, $bufSize)) {
          WriteChunk(\*STDOUT, $buf);
        }
        WriteChunk(\*STDOUT, "");
      } elsif ($ln =~ /^>/) {
        $ln = substr($ln, 1);
        open($stream, "|$ln") or die "Cannot open $ln: $!";
        binmode($stream) or die "Cannot binmode stream";
        while (ReadChunk(\*STDIN, $buf)) {
          syswrite($stream, $buf) == length($buf) or die "Cannot write!";
        }
      } else {
        die "Unrecognized command line: $ln";
      }
      close($stream);
    }
  };
  $perlCmd =~ s/\s+/ /g;

  my @pipe = $host
    # open via ssh
    ? ($ssh, @sshOptions, $host, "perl -e '$perlCmd'")
    # local pipe
    : ("zsh", "-c", "perl -e '$perlCmd'");
#"zsh", "-c", "perl -e '$perlCmd'"
  open2(my $rdr, my $wtr, @pipe) or die "Cannot open pipe `@pipe': $!";
  binmode($rdr) && binmode($wtr) or die "Cannot binmode channel";
  print $wtr qq{<echo ping\n};
  ReadAll($rdr, my $response);
  die "Expected `ping', got `$response' in command `@pipe'"
    if $response ne "ping\n";
  ($rdr, $wtr);
}

sub CopyFile($$$$$) {
  my ($src, $srcSize, $srcOffset, $dst, $append) = @_;
  my $redir = $append ? '>>' : '>';
  # Send commands to source
  my $payload = $srcSize - $srcOffset;
  my $nTh = $srcOffset + 1;
  print $srcWtr qq{<tail --bytes=+$nTh -- $src $compress\n}
    or die "Cannot send commands to source";
  # Send commands to target
  print $dstWtr qq{>$expand $redir $dst\n}
    or die "Cannot send commands to destination";

  my $speed = 0;
  my $eta;
  my $started = time();
  my $bytesSinceLastTime = 0;
  my $buf;
  my $accum = $srcOffset;
  my $moreData = 1;

  # ok, now do the deed
  while ($moreData) {
    $moreData = ReadChunk($srcRdr, $buf);
    WriteChunk($dstWtr, $buf) == length($buf) or die "Cannot write: $!\n";
    $accum += length($buf);
    $bytesSinceLastTime += length($buf);
    my $newTime = time();
    my $delta = $newTime - $started;
    next if ($delta < 1 && $moreData);
    # Compute speed and ETA
    my $instaSpeed = $bytesSinceLastTime / $delta;
    $speed = $speed == 0
      ? $instaSpeed
      : (19 * $speed + $instaSpeed) / 20;
    # Throttle bandwidth
    if ($speed > $limitBandwidth) {
        my $sleep = $bytesSinceLastTime / $limitBandwidth - $delta;
        if ($sleep > 0) {
          sleep($sleep);
          $speed = $limitBandwidth;
        }
    }
    $started = $newTime;
    $bytesSinceLastTime = 0;
    #
    next if ($quiet);
    $eta = $speed ? ($srcSize - $accum) / $speed : 0; # seconds
    # Print the stuff
    my $p = sprintf("%.2f", $srcSize ? $accum * 100 / $srcSize : 100);
    my $hrs = int($eta / 3600.);
    my $mins = int(($eta - 3600 * $hrs) / 60);
    my $rhs = sprintf(" %.2f%% %s %.0fKB/s %02u:%02u ETA",
      $p, FormatSize($accum), $speed / 1024., $hrs, $mins);
    my $fsLen = 80 - length($rhs) - 2;
    printf STDERR "%-*.*s %s\r", $fsLen, $fsLen, basename($src), $rhs;
  }
  print STDERR "\n";
}

sub FormatSize($;$) {
  my ($size, $suffix) = @_;
  $suffix = $suffix || "B";
  if ($size < 1000) {
    return sprintf("%.5s$suffix", $size);
  }
  $size /= 1024.;
  return FormatSize($size,
    $suffix eq "B" ? "K" : $suffix eq "K" ? "M" : $suffix eq "M" ? "G" : "T");
}

sub ReadAll($\$) {
  my ($h, $r) = @_;
  $$r = "";
  my $buf;
  while (ReadChunk($h, $buf)) {
    $$r .= $buf;
  }
  length($$r);
}

__END__

Generate html with:

$ pod2html scpi.pl >scpi.html --css="/style.css" --title=scpi

=head1 SCPI: B<S>ECURE B<C>OB<P>Y B<I>MPROVED

scpi - scp improved with restartable downloads and advanced compression.

=begin html

<style>
tt, pre, code {
    font-family:"Courier";
    font-size:105%;
}
</style>

<script type="text/javascript"><!--
google_ad_client = "pub-7042296581632428";
google_ad_width = 728;
google_ad_height = 90;
google_ad_format = "728x90_as";
google_ad_type = "text_image";
google_ad_channel ="";
google_color_border = "336699";
google_color_bg = "C1CCCD";
google_color_link = "0000FF";
google_color_url = "008000";
google_color_text = "000000";
//--></script>
<script type="text/javascript"
  src="http://pagead2.googlesyndication.com/pagead/show_ads.js">
</script>

=end html

=head1 SYNOPSIS

C<scpi.pl [options] [[user@]host:]src [...] [[user@]host:]dest>

=head1 DESCRIPTION

C<scpi> (C<scp> improved) is intended to be a drop-in replacement for the
C<scp> utility that comes together with any Secure Shell (ssh) implementation.
C<scpi> implements the much-needed restartable downloads that C<scp> famously
doesn't support. As a couple of perks, C<scpi> implements a few other
niceties such as optional use of advanced compression (C<gzip>/C<bzip2>)
and copying multiple files to one destination directory in one shot.


Options:

  -h, -help       brief help message
  -1              passed to ssh
  -1              passed to ssh
  -4              passed to ssh
  -6              passed to ssh
  -B              batch usage (not implemented)
  -C              passed to ssh
  -c str          passed to ssh
  -F str          passed to ssh
  -i str          passed to ssh
  -l              limit bandwidth used
  -o str          passed to ssh
  -P int          passed to ssh
  -p              preserve file times (not implemented)
  -q              don't display progress
  -r              recurse
  -S str          choose the ssh to use
  -v              passed to ssh
  -R              restart mode (resume broken downloads)
  -n              use no compression (default)
  -b              use bzip2 for compressing the data stream
                  (%, speed, and ETA will be inaccurate)
  -g              use gzip for compressing the data stream
                  (%, speed, and ETA will be inaccurate)
  -d              debug (extra output)

C<scpi> is implemented in Perl, and requires Perl on the machine it's running,
as well as on the source and/or destination hosts. Also, C<scpi> uses the C<ssh>
executable on the client machine (but not C<scp>).

The main target audience for C<scpi> consists of people who enjoy C<scp>'s
security but are unhappy with C<scp>'s lack of a "restart" capability---if
the connection drops in the middle of a copy, C<scp> forces redoing the
transfer all over again. C<scpi> implements robust restarts. When invoked with
the -R flag, C<scpi> assumes that the existing target file, if any, is a
valid fragment left from a previous C<scpi> (or C<scp> for that matter)
execution, and that the source file hasn't changed in the meantime.

It follows that C<scpi> is best at transferring large files. To better support
that ability, C<scp> supports C<gzip> or C<bzip2> compression of the data
stream, which can be a big win in transmission speed at a low computational
cost, particularly over an agglomerated LAN. (You can also pass C<scpi> the
-C flag, which C<scpi> passes along to C<ssh> instructing it to compress the
stream itself (but not the source and destination files). Generally, the
newer C<bzip2> algorithm is expected to be better than either C<gzip> or
C<ssh>'s native compression.)

=head1 DOWNLOAD

C<scpi.pl> is available from http://erdani.org/code/scpi.pl. Save the file to a
local Unix (including Cygwin) directory and use it as you'd use C<scp>.

=head1 IMPLEMENTATION

You don't need to read this unless you plan on changing scpi yourself, or you
enjoy cool hacks.

In essence, scpi starts ssh through a bidirectional pipe and implements its own
little data transfer protocol on top of that pipe. The protocol simply
prescribes that data transfers take place in "chunks". Each chunk consists of a
number N (in decimal ASCII) followed by a newline, followed by N bytes of data.
By convention, if N is zero, that means an entire transfer---in our case, a file
of arbitrary size---has ended. Transmitting a large file in chunks has the
advantage that the size of the file mustn't be known in advance, advantage
exploited in scpi's implementation.

The need for such a protocol arises from the requirement of reusing one
bidirectional stream (namely ssh's stdin and stdout) for multiple binary
transfers. If only one blob of data were to be transferred, closing the
stream would naturally signify the end of the data. However, a more
sophisticated communication demands a reliable way to detect the size
of a data block.

With this little protocol in place, scpi implements and uses internally a
very simple "command line" interface---a way to execute commands on a
remote system and either feed data
to their standard input or read their standard output. Simplicity and reuse of
good old utilities (such as C<tail> and C<cat>) make scpi robust and
easy to debug.

=head1 AUTHOR

Written by Andrei Alexandrescu. Mosey to http://erdani.org/email to contact
the author.

=head1 KNOWN BUGS

As of this time, the -p (preserve file time) and -B (batch usage) are ignored,
the first because the author didn't need it yet, and the second because the
author didn't have the time to look into what it really means.

C<scpi> has not been tested with file names containing a newline, and it
almost sure won't work with them. Quotes and other special characters inside
file names are likely to cause trouble as well.

The implementation of bandwidth limitation hasn't been really thought through.
When the option -l is in effect, there is some bandwith throttling, but perhaps
the regularization algorithm could be vastly enhanced.

When using -b or -g (compression with C<bzip2> or C<gzip>), the percent
transferred, speed, and estimated time of arrival (ETA) will likely be
inaccurate. This is because they reflect the amount of compressed, not "real",
data transferred. On the bright side, at the end of each file's transfer, the
percent complete will show the effective stream compression achieved on that
file.

=head1 SEE ALSO

The documentation for scp shows more details on the options. B<scpi> emulates
scp's options (and, just like scp, passes some of them to ssh).

=head1 COPYRIGHT

Copyright (c) 2006 Andrei Alexandrescu.

This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

=cut
	#!/usr/bin/env perl

	# Via: http://erdani.org/code/scpi.html
	################################################################################
	## Copyright (c) 2006 by Andrei Alexandrescu
	## Permission to use, copy, modify, distribute and sell this software for any
	## purpose is hereby granted without fee, provided that the above copyright
	## notice appear in all copies and that both that copyright notice and this
	## permission notice appear in supporting documentation.
	## The author makes no representations about the
	## suitability of this software for any purpose. It is provided "as is"
	## without express or implied warranty.
	################################################################################

	use strict;
	use warnings;
	use Pod::Usage;
	use Getopt::Long qw(:config no_ignore_case bundling);
	use IPC::Open2;
	use File::Basename;
	use Time::HiRes qw(time sleep);

	sub CopySpec($$);
	sub OpenCmdChannel($);
	sub SysReadLine($);
	sub FormatSize($;$);
	sub CopyFile($$$$$);
	sub ReadAll($\$);
	sub ReadChunk($\$);
	sub yap(@);

	my @sshOptions = ("-e", "none");
	my $batchMode = 0;
	my $ssh = "ssh";
	my $limitBandwidth = 2_000_000_000;
	my $preserveTime = 0;
	my $quiet = 0;
	my $recursive = 0;
	my $verbose = 0;
	my $restMode = 0;
	my $compress = "";
	my $expand = "cat";
	my ($srcRdr, $srcWtr, $dstRdr, $dstWtr);

	my $sharedCode = q{
	my $bufSize = 32 * 1024;
	sub SysReadLine($) {
	my ($h) = @_;
	my $buf = "";
	while (sysread($h, my $c, 1)) {
	$buf .= $c;
	last if ($c eq "\n");
	}
	$buf;
	}
	sub ReadChunk($\$) {
	my ($h, $buf) = @_;
	$$buf = "";
	my $len = int(SysReadLine($h));
	while ((my $diff = $len - length($$buf)) > 0) {
	sysread($h, $$buf, $diff, length($$buf)) or die "Cannot read from stream";
	}
	$len;
	}
	sub WriteChunk($$) {
	my $h = $_[0];
	my $buf = \$_[1];
	my $len = length($$buf);
	syswrite($h, "$len\n") && syswrite($h, $$buf) == $len
	or die "Cannot write to stream";
	$len;
	}
	};
	eval($sharedCode);
	die $@ if $@;

	sub AddSSHOption($$) { push @sshOptions, "-$_[0]"; }
	sub AddSSHOption2($$) { push @sshOptions, "-$_[0]", "$_[1]"; }
	GetOptions(
	"h\|help\|?" => sub { pod2usage(1); },
	"1" => \&AddSSHOption,
	"2" => \&AddSSHOption,
	"4" => \&AddSSHOption,
	"6" => \&AddSSHOption,
	"B" => \$batchMode,
	"C" => \&AddSSHOption,
	"c=s" => \&AddSSHOption2,
	"F=s" => \&AddSSHOption2,
	"i=s" => \&AddSSHOption2,
	"l=i" => sub { $limitBandwidth = 1024 * $_[1] },
	"o=s" => \&AddSSHOption2,
	"P=i" => sub { AddSSHOption2("p", $_[1]); },
	"p" => \$preserveTime,
	"q" => \$quiet,
	"r" => \$recursive,
	"S=s" => \$ssh,
	"v" => \&AddSSHOption,
	"R" => \$restMode,
	"b" => sub { $compress = "\|bzip2"; $expand = "bunzip2" },
	"g" => sub { $compress = "\|gzip"; $expand = "gunzip" },
	"n" => sub { $compress = ""; $expand = "cat" },
	"d" => sub { ++$verbose },
	);

	# main code starts here; scoped for the sake of symbol locality
	{
	pod2usage(1) if (@ARGV < 2);
	my $dst = pop(@ARGV);
	my ($dstHost, $dstSpec) = ($dst =~ qr{(?:(.+?)\:)?(.*)});
	$dstHost = '' if !$dstHost;
	$dstSpec = '' if !$dstSpec;
	for my $src (@ARGV) {
	# Parse source
	my ($srcHost, $srcSpec) = ($src =~ qr{(?:(.+?)\:)?(.*)});
	$srcHost = '' if !$srcHost;
	yap("Source host: `$srcHost', target host: `$dstHost'\n");
	# Start communicating with the two hosts
	($srcRdr, $srcWtr) = OpenCmdChannel($srcHost);
	($dstRdr, $dstWtr) = OpenCmdChannel($dstHost);
	# Here's the meat
	CopySpec($srcSpec, $dstSpec);
	# Cleanuppa
	close($srcWtr) or warn("Cannot close source channel");
	close($dstWtr) or warn("Cannot close target channel");
	}
	}

	################################################################################

	sub CopySpec($$) {
	my ($srcSpec, $dstSpec) = @_;
	# support spaces in destination, while allowing other metachars
	$srcSpec =~ s/(\s)/\\$1/g;
	yap("Source filespec: `$srcSpec', target filespec: `$dstSpec'\n");
	#my $fileInfoFormat = q{"q{%n}, %s, q{%A}, "};
	print $srcWtr qq{<stat --format="q{%n}, %s, q{%A}, "},
	qq{ -- $srcSpec 2>/dev/null\n};
	ReadAll($srcRdr, my $buf);
	yap("Source names, sizes, attributes: $buf\n");
	my @srcFiles = eval("($buf)");

	for (my $i = 0; $i < @srcFiles; $i += 3) {
	my $srcName = $srcFiles[$i];
	my $srcSize = $srcFiles[$i + 1];
	my $srcAttr = $srcFiles[$i + 2];
	if ($srcAttr =~ /^d/) {
	if (!$recursive) {
	print "Ignoring directory `$srcName'\n";
	next;
	}
	yap("Recursive copy\n");
	$dstSpec =~ s{/$}{};
	my $targetDir = "$dstSpec/" . basename($srcName) . '/';
	print $dstWtr qq{<mkdir --parents '$targetDir'; echo \$?\n};
	ReadAll($dstRdr, $buf);
	$buf = int($buf);
	if ($buf) {
	warn "Cannot create directory `$targetDir', error code $buf; skipping `$srcName'";
	next;
	}
	CopySpec($srcName . '/*', $targetDir);
	next;
	}
	my $dstName = $dstSpec;
	if ($dstName eq "" \|\| $dstName =~ qr{/$} \|\| $dstName =~ qr{(^\|/)\.?\.$}) {
	# it's a directory
	$dstName =~ s{/?$}{/};
	$dstName .= basename($srcName);
	}
	my $dstSize = 0;
	if ($restMode) {
	print $dstWtr qq{<stat --format='%s' -- '$dstName' 2>/dev/null\n};
	ReadAll($dstRdr, $buf);
	yap("Size of destination file `$dstName': $buf\n");
	$dstSize = int($buf) if ($buf);
	}

	my $diff = $srcSize - $dstSize;
	#next if ($restMode && $diff == 0);
	yap("Copying '$srcName' to '$dstName' from byte $dstSize to byte $srcSize ",
	"(total: $diff bytes)\n");
	if ($restMode && $diff < 0) {
	print STDERR "Destination '$dstName' exists but is larger than ",
	"source '$srcName', give up on -R\n";
	next;
	}
	CopyFile($srcName, $srcSize, $dstSize, $dstName, $restMode);
	}
	}

	sub yap(@) {
	return if (!$verbose);
	print join('', @_);
	}

	sub OpenCmdChannel($) {
	my ($host) = @_;
	# The command above should have no single quote, sigh
	my $perlCmd = $sharedCode . q{
	use strict;
	use warnings;
	use bytes;
	my $buf;
	$\| = 1;
	binmode(STDIN) or die "Cannot binmode stdin";
	binmode(STDOUT) or die "Cannot binmode stdout";
	while (my $ln = SysReadLine(\*STDIN)) {
	my $stream;
	if ($ln =~ /^</) {
	$ln = substr($ln, 1);
	open($stream, "$ln\|") or die "Cannot open $ln: $!";
	binmode($stream) or die "Cannot binmode stream";
	while (sysread($stream, $buf, $bufSize)) {
	WriteChunk(\*STDOUT, $buf);
	}
	WriteChunk(\*STDOUT, "");
	} elsif ($ln =~ /^>/) {
	$ln = substr($ln, 1);
	open($stream, "\|$ln") or die "Cannot open $ln: $!";
	binmode($stream) or die "Cannot binmode stream";
	while (ReadChunk(\*STDIN, $buf)) {
	syswrite($stream, $buf) == length($buf) or die "Cannot write!";
	}
	} else {
	die "Unrecognized command line: $ln";
	}
	close($stream);
	}
	};
	$perlCmd =~ s/\s+/ /g;

	my @pipe = $host
	# open via ssh
	? ($ssh, @sshOptions, $host, "perl -e '$perlCmd'")
	# local pipe
	: ("zsh", "-c", "perl -e '$perlCmd'");
	#"zsh", "-c", "perl -e '$perlCmd'"
	open2(my $rdr, my $wtr, @pipe) or die "Cannot open pipe `@pipe': $!";
	binmode($rdr) && binmode($wtr) or die "Cannot binmode channel";
	print $wtr qq{<echo ping\n};
	ReadAll($rdr, my $response);
	die "Expected `ping', got `$response' in command `@pipe'"
	if $response ne "ping\n";
	($rdr, $wtr);
	}

	sub CopyFile($$$$$) {
	my ($src, $srcSize, $srcOffset, $dst, $append) = @_;
	my $redir = $append ? '>>' : '>';
	# Send commands to source
	my $payload = $srcSize - $srcOffset;
	my $nTh = $srcOffset + 1;
	print $srcWtr qq{<tail --bytes=+$nTh -- $src $compress\n}
	or die "Cannot send commands to source";
	# Send commands to target
	print $dstWtr qq{>$expand $redir $dst\n}
	or die "Cannot send commands to destination";

	my $speed = 0;
	my $eta;
	my $started = time();
	my $bytesSinceLastTime = 0;
	my $buf;
	my $accum = $srcOffset;
	my $moreData = 1;

	# ok, now do the deed
	while ($moreData) {
	$moreData = ReadChunk($srcRdr, $buf);
	WriteChunk($dstWtr, $buf) == length($buf) or die "Cannot write: $!\n";
	$accum += length($buf);
	$bytesSinceLastTime += length($buf);
	my $newTime = time();
	my $delta = $newTime - $started;
	next if ($delta < 1 && $moreData);
	# Compute speed and ETA
	my $instaSpeed = $bytesSinceLastTime / $delta;
	$speed = $speed == 0
	? $instaSpeed
	: (19 * $speed + $instaSpeed) / 20;
	# Throttle bandwidth
	if ($speed > $limitBandwidth) {
	my $sleep = $bytesSinceLastTime / $limitBandwidth - $delta;
	if ($sleep > 0) {
	sleep($sleep);
	$speed = $limitBandwidth;
	}
	}
	$started = $newTime;
	$bytesSinceLastTime = 0;
	#
	next if ($quiet);
	$eta = $speed ? ($srcSize - $accum) / $speed : 0; # seconds
	# Print the stuff
	my $p = sprintf("%.2f", $srcSize ? $accum * 100 / $srcSize : 100);
	my $hrs = int($eta / 3600.);
	my $mins = int(($eta - 3600 * $hrs) / 60);
	my $rhs = sprintf(" %.2f%% %s %.0fKB/s %02u:%02u ETA",
	$p, FormatSize($accum), $speed / 1024., $hrs, $mins);
	my $fsLen = 80 - length($rhs) - 2;
	printf STDERR "%-.s %s\r", $fsLen, $fsLen, basename($src), $rhs;
	}
	print STDERR "\n";
	}

	sub FormatSize($;$) {
	my ($size, $suffix) = @_;
	$suffix = $suffix \|\| "B";
	if ($size < 1000) {
	return sprintf("%.5s$suffix", $size);
	}
	$size /= 1024.;
	return FormatSize($size,
	$suffix eq "B" ? "K" : $suffix eq "K" ? "M" : $suffix eq "M" ? "G" : "T");
	}

	sub ReadAll($\$) {
	my ($h, $r) = @_;
	$$r = "";
	my $buf;
	while (ReadChunk($h, $buf)) {
	$$r .= $buf;
	}
	length($$r);
	}

	__END__

	Generate html with:

	$ pod2html scpi.pl >scpi.html --css="/style.css" --title=scpi

	=head1 SCPI: B<S>ECURE B<C>OB<P>Y B<I>MPROVED

	scpi - scp improved with restartable downloads and advanced compression.

	=begin html

	<style>
	tt, pre, code {
	font-family:"Courier";
	font-size:105%;
	}
	</style>

	<script type="text/javascript"><!--
	google_ad_client = "pub-7042296581632428";
	google_ad_width = 728;
	google_ad_height = 90;
	google_ad_format = "728x90_as";
	google_ad_type = "text_image";
	google_ad_channel ="";
	google_color_border = "336699";
	google_color_bg = "C1CCCD";
	google_color_link = "0000FF";
	google_color_url = "008000";
	google_color_text = "000000";
	//--></script>
	<script type="text/javascript"
	src="http://pagead2.googlesyndication.com/pagead/show_ads.js">
	</script>

	=end html

	=head1 SYNOPSIS

	C<scpi.pl [options] [[user@]host:]src [...] [[user@]host:]dest>

	=head1 DESCRIPTION

	C<scpi> (C<scp> improved) is intended to be a drop-in replacement for the
	C<scp> utility that comes together with any Secure Shell (ssh) implementation.
	C<scpi> implements the much-needed restartable downloads that C<scp> famously
	doesn't support. As a couple of perks, C<scpi> implements a few other
	niceties such as optional use of advanced compression (C<gzip>/C<bzip2>)
	and copying multiple files to one destination directory in one shot.



	Options:

	-h, -help brief help message
	-1 passed to ssh
	-1 passed to ssh
	-4 passed to ssh
	-6 passed to ssh
	-B batch usage (not implemented)
	-C passed to ssh
	-c str passed to ssh
	-F str passed to ssh
	-i str passed to ssh
	-l limit bandwidth used
	-o str passed to ssh
	-P int passed to ssh
	-p preserve file times (not implemented)
	-q don't display progress
	-r recurse
	-S str choose the ssh to use
	-v passed to ssh
	-R restart mode (resume broken downloads)
	-n use no compression (default)
	-b use bzip2 for compressing the data stream
	(%, speed, and ETA will be inaccurate)
	-g use gzip for compressing the data stream
	(%, speed, and ETA will be inaccurate)
	-d debug (extra output)

	C<scpi> is implemented in Perl, and requires Perl on the machine it's running,
	as well as on the source and/or destination hosts. Also, C<scpi> uses the C<ssh>
	executable on the client machine (but not C<scp>).

	The main target audience for C<scpi> consists of people who enjoy C<scp>'s
	security but are unhappy with C<scp>'s lack of a "restart" capability---if
	the connection drops in the middle of a copy, C<scp> forces redoing the
	transfer all over again. C<scpi> implements robust restarts. When invoked with
	the -R flag, C<scpi> assumes that the existing target file, if any, is a
	valid fragment left from a previous C<scpi> (or C<scp> for that matter)
	execution, and that the source file hasn't changed in the meantime.

	It follows that C<scpi> is best at transferring large files. To better support
	that ability, C<scp> supports C<gzip> or C<bzip2> compression of the data
	stream, which can be a big win in transmission speed at a low computational
	cost, particularly over an agglomerated LAN. (You can also pass C<scpi> the
	-C flag, which C<scpi> passes along to C<ssh> instructing it to compress the
	stream itself (but not the source and destination files). Generally, the
	newer C<bzip2> algorithm is expected to be better than either C<gzip> or
	C<ssh>'s native compression.)

	=head1 DOWNLOAD

	C<scpi.pl> is available from http://erdani.org/code/scpi.pl. Save the file to a
	local Unix (including Cygwin) directory and use it as you'd use C<scp>.

	=head1 IMPLEMENTATION

	You don't need to read this unless you plan on changing scpi yourself, or you
	enjoy cool hacks.

	In essence, scpi starts ssh through a bidirectional pipe and implements its own
	little data transfer protocol on top of that pipe. The protocol simply
	prescribes that data transfers take place in "chunks". Each chunk consists of a
	number N (in decimal ASCII) followed by a newline, followed by N bytes of data.
	By convention, if N is zero, that means an entire transfer---in our case, a file
	of arbitrary size---has ended. Transmitting a large file in chunks has the
	advantage that the size of the file mustn't be known in advance, advantage
	exploited in scpi's implementation.

	The need for such a protocol arises from the requirement of reusing one
	bidirectional stream (namely ssh's stdin and stdout) for multiple binary
	transfers. If only one blob of data were to be transferred, closing the
	stream would naturally signify the end of the data. However, a more
	sophisticated communication demands a reliable way to detect the size
	of a data block.

	With this little protocol in place, scpi implements and uses internally a
	very simple "command line" interface---a way to execute commands on a
	remote system and either feed data
	to their standard input or read their standard output. Simplicity and reuse of
	good old utilities (such as C<tail> and C<cat>) make scpi robust and
	easy to debug.

	=head1 AUTHOR

	Written by Andrei Alexandrescu. Mosey to http://erdani.org/email to contact
	the author.

	=head1 KNOWN BUGS

	As of this time, the -p (preserve file time) and -B (batch usage) are ignored,
	the first because the author didn't need it yet, and the second because the
	author didn't have the time to look into what it really means.

	C<scpi> has not been tested with file names containing a newline, and it
	almost sure won't work with them. Quotes and other special characters inside
	file names are likely to cause trouble as well.

	The implementation of bandwidth limitation hasn't been really thought through.
	When the option -l is in effect, there is some bandwith throttling, but perhaps
	the regularization algorithm could be vastly enhanced.

	When using -b or -g (compression with C<bzip2> or C<gzip>), the percent
	transferred, speed, and estimated time of arrival (ETA) will likely be
	inaccurate. This is because they reflect the amount of compressed, not "real",
	data transferred. On the bright side, at the end of each file's transfer, the
	percent complete will show the effective stream compression achieved on that
	file.

	=head1 SEE ALSO

	The documentation for scp shows more details on the options. B<scpi> emulates
	scp's options (and, just like scp, passes some of them to ssh).

	=head1 COPYRIGHT

	Copyright (c) 2006 Andrei Alexandrescu.

	This is free software; see the source for copying conditions. There is NO
	warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

	=cut