Autoftp Perl Code

# Automatically FTP files to the web site.
#
# The idea is that the newfiles.txt file indicates which files have been
# updated by the makefile. This approach is more accurate and requires less
# maintenance than the older version of autoftp.pl. Nothing needs to be done
# for new files except update the makefile. Changes to the primary and mirror
# sites only require their information files to be updated.
#
# After successful downloading to the primary and mirror FTP sites the
# newfiles.txt file is removed.
#
#------------------------------------------------------------------------------

require 5.004;

use English;
use strict;
use Time::Local;
use Net::FTP;

my $log_file;
my $primary_info;
my $mirror_info;
my %times;
my @ftp_commands; # List of commands to send to FTP.
my @raw_files; # contents of newfiles.txt
my @files;
my $debug = 0;
my $primary_web;
my $primary_directory;
my $primary_username;
my $primary_password;
my $mirror_web;
my $mirror_directory;
my $mirror_username;
my $mirror_password;

$log_file = "/home/tom/ALL/WWW/newfiles.txt";
$primary_info = "/home/tom/ALL/WWW/primary.inf";
$mirror_info = "/home/tom/ALL/WWW/mirror.inf";

# Only have something to do if there is a list of new files.
if (-f "$log_file") {
 ($mirror_web, $mirror_directory, $mirror_username, $mirror_password) =
 parse_information_file($mirror_info);

 ($primary_web, $primary_directory, $primary_username, $primary_password) =
 parse_information_file($primary_info);

 open FILES, "$log_file" || die "Unable to open file $log_file";
 @raw_files = <FILES>;
 @files = remove_duplicates(@raw_files);
 close(FILES);

 if (put_files($primary_web, $primary_directory, $primary_username,
 $primary_password, @files) &&
 put_files($mirror_web, $mirror_directory, $mirror_username,
 $mirror_password, @files)) {
 unlink($log_file);
 }
}
else {
 print "Unable to find $log_file\n";
}

#------------------------------------------------------------------------------
# Write a file via FTP using the specified user information.
# Parameters:
# hostname - name of the host that contains the file.
# directory - the directory that contains the file.
# username - log in name
# password - duh
# files - the name of the files to get.
# Return value:
# boolean - true if the FTP was successful, false if not.
# Note: the FTP command results are written to archftp.log.
#------------------------------------------------------------------------------
sub put_files {
 my $hostname = shift @_;
 my $directory = shift @_;
 my $username = shift @_;
 my $password = shift @_;
 my @files = @_;
 my $n_files;
 my $file;
 my $base_file;
 my $last_line;
 my $ret;
 my $ftp;

 $n_files = @files;

 clear_ftp();
 if ($n_files > 0) {
 print "FTP to $hostname - ";
 $ftp = Net::FTP->new($hostname, Timeout => 30, $debug => 1) or
 die "Can't connect to $hostname: $ERRNO";
 $ftp->login($username, $password) or
 die "Can't login with <$username> <$password>";
 if ($directory ne "") {
 $ftp->cwd($directory) or
 die "Can't cwd to <$directory>";
 }
 $ftp->type("I"); # binary mode
 foreach $file (@files) {
 $base_file = basename($file);
 if ($base_file eq "index.htm") {
 $ftp->put($base_file, "index.html") or
 die "Can't put $base_file";
 }
 else {
 $ftp->put($base_file) or
 die "Can't put $base_file";
 }
 }
 $ftp->quit() or
 warn "Couldn't quit. Oh well.\n";

 $ret = 1;
 print ($ret ? "succeeded\n" : "failed\n");
 }
 return $ret;
} #put_files


#------------------------------------------------------------------------------
# basename - parallel to the Unix basename command.
# Parameters:
# $file - a file name, potentially with a directory.
# Return value:
# string - just the file part, without the directory.
#------------------------------------------------------------------------------
sub basename {
 my $file = $_[0];
 $file =~ /([^\\\/]*)$/;
 return $1;
} #basename


#------------------------------------------------------------------------------
# Collect commands to send to FTP.
# Parameters:
# line - a new line to send
# Return value:
# none
#------------------------------------------------------------------------------
sub collect_ftp {
 my $line = @_[0];

 push @ftp_commands, $line;
} # collect_ftp


#------------------------------------------------------------------------------
# Clear out list of commands to send to FTP.
# Parameters:
# none
# Return value:
# none
#------------------------------------------------------------------------------
sub clear_ftp {

 @ftp_commands = ();
} # clear_ftp


#------------------------------------------------------------------------------
# Send commands to FTP.
# Parameters:
# args - list of FTP commands
# Return value:
# none
# Note: the FTP command results are written to archftp.log.
#------------------------------------------------------------------------------
sub send_ftp {
 my $line;
 my $command_line;

 if ($debug) {
 print "Entering send_ftp\n";
 }
 $command_line = shift(@_);
 if ($debug) {
 print "send_ftp: command_line=$command_line\n";
 }
 if (open(FTP, "|$command_line>>archftp.log")) {
 for $line (@_) {
 print FTP "$line\n";
 }
 print FTP "disconnect\n";
 print FTP "bye\n";
 close(FTP);
 }
 if ($debug) {
 for $line (@_) {
 print "$line\n";
 }
 print "disconnect\n";
 print "bye\n";
 print "Exiting send_ftp\n";
 }
} # send_ftp


#------------------------------------------------------------------------------
# Scan a site information file and return the site, directory, username and
# password entries.
#
# Parameters:
# file - name of the information file.
# Return value:
# list - site, directory, username, password.
#------------------------------------------------------------------------------
sub parse_information_file {
 my $file = $_[0];
 my $site = "";
 my $directory = "";
 my $username = "";
 my $password = "";
 my $keyword;
 my $value;

 open INFO, "$file" || die "Unable to open FTP site information file $file";
 while (<INFO>) {
 ($keyword, $value) = split;
 if ($keyword eq "site") {
 $site = $value;
 }
 elsif ($keyword eq "directory") {
 $directory = $value;
 }
 elsif ($keyword eq "username") {
 $username = $value;
 }
 elsif ($keyword eq "password") {
 $password = $value;
 }
 else {
 print "Unknown keyword in FTP site information file $file: ";
 print "$keyword\n";
 }
 }

 return ($site, $directory, $username, $password);
} # parse_information_file


#------------------------------------------------------------------------------
# Remove duplicates from a list. A side-effect is that the return values are
# sorted.
#
# Parameters:
# in_list - list which may have duplicate entries.
# Return value:
# out_list - in_list, sorted with duplicates removed.
#------------------------------------------------------------------------------
sub remove_duplicates {
 my @unsorted_in_list = @_;
 my @in_list;
 my @out_list;
 my $element;
 my $last_element;

 @in_list = sort @unsorted_in_list;

 # Prime the pump.
 $element = shift(@in_list);
 chop $element;
 @out_list = ($element);
 $last_element = $element;
 foreach $element (@in_list) {
 chop $element;
 if ($element eq $last_element) {
 next;
 }
 $last_element = $element;
 push(@out_list, $element);
 }
 return @out_list;
} #remove_duplicates

Back to The Information Cave home page

Last modified Mon Apr 26 20:58:57 1999.