#!/usr/local/bin/perl
#
# LookingGlass 
#
# ftp batch upload client
#
# See __END__ for pod documentation
#
#----------------------------------
# Version      Changes
# ---------------------------------
#  0.1         First alpha release
#
# --------------------------------  compiler pragmas and modules

use strict;

use ConfigReader::DirectiveStyle;
use File::Basename;
use File::Copy;
use Getopt::Long;
use Net::FTP;
use Net::Time;
use Time::CTime;
use Time::ParseDate;

# ------------------------------  main program variables

my (%found) = {};               # hash of files found on server
my (@files) = ();               # list of files found on server
my ($files) = "";               # pointer to temp. array of files
my ($dirs)  = "";               # pointer to temp. array of directories
my($arg) = "";                  # scratch filename container for loops
my (@dirstack) = ();            # stack of directories
my ($target) = "";              # current directory to traverse
my (@remote_files) = ();        # array of refs to arrays containing stat() info
my (@local_files) = ();         # array of refs to arrays containing stat() info
my (@local_dirs) = ();          # array of (non-unique) local directories
my (@remote_dirs) = ();         # array of (non-unique) remote directories
my (%remote_dirs) = {};         # hash of remote dirnames
my (%local_dirs) = {};          # hash of local dirnames
my (%remfiles) = {};            # hash of remote filenames; val = mtime
my (%localfiles) = {};          # hash of local filenames; val = mtime
my (@uploads) = ();             # list of files to upload
my (@downloads) = ();           # list of files to download
my (@deletions) = ();           # list of files to delete from remote server
my (@gets) = ();                # list of files to fetch from remote server
my ($remtime) = 0;              # remote server time
my ($loctime) = 0;              # local host time
my ($skew) = 0;                 # clock skew correction coefficient
my ($key) = "";                 # hash iteration scratch var
my ($val) = "";                 # hash iteration scratch val
my ($noremote) = 0;             # flag: if 1, there are no files on remote

# ----------------------------  set up configuration variables - default

my ($default_config) = 
       "/etc/lookingglass.conf"; # defailt config file

fileparse_set_fstype();          # initialize the local filesystem type

# ------------------------------  setup config file options

my ($c) = new ConfigReader::DirectiveStyle;
$c->directive('HostName', undef, 'localhost');
$c->directive('SourceDir', undef, `pwd`);
$c->directive('TargetRoot', undef, '/incoming');
$c->directive('UID', undef, 'ftp');
$c->directive('Password', undef, 'user@host');
$c->directive('DelRemote', undef, 0);
$c->directive('GetRemote', undef, 0);
$c->directive('Debug', undef, 0);
$c->directive('Logfile', undef, '/tmp/lookingglass.log');

# ------------------------------  read and parse config file 

$c->load($default_config);

# ------------------------------  assign config items to variables

my ($sourcedir) = $c->value("SourceDir");
chomp ($sourcedir);         # default directory to upload
my ($hostname)  = $c->value("HostName");
                                # host to upload to -- default, local
my ($targetroot)= $c->value("TargetRoot");
                                # default target directory to upload into
my ($uid)       = $c->value("UID");
                                # default to anonymous ftp
my ($pass)    = $c->value("Password");
my ($help)      = "";
my ($delremotefiles) = $c->value("DelRemote");
                                # remote file deletion flag
my ($getremotefiles) = $c->value("GetRemote");
                                # remote file get flag
my ($logfile) = $c->value("Logfile");
                                # remote file to log to
my($DBG) = $c->value("Debug");  # debug level

# ------------------------------  override config from command line 

GetOptions("source=s"       => \$sourcedir,
           "so=s"           => \$sourcedir,
           "host=s"         => \$hostname,
           "ho=s"           => \$hostname,
           "root=s"         => \$targetroot,
           "ro=s"           => \$targetroot,
           "uid=s"          => \$uid,
           "pw=s"           => \$pass,
           "lo=s"           => \$logfile,
           "logfile=s"      => \$logfile,
           "del!"           => \$delremotefiles,
           "get!"           => \$getremotefiles,
           "debug=i"        => \$DBG,
           "help!"          => \$help);

# -----------------------------  issue help message, if needed

