#!/usr/bin/perl
#
# rpmupdate
# Automated application of RPM updates
#
# Copyright (c) 1997 Malcolm Beattie
#
# This program is free software: you can distribute it and/or modify it
# under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 1, 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. If you do not have a copy of
# the GNU General Public License, then you can get one by writing to
# Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# Author: Malcolm Beattie <mbeattie@sable.ox.ac.uk>
# Original version:  9 Jan 1997

use Getopt::Long;
use Fcntl;

$last_update_file = "/etc/rpm.update";

$mount = "";
$error = 0;
$interrupt = 0;
$SIG{INT} = sub { $interrupt = 1 };

chomp($arch = `uname -m`);
$arch =~ s/^i.86$/i386/;
$def_rem_dir = "sable.ox.ac.uk:/ftp/pub/linux/redhat/redhat-4.0/updates/$arch";

$| = 1;

END {
    if ($mount) {
	chdir("/"); # get out of the mounted directory so we can unmount it
	system("umount", $mount);
	if ($? >> 8) {
	    warn "Warning: failed to umount $mount\n";
	} else {
	    print "Unmounted $mount OK\n" if $opt_verbose;
	    rmdir($mount) or warn "Warning: failed to rmdir $mount: $!\n";
	}
    }
}

sub vercmp {
    # Algorithm based on vercmp() in lib/misc.c of rpm 2.2.7
    my ($one, $two) = @_;
    my ($el, $sign);
    local($_);
#   print "vercmp($one, $two): "; # debug
    while (!$sign && length($one) && length($two)) {
	$one =~ s/[^a-z0-9]*//i;
	$two =~ s/[^a-z0-9]*//i;
	if ($one =~ s/^([0-9]+)//) {
	    $el = $1;
	    $two =~ s/^([0-9]+)//;
	    $sign = $el <=> $1;
	} else {
	    $one =~ s/^([a-z]+)//i;
	    $el = $1;
	    $two =~ s/^([a-z]+)//i;
	    $sign = $el cmp $1;
	}
    }	
    $sign ||= $one cmp $two;
#    print "returning $sign\n";#debug
    return $sign;
}

use vars qw($opt_help $opt_dir $opt_force $opt_verbose $opt_test
	    $opt_interactive @opt_skip);

if (!GetOptions(qw(help dir=s force verbose test|not-really
		   interactive skip=s@)) || $opt_help) {
    warn <<"EOT";
Usage: rpmupdate [options] [filename...]
Uses rpm to auto-apply update RPMs.
Options (all can be abbreviated to a single letter and used with one -) are
    --help         This usage message
    --force        Don't restrict to RPMs newer than $last_update_file
    --test or --not-really
                   Don't really do the updates--just show what would be done
    --verbose      Give some verbose chat about what is happening
    --dir dirname  Use directory name dirname to find the update RPMs
                   dirname can contain a ":" in which case it refers to
                   an NFS filesystem which will be temporaily mounted for
                   the duration of the updates. If no directory option is
                   given, rpmupdate defaults to the current directory (if
                   there are explicit filename arguments present) or else to
                   $def_rem_dir
    --interactive  Ask before performing each update
    --skip pattern Skip filenames which match the regexp pattern
                   Multiple --skip options can be given
Filename arguments [filename...] can be given to specify which .rpm files
should be considered. Pathnames can be absolute or relative to the RPM
directory. In the absence of any filename arguments, all files in the RPM
directory are considered.
EOT
    exit 2;
}

$updates_dir = $opt_dir || (@ARGV ? "." : $def_rem_dir);
$mount = "";

if ($updates_dir =~ /:/) {
    # Assume it's an NFS exported directory and mount it
    $mount = "/tmp/rpmupdate.$$";
    if (-d $mount) {
	rmdir($mount) or die "rmdir($mount) failed: $!\n";
    }
    mkdir($mount, 0755) or die "mkdir($mount, 0755) failed: $!\n";
    system(qw(mount -r -o rsize=8192), $updates_dir, $mount);
    die "failed to mount $updates_dir on $mount\n" if $? >> 8;
    print "Mounted $updates_dir on $mount\n" if $opt_verbose;
    $dir = $mount;
} else {
    $dir = $updates_dir;
}

if (@ARGV) {
    # explicit filenames (absolute or relative to $dir)
    @rpms = @ARGV;
} else {
    opendir(UPDATES, $dir) or die "opendir of $dir failed: $!\n";
    @rpms = readdir(UPDATES);
    closedir(UPDATES);
}

