#!/usr/bin/perl -w

# Nastiness to automatically update a redhat box from assorted update sites.
# Then I discovered rpmfind (http://www.rpmfind.net/)
# Waider 1999
#
# 2002 rehack
# * discovered that the RPM package has a neat version comparison tool
# * discovered that it doesn't appear to work any better than what I'd
#   written myself. Ptui.
#
# 09/05/2003 Merging all the versions
# 30/05/2003 Use home-made ftp->get mechanism
# 08/06/2003 RPM.pm is defunct. RPM2 appears to be The Good Shit.

use Net::FTP;
use strict;
my $RPMAPI = "RPM";
eval {
  require RPM;
  import RPM "vercmp";
};
if ( $@ ) {
  eval {
	require RPM2;
	my $RPMAPI = "RPM2";
  };

  if ( $@ ) {
	die "Can't find a usable RPM module\n";
  }
}

$| = 1;

my $ftp;
my $verbose = ( $#ARGV > -1 && $ARGV[0] eq "-v" );
my ( $HOST, $DIR );
my ( $USER, $PASS ) = ( 'anonymous', 'waider@waider.ie' );

sub maybe_fetch_file( $ ) {
  my $file = shift;
  my ( $locsz, $loctm, $remsz, $remtm );

  # check for local copy of the file
  if ( -r $file ) {
    # stat local copy, get mtime & size
    (undef, undef, undef, undef, undef, undef, undef, $locsz,
     undef, $loctm, undef, undef, undef ) = stat( $file );
  } else {
    $locsz = 0;
    $loctm = 0;
  }

  # check if ftp connection is live, reopen if necessary
  if ( !defined( $ftp ) || !ref( $ftp ) || !$ftp->pwd ) {
    $ftp = Net::FTP->new( $HOST, Debug=>$verbose, Hash => \*STDERR );
    $ftp->login( $USER, $PASS );
    $ftp->cwd( $DIR );
    $ftp->pasv();
    $ftp->binary();
  }

  # FIXME check that file exists on server!

  # check mtime & size of remote copy
  $remsz = $ftp->size( $file ) or die $!;

  # if mtime of local is more recent & sizes match, return
  if ( $remsz == $locsz ) {
    #	$remtm = $ftp->mdtm( $file );
    #	if ( $remtm <= $loctm ) {
    #	  return 1;
    #	}
  }

  # fetch file
  # try to recover from partial fetch
  if ( $locsz ) {
    print " recovering...";
    ftp_get( $file, $remsz ) or die $!;
  } else {
    print " fetching...";
    ftp_get( $file, $remsz ) or die $!;
  }

  1;
}

# Get rpm list
print "Fetching list of installed RPMS\n" if $verbose;
open( RPMLIST, "rpm -qa --queryformat '%{NAME} %{VERSION}-%{RELEASE}\n'|") or die $!;
my @installed = <RPMLIST>;
close( RPMLIST );

my %installed;

# Sort it into package, version
print "Sorting list of installed RPMS\n" if $verbose;
for my $rpm ( @installed ) {
  my ( $pkg, $version ) = split( /\s/, $rpm );
  $installed{$pkg} = $version;
}

opendir( HERE, "." );
my @downloads = readdir( HERE );
closedir( HERE );

# figure out what directory we need
print "Checking system version..." if $verbose;
open( FOO, "</etc/redhat-release");
my $os = <FOO>;
close( FOO );
chomp( $os );
$os =~ s/^.* (\d+\.\d+) .*$/$1/;
print "$os\n" if $verbose;

#$HOST = "ftp.rackspace.com";
$HOST = "ftp.esat.net";
$ftp = Net::FTP->new( $HOST, Debug => $verbose ) || die "Could not connect to $HOST: $!";
$ftp->login( $USER, $PASS ) || die "ftp error: $!";

for my $dir (
			 "/mirrors/ftp.redhat.com/redhat/linux/$os/en/os/i386/RedHat/RPMS",
			 "/mirrors/updates.redhat.com/$os/en/os/i386",
			 "/mirrors/updates.redhat.com/$os/en/os/i686",
			 "/mirrors/updates.redhat.com/$os/en/os/noarch"
			) {
  print "Checking $dir\n" if $verbose;
  $ftp->cwd( "$dir" );
  $DIR = "$dir";
  my @available = $ftp->ls;

  for my $rpm ( @available ) {
    next unless $rpm =~ /\.rpm$/i;

    my ( $pkg, $version, undef ) =
      $rpm =~ m/^(.*)-([a-z0-9._+]+\-.*)\.(i[3-6]86|noarch|athlon)?(-glibc\d+)?\.rpm$/i;
    if ( !defined( $pkg ) || !defined( $version )) {
      warn "Tweak regexp to also match $rpm.\n";
    }
    print "$pkg version $version: " if $verbose;
#    $installed{$pkg} = "0-0" unless $installed{$pkg};
    if ( defined( $installed{$pkg})) {
	  if ( $verbose ) {
		print " (installed is $installed{$pkg})";
	  }
      # Need to split version and revision
      my ( $v1, $r1 ) = split( /-/, $version, 2 );
      my ( $v2, $r2 ) = split( /-/, $installed{$pkg}, 2 );
      my $upg = 0;
      if ( vercmp( $v1, $r1, $v2, $r2 ) > 0 ) {
		$upg = 1;
      }
      if ( $upg ) {
		print "$pkg $version (installed is $installed{$pkg}" unless $verbose;
		print " (upgradable)";
		print "\n" unless $verbose;
		# fetch files that we can upgrade to
		maybe_fetch_file( $rpm ) unless -f $rpm;
      }
    }
    print "\n" if $verbose;
  }
}
$ftp->close() if defined( $ftp );

sub ftp_get {
  my ( $file, $expected ) = @_;
  my ( $nr, $nw, $buf, $tot );

  $ftp->binary();

  my $dataconn = $ftp->retr( $file ) or die $!;
  open( FILE, ">$file" ) or die;
  while ( $nr = $dataconn->read( $buf, 1024 )) {
	my $nw = syswrite( FILE, $buf, $nr );
	$tot += $nw;
	if ( $nr != $nw ) {
	  die "Write failed: $!\n";
	}
	print "$tot / $expected\r";
  }
  close( FILE );
  if ( $tot != $expected ) {
    die "failed: expected $expected, got $tot\n";
  } else {
    print "\n";
  }
}

__DATA__
/pub/linux/redhat/7.1                          /pub/rackspace/solaris/archives
/pub/linux/redhat/updates/6.2                  /pub/rackspace/raq/rpms
/pub/linux/redhat/updates/7.0                  /pub/rackspace/raq/archives
/pub/linux/redhat/updates/7.1                  /pub/rackspace/raq/scripts
                                               /pub/rackspace/linux/rpms/7.1
/pub/raq/ftp.cobalt.com/pub/artwork            /pub/rackspace/linux/archives
/pub/raq/ftp.cobalt.com/pub/packages           /pub/rackspace/linux/scripts