if ($help > 0) {
   print "\nLookingGlass 0.1\n", 
         "Recursively send a tree of files up to a server via ftp\n",
         "overwriting and deleting the old tree along theway.\n",
         "\nOptions:\n",
         "--source=<dir>, --so=<dir>   Source directory for files to send\n",
         "--host=<name>, --ho=<name>   Hostname to upload files to\n",
         "--root=<dir>,  --ro=<dir>    Directory to root files in on server\n",
         "--logfile=<fn>, --lo=<fn>    Filename to log session to\n",
         "--uid=<id>                   User ID to log into ftp server with\n",
         "--pw=<pass>                  Password to use on server\n",
         "--del                        Delete remote files if local has gone\n",
         "--get                        Get remote file if newer than local\n",
         "--debug=<n>                  Set debugging output (n = 1...4)\n",
         "--help                       This message\n\n",
         "WARNING: do not use the --pw option if you are working on a\n",
         "machine with other people logged in! They can use the ps(1)\n",
         "command to capture your password! If you don't specify a password\n",
         "on the command line, LookingGlass will prompt for one.\n\n";
   exit 0;  
}

# -----------------------------  move to base dir and start logging

my ($name, $basedir, $suffix) = fileparse($sourcedir); 
chdir($basedir) || die "Could not enter $basedir!\n";

if ($logfile ne "") {
    open (LOG, ">>$logfile") || warn "Could not append log info to $logfile\n";
} else {
    open (LOG, ">-") || warn "Could not attach LOG handle to STDOUT\n";
}

print LOG "\n", "new LookingGlass session started at ", ctime(time), "\n",
          "source => $sourcedir\n",
           "host  => $hostname\n",
           "root  => $targetroot\n",
           "uid   => $uid\n",
           "pw    => $pass\n", "\n";

# -----------------------------  create new FTP session object; get password

my($ftp) = Net::FTP->new($hostname);

if ($pass eq "") {
    print "Enter password for [$uid\@$hostname]:";
    system("stty -echo");
    $pass = <>;
    chomp($pass);
    print "\n";
    system("stty echo");
}

$ftp->login($uid, $pass) || abend ($ftp, 
                                 "ftp->login($uid) failed");

$ftp->binary() && print LOG "mode set to binary\n";

# -----------------------------  check that we're not talking to an alien

my ($syst_type)     = $ftp->quot("SYST");
my ($syst_response) = "";
($DBG > 3) && print "ftp hash contains [", join('][', keys %{*$ftp}), "]\n";
my ($key, $value);
while (($key, $value) = each %{*$ftp}) {
    if ($key eq "net_cmd_resp") {
        my (@tmp_arr) = @$value;
        chomp(@tmp_arr);
        $syst_response = join(" ", @tmp_arr);
    }
}

if ($syst_type == 2) {
    if ($syst_response !~ /unix/i) {
        if ($syst_response !~ /not understood/i) {
            abend($ftp, "ftp->quot(SYST) returned $syst_type: [$syst_response]");
        }
    }
} else {
    abend($ftp, "ftp->quot(SYST) returned $syst_type");
}

# -----------------------------  avoid clock skew

# note: this only needs to be accurate to within 60 seconds -- granularity of
# time stamps returned by ftp->ls().
$loctime = Net::Time::inet_time('localhost', 'tcp');
$remtime = Net::Time::inet_time($hostname, 'tcp') || 
           Net::Time::inet_time($hostname, 'udp') || undef;

($DBG > 1) && print "inet_time($hostname) is [$remtime]\n";
($DBG > 1) && print "inet_time(localhost) is [$loctime]\n";

if (defined ($remtime)) {
     $skew = $loctime - $remtime;
     ($DBG > 1 ) && print "clock skew adjustment coefficient: [$skew]\n";
}

# -----------------------------  run transfer session

#
# First, work out what files we have locally and on the remote server
#

($DBG > 1) && print "scanning remote files using dir_files_remote()\n";
push (@dirstack, $targetroot);
while ($target = pop(@dirstack)) {
    $ftp->ls($target) || next;
    ($dirs, $files) = dir_files_remote($ftp, $target);
    push(@dirstack, @$dirs);
    push(@remote_dirs, @$dirs);
    foreach $target (@$files) {
        # print LOG "deleting ftp://$hostname$target\n";
        push(@remote_files, $target);
    }
}

($DBG > 1) && print "scanning local files using dir_files_local()\n";
undef @dirstack;
my (@dirstack) = ($sourcedir);
while ($target = pop(@dirstack)) {
    ($dirs, $files) = dir_files_local($target);
    push(@dirstack, @$dirs);
    push(@local_dirs, @$dirs);
    foreach $target (@$files) {
        # print LOG "deleting ftp://$hostname$target\n";
        push(@local_files, $target);
    }
}

