#!/usr/bin/perl
#
# check-rpms, version 2.1.0
# Martin Siegert, SFU, siegert@sfu.ca, Feb 02
#
# ************ WARNING *****************************************************
# THIS PROGRAM IS PROVIDED "AS IS" WITHOUT
# WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLICIT.
# IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
# **************************************************************************

# check-rpms.pl 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.
#
# check-rpms.pl 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:
# http://www.gnu.org/licenses/gpl.html

use Getopt::Long;

my $retval = &GetOptions("verbose|v","lm|list-missing","lq|list-questionable",
                         "dir|d=s","ftp:s","noftp","download|dl","recheck|r",
                         "nk|no-kernel","update","c=s");

if ( $retval == 0 ) {
    usage();
}

# executables
$FTPLS = "ncftpls";
$FTPGET = "ncftpget";
$GREP = "grep";

# default values
$RHversion = (split /\s/, `cat /etc/redhat-release`)[4];
$DEFCONF = "/usr/local/etc/check-rpms.conf";
$DEFRPMDIR = "/mnt/redhat/RedHat/RPMS";
$DEFFTPSERVER = "updates.redhat.com";
$DEFFTPUPDATES = "$RHversion/en/os";
$DEFRPMUSER = "nobody";

$RPMDIR=$DEFRPMDIR;

# configuration
# the configuration file should set the $RPMDIR variable and/or $FTPSERVER,
# $FTPUPDATES and $DOWNLOADDIR variables, and the $RPMUSER variable.
if ($opt_c) {
   $CONF = $opt_c;
} else {
   $CONF = $DEFCONF;
}

if ( -f $CONF) {
   require($CONF);
} else {
   $FTPSERVER = $DEFFTPSERVER;
   $FTPUPDATES = $DEFFTPUPDATES;
}

# check whether we are running as root
if ($< == 0){
   if (! $RPMUSER) {
      $RPMUSER = $DEFRPMUSER;
   }
   $RPMUID = getpwnam($RPMUSER);
   if (! $RPMUID) {
      die "You do not seem to have a $RPMUSER user on your system.\nSet the \$RPMUSER variable in the $CONF configuration file to a non-root user.\n";
   }
   if ($RPMUID == 0) {
      die "You must set the \$RPMUSER variable in $CONF to a non-root user.\n";
   }
   # switch to $RPMUID
   $> = $RPMUID;
   if ($> != $RPMUID) { die "switching to $RPMUID uid failed.\n" }
}

# command-line arguments
$verbose         = $opt_verbose;
$list_missing    = $opt_lm;
$questionable    = $opt_lq;
$no_kernel       = $opt_nk;
$download        = $opt_download;
$recheck         = $opt_recheck;
$update          = $opt_update;

if (defined $opt_update && $< != 0) {
    die "You must be root in order to update rpms.\n";
}

if ( defined $opt_dir ){
   $RPMDIR = $opt_dir;
}

if (defined $opt_ftp && defined $opt_noftp) {
   die "Setting -ftp and -noftp does not make sense, does it?\n";
}

if (defined $opt_noftp) { $FTP = 0; }

if (defined $opt_ftp || $FTP) {
   $ftp = 1;
   if ( $opt_ftp ) {
      $_ = $opt_ftp;
      ($FTPSERVER, $FTPUPDATES) = m/^([^\/]+)\/(.*)$/;
   } elsif ( ! ($FTPSERVER && $FTPUPDATES)) {
      $FTPSERVER = $DEFFTPSERVER;
      $FTPUPDATES = $DEFFTPUPDATES;
   }

   if (defined $opt_update){
      $download=1;
   }

   if ($download || $recheck) {
       if ( ! -d $RPMDIR) {
          $retval = system("mkdir -p $RPMDIR; chmod 700 $RPMDIR");
          if ($retval) { die "error: could not create $RPMDIR\n"; }
      }
   }
} elsif ( (! -d $RPMDIR) || system("ls $RPMDIR/*.rpm > /dev/null 2>&1")) {
   die "Either $RPMDIR does not exist or it does not contain any packages.\n";
}

