#!/usr/bin/perl
#
# rhupd - fetch redhat package manager updates from the network
# $Revision: 1.9 $
#
# Author/Maintainer: Jonathan Stigelman <Stig@hackvan.com>
# Latest Version:    http://hackvan.com/pub/stig/src/linux/
#
# USAGE: rhupd [-afnqu] [ known_mirror_host | [user@]host:/path/to/rpm_directory ]
#
#   -a - get all files without prompting
#   -f - force download even if file already exists in current directory
#   -n - identify packages that are "new" (e.g. not yet installed)
#   -r - use rpm to do the updates, don't ftp files (NOT IMPLEMENTED)
#   -u - identify "updates" packages (e.g. don't mention older versions)
#   -q - quiet operation (intended for late-night cron invocation)
#   -v - verbose operation (intended for debugging)
#
# rhupd queries the set of installed packages on the local machine.  It
# then connects to the redhat repository of your choice via ftp, examines
# the list of available updates there, and informs you of any packages that
# have had their patch level increased or version number changed. You can
# then choose to have all of the indicated packages downloaded, or
# individually select which packages to download. The transferred RPMs are
# placed in the current working directory. They can then be installed on
# your system by using the command rpm -u <file>, where <file> is one of
# the downloaded RPMs.
#
# Note that if there is an update to RPM or GLINT, these should be updated
# first!
#
#
# $Header: /u/stig/bin/RCS/rhupd,v 1.9 1997/07/10 15:46:59 stig Exp stig $
# 
# $Log: rhupd,v $
# Revision 1.9  1997/07/10 15:46:59  stig
#   Duh!  One-line fix!
#
# Revision 1.8  1997/07/06 20:55:30  stig
#   doc fix
#
# Revision 1.7  1997/07/05 08:02:08  stig
#   documentation fix
#
# Revision 1.6  1997/07/05 07:57:41  stig
#   vastly improved handling of version numbers
#
# Revision 1.5  1997/06/12 22:27:54  stig
#   updated list of mirror sites
#
#   diagnostic output is now given with the -v flag instead of all the time
#
# Revision 1.4  1997/06/10 01:36:29  stig
#
#   use Net::FTP instead of requiring ftp.pl because perl 5.004 breaks ftp.pl
# 
# Revision 1.3  1997/04/18 21:35:17  stig
#
#   added quiet-mode for nuisance-free cron invocation
#   
#   cleaned up list of mirrors a bit, still could stand to be cleaned up a little more
#   
#   fetch the ERRATA file and diff it
#   
# Revision 1.2  1997/03/09 21:22:31  stig
#   
#   added support for scanning multiple remote directories
#  
#   improved version comparison logic, but it's still just a string compare,
#   which is hardly reliable
#  
#   downloads of files that are already in the current directory are suppressed
#   to facilitate the resumption of aborted downloads.
#  
#   added -a, -q, -f, and -u flags for less tedious operation
#  
#   improved diagnostic output
#  
#   general code cleanup:
#  
#   - got rid of trivial array indices in favor of just pushing values onto lists
#  
#   - general readability improvements
#  
#   - elimination of redundant code
#
# ---------------------------------------------------------------------------
#
# NOTE: Before I incrementally rewrote the whole thing, this script was
# derived from another such script which I obtained from ftp.redhat.com.
# I've lost track of the original file and don't have the original author
# information, but the most recent RCS log entry is below.  --Stig
#
# Revision 1.10  1995/11/27 11:01:33  ahby
# Changed default path to be for the 2.1 RPMS directory.
#
#############################################################################

use Net::FTP;
require "getopts.pl";


#############################################################################
# Popular RedHat mirrors sites
#############################################################################

