# 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.