if ($recheck) {
   $questionable=1;
}

if (defined $opt_update || defined $opt_nk) {
    $no_kernel=1;
}

$PROC = `grep -i athlon /proc/cpuinfo`;
if ( ! "$PROC" ) {
    $PROC = `uname -m`;
    chomp($PROC);
} else {
    $PROC = "athlon";
}

@ARCHITECTURES = ("noarch", "i386", "i586", "i686");
if ( $RHversion > 7.0 ){ 
    push(@ARCHITECTURES, "athlon");
}

# get the local list of installed packages

if ($verbose) {
   print "updates for $PROC processor, RH $RHversion\n";
   print "Getting list of installed packages\n";
}

if ($< == 0) {
   @local_rpm_list = `su $RPMUSER -c 'rpm -qa'`;
} else {
   @local_rpm_list = `rpm -qa`;
}
chop(@local_rpm_list);

%local_rpm = %remote_rpm = ();

for (@local_rpm_list) {
#    good place to test the regular expressions...
#    ($pkg, $ver, $release) = m/^(.*)-([^-]*)-([^-]+)/;
#    print "$_\t->$pkg, $ver, $release\n";

    my ($pkg, $pver) = m/([^ ]*)-([^-]+-[^-]+)/;
    $local_rpm{$pkg} = $pver;
}

# now connect to the remote host

my @templist;
if ($ftp) {
   if ( `rpm -q ncftp --pipe "grep 'not installed'"` ) {
      die "you must have the ncftp package installed in order to use a\n",
          "ftp server with check-rpms.\n";
   }
   $SOURCE = $FTPSERVER;
   for (@ARCHITECTURES) {
      my $FTPDIR = "$FTPUPDATES/$_";
      if ($verbose) {
         print ("Getting package lists from $FTPSERVER/$FTPDIR ...\n");
      }
      push(@templist, grep(/\.rpm$/, `$FTPLS -x "-1a" "ftp://$FTPSERVER/$FTPDIR/"`));
      if ($?) { print STDERR "$FTPLS failed with status ",$?/256,".\n"; }
   }
} else {
   $SOURCE = $RPMDIR;
   if ($verbose) {
       print ("Getting package lists from $RPMDIR ...\n");
   }
   @templist = grep(/\.rpm$/, `(cd $RPMDIR;ls -1)`);
}

#
# If two versions of the same RPM appear with different architectures
# and/or different versions, the right one must be found.
#

$giveup = 0;
for (@templist) {
   ($rpm, $pkg, $pver, $arch) = m/(([^ ]*)-([^- ]+-[^-]+\.(\w+)\.rpm))/;
   if ($remote_rpm{$pkg}) {
      # problem: there are several versions of the same package.
      # this means that the package exists for different architectures
      # (e.g., kernel, glibc, etc.) and/or that the remote server
      # has several versions of the same package in which case the
      # latest version must be picked.
      my ($pkg1) = ($remote_rpm{$pkg} =~ m/([^-]+-[^-]+)\.\w+.rpm/);
      my ($pkg2) = ($pver =~ m/([^-]+-[^-]+)\.\w+.rpm/);
      my ($vcmp, $qflag) = cmp_versions($pkg1, $pkg2);
      if ($qflag && $questionable) {
         # cannot decide which of the two is newer - what should we do?
         # print a warning that lists the two rpms.
         # If running with --update, both packages must be rechecked with 
         # rpm -qp --queryformat '%{SERIAL}' <pkg>
         if ($recheck || $update) {
            my $decision = pkg_compare("$pkg-$remote_rpm{$pkg}",$rpm, $vcmp);
            if ($decision < 0) {
               # an error in the ftp download routine accured: giveup
               $remote_rpm{$pkg} = undef;
               $giveup = 1;
            } elsif ($decision > 0) {
               # second package is newer
               $remote_rpm{$pkg} = $pver;
            }
            next;
         } else {
            mulpkg_msg("$pkg-$remote_rpm{$pkg}", $rpm, $vcmp);
            print "** check whether this is correct or rerun with --recheck option.\n";
            if ($vcmp < 0) {
               $remote_rpm{$pkg} = $pver;
            }
         }
      }
      if ($vcmp == 0) {        
         # versions are equal: must be different architecture
         # procedure to select the correct architecture:
         # if $PROC = athlon: if available use $arch = athlon (exist for
         # RH 7.1 or newer) otherwise use i686
         # if $PROC = ix86: choose pkg with $PROC cmp $arch >= 0 and
         # $arch cmp $prev_arch = 1
         $_ = $remote_rpm{$pkg};
         ($prev_arch) =  m/.*\.(\w+)\.rpm$/;
         if (cmp_arch($arch,$prev_arch)) { $remote_rpm{$pkg} = $pver };
      } elsif ($vcmp < 0) {    # second rpm is newer
         $remote_rpm{$pkg} = $pver;
      }
   } else {
      $remote_rpm{$pkg} = $pver;
   }
}