%mirrors = (
	#  Primary Red Hat FTP site

	"ftp.redhat.com"	           => "/pub/redhat",

        #  Mirror Listing
        #  Updated: Thu Jun 12 10:43:34 1997
        # 
        #  Africa
        #  ==============================
        
        "ftp.sun.ac.za"                    => "/pub/linux/redhat",
        "ftp.leg.uct.ac.za"                => "/pub/linux/distributions/redhat",
        "linux.iafrica.com"                => "/pub/linux/redhat-4.2",
        "ftp.is.co.za"                     => "/linux/distributions/redhat",
        
        # 
        #  Asia
        #  ==============================
        
        "linux.cis.nctu.edu.tw"            => "/pub/distributions/redhat",
        "ftp.hkstar.com"                   => "/pub/Linux/redhat",
        "sunsite.ust.hk"                   => "/pub/Linux/distributions/redhat",
        "ftp.jaist.ac.jp"                  => "/pub/os/linux/redhat",
        "ftp.lab.kdd.co.jp"                => "/OS/Linux/packages/redhat",
        "ftp.dacom.co.kr"                  => "/pub/Linux/redhat",
        "ftp.ktnet.co.kr"                  => "/pub/redhat",
        "ftp.kreonet.re.kr"                => "/pub/Linux/redhat",
        "nctuccca.edu.tw"                  => "/OS/Linux/distributions/RedHat",
        "ftp.tku.edu.tw"                   => "/Unix/Linux/RedHat",
        "ftp.wownet.net"                   => "/LINUX/redhat",
        
        # 
        #  Australia
        #  ==============================
        
        "sunsite.anu.edu.au"               => "/pub/linux/distributions/redhat",
        "www.unimelb.edu.au"               => "/pub/unix/linux/redhat",
        "ftp.cse.unsw.edu.au"              => "/pub/linux/redhat",
        "dopey.gist.net.au"                => "/pub/linux/redhat",
        
        # 
        #  Europe
        #  ==============================
        
        "ftp.gts.cz"                       => "/pub/linux/redhat",
        "ftp.tu-clausthal.de"              => "/pub/linux/redhat",
        "caristudenti.cs.unibo.it"         => "/pub/Linux/distributions/RedHat",
        "sunsite.mff.cuni.cz"              => "/OS/Linux/Distributions/Redhat",
        "ftp.wcfauna.ee"                   => "/pub/Linux/RedHat",
        "ftp.gwdg.de"                      => "/pub/linux/install/redhat",
        "ftp.mpi-sb.mpg.de"                => "/pub/linux/mirror/ftp.redhat.com",
        "ftp.tu-chemnitz.de"               => "/pub/linux/redhat-mirror/redhat",
        "ftp.uni-bayreuth.de"              => "/pub/linux/ftp.redhat.com/redhat",
        "sunsite.auc.dk"                   => "/pub/os/linux/redhat",
        "ftp.funet.fi"                     => "/pub/Linux/images/RedHat",
        "ftp.ton.tut.fi"                   => "/pub/Linux/RedHat",
        "garbo.uwasa.fi"                   => "/pub/mirror/RedHat",
        "ftp.ibp.fr"                       => "/pub/linux/distributions/redhat",
        "ftp.etud.insa-tlse.fr"            => "/pub/redhat",
        "ftp.sunet.se"                     => "/pub/os/Linux/distributions/redhat",
        "ftp.u-bordeaux.fr"                => "/pub/Linux/redhat",
        "ftp.vma.bme.hu"                   => "/pub/linux/redhat",
        "ftp.osb.hu"                       => "/pub/mirrors/linux/redhat",
        "ftp.jate.u-szeged.hu"             => "/pub/linux/redhat",
        "ftp.iol.ie"                       => "/pub/Unix/Linux/distributions/RedHat",
        "redhat.netvision.net.il"          => "/pub/mirrors/redhat",
        "ftp2.linux.org.il"                => "/pub/linux/redhat",
        "ftp.rhi.hi.is"                    => "/pub/linux/RedHat",
        "linux.stt.it"                     => "/pub/mirrors/redhat",
        "ftp.nluug.nl"                     => "/pub/os/Linux/distr/RedHat/redhat",
        "dutepp0.et.tudelft.nl"            => "/pub/Unix/Linux/Distributions/redhat",
        "ftp.nvg.ntnu.no"                  => "/pub/linux/redhat",
        "sunsite.uio.no"                   => "/pub/unix/linux/redhat",
        "sunsite.icm.edu.pl"               => "/pub/Linux/redhat",
        "ftp.pk.edu.pl"                    => "/pub/linux/redhat",
        "ftp.arch.pwr.proc.pl"             => "/mirror/linux/redhat",
        "ftp.arch.pwr.wroc.pl"             => "/mirror/linux/redhat",
        "ftp.sfos.ro"                      => "/mirror/RedHat",
        "ftp.sorosis.ro"                   => "/pub/mirrors/ftp.redhat.com",
        "ftp.ras.ru"                       => "/pub/Linux/redhat",
        "ftp.sgg.ru"                       => "/mirror/redhat",
        
        # 
        #  South America
        #  ==============================
        
        "ftp.sunsite.dcc.uchile.cl"        => "/pub/OS/linux/redhat",
        "ftp.linux.com.ar"                 => "/pub",
        
        # 
        #  UK
        #  ==============================
        
        "nfs-uxsup.csx.cam.ac.uk"          => "/pub/redhat",
        "sunsite.doc.ic.ac.uk"             => "/packages/linux/redhat",
        "ftp.ox.ac.uk"                     => "/pub/linux/redhat",
        
        # 
        #  North America
        #  ==============================
        
        "bridget.deh.ehnr.state.nc.us"     => "/pub/linux/redhat",
        "ftp.linux.org"                    => "/pub/distributions/RedHat",
        "www.redshift.com"                 => "/pub/linux/redhat/redhat-4.2",
        "redhat.eznet.net"                 => "/pub/redhat",
        "ftp.lame.org"                     => "/mirrors/redhat/redhat",
        "linuxwww.db.erau.edu"             => "/pub/linux/distrib/redhat",
        "ftp.cc.gatech.edu"                => "/pub/linux/distributions/redhat",
        "linux.ucs.indiana.edu"            => "/pub/linux/redhat",
        "tsx-11.mit.edu"                   => "/pub/linux/distributions/redhat",
        "vader.tln.net"                    => "/pub/redhat",
        "ftp.ou.edu"                       => "/linux/redhat",
        "ftp-nog.rutgers.edu"              => "/pub/linux/distributions/redhat",
        "ftp.engr.uark.edu"                => "/pub/linux/redhat",
        "uiarchive.uiuc.edu"               => "/pub/systems/linux/redhat",
        "redhat.aiss.uiuc.edu"             => "/pub/redhat",
        "linux.eecs.umich.edu"             => "/pub/linux/redhat",
        "sunsite.unc.edu"                  => "/pub/Linux/distributions/redhat",
        "schlitz.cae.wisc.edu"             => "/pub/Linux/RedHat",
        "ftp.caldera.com"                  => "/pub/mirrors/redhat",
        "gatekeeper.dec.com"               => "/pub/linux/redhat",
        "ftp.eit.com"                      => "/pub/mirrors/redhat",
        "ftp.infomagic.com"                => "/pub/mirrors/linux/RedHat",
        "ftp.pht.com"                      => "/pub/linux/redhat",
        "ftp.real-time.com"                => "/pub/redhat/redhat",
        "ftp.rge.com"                      => "/pub/systems/linux/redhat",
        "ftp.varesearch.com"               => "/pub/mirrors/redhat",
        "ftp.wgs.com"                      => "/pub/linux/redhat",
        "ftp.epix.net"                     => "/pub/Linux/distributions/redhat",
        "peyote-asesino.nuclecu.unam.mx"   => "/linux/redhat-4.1",
        "ftp.interpath.net"                => "/pub/linux/redhat",
        "ftp.priority.net"                 => "/pub/redhat",
        "ftp.wilmington.net"               => "/linux/redhat",
        "ftp.xtn.net"                      => "/pub/linux/redhat",
        "ftp.kernel.org"                   => "/pub/mirrors/redhat",
	    );

