#!/usr/bin/perl
##############################################################################
#
#  remote   1.15
#
#  Introduction
#    This script works in conjunction with the "pmirror" script to retrieve
#    and maintain an up to date copy of any archive directory structure
#    that is available from a UNIX host via anonymous ftp.
#
#    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, remote would repeat the following cycle
#    until all files of the required files were updated:
#
#      1. Wait for the next file to finish downloading
#      2. Move the file to the proper directory
#      3. If not done, repeat
#
#  Where to Start
#    The "remote" script accepts several switches.  The following is a
#    description of their functions:
#
#       -i  Build the initial "old.lst" directory listing file
#
#       -c  Remove (clean) all of the files specified in the "rm.lst" file
#
#       -pN Start placing files with file index number 'N'.
#
#    Normally, all switches will be given, and 'N' will be 1; however, if
#    you run "remote" under DOS, you will most likely call it once with
#    the '-i' switch and a second time with the '-c' and '-p' switches after
#    all of the downloading is complete.  Make sure that you run the
#    "remote" script in the directory where your communications packages
#    stores downloaded files, or remote won't be able to find them!
#
#    See the comments in the "pmirror" script for more instructions on how
#    to get started.
#
#  Support for DOS Perl
#    This script runs using Darryl Okahata's (darrylo@sr.hp.com)
#    "BIGPERL" port of perl for DOS which he released in October of
#    1994.  I got my copy from ftp.ee.umanitoba.ca in a file called
#    /pub/msdos/perl/perl4/bperl4x.zip.  I did have to modify the
#    pwd.pl file in the lib directory.  Change the two occurrences of
#    "`pwd`" to "`cd`" (unless you have a pwd(1) program in your DOS
#    path!).  Testing was done under MS-DOS 6.22 with 4096K of EMS
#    configured using HIMEM.SYS and EMM386.EXE.
#
#    Since DOS probably can't run your communications package and my
#    "remote" perl script at the same time, you'll have to do this in
#    several steps:
#
#       1. Go to the "User Configuration Section" and customize the
#          "remote" and "pmirror" scripts for your application.
#       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 downloaded files with:  perl remote -c -p 1
#
#    Don't be afraid to tinker with the script if something goes
#    wrong.  The script is not very sophisticated, and it may not
#    be able to handle what you're doing as is.  Please let me know
#    what you had to do to fix it so that I can roll your changes
#    into the next release!
#
#  Author:  David C. Snyder (dsnyder@netcom.com)
##############################################################################

require "pwd.pl";
require "getopts.pl";


##############################################################################
#
#  User Configuration Section
#
#  Change the values of the variables below to reflect the data you wish
#  to mirror.  Note that "DOS" for $dest_host is experimentally supported.
#  If you set $dest_host to "DOS", remember that you need to double
#  back-slashes in path names.  For example:
#
#     $dest_path = "c:\\archive\\linux";
#
#  dest_host    - Set to "UNIX" or "DOS"
#  dest_path    - The path where the mirrored files will be stored
#  spool_dir    - The temporary spooling area for received files
#  file_wait    - Number of seconds to wait before re-checking for a file
#  use_copy     - If set to 1, use cp/COPY instead of rename() to place files
#  kill_dirs    - If set to 1, try to remove local empty directories that are
#                 not on the mirrored site
#
$dest_host    = "UNIX";
$dest_path    = "/home/davids/tmp/slackware";
$spool_dir    = "/home/davids/tmp/modem";
#
$file_wait    = 5;
$use_copy     = 1;
$kill_dirs    = 1;
#
##############################################################################


if ( $#ARGV < 0 ) {
  print "Usage:  remote -i -c -p 1\n";
  exit( 1 );
}


&initpwd();
&chdir( $spool_dir ) || die "Could not cd to $spool_dir";
&Getopts( 'icp:' );
&initialize() if ( $opt_i );  # Take a listing of the destination path.
&clean()      if ( $opt_c );  # Remove files that don't belong.
&place()      if ( $opt_p );  # Move the downloaded files to their new home.
exit( 0 );