if ($giveup && defined $opt_update) {
   die "Multiple versions of the same package were found on the server.\n",
       "However, due to ftp download problems it could not be verified\n",
       "which of the packages are the most recent ones.\n",
       "If the choices specified above appear to be correct, rerun check-rpms\n",
       "without the -lq (or --list-questionable) option. Otherwise, fix the download\n",
       "problems or install those packages separately first.\n";
}

#
# check for UPDated and DIFferent packages...
#

for (@local_rpm_list) {
    my ($pkg,  $version) = m/^([^ ]*)-([^-]+-[^-]+)$/;
    if (! $pkg) { print "Couldn't parse $_\n"; next; }
    if ($no_kernel) {
       if ($pkg eq 'kernel' || $pkg eq 'kernel-smp'
           || $pkg eq 'kernel-enterprise' || $pkg eq 'kernel-BOOT'
           || $pkg eq 'kernel-debug') { next; }
    }
    if (defined $remote_rpm{$pkg}) { 
        # this package has an update
	my ($rversion) = ($remote_rpm{$pkg} =~ m/([^-]+-[^-]+)\.\w+.rpm/);
	my $rpm = ($pkg . '-' . $remote_rpm{$pkg});
	my ($vcmp,$qflag) = cmp_versions($version, $rversion);
	if ( $qflag && $questionable ) {
            # at least one of the version strings contains letters
            push(@q_updates, $rpm);
        } elsif ( $vcmp < 0 ) {
            # local version is lower
            if ( $qflag ) {
               push(@q_updates, $rpm);
            } else {
               push(@updates, $rpm);
            }
	}
    } elsif ($list_missing) {
	print "Package '$pkg' missing from remote repository\n";
    }
}

if ($recheck && @q_updates) {
   if ($ftp) {    
      for (@q_updates) {
         ($arch) = m/[^ ]*-[^- ]+-[^-]+\.(\w+)\.rpm/;
         push(@ftp_files, "$FTPUPDATES/$arch/$_");
      }
      if ($verbose) {
         print "Getting questionable packages form $FTPSERVER ...\n";
      }
      my $status = system("$FTPGET $FTPSERVER $RPMDIR @ftp_files");
      if ($status) {
         if ($< == 0) {
            # if we are running as root exit to avoid symlink attacks, etc.
            die "$FTPGET failed with status ", $status/256, ".\n";
	 } else {
            print STDERR "warning: $FTPGET failed with status ", $status/256, ".\n";
         } 
      }
   }
   for (@q_updates) {
      if ($verbose) {print "** rechecking $_ ... ";}
      my $errmsg = `rpm -Uvh --test --nodeps --pipe 'grep -v ^Preparing' $RPMDIR/$_ 2>&1`;
      if (! $errmsg) {
         # no error message, i.e., the rpm is needed.
          push(@updates,$_);
          if ($verbose) {print "needed!\n";}
      } elsif ($verbose) {
          print "not needed:\n$errmsg\n";
      }
   }
   @q_updates=();
}
       
