# -*- perl -*-
#
#  $Id: Mirror.pm,v 1.38 2004-03-18 17:05:12-07 rrb LANL $
#
#  $Source: /packages/lib/perl5/site_perl/5.8.0/ESM/RCS/Mirror.pm,v $
#  $Revision: 1.38 $ 
#  $Date: 2004-03-18 17:05:12-07 $
#
#  Purpose:
#	Mirror (copy) a remote directory tree locally.
#
#  Author:	Ed Santiago (esm), July, 2000
#  Modification $Author: rrb $
#
package ESM::Mirror;

=head1 NAME

B<ESM::Mirror> - mirror FTP or HTTP directories

=head1 SYNOPSIS

    use ESM::Mirror;

    my $m = new ESM::Mirror ( ARGS );

=head1 DESCRIPTION

Blah Blah Blah

=cut

###############################################################################
# Code Starts Here
###############################################################################

$Revision = "";
$E = "";
$VERSION = "$Revision: 1.38 $E";
$VERSION =~ s/[:\s]//g;

use Carp;
use strict;
use vars qw(@OPTS  $ME  $DEBUG  $QUIET  $NOTIFY  $NONONO  $REGRAB  @LOCKFILES);

# Define my program name.  We use this for displaying status messages
($ME = $0) =~ s,.*/,,;		# My program name
# (If our name is the simple-but-nondescriptive "mirror", find out
# what project we're related to)
if ($ME eq "mirror") {
  if ($0 =~ m!/projects/([^/]+)/!  || $0 =~ m!/esm/tmp/([^/])/!) {
    $ME .= "($1)";
  }
}

$DEBUG = 0;
if (exists $ENV{"DEBUG_MIRROR"} && $ENV{"DEBUG_MIRROR"} =~ /^(\d+)$/) { 
  $DEBUG = $1;	# untaint
}

$| = 1;			# For debugging, force immediate output

umask 002;		# Make default protections rwxrwxr-x (ie, group-write)

#
# When we exit, clear up any existing lockfiles.
#
END {  map { unlink $_ } @LOCKFILES }

################################################################
# Define the valid options

@OPTS = split(/\n/, <<EOP);
host=s         Name of host to connect to
proto=s        Protocol to use.  May be FTP or HTTP
user=s         Name of user on remote machine.  Defaults to anonymous
basedir=s      Top-level directory on remote, e.g., /pub/projects/foo
regrab!        Re-fetch any files that have been updated on remote
sleep=s        Try again after HH:MM:SS, MM:SS, or SS
sleep_until=s  For daily jobs, wake up next day at HH:MM
notify:s       Send e-mail when things happen
lock=s         Prevent multiple jobs from conflicting with each other
daemonize!     Fork into background.  Only useful with a sleep option
quiet!         Don\'t emit progress messages
nonono|n       Don\'t grab anything, just say what we\'re doing
help           This message
EOP

# END option definition
################################################################


#########
#  new  #  instance of a "Mirror" object.
#########
sub new {
  my $class = shift;

  my $self = bless {}, $class;

  # Initialize default values -- they may be overriden by our caller
  $self->{"proto"} = "FTP";

  #
  # Parse command-line options.
  #
  # It would be stupid to require the user to specify "-host", etc, on
  # the command line.  We have a calling script which specifies most of
  # the hardcoded options (host, basedir, etc), but allow the user to
  # add more options, or override others.  Since the Getopt codes all
  # use @ARGV, we use a local definition here, comprising all the args
  # given to us in the initializer.
  #
  use Getopt::Long;
  local (@ARGV) = @_;
  GetOptions($self, map { /^(\S+)/; $1; } @OPTS) || _usage();
  eval "use Data::Dumper; print Dumper(\$self);"		if $DEBUG;
  _usage(1) if $self->{"help"};

  # DANGER WILL ROBINSON: Untaint the options.  I just don't see any
  # possible way we can harm ourselves by accepting user input.
  map { $self->{$_} =~ /^(.*)$/; $self->{$_} = $1; } keys %{$self};

  # Some sanity checks
  croak "You need to define a host to mirror,"	unless defined $self->{"host"};


  # Command-line "-sleep 0" can override settings in main script
  foreach ("sleep","sleep_until") {
    delete $self->{$_} if (exists $self->{$_}) && ($self->{$_} eq "0");
  }

  # "-daemonize" is meaningless without a sleep time
  if ($self->{"daemonize"}) {
    unless (exists $self->{"sleep"} || exists $self->{"sleep_until"}) {
      carp "-daemonize is pretty useless without '-sleep' or '-sleep_until',";
    }

    # Omit printfs
    $self->{"quiet"} = 1;
  }

  # Set up global shortcut names for some, eg, $QUIET = $self->{"quiet"}
  map { 
    eval sprintf("\$%s = \$self->{\"%s\"} || 0", uc $_, lc $_);
  } qw(NONONO NOTIFY QUIET REGRAB);

  # If called with "-d", but no "-notify", set an appropriate notify
  if ($self->{"daemonize"}  &&  $NOTIFY eq "0") {
    $NOTIFY = getlogin || (getpwuid($<))[0] || "esm";
  }

  # If a lockfile exists, make sure no other jobs are running.
  $self->_lock_or_die;

  # If called with a non-anonymous user, request a password
  if (defined $self->{"user"} && $self->{"user"} !~ /^(ftp|anonymous)$/) {
    $self->_read_user_password;
  }

  $self->_unlock();

  # If interrupted from here on, remove the lock file and clean up
  $SIG{INT} = \&_handler;

  return $self;
}


