#!/usr/bin/perl -w
# 
# rhupdate.pl, Update RedHat RPMs.
# 
# Copyright (C) 2001 Jonathan J. Miner
# 
# 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.
# 
# $Id: rhupdate.pl,v 1.52 2001/04/04 16:13:08 miner Exp $
# Jonathan J. Miner <jon@jjminer.org>

use Net::FTP;
use Getopt::Long;
use Pod::Usage;
use strict;

my %options;

GetOptions(\%options, 'download:s', 'list', 'help', 'server:s', 
                      'user:s', 'passwd:s', 'dir:s', 'arch:s',
                      'include:s', 'exclude:s', 'debug', 'rpm',
                      'uname', 'retry:i', 'hash', 'passive', 'all',
                      'version');

my $rhver = "7.0";

if (-e '/etc/redhat-release') {
    open (RELEASE, '/etc/redhat-release');
    my $line = <RELEASE>;
    close (RELEASE);

    ($rhver) = $line =~ /^Red Hat Linux release ([\d\.]+) /;
}

my $ftpserver = defined($options{server}) ? $options{server} : "updates.redhat.com";
my $ftpuser = defined($options{user}) ? $options{user} : undef;
my $ftppasswd = defined($options{passwd}) ? $options{passwd} : undef;
my $updatedir = 
    defined($options{dir}) ? $options{dir} : "";
my $defarch = defined($options{arch}) ? $options{arch} : 'i386';

my $rpmprog = defined($options{rpm}) ? $options{rpm} : "/bin/rpm";

my $localeprog = defined($options{localeprog}) ? $options{localeprog} : "/usr/bin/locale";
my $locale = defined($options{locale}) ? $options{locale} : undef;

my $unameprog = defined($options{uname}) ? $options{uname} : "/bin/uname";

my $tries = defined($options{retry}) ? $options{retry} == 0 ? -2 : $options{retry} + 1 : 1;

my $passive = defined($options{passive}) ? 1 : 0;

my $debug = defined($options{debug}) ? 1 : 0;

$updatedir =~ s#/*$##;

my $downdir = defined($options{download}) ? 
                $options{download} eq '' ? '.' : $options{download} 
                : '';

my $pattern = shift;

$options{include} = $pattern if (defined($pattern));

if (!defined($options{include}) && $downdir ne '' && ! -d $downdir && $downdir !~ m#/# ) {
    $options{include} = $downdir;
    $downdir = '.';
} else {
    $downdir =~ s#/*$##;
    if ($downdir ne '' && ! -d $downdir) {
        print STDERR "Directory \"$downdir\" does not exist!\n";
        undef $options{list};
        undef $options{download};
    }
}

my $VERSION_MAJ = 1;
my $VERSION_MIN = '5a';
my $VERSION = $VERSION_MIN =~ s/a$// ? "$VERSION_MAJ.$VERSION_MIN beta" : "$VERSION_MAJ.$VERSION_MIN";

my ($REVISION) = q$Revision: 1.52 $ =~ /([\d.]+)/;
my ($FILE) = q$RCSfile: rhupdate.pl,v $ =~ /^[^:]+: ([^\$]+),v $/;

if (defined($options{version})) {
    print STDERR "$FILE $VERSION ($REVISION)\n";
    exit(-1);
}

if (defined($options{help})) {
    pod2usage( -msg => "$FILE $VERSION ($REVISION)", -exitval => 0);
}

if (!(defined($options{list}) || defined($options{download}))) {
    pod2usage( -msg => "$FILE $VERSION ($REVISION)", -exitval => 2)
}

=pod

=head1 NAME

rhupdate.pl - Check for updates to RedHat RPMs

=head1 SYNOPSIS

rhupdate.pl [ pattern ] [ --download [dir] | --list ] [ --options ]

=head1 DESCRIPTION

Checks for updates for installed RPMS on RedHat's updates site.

Requires C<Net::FTP> and C<Pod::Usage> perl modules to be installed.  On some
versions of RedHat you will need to update File::Spec before Pod::Usage will
install.  (Even using CPAN.)

B<NOTE:> since version strings aren't simple numerics, I can only tell you when
the version on the server is different from what you have installed.

B<Install updates at your own risk.>

See http://www.redhat.com/support/docs/howto/kernel-upgrade/kernel-upgrade.html
for information on installing the kernel-* packages.  Failure to install the
Linux Kernel properly will result in a non-bootable machine.  Use --exclude
kernel to skip notification and download of Kernel packages.

=head1 INSTALL

(see INSTALL file)

http://www.jjminer.org/rhupdate/INSTALL

=for html
<pre>
<!--#include file="INSTALL" -->
</pre>

