#!/usr/bin/perl
#
# ftp-upgrade - fetch redhat package manager updates from the network
#
# usage: ftp-upgrade [-n] [-u uname]
#
#	-u - specify a username to use - will be prompted for a password
#   -n - identify packages that are "new" (e.g. not yet installed)
#
# ftp-upgrade 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: /storage/cvsroot/user/www/homepage/linux/ftp-upgrade,v 1.1 2003/06/02 13:01:37 pere Exp $
#
# $Log: ftp-upgrade,v $
# Revision 1.1  2003/06/02 13:01:37  pere
# Add all my patches to CVS.
#
# Revision 1.10-pr 1998/05/28 10:00:00 pere
# Lost of changes.  Added handling of many directories, etc.
#
# Revision 1.10  1995/11/27 11:01:33  ahby
# Changed default path to be for the 2.1 RPMS directory.
#
# Revision 1.9  1995/11/22 09:38:21  ahby
# Removed some debugging code.
#
# Revision 1.8  1995/11/20 19:27:58  ahby
# Added ability to get packages that are not yet installed.
#
# Revision 1.7  1995/11/14 21:53:41  ahby
# Fixed an erroneously anchored string.
# Improved package recognition.
# Fixed a stupid array reference (I really am a better programmer
# than this!).
#
# Revision 1.6  1995/11/14 19:09:35  ahby
# Added list of mirror sites and username option.
# Changed handling on connection error.
#
# Revision 1.5  1995/11/14 15:59:07  ahby
# Changed it so if there are no changes it just terminates.
#
# Revision 1.4  1995/11/14 15:51:16  ahby
# Cleaned up some comments.
#
# Revision 1.3  1995/11/09 23:15:46  ahby
# CHanged revision tracking strategy to be smarter and use associative
# array instead of a flat array and a search.
#
# Revision 1.2  1995/11/09 17:27:01  ahby
# Fixed RCS headers.
#
#
sub get_redhat_version {
    my($tmp) = `rpm -q redhat-release`;
    my($ver) = $tmp =~ m/^.+-([\d\.]+)-\d+/;
    if ($ver) {
	return $ver;
    } else {
	print "Unable to determine RedHat version.  Exiting.\n";
	exit(1);
    }
}

sub get_redhat_architecture {
    my($tmp) = `uname -m`;
    chomp($tmp);
	    my($arch);
    if ($tmp =~ m/i?86/) {
	$arch = 'i386';
    } else {
	$arch = $tmp;
    }
    return $arch;
}

$version = get_redhat_version();
$arch = get_redhat_architecture();
@rpm_dirs = ("redhat-$version/$arch/RedHat/RPMS",
	     "updates/$version/$arch",
	     "powertools-$version/$arch");

# Popular RedHat mirrors sites
#$host = "ftp.nvg.unit.no";
#$path = "/pub/linux/redhat";
$host = "sunsite.uio.no";
$path = "/pub/unix/linux/redhat";
#$host = "ftp.caldera.com";
#$path = "/pub/mirrors/redhat";
#$host = "ftp.cc.gatech.edu";
#$path = "/pub/linux/distributions/redhat";
#$host = "ftp.pht.com";
#$path = "/pub/linux/redhat";
#$host = "ftp.cms.uncwil.edu";
#$path = "/linux/redhat";
#$host = "ftp.wilmington.net";      
#$path = "/linux/redhat";
#$host = "ftp.caldera.com";         
#$path = "/pub/mirrors/redhat";
#$host = "ftp.lasermoon.co.uk";     
#$path = "/pub/distributions/RedHat";
#$host = "sunsite.unc.edu";         
#$path = "/pub/Linux/distributions/redhat";
#$host = "sunsite.doc.ic.ac.uk";    
#$path = "/packages/linux/sunsite.unc-mirror/distributions/redhat";
#$host = "ftp.cc.gatech.edu";       
#$path = "/pub/linux/distributions/redhat";
#$host = "uiarchive.cso.uiuc.edu";  
#$path = "/pub/systems/linux/distributions/redhat";
#$host = "ftp.ibp.fr";              
#$path = "/pub/linux/distributions/redhat";
#$host = "ftp.gwdg.de";             
#$path = "/pub/linux/install/redhat";
#$host = "ftp.uoknor.edu";          
#$path = "/linux/redhat";
#$host = "ftp.msu.ru";              
#$path = "/pub/Linux/RedHat";
#$host = "linux.ucs.indiana.edu";   
#$path = "/pub/linux/redhat";
#$host = "ftp.cvut.cz";             
#$path = "/pub/linux/redhat";
#$host = "ftp.ton.tut.fi";          
#$path = "/pub/Linux/RedHat";
#$host = "ftp.funet.fi";		
#$path = "/pub/Linux/images/RedHat";