#############
#  connect  #  Start a connection.  
#############
sub connect {
  my $self = shift;

  $self->_lock_or_die();

  my $pkg = sprintf("new %s::%s", ref $self, uc $self->{"proto"} || "FOO");
  # HTTPS (SSL) is handled the same way as HTTP
  $pkg =~ s/::HTTPS/::HTTP/;

  $pkg .= "( %{\$self} )";

  $self->{"session"} = eval $pkg;
  croak "connect: $@" if $@;

  return 1;
}


################
#  disconnect  #  terminate a session.  
################
sub disconnect {
  my $self = shift;

  $self->{"session"} = undef;
  $self->_unlock();
}


##########
#  loop  #  ESM -- need a better name!
##########
sub loop {
  my $self = shift;

  # If asked to daemonize, do so
  $self->_daemonize()				if exists $self->{"daemonize"};

  while (1) {
    # Keep track of the time we started
    my $t_start = time;

    $self->connect;
    foreach my $key (@_) {
      $self->check(%{$key});
    }
    $self->disconnect;

    # If called without a sleep delay or sleep_until time, return to caller
    return unless (exists $self->{"sleep"}) || (exists $self->{"sleep_until"});

    #
    # Sleep until the next time
    #
    my $delay;

    if (exists $self->{"sleep"}) {
      my $sleep = $self->{"sleep"};

      if ($sleep =~ /^(\d+)$/) {			# just seconds
	$delay = 0 + $1;
      } elsif ($sleep =~ /^(\d+):(\d+)$/) {		# mm:ss
	$delay = 0 + $1 * 60 + $2;
      } elsif ($sleep =~ /^(\d+):(\d+):(\d+)$/) {	# hh:mm:ss
	$delay = 0 + $1 * 60*60 + $2 * 60 + $3;
      } else {
	carp "Cannot parse sleep delay '$sleep', defaulting to 10 minutes\n";
	$delay = 10 * 60;
      }

      # Sleep for this delay _from when we started_, not from current time!
      # This is done to avoid slipping offsets, since the FTP connections
      # can take a long time.
      $delay -= (time - $t_start);  $delay = 0 if $delay < 0;
    }

    if (exists $self->{"sleep_until"}) {
      my $sleep = $self->{"sleep_until"};

      if ($sleep =~ /^(\d+):(\d+)$/) {
	my $T0  = ($1 * 60 * 60)  + ($2 * 60);	# FUTURE time of day, in sec.
	my $now = ((localtime)[2] * 60 * 60) +
	          ((localtime)[1] * 60) +
		   (localtime)[0];		# CURRENT time of day, in sec.

	# Delay, in seconds, is difference between the two.  If negative,
	# it means an earlier hour tomorrow, so we add one day (86400 secs)
	$delay = $T0 - $now;  $delay += 86400 if $delay < 0;
      } else {
	carp "Cannot parse sleep_until time '$sleep'\n";
	$delay = 10 * 60;
      }
    }

    # Set the process name to indicate how long we're sleeping
    my (@later) = (localtime(time + $delay));
    my (@DoW) = qw(Sun Mon Tue Wed Thu Fri Sat);
    my ($msg)   = sprintf("sleeping until %s %02d:%02d:%02d", 
			  $DoW[$later[6]], @later[2,1,0]);
    printf "[%s]", $msg						unless $QUIET;
    $0 = $ME . ": " . $msg;

    $SIG{INT} = $SIG{HUP} = sub { $SIG{INT} = \&_handler; return }; # wakeup

    sleep $delay;

    print  "\n"							unless $QUIET;
  }
}


