cpblk

cpblk

#!/usr/bin/perl

use strict;

use Digest::MD5 qw(md5);
use Fcntl qw(:DEFAULT :seek);
use Getopt::Long qw(:config gnu_getopt);

my $bs = 4096;
my $skip = 0;
my $seek = 0;
my $count = undef;
my $rsh = 'ssh';
my $server = 0;
my $path = $0;

GetOptions(
    'bs=i' => \$bs,
    'skip=i' => \$skip,
    'seek=i' => \$seek,
    'n|count=i' => \$count,
    'e|rsh=s' => \$rsh,
    'server' => \$server,
    'path' => \$path,
) and @ARGV == 2 or die <<EOF;
usage: $0 [--bs=#] [--skip=#] [--seek=#] [--count=#] [host:]<source> [host:]<dest>
EOF

my ($source, $dest) = @ARGV;

sub reader {
    sysopen my $fd, $source, O_RDONLY or die "failed to open source: $!";
    sysseek $fd, $skip * $bs, SEEK_SET or die "failed to skip source: $!" if $skip;
    my ($n, $s) = (0, 0);
    local $SIG{INFO} = local $SIG{PWR} = local $SIG{USR1} = sub {
        warn "read $n blocks, sent $s\n";
    };
    my ($a, $b);
    while (!defined($count) || $n++ < $count
            and $a = sysread $fd, my $buf, $bs
            and $b = sysread STDIN, my $sum, 16) {
        substr($buf, $a, $bs - $a, '\0' x ($bs - $a));
        $a = md5($buf) eq $sum;
        syswrite STDOUT, $a ? '=' : '!' or die "failed to command source: $!";
        if (!$a) {
            for ($a = 0;
                $b = syswrite STDOUT, $buf, $bs - $a, $a
                    or die "failed to pipe source: $!";) {
                last if ($a += $b) >= $bs;
            }
            $s++;
        }
    }
    $a && !$b and die "short destination: $!";
    defined($count) and $n++ < $count and die "short source: $!";
}

sub writer {
    sysopen my $fd, $dest, O_RDWR or die "failed to open dest: $!";
    sysseek $fd, $seek * $bs, SEEK_SET or die "failed to skip dest: $!" if $seek;
    my ($n, $s) = (0, 0);
    local $SIG{INFO} = local $SIG{PWR} = local $SIG{USR1} = sub {
        warn "read $n blocks, wrote $s\n";
    };
    my ($a, $b);
    while (!defined($count) || $n++ < $count
            and $a = sysread $fd, my $buf, $bs) {
        substr($buf, $a, $bs - $a, '\0' x ($bs - $a));
        my $sum = md5($buf);
        for (my $c = 0;
            $b = syswrite STDOUT, $sum, 16 - $c, $c
                or die "failed to pipe dest: $!";) {
            last if ($c += $b) >= 16;
        }
        $b >= 0 or die "failed write: $!";
        sysread STDIN, my $c, 1 or die "short source: $!";
        if ($c eq '=') {
            next;
        } elsif ($c eq '!') {
            for ($c = 0;
                $b = sysread STDIN, $buf, $bs - $c, $c or die "failed to read data: $!";) {
                last if ($c += $b) >= $bs;
            }
            substr($buf, $a) eq '\0' x ($bs - $a) or die "short dest";
            sysseek $fd, -$a, SEEK_CUR or die "failed seek: $!";
            $a == syswrite $fd, $buf, $a or die "failed write: $!";
            $s++;
        } else {
            die 'unexpected command "'. ord($c);
        }
    }
}

sub remote {
    my ($host, $source, $dest) = @_;
    my @cmd = split ' ', $rsh;
    push @cmd, $host;
    push @cmd, split ' ', $path;
    push @cmd, "--bs=$bs", "--skip=$skip", "--seek=$seek";
    push @cmd, "--count=$count" if defined($count);
    push @cmd, '--server', '--', $source, $dest;
    return @cmd;
}

if ($server) {
    if ($source ne '-' and $dest eq '-') {
        reader;
    } elsif ($source eq '-' and $dest ne '-') {
        writer;
    } else {
        die "unknown server mode";
    }
} else {
    pipe(my $i0, my $o0) and pipe(my $i1, my $o1) or die "pipe: $!";
    defined (my $reader = fork) or die "fork: $!";
    if (!$reader) {
        open(STDIN, '<&', $i0) and open(STDOUT, '>&', $o1) or die "dup: $!";
        close($i0), close($o0), close($i1), close($o1);
        if ($source =~ s(\A([^/]*?):)()) {
            exec remote($1, $source, '-');
            exit -1;
        } else {
            reader;
            exit 0;
        }
    }
    defined (my $writer = fork) or die "fork: $!";
    if (!$writer) {
        open(STDIN, '<&', $i1) and open(STDOUT, '>&', $o0) or die "dup: $!";
        close($i0), close($o0), close($i1), close($o1);
        if ($dest =~ s(\A([^/]*?):)()) {
            exec remote($1, '-', $dest);
            exit -1;
        } else {
            writer;
            exit 0;
        }
    }
    close($i0), close($o0), close($i1), close($o1);
    while ((my $pid = wait) != -1) {
        if ($pid == $reader) {
            warn "reader failed: $?" if $?;
            undef $reader;
        } elsif ($pid == $writer) {
            warn "writer failed: $?" if $?;
            undef $writer;
        }
    }
    warn 'lost child' if $reader or $writer;
}