Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

Indirect file transfer

by Beechbone (Friar)
on Apr 18, 2007 at 12:28 UTC ( #610755=CUFP: print w/replies, xml ) Need Help??

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"; }
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";
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(); }

Search, Ask, Know

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://610755]
Approved by Corion
Front-paged by liverpole
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (4)
As of 2021-06-13 08:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    What does the "s" stand for in "perls"? (Whence perls)












    Results (54 votes). Check out past polls.

    Notices?