#################
#  lock_or_die  #
#################
sub _lock_or_die {
  my $self = shift;

  # If no "lock" argument is present, we can bail out safely.
  return unless exists $self->{"lock"};
  my $lockfile = $self->{"lock"};

  # Called with -lock.  Before doing anything, obtain our hostname.
  my $hostname = "unknown";
  eval "use Net::Domain qw(hostname);  \$hostname = hostname;";

  # If lockfile exists, barf (but indicate who owns it)
  if (-f $lockfile) {
    open(LOCK, $lockfile) or croak "Cannot read lockfile '$lockfile': $!\n";
    chop($_ = <LOCK>);
    close LOCK;

    # Owner of the lock
    my $u = (getpwuid((stat($lockfile))[4]))[0];

    my ($lockhost, $lockpid);
    if (/^(\S+):(\d+)$/) {
      ($lockhost, $lockpid) = ($1, $2);
    } else {
      croak "FATAL: Internal error: bad lockfile (someone being sneaky?)";
    }

    if ($lockhost eq $hostname) {
      # "kill 0" returns 1 if the PID exists, 0 otherwise.  
      if (kill 0 => $lockpid) {		# PID exists... could be that job
	carp  "FATAL: Locked by $u, pid $lockpid, ";
	die "\nLockfile is $lockfile\n";
      } else {				# No such PID -- lock is inactive
	warn "Deactivating stale lock by $u\n";
	unlink $lockfile	or croak "Could not remove '$lockfile'\n";
      }
    } else {		# lock host is not the same as ours.
      carp "FATAL: Locked by $u\@$lockhost, pid $lockpid, ";
      die  "\nLockfile is $lockfile\n";
    }
  }

  #
  # Got here: no lock exists (or we killed a stale one).  Let's make one.
  #


  # From hostname and PID, make a temporary file (with unique name)
  my $tmpfile = sprintf("%s.tmp.%s.%08d",$lockfile, $hostname, $$);
  open(LOCK, ">$tmpfile") or die "$ME: open( >$tmpfile ): $!\n";
  chmod 0444, $tmpfile;
  printf LOCK "%s:%d\n", $hostname, $$;
  close LOCK;

  # Now comes the tricky bit.  We "mv" this temporary file into place,
  # hoping that perl's "rename" is atomic.  Since 
  rename $tmpfile, $lockfile	or do {
    unlink $tmpfile;
    croak "Cannot lock -- race condition!";
  };


  # Lock file is now in place.  Keep track of it, so we can unlock when we quit
  push(@LOCKFILES, $lockfile);
}



############
#  unlock  #  Before exiting, or while sleeping, remove any lock file
############
sub _unlock {
  my $self = shift;

  if (exists $self->{"lock"}) {
    # Remove the file...
    unlink $self->{"lock"};
    # ...and forget we ever had it.
    for (my $i=0; $i < @LOCKFILES; $i++) {
      if ($LOCKFILES[$i] eq $self->{"lock"}) {
	splice @LOCKFILES, $i, 1;
      }
    }
  }
}


################
#  _daemonize  #  fork, reparent, and keep only the child (parent exits)
################
sub _daemonize {
  my $self = shift;

  my $kidpid = fork;
  if ($kidpid == 0) {			# pid == 0: we are child
    close STDIN;
    close STDOUT;
    close STDERR;

    # Use setsid() to start a new session (put in eval, for startup speed)
    eval "use POSIX; POSIX::setsid();";

    # Trap signals
    $SIG{INT} = $SIG{TERM} = $SIG{PIPE} = \&cleanup_and_die;
    $SIG{HUP} =                           \&wakeup;

    # If we have a lock file, be sure to change the lock PID!
    $self->_set_lockfile_pid;	# ESM ESM ESM ESM ESM
  } elsif ($kidpid > 0) {		# pid > 0 : we are parent
    exit 0;				# ...abandon child to init
  } else {
    die "fork(): $!\n";
  }
}


