#!/usr/bin/perl
#
# freshrpms -  Fetch RPM packages from FTP servers which are
#              newer than the ones installed on your system
#
# (c) 1997-99 Dirk Lutzebaeck <lutzeb@topmail.de>
#
# NOTE:
#
# This program needs the Perl5 module 'libnet'. If you use Perl less
# than version 5.004 you also need to install the modules 'IO' and
# 'DataDumper'.  You find the modules at your nearest CPAN Perl archive
# before, eg.
# http://ftp.cdrom.com/pub/perl/CPAN/modules/00modlist.long.html
#
# To get the latest version of freshrpms download either from
#
# ftp://ftp.cs.tu-berlin.de/pub/local/flp/lutzeb/software/freshrpms/freshrpms.tar.gz
#
# or enter the following declaration into your freshrpms config file
#
# HOST ftp.cs.tu-berlin.de <your-local-download-directory> \
#      /pub/local/flp/lutzeb/software/freshrpms
#
# Please view the README for a changelog

$version = "0.7.4 [06-Jul-99]";

use Net::FTP;
use POSIX;

### globals

@hosts = ();			# holds hosts spec from config file
@dir_hosts = ();		# holds directory reads
@newrpm_hosts = ();		# holds new rpms from hosts
@lslR_rpmdirs = ();		# rpm direcotories on mirror host
%sysrpms = ();			# system installed rpms
%ldirrpms = ();			# rpms in a local dir
%excludes = ();			# exclude rpm base names
%includes = ();			# include rpm base names
%nogc = ();			# dont garbage collect these rpms
$rpmvers_regex = "[^-]+-[\\w\\.]+\$"; # rpm version regular expression
$rpmvers_regex_split = "([^-]+)-([\\w\\.]+)\$";
$pname = "freshrpms";		# program name
$progress_pid = "0";		# process id of progress indicator

$usage = 
"Usage: freshrpms {<option>}
 <option> ::=
  <host> {<remote-rpm-dir>} # checks for newer rpms in <remote-rpm-dir>
                            # than system installed rpms and in `.' local dir
  (-M | --match-mode) <host> [<lslR-dir> {<partial-rpm-dir>}]
                            # caches ls-lR file from <host> and finds rpm dirs;
                            # if <partial-rpm-dir> given checks for newer rpms
                            # in matching remote subdirectories than system
                            # installed rpms and in `.' local dir
  (-L | --list-rpmdirs)     # if --match-mode list all rpms found
  (-u | --update-lslR)      # if --match-mode force a ls-lR file reload
  (-I | --include) {<pkgbasename>} # only check exclusively for <pkgbasename>
  (-X | --exclude) {<pkgbasename>} # never check for <pkgbasename>
  (-N | --not-installed)    # reverse semantics: fetch all rpms *not* installed
  (-n | --no-fetch)         # don't fetch or garbage collect any rpms (dry run)
  (-a | --arch) <arch>      # force machine architecture to check for
  (-r | --root-dir) <dir>   # set the root directory for system installed rpms
  (-l | --log)              # save remote FTP directory contents
  (-g | --garbage-collect)  # gc older rpms in local download directories
  (-G | --gc-not-others)    # like -g but don't gc rpms which are not installed
  (-b | --batch)            # don't ask for download and don't show progress
  (-f | --conf-file) <file> # use another config file
  (-c | --check-archived)   # check for not archived rpms
  (-C | --compare-test)     # enter interactive rpm version compare test mode
  (-P | --nopgp)            # don't check PGP signature if PGP not installed
  (-q | --quiet)            # don't print any messages
  (-d | --debug)            # print debug messages from Net::FTP module
  (-v | --verbose)          # print more messages
  (-V | --version)          # prints freshrpms version number
  (-h | --help)             # this message
";

$start_time;
$rpms_retrieved = 0;
$rpms_deleted = 0;
$rpms_garbage = 0;
$ftp_failures = 0;
@new_rpms = ();

$rpmrootdir = "/";		# root directory for rpm command
$adir = "";			# archive directory for system installed rpms
$debug = "";			# debug value for FTP operations
$incl = 0;			# flag for include operation
$conf_file = "";		# configuration file

### main program

$| = 1;
$start_time = time;
isatty(STDIN) || ($opt_batch = 1);
ttyname(STDIN) || ($opt_batch = 1);
&read_opts;
&setarch;
&read_rc;
$opt_matchmode && $opt_listrpmdirs && &read_lslR && exit(0);
$chost && &prepare_commandline;
&read_sysrpms;
&get_rpmdirs;
&find_newrpms;
&get_newrpms;
$opt_gc && &garbage_collect_oldrpms;
&stats;
&log("\n");
foreach (sort(@new_rpms)) {
  print("$_\n");
}
exit(0);

### read options from argument list