=head1 OPTIONS

=over 4

=item pattern

A pattern that the updates should match. (Shortcut for "--include pattern".)

=item --all

List or Download B<all> updates that are available on the server, not just those
that are installed on the local machine (and different from the local version.)
Different from just mirroring the updates directory because it downloads only
the correct architecture.

=item --arch arch

Default architecture (default: i386).

=item --dir directory

Root directory of B<THIS VERSION'S> updates.

=item --download [dir]

Download updated RPMs to the named directory or the current directory.

=item --exclude pattern

Pattern for packages to exclude.  B<NOTE> Exclude takes precedence over include.

=item --hash

Print hash marks as the file is downloaded.

=item --include pattern

Pattern for packages to include.  B<NOTE> Exclude takes precedence over include.

=item --list

List the available updates.

=item --passive

Get updates in passive mode.

=item --passwd passwd

Password to log in with (default: $USER@$HOST).

=item --retry [num]

Retry connecting to the FTP server num times 
(or infinitely if num is not specified) if it fails.

=item --server server

Server to check for updates on.

=item --user user

Username to log in as (default: anonymous).

=back

=head1 DOWNLOAD

http://www.jjminer.org/rhupdate

=for html
Stable<br>
<!--#include file="stable.inc" -->
Beta<br>
<!--#include file="beta.inc" -->

=head1 CHANGELOG

(See ChangeLog file)

http://www.jjminer.org/rhupdate/ChangeLog

=for html
<pre>
<!--#include file="ChangeLog" -->
</pre>

=head1 TODO

=over 4

=item multiple servers

Allow multiple servers to be queried (but, the question is, should they be
queried only if the previous server was unavailable, if there were no updates
at the previous server, or always?)

=item config file

Create/use a config file (~/.rhupdate or something?)  To record the defaults for
a specific site.

=item all installed updates

Add an option to download/list all files that are installed (different or not.)

=item multiple patterns

Allow for multiple patterns (include and exclude) to be entered.

=item version checks

Is there a way to check to see if the version on the server is greater-than the
version installed?

=item powertools

Add the ability to update the "powertools" 
(usually "$updatedir/powertools/version/arch")

=item error messages

Print a different error message when there are no updates versus nothing found
in the updates directory.

=back

=head1 AUTHOR

Jonathan J. Miner <jon@jjminer.org>

=head1 LICENSE

Copyright (C) 2001 Jonathan J. Miner

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.

=head1 VERSION

=for html
<pre>

1.5 beta
$Revision: 1.52 $

=for html
</pre>

=cut

print "Listing Updates..\n\n" if (defined($options{list}));
print "Downloading Updates..\n\n" if (defined($options{download}));

my %rpms;

foreach (`$rpmprog -q -a`) {
    next if (defined($options{include}) && !/$options{include}/);
    next if (defined($options{exclude}) && /$options{exclude}/);

    my ($lname, $lversion, $lrevision) = /(.*)-([^-]*)-(.*)/;

    $rpms{$lname}->{local}->{"$lversion-$lrevision"}->{version} = $lversion;
    $rpms{$lname}->{local}->{"$lversion-$lrevision"}->{revision} = $lrevision;
}

my $error = 0;
my $numtries = 0;