# the default behavior is to visit a redhat mirror site where we know the
# structure of the directory heirarchy.  So, in that case we can visit two
# different directories on the server because we know where they are.  If,
# however, the host and path are overridden then we can only visit the
# directory specified on the command line.  These get overridden below.

$path = $mirrors{$host = "ftp.wgs.com"};
@update_dirs = ("current/i386/RedHat/RPMS/",
		"updates/i386/");

$uname = "anonymous";
#$pword = $ENV{LOGNAME}."@";
$pword = "user";		# bad internet etiquette I suppose...

&Getopts('afnqvul:');

$no_prompt     = ($opt_a = $opt_a); # this ($opt_a = $opt_a) business is to suppress perl warnings
$nuke_locals   = ($opt_f = $opt_f);
$check_new     = ($opt_n = $opt_n);
#$rpm_directly = ($opt_r = $opt_r);
$updates_only  = ($opt_u = $opt_u);
$quiet_mode    = ($opt_q = $opt_q);
$verbose_mode  = ($opt_v = $opt_v);

if ($verbose_mode && $quiet_mode) {
    printf STDERR "Quiet mode and Verbose mode seem to be at cross-purposes, don't you think?\n";
}

if ($ARGV[0] =~ m,((\w+)@)?(.*):(/.*),) {
    ($host, $path) = ($3, $4);
    $uname = $2 if ($2);
    @update_dirs = ('.');
    shift;
} elsif ($ARGV[0] =~ m/\w+\.\w+/) { # if it looks like a hostname...
    $path = $mirrors{$host = $ARGV[0]};
    $path || die "Error: $0 not in list of known redhat mirror hosts";
    shift;
} 


