#!/usr/bin/perl -w
use strict;

# $Id: aixtoolbox-updates,v 1.5 2002-03-26 17:05:28-05 roderick Exp roderick $
#
# Roderick Schertler <roderick@argon.org>

# Copyright (C) 2001 Roderick Schertler
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or (at
# your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# For a copy of the GNU General Public License write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

use Proc::WaitStat	qw(close_die);
use Net::FTP		  ();
use RS::Handy		qw($Me cmp_strnum data_dump getopt xdie);

my $Ftp_host	= 'ftp.software.ibm.com';
my $Ftp_dir	= '/aix/freeSoftware/aixtoolbox/RPMS';
my $Arch	= 'ppc';

my $Debug	= 0;
my $Exit	= 0;
my $Ftp		= undef;
my $No		= 0;
# XXX You can run the 4.3 packages on 5.1.
my $Os		= 'aix' . join '.', map { chomp; $_ } `uname -v`, `uname -r`;
my $Package_re	= qr/[\w\-+.]+/;
my $Verbose	= 0;
my $Version	= q$Revision: 1.5 $ =~ /(\d\S+)/ ? $1 : '?';

my @Option_spec = (
    'arch=s'		=> \$Arch,
    'debug!'		=> \$Debug,
    'dir=s'		=> \$Ftp_dir,
    'help'		=> sub { usage() },
    'host=s'		=> \$Ftp_host,
    'no|n!'		=> \$No,
    'os=s'		=> \$Os,
    'verbose|v!'	=> \$Verbose,
    'version'		=> sub { print "$Me version $Version\n"; exit },
);

my $Usage = <<EOF;
usage: $Me [switch]...
switches:
      --arch a		specify architecture (default $Arch, alt ia64)
      --debug		turn debugging on
      --dir d		specify RPMS dir ($Ftp_dir)
      --help		show this and then die
      --host h		specify FTP host ($Ftp_host)
  -n, --no		don't download anything
      --os o		specify OS version (default $Os on this host)
  -v, --verbose		be more verbose
      --version		show the version ($Version) and exit
Use \`perldoc $Me\' to see the full documentation.
EOF

sub xwarn {
    RS::Handy::xwarn @_;
    $Exit ||= 1;
}

sub Net::Cmd::xwarndie_mess {
    my ($self, @mess) = @_;

    my $s = $self->code . " " . $self->message;
    chomp $s;

    push @mess, ": $s\n";
    return @mess;
}

sub Net::Cmd::xwarn {
    my ($self, @msg) = @_;
    xwarn $self->xwarndie_mess(@msg);
}

sub Net::Cmd::xdie {
    my ($self, @msg) = @_;
    xdie $self->xwarndie_mess(@msg);
}

sub debug {
    print STDERR "debug: ", @_, "\n" if $Debug;
}

sub usage {
    xwarn @_ if @_;
    # Use exit() rather than die(), as Getopt::Long does eval().
    print STDERR $Usage;
    exit 1;
}

sub init {
    getopt -bundle, @Option_spec or usage if @ARGV;
    $Ftp_dir .= "/$Arch";
}

sub get_rpm_avail {
    my %avail;

    $Ftp = Net::FTP->new($Ftp_host, Debug => $Debug)
	or xdie "can't connect to $Ftp_host: $@\n";
    $Ftp->login			or $Ftp->xdie("can't login");
    $Ftp->cwd($Ftp_dir)		or $Ftp->xdie("can't cd to $Ftp_dir");

    # IBM's server doesn't work with ->ls, so wing it with ->dir.  The
    # dir I'm in has one subdir for each source package.  Each subdir
    # can have multiple binary package names (one source can generate
    # multiple binary packages), with multiple versions for multiple
    # OS/arch combinations.
    #
    # Output looks like:
    #
    #     dir1:
    #	  total <size>
    #	  dir1 file line 1
    #	  dir1 file line 2
    #
    #     dir2:
    #	  total <size>
    #	  dir2 file line 1
    # [...]

    my $dir = undef;
    for ($Ftp->dir("*")) {
    	chomp;
    	if (/^($Package_re):$/) {
	    $dir = $1;
	    next;
	}
	elsif (/^$/) {
	    $dir = undef;
	    next;
	}
	elsif (!defined $dir) {
	    xdie "dir output without package `$_'";
	}
	elsif (/^total \d+$/) {
	    next;
	}

	my $file = (split)[-1];
	my $path = "$dir/$file";
	if ($file !~ /^($Package_re)-($Package_re-\d+[a-z]*)
			\.(aix\d+\.\d+)\.(\w+)\.rpm$/x) {
	    xwarn "bad file name $file\n";
	    next;
	}
	my ($p, $v, $os, $arch) = ($1, $2, $3, $4);

	printf "%-15s %-20s %-20s %-5s %-5s\n", $dir, $p, $v, $os, $arch
	    if 0;
	next if $os ne $Os;
	next if $arch ne 'noarch' && $arch ne $Arch;
	if ($avail{$p}) {
	    next if cmp_strnum($v, $avail{$p}[0]) <= 0;
	    debug "replace $p $avail{$p}[0] => $v";
	}
	$avail{$p} = [$v, $path];
    }

    return %avail;
}

