#!/usr/bin/perl
##############################################################################
#
#  pmirror   1.22
#
#  Introduction
#    This program was designed to retrieve and maintain an up to date copy
#    of any archive directory structure that is available from a UNIX
#    host via anonymous ftp.  With the aid of the "remote" script this
#    program can also be used to retrieve and maintain an archive directory
#    structure over a modem.
#
#    An example of use would be to maintain an up to date archive of the
#    Slackware Linux distribution on your PC's hard drive when your
#    only network connection is via modem to a UNIX shell account.  This
#    process is done using a three tier arrangement as follows:
#
#           Linux or
#            DOS PC    sz/rz      UNIX        ftp        UNIX 
#            with   <---------->  shell  <------------> Source
#            modem               account                 host
#              |                    |
#              v                    v
#            remote              pmirror
#
#    In the above application, pmirror would repeat the following basic cycle
#    until all of the required files were updated:
#
#      1. ftp a file from the source host
#      2. ZMODEM the file down to the Linux PC
#      3. delete the file
#      4. if not done, repeat
#
#    If modem'ing is not required, step two and three are simply replaced
#    by "move the file to its local destination"
#
#    The above might be a way to pull down the Slackware Linux distribution
#    so that you can install it on your PC (assuming that you have lots and
#    lots of free disk space, no CD-ROM, and no dial-up time limit).  Since
#    someone will probably ask, I'll go ahead and document one approach here.
#    This process was more complicated before I finished porting the
#    "remote" script to DOS perl.  Now that the "remote" runs under
#    DOS, just do the following:
#
#       1. Go to the "User Configuration Section" and customize the
#          "remote" and "pmirror" scripts to pull down the Slackware
#          (or some other) distribution from your favorite mirror site.
#       2. Make sure that the destination directory exists on your PC.
#       3. Create the "old.lst" file with:  perl remote -i
#       4. After remote finishes, dial into your UNIX shell account.
#       5. Upload your customized version of pmirror.
#       6. Start pmirror and upload the "old.lst" file.
#       7. Wait for all of the files to finish downloading.
#       8. Install the Slackware files in the destination directory
#          with:  perl remote -c -p 1
#       9. Follow the instruction in INSTALL.TXT from there.
#
#    If you mirror /pub/Linux/distributions/slackware/slakware, plan on
#    modem'ing down about 90Mb of data.  I don't recommend mirroring any
#    path higher than "slakware" unless you are very good at setting the
#    filter_keep and filter_kill variables because you can end up pulling
#    down hundreds and hundreds of Mb.  If you really want all of those
#    files, buy the CD (and a CD-ROM drive)!
#
#  What You Need
#    As this script is a perl script, you need perl.  It was written
#    for perl 4.0.1.8, patch level 36, but should work with perl 5.0
#    (haven't tested recently).  There are many ftp sites that archive
#    the perl source if your system administrator has not installed it
#    yet.  I got my copy from prep.ai.mit.edu:/pub/gnu.  I have ported
#    the "remote" script to DOS perl.  If you would like to use
#    "remote" under DOS, get Darryl Okahanta's (darryl@sr.hp.com)
#    "BIGPERL" port of perl for DOS.  I got my copy from
#    ftp.ee.umanitoba.ca in a file called /pub/msdos/perl/perl4/bperl4x.zip.
#    See the comments in the "remote" script for more information.
#
#    Some knowledge of perl will be helpful when you set the variable
#    initializations in the "User Configuration Section".  See below for
#    details.
#
#    An internet connection is required at some point as well.  This can
#    be via a proxy ftp server.  See the example values in the "User
#    Configuration Section" for details.
#
#    On the modem side, you need a communications package that can autodetect
#    ZMODEM transmissions.  Both minicom and seyon for Linux work well for
#    this.  If you use minicom 1.7 under Linux, you may need to edit the
#    'port.h' headder.  Define VC_MUSIC to 0.  If it's set to 1, minicom
#    requires you to "hit any key" after every download.  This can make
#    downloading 500 or so files extremely tedious!
#
#  Where to Start
#    Modify the variable initializations in the "User Configuration Section"
#    to point the script at the source directory structure that you want
#    to mirror.  Set other configuration variables as you like, and run
#    the "pmirror" script.
#
#    If you are sending files over a modem, be sure to set "dest_host" to
#    "modem" and set the variables properly in the "remote" script.  Start
#    the "pmirror" script in your dial-up UNIX shell account, and start the
#    "remote" script on your PC at home.  Once the "remote" script has finished
#    creating the local directory listing file (old.lst), initiate ZMODEM
#    to send this list up to your UNIX shell account.  The scripts should
#    communicate (via ZMODEM) to finish the job.
#
#    If you have to stop the transmission for some reason, don't worry. 
#    It's usually possible to re-start with minimal back-tracking.
#
#  Author:  David C. Snyder (dsnyder@netcom.com)
##############################################################################