sub read_opts {
  local($arg);

  while (@ARGV) {
    $arg = @ARGV[0];
    if ($arg =~ /^-f$/ || $arg =~ /^--conf-file$/) {
      if ($ARGV[1] !~ /^-/ && $ARGV[1] ne "") {
	shift @ARGV;
	$conf_file = $ARGV[0];
      } else {
	&fail("missing argument\n");
      }
    } elsif ($arg =~ /^-q$/ || $arg =~ /^--quiet$/) {
      $opt_quiet = 1;
    } elsif ($arg =~ /^-v$/ || $arg =~ /^--verbose$/) {
      $opt_verb = 1;
    } elsif ($arg =~ /^-l$/ || $arg =~ /^--log$/) {
      &log("[OPT]\t--log\n");
      $opt_log = 1;
    } elsif ($arg =~ /^-g$/ || $arg =~ /^--garbage-collect$/) {
      &log("[OPT]\t--garbage-collect\n");
      $opt_gc = 1;
    } elsif ($arg =~ /^-G$/ || $arg =~ /^--gc-not-others$/) {
      &log("[OPT]\t--gc-not-others\n");
      $opt_gc = 1;
      $opt_gc_notothers = 1;
    } elsif ($arg =~ /^-n$/ || $arg =~ /^--no-fetch$/) {
      &log("[OPT]\t--no-fetch\n");
      $opt_nofetch = 1;
    } elsif ($arg =~ /^-i$/ || $arg =~ /^--interactive$/) {
      &log("[OPT]\t--interactive (obsolete)\n");
    } elsif ($arg =~ /^-c$/ || $arg =~ /^--check-archived$/) {
      &log("[OPT]\t--check-archived\n");
      $opt_checkarchive = 1;
    } elsif ($arg =~ /^-P$/ || $arg =~ /^--nopgp$/) {
      &log("[OPT]\t--nopgp\n");
      $rpm_nopgp = "--nopgp";
    } elsif ($arg =~ /^-b$/ || $arg =~ /^--batch$/) {
      &log("[OPT]\t--batch\n");
      $opt_batch = 1;
    } elsif ($arg =~ /^-M$/ || $arg =~ /^--match-mode$$/) {
      &log("[OPT]\t--match-mode");
      $opt_matchmode = 1;
      shift(@ARGV);
      ($chost = $ARGV[0]) && $chost !~ /^-/ || &fail("\nmissing argument\n");
      &log(" $chost");
      if ($ARGV[1] !~ /^-/ && $ARGV[1] ne "") {
	shift(@ARGV);
	$rootdir = $ARGV[0];
	&log(" $rootdir");
	$opt_listrpmdirs = 1;
	while ($ARGV[1] !~ /^-/ && $ARGV[1] ne "") {
	  shift(@ARGV);
	  push(@mdirs, $ARGV[0]);
	  &log(" $ARGV[0]");
	  $opt_listrpmdirs = 0;
	}
      } else {
	$opt_listrpmdirs = 1;
      }
      &log("\n");
    } elsif ($arg =~ /^-u$/ || $arg =~ /^--update-lslR$/) {
      &log("[OPT]\t--update-lslR\n");
      $opt_updatelslR = 1;
    } elsif ($arg =~ /^-I$/ || $arg =~ /^--include$/) {
      &log("[OPT]\t--include");
      $incl = 1;
      %excludes && &fail("specify either --exclude or --include!\n");
      shift(@ARGV);
      while ($ARGV[1] !~ /^-/ && $ARGV[1] ne "") {
	shift(@ARGV);
	$includes{"$ARGV[0]-"} = 1;
	&log(" $ARGV[0]");
      }
      &log("\n");
    } elsif ($arg =~ /^-X$/ || $arg =~ /^--exclude$/) {
      &log("[OPT]\t--exclude");
      %includes && &fail("specify either --exclude or --include!\n");
      shift(@ARGV);
      while ($ARGV[1] !~ /^-/ && $ARGV[1] ne "") {
	shift(@ARGV);
	$excludes{"$ARGV[0]-"} = 1;
	&log(" $ARGV[0]");
      }
      &log("\n");
    } elsif ($arg =~ /^-a$/ || $arg =~ /^--arch$/) {
      &log("[OPT]\t--arch");
      if ($ARGV[1] !~ /^-/ && $ARGV[1] ne "") {
	shift(@ARGV);
	$ARCH = $ARGV[0];
	&log(" $ARCH\n");
      } else {
	&fail("\nmissing argument\n");
      }
    } elsif ($arg =~ /^-r$/ || $arg =~ /^--rootdir$/) {
      &log("[OPT]\t--root-dir");
      if ($ARGV[1] !~ /^-/ && $ARGV[1] ne "") {
	shift(@ARGV);
	$rpmrootdir = $ARGV[0];
	&log(" $rpmrootdir\n");
      } else {
	&fail("\nmissing argument\n");
      }
    } elsif ($arg =~ /^-N$/ || $arg =~ /^--not-installed$/) {
      &log("[OPT]\t--not-installed\n");
      $opt_notinstalled = 1;
    } elsif ($arg =~ /^-L$/ || $arg =~ /^--list-rpmdirs$/) {
      &log("[OPT]\t--list-rpmdirs\n");
      $opt_listverb = 1;
    } elsif ($arg =~ /^-d$/ || $arg =~ /^--debug$/) {
      &log("[OPT]\t--debug\n");
      $debug = 1;
    } elsif ($arg =~ /^-V$/ || $arg =~ /^--version$/) {
      print("freshrpms $version\n");
      exit(0);
    } elsif ($arg =~ /^-C$/ || $arg =~ /^--compare-test$/) {
      print("Version string test mode (enter two strings)\n-> ");
      while(<STDIN>) {
	($a, $b) = split;
	if (&vers_gt($a, $b)) {
	  print("$a is newer than $b\n");
	} else {
	  print("$a is not newer than $b\n");
	}
	print("-> ");
      }
      exit(0);
    } elsif ($arg =~ /^-h$/ || $arg =~ /^--help$/) {
      print($usage);
      exit(0);
    } elsif ($arg =~ /^-/) {
      &fail("unknown option `$arg'\n", $usage);
    } else {
      &log("[OPT]\t");
      ($chost = $ARGV[0]) && $chost !~ /^-/ || &fail("missing argument\n");
      &log($chost);
      while ($ARGV[1] !~ /^-/ && $ARGV[1] ne "") {
	shift(@ARGV);
	push(@crpmdirs, $ARGV[0]);
	&log(" $ARGV[0]");
      }
      &log("\n");
    }
    shift @ARGV;
  }
}

### read config file