##############
#  _handler  #  interrupt handler -- exit cleanly
##############
sub _handler {
  exit;
}


###########
#  check  #  Main function
###########
sub check {
  my $self = shift;

  $self->{"check_keys"} = { @_ };

  # Start by cd'ing to the desired directory
  my $dir = $self->dir		|| croak "No remote directory specified";
  $dir = $self->{"basedir"} . "/" . $dir	if exists $self->{"basedir"};
  $self->{"session"}->cd( $dir );

  # Now perform an "ls" to find out what's there
  my $pat = $self->coarsepattern || "";
  my (@f) = $self->{"session"}->ls ($pat);

  my (@need2grab, @need2regrab);

  # Look at every file, and compare against the given pattern...
  my $pattern = $self->pattern	|| croak "No pattern specified";
#  eval "use Data::Dumper; print Dumper(\@f);"		if $DEBUG;
  foreach my $f (grep($_->name =~ /^$pattern$/, @f)) {
    # ...if we match, it's a file that we need to have locally.
    #
    # Now we have two possibilities:
    #
    #  1) we don't have the file.  In this case, we need to grab it.
    #  2) we _do_ have it, but it has been updated.  We then need to
    #     flag it for re-grabbing, but we only do so if given "-regrab"
    #     switch.
    #
    my $l = $self->localpath($f);
    if (! -f $l) {
      push(@need2grab, $f);
    } else {
      if ((stat($l))[9] != $f->mtime) {
	push(@need2regrab, $f);
      }
    }
  }

#	Set proper transefer mode, if specified

  $self->{"session"}->binary() if defined $self->binary;
  $self->{"session"}->ascii() if defined $self->ascii;

  # We now have 2 arrays: need2grab, and need2regrab.
  #
  # Let's look at the "regrab" ones first, since they're probably
  # earlier data.  
  #
  # If the "-regrab" switch was given, go grab those.  If not, see if
  # we should notify someone of their existence.
  if ($REGRAB) {
    $self->get(@need2regrab);
  } elsif (@need2regrab) {
    my $n = scalar @need2regrab;
    # Generate a syntactically correct sentence (i.e., "1 file", "<x> files")
    my $msg = sprintf("%d file%s need%s to be re-grabbed from %s:\n", $n, 
		      ($n == 1 ? ("","s") : ("s","")), $self->cwd);
    $msg .= "   " . join("\n   ", map { 
                                         $self->dir . "/" . $_->name 
				      } @need2regrab);
    print  $msg, "\n"						unless $QUIET;

    if ($NOTIFY ne "0") {
      eval {
	use ESM::Notify;
	notify(-from    => "mirror",
	       -to      => $NOTIFY,
	       -subject => "$ME: Files have been updated on remote",
	       -body    => $msg);
      };
    }
  }

  #
  # Always try to grab missing files ("get()" will handle "-n", if needed)
  #
  $self->get(@need2grab);
}

# Assumes that all protocols preserve a "cwd"
sub cwd { my $self = shift; return $self->{"session"}->{"cwd"}; }

#########
#  get  #
#########
sub get {
  my $self = shift;

  my $dsep = $self->{"session"}->dir_separator || "/";

  foreach my $f (@_) {
    my $localfile = $self->localpath($f);

    print  "RE"		if (-f $localfile) && !$QUIET;
    printf "get %s%s%s...", $self->dir, $dsep, $f->name		unless $QUIET;
    if ($NONONO) { 
      print "(NOT)"						unless $QUIET;
    } else {
      eval "use File::Basename;  use File::Path;";
      my $localdir = dirname($localfile);
      if (! -d $localdir) {
	mkpath($localdir, !$QUIET, 02775) or die "mkpath( $localdir ): $!\n";
      }

      # In Standard Ed Form, we save to a temporary filename instead of
      # the real thing.  If we encounter an error, or user ^C, or even
      # a crash, we don't have a file advertising itself as complete.
      my $tmpfile = $localfile . ".TMP";	unlink $tmpfile;

      # Invoke the session (FTP, HTTP, ???) get method
      $0 = sprintf("%s: GET %s%s%s", $ME, $self->dir, $dsep, $f->name);
      $self->{"session"}->get($f->name, $tmpfile) || die "get $tmpfile: $!\n";

      # Set the file's modification time to that of the remote
      utime $f->mtime, $f->mtime, $tmpfile;
      chmod 0444,                 $tmpfile;

      # If this is a regrab, see if we need to preserve the older version
      if (-f $localfile) {
	my $bakfile = $localfile . ".BAK";
	unlink $bakfile;
	rename $localfile, $bakfile	unless $self->{"overwrite"};
      }

      # Okay, now we can mv it into place.
      rename $tmpfile, $localfile;
    }

    # Close out the progress indicator line
    print  "ok\n"						unless $QUIET;
  }

  # If asked to email, do so
  if (@_  &&  $NOTIFY ne "0") {
    # Generate a syntactically correct sentence (i.e., "1 file", "<x> files")
    my $msg = sprintf("%d file%s %s grabbed from %s:\n", scalar @_,
		      (@_ == 1 ? ("","was") : ("s","were")), $self->cwd);
    $msg .= "   " . join("\n   ", map { $self->dir . "/" . $_->name } @_)."\n";

    eval {
      use ESM::Notify;
      notify(-from    => "mirror",
	     -to      => $NOTIFY || "esm",
	     -subject => "transfer results from `$ME'",
	     -body    => $msg);
    };
  }
}