print STDERR "Warning: excess arguments ignored: @ARGV\n" if (@ARGV);

if ($uname ne "anonymous") {
    system "stty -echo";
    print "Password for $uname\@$host: ";
    chop($pword = <STDIN>);
    print "\n";
    system "stty echo";
}

#############################################################################
# Directories in @update_dirs should be listed in the order from oldest to
# newest so that RPMs in the later directories will override the RPMs in the
# first directories and not vice-versa

@updates = ();
%upd_type = ();

my $errata = '00README.errata';

# always get the ERRATA file
if (@update_dirs == 2) {	# if we didn't specify an alternate host:/path to sync from...
    ( -f $errata ) and do { $diff_errata=1 ; rename($errata, "$errata.old"); };
    push(@updates, $errata);
    $file_dir{$errata} = $path.'/'.$update_dirs[1];
    $upd_type{$errata} = 'ERRATA';
}

# subroutine to get y/n answer

sub getyn {
    my ($prompt) = @_;
    my ($answer) = "";
    my ($a) = "";

    return 1 if ($no_prompt);

    do {
	print "$prompt (yes/no/all)? ";
	$_ = lc (<STDIN>);
	chop $_;
    } while (m/^([yna]|yes|no|all)$/);
    
    return ($no_prompt = 1) if (m/^a(ll)?/);
    return (m/^y(es)?/);
}


# get the local list of installed packages

print "Getting list of installed packages\n" unless ($quiet_mode);
@local_rpm_list = `rpm -qa`;
chop(@local_rpm_list);

%local_rpm = %remote_rpm = ();

for (@local_rpm_list) {
#    good place to test the regular expressions...
#    ($pkg, $ver, $patch) = m/^(.*)-([^-]*)-([^-]+)/;
#    print "$_\t->$pkg, $ver, $patch\n";

    my ($pkg, $pver) = m/([^ ]*)-([^-]+-[^-]+)/;
    $local_rpm{$pkg} = $pver;
}


# now connect to the remote host

print ("Getting package lists from $host:\n") unless ($quiet_mode);

$ftp = Net::FTP->new($host);
print "    Connection open\n" unless ($quiet_mode);

$ftp->login($uname,$pword) || die("login failed");
print "    Logged in as $uname\n" unless ($quiet_mode);


for $up_dir (@update_dirs) {

    my $dir = "$path/$up_dir";

    print "    CD $dir\n" unless ($quiet_mode);
    $ftp->cwd($dir);
    print "    Fetching directory list\n" unless ($quiet_mode);

    my @templist = grep(/\.rpm/, @{$ftp->dir()});

    #
    # If two versions of the same RPM appear in two different directories,
    # then the later ones will take precedence over the former.
    #

    for (@templist) {
	($rpm, $pkg, $pver) = m/(([^ ]*)-([^- ]+-[^-]+\.\w+\.rpm))/;
	$file_dir{$rpm} = $dir;
	if ($remote_rpm{$pkg} && $verbose_mode) {
	    printf "      superceding %-20s VER %-12s -> %-12s\n",
		   $pkg,
		   ($remote_rpm{$pkg} =~ m/(.*)\.\w+\.rpm/),
		   ($pver =~ m/(.*)\.\w+\.rpm/);
	}
	$remote_rpm{$pkg} = $pver;
    }
}

# if ($verbose_mode) {
#     print "\n\n";
#     foreach $_ (sort keys(%remote_rpm)) {
#         print "     $_-$remote_rpm{$_}\n";
#     }
#     print "\n\n";
# }

$ftp->binary();
$ftp->debug(! $quiet_mode);

# updated RPMs are stored in @updates
# while the type (NEW, UPD, DIF) of each is stored in %upd_type

print "\n" unless ($quiet_mode);

#
# if we are looking for NEW packages...
#