require "pwd.pl";
require "timelocal.pl";

%mon2num = ( "Jan", 0, "Feb", 1, "Mar", 2, "Apr", 3, "May",  4, "Jun",  5,
             "Jul", 6, "Aug", 7, "Sep", 8, "Oct", 9, "Nov", 10, "Dec", 11 );


##############################################################################
#
#  User Configuration Section
#
#  Change the values of the variables below to reflect the data you wish
#  to mirror.  If your dest_host is "modem", make sure you change the
#  variables in the 'remote' script as well.
#
#  src_host     - Name of the remote site or name of the proxy ftp server
#  proxy_login  - Remote login name.   Probably "anonymous"
#  email_addr   - Remote password.  Should be an e-mail address.  Never
#                 code your password into a program!
#  src_path     - The path to mirror at the remote site
#  dest_host    - Set to "localhost" or "modem"
#  dest_path    - The path where the mirrored files will be stored
#  spool_dir    - The temporary spooling area for received files
#  filter_kill  - Files that match the listed regular expressions will
#                 not be mirrored
#  filter_keep  - If not empty, only files that match the listed
#                 regular expressions will be mirrored
#  filter_size  - Files larger than this will not be mirrored
#  modem_delay  - Minimum number of seconds to wait between modem commands
#  ftp_retry    - Number of seconds to wait between ftp retries
#  file_wait    - Number of seconds to wait before re-checking for a file
#  queue_depth  - Maximum number of files to receive before letting the
#                 placement routine to catch up
#  use_copy     - If set to 1, use cp instead of mv to place files
#  kill_dirs    - If set to 1, try to remove local empty directories that are
#                 not on the mirrored site
#
$src_host     = "GATEKEEPER.PROXY.COM";
$proxy_login  = "anonymous\@FTP.MIRROR-SITE.EDU";
$email_addr   = "YOUR_E-MAIL_ADDRESS";
$src_path     = "/pub/linux/distributions/slackware";
$dest_host    = "localhost";
$dest_path    = "/home/davids/tmp/slackware";
$spool_dir    = "/home/davids/src/pmirror";
#
@filter_keep  = ( "^\\.\\/", "slakware\\/", "ootdsks.144\\/" );
@filter_kill  = ( "\\/\\.", "00index.txt" );
$filter_size  = 1.5 * 2**20;
#
$modem_delay  = 5;
$ftp_retry    = 30;
$file_wait    = 5;
#
$queue_depth  = 20;
#
$use_copy     = 1;
$kill_dirs    = 1;
#
##############################################################################


##############################################################################
#
#  The main program
#
#  Now that configuration is out of the way, let's get on with things.
#  The following is an outline of the steps that pmirror follows to get the
#  work done.
#
#     1. Perform initialization.
#
#     2. Add the source host to the ~/.netrc file so that we can easily
#        open lots of ftp connections without "manually" sending username
#        and password information.
#
#     3. Get a recursive directory listing of the destination path.  This
#        information will be used to determine what files need to be added,
#        removed, or updated.
#
#     4. Get a recursive directory listing of the source path (via ftp).
#
#     5. Build two lists from these directory listings.  One of them
#        contains all files that will be mirrored (file_list), the other
#        contains all files that will be ignored (skip_list).
#
#     6. Write out the skip list for the user's future reference.
#
#     7. Build two action lists from the file_list.  The rm_list contains
#        all of the local files must be removed, and the in_list contains
#        all files that must be pulled down from the source host.
#
#     8. Write out these two lists for future reference and print a summary
#        from the "skip", "rm", and "in" lists.
#
#     9. Remove all local files in the rm_list.
#
#    10. Ftp and install all files in the in_list.
#
#    11. Remove the extra line we added to the ~/.netrc file.
#
#    12. Remove temporary files.
#
#
##############################################################################

