The Labs.Com Issue_03_FTP

TPJ: Issue_03_FTP

This is a collection of programs published by The Perl Journal. You can download all source-code also from TPJ: Programs.

1. the_basics
2. multiple_connections
3. sequential_reads_and_writes
4. pasv
5. More Samples on FTP

Download the_basics

#!/usr/bin/perl

# Load the Net::FTP package

use Net::FTP;

# I will explain the use of this module later

use File::Listing qw(parse_dir);

# Some defaults

# Look for files under this age (in seconds),

# I shall use 7 days

$age          = 7*24*60*60;

# The name of your nearest CPAN host, you will

# need to change this

$CPANhost = 'CPAN';

# The path to the CPAN/modules directory

# You will probably need to CHANGE this

$CPANpath = '/mirrors/CPAN/modules';

# Create a new NET::FTP object

# NOTE: I have also changed the timeout

# value to be 60 seconds

$ftp = Net::FTP->new($CPANhost, Timeout => 60) or

die "Cannot contact $CPANhost: $!";

# We shall login to the ftp server as anonymous

# Specifying a login id stops any netrc lookup

$ftp->login('anonymous') or

die "Cannot login ($CPANhost):" . $ftp->message;

# Change the working directory

$ftp->cwd($CPANpath) or

die "Cannot change directory ($CPANhost):" . $ftp->mess\

age;

# Retrieve a recursive directory listing

@ls = $ftp->ls('-lR');

# We probably do want binary, although some files

# may be ASCII :-)

$ftp->binary();

foreach $file (parse_dir(\@ls)) {

my($name, $type, $size, $mtime, $mode) = @$file;

# We only want to process plain files,

# we shall ignore symbolic links

next unless($type eq 'f');

# Check age of file against $age

# $mtime is a unix date value, that is

#   seconds since 1 Jan 1970

# $^T is the time this script started

#   as a unix date value

if($^T - $mtime < $age) {

print "Retrieving ",$name,"\n";

# Get the file from the ftp server

$ftp->get($name) or

warn "Could not get '$name', skipped: $!";

}

}

# Close the connection to the ftp server

$ftp->quit or

die "Could not close the connection cleanly: $!";

# We are done !

exit;

Issue_03_FTP 2. multiple_connections

Download multiple_connections

#!/usr/bin/perl

# Load the modules we will need

use Net::FTP;

use File::Listing qw(parse_dir);

# We will need to open/write some files

use FileHandle;

# Some defaults

# Look for files under this age (in seconds),

# I shall use 7 days

$age          = 7*24*60*60;

# The name of your nearest CPAN host, you will

# need to change this

$CPANhost = 'CPAN';

# The path to the CPAN/modules directory

# You will probably need to CHANGE this

$CPANpath = '/mirrors/CPAN/modules';

# Create the initial connection

$ftp = connection();

# Retrieve a recursive directory listing

@ls = $ftp->ls('-lR');

# Set the transfer mode to binary

$ftp->binary or

die "Cannot set binary mode: $!";

# Create a list of files we want to get

@files = ();

foreach $file (parse_dir(\@ls)) {

my($name, $type, $size, $mtime, $mode) = @$file;

# We only want to process plain files

next unless($type eq 'f');

# Check age of file against $age

if($^T - $mtime < $age) {

push(@files, $name);

}

}

# The maximum number of connections to make

$max_connection = 4;

$max_connection = @files

if(@files < $max_connection);

# Create a list of connections, we already have one

@ftp = ($ftp);

for($i = 1 ; $i < $max_connection ; $i++) {

my $ftp = connection();

$ftp->binary or

die "Cannot set binary mode: $!";

push(@ftp, $ftp);

}

print "Using ",scalar(@ftp)," connections,\n";

print " to download ",scalar(@files)," files.\n";

# Keep a list of data connections

@data = ();

# Initialise the fdset to be empty

$fdset = "";

# Prime the ftp servers with RETR commands

while(@ftp && @files) {

my $ftp  = shift @ftp;

my $file = shift @files;

my($data,$fh) = init_xfer($ftp, $file);

push(@data, [$data, $fh]);

}

# Close any unused connections

while(@ftp) {

my $ftp  = shift @ftp;

$ftp->close or

warn "Cannot close connection cleanly: $!";

}

# Loop while we have connections, connections will be closed

# and removed from @data when xfer's finish and @files is empt\

y

while(@data) {

$nfound = select($rout=$fdset, undef, undef, undef);

next

unless($nfound);

die "select: $!"

if($nfound == -1);

my @d = @data;

# Empty @data, connections will be added back

# into @data if they are still in use

@data = ();

foreach $con (@d) {

my($data,$fh) = @$con;

# Do we have data waiting on this data

# connection ?

if(vec($rout, fileno($data),1)) {

my $buf = "";

# Read some data, this may block as there

# may not be 1024 bytes ready for reading

# but we cannot tell, If we want to

# reduce the possible blocking time then

# use a smaller number

my $l = $data->read($buf, 1024);

die "Error reading data: $!"

if($l < 0);

if($l) {

# Write the data to the local file

syswrite($fh, $buf, $l)

}

else {

# The data transfer is complete, do

# the necessary ftp commands to

# close the data connection

my $ftp = finish_xfer($data, $fh);

# If the are still files left to pull

# then reuse this ftp connection

# for another xfer

if(@files) {

my $file = shift @files;

@$con = init_xfer($ftp, $file);

}

else {

# else close the ftp connection

# and remove it from @data

$ftp->close or

warn "Cannot close connection cleanly:\

$!";

# undef $con denotes that the connection

# is no longer in use

undef $con;

}

}

}

# If the connection is still in use then

# place if back into @data

push(@data, $con)

if(defined $con);

}

}