if ($check_new) {		
    for (sort keys %remote_rpm) {
	my $fname = ($_ . '-' . $remote_rpm{$_});
	if (! $local_rpm{$_}) { # if this package is not already installed...
	    push(@updates, $fname);
	    $upd_type{$fname} = 'NEW';
	}
    }
}

#
# check for UPDated and DIFferent packages...
#
# FIXME - some packages such as PGP and SSH are being built in US and
# international versions where the package builders are mucking about with
# the VERSION NUMBER portion of the rpm file name instead of the PACKAGE
# NAME portion of the rpm file name.  This is bad.  There's no way to decode
# this nonsense and it will break mechanical version comparisoni attempts.


for (@local_rpm_list) {
    my ($pkg,  $ver, $patch) = m/^(.*)-([^-]+)-([^-]+)$/;
    if (! $pkg) { print "Couldn't parse $_\n"; }
    if (defined $remote_rpm{$pkg}) { # if this package has an update
	my ($rver, $rpatch) = ($remote_rpm{$pkg} =~ m/([^-]+)-([^-]+)\.\w+.rpm/);
	my $rpm = ($pkg . '-' . $remote_rpm{$pkg});
	my $vcmp = cmp_versions($ver, $rver);

	if ($vcmp = 0) { # if versions equal
	    if (cmp_versions($patch, $rpatch) < 0) { # if the local patchlevel is lower
		push(@updates, $rpm);
		$upd_type{$rpm} = 'PATCH';
	    };
	} elsif ( $vcmp < 0 ) { # if local version is lower
	    push(@updates, $rpm);
	    $upd_type{$rpm} = 'UPDATE';
	}
    } else {
	print "Package '$pkg' missing from remote repository\n" if ($verbose_mode);
    }
}

#
# print list of new files and query for download...
#

if (@updates) {
    
    print "\nInteresting RPM files:\n\n" unless ($quiet_mode && $no_prompt);
    for (@updates) {
	my $loaded = ((-f $_ && ! $nuke_locals) ? "(already downloaded)" : "");
	printf("  %-8s %-32s %s\n", $upd_type{$_}, $_, $loaded) 
          unless ($quiet_mode && $no_prompt && ($loaded || ($upd_type{$_} eq 'ERRATA')));
    }

    # This whole yes/no business is lame unless you're on a T1.
    # An improvement would be to use regular expressions or globbing
    # to include and exclude packages based upon their names...
    # something like:  "* - ^X ^x" 
    # would mean:      "all files, except those beginning with X or x"

    for $rpm_file (@updates) {
	next if (-f $rpm_file && ! $nuke_locals);
	next unless($no_prompt or getyn("Fetch $rpm_file"));

	my $rname = $file_dir{$rpm_file}.'/'.$rpm_file;
	$ftp->get($rname, $rpm_file);
    }
} else {
    print ("No new updates are available on $host\n") unless ($quiet_mode);
}

$ftp->debug(0);
$ftp->close();

# quiet_mode doesn't suppress the final diff because quiet-mode is just supposed to 
# suppress normally irrelevant output.  A change in the errata file is always relevant.

if ($diff_errata) {
   system ("diff -c $errata.old $errata");
}


#############################################################################
#
# Version comparison utilities
#

sub hack_version($) {
    my ($pver) = @_;
    $pver =~ s/(\d+)/sprintf("%06d", $1)/eg; # pad numbers with leading zeros to make alphabetical sort do the right thing
    $pver =  (sprintf "%-80s", $pver);	     # pad with spaces so that "3.2.1" is greater than "3.2"
    return $pver;
}

sub cmp_versions($$) {
    my ($a, $b) = @_;

    return 0 if ($a eq $b);	# shortcut if they're obviously the same.

    $a = hack_version($a);
    $b = hack_version($b);
    
    return ($a cmp $b);
}

# @tests = ('3.2', '3.2',
#           '3.2a', '3.2a',
#           '3.2', '3.2a',
#           '3.2', '3.3',
#           '3.2', '3.2.1');
# 
# while (@tests) {
#     $a = shift(@tests);
#     $b = shift(@tests);
#     printf "%-10s < %-10s = %d\n", $a, $b, cmp_versions($a, $b);
# }
#
# And the correct output is...
#
#     3.2        < 3.2        = 0
#     3.2a       < 3.2a       = 0
#     3.2        < 3.2a       = -1
#     3.2        < 3.3        = -1
#     3.2        < 3.2.1      = -1