sub main {
    init;

    # Figure out what packages are installed.  %installed maps from
    # package name to version.

    my %installed;
    open RPM, 'rpm -qa --queryformat "%{NAME} %{VERSION}-%{RELEASE}\n" |'
    	or die $!;
    while (<RPM>) {
    	chomp;
	/^($Package_re)\s+(\S+)$/	or xdie "invalid rpm output `$_'\n";
	my ($package, $version) = ($1, $2);
	if (exists $installed{$package}) {
	    xdie "duplicate package $package\n";
	}
	next if $package eq 'AIX-rpm';	# special internal package
	$installed{$package} = $version;
    }
    close_die *RPM, 'rpm';
    %installed or die "no packages installed\n";
    if (0) {
	for my $p (sort keys %installed) {
	    printf "%-20s %s\n", $p, $installed{$p};
	}
    }

    # Figure out what packages are available.  %avail maps from package
    # name to [version, path] tuple.

    my %avail = get_rpm_avail;

    # Decide which packages were updated.  Let the user know.

    my @get;
    my $vfmt = "%-20s %-20s %-20s %s\n";
    my $header;
    $header = sub {
	my @label = qw(package installed available comparison);
	printf $vfmt, @label;
	printf $vfmt, map { '-' x length } @label;
	$header = undef;
    };
    for my $p (sort keys %avail) {
    	my ($v, $path) = @{ $avail{$p} };
	next unless $installed{$p};
	my $installed = delete $installed{$p};
	next unless $installed;
	my $cmp = cmp_strnum $installed, $v;
	my $cmp_s = (qw(updated current MISSING))[$cmp + 1];
	if ($Verbose || $cmp != 0) {
	    $header->() if $header;
	    printf $vfmt, $p, $installed, $v, $cmp_s;
	}
	push @get, $path if $cmp < 0;
    }
    for my $p (sort keys %installed) {
    	$header->() if $header;
	printf $vfmt, $p, $installed{$p}, '-', 'gone';
    }

    # Download updated packages.

    $Ftp->binary		or $Ftp->xdie("error setting binary mode");
    for my $path (@get) {
	(my $local = $path) =~ s-.*/--;
	if (-e $local) {
	    if (!-f _) {
	    	xwarn "$local exists locally but isn't a plain file, skipping it\n";
		next;
	    }
	    my $size = $Ftp->size($path);
	    if (!$size) {
		xwarn "can't get size of remote file $path, skipping it\n";
		next;
	    }
	    if ($size == -s _) {
		print "already have $local\n";
		next;
	    }
	}
	print $No ? 'would ' : '', "get $path\n";
	$Ftp->get($path)	or $Ftp->xwarn("error getting $path")
	    unless $No;
    }

    return 0;
}

$Exit = main || $Exit;
$Exit = 1 if $Exit && !($Exit % 256);
exit $Exit;

__END__

=head1 NAME

aixtoolbox-updates - check for and download updates to Aix Toolbox binary RPMs

=head1 SYNOPSIS

B<aixtoolbox-updates>
[B<--arch> I<architecture>]
[B<--debug>]
[B<--dir> I<dir>]
[B<--help>]
[B<--host> I<hostname>]
[B<-n> | B<--no>]
[B<--os> I<os-version>]
[B<-v> | B<--verbose>]
[B<--version>]

=head1 DESCRIPTION

B<aixtoolbox-updates> checks the Aix Toolbox FTP site for updates to
the RPMs which are installed on the local machine, and downloads those
which have been updated.  It's neither polished nor bulletproof, but
I'm releasing it as-is as I'm unlikely to improve either thing any time
soon.

=head1 OPTIONS

=over 4

=item B<--arch> I<architecture>

Override the architecture string.  By default it's B<ppc>.  The other
current possibility is B<ia64>.  Let me know if you know the right way
for me to detect the correct setting for the host on which I'm running.

=item B<--debug>

Turn debugging on.

=item B<--dir> I<dir>

Specify the path to the RPMS directory on the FTP host.  See the --help
for the default.

=item B<--help>

Show the usage message and die.

=item B<--host> I<hostname>

Specify the FTP host name.  See the --help for the default.

=item B<-n>, B<--no>

Don't actually try to download any files.  This also turns on B<--verbose>.

=item B<--os> I<os-version>

Override the OS version.  The default is the version on this machine.

=item B<-v>, B<--verbose>

Be more verbose.  This causes packages to be output even if they're the
current version.

=item B<--version>

Show the version number and exit.

=back

=head1 EXAMPLES

Here's an excerpt of a sample run:

    $ aixtoolbox-updates -v
    package              installed            available            comparison
    -------              ---------            ---------            ----------
    bzip2                1.0.1-6              1.0.1-6              ok
    cvs                  1.11.1p1-1           1.11.1p1-2           updated
    db                   2.7.7-3              2.7.7-4              updated
    diffutils            2.7-20               2.7-20               ok
    [...]
    ytalk                3.1.1-1              3.1.1-1              ok
    zip                  2.3-1                2.3-2                updated
    zlib                 1.1.3-10             1.1.3-10             ok
    zlib-devel           1.1.3-10             1.1.3-10             ok
    openssh              2.9.9p2-5            -                    gone
    openssh-clients      2.9.9p2-5            -                    gone
    [...]
    get cvs-1.11.1p1-2.aix4.3.ppc.rpm
    get db-2.7.7-4.aix4.3.ppc.rpm
    [...]
    get zip-2.3-2.aix4.3.ppc.rpm
    $ _

=head1 BUGS

The architecture is hardcoded as B<ppc>.  Use C<--arch ia64> if you're
on that architecture, and let me know if you know the right way for me
to detect the correct setting for the host on which I'm running.

The code which splits the package name from the version given an RPM
file name is ad-hoc and likely too fragile.

=head1 AVAILABILITY

The code is licensed under the GNU GPL.  Check
http://www.argon.org/~roderick/ for updated versions.

=head1 AUTHOR

Roderick Schertler <roderick@argon.org>

=cut