#!/usr/local/bin/perl

use strict;
use File::Basename;
use File::Recurse;
use File::Copy;
use Net::FTP;
use Getopt::Long;
use Time::CTime;
fileparse_set_fstype();

my ($sourcedir) = `pwd`;
chomp ($sourcedir);             # default directory to upload
my ($hostname)  = "localhost";  # host to upload to -- default, local
my ($targetroot)= "/incoming";  # default target directory to upload into
my ($uid)       = "ftp";        # default to anonymous ftp
my ($basepw)    = 'ftp@' . `uname -n`;   
                                # default password to send
my ($pass)      = "";           # password container
my ($help)      = "";

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 (@dirstack) = ();            # stack of directories
my ($target) = "";              # current directory to traverse
my ($logfile) = "";             # file to log session to


# set up command line options

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,
           "help!"          => \$help);

# issue help message, if needed

if ($help > 0) {
   print "\nmetaput -- put html tree on server\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",
         "--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, metaput will prompt for one.\n\n";
   exit 0;  
}

my ($name, $basedir, $suffix) = fileparse($sourcedir);# rootdir
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 metaput session started at ", ctime(time), "\n",
          "source => $sourcedir\n",
           "host  => $hostname\n",
           "root  => $targetroot\n",
           "uid   => $uid\n",
           "pw    => $pass\n", "\n";

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";


print LOG "deleting old tree:\n";
push (@dirstack, $targetroot);
while ($target = pop(@dirstack)) {
    $ftp->ls($target) || next;
    ($dirs, $files) = list_files_remote($ftp, $target);
    push(@dirstack, @$dirs);
    foreach $target (@$files) {
        print LOG "deleting ftp://$hostname$target\n";
        $ftp->delete($target);
    }
}

# now we've nuked all the files up there

print LOG "uploading new tree:\n";
push (@dirstack, $sourcedir);
while ($target = pop(@dirstack)) {
    ($dirs, $files) = list_files_local($target);
    if (! ref($dirs)) {
        print LOG "list_files_local($target) failed to return a dir stack\n";
        exit 1;
    }
    push (@dirstack, @$dirs);
    my ($destdir) = $target;
    $destdir =~ s/$sourcedir/$targetroot/;
    $ftp->ls($destdir) || $ftp->mkdir($destdir);
    foreach $target (@$files) {
       my ($destfile) = $target;
       $destfile =~ s/$sourcedir/$targetroot/;
       $ftp->put($target,$destfile) && print LOG "$target -> $destfile\n";
    }
}

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


sub list_files_remote {
    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 (@fvec) = split(/\s+/, $_);
                if ($fvec[$#fvec] !~ /\.+/) {
                    push(@dirs, "$d/$fvec[$#fvec]");
                }
            } else {
                my (@fvec) = split(/\s+/, $_);
                next if ($#fvec ne 8); # 8: number of elements in ls listing
                push(@files, "$d/$fvec[$#fvec]");
            }
        }
    }
    return (\@dirs, \@files);
}

sub list_files_local {

    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/$_" ) {
                push (@files, "$d/$_");
            }
        }       
    } 
    return \@dirs, \@files;
}

sub abend {
    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;
}