### Step 1
select( STDERR ); $| = 1;       # make unbuffered
select( STDOUT ); $| = 1;       # make unbuffered
&initpwd();
&chdir( $spool_dir ) || die "Could not cd to $spool_dir";
&assign_handlers();

### Step 2
&modify_netrc( "add" );

### Step 3
&get_local_list( "old.lst" );

### Step 4
&get_remote_list( "new.lst" );

### Step 5
&build_file_list( "new.lst", "new" );
&build_file_list( "old.lst", "old" );

### Step 6
&save_list( "skip.lst", @skip_list );

### Step 7
@file_list = sort( @file_list );
&build_action_lists();

### Step 8
&save_list( "rm.lst", @rm_list );
&save_list( "in.lst", @in_list );
&list_summary();

### Step 9
&rm_files();

### Step 10
&get_in_files();

### Step 11
&modify_netrc( "remove" );

### Step 12
&clean_up();
exit( 0 );


########################################
#
#  assign handlers
#
#  I thought it might be good to trap
#  a few common signals to clean things
#  up before we "die".  There's actually
#  not much to do these days though.
#
########################################
sub assign_handlers {
  $SIG{'INT'}  = 'handler';
  $SIG{'QUIT'} = 'handler';
  $SIG{'TERM'} = 'handler';
  $SIG{'HUP'}  = 'handler';
}


########################################
#
#  handler
#
#  A present, this function just
#  removes the extra line we added
#  to the user's ~/.netrc file.
#  I may add other clean-up tasks
#  later.
#
########################################
sub handler {
  local ( $sig ) = @_;
  print "Caught a SIG$sig--shutting down\n";
  &modify_netrc( "remove" );
  exit( 0 );
}


########################################
#
#  modify netrc
#
#  This function either adds or removes
#  a line from the user's ~/.netrc file.
#  The line makes the frequent ftp
#  connections to the source host less
#  of a hassle.
#
########################################
sub modify_netrc {
  local ( $action ) = @_;
  $netrc = $ENV{'HOME'} . "/.netrc";
  $netbak = $netrc . "._bak";

  if ( -e $netrc ) {
    if ( -e $netbak ) {
      unlink( $netbak ) || die "Could not unlink $netbak.";
    }
    rename( $netrc, $netbak ) || die "Could not rename $netrc to $netbak.";
    open( NETBAK, "<" . $netbak ) || die "Could not open $netbak.";
    @netbak = <NETBAK>;
    close( NETBAK );
  }

  open( NETRC, ">" . $netrc ) || die "Could not open $netrc.";
  chmod( 0600, $netrc ) || die "Could not set mode for $netrc.";
  foreach ( @netbak ) {
    $machine = (split( /\s/ ))[1];
    if ( $machine ne $src_host ) {
      print NETRC "$_";
    }
  }
  if ( "add" eq $action ) {
    print NETRC "machine $src_host login $proxy_login password $email_addr\n";
  }
  close( NETRC );
  if ( -e $netbak ) {
    unlink( $netbak ) || die "Could not remove $netbak";
  }
}


########################################
#
#  get local list
#
#  This function gets the current
#  recursive directory listing of the
#  destination path.  If the path
#  is local, it does this using ls(1).
#  Otherwise, it uses ZMODEM to upload
#  the listing produced by the "remote"
#  script.
#
########################################
sub get_local_list {
  local ( $file ) = @_;

  if ( "localhost" eq $dest_host ) {
    print "Building $file from $dest_path ...\n";
    $old_dir = $ENV{'PWD'};
    &chdir( $dest_path ) || die "$dest_path does not exist";
    system( "ls -AlR > " . $old_dir . "/" . $file ) && die "ls";
    &chdir( $old_dir );
  } elsif ( "modem" eq $dest_host ) {
    unlink( $file );
    print "\nZMODEM ready to receive $file from home ...\n";
    system( "rz" );
    sleep( $modem_delay );
  } else {
    die "$dest_host is not a supported dest_host type.";
  }
}