##############
#  AUTOLOAD  #  Look for the given key in a hash.  Execute code if need be.
##############
sub AUTOLOAD {
  my $self = shift;

  use vars qw($AUTOLOAD);
  my $want = $AUTOLOAD;  $want =~ s/^.*:://;

  return undef		unless exists $self->{"check_keys"};
  my (%keys) = %{$self->{"check_keys"}};

  my $val;
  if    (exists $keys{"-$want"})	{ $val = $keys{"-$want"} }
  elsif (exists $keys{$want})		{ $val = $keys{$want} }

  if (ref $val eq "CODE") {
    $val = &{$val}( @_ );
  }

  return $val;
}


########################
#  read_user_password  #  Prompt for a password
########################
sub _read_user_password {
  my $self = shift;

  local($|) = 1;		# Force immediate output, no buffering

  system "stty", "-echo";
  printf "Password for %s\@%s: ", $self->{"user"}, $self->{"host"};
  my $passwd;
  chop($passwd = <STDIN>);
  print  "\n";
  system "stty", "echo";

  # untaint, and preserve
  $passwd =~ /^(.*)$/;   $self->{"password"} = $1;

  # There should be no further need for input.  We therefore close STDIN,
  # not because we need to, but because if we don't, Perl error/warning
  # messages will subsequently say "... at <STDIN> chunk 1".
#  close STDIN;
}



sub localpath {
  my $self = shift;
  my $f    = shift;	# a File object

  my $localdir  = $self->localdir($f)  || croak "Need a local dir";
  my $localfile = $self->localfile($f) || $f->name;

  return "$localdir/$localfile";
}


############
#  _usage  #  emit a useful message, and die
############
sub _usage {
  eval "use File::Basename";
  printf "Usage:\t%s [options]", basename($0);

  # If called without options, show how we can display more info
  if (@_ == 0) {
    print  " (\"-help\" for help)\n";
    exit 1;
  }

  # Get here if called with _any_ options, eg, "_usage(1)" (or even "(0)").
  print  "\n\n";
  print  "Valid options are:\n";

  # Determine the length of the longest option, and use that for formatting
  my $maxlen = -1;
  map { 
    /^(\w+)/;
    $maxlen = length($1) if length($1) > $maxlen;
  } @OPTS;
  $maxlen += 4;		# To compensate for the " <x>"

  # Show each option, with its associated description.
  map {
    /^(\w+)(\S*)\s+(\S.*)/;
    my ($kw, $desc) = ($1, $3);
    if (defined $2) {
      if ($2 eq "=s")		{ $kw .= sprintf(" <%1.1s>", $kw); }
    }
    printf "  -%-*s %s\n", $maxlen, $kw, $desc;
  } @OPTS;

  exit 1;
}


###############################################################################
package ESM::Mirror::FTP;

use Carp;

use strict;
use vars qw(@ISA  $ME  $DEBUG  $NOTIFY  $FTP);

@ISA = qw(ESM::Mirror);

*ME     = *ESM::Mirror::ME;
*DEBUG  = *ESM::Mirror::DEBUG;
*NOTIFY = *ESM::Mirror::NOTIFY;