BEGIN {
    # Find Net::FTP if it is in an nonstandard place
    push(@INC, "/store/lib/perl5", "/store/lib/perl5/site_perl" );

    # Workaround for a bug in early RedHat 5 perl distributions.
    eval 'require "ftp.pl"; import ftp;';
    return unless ( $@ );

    # Make backup include files
    mkdir "/tmp/perl-fix", 0777;
    mkdir "/tmp/perl-fix/gnu", 0777;
    my($tmp) = `echo '1;' > /tmp/perl-fix/gnu/stubs.ph`;
    $tmp = `echo '1;' > /tmp/perl-fix/stddef.ph`;
    push(@INC, "/tmp/perl-fix");
}

# compare versions - needs more work
# 1.9.1 is newer then 1.9 and 3.19 is newer then 3.2
# Return true if v2 is newer then v1
sub version_newer {
  my ($v1, $v2) = @_;
  my($r1, $r2);
  ($v1,$r1) = $v1 =~ m/^(.+)-(\d+).+rpm/;
  ($v2,$r2) = $v2 =~ m/^(.+)-(\d+).+rpm/;
  if ($v1 eq $v2) {
    return ($r1 < $r2);
  }
  my @v1 = split(/\./, $v1);
  my @v2 = split(/\./, $v2);
  if ($v1[0] < $v2[0] ||
      ($v1[0] == $v2[0] && $v1[1] < $v2[1]) ||
      ($v1[0] == $v2[0] && $v1[1] == $v2[1] && $v1[2] lt $v2[2])) {
#       print "Comparing $v1 and $v2 - true\n";
    return 1;
  }
#    print "Comparing $v1 and $v2 - false\n";
  return 0;
}

use Getopt::Std;

# XXX use Net::FTP;
require "ftp.pl";
import ftp;


$uname = "anonymous";
$pword = "upgrade-user@";

&getopts('nu:');

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

# subroutine to get y/n answer

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

	do {
		print "$prompt (y/n)? ";
		$answer = <STDIN>;
		$a = substr($answer, 0, 1);
	} while (($a ne "Y") && ($a ne "y") && ($a ne "N") && ($a ne "n"));
	return (($a eq "Y") || ($a eq "y"));
}


# get the local list of installed packages

print "Getting list of installed packages\n";
@llist = `rpm -qa`;
chop(@llist);
sort(@llist);

# now connect to the remote host

print ("Getting the list of updated packages from $host.\n");

# make the connection and fetch the directory

print "Opening connection to $host\n";

# XXX $ftp = Net::FTP->new($host, Timeout => '30');
ftp::set_timeout(30);
$ftp = ftp::open($host,21,0,10);

if ( ! $ftp ) {
	die("open of $host failed");
}
print "Logging in to $host as $uname\n";

# XXX $ftp->login($uname,$pword) || die("login failed");
ftp::login($uname,$pword) || die("login failed");

for $dir (@rpm_dirs) {
    fetch_subdir_list($dir);
}