########################################
#
#  get remote list
#
#  This function gets a recursive
#  directory listing from the source
#  host.  If the remote host is busy
#  it just keeps retrying.  It also
#  tries to determine if the remote
#  path actually exists.
#
#  If the directory listing file
#  exists and is less than a day old,
#  this function just returns since the
#  contents of the archive site
#  probably haven't changed.  This
#  seemed like a "net polite" thing
#  to do.
#
########################################
sub get_remote_list {
  local ( $file ) = @_;

  $mtime = (stat( $file ))[9];
  if ( -e $file && (time() - $mtime) < (24 * 3600) ) {
    print "Using existing $file file ...\n";
    return;
  } else {
    unlink( $file );
  }
  print "Building $file via ftp to $src_host ...\n";
  unlink( "still_there" );
  until ( -e "still_there" ) {
    open( FTP, "| ftp $src_host" ) || die "Could not open ftp";
    print FTP "prompt\n";
    print FTP "hash\n";
    print FTP "dir $src_path still_there\n";
    print FTP "bye\n";
    close FTP;
    if ( -e "still_there" ) {
      die "$src_path does not exist\non $src_host" if (-z "still_there");
    } else {
      print "Could not connect to $src_host.\n";
      print "Trying again in $ftp_retry seconds ...\n";
      sleep( $ftp_retry );
    }
  }
  until ( -e $file ) {
    open( FTP, "| ftp $src_host" ) || die "Could not open ftp";
    print FTP "prompt\n";
    print FTP "hash\n";
    print FTP "cd $src_path\n";
    print FTP "ls -lR $file\n";
    print FTP "bye\n";
    close FTP;
    unless ( -e $file ) {
      print "Could not connect to $src_host.\n";
      print "Trying again in $ftp_retry seconds ...\n";
      sleep( $ftp_retry );
    }
  }
}


########################################
#
#  build file list
#
#  This function tries to figure out
#  if the recursive directory listing
#  is a UNIX ls(1) format or a DOS
#  DIR format.  It then calls the
#  appropriate conversion function
#  to translate the listing to a
#  generic and internally useful
#  format.
#
########################################
sub build_file_list {
  local ( $file_name, $status ) = @_;

  open( STREAM, "<" . $file_name ) || die "Could not open $file_name";
  print "Building list from $file_name ...\n";
  while ( <STREAM> ) {
    if ( /^total [0-9]+$/ ) {
      &unix_ls2gen( $status );
      last;
    } elsif ( /Volume Serial Number/ ) {
      &dos_dir2gen( $status );
      last;
    }
  }
  close( STREAM );
}


########################################
#
#  unix ls to generic
#
#  This function converts the new.lst
#  file, which has been identified as
#  a UNIX 'ls -lR' format file to
#  a generic and internally useful
#  format.
#
########################################
sub unix_ls2gen {
  local ( $status ) = @_;
  $path = ".";

  while ( <STREAM> ) {
    if ( /^-\S+r.. / ) {
      ($file, $hmy, $mday, $smon, $size) = reverse( split( /\s+/ ) );
      die "Invalid month name:  <$smon>"
        unless defined( $mon = $mon2num{$smon} );
      if ( $hmy =~ /:/ ) {
        ($hour, $min) = split( /:/, $hmy );
        ($cmon, $year) = (localtime( time ))[4,5];
        $year-- if ( $mon > $cmon );
      } else {
        $year = $hmy - 1900;
        ($hour, $min) = (0, 0);
      }
      $date = &timelocal( 0, $min, $hour, $mday, $mon, $year );
      if ( "new" eq $status && &filter_match( $path . "/" . $file, $size ) ) {
        push( @skip_list, "$path $file $status $date $size\n" );
      } else {
        push( @file_list, "$path $file $status $date $size\n" );
      }
    } elsif ( /^\S+:$/ ) {
      ($path) = split( /:/ );
      $path =~ s#^\./##;
    }
  }
}