sub read_rc {
  local($lineno) = 0;
  local($line);

  open(CF, $conf_file) ||
      open(CF, $conf_file = $ENV{'FRESHRPMS'}) ||
	  open(CF, $conf_file = $ENV{'HOME'} . "/.$pname") ||
	      open(CF, $conf_file = "/usr/local/etc/$pname.conf") ||
		  open(CF, $conf_file = "/etc/$pname.conf") ||
		      return;
  
  &log("[MAIN]\treading config file $conf_file\n");
  
  while(<CF>) {
    $line = $_;
    $lineno++;
    while (/\\$/) {
      chop $line;
      chop $line;
      if (index($line, "#") >= 0) {
	$line = substr($line, 0, index($line, "#"));
      }
      $line .= ($_ = <CF>);
      $lineno++;
    }
    if (index($line, "#") >= 0) {
      $line = substr($line, 0, index($line, "#"));
    }

    $_ = $line;

    if (/^\s*$/) {
      ;
    } elsif (/^\s*exclude\s+(.*)\s*$/i) {
      $opt_verb && &log("[EXCL]\t$1\n");
      %includes && &fail("specify either EXCLUDE or INCLUDE!\n");
      $excludes{$1 . "-"} = 1;
    } elsif (/^\s*include\s+(.*)\s*$/i) { 
      $opt_verb && &log("[INCL]\t$1\n");
      %excludes && &fail("specify either EXCLUDE or INCLUDE!\n");
      $includes{$1 . "-"} = 1;
      $incl = 1;
    } elsif (/^\s*nogc\s+(.*)\s*$/i) {
      $opt_verb && &log("[NOGC]\t$1\n");
      $nogc{$1 . "-"} = 1;
    } elsif (/^\s*installedrpms\s+(.*)\s*$/i ||
	     /^\s*archive\s+(.*)\s*$/i) {
      $opt_verb && &log("[ARDIR]\t$1\n");
      push(@adirs, $1);
    } elsif (/^\s*host\s+(.*)\s*$/i) {
      $opt_verb && &log("[HOST]\t$1\n");
      push(@hosts, $1);
    } else {
      chop;
      &fail("illegal syntax in config file $conf_file (line $lineno):\n'$_'\n");
    }
  }
  close(CF);
}

### read system rpms into global %sysrpms

sub read_sysrpms {
  local($rpm_base, $rpm_vers);

  &log("[MAIN]\treading system installed rpms\n");

  if (! `rpm --version 2>&1`) {
    &log("machine misses 'rpm' command (rpm not in path)!\n" .
	 "Are you running a RedHat Linux distribution?\n");
    exit(1);
  }

  foreach (sort(`rpm --root $rpmrootdir -q -a 2>&1`)) { # read system rpms
    /$rpmvers_regex/;
    $rpm_vers = $&;
    $rpm_base = $`;
    if ($incl) {
      if (exists($includes{$rpm_base})) {
	$sysrpms{$rpm_base} = $rpm_vers;
	$opt_verb && &log("\t$rpm_base$rpm_vers\n");
      }
    } else {
      if (! exists($excludes{$rpm_base})) {
	$sysrpms{$rpm_base} = $rpm_vers;
	$opt_verb && &log("\t$rpm_base$rpm_vers\n");
      }
    }
  }
}

### read rpms of a local directory into global %ldirrpms

sub read_ldirrpms {
  local($ldir, $arch) = @_;
  local($rpm_vers, $rpm_base);
  
  %ldirrpms = ();
  if (! opendir(DIR, $ldir)) {
    &err("can't open $ldir: $!\n");
    return 0;
  }
  foreach (readdir(DIR)) {
    if (s/\.$arch\.rpm$// && /$rpmvers_regex/) {
      $rpm_vers = $&;
      $rpm_base = $`;
      if ($ldirrpms{$rpm_base}) {
	$ldirrpms{$rpm_base} .= "&";
      }
      $ldirrpms{$rpm_base} .= $rpm_vers;
    }
  }
  closedir(DIR);
  return 1;
}

### get rpm ftp server directory listings into global @dir_hosts

