Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Perl FTP

by Khürt (Initiate)
on Oct 23, 2000 at 21:47 UTC ( #37971=sourcecode: print w/ replies, xml ) Need Help??

Category: FTP stuff
Author/Contact Info khurt@williamsinteractive.com
Description:
ftp.pl [-netrc] [-u <i>user</i>] [-p <i>passwd</i>] -m server -s source_dir -t target_dir [-log_dir <i>/path/to/logs/file</i>] file1 file2 ...

# Copyright 2000 Williams Interactive, Inc.
# Programmer: Khurt Williams, 2000.10.18
# command switches are
# -netrc : uses .netrc file to find user/passwd for the destination server 
# -u <i>user</i> : specify the user id
# -p <i>passwd</i> :specify the passwd for user id
# -m server : server ip or name
# -s source_dir : source dir
# -t target_dir : target dir
# -log_dir <i>/path/to/logs/file</i> : location of log file
#!/usr/local/bin/perl -w
# Copyright 2000 Williams Interactive, Inc.
# Programmer: Khurt Williams, 2000.10.18
# command switches are
# [-netrc] : uses .netrc file to find user/passwd for the destination 
+server 
# [-u user] : specify the user id
# [-p passwd] :specify the passwd for user id
# -m server : server ip or name
# -s source_dir : source dir
# -t target_dir : target dir
# [-log_dir /path/to/log] : location of log file

use strict;
use Getopt::Long;
use Net::FTP;
use Net::Netrc;
use Log::ErrLogger;

my ($log_file,@file_list,$file,$return_code);
my ($netrc,$server,$source,$target,$user,$passwd,$log_dir,$ftp);
my ($machine,$login,$password);
my $options = { netrc => \$netrc, m => \$server, s => \$source, t => \
+$target, u => \$user, p => \$passwd, log_dir => \$log_dir };

GetOptions($options, "netrc","m=s","s=s","t=s","u:s","p:s","log_dir:s"
+);

@file_list = @ARGV;

#make sure we have some filename
usage() if( !defined(@file_list) );

#use netrc
if( $netrc ) {
#exit if not server specified
 usage () if( !defined($server) );
#make sure we use the correct userid
 if( !defined($user) ) {
  $machine = Net::Netrc->lookup($server);
 }
 else {
  $machine = Net::Netrc->lookup($server,$user);
 }
#get login id and password for that server
 $login = $machine->login();
 $password = $machine->password();

 $user = $login;
 $passwd = $password;
}

#check that command line switches are set
usage() if( !defined($user) || !defined($passwd) || !defined($server) 
+);
usage() if( !defined($source) || !defined($target) );

#append to log file if it already exist
$log_dir = "/tmp" if( !defined($log_dir) );
#log all event to file including die and warn
$log_file = new Log::ErrLogger::File( FILE => ">$log_dir/SendToML.log"
+,SENSITVITY => Log::ErrLogger::ALL );

#connect to server
$ftp = new Net::FTP($server);
Log::ErrLogger::log_error(Log::ErrLogger::INFORMATIONAL,__FILE__." ftp
+ started.\n");
Log::ErrLogger::log_error(Log::ErrLogger::INFORMATIONAL,"ftp $server\n
+");
#exit and log message on failure
die($ftp->message()) if( !($ftp->login($user,$passwd)) );

#set mode to binary
Log::ErrLogger::log_error(Log::ErrLogger::INFORMATIONAL,"bin\n");
#exit and log message on failure
die($ftp->message()) if( !($ftp->binary()) );

#change local directory
chdir($source);
Log::ErrLogger::log_error(Log::ErrLogger::INFORMATIONAL,"lcd $source\n
+");

#change remote directory
Log::ErrLogger::log_error(Log::ErrLogger::INFORMATIONAL,"cd $target\n"
+);
#exit and log message on failure
die($ftp->message()) if( !($ftp->cwd($target)) );

foreach $file (@file_list) {
#send files to server
 Log::ErrLogger::log_error(Log::ErrLogger::INFORMATIONAL,"put $file $f
+ile\n");
 retry_put($file) if( !($ftp->put($file,$file)) );
}

#close connection
$return_code = $ftp->quit();
Log::ErrLogger::log_error(Log::ErrLogger::INFORMATIONAL,"quit\n");
Log::ErrLogger::log_error(Log::ErrLogger::INFORMATIONAL,__FILE__." ftp
+ ended.\n");

#end logging
$log_file->close();

exit(0);

sub usage {
 die "$0 [-netrc] [-u user] [-p passwd] -m [server]  -s [source_dir] -
+t [target_dir] [-log_dir [/path/to/logs/file]] file1 file2 ...\n";
}

#resend file if first attempt fails
#remove file if second attemp also fails.
sub retry_put {
 my ($file) = @_;

 warn($ftp->message());
 Log::ErrLogger::log_error(Log::ErrLogger::INFORMATIONAL,"Will attempt
+ to resend file %s.\n",$file);

 warn($ftp->message()) if( !($ftp->quit()) );
 Log::ErrLogger::log_error(Log::ErrLogger::INFORMATIONAL,"quit\n");

 $ftp = new Net::FTP($server);
 Log::ErrLogger::log_error(Log::ErrLogger::INFORMATIONAL,"ftp $server\
+n");
 die($ftp->message()) if( !($ftp->login($user,$passwd)) );

 Log::ErrLogger::log_error(Log::ErrLogger::INFORMATIONAL,"cd $target\n
+");
 die($ftp->message()) if( !($ftp->cwd($target)) );

 Log::ErrLogger::log_error(Log::ErrLogger::INFORMATIONAL,"put $file $f
+ile\n");
 remove_file($file) if( !($ftp->put($file,$file)) );
}

sub remove_file {
 my ($file) = @_;

 warn($ftp->message());
 Log::ErrLogger::log_error(Log::ErrLogger::INFORMATIONAL,"Resend of $f
+ile failed.\n");
 Log::ErrLogger::log_error(Log::ErrLogger::INFORMATIONAL,"Will attempt
+ to remove half baked file $file.\n");

 warn($ftp->message()) if( !($ftp->quit()) );
 Log::ErrLogger::log_error(Log::ErrLogger::INFORMATIONAL,"quit\n");

 $ftp = new Net::FTP($server);
 Log::ErrLogger::log_error(Log::ErrLogger::INFORMATIONAL,"ftp $server\
+n");
 die($ftp->message()) if( !($ftp->login($user,$passwd)) );

 Log::ErrLogger::log_error(Log::ErrLogger::INFORMATIONAL,"cd $target\n
+");
 die($ftp->message()) if( !($ftp->cwd($target)) );

 Log::ErrLogger::log_error(Log::ErrLogger::INFORMATIONAL,"delete $file
+\n");
 warn($ftp->message()) if( !($ftp->delete($file)) );
}

Comment on Perl FTP
Download Code
RE: Perl FTP
by princepawn (Parson) on Oct 24, 2000 at 16:22 UTC
    as a related FTP shell, please see my CPAN module, Net::FTP::Shell

    I like your use of Net::Netrc. I didn't know about this module.

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://37971]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (11)
As of 2014-10-31 21:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (225 votes), past polls