chdir($dir) or die "chdir($dir) failed: $!\n";

@rpms = grep(/\.$arch\.rpm$/o, @rpms);
$count = @rpms;
print "Total RPMs present: $count\n" if $opt_verbose;

if (@opt_skip) {
    my $pattern;
    foreach $pattern (@opt_skip) {
	@rpms = grep(!/$pattern/, @rpms);
    }
    $count = @rpms;
    print "RPMs left after skips: $count\n" if $opt_verbose;
}

if ($opt_force) {
    print "Ignoring last update marker because of --force option\n"
	if $opt_verbose;
} else {
    $days_since = -M $last_update_file;
    if (defined($days_since)) {
	@rpms = grep(-M $_ < $days_since, @rpms);
	$count = @rpms;
	print "New since last update: $count\n" if $opt_verbose;
    } else {
	print "$last_update_file not found: considering all RPMs\n"
	    if $opt_verbose;
    }
}

chomp(@installed_rpms = `rpm --quiet -qa`);
$rc = $? >> 8;
die "rpm --quiet -qa exited with error code $rc\n" if $rc;

foreach (@installed_rpms) {
    if (/^(.*)-(.*)-(.*)$/) {
	$rpm_version{$1} = [$2, $3];
    } else {
	warn "Warning: ignoring installed RPM with unparseable name: $_\n";
    }
}

print <<'EOT' if $opt_verbose;
EOT
$done_header = 0;

@rpms = grep {
    my ($name, $ver, $rel) = /^(.*)-(.*)-(.*)\.$arch\.rpm$/o;
    warn "ignoring RPM update file with unparseable name: $_\n" unless $rel;
    my $cur = $rpm_version{$name};
    if ($rel && $cur && (vercmp($cur->[0], $ver) || $cur->[1] <=> $rel) < 0) {
	if ($opt_verbose) {
	    if (!$done_header) {
		print "PACKAGE               VERSION/REL  ->  VERSION/REL\n";
		$done_header = 1;
	    }
	    printf "%-16.16s %12.12s %3d %12.12s %3d\n",
	           $name, @$cur, $ver, $rel;
	}
	1;
    } else {
	0;
    }
} @rpms;

$count = @rpms;
print "RPMs for attempted update: $count\n" if $opt_verbose;

@failures = ();
@successes = ();
@rpm_opts = ();
if ($opt_test) {
    push(@rpm_opts, "--test", $opt_verbose ? "-v" : "--quiet");
} else {
    push(@rpm_opts, $opt_verbose ? "-vh" : "--quiet");
}

foreach (@rpms) {
    my $confirmed = 1;
    my $rc = 0;
    if ($opt_interactive) {
	my $answer;
	print "Update to $_ (y/n)? ";
	chomp($answer = <STDIN>);
	$confirmed = $answer =~ /^y/i;
    }
    if ($confirmed) {
	system("rpm", "-U", @rpm_opts, $_);
	$rc = $?;
	if ($rc) {
	    push(@failures, $_);
	} else {
	    push(@successes, $_);
	}
    } else {
	print "Not updating $_\n" if $opt_verbose;
    }
    if ($interrupt || $rc & 255) {
	warn "\n\nInterrupted...aborting\n\n";
	$error = 1;
	last;
    }
}

$num_failures = @failures;
$num_successes = @successes;

# strip trailing .arch.rpm from filenames for logging purposes
map(s/\.$arch\.rpm$//o, @failures);
map(s/\.$arch\.rpm$//o, @successes);

if ($num_successes) {
    print "$num_successes RPMs successfully updated: ",
	join (", ", @successes), "\n";
}

if ($num_failures) {
    warn "Error: Failed to update $num_failures RPMs: ",
	join (", ", @failures), "\n";
} else {
    print "All $num_successes updates completed without error\n" unless $error;
    if ($opt_test) {
	print "Not touching $last_update_file because of --test option\n"
	    if $opt_verbose;
    } else {
	if (sysopen(LAST_UPDATE, $last_update_file, O_RDWR|O_CREAT, 0644)) {
	    close(LAST_UPDATE);
	    print "Successfully touched $last_update_file\n" if $opt_verbose;
	} else {
	    warn "Warning: failed to open $last_update_file: $!\n";
	}
    }
}