Indirect file transfer

I'm a mobile worker, so I have the problem that I use multiple computers at multiple locations. And, as expected, a file I need is never on the same computer I'm using at the moment. And usually I need to transfer files between 2 computers that are both firewalled, so a direct scp is not possible. Ok, there are ways around. I used to scp the files to a third host, filling up /tmp over time, or I mailed them to myself. And sometimes I scped a file over multiple hops, if I needed to send it to some system behind my home router...

But now that's a problem of the past. With a couple of lines of code and the help of the Net::EasyTCP module, I created a server that will receive files over the net, temporarily hold them in memory, and finally release them upon request. A matching sender and getter client makes the solution complete.

Usage: Change the $port and $password settings in all 3 files to the same values. Change the $host in the clients to the hostname or IP of the server. Start the server (program) on the server (host). Now run the sender with any file(s) as parameter. Wait until the files have been sent, then start the getter on any other host. Find the files in the current directory.

Note: Quick and dirty code. You may want to clean it a little bit for safe usage.

Server:

#!/opt/perl/bin/perl

use strict;
use warnings;
use Net::EasyTCP;

# Configuration settings
our $port = 7716;
our $password = 'secret passphrase or whatever';

# Implementation
our $cache = [];

our $server = new Net::EasyTCP(
    mode            =>      "server",
    port            =>      $port,
) || die "ERROR CREATING SERVER: $@\n";

$server->setcallback(
    data            =>      \&gotdata,
    connect         =>      \&connected,
    disconnect    =>    \&disconnected,
) || die "ERROR SETTING CALLBACKS: $@\n";

print "Server starting on port $port\n";
$server->start() || die "ERROR STARTING SERVER: $@\n";

sub gotdata {
    my $client = shift;
    my $serial = $client->serial();
    my $data = $client->data();
    print "Client $serial sent me some data\n";
    if (ref($data) ne 'HASH') {
        print "Client $serial sent bad data\n";
        $client->send('DATA') || die "ERROR SENDING TO CLIENT: $@\n";
        $client->close() || die "ERROR CLOSING CLIENT: $@\n";
    }
    if ($data->{password} ne $password) {
        print "Client $serial sent wrong password\n";
        $client->send('PWD') || die "ERROR SENDING TO CLIENT: $@\n";
        $client->close() || die "ERROR CLOSING CLIENT: $@\n";
    }
    if ($data->{put}) {
        push @$cache, $data;
        print "Client $serial sent data to store\n";
        $client->send('OK') || die "ERROR SENDING TO CLIENT: $@\n";
        $client->close() || die "ERROR CLOSING CLIENT: $@\n";
    } elsif (not @$cache) {
        print "Client $serial requested data, but there is nothing her
+e\n";
        $client->send('NODATA') || die "ERROR SENDING TO CLIENT: $@\n"
+;
        $client->close() || die "ERROR CLOSING CLIENT: $@\n";
    } else {
        print "Client $serial requested date, sending one record\n";
        my $tosend = shift @$cache;
        $client->send($tosend) || die "ERROR SENDING TO CLIENT: $@\n";
        $client->close() || die "ERROR CLOSING CLIENT: $@\n";
    }
}

sub connected {
    my $client = shift;
    my $serial = $client->serial();
    print "Client $serial just connected\n";
}

sub disconnected {
    my $client = shift;
    my $serial = $client->serial();
    print "Client $serial just disconnected\n";
}
[download]

Sender:

#!/usr/bin/perl

use strict;
use warnings;
use Net::EasyTCP;

# Configuration settings
our $host = 'myhost.mydomain.mytld';
our $port = 7716;
our $password = 'secret passphrase or whatever';

# Implementation
foreach my $file (@ARGV) {
    unless (-e $file) {
        print "No such file: '$file', skipping\n";
    }
    open F, '<', $file or die $!;
    my $data = { password => $password, filename => $file };
    {
        local $/ = undef;
        $data->{put} = <F>;
    }
    close F or die $!;

    print "Connecting to server...\n";
    my $client = new Net::EasyTCP(
        mode            =>      "client",
        host            =>      $host,
        port            =>      $port,
    ) || die "ERROR CREATING CLIENT: $@\n";

    print "Connected. Sending $file...\n";
    $client->send($data) || die "ERROR SENDING: $@\n";

    print "Sent. Reading reply...\n";
    my $reply = $client->receive() || die "ERROR RECEIVING: $@\n";

    print "Reply was: '$reply'\n";
    $client->close();
}
print "Done.\n";
[download]

Getter:

#!/usr/bin/perl

use strict;
use warnings;
use Net::EasyTCP;

# Configuration settings
our $host = 'myhost.mydomain.mytld';
our $port = 7716;
our $password = 'secret passphrase or whatever';

# Implementation
while (1) {
    print "Connecting to server...\n";
    my $client = new Net::EasyTCP(
        mode            =>      "client",
        host            =>      $host,
        port            =>      $port,
    ) || die "ERROR CREATING CLIENT: $@\n";

    print "Connected. Sending get request...\n";
    my $data = { password => $password };
    $client->send($data) || die "ERROR SENDING: $@\n";

    print "Sent. Reading reply...\n";
    $data = $client->receive() || die "ERROR RECEIVING: $@\n";
    unless (ref($data)) {
        print "Reply was: '$data', exiting\n";
        $client->close();
        exit(0);
    }

    # Note: Now we have the only copy of the file.
    #       If we don't save it, it's lost.

    # Very simple sanity check, we trust the host...
    $data->{filename} =~ s!^.*/!!;
    if (-e $data->{filename}) {
        die "I won't overwrite '".$data->{filename}."'!\n";
    }
    open F, '>', $data->{filename} or die $!;
    print F $data->{put};
    close F or die $!;
    print "Written '".$data->{filename}."'.\n";

    $client->close();
}
[download]

_Search, Ask, ^Know

Comment on Indirect file transfer Select or Download Code


Keep It Simple, Stupid
	PerlMonks