$| = 1;			# For debugging, force immediate output

sub new {
  my $class = shift;

  # Define the login info: host, user, password (optional, if anonymous)
  my (%keys) = @_;
  my $h = $keys{"host"};
  my $u = $keys{"user"} || "anonymous";
  my $p = $keys{"password"};

  my $self = bless {}, $class;

  eval "use Net::FTP"; die "new FTP: $@" if $@;

  # Set up a 60-second timeout, for some cases where we hang
  my $real_ftp_return;
  eval {
    status("connecting to $h");
    local $SIG{ALRM} = sub { die "FTP: connect($h) timed out\n" };
    alarm 60;
    $FTP = new Net::FTP( $h );
    alarm 0;
    $real_ftp_return = $@;
  };

  if (!defined $FTP) {
###    return 0 if $DAEMONIZE;
    barf("connection failed: %s", $real_ftp_return || $@ || "unknown reason");
  }


  # Flag whether or not remote host is a VAX
  $self->{"is_vax"} = ($FTP->message =~ /\bmultinet\b/i);

  #
  # Log in as the desired user
  #
  status("logging in as %s[\@%s]", $u, $h);
  $FTP->login( $u, $p ) || barf("FTP login failed");
  status();

  # Check to see if the remote server supports MDTM
  $FTP->mdtm("/this-foobar-file-should-not-exist");
  $self->{"has_mdtm"} = ($FTP->code == 550);
  if ($DEBUG) {
    printf "%s is%s a VAX", $h,($self->{"is_vax"} ? "" : " not");
    printf " and %s MDTM\n",   ($self->{"has_mdtm"} ? "has":"*DOES NOT HAVE*");
  }

  #
  # Done!  Preserve the session object, and return
  #
  $self->{"ftp"} = $FTP;


  # Before we go... load required packages.
  #
  # We do this inside an "eval" because otherwise it takes a long time,
  # and thus our caller sees a delay before seeing the "Password: " prompt.
  eval "use Date::Manip;"; die $@ if $@;

  return $self;
}

#############
#  DESTROY  #  Called when object is no longer needed.  Terminate FTP session.
#############
sub DESTROY {
  my $self = shift;

  $FTP = $self->{"ftp"};
  $FTP->quit;
  $FTP = undef;
}

sub ascii {
#   Purpose:	Enable ascii mode transfer

 my $self = shift;

 print "Set mode A\n" if $DEBUG;
 $FTP = $self->{"ftp"};
 $FTP->ascii();
}

sub binary {
#   Purpose:	Enable binary mode transfer

 my $self = shift;

 print "Set mode I\n" if $DEBUG;
 $FTP = $self->{"ftp"};
 $FTP->binary();
}

########
#  cd  #  Change Directory.
########
sub cd {
  my $self = shift;
  my $d    = shift;	# Directory to cd to

  status("cd $d");
  $FTP = $self->{"ftp"};
  $FTP->cwd($d)			|| barf("cd $d (base) failed");

  $self->{"cwd"} = $d;		# Remember where we are
}


########
#  ls  #  get a listing of files
########
sub ls {
  my $self = shift;
  my $pat = shift || "";

  $FTP = $self->{"ftp"};		# (for barf)

  status("ls [ %s ] %s", $self->{"cwd"}, $pat);
  my (@files) = $pat ? $FTP->dir($pat) : $FTP->dir();
  status();
  if (@files == 0) {
    return undef;
  }

  #
  # If remote server is a VAX, we need to fix the directory listing.
  #
  # When you do an "ls" on a VAX, and the file name is longish, the
  # stupid thing will split the line into two (filename on one,
  # mtime / size / owner / etc on the next).  Let's standardize
  # that to all-on-one-line, the way God meant it to be.  We do this
  # by looking for lines with only one item (filename) followed by 
  # lines starting with a space, and merging the two.
  #
  if ($self->{"is_vax"}) {
    for (my $i = 0; $i < $#files; ++$i) {
      if ($files[$i] =~ m!^\S+$!  &&  $files[$i+1] =~ s!^\s+!!) {
	$files[$i] .= " " . $files[$i+1];
	splice(@files, $i+1, 1);
      }
    }

#####    return grep( $_ !~ /RMS-E-FLK/, @files );
  }

  #
  # Convert each file row to a "file" object
  #
  my @fo;			# File Object array
  foreach my $f (@files) {
    if ($self->{"is_vax"}) {
      # ESM: TODO: parse VAX line
    } else {
      next if $f =~ /^total\s+\d+$/;	# First line is a total; skip it

      # UNIX FTP has a line of the form
      #     -rw- [...]   <size> <date>                   <name>
      # eg,
      #     -rw-r--r-...   284409 Jul 21 02:53 IMAGE.IMAGE1.UDFp.200020220.tgz
      if ($f =~ /^(.).*\s+\d+\s+(\w+\s+\d+\s+[\d\:]+)\s+(\S+)$/) {
	my ($type, $mtime, $name) = ($1, $2, $3);

	# ls shows "-" for regular files, "d" for dirs, etc
	$type = "f" if $type eq "-";

	# From the date string, determine a reference mtime
	$mtime = UnixDate(ParseDate($mtime), "%s");

	push(@fo, ESM::Mirror::File->new(-type   => $type,
					 -mtime  => $mtime,
					 -name   => $name,
					 -parent => $self));
	# ESM ESM ESM for back east, we do "- 2 * 60" for 2 hours... how?
      } else {
	carp "cannot parse '$f'";
      }
    }
  }

  return @fo;
}