##
# Exports: @templist, %rlist
sub fetch_subdir_list {
    my($dir) = @_;
    my($curpath) = $path . "/" . $dir;

    print "Changing to directory $curpath on $host\n";

    # XXX $ftp->cwd($curpath);
    if ( ! ftp::cwd($curpath) ) {
	return;
    }

    print "Fetching directory list\n";

    # XXX my(@longlist) = $ftp->ls();
    ftp::dir_open("");
    @longlist = <ftp::NS>;
    ftp::dir_close();

    push(@templist, grep(/\.rpm/, @longlist));
    undef @longlist;

    chomp(@templist);
    sort (@templist);

    my(@temp);
    for (@templist) {
	@temp = m/([^ ]*)-([^- ]*-[0-9]*[^ ]*rpm).*/;
	($file) = m/(\S+rpm)/;
	# Only add newer package
	if ( (! $rlist{$temp[0]} ) ||
	    ($rlist{$temp[0]} && version_newer($rlist{$temp[0]},$temp[1])) ) {
	    $rlist{$temp[0]} = $temp[1];
	    $directory{$file} = $curpath;
	}
    }
}

# XXX $ftp->type("I");
ftp::type("I");

# XXX $ftp->debug(1);
#ftp::debug(1);

if ($opt_n) {		# if we are looking for new packages

	for (@llist) {
		@temp = m/([^ ]*)-([^-]*-[0-9]*)/;
		$ilist{$temp[0]} = $temp[1];
	}

	$uindex = 0; #initialize index for uninstalled package array

	for (@templist) {
		$fname = $_;
		$fname =~ s/.*\s([^ ]*rpm).*/$1/;
		@pname = ($fname =~ m/^(.*)-([^-]*)-([0-9]*)/);
		if (! $ilist{$pname[0]}) {		# if this not package already installed
			@ulist[$uindex] = $fname;
			$uindex++;
		}
	}
	@ulist = sort(@ulist);
	if (@ulist) {
		print "Uninstalled packages:\n";
		for (@ulist) {
			print "    $_\n";
		}
		$all = getyn("Fetch all?");

		for (@ulist) {
			if (! $all) {
				if (!getyn("Fetch $_")) { next };
			}
			getfile($ftp, $_);
		}
	} else {
		print ("No new packages are available on $host\n");
	}

} else {		# check for updated packages

	$nindex = 0; #initialize index for new version array
	$cindex = 0; #initialize index for changed patch array

	for (@llist) {
		@lname = m/^(.*)-([^-]*)-([0-9]*$)/;
		if ($rlist{$lname[0]}) {					# if this package has an update
			@temp = ($rlist{$lname[0]} =~ m/([^-]*)-([0-9]*).*rpm/);
			if ($lname[1] eq $temp[0]) {		# if versions equal
				if ($lname[2] < $temp[1]) {    	# if patch level has increased
					@clist[$cindex] = $lname[0] . '-' . $rlist{$lname[0]};
					$cindex++;
				};
			} else {							# if different version
			    if (version_newer($lname[1], $temp[0])) {
				@nlist[$nindex] = $lname[0] . '-' . $rlist{$lname[0]};
				$nindex++;
			    }
			}
		}
	}
	if (@clist || @nlist) {
	        @clist = sort(@clist);
		@nlist = sort(@nlist);
		print "New patches:\n\n";
		for (@clist) {
			print "  $_\n"
		}
		print "\nDifferent versions:\n\n";
		for (@nlist) {
			print "  $_\n"
		}

		$all = getyn("Fetch all?");

		for (@clist) {
			if (! $all) {
				if (!getyn("Fetch $_")) { next };
			}
			getfile($ftp, $_);
		}
		for (@nlist) {
			if (! $all) {
				if (!getyn("Fetch $_")) { next };
			}
			getfile($ftp, $_);
		}
		print "\nTo upgrade, run 'rpm -Uvh *.rpm' as root.\n"
	} else {
		print ("No new updates are available on $host\n");
	}
}


#$ftp->debug(0);
# XXX $ftp->quit();
ftp::close();

sub getfile {
    my($ftphandle, $filename) = @_;
    my($dir) = $directory{$filename};
    print "Fetching $dir/$filename\n";
    # XXX $ftphandle->cwd($dir);
    ftp::cwd($dir);

    # XXX $ftphandle->get($filename);
    ftp::get($filename);
}