# status: @remote_files contains remote files on server; @local_files
# contains file on local system. Now we need to do the comparison by
# mtime field (field #9 (index 0) of the stat() structure in $$local_files
# and date encoded in fields 5-6-7 of the $$remote_file items.

# We add $skew to mtime on the local host to correct it relative to the
# remote values.

# Now let's build a table of remote files; key = file pathname, val = mod time

if (scalar(@remote_files) != 0 ) {
    my ($maxsub) = scalar(@{@remote_files[1]}) -1;
    foreach $arg (@remote_files) {
        next if (! defined $arg->[$maxsub]);
        my ($key) = $arg->[$maxsub];
        $key =~ s/$targetroot//;
        my ($val) = $arg->[7] . " " . $arg->[6] . " " . $arg->[5];
        $val = parsedate($val);
        $val += $skew;
        $remfiles{$key} = $val;
        ($DBG > 3) && print "$key => $val\n";
    }
} else {
    # remote dir is empty
    $noremote = 1;
}

# now do the same for local files

($DBG > 3) && print "\n\nsourcedir is $sourcedir\n\n";
my ($maxsub) = scalar(@{@local_files[1]}) -1;
foreach $arg (@local_files) {
    my ($key) = $arg->[$maxsub];
    $key =~ s/$sourcedir//;
    my ($val) = $arg->[9];
    $localfiles{$key} = $val;
    ($DBG > 3) && print "$key => $val\n";
}

# build list of files to upload to server, list of dirs to create on server

while (($key, $val) = each (%localfiles)) {
    if (! defined ($remfiles{$key}) ) {
        # local file doesn't exist in remote tree, so send it
        push(@uploads, $key);
        ($DBG > 2) && print "Upload new file: $key\n";
    } elsif ($localfiles{$key} > $remfiles{$key}) {
        # local date more recent than remote date, so send it
        push(@uploads, $key);
        ($DBG > 1) && print "Update new file: $key\n";
        ($DBG > 2) && print "\tlocal time:  $localfiles{$key}\n",
                            "\tremote time: $remfiles{$key}\n";
    }
}

# build lists of files to delete or download from server

if (! $noremote) {
    while (($key, $val) = each (%remfiles)) {
        if (!defined ($localfiles{$key})) {
            if ($delremotefiles > 0) {
                # file no longer exists in local tree, so delete it
                push(@deletions, $key);
                ($DBG > 2) && print "Delete defunct file: $key\n";
            }
        } 
        if (( -f "$sourcedir$key") && 
            ($remfiles{$key} > $localfiles{$key})) {
            if ($getremotefiles > 0) {
                # remote file is more recent than local file, so get it
                push(@gets, $key);
                ($DBG > 2) && print "Get remote file: $key\n";
                ($DBG > 3) && print "local time: $localfiles{$key} ",
                                    "remote time: $remfiles{$key}\n";
            }
        }
    }
}

# warn if nothing to do 

if ((scalar(@uploads)   == 0) &&
    (scalar(@gets)      == 0) &&
    (scalar(@deletions) == 0)) {
    ($DBG > 0) && print 'scalar(@uploads)= ', scalar(@uploads), "\n",
                        'scalar(@gets) = ', scalar(@gets), "\n",
                        'scalar(@deletions) = ', scalar(@deletions), "\n";
    abend ($ftp, "Absolutely no files tagged for upload, download, or deletion!");
}


# use @remote_dirs and @local_dirs to build unique hash of valid dirnames
# on both sites, so we can use defined($remote_dirs{foo}) to see if a 
# directory called "foo" exists on the remote host.

%remote_dirs = {}; # hash of directory names; val = irrelevant
%local_dirs = {}; # hash of directory names; val = irrelevant

@remote_dirs = map {$remote_dirs{$_}++ } @remote_dirs;
@local_dirs = map {$local_dirs{$_}++ } @local_dirs;

if ($DBG > 2) {
    print "Remote dirs:\n";
    foreach (sort keys %remote_dirs) {
         print "$_\n";
    }
    print "Local dirs:\n";
    foreach (sort keys %local_dirs) {
         print "$_\n";
    }
}

print LOG "updating files:\n";

# create non-existent remote directories using %local_dirs