#########
#  get  #  grab a file
#########
sub get {
  my $self = shift;

  $FTP = $self->{"ftp"};
  $FTP->get(@_)		|| barf("FTP get( %s, %s )", @_);
}



###################
#  dir_separator  #
###################
sub dir_separator {
  my $self = shift;

  return ($self->{"is_vax"} ? ":" : "/");
}


###########
#  mtime  #  returns file modification time
###########
sub mtime {
  my $self = shift;
  my $f    = shift;

  if ($self->{"has_mdtm"}) {
    $FTP = $self->{"ftp"};
    return $FTP->mdtm( $f->name );
  } else {
    return $f->mtime;
  }
}


############
#  status  #  Set the process title, and (if debugging) emit a message
############
sub status {
  local($|) = 1;
  # If called with no arguments, terminate a status line
  if (@_ == 0) {
    print  "\n"							if $DEBUG;
    return;
  }

  my $msg = sprintf(shift, @_);

  $0 = $ME . ": " . $msg;

  $msg =~ s/\[.*\]//;
  print  "$msg..."						if $DEBUG;
}


##########
#  barf  #  print out error message and die
##########
sub barf {
  my $msg = sprintf("%s: %s", $ME, sprintf(shift,@_) || "died");
  if ($msg !~ /\n$/  && defined $FTP) { #  && $FTP->code !~ /^2/) {
    my $ftp_msg = $FTP->message;  chomp $ftp_msg;
    $msg   .= sprintf(" (%03d %s)", $FTP->code, $ftp_msg);
  }

  # Always send message to STDERR (that's a NOP if we're a daemon)
  print STDERR $msg, "\n";

  # If asked to NOTIFY, do so
  if ($NOTIFY ne "0") {
    eval {
      use ESM::Notify;
      notify(-from    => "mirror",
	     -to      => $NOTIFY || "esm",
	     -subject => "Error results from `$ME'",
	     -body    => $msg);
    };
  }

  # Terminate FTP session (nicely, if possible)
  $FTP->quit()						if defined $FTP;
  exit 1;
}










1;
###############################################################################
package ESM::Mirror::LWP::UserAgent;

use strict;
use vars qw(@ISA  $USERNAME  $PASSWORD);	# Not reentrant, but so what

@ISA = qw(LWP::UserAgent);

sub new {
  my $class = shift;
  $USERNAME = shift;
  $PASSWORD = shift;

  eval "use LWP";  die $@ if $@;
  my $self = LWP::UserAgent::new($class, @_);
  $self->agent("ESM::Mirror/$ESM::Mirror::VERSION");
  $self;
}

sub get_basic_credentials {
  return ($USERNAME, $PASSWORD);
}

###############################################################################
package ESM::Mirror::HTTP;

use Carp;

use strict;
use vars qw(@ISA  $ME  $DEBUG);

@ISA = qw(ESM::Mirror);

$ME    = $ESM::Mirror::ME;
$DEBUG = $ESM::Mirror::DEBUG;