while ($tries != $numtries) {
    $numtries++;

    print "Attempt $numtries\n" if ($tries != 1);

    my $ftp = new Net::FTP($ftpserver, Passive => $passive, Debug => $debug, Timeout => 30);
    
    if (! defined($ftp)) {
        print STDERR "FTP Returned: $@\n" if (defined($options{debug}));

        $error = 1;

        $numtries = $tries if ($@ =~ /Bad hostname/);

        next;
    } else {
        $error = 0;
    }

    if (defined($options{hash})) {
        $ftp->hash(\*STDERR, 128000);
    }

    print STDERR "Connecting to $ftpserver\n" if (defined($options{debug}));

    print STDERR "Logging in as $ftpuser:$ftppasswd\n" 
        if (defined($options{debug}) && defined($ftpuser));

    my $login = $ftp->login(defined($ftpuser) ? ($ftpuser, $ftppasswd) : () );

    if (! defined($login)) {
        print STDERR "LOGIN Returned: $@\n" if (defined($options{debug}));

        $error = 1;
        next;
    } else {
        $error = 0;
    }

    print STDERR "Changing directory to $updatedir\n" if (defined($options{debug}));

    unless ($ftp->cwd($updatedir)) {
        die "Cannot change to $updatedir: $!\n";
    }

    if ($ftp->cwd($rhver)) {
        $updatedir .= "/$rhver";
        print STDERR "Changed directory to $rhver\n" if (defined($options{debug}));
    }

    ($locale) = (`$localeprog`)[0] =~ /LANG=(\w+)_.*\n/ if (! defined($locale));

    if (defined($locale)) {
        if ($ftp->cwd($locale)) {
            $updatedir .= "/$locale";
            print STDERR "Changed directory to $locale\n" if (defined($options{debug}));
        }
    }

    if ($ftp->cwd("os")) {
        $updatedir .= "/os";
        print STDERR "Changed directory to os\n" if (defined($options{debug}));
    }

    foreach my $line ($ftp->dir()) {

        # Some servers appear to have a broken "NLST" 
        # (most notably updates.redhat.com), so we have to parse the output of "LIST".

        my ($dir) = $line =~ /\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+(.*)/;

        next if (! defined($dir));
        next if ($dir =~ /^\.+$/);
        next if (! $ftp->cwd($dir));

        foreach ($ftp->ls()) {

            next if (!/rpm$/);
            next if (defined($options{include}) && !/$options{include}/);
            next if (defined($options{exclude}) && /$options{exclude}/);

            my ($name, $version, $revision, $extension) = /(.*)-([^-]*)-(.*)\.([\w\d]+\.rpm)/;

            my $update = undef;

            if (defined($rpms{$name})) {
                $rpms{$name}->{server}->{versionstring} = "$version-$revision";
                $rpms{$name}->{server}->{version} = $version;
                $rpms{$name}->{server}->{revision} = $revision;
                $rpms{$name}->{server}->{arch}->{$dir} = "$_";
            }
        }

        $ftp->cwd($updatedir);

    }

    my ($machine) = `$unameprog -m` =~ /(.*)\n/;

    my $num = 0;

    foreach my $name (keys %rpms) {
        my $update = undef;
        my $match = undef;

        if (! defined($options{all})) {
            foreach (keys %{$rpms{$name}->{local}}) {

                next if (!defined($rpms{$name}->{server}->{versionstring}));

                print STDERR "$_ ", 
                    $_ ne $rpms{$name}->{server}->{versionstring} ? "=>" : "=", 
                    " $rpms{$name}->{server}->{versionstring}\n" 
                    if (defined($options{debug}));

                if ($_ ne $rpms{$name}->{server}->{versionstring}) {
                    $update = $_;
                } else {
                    $match = $_;
                }
            }
        } else {
            $update = defined($rpms{$name}->{server}->{versionstring}) ? 
                $rpms{$name}->{server}->{versionstring} : undef;
        }

        if (defined($update) && !defined($match)) {

            $num++;

            my $local = $rpms{$name}->{local}->{$update};
            my $server = $rpms{$name}->{server};

            my $file = undef;
            my $loc = undef;
            if (defined($server->{arch}->{$machine})) {
                $file = $server->{arch}->{$machine};
                $loc =  $machine;
            } else {
                if (defined($server->{arch}->{$defarch})) {
                    $file = $server->{arch}->{$defarch};
                    $loc = "$defarch";
                } elsif (defined($server->{arch}->{'noarch'})) {
                    $file = $server->{arch}->{'noarch'};
                    $loc = 'noarch';
                }
            }

            if (defined($loc) && defined($file)) {

                if (! defined($options{all})) {
                    print "Update: $name ";
                    if ($local->{version} ne $server->{version}) {
                        print "Version Change $local->{version} -> $server->{version}\n";
                    } elsif ($local->{revision} ne $server->{revision}) {
                        print "Revision Change $local->{revision} -> $server->{revision}\n";
                    }
                } else {
                    print "Available: $name $server->{version} ", 
                    defined($local->{version}) ? "(local: $local->{version})\n" : "\n";
                }

                if (defined($options{download})) {
                    print "        $downdir/$file";
                    if ( -e "$downdir/$file" ) {
                        print " already exists.  Skipped.\n";
                    } else {
                        print " ... ";
                        $ftp->get("$updatedir/$loc/$file", "$downdir/$file");
                        my $mdtm = $ftp->mdtm("$updatedir/$loc/$file");
                        utime $mdtm, $mdtm, "$downdir/$file";
                        print "Done.\n";
                    }
                } else {
                    print " ftp://$ftpserver$updatedir/$loc/$file\n\n";
                }
            }
        }
    }


    $ftp->quit;

    if ($num == 0) {
        print "No updates available.\n";
    } else {
        print( "$num", $num != 1 ? " updates " : " update ", 
               defined($options{download}) ? "downloaded.\n" : "available.\n" );
    }

    $numtries = $tries;
}

if ($error != 0) {
    print "Error: $@\n";
}