########################################
#
#  dos dir to generic
#
#  This function converts the new.lst
#  file, which has been identified as
#  a UNIX 'DIR /S' format file to
#  a generic and internally useful
#  format.
#
########################################
sub dos_dir2gen {
  local ( $status ) = @_;
  $leader = 0;

  while ( <STREAM> ) {
    chop;
    chop if ( /\r/ );
    if ( /[ap]$/ && !(/<DIR>/) ) {
      tr/A-Z/a-z/;
      s/,//g;
      ($hm, $mdy, $size, $ext, $file) = reverse( split( /\s+/ ) );
      ($hour, $min) = split( /[:ap]/, $hm );
      if ( /p$/ ) {
        $hour = ($hour + 12) % 24;
      }
      ($mon, $mday, $year) = split( /-/, $mdy );
      $mon--;
      if ( "" eq $file ) {
        $file = $ext;
      } else {
        $file = $file . "." . $ext;
      }
      $date = &timelocal( 0, $min, $hour, $mday, $mon, $year );
      if ( "new" eq $status && &filter_match( $path . "/" . $file, $size ) ) {
        push( @skip_list, "$path $file $status $date $size\n" );
      } else {
        push( @file_list, "$path $file $status $date $size\n" );
      }
    } elsif ( /^Directory of/ ) {
      tr/A-Z/a-z/;
      s#\\#/#g;
      if ( $leader != 0 ) {
        $path = substr( $_, $leader + 1 );
      } else {
        $leader = length();
        $path = ".";
      }
    }
  }
}


########################################
#
#  filter match
#
#  This function is called by
#  unix_ls2gen() or dos_dir2gen().
#  If the file size is too large, or
#  the file matches the kill pattern,
#  or it doesn't match the keep
#  pattern, this function returns true,
#  indicating that the file will be
#  rejected.
#
########################################
sub filter_match {
  local ( $pathname, $size ) = @_;

  return 1 if ( $size > $filter_size );

  foreach $regex ( @filter_kill ) {
    return 1 if ( $pathname =~ /$regex/ );
  }

  return 0 if ( 0 == @filter_keep );

  foreach $regex ( @filter_keep ) {
    return 0 if ( $pathname =~ /$regex/ );
  }

  1;
}


########################################
#
#  save list
#
#  This function writes a generic list
#  out to a file.  If a remote host
#  connected via modem is involved,
#  the function uses ZMODEM to "move"
#  the file down to the remote host.
#
#  The remote host needs these list
#  files to determine where to install
#  the downloaded files.
#
########################################
sub save_list {
  local ( $file, @list ) = @_;

  open( LIST, "> $file" ) || die "Could not create $file";
  print LIST @list;
  print LIST "--EOT--\n";
  close LIST;
  if ( "modem" eq $dest_host ) {
    print "Sending $file via ZMODEM ...\n";
    system( "sz -y $file" ) && die "ZMODEM sz";
    unlink( "$file" );
    sleep( $modem_delay );
  }
}


########################################
#
#  build action lists
#
#  This function builds the rm_list
#  and the in_list from the generic
#  file_list.  Files that make it to
#  the in_list will be ftp'd from the
#  source host and downloaded.  Files
#  that end up in the rm_list will be
#  removed from the destination
#  directory.
#
#  A file is added to the in_list if
#  it exists on the source host, but
#  doesn't exist on the destination
#  host.  If the file exists on both,
#  it is added to the in_list if the
#  file size is different or if the
#  time stamp on the source host is
#  more recent.
#
#  If the file only exists on the
#  destination host, it is added to
#  the rm_list.
#
#  The logic is ugly, but it works.
#
########################################
sub build_action_lists {
  print "Building in_list and rm_list ...\n";
  ($lpath, $lfile, $lstatus, $ldate, $lsize, $lrec) = ("", "", "", "", "", "");
  foreach ( @file_list ) {
    ($path, $file, $status, $date, $size) = split( /\s/ );

    if ( "new" eq $status ) {
      push( @in_list, $lrec ) if ( "new" eq $lstatus );
    } elsif ( "old" eq $status ) {
      if ( "new" eq $lstatus ) {
        if ( $file eq $lfile && $path eq $lpath &&
             ($size != $lsize || $date < $ldate) ) {
          push( @in_list, $lrec );
        } elsif ( $file ne $lfile || $path ne $lpath ) {
          push( @in_list, $lrec );
          push( @rm_list, $_ );
        }
      } elsif ( "old" eq $lstatus || "" eq $lstatus ) {
        push( @rm_list, $_ );
      } else {
        die "Bad status value: <$status>";
      }
    } else {
      die "Bad status value: <$status>";
    }
    ($lpath, $lfile, $lstatus, $ldate, $lsize) = ($path, $file, $status,
                                                  $date, $size);
    $lrec = "$lpath $lfile $lstatus $ldate $lsize\n";
  }
  push( @in_list, $lrec ) if ( "new" eq $lstatus );
}