sub new {
  my $class = shift;

  my (%keys) = @_;

  my $self = bless {}, $class;

  $self->{proto} = $keys{"proto"} || "http";
  $self->{host}  = $keys{"host"};

  $self->{ua} = new ESM::Mirror::LWP::UserAgent( $keys{"user"}, 
						 $keys{"password"} );

  # Before we go... load required packages.
  #
  # We do this inside an "eval" because otherwise it takes a long time,
  # and thus our caller sees a delay before seeing the "Password: " prompt.
  eval "use Date::Manip;"; die $@ if $@;

  $self;
}


########
#  cd  #  "change directory"
########
sub cd {
  my $self = shift;

  #
  # Unlike FTP, HTTP is stateless.  We don't actually have a real connection
  # established at this moment.  All we do is "remember" where we need to be.
  #
  $self->{"cwd"} = shift;
}

########
#  ls  #  Get a listing of files in "cwd"
########
sub ls {
  my $self = shift;

  #
  # Generate a full URL to the remote host.  Remember, HTTP is stateless.
  # Since we know the protocol (http or https), hostname (unchanging),
  # and remote directory (set via the "cd" method, above), we use those
  # to generate a complete URL, which we then pass to LWP.
  #
  my $url = sprintf("%s://%s%s/", $self->{proto}, $self->{host}, $self->{cwd});
  printf "ls: %s\n", $url					if $DEBUG;

  # Generate a new "HTTP::Request" object for this URL.  We need to do
  # this inside an eval, since at compile-time, HTTP::Request hasn't
  # actually been "use"d.
  my $req = eval "new HTTP::Request \"GET\"";	die $@ if $@;
  $req->url( $url );

  # Go do it, and check for errors
  my $response = $self->{ua}->request( $req );
  unless ($response->is_success) {
    die "$ME: failed: " . $response->as_string;
  }

  # Got something.  Parse the filenames, mtimes, etc
  my @flist;
  foreach my $l (split(/\n/, $response->content)) {
    if ($l =~ /\<a\s+href=\"([^\"]+)\".*>.*\s(\d+-\w+-\d+\s+\d+:\d+)\s+/i) {
      my $fname = $1;
      my $mtime = UnixDate(ParseDate($2), "%s");

      my $type  = ($fname =~ s!/$!! ? "d" : "f");	# Dir, or file?

      printf "ls: -> %s\n", $fname				if $DEBUG;
      push(@flist, ESM::Mirror::File->new(-type   => $type,
					  -mtime  => $mtime,
					  -name   => $fname,
					  -parent => $self));
    }
  }


  return @flist;
}


#########
#  get  #  Fetch the file
#########
sub get {
  my $self    = shift;
  my $f       = shift;
  my $f_local = shift;

  # Again, generate a full URL
  my $url = sprintf("%s://%s%s/%s", $self->{proto}, $self->{host}, 
		    $self->{cwd}, $f);
  printf "GET: %s\n", $url					if $DEBUG;

  # Generate a new "HTTP::Request" object for this URL.  We need to do
  # this inside an eval, since at compile-time, HTTP::Request hasn't
  # actually been "use"d.
  my $req = eval "new HTTP::Request \"GET\"";	die $@ if $@;
  $req->url( $url );

  # Go do it, and check for errors
  my $response = $self->{ua}->request( $req );
  unless ($response->is_success) {
    die "$ME: failed: " . $response->as_string;
  }

  # Save the results
  open(OUT, ">$f_local") or die "$ME: open( >$f_local ): $!\n";
  print  OUT $response->content;
  close OUT;
}

###########
#  mtime  #  get the file's modification time
###########
sub mtime {
  my $self = shift;
  my $f    = shift;

  # We could do a "HEAD", but let's not bother just yet
  return $f->{mtime};
}




1;
###############################################################################
# ESM::Mirror::File   --   smallish file object
###############################################################################
package ESM::Mirror::File;

use Carp;

use strict;

sub new {
  my $class = shift;
  my $self  = bless {}, $class;

  # Parse keywords
  while (@_) {
    my $k = lc shift;  $k =~ s/^-//;
    $self->{$k} = shift;
  }

  return $self;
}

sub name { return $_[0]->{"name"}; }

sub mtime {
  my $self = shift;

  return $self->{"mdtm"} || do {
    return $self->{"mdtm"} = $self->{"parent"}->mtime( $self );
  };
}

#sub localfile {
#  my $self = shift;
#
#  return $self->{"parent"}->localfile( $self );
#}
  

###############################################################################
1;