########################################
#
#  initialize
#
#  One of the first steps in this
#  process is to upload the "old.lst"
#  directory listing file to the
#  "pmirror" script, which should be
#  running in your dial-up UNIX
#  shell account.
#
########################################
sub initialize {
  unlink( "skip.lst", "in.lst", "rm.lst", <i[0-9][0-9]*> );
  &get_local_list( "old.lst" );
}


########################################
#
#  get local list
#
#  This function just takes a
#  recursive directory listing of
#  the destination path.
#
########################################
sub get_local_list {
  local ( $file ) = @_;

  if ( "UNIX" 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 ( "DOS" eq $dest_host ) {
    print "Building $file from $dest_path ...\n";
    $old_dir = $ENV{'PWD'};
    $old_dir =~ s#/#\\#g;
    &chdir( $dest_path ) || die "$dest_path does not exist";
    system( "dir /s > " . $old_dir . "\\" . $file );
    &chdir( $old_dir );
  } else {
    die "$dest_host is not a supported dest_host type";
  }
}


########################################
#
#  clean
#
#  This function reads the
#  rm.lst and in.lst into memory.
#  It then removes all files that
#  are in either of the lists to make
#  room for the files that will be
#  downloaded.
#
########################################
sub clean {
  @rm_list = &get_list( "rm.lst" );
  @in_list = &get_list( "in.lst" );
  &rm_files();
}


########################################
#
#  get list
#
#  This function waits for a generic
#  list file to finish downloading.
#  It returns the list.
#
########################################
sub get_list {
  local ( $file ) = @_;

  @tmp_list = ();
  $lrec = "";
  until( "--EOT--" eq $lrec ) {
    unless ( open( LIST, "< $file" ) ) {
      print "Waiting for $file ...\n";
      sleep( $file_wait );
      next;
    }
    @tmp_list = <LIST>;
    close LIST;
    chop( $lrec = pop( @tmp_list ) );
    unless ( "--EOT--" eq $lrec ) {
      print "Waiting for $file ...\n";
      sleep( $file_wait );
      next;
    }
  }
  @tmp_list;
}


########################################
#
#  rm files
#
#  This function removes the files
#  in the rm_list and in_list from the
#  destination host.  This is done
#  before any new files are downloaded
#  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 ( "UNIX" 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;
          }
        }
      }
    }
  } elsif ( "DOS" eq $dest_host ) {
    foreach ( @rm_list, @in_list ) {
      ($path, $file, $status, $date, $size) = split( /\s/ );
      $path =~ s#/#\\#g;
      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;
          }
        }
      }
    }
  } else {
    die "$dest_host is not a supported dest_host type";
  }
}


########################################
#
#  place
#
#  This function waits for the
#  individual files to finish
#  downloading.  As they are downloaded
#  it calls place_file() to have them
#  moved to their new home.
#
########################################
sub place {
  @in_list = &get_list( "in.lst" ) if ( 0 == @in_list );
  for ( $in_count = 1; $in_count < $opt_p; $in_count++ ) {
    shift( @in_list );
  }
  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 );
  }
}


########################################
#
#  place file
#
#  This function moves a file to
#  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.
#
########################################
sub place_file {
  local ( $rec, $in_file ) = @_;

  if ( "UNIX" 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 ( "DOS" eq $dest_host ) {
    ($path, $file, $status, $date, $size) = split( /\s/, $rec );
    $path =~ s#/#\\#g;
    if ( "." eq $path ) {
      $path = $dest_path;
    } else {
      $path = $dest_path . "\\" . $path;
    }
    &mkpath( $path ) unless ( -e $path );
    $dest = $path . "\\" . $file;
    if ( $use_copy ) {
      system( "copy $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 );
  } else {
    die "$dest_host is not a supported dest_host type";
  }
}


########################################
#
#  mkpath
#
#  This recursive function creates
#  a directory path.  It performs the
#  same job as the UNIX 'mkdir -p'
#  command.
#
########################################
sub mkpath {
  local ( $path ) = @_;

  return if ( $path eq "" || $path =~ /:$/ || -d $path );
  $parent = substr( $path, 0, rindex( $path, "\\" ) );
  &mkpath( $parent );
  mkdir( $path, 755 ) || die "Could not create directory:  $path";
}