########################################
#
#  list summary
#
#  This function prints a summary
#  of the number of files in the
#  "skip", "rm", and "in" lists.
#  It also prints the total number of
#  bytes represented by those files
#  to give the user some indication
#  of how long the download will
#  take to complete.
#
########################################
sub list_summary {
  print ".\n.\n.\n----------------------------------------\n";
  &print_list_summary( "skip.lst", @skip_list );
  &print_list_summary( "rm.lst", @rm_list );
  &print_list_summary( "in.lst", @in_list );
  print "----------------------------------------\n.\n.\n";
}


########################################
#
#  print list summary
#
#  This function is called by the
#  list_summary() function to calculate
#  and print file list summaries.
#  It returns a list containing the
#  number of files and number of
#  bytes in a file list.
#
########################################
sub print_list_summary {
  local ( $file, @list ) = @_;

  $file_count = $total_bytes = 0;
  foreach ( @list ) {
    $total_bytes += (split( /\s/ ))[4];
    $file_count++;
  }
  printf( " %-14s: %4d files, %7.2f Mb\n", $file, $file_count,
          $total_bytes / 2**20 );
  ( $file_count, $total_bytes );
}


########################################
#
#  rm files
#
#  This function removes the files
#  in the rm_list from the destination
#  host.  This is done before any
#  new files are ftp'd to make space
#  for the new files.
#
#  The function also tries to remove
#  the directories that it empties.
#  If a directory contains only
#  sub directories, it won't be removed.
#  This doesn't bother me enough to make
#  me want to fix it.
#
########################################
sub rm_files {
  if ( "localhost" eq $dest_host ) {
    foreach ( @rm_list, @in_list ) {
      ($path, $file, $status, $date, $size) = split( /\s/ );
      if ( "." eq $path ) {
        $path = $dest_path;
      } else {
        $path = $dest_path . "/" . $path;
      }
      $dest = $path . "/" . $file;
      if ( -e $dest ) {
        print "Removing $dest ...\n";
        unlink( $dest );
      }
      RMDIR: {
        if ( $kill_dirs && -d $path && $path ne $dest_path ) {
          opendir( DIR, $path ) || die "Could not list $path";
          @dir = readdir( DIR );
          if ( 2 == @dir ) {
            close DIR;
            rmdir( $path ) || die "Could not remove $path";
            print "Removing $path ...\n";
            $path = substr( $path, 0, rindex( $path, "/" ) );
            redo RMDIR;
          } else {
            close DIR;
          }
        }
      }
    }
  }
}


