#!/usr/bin/perl -w
#
#  SPident - Try to identify Service Pack Level based on installed packages
#
#  $Id: SPident.pl,v 1.33 2006/04/13 15:58:33 rw Exp $
#
#  Copyright (c) 2003 SuSE Linux AG, Nuernberg, Germany.
#
#  Author: Raymund Will <rw@suse.de>
#
#  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.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#

use strict;

$| = 1;
$[ = 0;
my $C = $0; $C =~ s%^.*/%%;

$ENV{"LC_ALL"} = "C";

my $GTv = "1.1";
my $Version = q(0.9-74.27.8);
my $DBpath = q(/usr/share/misc/SPident);

my $debug = 0;
my $verbose = 1;
my $ignoreDupPkg = 0;
my $considerEverySP = 1;
my $rArch = `arch`;
my $inspect = "";
my $Installed = "";

my $Vendors = qr(^(?:
   SuSE\ GmbH |
   SuSE\ AG |
   SuSE\ Linux\ AG |
   SUSE\ LINUX\ Products\ GmbH |
   UnitedLinux\ LLC |
   Novell
))ixo;

my $showRevSP  = 0x02;
my $showDistS  = 0x04;
my $showFQPoD  = 0x08;
my $showPbyEpD = 0x10;
my $showDbyEpP = 0x20;
my $showMax    = 0x40;

sub Version() {
  $_ = $Version;
  if ( /\@VERSION\@/ ) {
    $_ = q($Revision: 1.33 $ );
    s/^\$ Rev.*:\ ([0-9.]+)\ \$\ /RCS-$1/x;
  }
  print "$C version $_\n";
  exit( 0 );
}

sub Die($) {
  my( $msg) = @_;
  warn "FATAL: " . $msg;
  exit( 2);
}

{
  use Getopt::Long;
  use Pod::Usage;
  $Getopt::Long::debug = 0;
  $Getopt::Long::ignorecase = 0;
  $Getopt::Long::bundling = 1;
  $Getopt::Long::passthrough = 0;
  my %Opt = ();

  pod2usage(2) unless ( GetOptions( \%Opt,
     'help|h', 'man|m', 'version|V', 'verbose|v+', 'quiet|q+', 'debug|d+',
     'no-update|N', 'once|o', 'skip|s') && ! $Opt{'help'} );

  Version() if ( $Opt{'version'} );
  pod2usage(-exitstatus => 0, -verbose => 2) if ( $Opt{'man'} );
  pod2usage(1) if ( $Opt{'help'} );
  $debug += $Opt{'debug'} if ( $Opt{'debug'} );
  $verbose += $Opt{'verbose'} if ( $Opt{'verbose'} );
  $verbose -= $Opt{'quiet'} if ( $Opt{'quiet'} );
  $ignoreDupPkg = 1 if ( $Opt{'once'} );
  $considerEverySP = 0 if ( $Opt{'skip'} );
}
$verbose = $verbose <= 0 ? 0 : (1 << $verbose) - 1;
$debug = $debug <= 0 ? 0 : (1 << $debug) - 1;
$DBpath = "." if ( $DBpath =~ /\@DBpath\@/ );

my %iArch = (
    #fancy name	    dist-arch (internal, canonical)
    "IA32"	=> "i386",
    "athlon"	=> "i386",
    "x86"	=> "i386",
    "ix86"	=> "i386",
    "i686"	=> "i386",
    "i586"	=> "i386",
    "i486"	=> "i386",
    "i386"	=> "i386",
    "IPF"	=> "ia64",
    "IA64"	=> "ia64",
    "ia64"	=> "ia64",
    "powerpc"	=> "ppc",
    "ppc64"	=> "ppc",
    "ppc"	=> "ppc",
    "S390"	=> "s390",
    "s390"	=> "s390",
    "S390x"	=> "s390x",
    "s390x"	=> "s390x",
    "amd64"	=> "x86_64",
    "em64t"	=> "x86_64",
    "ia32e"	=> "x86_64",
    "x86-64"	=> "x86_64",
    "x86_64"	=> "x86_64",
);
my %oArch = (
    #arch-output   politically correct
    "ia64"	=> "IPF",
    "x86_64"	=> "x86-64",
);

my $archRE = q(alpha|i386|ia64|ppc|s390x?|sparc|x86_64);
my $ArchRE = $archRE;
$ArchRE .= q(|IPF|amd64|x86-64|ppc64|i486|i586|i686);
$ArchRE .= q(|noarch|\\\(none\\\));
# fixme: build $ArchRE from $archRE + %iArch

my $distRE = qr(^
    ([^0-9]+)- # Product/Distribution-Names contain no digits
    ([0-9.]+)- # Product/Distribution-Versions contain only digits (& dots)
    (?:(.*?)-)?? # optional string (e.g. "Int", "Developer")
    ($archRE) # known architectures (fixpoint!)
    (?:-(SP[^-]+))? # optional ServicePack identifier (e.g. "SP1" or "SP2a")
    (?:-([^-]+))??$ # optional release id (e.g. "RC" or "beta")
    $ )xo;

my $editionRE = qr(^
    (?:([^:]+):)?	# optional Epoch
    ([^-]+)-		# Version followed by '-'
    ([^-]+)		# Release
    (?:\.$archRE)?	# optionally followed by '.' and Architecture
    $ )xo;

my $ignoreRE = qr((?:SPident|release-notes|gpg-pubkey))x;

my $QF =  q();
my $QP = qr();
$QF .=  q(%{NAME});
$QP .=  q(^(.+) );
$QF .=  q(\t%|EPOCH?{%{EPOCH}:}:{}|%{VERSION}-%{RELEASE});
$QP .=  q([\t-]([^-]+)-(.+?) );
$QF .=  q(\t%|ARCH?{%{ARCH}}:{noarch}|);
$QP .= qq([.\t]($ArchRE) );
$QF .=  q(\t%{BUILDTIME}\t"%{VENDOR}");
$QP .=  q((?:\s+([0-9]+) (?:\s+\" ( (?>[^"]+) | \"[^"]*\" )+ \")?)? );
$QF .=  q(\t);
$QP .=  q(\s*$ );

$QP = qr($QP)xo;
$ArchRE = qr($ArchRE)xo;
$archRE = qr($archRE)xo;

# ( Version comparison "a la RPM" is brought to us by <mls@suse.de> !-)
sub _verscmp($$) {
  my ($s1, $s2) = @_;
  if ( !defined($s1) ) {
    return ( defined($s2) ? -1 : 0 );
  }
  return ( 1 ) if !defined $s2;
  return ( 0 ) if $s1 eq $s2;
  while ( 1 ) {
    $s1 =~ s/^[^a-zA-Z0-9]+//;
    $s2 =~ s/^[^a-zA-Z0-9]+//;
    my ($x1, $x2, $r);
    if ($s1 =~ /^([0-9]+)(.*?)$/) {
      ($x1, $s1) = ($1, $2);
      ($x2, $s2) = $s2 =~ /^([0-9]*)(.*?)$/;
      return ( 1 ) if $x2 eq '';
      $x1 =~ s/^0+//;
      $x2 =~ s/^0+//;
      $r = length($x1) - length($x2) || $x1 cmp $x2;
    } else {
      ($x1, $s1) = $s1 =~ /^([a-zA-Z]*)(.*?)$/;
      ($x2, $s2) = $s2 =~ /^([a-zA-Z]*)(.*?)$/;
      return ( -1 ) if $x1 eq '' || $x2 eq '';
      $r = $x1 cmp $x2;
    }
    return ( $r ) if $r;
    if ($s1 eq '') {
      return ( ($s2 eq '') ? 0 : -1 );
    }
    return ( 1 ) if $s2 eq ''
  }
}

sub CMPversions($$) {
  my ($evr1, $evr2) = @_;
  my $r;

  my ($e1, $v1, $r1) = $evr1 =~ /^(?:(\d*):)?(.*?)(?:-([^-]*))?$/;
  my ($e2, $v2, $r2) = $evr2 =~ /^(?:(\d*):)?(.*?)(?:-([^-]*))?$/;
  $e1 = "0" if defined($e1) && $e1 eq '';
  $e2 = "0" if defined($e2) && $e2 eq '';
  if ( defined($e1) || defined($e2) ) {
    $r = _verscmp(defined($e1) ? $e1 : "0", defined($e2) ? $e2 : "0");
    return ( $r ) if $r;
  }
  $r = _verscmp($v1, $v2);
  return ( $r ) if $r;
  return ( _verscmp($r1, $r2) );
}

sub breakD($) {
  my($aD, $aV, $aP, $aA, $aS, $aR);
  if ( ($aD, $aV, $aP, $aA, $aS, $aR) = ($_[0] =~ /$distRE/o) ) {
    $aP ||= "";
    $aS ||= "";
    $aR ||= "zzzz";
    $aR = "zzzy" . $aR if ( $aR =~ /^(GA|FCS)$/ );
    $aR = "zzzx" . $aR if ( $aR =~ /^RC/ );
    return ( ($aD, $aV, $aP, $aA, $aS, $aR) );
  } else {
    return undef;
  }
}

sub checkD($$) {
  my($aD, $aV, $aP, $aA, $aS, $aR) = breakD($_[0]);
  my $d = $_[1];
  my $aRp;
  if ( defined($aD) ) {
    $aRp = substr( $aR, 0, 1);
    $aR = substr( $aR, 1);
    if ($d ) {
      printf( STDERR
	      "Dist=\t\t$aD\n" .
	      " Version=\t$aV\n" .
	      " Add=\t\t$aP\n" .
	      " Arch=\t\t$aA\n" .
	      " SP=\t\t$aS\n" .
	      " Release=\t$aR (ord=%d)\n" .
	      "", ord($aRp));
    }
    return ( 1 );
  } else {
    print STDERR "Warning! Ignoring <$_[0]> ...\n";
    return ( 0 );
  }
}

sub dist2float($$$$);
my $d2fmsg = "d2f(";

sub dist2float($$$$){
  my($n, $v, $p, $s) = @_;
  my $r = 0;
  my $so = 100;
  my $spe = 0;
  my %match = (
    "SLES-9-NLPOS-9-"		=>  ["SLES", "9", "", "SP1"],
    "SLES-9-OES-9-"		=>  ["SLES", "9", "", "SP1"],
  );
  my %order = (
    "UnitedLinux"	=>  7.0 - (1 / ($so ** 2)),
    "CORE"		=>  0.0 - (1 / ($so ** 2)),
  );
  $d2fmsg .= "$n-$v-$p-$s)";
  if ( "$p" && exists( $match{"$n-$v-$p-$s"}) ) {
    my ($bn, $bv, $bp, $bs) = @{ $match{"$n-$v-$p-$s"} };
    $d2fmsg .= " == (";
    return ( dist2float( $bn, $bv, $bp, $bs) );
  } elsif ( "$p" && exists( $match{"$n-$v-$p-"}) ) {
    my $d = $debug;
    my ($bn, $bv, $bp, $bs) = @{ $match{"$n-$v-$p-"} };
    $debug = 0;
    $d2fmsg .= " => <(";
    $r = dist2float( $bn, $bv, $bp, $bs);
    $debug = $d;
    $d2fmsg .= ">";
  } else {
    my @S = split( /[[:^alnum:]]/, $v);
    my $sn = $S[0];
    $sn =~ s{^([0-9]*).*}{$1};
    if ( exists( $order{"$n-$S[0]"}) ) {
      $r = $order{"$n-$S[0]"};
    } elsif ( exists( $order{"$n"})) {
      $r = $order{"$n"} + $sn;
    } else {
      $r = $sn;
    }
    for my $i ( 1..$#S ) {
      $r += ($S[$i] / ($so ** $i));
    }
    $spe = $#S;
    $d2fmsg .= " [$spe]";
  }
  if ( $s =~ m{^SP([0-9]*)([a-z]?)$} ) {
    my ($sv, $sa) = ($1, $2);
    if ( defined( $sa) && "$sa" ) {
      $sa = (ord($sa) - ord('a') + 1) / 10;
    } else {
      $sa = 0.0;
    }
    if ( ! defined( $sv) || ! "$sv" ) {
      $sv = 1.0;
    }
    $r += ( $sv + $sa ) / ($so ** ($spe + 1));
  }
  if ( $debug ) {
    printf STDERR "%-56s = %.14f\n", $d2fmsg, $r;
    $d2fmsg = "d2f(";
  } else {
    $d2fmsg .= sprintf " = %.2f", $r;
  }
  return ( $r );
}

my %N;
my @V;
my %V_sp;
my %Matched;
my %Offend;
my %Updated;
my %D_arch;
my %D_pkg2eas;
my %D_pkg2ea;
my %D_pa2editions;
my %D_pa2edition;
my %P_dnea2btime;
my %P_edition2dists;
my %P_full2dists;
my @revSP;
my %atomizeD;
my ($maxP, $maxE, $maxF, $maxS) = ( 0, 0, 0, 0);
my $maxD = length("Product/ServicePack");


sub CMPeditions($$) {
  my($aE, $aV, $aR, $aA) = ($_[0] =~ m($editionRE)o);
  my($bE, $bV, $bR, $bA) = ($_[1] =~ m($editionRE)o);

  $aE ||= "";
  $bE ||= "";
  $aA ||= "";
  $bA ||= "";
  $aE cmp $bE ||
  CMPversions( $aV, $bV) ||
  CMPversions( $aR, $bR) ||
  $aA cmp $bA
}

sub CMPfqp($$) {
  my($aN, $aE, $aA) = ($_[0] =~ m(^(.+)-([^-]+-[^-]+)\.([^.]+)$ )x);
  my($bN, $bE, $bA) = ($_[1] =~ m(^(.+)-([^-]+-[^-]+)\.([^.]+)$ )x);

  $aN cmp $bN ||
  CMPeditions( $aE, $bE) ||
  $aA cmp $bA
}

sub CMPdist($$) {
  my($aD, $aV, $aP, $aA, $aS, $aR, $aF) = @{ $atomizeD{$_[0]}};
  my($bD, $bV, $bP, $bA, $bS, $bR, $bF) = @{ $atomizeD{$_[1]}};

  $aA cmp $bA ||
  $aF <=> $bF ||
  $aP cmp $bP ||
  CMPversions( $aR, $bR)
}

sub abbrev($) {
  my($d) = @_;
  $d =~ s/UnitedLinux-1\.0/UL-1/g;
  $d =~ s/[Bb]eta/b/g;
  return ( $d );
}

sub jPrint($@) {
  my($j, @A) = @_;
  print( "$j", join( "\n$j", @A), "\n") if ( $#A >= 0 );
}

sub sPrint($$) {
  my( $v, $p) = @_;
  my $F = '%d %4.1f%%';
  my $D = '%d %4d%%';
  my $o = "";
  if ( $p == 100 || $p == 0 ) {
    $o = sprintf( $D, $v, $p);
  } else {
    $o = sprintf( $F, $v, $p);
  }
  return ( $o );
}

sub dPrint($$@) {
  my( $l, $f, @A) = @_;
  printf( STDERR $f, @A) if $l & $debug;
}

#
# check args and map arch
#
if ( defined( $ARGV[0]) ) {
  my $t = $rArch;
  $inspect = $ARGV[0];
  ( $rArch ) = ($inspect =~ m:([^./]+)\.[^/]+$:);
  Die "could not initialize 'arch'!\n" unless defined( $rArch);
  if ( -r $inspect ) {
    print STDERR "Attention: overriding 'rpm'-input from '$inspect'!\n\n";
  } else {
    chomp( $t);
    my $i = (exists( $iArch{$rArch})) ? $iArch{$rArch} : $rArch;
    print STDERR "Attention: saving 'rpm'-output to '$inspect'!\n";
    print STDERR "Warning: selected '$rArch' doesn't match detected '$t'\n"
       unless $rArch eq $t || $i eq $t;
    print STDERR "\n"
  }
} else {
  chomp( $rArch);
}
my $iArch = (exists( $iArch{$rArch})) ? $iArch{$rArch} : $rArch;
my $oArch = (exists( $oArch{$rArch})) ? $oArch{$rArch} : $rArch;

dPrint( 1, "rArch=$rArch iArch=$iArch oArch=$oArch arch=%s\n", `arch`);

die( "ERROR: unsupported architecture: $iArch\n") if ( $iArch !~ /$archRE/o );

#
# Parse database into hashes
#
foreach my $t ( <$DBpath/*> ) {
  my ($dist, $ext) = ( $t =~ m:^$DBpath/(.+?)(\.gz|\.bz2)?$:o );
  print STDERR "*** $dist ***  ($t)" if $debug & 0x80;
  my($aD, $aV, $aP, $aA, $aSP, $aR) = breakD( $dist);
  if ( ! defined($aD) ) {
    print STDERR "  => skipped!\n" if $debug & 0x80;
    next;
  } elsif ( ! exists( $iArch{$aA}) || $iArch{$aA} ne $iArch ) {
    print STDERR ": arch mismatch  => skipped!\n" if $debug & 0x80;
    next;
  } else {
    print STDERR "\n" if $debug & 0x80;
  }
  if ( ! defined( $ext) ) {
    open( IN, "< $t") || Die( "open($t): $!\n");
  } elsif ( $ext eq ".gz" ) {
    open( IN, "zcat $t |") || Die( "open(zcat $t): $!\n");
  } elsif ( $ext eq ".bz2" ) {
    open( IN, "bzcat $t |") || Die( "open(bzcat $t): $!\n");
  } else {
    print STDERR "how come? ext='$ext'\n";
  }
  $_ = <IN>;
  if ( ! /^\#\# V([0-9.]+) --/ ) {
    print STDERR "$t: outdated format => skipped\n";
    next;
  } elsif ( CMPversions( $GTv .".999", $1) < 0) {
    print STDERR "$t: incompatible format => skipped\n";
    next;
  }

  $N{$dist} = 0;

  while ( <IN> ) {
    chomp;
    my($pkg, $edition, $arch, $btime, $path) = split '\t';
    if ( $ignoreDupPkg && exists($P_full2dists{"$pkg-$edition.$arch"}) ) {
      # FixMe: look at all entries?  I don't think so...
      my $d = $P_full2dists{"$pkg-$edition.$arch"}[0];
      next if ( $btime == $P_dnea2btime{"$d $pkg-$edition.$arch"} );
    }
    $P_dnea2btime{"$dist $pkg-$edition.$arch"} = $btime;
    push @{ $D_pkg2eas{$dist}{"$pkg"} }, "$edition.$arch";
    push @{ $D_pa2editions{$dist}{"$pkg.$arch"} }, $edition;
    push @{ $P_edition2dists{$pkg}{$edition} }, $dist;
    push @{ $P_full2dists{"$pkg-$edition.$arch"} }, $dist;
    $D_arch{$dist}{$arch} += 1;
    $N{$dist} += 1;
    $t = length($pkg);			$maxP = $t if $maxP < $t;
    $t = length($edition);		$maxE = $t if $maxE < $t;
    $t = length("$pkg-$edition.$arch"); $maxF = $t if $maxF < $t;
  }
  if ( $N{$dist} > 0 ) {
    $t = length($dist);			$maxD = $t if $maxD < $t;
    $t = length(abbrev($dist));		$maxS = $t if $maxS < $t;
    $t = dist2float( $aD, $aV, $aP, $aSP);
    $atomizeD{$dist} = [ ($aD, $aV, $aP, $aA, $aSP, $aR, $t) ];
    if ( $debug & 0x100 ) {
      print  "Dist=\t\t$aD\n";
      print  " Version=\t$aV\n";
      print  " Add=\t\t$aP\n";
      print  " Arch=\t\t$aA\n";
      print  " SP=\t\t$aSP\n";
      print  " Release=\t$aR\n";
      printf " sorting=\t%.14f\n", $t;
    }
  } else {
    delete $N{$dist};
  }
}
print "\n" if ($debug & 0x80 );
close( IN);

#
# house-keeping
#
{
  # pre-sort products ("distributions") per fully-qualified package  
  foreach my $f ( keys( %P_full2dists) ) {
    $P_full2dists{$f} = [ sort( CMPdist @{ $P_full2dists{$f} }) ];
  }
  # pre-sort edition.arch per pkg
  foreach my $d ( keys( %D_pkg2eas) ) {
    foreach my $p ( keys( %{ $D_pkg2eas{$d} }) ) {
      my @t = sort(CMPeditions @{$D_pkg2eas{$d}{$p}});
      @{$D_pkg2eas{$d}{$p}} = @t;
      $D_pkg2ea{$d}{$p} = $t[$#t];
    }
  }
  # pre-sort editions (version + release) per pkg.arch
  foreach my $d ( keys( %D_pa2editions) ) {
    foreach my $p ( keys( %{ $D_pa2editions{$d} }) ) {
      my @t = sort( CMPeditions @{$D_pa2editions{$d}{$p}});
      @{$D_pa2editions{$d}{$p}} = @t;
      $D_pa2edition{$d}{$p} = $t[$#t];
    }
  }
  # build array of service-packs (sorted reverse) 
  foreach my $d ( sort( CMPdist keys( %N)) ) {
    @revSP = ( $d, @revSP);
  }
}

#
# print tables (for evaluation and debugging)
#
if ( $debug & $showDistS ) {
  print "# List: covered distributions/service-packs (oldest to newest)\n";

  foreach ( sort( CMPdist keys( %N)) ) {
    printf "  %-*s  %5d", $maxD, $_, $N{$_};
    printf "%4s %s\n", "", join( " ", sort( keys( %{$D_arch{$_}})));
  }
  print "\n";
}

if ( $debug & $showRevSP ) {
  print "# List: ServicePacks sorted newest to oldest (revSP: $#revSP)\n";
  foreach my $i ( 0 .. $#revSP ) {
    print "[$i]  $revSP[$i]\n";
  }
  print "\n";
}

if ( $debug & $showPbyEpD ) {
  print "# Table: packages by edition per distribution\n";

  printf "%-*s ", $maxP, "";
  foreach ( sort( CMPdist keys( %N)) ) {
    printf "%-*s ", $maxS, abbrev( $_);
  }
  print "\n";

  foreach my $p ( sort( keys( %P_edition2dists)) ) {
    printf "%-*s ", $maxP, $p;
    foreach my $d ( sort( CMPdist keys( %N)) ) {
      if ( exists( $D_pkg2eas{$d}{$p} ) ) {
        $_ = join( ", ", @{$D_pkg2eas{$d}{$p}});
      } else {
        $_ = "-";
      }
      printf "%-*s ", $maxS, $_;
    }
    print "\n";
  }
  print "\n";
}

if ( $debug & $showDbyEpP ) {
  print "# Table: distributions by edition per package\n";

  printf "%-*s ", $maxD, "";
  foreach my $p ( sort( keys( %P_edition2dists)) ) {
    printf "%-*s ", $maxP, $p;
  }
  print "\n";
  foreach my $d ( sort( CMPdist keys( %N)) ) {
    printf "%-*s ", $maxD, $d;
    foreach my $p ( sort( keys( %P_edition2dists)) ) {
        if ( exists( $D_pkg2eas{$d}{$p} ) ) {
        $_ = join( ", ", @{$D_pkg2eas{$d}{$p}});
      } else {
        $_ = "-";
      }
      printf "%-*s ", $maxP, $_;
    }
    print "\n";
  }
  print "\n";
}

if ( $debug & $showFQPoD ) {
  print "# List: fully-qualified packages (name-edition.arch) with origin\n";
  # with all dists they're on...
  foreach my $f ( sort( CMPfqp keys( %P_full2dists)) ) {
    printf "%-*s %s\n", $maxF, $f, abbrev( join( ", ", @{$P_full2dists{$f}}));
  }
  print "\n";
}

#
# and now for something completely different...
#
if ( 1 ) {
  my (%I, %O, $total);
  my $bestM = 0;
  my $firstM = $#revSP;
  my $lastM = 0;

  if ( -r $inspect ) {
    open( IN, "< $inspect") || Die( "open: $inspect: $!\n");
  } else {
    my $qf = q/%{NAME}-%|EPOCH?{%{EPOCH}:}:{}|%{VERSION}-%{RELEASE}.%{ARCH}/;
    $qf .= q/\t%{BUILDTIME} "%{VENDOR}"\n/;
    open( IN, "rpm -qa --qf '$QF\n' | sort |") || Die( "open: rpm: $!\n");
    if ( $inspect ) {
      if ( open( OUT, "> $inspect") ) {
        while ( <IN> ) {
          print OUT;
        }
        close( OUT);
        open( IN, "< $inspect") || Die( "reopen: $inspect: $!\n");
      } else {
        warn( "create: $inspect: $!\n");
      }
    }
  }

  $atomizeD{"Unknown"} = [ ("\376", "", "", "\376", "", "", -1.0) ];
  foreach my $d ( @revSP ) {
    $I{$d} = $O{$d} = 0;
  }

  while ( <IN> ) {
    next if ( /^\#/ );

    chomp;
    my ($n, $v, $r, $a, $btime, $vendor) =
      m($QP)xo;
    if ( !defined($n) ) {
      warn( "Ignoring distorted package data for\n  $_\n");
      next;
    }

    # ignore notorical trouble-makers  # FixMe: better record in %Ignored ...
    if ( $n =~ m($ignoreRE)o ) {
      push @{ $Matched{"Ignored"}}, "$n-$v-$r.$a";
      next;
    }
    $total++;

    $_ = "$n-$v-$r.$a";
    $btime ||= 0;
    $vendor ||= "undef";
    $Installed .= sprintf( "  %-*s  ", $maxF, $_);
    if ( exists( $P_full2dists{$_}) ) {
      foreach my $d ( @{ $P_full2dists{$_} }) {
        $I{$d}++;
	push @{ $Matched{$d}}, "$_";
      }
      $Installed .= abbrev( join( ", ", @{$P_full2dists{$_}}));
    } else {
      $I{"Unknown"}++;
      print "$_\n" if $debug & $showMax;
      $Installed .= "unknown";
      push @{ $Matched{"Unknown"}}, "$n-$v-$r.$a";
    }

    foreach my $i ( 0 .. $#revSP ) {
      my $SP = $revSP[$i];
      if ( exists( $D_pa2editions{$SP}{"$n.$a"}) ) {
	# don't match all versions! Only the last (==newest).
	my $e = $D_pa2edition{$SP}{"$n.$a"};
	if ( "$v-$r" eq $e ) {
	  last;
	}
	if ( $vendor =~ m($Vendors)o &&
	     ( CMPeditions("$v-$r",$e) > 0 ||
	       $btime > $P_dnea2btime{"$SP $n-$e.$a"}) ) {
	  print STDERR "UPDATE: $n-$v-$r for $SP($e)\n" if $debug & 0x80;
	  push @{ $Updated{$SP}}, "$n  $v-$r > $e";
	  #push @{ $Updated{$SP}}, "$n-$v-$r.$a";
	  $Installed .= " up4($SP)?";
	  next; #last;
	}
	push @{ $V_sp{$SP} }, "$n  $v-$r < $e";
	#push @{ $V_sp{$SP} }, "$n-$e";
	#push @{ $V_sp{$SP} }, "$n-$e  (found $v-$r)";
	push @V, $_ unless ( $#V >= 0 && $V[$#V] eq $_ );
      } elsif ( exists( $D_pkg2ea{$SP}{"$n"}) ) {
	# track 'arch'-transition (bi-arch)?
	my $ea = $D_pkg2ea{$SP}{"$n"};
	print STDERR "v-r=$v-$r ea=$ea btime=$btime P_dnea2btime{$SP $n-$ea}=",
	   $P_dnea2btime{"$SP $n-$ea"}, "\n" if $debug & 1 && $n eq "strace";
	if ( defined( $vendor) &&
	     $vendor =~ m($Vendors)o &&
	     ( CMPeditions("$v-$r",$ea) > 0 ||
	       $btime > $P_dnea2btime{"$SP $n-$ea"}) ) {
	  print STDERR "UPDATE: $n-$v-$r for $SP($ea)\n" if $debug & 0x80;
	  push @{ $Updated{$SP}}, "$n  $v-$r.$a > $ea";
	  #push @{ $Updated{$SP}}, "$n-$v-$r.$a";
	  $Installed .= " Xup4($SP)?";
	  next; #last;
	}
	push @{ $V_sp{$SP} }, "$n  $v-$r.$a < $ea";
	#push @{ $V_sp{$SP} }, "$n-$ea";
	#push @{ $V_sp{$SP} }, "$n-$ea  (found $n-$v-$r.$a)";
	push @V, $_ unless ( $#V >= 0 && $V[$#V] eq $_ );
      }
    }
    $Installed .= "\n";
  }
  close( IN);

  # remove duplicates in %V_sp
  foreach my $d ( sort( CMPdist keys( %V_sp)) ) {
    my $p = "";
    my @t = ();
    $Offend{$d} = ();
    foreach ( @{$V_sp{$d}} ) {
      dPrint( 4, "push Offend{$d} <= $_\n");
      push @{ $Offend{$d} }, $_;
      push @t, $_ unless $_ eq $p;
      $p = $_;
    }
    @{$V_sp{$d}} = @t;
    $O{$d} = $#t + 1;
  }
  dPrint( 4, "1: bestM=[$bestM] %s f/lM=$firstM/$lastM\n",$revSP[$bestM]);
  # determine $firstM, $lastM, and $bestM
  for my $i ( 0 .. $#revSP ) {
    my $SP = $revSP[$i];
    if ( $considerEverySP || $#{ $Matched{$SP} } >= 0 ) {
      $firstM = $i unless ( $firstM < $i );
      $lastM = $i unless ( $lastM > $i );
      $bestM = $i + 1 if ( $O{$SP} > 0 )
    } elsif ( $bestM == $i ) {
      $bestM++;
    }
    dPrint( 4, ".. %-*s: m=%d/%d c=%d F=$firstM L=$lastM B=$bestM\n",
	    $maxD, $SP, $#{ $Matched{$SP} }, $I{$SP}, $O{$SP});
  }
  dPrint( 4, "2: bestM=[$bestM] %s f/lM=$firstM/$lastM\n",
	  ($bestM <= $#revSP) ? $revSP[$bestM] : "<none>");
  # fix $bestM
  if ( $bestM > $#revSP ) {
    $bestM = -1;
  }
  while ( $bestM >= 0 && $I{$revSP[$bestM]} <= 0 ) {
    dPrint( 4, ".. bestM=[$bestM]=%d / %d\n",
	    $#{ $Matched{$revSP[$bestM]} }, $I{$revSP[$bestM]});
    # having no conflict is meaningless, if there's also no match
    if ( $bestM < $#revSP ) {
      $bestM++;
    } else {
      $bestM = -1;
    }
  }
  dPrint( 1, "bestM=[$bestM] %s f/lM=$firstM/$lastM\n",
	  ($bestM < 0) ? "<none>" : $revSP[$bestM]);


  #
  # display results
  #
  if ( $verbose & 32 ) {
    print "\nInstalled packages with origin:\n$Installed\n\n";
  }

  if ( $bestM < 0 || $verbose & 2 ) {
    printf "\n%-*s   %s\n", $maxD, "Summary", "(using $total packages)";
    printf "%-*s  %11s  %11s  %6s %14s\n", $maxD, "Product/ServicePack", 
       "conflict", "match", "update", "(shipped)";
    foreach my $SP ( sort( CMPdist keys( %I)) ) {
      my ($sI, $sO, $sU, $sD, $t) = ("", "", "", "", 0);
      $sI = sPrint( $I{$SP}, $I{$SP}*100/$total);
      if ( exists( $N{$SP}) && $N{$SP} > 0) {
	my ($i, $o, $u, $n) = ($I{$SP}, $O{$SP}, $#{$Updated{$SP}}+1, $N{$SP});
	next if ( ! $considerEverySP && (
		    ($i <= 0 && !($verbose & 32) ) ||
		    ($i <= 0 && $o <= 0 && $u <= 0 && !($verbose & 128))) );
	$sO = sPrint( $o, $o*100/$n);
	$sU = sprintf( "%d", $u);
	$sD = "(" . sPrint( $n, $i*100/$n) . ")";
      }
      printf "%-*s  %11s  %11s  %6s %14s\n", $maxD, $SP, $sO, $sI, $sU, $sD;
      next unless ( $considerEverySP || $I{$SP} > 0 || $verbose & 64 );
      my ($pM, $pO, $pU) = ( "  = ", "  - ", "  + ");
      $pM = "    " if ( $SP eq "Unknown" );
      jPrint( $pO, @{$Offend{$SP}})  if ( $verbose & 4 );
      jPrint( $pU, @{$Updated{$SP}}) if ( $verbose & 8 );
      jPrint( $pM, @{$Matched{$SP}}) if ( $verbose & 16 );
    }
    if ( $verbose & 128 ) {
      my ($SP, $sI, $sO, $sU, $sD, $t) = ("Ignored", "", "", "", "", 0);
      $t = $#{$Matched{$SP}} + 1;
      $sI = sPrint( $t, $t*100/$total);
      printf "%-*s  %11s  %11s  %6s %14s\n", $maxD, $SP, $sO, $sI, $sU, $sD;
      jPrint( "    ", @{$Matched{$SP}});
    }
    $_  = "\n";
    $_ .= " Legend for Package Details: \n" if ($verbose >= 4);
    $_ .= "  -  conflicting package (found < expected)\n" if ($verbose & 4);
    $_ .= "  =  matched package\n" if ($verbose & 16);
    $_ .= "  +  updated package (found > expected)\n" if ($verbose &  8);
    print $_;
  }

  my $ret = 1;
  if ( $bestM > $#revSP ) {
    $_ = "No ServicePack completely installed!";
    $_ .= "\n(unexpected this is...)"
      if ($verbose > 1);
  } elsif ( $bestM < 0 ) {
    $_ = "No supported Product/ServicePack found at all!";
    $_ .= "\n(at least one conflict has been detected everywhere)"
      if ($verbose > 1);
  } else {
    $_  = "System is" . (($bestM == 0) ? " " : " NOT ") . "up-to-date!\n";
    $_ .= "  found    " . $revSP[$bestM];
    # MaintenanceWeb  | official | security
    $_ .= " + \"online updates\"" if ($#{$Updated{$revSP[$bestM]}} >= 0);
    $_ .= "\n";
    $_ .= "  expected " . $revSP[0] . "\n" unless ($bestM == 0);
    $ret = ( $bestM == 0 ) ? 0 : 1;
  }
  print "\nCONCLUSION: $_\n" if ( $verbose );
  exit ( $ret );
}

__END__

=head1 NAME

SPident - Try to Identify Service Pack Level

=head1 SYNOPSIS

SPident [options] [file]

 Options:
   -v --verbose         increase verbosity
   -q --quiet           decrease verbosity
   -o --once            account each package-edition only once
   -s --skip            skip SPs without a matching package
   -h --help            brief help message
      --man             full documentation
   -V --version         display version

=head1 DESCRIPTION

This program queries the C<rpm> database and matches each installed
package against all known Products/Service Packs ('SP' for short).
The newest SP, which is not violated by any out-of-date package is
announced as being "installed".

If an optional I<file> is given that does not exists,
it will be created to collect the sample-data,
e.g. for off-line inspection.
If it does exist, it is consequently used instead of the
current system's package-database.
The filename has to conform to F<arch.description>.

=head1 OPTIONS

=over 8

=item B<--verbose>

Increase level of verbosity starting from the default 1.

=item B<--quiet>

Decrease level of verbosity.

=item B<--once>

Account packages only for oldest SP, even if they appear on more than one SP
with identical version and release numbers.

=item B<--skip>

Ignore SPs without any installed package
(i.e. revert to the previous behavior.)

=item B<--help>

Print a brief help message and exit.

=item B<--man>

Print the manual page and exit.

=item B<--version>

Print the version information and exit.

=back

=head1 STATISTICS

Each installed package is counted against every SP
where it produces a I<match> (except when using C<--once>)
or the first (from newest to oldest)
where it is considered an I<update>.
A I<match> in a newer SP is B<not> counted as an
I<update> for older SPs, even if that (or intermediate SPs)
are disregarded because of a I<conflict>.
I<Conflicts> in turn are repeatedly counted until a
I<match> or an I<update> is found.

=head1 DIAGNOSTICS

The latest B<known> Service Pack yields exit status 0,
if found to be installed.
Otherwise 1 is returned, unless an error occured, which gives 2.

In other words, only the newest known Service Pack is considered a
success.

=head1 LIMITATIONS

A reliable detection of "unauthorized" updates is currently not possible.

A low number of matches with a high number of conflicts for an individual
Service Pack does not necessarily
indicate, that this Service Pack is improperly installed --
it may very well be not installed at all.

=begin :comment

=head1 TODO

=over

=item *

limit output to 10 (maybe 20) "important" packages on low verbosity levels

=item *

...

=back

=end :comment

=head1 COPYRIGHT

2004 SuSE Linux AG, Nuernberg, Germany.

=cut