foreach (sort keys %local_dirs) {
    $_ =~ s/$sourcedir/$targetroot/;
    if (! defined $remote_dirs{$_}) {
        ($DBG > 2) && print "Directory $_ not present on remote server\n";
        # $_ =~ s/$targetroot\///;
        ($DBG > 1) && print "mkdir($_, RECURSE) ...";
        if ($ftp->mkdir($_, 1) ) {
            ($DBG > 1 ) && print " FAILED!\n";
        } else {
            ($DBG > 1 ) && print " OK\n";
        }
    }
}

# upload files to remote server

while ($target = pop(@uploads)) {
     ($DBG > 1 ) && print "processing upload($target)\n";
     my ($src) = "$sourcedir$target";
     my ($dst) = "$targetroot$target";
     $ftp->put($src, $dst) && print LOG "$src -> $dst\n";
     print "$src -> $dst\n";
}

if ($getremotefiles > 0) {
    # if get is set,
    # create non-existent local dirs using %remote_dirs

    foreach (sort keys %remote_dirs) {
        $_ =~ s/$targetroot/$sourcedir/;
        if (! defined $local_dirs{$_}) {
            ($DBG > 2) && print "Directory $_ not present on local host\n";
            $_ =~ s/$sourcedir\///;
            my (@dstack) = split("/", $_);
            my ($thisdir) = "";
            my ($buff) = $sourcedir;
            ($DBG > 2) && print "dstack: [", join("][", @dstack), "]\n";
            foreach $thisdir (@dstack) {
                # next if ($thisdir eq "");
                $buff .= "/" . $thisdir  ;
                print "buff is $buff\n";
                if (! -d $buff) {
                     ($DBG > 2) && print "mkdir($buff) ... ";
                     if (mkdir($buff, 0755) == 0) {
                          print "ERROR!\n";
                     } else {
                          print "OK\n";
                     }
                } else {
                     print "something called $buff exists\n";
                }
            }
        }
    }
    # get remote files 

    while ($target = pop(@gets)) {
         ($DBG > 1 ) && print "processing download($target)\n";
         my ($src) = "$targetroot$target";
         my ($dst) = "$sourcedir$target";
         $ftp->get($src, $dst) && print LOG "$src -> $dst\n";
         print "$src -> $dst\n";
    }
}

if ($delremotefiles > 0) {
    my (%touched_dirs) = {}; # table of dirs we deleted files from
    # if del is set,
    # delete remote files
     while ($target = pop(@deletions)) {
         ($DBG > 1 ) && print "processing deletion($target)\n";
         my ($src) = "$targetroot$target";
         $ftp->delete($src) && print LOG "deleted($src)\n";
         print "deleted($src)\n";
         my ($f, $b, $ex) = fileparse($target);
         $touched_dirs{$b}++;
         ($DBG > 2) && print "touched_dirs{$b}++\n";
    }
    # if directories are emptied by this, remove them
    my ($deldir) = "";
    my (@ls) = ();
    foreach $deldir (keys %touched_dirs) {
        $deldir =~ s/\/$//;
        @ls = $ftp->ls("$targetroot$deldir");
        ($DBG > 3) && print "dir $targetroot$deldir; contents:\n [", 
                      join("][", @ls), "]\n";
        if (scalar(@ls) == 0) {
            ($DBG > 1) && print "rmdir($targetroot$deldir) ... ";
            if ($ftp->rmdir("$targetroot$deldir")) {
                 ($DBG > 1) && print "OK\n";
            } else {
                 ($DBG > 1) && print "Failed!\n";
            }
        }
    }
}


print LOG "Session finished at ", ctime(time), "\n";
$ftp->quit || die "ftp session failed to exit properly!\n";
exit 0;

#---------------------------------  end of main program -- subroutines follow