# We are done !

exit;

# Create a new connection to the ftp server

sub connection {

# Create a new NET::FTP object

# NOTE: I have also changed the timeout

# value to be 60 seconds

$ftp = Net::FTP->new($CPANhost, Timeout => 60) or

die "Cannot contact $CPANhost: $!";

# We shall login to the ftp server as anonymous

# Specifying a login id stops any netrc lookup

$ftp->login('anonymous') or

die "Cannot login ($CPANhost):" . $ftp->message;

# Change the working directory

$ftp->cwd($CPANpath) or

die "Cannot change directory ($CPANhost):" . $ftp->\

message;

$ftp;

}

# Initialise a file transfer

sub init_xfer {

my($ftp,$file) = @_;

# Send the retr command, and get a file descriptor

# for the socket

my $data = $ftp->retr($file) or

die "Cannot retrieve file '$file': $!";

# Locally store all files in the current

# directory

my $path = $file;

$path =~ s,.*/([^/]+)\Z,$1,;

# Open a filehandle to the local file

my $fh = FileHandle->new($path,"w") or

die "Cannot open file '$path': $!";

print "Retrieving $file as $path ...\n";

# Add data connection into fdset for select()

vec($fdset, fileno($data),1) = 1;

($data, $fh);

}

# Cleanup after a file transfer has completed

sub finish_xfer {

my($data, $fh) = @_;

# Get the ftp command object

my $ftp = $data->cmd;

# Remove data connection from fdset for select()

vec($fdset, fileno($data),1) = 0;

# Close the data connection

$data->close or

warn "Cannot close data connection: $!";

# Close the local file

close($fh) or

warn "Cannot close filehandle: $!";

$ftp;

}

Issue_03_FTP 3. sequential_reads_and_writes

Download sequential_reads_and_writes

#!/usr/bin/perl

use Net::FTP;

# Create connections to the remote servers

$ftpf = Net::FTP->new('from') or

die "Cannot connect to 'from': $!";

$ftpd = Net::FTP->new('dest') or

die "Cannot connect to 'dest': $!";

# login to the servers

$ftpf->login('anonymous') or

die "Cannot login to 'from'";

$ftpd->login('anonymous') or

die "Cannot login to 'dest'";

# Place both servers into the correct transfer

# mode. In this case I am using ASCII

$ftpf->ascii() &&  $ftpd->ascii() or

die "Cannot set ASCII mode: $!";

# Send the RETR command to the source server

# and obtain a file descriptor

$ffile = '/pub/testfile';

$fdf = $ftpf->retr($ffile) or

die "Cannot retrieve '$ffile': $!";

# Send the STOR command to the destination server

# and obtain a file descriptor

$sfile = '/pub/outfile';

$fdd = $ftpd->stor($sfile) or

die "Cannot store '$sfile': $!";

# Read and write the data between the two

# file descriptors

while($fdf->read($buf,1024)) {

$fdd->write($buf, length $buf);

}

# Close the connections

$fdf->quit() &&  $fdd->quit() or

die "Cannot close connections: $!";

$ftpf->quit() && $ftpd->quit() or

die "Cannot quit ftp connections: $!";

exit;

Issue_03_FTP 4. pasv

Download pasv

#!/usr/bin/perl

use Net::FTP;

# Create connections to the remote servers

$ftpf = Net::FTP->new('from') or

die "Cannot connect to 'from': $!";

$ftpd = Net::FTP->new('dest') or

die "Cannot connect to 'dest': $!";

# login to the servers

$ftpf->login('anonymous') or

die "Cannot login to 'from'";

$ftpd->login('anonymous') or

die "Cannot login to 'dest'";

# Place both servers into the correct transfer

# mode. In this case I am using ASCII

$ftpf->ascii() &&  $ftpd->ascii() or

die "Cannot set ASCII mode: $!";

# Send the PASV command to the destination server

# This will return a port address

$port = $ftpd->pasv or

die "Cannot put ftp host in passive mode: $!";

# Send this port address to the source server

# as the port to connect to for the next data

# transfer

$ftpf->port($port) or

die "Error sending port: $!";

# Send the RETR and STOU commands to the servers

$rfile = '/pub/testfile';

$ftpf->retr($rfile) or

$ftpf->ok or die "Cannot retrieve '$rfile': $!";

$sfile = '/pub/outfile';

$ftpd->stou($sfile) or

die "Cannot store '$sfile': $!";

# Wait for the transfer to complete

$ftpd->pasv_wait($ftpf) or

die "Transfer failed: $!";

# Close the connections

$fdf->close() &&  $fdd->close() or

die "Cannot close connections: $!";

$ftpf->quit() && $ftpd->quit() or

die "Cannot quit ftp connections: $!";

exit;

Issue_03_FTP 5. More Samples on FTP

• Issue_03_FTP