#
# print list of new files and download ...
#

@updates = sort @updates;
if (@updates) {
    if ($verbose) {
       print "\nRPM files to be updated:\n\n";
    }
    for (@updates) {
       print "$_\n";
    }
    if ($download) {
       @ftp_files=();
       for (@updates) {
          ($arch) = m/[^ ]*-[^- ]+-[^-]+\.(\w+)\.rpm/;
          push(@ftp_files, "$FTPUPDATES/$arch/$_");
       }
       if ($verbose) {
          print "starting downloads ... \n";
       }
       my $status = system("$FTPGET $FTPSERVER $RPMDIR @ftp_files");
       if ($status) {
          if ($< == 0) {
             # if we are running as root exit to avoid symlink attacks, etc.
             die "$FTPGET failed with status ", $status/256, ".\n";
	  } else {
             print STDERR "warning: $FTPGET failed with status ", $status/256, ".\n";
          } 
       } elsif ($verbose) {
          print "... done.\n";
       }
    }           
}

@q_updates = sort @q_updates;
if (@q_updates && $questionable) {
    if ($verbose) {
       print "\nRPM files that may need to be updated:\n\n";
       for (@q_updates) {
          my ($old) = m/^([^ ]*)-[^-]+-[^-]+\.\w+\.rpm$/;
          $old = `rpm -q $old`;
          chomp($old);
          print "upgrade ", $old, " to ", $_, " ?\n";
       }
    } else {
       for (@q_updates) {
          print "$_\n";
       }
    }
    if ($download) {
       @ftp_files=();
       for (@updates) {
          ($arch) = m/[^ ]*-[^- ]+-[^-]+\.(\w+)\.rpm/;
          push(@ftp_files, $FTPUPDATES/$arch/$_);
       }
       if ($verbose) {
          print "starting downloads ... \n";
          system("$FTPGET $FTPSERVER $$RPMDIR @ftp_files");
          print "... done.\n";
       } else {
          system("$FTPGET $FTPSERVER $$RPMDIR @ftp_files");
       }
    }           
}

if ($verbose && !(@updates || @q_updates)) {
    print "No new updates are available in $SOURCE\n";
}

if ($opt_update) {
    if (@q_updates){
       push(@updates,@q_updates);
    }
    if (@updates) {
       if ($verbose) {
          print "Running rpm -Fvh ...\n";
       }
       # switch to UID=0
       $> = $<;
       system("(cd $RPMDIR;rpm -Fvh @updates)");
   }
}

# download routine
sub ftp_download {
   my ($FTPSERVER, $FTPDIR, $downloaddir, @packages) = @_;
   my @ftp_packages=();
   for (@packages) {
       my ($arch) = m/[^ ]*-[^-]+-[^-]*\.(\w+)\.rpm$/;
       push(@ftp_packages,"$FTPDIR/$arch/$_");
    }
    my $status = system("$FTPGET $FTPSERVER $downloaddir @ftp_packages");
    return $status;
}

sub pkg_compare($$$) {
   my ($pkg1, $pkg2, $cmp) = @_;
   if (defined $opt_ftp) {
      if ($verbose) {
         my ($pkg) = ($pkg1 =~ /([^ ]*)-[^-]+-[^-]+\.\w+\.rpm/);
         print "The ftp server provides multiple versions of the $pkg package.\n",
               "Downloading $pkg1 and $pkg2 in order to find out which is newer.\n";
      }
      my $status = ftp_download($FTPSERVER, $FTPUPDATES, $RPMDIR, ($pkg1, $pkg2));
      if ($status) {
         # at this point just give up ...
         print STDERR "** $FTPGET failed with status ", $status/256, ".\n";
         mulpkg_msg($pkg1, $pkg2, $cmp);
         return -1;
      }
   }
   my $serial1 = `rpm -qp --queryformat '%{SERIAL}' $RPMDIR/$pkg1`;
   my $serial2 = `rpm -qp --queryformat '%{SERIAL}' $RPMDIR/$pkg2`;
   ($serial2 > $serial1) ? return 1 : return 0;
}