sub dir_files_remote {
    # build an array containing a LONG listing of all files on the remote host
    # format is an array of arrays; each file array consists of ls -l output
    # with file's pathname appended as final field
    my ($f) = shift @_;
    my ($d) = shift @_;
    my (@files) = ();
    my (@dirs) = ();
    my ($listing) = "";

    $listing = $f->dir($d) || abend ($f, "f->dir($d) failed");
    if (ref ($listing) ) {
        foreach $_ (@{$listing}) {
            if (/^drwx/) {
                my ($fn) = $_;
                my (@fvec) = split(" ", $_);
                if ($fvec[$#fvec] !~ /\.+/) {
                    push(@dirs, "$d/$fvec[$#fvec]");
                }
                # push (@files, "$d/$fn);
            } else {
                my (@st) = split(" ", $_);
                push(@st, "$d/$st[$#st]");
                push(@files, \@st);
            }
        }
    }
    return (\@dirs, \@files);
}

sub dir_files_local {
    # build an array containing a LONG listing of all files on the local host
    my ($d) = shift @_;
    my (@files) = ();
    my (@dirs) = ();
    my (@contents) = ();
    if ( -d $d  &&  -r _ && -x _  ) {
        opendir (DIR, $d) || warn "could not open $d\n";
        @contents = readdir DIR;
        closedir(DIR);
        foreach (@contents) {
            if (-d "$d/$_") {
                if ($_ !~ /^\.+/) {
                    push (@dirs, "$d/$_");
                }
            } elsif ( -f "$d/$_" ) {
                my (@st) = stat("$d/$_");
                push(@st, "$d/$_");
                push (@files, \@st);
            }
        }       
    } 
    return \@dirs, \@files;
}

sub abend {
    # exit, giving some kind of appropriate warning
    #
    my ($session, $message) = @_;
    print $message, " at ", ctime(time), "\n";
    print LOG $message, " at ", ctime(time), "\n";
    close LOG;
    if (ref ($session) eq "Net::FTP") {
        $session->quit || die "abend(): Session failed to exit properly!\n";
    } else {
        print "abend(): I was expecting a Net::FTP object,\n",
              "but you passed me a [", (ref($session)|| "scalar"), "]\n\n";
    }
    exit 1;
}

#-----------------------------------  POD documentation follows

__END__

=head1 NAME

LookingGlass - batch ftp pusher client

The opposite of mirror.pl; push a tree of directories up to an ftp server.

=head1 Configuration

Supports configuration via a configuration file and command line switches.

=head2 Configuration file

The following options are available:

=over 4

=item HostName

(Default: localhost) Specifies the hostname of the ftp server to connect to

=item SourceDir

(Default: `pwd`) Specifies  the root of the directory tree to upload

=item TargetRoot

(Default: '/incoming') Specifies the directory to upload SourceDir into

=item UID

(default: 'ftp') Specifies the User ID to log into the ftp server under

=item Password

(default: 'user@host') Specifies the password for User ID to log in with

=item LogFile

(default: '/tmp/lookingglass.log') Name of file to log session to

=item DelRemote

(default: 0) If non-zero, indicates that LookingGlass should delete
files on the server that no longer exist under SourceDir

=item GetRemote

(default: 0) If non-zero, indicates that LookingGlass should download
files from the server that are newer than the local copy, or that do not
exist locally

=item Debug

(default: 0) Enables debugging output of increasing verbosity when set
in the range 1 to 4

=back

=head2 Command Line Options

Run LookingGlass with the --help option; it will print out all currently
recognized options then exit. (These correspond to the configuration
file options described above.)

Command line parameters I<override> options read from the configuration file.

If no password is specified in the configuration file or on the command
line, LookingGlass will stop and prompt for one.

=head1 DESCRIPTION

LookingGlass is designed to facilitate the easy uploading of an entire
directory tree to an ftp server. In this way, it is the opposite of
mirror, which is designed to facilitate the easy downloading of an
entire directory tree from a server.

(It was written for batch uploading of HTML and related files to a web
server with an ftp server running on top of the public_html
directories.)

=head1 Known defects

=over 4

=item 1

LookingGlass uploads a file if the local file creation time is later
than the remote file creation time. It makes no allowances for clock
skew or time zone differences (in this version). (Note: this is top of
the to-do list.)

=item 2

LookingGlass assumes that the ftp account is correctly set up; in
particular, that B<ls>, B<mkdir>, and a few other commands are working.
If they aren't, you're out of luck (in this release, at least).

=item 3

LookingGlass assumes that the remote server understands UNIX pathnames.
It also assumes that it is running on a UNIX-like system. (Developed on
Linux, to be precise.) It does a cursory check on the remote server
using SYST, to ensure it's not an alien, but if the server I<is> an
alien with eldritch pathnames and doesn't implement SYST you're 
in the Twilight Zone.

=item 4

Using LookingGlass you can very easily B<DESTROY LOTS OF FILES> by
accident! Be extremely cautious using this tool, and practice first with
a copy of your source directory tree on a safe area of your ftp server!

=back

LookingGlass relies on Perl 5.002, the standard module library, and the
following additional modules, without which it will not run:

=over 8

=item ConfigReader

=item Net::FTP (from libnet 1.01)

=item Time::CTime and Time::ParseDate (from Time-modules and TimeDate)

=back

These modules are all available from CPAN.


=cut