sub get_rpmdirs {
  local(@dirs, @dir_list, @dir_host);
  local($host, $arch, $user, $pass, $ldir);
  local($ftp, $ok);
  
  &log("[MAIN]\treading remote rpm directories\n");

  foreach (@hosts) {
    ($host, $arch, $user, $pass, $ldir, @dirs) = &parsehostspec($_);
    $host =~ s/[\"\']//g;
    $arch =~ s/[\"\']//g;
    $user =~ s/[\"\']//g;
    if (! $user) { $user = "anonymous"; }
    $pass =~ s/[\"\']//g;
    $ldir =~ s/[\"\']//g;
    @dir_host = ();
    $first_log_hostdir = 1;

    &log("[CONN]\t$host ... ");
    if ($ftp = Net::FTP->new($host, "Debug", $debug)) {
      &log("ok.\n");
      &log("[LOGIN]\t$user ... ");
      if ($pass) {
	$ok = $ftp->login($user, $pass);
      } else {
	$ok = $ftp->login($user);
      }
      if ($ok) {
	&log("ok.\n");
	foreach $dir (@dirs) {
	  &log("[DIR]\t$dir ... ");
	  if ($ftp->cwd($dir)) {
	    @dir_list = $ftp->dir(".");
	    &log("ok.\n");
	    foreach (@dir_list) { # scan directory file list entries
	      $opt_verb && &log("$_\n");
	      if (/[^\s]+\.$arch\.rpm$/) {
		$rpm = $&;
		if (! @dir_host) { # @dir_host holds all the rpms with path
		  @dir_host = ($host, $arch, $user, $pass, $ldir);
		}
		push(@dir_host, "$dir/$rpm");
	      }
	    }
	    $opt_log && &log_hostdir($host, $ldir, $dir, @dir_list);
	  } else {
	    $ftp_failures++;
	    &log("fail!\n");
	    &log("[FAIL]\t", $ftp->code(), " ", $ftp->message());
	  }
	}
	if (@dir_host) {	# save all hosts rpms with paths in @dir_hosts
	  push(@dir_hosts, join("&", @dir_host));
	}
	&log("[CLOSE]\t$host ... ");
	if ($ftp->quit) {
	  &log("ok.\n");
	} else {
	  &log("fail!\n");
	  &log("[FAIL]\t", $ftp->code(), " ", $ftp->message());
	}
      } else {
	$ftp_failures++;
	&log("fail!\n");
	&log("[FAIL]\t", $ftp->code(), " ", $ftp->message());
      }
    } else {
      $ftp_failures++;
      &log("fail!\n");
    }
    $last_host = $host;
  }
}

### find newer rpms than system installed rpms

sub find_newrpms {
  local($host, $arch, $user, $pass, $ldir, @dir_list);
  local(@newrpm_host, @hostrpm, $ldir_compare);
  local($hostrpm_spec, $hostrpm_fullpath);
  local($rpm_base, $rpm_vers, $hostrpm_base, $hostrpm_vers);

  &log("[MAIN]\tcheck for newer rpms\n");
  
  foreach (@dir_hosts) {
    ($host, $arch, $user, $pass, $ldir, @dir_list) = split(/&/);

    # read hostrpms in a hash array

    %hostrpms = ();
    foreach $hostrpm_fullpath (@dir_list) {
      $hostrpm = substr($hostrpm_fullpath,
			rindex($hostrpm_fullpath, "/") + 1);
      
      if ($hostrpm =~ s/\.$arch\.rpm$// && $hostrpm =~ /$rpmvers_regex/) {
	$hostrpm_vers = $&;
	$hostrpm_base = $`;
	if ($hostrpms{$hostrpm_base}) {
	  $hostrpms{$hostrpm_base} .= "&"; 
	}
	$hostrpms{$hostrpm_base} .= $hostrpm_fullpath . "!" . $hostrpm_vers;
      }
    }

    # read rpms already downloaded

    &read_ldirrpms($ldir, $arch) || next;

    # cross check %sysrpms, %hostrpms and %ldirrpms
   
    @newrpm_host = ();
    if (! $opt_notinstalled) {
      # check for installed rpms
      foreach $sysrpm_base (sort(keys(%sysrpms))) {
	$sysrpm_vers = $sysrpms{$sysrpm_base};
	$ldir_compare = 0;
	foreach $ldirrpm_vers (split(/&/, $ldirrpms{$sysrpm_base})) {
	  if (&vers_gt($ldirrpm_vers, $sysrpm_vers)) {
	    $sysrpm_vers = $ldirrpm_vers;
	    $ldir_compare = 1;
	  }
	}
	$hostrpm_vers = "";	# find the newest rpm on the ftp host
	foreach $hostrpm_spec (split(/&/, $hostrpms{$sysrpm_base})) {
	  @hrpm = split(/!/, $hostrpm_spec);
	  $hrpm_fullpath = $hrpm[0];
	  $hrpm_vers = $hrpm[1];
	  if ($hostrpm_vers eq "" || &vers_gt($hrpm_vers, $hostrpm_vers)) {
	    $hostrpm_vers = $hrpm_vers;
	    $hostrpm_fullpath = $hrpm_fullpath;
	  }
	}
	if ($hostrpm_vers && &vers_gt($hostrpm_vers, $sysrpm_vers)) {
	  if (! @newrpm_host) {
	    @newrpm_host = ($host, $arch, $user, $pass, $ldir);
	  }
	  push(@newrpm_host, $hostrpm_fullpath);
	  $opt_verb &&
	    &log("[COMP]\t\"$host:$hostrpm_fullpath\" is newer than local " .
		 (($ldir_compare) ? "\"$ldir/$sysrpm_base$sysrpm_vers\"" :
		                    "installed $sysrpm_base$sysrpm_vers") .
		 "\n");
	}
      }

    } else {
      # check for not installed rpms
      foreach $hostrpm_base (sort(keys(%hostrpms))) {
	if (! exists($sysrpms{$hostrpm_base})) {
	  $ldirrpm_vers = "";	# find the newest rpm in local dir
	  foreach $lrpm_vers (split(/&/, $ldirrpms{$hostrpm_base})) {
	    if ($ldirrpm_vers) {
	      if (&vers_gt($lrpm_vers, $ldirrpm_vers)) {
		$ldirrpm_vers = $lrpm_vers;
	      }
	    } else {
	      $ldirrpm_vers = $lrpm_vers;
	    }
	  }
	  $hostrpm_vers = "";	# find the newest rpm on the ftp host
	  foreach $hostrpm_spec (split(/&/, $hostrpms{$hostrpm_base})) {
	    @hrpm = split(/!/, $hostrpm_spec);
	    $hrpm_fullpath = $hrpm[0];
	    $hrpm_vers = $hrpm[1];
	    if ($hostrpm_vers eq "" || &vers_gt($hrpm_vers, $hostrpm_vers)) {
	      $hostrpm_vers = $hrpm_vers;
	      $hostrpm_fullpath = $hrpm_fullpath;
	    }
	  }
	  if ((! $ldirrpm_vers) || &vers_gt($hostrpm_vers, $ldirrpm_vers)) {
	    if (! @newrpm_host) {
	      @newrpm_host = ($host, $arch, $user, $pass, $ldir);
	    }
	    push(@newrpm_host, $hostrpm_fullpath);
	  }
	}
      }
    }

    if (@newrpm_host) {		# add new rpms to get from this host
      push(@newrpm_hosts, join("&", @newrpm_host));
    }

    # log rpms which are not installed on the system

    $opt_log && &log_hostother($host, $ldir);
  }
}

### get newer rpms and remove older downloads

sub get_newrpms {
  local($ftp);
  local($host, $arch, $user, $pass, $ldir, @newrpms);
  local($hostrpm, $hostrpm_base);
  local($ldirrpm, $ok, $size);
  
  &log("[MAIN]\tget new rpms\n");

  foreach (@newrpm_hosts) {
    ($host, $arch, $user, $pass, $ldir, @newrpms) = split(/&/);

    &read_ldirrpms($ldir, $arch) || next;
    &log("[CHDIR]\t$ldir ... ");
    chdir($ldir);
    &log("ok.\n");

    &log("[CONN]\t$host ... ");
    if ($ftp = Net::FTP->new($host, "Debug", $debug)) {
      &log("ok.\n");
      &log("[LOGIN]\t$user ... ");
      if ($pass) {
	$ok = $ftp->login($user, $pass);
      } else {
	$ok = $ftp->login($user);
      }
      if ($ok) {
	&log("ok.\n");
	foreach $hostrpm_fullpath (@newrpms) {
	  $hostrpm_arch = substr($hostrpm_fullpath,
			    rindex($hostrpm_fullpath, "/") + 1);
	  $hostrpm = $hostrpm_arch;
	  $hostrpm =~ s/\.$arch\.rpm$//;
	  $hostrpm =~ /$rpmvers_regex/;
	  $hostrpm_base = $`;
	  &log("[GET]\t$hostrpm_fullpath ... ");
	  if (! -e $hostrpm_arch) { # downloaded before for another host?
	    # make a temp download file to check for partial downloads
	    $downloadfile = $hostrpm_arch . ".partial";
	    if (! $opt_nofetch) {
	      &log("(");
	      $size = $ftp->size($hostrpm_fullpath);
	      &log("$size bytes) ... ");
	      (-s $downloadfile) &&
		&log("[REGET] ", $size - (stat($downloadfile))[7],
		     " bytes ... ");
	    }
	    if (! $opt_batch) {
	      &log("(y/n/a/q)? [y] ");
	      $_ = <STDIN>;
	      if (/^a/i) {
		$opt_batch = 1;
	      } elsif (/^q/i) {
		exit 0;
	      } elsif (/^n/i) {
		next;
	      }
	    }
	    if (! $opt_nofetch) {
	      $downloadstart = time;
	      $opt_batch || &fork_progress_indicator($downloadfile, $size);
	    }
	    if ($opt_nofetch ||
		$ftp->get($hostrpm_fullpath, $downloadfile, (-s $downloadfile))) {
	      if ($opt_nofetch) {
		&log("not fetched.\n");
	      } else {
		$opt_batch || &kill_progress_indicator;
		&log("ok.\n");
		&print_downloadtime(time - $downloadstart, $size);
	      }
	      $rpms_retrieved++;
	      push(@new_rpms, $hostrpm_arch);
	      if (! $opt_nofetch) {
		system("mv -f \"$downloadfile\" \"$hostrpm_arch\"");
		&log("[MD5]\t");
		&log($rpm_checksig = `rpm --checksig $rpm_nopgp $hostrpm_arch 2>&1`);
		# $? return -1 when `rpm --checksig` succeeds! So we can't
		# rely on the return code -> check the output...
		if ($rpm_checksig =~ /md5.+ok/i) {
		  &log("[INFO]\n");
		  &log(`rpm -q -i -p $hostrpm_arch 2>&1`);
		  # garbage collect older versions
		  if (! exists($nogc{$hostrpm_base})) {
		    foreach $ldirrpm_vers (split(/&/, $ldirrpms{$hostrpm_base})) {
		      $ldirrpm = $hostrpm_base . $ldirrpm_vers . ".$arch.rpm";
		      &remove($ldirrpm);
		    }
		  }
		} else {
		  # not a correct rpm file so delete it
		  &remove($hostrpm_arch);
		  $rpms_retrieved--;
		  pop(@new_rpms);
		}
	      }
	    } else {
	      $ftp_failures++;
	      $opt_batch || &kill_progress_indicator;
	      &log("fail!\n");
	      &log("[FAIL]\t", $ftp->code(), " ", $ftp->message());
	    }
	  } else { 
	    &log("already downloaded.\n");
	  }
	}
	&log("[CLOSE]\t$host ... ");
	if ($ftp->quit) {
	  &log("ok.\n");
	} else {
	  &log("fail!\n");
	  &log("[FAIL]\t", $ftp->code(), " ", $ftp->message());
	}
      } else {
	$ftp_failures++;
	&log("fail!\n");
	&log("[FAIL]\t", $ftp->code(), " ", $ftp->message());
      }
    } else {
      $ftp_failures++;
      &log("fail!\n");
    }
  }
}

### garbage collect rpms in the local directories which are older
### that the system installed ones or have been erased from the system

sub garbage_collect_oldrpms {
  local($host, $arch, $user, $pass, $ldir, @dirs);
  local($gcrpm, $rpm_base, $rpm_vers, %adirrpms);

  # garbage collect in the download dirs

  &log("[MAIN]\tgarbage collect old rpms\n");

  foreach (@hosts) {
    ($host, $arch, $user, $pass, $ldir, @dirs) = &parsehostspec($_);
    $ldir =~ s/[\"\']//g;
    $arch =~ s/[\"\']//g;
    
    &read_ldirrpms($ldir, $arch) || next;
    &log("[CHDIR]\t$ldir ... ");
    chdir($ldir);
    &log("ok.\n");

    foreach $ldirrpm_base (sort(keys(%ldirrpms))) {
      if (! exists($nogc{$ldirrpm_base})) {
	$ldirrpm_vers = $ldirrpms{$ldirrpm_base};
	$gcrpm = $ldirrpm_base . $ldirrpm_vers . ".$arch.rpm";
	if (! exists($sysrpms{$ldirrpm_base})) {
	  &gc($gcrpm) unless $opt_gc_notothers;
	} else {
	  foreach $sysrpm_vers (split(/&/, $sysrpms{$ldirrpm_base})) {
	    if (! &vers_gt($ldirrpm_vers, $sysrpm_vers)) {
	      &gc($gcrpm);
	    }
	  }
	}
      }
    }
  }

  # garbage collect in the additional archive dirs

  foreach $adir (@adirs) {	# any additional archive directories?
    &log("[ADIR]\t$adir\n");
    if (! chdir($adir)) {
      &err("can't chdir to $adir: $!\n");
      next;
    }
    if (! opendir(DIR, ".")) {
      &err("can't open $adir: $!\n");
      next;
    }
    %adirrpms = ();
    foreach (readdir(DIR)) {
      $gcrpm = $_;
      if (s/\.[^\.]+\.rpm$// && /$rpmvers_regex/) {
	$rpm_vers = $&;
	$rpm_base = $`;
	$adirrpms{$rpm_base} = $rpm_vers;
	if (! exists($nogc{$rpm_base})) {
	  if (! exists($sysrpms{$rpm_base})) {
	    &gc($gcrpm) unless $opt_gc_notothers;
	  } elsif (&vers_gt($sysrpms{$rpm_base}, $rpm_vers)) {
	    &gc($gcrpm);
	  }
	}
      }
    }
    closedir(DIR);
    
    # check for not archived system installed rpms
    
    if ($opt_checkarchive) {
      foreach $rpm_base (sort(keys(%sysrpms))) {
	if (! exists($adirrpms{$rpm_base})) {
	  &log("[INFO]\t$rpm_base$sysrpms{$rpm_base} " .
	       "is installed but not archived in $adir\n");
	}
      }
    }
  }
}

### garbage collect a file

sub gc {
  local($gcrpm) = @_;
  local($gcrpm_bin, $gcrpm_noarch);

  if ($gcrpm =~ /\((\w+)\|(\w+)\)/) {
    $gcrpm_bin = $` . $1 . $';
    $gcrpm_noarch = $` . $2 . $';
    if (-f $gcrpm_bin) {
      $gcrpm = $gcrpm_bin;
    } elsif (-f $gcrpm_noarch) {
      $gcrpm = $gcrpm_noarch;
    }
  }

  &log("[GC]\t$gcrpm ... ");
  if (-f $gcrpm) {
    $opt_nofetch || unlink($gcrpm);
    $rpms_garbage++;
    $rpms_deleted++;
    $opt_nofetch ? &log("not gc'ed.\n") : &log("ok.\n");
  } else {
    &log("already garbage collected.\n");
  }
}

### remove a file

sub remove {
  local($fn) = @_;
  local($fn_bin, $fn_noarch);
  
  if ($fn =~ /\((\w+)\|(\w+)\)/) {
    $fn_bin = $` . $1 . $';
    $fn_noarch = $` . $2 . $';
    if (-f $fn_bin) {
      $fn = $fn_bin;
    } elsif (-f $fn_noarch) {
      $fn = $fn_noarch;
    }
  }

  &log("[DEL]\t$fn ... ");
  if (unlink($fn)) {
    $rpms_deleted++;
    &log("ok.\n");
  } else {
    &log("fail!\n");
  }
}

### version compare (greater than)

sub vers_gt {
  local($va, $vb) = @_;
  local($va_v, $vb_v);		# version part
  local($va_r, $vb_r);		# release part
  local($res);
  
  if ($va =~ /$rpmvers_regex_split/) {
    $va_v = $1;
    $va_r = $2;
  } else {
    &err("illegal version string syntax ($va)\n");
    return 0;
  }

  if ($vb =~ /$rpmvers_regex_split/) {
    $vb_v = $1;
    $vb_r = $2;
  } else {
    &err("illegal version string syntax ($vb)\n");
    return 0;
  }
  
  $res = &vers_gt_s($va_v, $vb_v); # compare version part
  if ($res eq "=") {		# if they are equal
    $res = &vers_gt_s($va_r, $vb_r); # compare release part
    return ($res eq "=") ? 0 : $res;
  } else {
    return $res;
  }
}

sub vers_gt_s {
  my($va, $vb) = @_;
  my(@va_dots) = split(/\./, $va);
  my(@vb_dots) = split(/\./, $vb);
  my($a, $b);

  # print ("$va > $vb ?\n");

  for ($i=0; $i <= $#va_dots || $i <= $#vb_dots; $i++) {
    # compare each minor from left to right
    $a = $va_dots[$i]; $b = $vb_dots[$i];
    # print("/$a/ | /$b/\n");
    if ($a eq "") { return 0; }	# the longer version is newer
    if ($b eq "") { return 1; }
    if ($a =~ /^\d+$/ && $b =~ /^\d+$/) {
      # numeric compare
      if ($a != $b) { return $a > $b; }
    } else {
      # string compare
      if ($a =~ /\d+/ || $b =~ /\d+/) {
	# we have digits in some minor, so split them for digits and non-digits
	# and take them as a version string with dots
	if (($a =~ /^\d+$/ && $b =~ /^\D+$/) ||	# recursion stop
	    ($a =~ /^\D+$/ && $b =~ /^\d+$/)) {
	  return $a gt $b;
	} else {
	  my $res =  vers_gt_s(join(".", ($a =~ /(\D+|\d+)/g)),
			       join(".", ($b =~ /(\D+|\d+)/g)));
	  return $res unless $res eq "=";
	}
      } else {
	# no digits in the minor string
	if (length($a) == 1 && length($b) == 1) {
	  # only minors with one letter seem to be useful for version
	  if ($a ne $b) { return $a gt $b; }
	}
      }
    }
  }

  return "=";			# versions are equal
}

### parse HOST entry line

sub parsehostspec {
  local($line) = @_;
  local(@spec);

  $line =~ s/\\\s/\001/g;	# mark escaped space characters with \001
  foreach (split(/\s+/, $line)) {
    s/\001/ /g;
    push(@spec, $_);
  }
  
  if ($spec[1] =~ /^\//) {
    # second argument is a path so we fill up
    # arch, login and pass automagically
    return (shift(@spec), $ARCH, "", "", @spec);
  } else {
    return @spec;
  }
}

### log the directory listings

sub log_hostdir {
  local($host, $ldir, $dir, @dir_list) = @_;

  &log("[LOG]\t$ldir ... ");

  if (! chdir($ldir)) {
    &err("can't cd to $ldir: $!\n");
    return 0;
  }

  if (! -d ".$pname") {
    mkdir(".$pname", 0755);
  }

  if ($first_log_hostdir) {
    unlink(".$pname/$host-DIR");
    $first_log_hostdir = 0;
  }

  if (! open(LOG, ">>.$pname/$host-DIR")) {
    &err("can't write to $ldir/.$pname/$host-DIR: $!\n");
    return 0;
  }
  print(LOG "DIR $dir\n");
  foreach (@dir_list) {
    print(LOG "$_\n");
  }
  close(LOG);

  &log("ok.\n");

  return 1;
}

### log rpms which are not installed in the system

sub log_hostother {
  local($host, $ldir) = @_;
  local(%hrpms) = %hostrpms;
  local(@hrpm, $hrpm_fullpath, $hrpm_vers);

  foreach $sysrpm_base (keys(%sysrpms)) { # kick out installed rpms
    delete($hrpms{$sysrpm_base});
  }

  chdir($ldir);

  if (! open(LOG, ">.$pname/$host-OTHER")) {
    &err("can't write to $ldir/.$pname/$host-OTHER: $!\n");
    return 0;
  }

  # print the rpms which are left over in %hrpms

  foreach $hrpm_base (sort(keys(%hrpms))) {
    foreach $hspec (split(/&/, $hrpms{$hrpm_base})) {
      @hrpm = split(/!/, $hspec);
      $hrpm_fullpath = $hrpm[0];
      $hrpm_vers = $hrpm[1];
      print(LOG $hrpm_base . $hrpm_vers . "\n");
    }
  }

  close(LOG);
  return 1;
}  

### get an FTP file

sub get_file {
  local($host, $from, $to) = @_;
  local($dir, $file, @dir, $size, $starttime, $transtime, $bps);
  local($ok) = 0;

  @dir = split(/\//, $from);
  $file = pop(@dir);
  $dir = join("/", @dir);

  &log("[CONN]\t$host ... ");
  if ($ftp = Net::FTP->new($host, "Debug", $debug)) {
    &log("ok.\n");
    &log("[LOGIN]\tanonymous ... ");
    if ($ftp->login("")) {
      &log("ok.\n");
      if ($to =~ /\.DIR$/) { 
	&log("[DIR]\t$dir ... ");
	if ($ftp->cwd($dir)) {
	  &log("ok.\n");
	  $ok = 1;
	  open(DIR, ">$to") || fail("can't create $to: $!\n");
	  foreach ($ftp->dir($dir)) {
	    print(DIR "$_\n");
	  }
	  close(DIR);
	} else {
	  &log("fail!\n");
	  &log("[FAIL]\t", $ftp->code(), " ", $ftp->message());
	}
      } else {
	&log("[GET]\t$from as $to ... ");
	if ($ftp->cwd($dir)) {
	  &log("(");
	  $size = $ftp->size($file);
	  &log("$size bytes) ... ");
	  $downloadfile = $to;
	  $downloadstart = time;
	  $opt_batch || &fork_progress_indicator($downloadfile, $size);
	  if ($ftp->get($file, $to)) {
	    $opt_batch || &kill_progress_indicator;
	    &log("ok.\n");
	    $ok = 1;
	    &print_downloadtime(time - $downloadstart, $size);
	    if ($from =~ /\.gz$/ && $to !~ /\.gz$/) {
	      system("mv -f $to $to.gz ; gunzip $to.gz");
	    }
	    if ($from =~ /\.Z$/ && $to !~ /\.Z$/) {
	      system("mv -f $to $to.Z ; uncompress $to.Z");
	    }
	  } else {
	    $opt_batch || &kill_progress_indicator;
	    &log("fail!\n");
	    &log("[FAIL]\t", $ftp->code(), " ", $ftp->message());
	  }
	} else {
	  &log("fail!\n");
	  &log("[FAIL]\t", $ftp->code(), " ", $ftp->message());
	}
      }
      &log("[CLOSE]\t$host ... ");
      if ($ftp->quit) {
	&log("ok.\n");
      } else {
	&log("fail!\n");
	&log("[FAIL]\t", $ftp->code(), " ", $ftp->message());
      }
    } else {
      &log("fail!\n");
      &log("[FAIL]\t", $ftp->code(), " ", $ftp->message());
    }
  } else {
    &log("fail!\n");
  }

  return $ok;
}

### print download stats

sub print_downloadtime {
  local($transtime, $size) = @_;
 
  if ($size > 0 && $transtime > 0) {
    &log("[STAT]\t", 
	 sprintf("%dm%02ds, ", int($transtime / 60), $transtime % 60),
	 &download_speed($transtime, $size), "\n");
  }
}

### calculate download speed/time

sub download_speed {
  local($transtime, $size) = @_;
  local($bps);
  local($s) = "";

  $bps = int($size / $transtime);
  if ($bps < 1024) {
    $s .= "$bps bytes/s";
  } elsif ($bps < 1024 * 1024) {
    $s .= sprintf("%.2f kB/s", ($bps / 1024));
  } else {
    $s .= sprintf("%.2f MB/s", ($bps / 1024 / 1024));
  }
}

### fork a progress indicator

sub fork_progress_indicator {
  local($file, $targetsize) = @_;
  local($size, $lastsize, $pid, $stalledtime, $lasttime);
  local($evaltime, $evalsize, $remaintime, $speedtime, $speedsize);

  if ($progress_pid = fork) {
    $SIG{INT} = \&interrupt;
    $SIG{QUIT} = \&interrupt;
    return;
  } else {
    $size = (stat($file))[7];
    $lastsize = -1;
    $speedsize = $size;
    $starttime = time;
    $speedtime = $starttime;
    $lasttime = $starttime;
    while ($size >= 0 && $size < $targetsize) {
      $s = " ";
      $s .= sprintf("%2d%% ", int($size / $targetsize * 100));
      if ($size == $lastsize) {
	$stalledtime = time - $lasttime;
	$speedtime = time;
	$speedsize = $size;
	$s .= sprintf("stalled for %dm%02ds",
		      int($stalledtime / 60), $stalledtime % 60);
      } else {
	# calc the speed since last stall
	$lasttime = time;
	$evaltime = time - $speedtime;
	$evalsize = $size - $speedsize;
	if ($evaltime > 0 && $evalsize > 0) {
	  $remaintime = ($targetsize - $size) / ($evalsize / $evaltime) ;
	  $s .= sprintf("%dm%02ds, ", int($remaintime / 60), $remaintime % 60),
	  $s .= &download_speed($evaltime, $evalsize);
	}
      }
      print($s, "" x length($s));
      sleep(1);
      print(" " x length($s), "" x length($s));
      $lastsize = $size;
      $size = (stat($file))[7];
    }
    exit;
  }
}

### kill the process indictaor safely

sub kill_progress_indicator {
  if ($progress_pid) {
    kill(15, $progress_pid);
    $progress_pid = 0;
    $SIG{INT} = "DEFAULT";
    $SIG{QUIT} = "DEFAULT";
  }
}

### interrupt handler for SIGINT, SIGQUIT

sub interrupt {
  $opt_batch || &kill_progress_indicator;
  exit 1;
}

### read lslR file remotely or cached and find rpm files

sub read_lslR {
  local($lslR);
  local($arch) = "(i386|noarch)";
  local($cwd, $prcwd, $rpm_dir, $rootdircache);

  $rootdir || ($rootdir = "/");
  $rootdircache = $rootdir;
  if ($rootdircache) {
    $rootdircache =~ s/\//:/g;
  }

  $lslR = "/var/lib/$pname/$chost$rootdircache-lslR";

  &log("[RDIRS]\t$lslR\n");

  (! -d "/var/lib/$pname") && mkdir("/var/lib/$pname", 0755);

  $chost || &fail("no host specfied. Use <host> [<rootdir> {<subdirs>}].\n");

  # get the remote ls-lR file

  if (! -f $lslR ||
      (-f $lslR && ($opt_updatelslR || (time - (stat($lslR))[9]) > 86390))) {
    if ($rootdir ne "/") {
      foreach $ls ("$rootdir/ls-lR.gz",
		   "$rootdir/ls-lR.Z",
		   "$rootdir/ls-lR") {
	if (&get_file($chost, $ls, $lslR)) {
	  &get_file($chost, $ls, "$lslR.DIR");
	  last;
	}
      }
    } else {
      foreach $ls ("/pub/ls-lR.gz",
		   "/pub/ls-lR.Z",
		   "/pub/ls-lR",
		   "/ls-lR.gz",
		   "/ls-lR.Z",
		   "/ls-lR") {
	if (&get_file($chost, $ls, $lslR)) {
	  &get_file($chost, $ls, "$lslR.DIR");
	  last;
	}
      }
    }
  }

  # read the ls-lR and ls-lR.DIR file

  (! -f $lslR) &&
      &fail("no ls-lR file found for host $chost$rootdir\n");
  (! -f "$lslR.DIR") &&
      &fail("no ls-lR.DIR file found for host $chost$rootdir\n");

  open(D, "$lslR.DIR") || &fail("can't open $lslR.DIR: $!\n");
  while(<D>) {
    chop $_;
    if ($_ !~ /^\./ && $_ !~ /^total/) {
      /\S+$/;
      push(@lslR_dir, $&);
    }
  }
  close(D);

  open(L, $lslR) || &fail("can't open $lslR: $!\n");
  while(<L>) {
    if (/:$/) {			# current directory
      $cwd = $`;
      $rpm_dir = 0;
      $prcwd = 1;
    } elsif (/\.$arch\.rpm$/) {
      if (! $rpm_dir && ! grep(/^$cwd$/, @lslR_rpmdirs)) {
	push(@lslR_rpmdirs, $cwd);
	$rpm_dir = 1;
	$opt_listrpmdirs && print("\t$cwd\n");
      }
      if ($opt_listverb && grep(/^$cwd$/, @lslR_rpmdirs)) {
	print($_);
      }
    }
  }
  close(L);

  return 1;
}

### setup @hosts for commandline arguments

sub prepare_commandline {
  local($i, $subdir);
  local($odir) = "";

  $hosts_num || (@hosts = ());	# ignore HOST specs read by the config file
  $hosts[$hosts_num] = "$chost $ARCH '' '' . ";

  if (! $opt_matchmode) {
    foreach $crpmdir (@crpmdirs) {
      $hosts[$hosts_num] .= " $crpmdir";
    }
  } else {
    @lslR_rpmdirs || &read_lslR;

  FOUND:
    foreach $lslR_rpmdir (@lslR_rpmdirs) {
      $odir = "";
      foreach $lslR_rpmdir_elem (split(/\//, $lslR_rpmdir)) {
	$lslR_rpmdir_elem || next;
	if ($lslR_rpmdir_elem ne "pub") {
	  foreach $lslR_dir (@lslR_dir) {
	    foreach $lslR_dir_elem (split(/\//, $lslR_dir)) {
	      ($lslR_dir_elem eq $lslR_rpmdir_elem) && last FOUND;
	    }
	  }
	}
	$odir .= "/$lslR_rpmdir_elem";
      }
    }
    
    # find directory offset from 
    
    foreach $lslR_rpmdir (@lslR_rpmdirs) {
      $subdir = substr($lslR_rpmdir, length($odir), length($lslR_rpmdir));
      foreach $mdir (@mdirs) {
	if ($lslR_rpmdir =~ /^\Q$mdir\E$/ ||
	    $lslR_rpmdir =~ /\/\Q$mdir\E$/ ||
	    $lslR_rpmdir =~ /^\Q$mdir\E\// ||
	    $lslR_rpmdir =~ /\/\Q$mdir\E\//) {
	  if ($rootdir !~ /\/$/ && $subdir !~ /^\//) {
	    $rootdir .= "/";
	  }
	  $hosts[0] .= " $rootdir$subdir";
	  $opt_verb && &log("[CHECK]\t" . "$rootdir$subdir");
	}
      }
    }
  }
  $hosts_num++;
}

### find RPM compatible machine architecture

sub setarch {
  # anyone know a better way to do this?

  if (! $ARCH) {
    if (-x "/bin/uname" || -x "/usr/bin/uname") {
      $ARCH = `uname -m`;
      chop $ARCH;
    } elsif (-x "/bin/arch" || -x "/usr/bin/arch") {
      $ARCH = `arch`;
      chop $ARCH;
    } else {
      $ARCH = "i386";
    }
    
    if ($ARCH =~ /^i(\d|E)86/) { # E is a Cyrix CPU!
      $ARCH = "i386";		# normalize Intel Architecture
    } elsif ($ARCH =~ /^a/) {
      $ARCH = "alpha";		# normalize Alpha architecture;
    }
  }

  $ARCH = "($ARCH|noarch)";

  &log("[ARCH]\t$ARCH\n");
}

### print statistics

sub stats {
  local($dur) = time - $start_time;
  local($min) = int($dur / 60);
  local($sec) = $dur % 60;

  &log("[STAT]\t" . $min . "m" . "$sec" . "s run time.\n");
  &log("[STAT]\t$ftp_failures FTP failure(s).\n");
  &log("[STAT]\t$rpms_retrieved rpm(s) " .
       ($opt_nofetch ? "would have been " : "") .
       "retrieved.\n");
  &log("[STAT]\t$rpms_deleted rpm(s) " .
       ($opt_nofetch ? "would have been " : "") .
       "deleted ($rpms_garbage garbage collected).\n");
}

### logging functions

sub fail {
  print(STDERR @_);
  exit(1);
}

sub log {
  if (! $opt_quiet) {
    print(@_);
  }
}

sub err {
  print(STDERR @_);
}

# EOF