########################################
#
#  get in files
#
#  This function is interesting.  It
#  forks itself, and does two things
#  in parallel.  The parent process
#  ftp's files from the source host
#  into a spooling directory.  The
#  child process moves the files to
#  their final home on the destination
#  host.
#
#  The child's job will most likely
#  be the bottle neck if a remote
#  modem connected host is involved.
#  For this reason, the parent counts
#  the number of incoming files in
#  the spooling directory after every
#  ftp.  If there are more than
#  queue_depth files, the parent waits
#  for the child process to catch up.
#  This is done to keep you from using
#  too much temporary space in the
#  spooling directory.
#
#  The parent logs its activities to
#  a file called "ftp.log".  If you
#  need to kill the parent for some
#  reason, just do a chmod 000 on
#  the "ftp.log" file.  (I had a the
#  parent run away on me once.  :-)
#
#  The child knows how big a file
#  that's being ftp'd should be, and
#  it waits until the file grows to
#  that size before placing it.  If
#  the file never gets ftp'd, or if
#  the file size has changed since the
#  directory listing was taken from
#  the source host, the child will get
#  confused.  Just kill pmirror (and
#  remote), remove the new.lst file,
#  and re-start.
#
#  I could talk more about the
#  features of this function, but I
#  would hate to spoil it for you.
#  Just read the source.
#
########################################
sub get_in_files {
  unlink( <i[0-9][0-9]*> );   # blast any old ftp files
  $in_count = 1;
  FORK: {
    if ( $pid = fork() ) {
      # parent here
      # child pid is available in $pid
      open( FTPLOG, "> ftp.log" ) || die "Could not open ftp.log";
      truncate( FTPLOG, 0 );
      close FTPLOG;
      foreach ( @in_list ) {
        ($path, $file, $status, $date, $size) = split( /\s/ );
        $in_file = sprintf( "i%07d", $in_count++ );
        open( FTPLOG, ">> ftp.log" ) || die "Could not open ftp.log";
        print FTPLOG "Getting $file from $src_host to $in_file ...\n";
        close FTPLOG;
        unlink( "still_there" );
        until ( -e "still_there" ) {
          open( FTP, "| ftp $src_host >> ftp.log" ) || die "Could not open ftp";
          print FTP "prompt\n";
          print FTP "hash\n";
          print FTP "bin\n";
          print FTP "cd $src_path\n";
          print FTP "cd $path\n";
          print FTP "dir $file still_there\n";
          print FTP "get $file $in_file\n";
          print FTP "bye\n";
          close FTP;
          unless ( -e "still_there" ) {
            open( FTPLOG, ">> ftp.log" ) || die "Could not open ftp.log";
            print FTPLOG "Could not connect to $src_host.\n";
            print FTPLOG "Trying again in $ftp_retry seconds ...\n";
            close FTPLOG;
            sleep( $ftp_retry );
          }
        } # If the file is "still there", assume that we were able to get it.
          # If this assumption is incorrect (e.g. changed file permissions
          # at the source host), the child will loop forever.
          # I probably need to fix this...
        CHILD_DELAY: {
          @dir = <i[0-9][0-9]*>;
          if ( $queue_depth < @dir ) {
            sleep( $file_wait );
            redo CHILD_DELAY;
          }
        }
      }
      waitpid( $pid, 0 );
    } elsif ( defined $pid ) { #$pid is zero here if defined
      # child here
      # parent pid is available with getppid()
      &reset_handlers();
      foreach( @in_list ) {
        ($path, $file, $status, $date, $size) = split( /\s/ );
        $in_file = sprintf( "i%07d", $in_count++ );
        until ( -e $in_file ) {
          print "Waiting for $in_file ...\n";
          sleep( $file_wait );
        }
        $new_size = (stat( $in_file ))[7];
        while ( $new_size < $size ) {
          printf( "Received %3d%% of %s ...\n", $new_size/$size*100, $in_file );
          sleep( $file_wait );
          $new_size = (stat( $in_file ))[7];
        }
        &place_file( $_, $in_file );
      }
      exit( 0 );
    } elsif ( $! =~ /No more process/ ) {
      # EAGIN, supposedly recoverable fork error
      sleep( 5 );
      redo FORK;
    } else {
      # weird fork() error
      die "Can't fork: $!";
    }
  }
}


########################################
#
#  reset handlers
#
#  Called by the child process
#  in get_in_files() so that only the
#  parent will do clean-up work
#  after a shutdown.
#
########################################
sub reset_handlers {
  $SIG{'INT'}  = 'DEFAULT';
  $SIG{'QUIT'} = 'DEFAULT';
  $SIG{'TERM'} = 'DEFAULT';
  $SIG{'HUP'}  = 'DEFAULT';
}


########################################
#
#  place file
#
#  This function installs a file in
#  the destination path, renames it,
#  and sets the time/date stamp
#  to match the time/date stamp of
#  the original file on the source
#  host.
#
#  If a remote modem connected host is
#  involved, the function downloads
#  the file to the destination host
#  using ZMODEM.
#
########################################
sub place_file {
  local ( $rec, $in_file ) = @_;

  if ( "localhost" eq $dest_host ) {
    ($path, $file, $status, $date, $size) = split( /\s/, $rec );
    if ( "." eq $path ) {
      $path = $dest_path;
    } else {
      $path = $dest_path . "/" . $path;
    }
    unless ( -e $path ) {
      system( "mkdir -p $path" ) && die "mkdir $path";
    }
    $dest = $path . "/" . $file;
    if ( $use_copy ) {
      system( "cp $in_file $dest" ) && die "Could not copy $in_file to $dest.";
      unlink( $in_file );
    } else {
      rename( $in_file, $dest ) || die "Could not move $in_file to $dest.";
    }
    print "Moving $in_file to $dest ...\n";
    utime( $date, $date, $dest );
  } elsif ( "modem" eq $dest_host ) {
    print "Sending $in_file via ZMODEM ...\n";
    system( "sz -y -b $in_file" ) && die "ZMODEM sz";
    unlink( $in_file );
    sleep( $modem_delay );
  }
}


########################################
#
#  clean up
#
#  This function blasts temporary
#  files.  Right now, there aren't
#  very many.
#  
########################################
sub clean_up {
  unlink( "still_there" );
}