sub mulpkg_msg($$$) {
   my ($pkg1, $pkg2, $cmp) = @_;
   print "** The server provides two versions of the same package:\n",
         "** $pkg1 and $pkg2.\n";
   if ($cmp > 0) {
       print "** It appears that $pkg-$remote_rpm{$pkg} is newer.\n"
   } else {
       print "** It appears that $pkg-$pver is newer.\n";
   }
}

#############################################################################
#
# Version comparison utilities
#

sub hack_version($) {
    my ($pver) = @_;
    $pver =~ s/(\d+)/sprintf("%08d", $1)/eg; # pad numbers with leading zeros to make alphabetical sort do the right thing
    $pver =  (sprintf "%-80s", $pver);	     # pad with spaces so that "3.2.1" is greater than "3.2"
    return $pver;
}

sub cmp_versions($$) {
    my ($pkg1, $pkg2) = @_;

    # shortcut if they're obviously the same.
    return (0,0) if ($pkg1 eq $pkg2);

    # split into version and release
    my ($ver1, $rel1) = ($pkg1 =~ m/([^-]+)-([^-]+)/);
    my ($ver2, $rel2) = ($pkg2 =~ m/([^-]+)-([^-]+)/);

    if ($ver1 ne $ver2) {
       my $qflag = ((grep /[A-z]/, $ver1) || (grep /[A-z]/, $ver2));
       $ver1 = hack_version($ver1);
       $ver2 = hack_version($ver2);
       return ($ver1 cmp $ver2, $qflag);
    } else {
       my $qflag = ((grep /[A-z]/, $rel1) || (grep /[A-z]/, $rel2));
       $rel1 = hack_version($rel1);
       $rel2 = hack_version($rel2);
       return ($rel1 cmp $rel2, $qflag);
    }
}

sub cmp_arch($$) {
    my ($arch1, $arch2) = @_;
    my $retval = 0;
    $archcmp = ($arch1 cmp $arch2) > 0;
    if ( "$PROC" eq "athlon" ) {
       if ( "$arch2" ne "athlon" 
              && ( "$arch1" eq "athlon" || $archcmp )){
	   $retval = 1;
       }
    } elsif ( $archcmp && ($PROC cmp $arch1) >= 0 ) {
       $retval = 1;
    }
    return $retval;
}

# @tests = ('3.2', '3.2',
#           '3.2a', '3.2a',
#           '3.2', '3.2a',
#           '3.2', '3.3',
#           '3.2', '3.2.1',
#           '1.2.5i', '1.2.5.1',
#           '1.6.3p6', '1.6.4');
# 
# while (@tests) {
#     $a = shift(@tests);
#     $b = shift(@tests);
#     printf "%-10s < %-10s = %d\n", $a, $b, cmp_versions($a, $b);
# }
#
# And the correct output is...
#
#     3.2        < 3.2        = 0
#     3.2a       < 3.2a       = 0
#     3.2        < 3.2a       = -1
#     3.2        < 3.3        = -1
#     3.2        < 3.2.1      = -1
#     1.2.5i     < 1.2.5.1    = -1
#     1.6.3p6    < 1.6.4      = -1
#
# the lexical sort does not give the correct result in the second to last case.


sub usage(){
   die "usage: check-rpms [-v | --verbose]  [-d directory | --dir directory]\n",
       "                  [-ftp [server/directory]] [-noftp] [-lm | --list-missing]\n",
       "                  [-lq | --list-questionable] [-r | --recheck ]\n",
       "                  [-nk | --no-kernel] [--update] [-c configurationfile]\n";
}