#!/usr/bin/perl -w
# vim: set et ts=8 sts=4 sw=4 ai si:
#
#  sam - Supportability Analysis Module
#
#  Copyright (c) 2008, 2009, 2010 SuSE Linux Products GmbH, Nuernberg, Germany
#
#  Authors: David Sterba <dsterba@suse.cz>
#
#           Olaf Dabrunz <od@suse.de>
#           (based on 'sammi' by 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
#
# Notes:
#
# RPM epoch is not used at SUSE/Novell and elsewhere, as it is sticky
# (every version upgrade of any distribution's version of this package must
# contain the latest epoch value) and also not visible to the user. SAM still
# is aware of the epoch.
#
# Extensions for SELinux, ACLs, capabilities and others need to be added when
# they are supported by both the SUSE Linux kernel and the SUSE version of RPM.
#

use strict;
use warnings;
use POSIX qw(strftime WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG);
# handle HUP INT PIPE TERM ABRT QUIT with die, so the END block is executed
# which unlinks temporary files
use sigtrap qw(die untrapped normal-signals ABRT QUIT);
use File::Find;
use File::Path qw(mkpath);
use File::Temp qw(tempdir);
use File::Basename qw(basename dirname);
use File::Spec qw(canonpath);
use Cwd qw(abs_path);

use satsolver;
use XML::Simple;

use Data::Dumper;
use Carp;

my $progname            = $0; $progname =~ s/^.*\///;
my $progspcs            = ' 'x(length($progname));
my $invocation_cmd_line = join (' ', $progname, @ARGV);

my $prog_version        = '0.8.5';

# temporary directories
my $defaulttmp          = '/tmp';
my $tmpsubdir;
my $tmpsubdirtemplate;
my $tmpdir              = $ENV{'TMPDIR'} // $defaulttmp;
my $tmpsubdirprefix     = $progname;
my $pubring             = 'pubring';
my $sigfile             = 'sigfile';
my $signedfile          = 'signedfile';
my $reftempdir          = 'temp';
my $refsolvdir          = 'solv';
my $refkeysdir          = 'keys';

my $rm_command          = '/bin/rm';
my $tar_command         = '/bin/tar';
my $cp_command          = '/bin/cp -f';
my $repo2solv_command   = '/usr/bin/repo2solv.sh';
my $rpm_command         = '/bin/rpm';
my $gpg_exe             = '/usr/bin/gpg';
my $gpg_command         = "$gpg_exe --no-default-keyring --keyring $pubring " .
                          '--trust-model always --batch <&-';
# remove temp files in the end (but not if the program ends before temp dir
# name is known)
END {
    if (defined $tmpsubdir) {
        system("$rm_command -rf -- $tmpsubdir");
    }
}

my $sam_packages        = 'suse-sam suse-sam-data perl-satsolver satsolver-tools';
my %sam_version         = ();

$ENV{'LC_ALL'} = 'C';
delete $ENV{'LANG'};

my $root_dir            = '/';
my $reference_datadir   = '/usr/share/suse-sam';
my $products_dir        = '/etc/products.d';
my %prodinfo            = ();
my $num_our_products    = 0;
my $baseproduct;
my $skippedrepos        = 0;
my $needrefresh         = 0;

# caches -- for development and debugging
my $sam_cache           = 'sam-cache.d';
my $rpm_qa_cache        = "$sam_cache/rpm-qa";
my $rpm_Vv_cache        = "$sam_cache/rpm-Vv";
my $rpm_ql_cache        = "$sam_cache/rpm-ql";
my $rpm_e_cache         = "$sam_cache/rpm-e";
my $cache_file_version  = '0.8';

# repositories -- for gpg keys and inst source information
my $solvfilename        = 'solv';   # for all repo schemas

# config values for different repo setup schemas
my $repo_schema = 'zypper';
my %repo_config = (
    'zypper' => {
        # private vars
        'zypp_conf'       => $ENV{'ZYPP_CONF'} // '/etc/zypp/zypp.conf', # libzypp
        'def_zypp_cache'  => '/var/cache/zypp',
        # interface
        'get_conf'        => \&get_zypper_repo_conf,    # setup paths
        'repos_dir'       => undef,
        'keys_dir'        => undef,
        'solv_dir'        => undef
    },
    'studio' => {
        # interface
        'get_conf'     => \&get_studio_repo_conf,
        'repos_dir'    => undef,    # not used in this schema
        'keys_dir'     => undef,
        'solv_dir'     => undef
    },
    'none' => {
        'get_conf'  => sub { },
        'repos_dir' => $reference_datadir,
        'keys_dir'  => "$reference_datadir/keys",
        'solv_dir'  => $reference_datadir
    }
);

my %archtable;
my %repoinfo            = ();
my $allowed_codestreams = '';

# installed package information
my %packinfo            = ();
my %foreigninfo         = ();
my %skipped_packages    = ();

my $num_sig_ok_packs    = 0;
my $num_prod_ok_packs   = 0;

# package signing keys
my %good_key_ids        = ();

# key: product-sp
# value: number of packages
my %spreport            = ();

# usage: $corepkgs->{$prod}->${pkg}
# value: list of SP numbers for which the package is a core package
# (all packages from corepkg lists)
my $corepkgs;
# usage: $corepkg_max->{$prod}->{$pkg}
# value: max SP number for which the package is core (-1 if none)
# (only installed packages)
my $corepkg_max;
# key: product
# value: max SP number for which there is a core package installed
my $max_corepkg_sp;
# key: product
# value: array of packages which are core for latest SP and are present
#        in sufficient version for this SP
my $corepkg_out_new;
# key: product
# value: array of packages which are core for latest SP and installed
#        but not in sufficient version for this SP
my $corepkg_out_old;
# result of "mixed SP" test (0 OK, >0 failed)
my $mixed_sp = 0;

# --------------------------------------------------------------------------
# data for verfication step
my %inodes;
my %file2rpm;
my %file2kind;  # to be moved to $packinfo{$pack}->{'file'}->{$file}->{'kind'}
use constant { FT_FILE => 0, FT_DIR => 1, FT_LINK => 2, FT_SPECIAL => 3 };
my %file2type;  # to be moved to ...
my %file2res;   # to be moved to ...
my %unsatisfied;
my %foreign_unsatisfied;
my %depends_on_foreign; # key: our package, value: array of dep foreign packages

my %newer_exists = ();  # key: pkg, value: array: [reponumber]=evr

my @file_modified;
my @file_tolerated;
my @file_missing;
my @file_dispensable;

my @foreign_file_modified;
my @foreign_file_tolerated;
my @foreign_file_missing;
my @foreign_file_dispensable;

my %unsupportable;  # key: rpm name, value: array of files
my %tolerable;      # dtto
my %harmless;       # dtto

my %repo_to_refresh;

# --------------------------------------------------------------------------
# cached data for summary
my $summary_nvra;
my $summary_orphaned;
my $summary_modif;
my $summary_unsatdeps;
my $summary_updates;

my @report; # save report output and prepend it to html report
my @xs; # xml tag stack

# --------------------------------------------------------------------------
# SAM configuration, defaults are set in main
my $ALLOW_MULTIHOMED_OBJECTS = 0;
my $opt_header_sig_check;
my $opt_rpm_verify;
my $opt_orphan_search;
my $opt_rpm_verify_md5;
my $opt_print_pkg_summary;
my $opt_log_commands;
my $opt_strict_repo_description;
my $opt_spreport;

my $debug               = 0;
my $debug_to_log        = 1;
# levels:
# 0 - batch run
# 1 - more interactive
# 2 - not so important
# 3 - annoying messages
my $opt_verbose;

my $opt_repo_freshness_limit = 7; # days

# command line override of various directories used, from command line
my %opt_dirs;   # key: dir type, value: path
my @opt_exp;    # list of experimental options

my $opt_use_all_products = 0;
my $opt_skip_unmatched_prod = 0;
my $sysarch;
my $opt_sysarch;

# hex encoding of RPM header prefix used when creating/verifying the header
# signature
my $headerprefix        = '8eade80100000000';

# regex for codestream schema
my $codestream_schema   = qr{^obs://([^/]+)/([^/]+)/([^/]+)}i;

# --------------------------------------------------------------------------
# statistics
my $time_of_start = time;
my ($sum_all_inodes, $sum_all_fsize, $sum_pkg_inodes, $sum_pkg_fsize) = (0, 0, 0, 0);

# --------------------------------------------------------------------------
# development only
sub Dbg {
    return unless $debug;
    if ($debug_to_log) {
        Log(join(' ','DB:',@_,"\n"));
    } else {
        print STDERR "\033[31;2m" if(-t STDERR);
        print STDERR "DB: @_\n";
        print STDERR "\033[0m" if(-t STDERR);
    }
}

# Log information to a file, extending information displayed directly
# - "%T" in the message are replaced with a timestamp.
sub Log($@) {
    my ($msg, @args) = @_;
    if($msg =~ /\%T/) {
	my $timestamp = strftime('%Y-%m-%d %H:%M:%S', gmtime(time));
	$msg =~ s/\%T/$timestamp/g;
    }
    $msg = sprintf($msg, @args) if(@args);
    print(LOG $msg);
    return $msg;
}

# Logger of executed commands and output
sub LogCmd {
    return if !$opt_log_commands;
    print LOG @_;
}

# Information displayed directly on screen
sub Report($@) {
    my ($fmt,@args)=@_;
    my $msg = Log($fmt, @args);
    print($msg);
    print(REPORT $msg);
    push @report,$msg;
}
# Xml output
sub x_out($) {
    print(XML @_);
}

# ---------------------------------------------------------------------------
# Exit the program with an error return value and an optional message.
# - pass errorcode and printf format string
#
# error code classes:
# 1 - external command failed
# 2 - internal check failed
sub Die($$@) {
    my ($error_code, $format, @args) = @_;

    if (defined $format) {
        my $msg = sprintf($format, @args);
        Log("FATAL: $msg");
        print(STDERR "FATAL: $msg");
	carp($msg) if $debug;
    }

    exit($error_code);
}

#
# html output helpers

sub showhidebutton($) {
    my ($element) = @_;
    my $showbutton = <<EOT;
<a id="but_$element" href="#" onclick="return showhide('but_$element','$element');">[hide]</a>
EOT
}

# print package information as HTML
sub init_html() {
    print HTML <<EOT
<html><head>
<title>sam support status</title>
<script>
function showhide(button,id) {
    var but=document.getElementById(button);
    var el=document.getElementById(id);
    if(but.innerHTML.match(/show/)) {
        el.style.display='';
        but.innerHTML='[hide]';
    } else {
        el.style.display='none';
        but.innerHTML='[show]';
    }
    return false;
}
</script>
</head>
<body>
EOT
}
sub init_html_table {
    my ($tabid) = @_;
    print HTML <<EOT
    <table id="$tabid" cellspacing=0 border=1>
      <thead>
        <th>Name</th><th>Version</th><th>Supported</th>
          <th>Status</th><th>Details</th>
      </thead>
      <tbody>
EOT
}

sub finish_html() {
    print HTML <<EOT
  </body>
</html>
EOT
}

sub print_html_package($@) {
    my ($pkg, @res) = @_;
    my ($supp, $ver) = ('no');
    my %notes;

    if($res[0] eq 'foreign_pkg') {
        $ver = $foreigninfo{$pkg}->{'evr'};
        my $a = 'vendor: '. $foreigninfo{$pkg}->{'vendor'} .'<br>codestream: '. $foreigninfo{$pkg}->{'disturl'};
        if(is_foreign_codestream($foreigninfo{$pkg}->{'disturl'})) {
            $notes{'foreign codestream'} = $a;
        } else {
            $notes{'foreign vendor'} = $a;
        }
    } elsif ($res[0] eq 'ok') {
        $ver = $packinfo{$pkg}->{'evr'};
        $supp = 'yes';
    } else {
        $ver = $packinfo{$pkg}->{'evr'};
        if(grep(/update/,@res)) {
            my @vers;
            map { push @vers, $_ if(!grep(/\Q$_/,@vers)) } grep {defined} @{$newer_exists{$pkg}};
            $notes{'update needed'} = join('<br>',@vers);
        }
        if(grep(/foreign_deps/,@res)) {
            $notes{'foreign dependencies'} = join('<br>', @{$depends_on_foreign{$pkg}});
        }
        if(grep(/file_mods/,@res)) {
            map { $notes{'file modifications'} .= "$_: ". pretty_print_result($_,''). '<br>' }
                @{$unsupportable{$pkg}};
        }
        if(grep(/unsat_deps/,@res)) {
            $notes{'unsatisfied dependencies'} = join('<br>', split(/, /, $unsatisfied{$pkg}));
        }
    }
    my $rowspan = scalar(keys %notes) > 1 ? 'rowspan="'. scalar(keys %notes).'"' : '';
    print(HTML "<tr>");
    print(HTML "<td valign='top' $rowspan><b>$pkg</b></td>");
    print(HTML "<td valign='top' align='right' $rowspan >$ver</td>");
    print(HTML "<td valign='top' $rowspan>$supp</td>");
    my $first=1;
    foreach(keys %notes) {
        print(HTML "<tr>") unless $first;
        print(HTML "<td valign='top'>$_</td>\n");
        print(HTML "<td valign='top'>$notes{$_}</td>\n");
        print(HTML "</tr>\n");
        $first=0;
    }
}

sub print_package_table($$\@) {
    my ($tabid, $title, $pkglist) = @_;

    print(HTML "$title ");
    print(HTML showhidebutton($tabid));
    init_html_table($tabid);
    my %seen = (); # use unique list
    for my $pkg (sort grep { !$seen{$_}++ } @$pkglist) {
        my @res=();
        push @res, 'foreign_pkg', if (exists $foreigninfo{$pkg});
        push @res, 'unsat_deps' if (exists $unsatisfied{$pkg});
        push @res, 'file_mods' if (exists $unsupportable{$pkg});
        push @res, 'foreign_deps' if (exists $depends_on_foreign{$pkg});
        push @res, 'update' if (exists $newer_exists{$pkg});
        push @res, 'ok' if (!@res);
        print_html_package($pkg, @res);
    }
    print(HTML "</tbody></table><br>");
}

sub print_package($@) {
    my ($pkg, @res) = @_;
    my ($supp, $ver) = ('no');
    my %notes;
    my $s;

    if($res[0] eq 'foreign_pkg') {
        $ver = $foreigninfo{$pkg}->{'evr'};
        my $a = 'vendor: '. $foreigninfo{$pkg}->{'vendor'} .'<br>codestream: '. $foreigninfo{$pkg}->{'disturl'};
        if(is_foreign_codestream($foreigninfo{$pkg}->{'disturl'})) {
            $notes{'foreign codestream'} = $a;
        } else {
            $notes{'foreign vendor'} = $a;
        }
    } elsif ($res[0] eq 'ok') {
        $ver = $packinfo{$pkg}->{'evr'};
        $supp = 'yes';
    } else {
        $ver = $packinfo{$pkg}->{'evr'};
        if(grep(/update/,@res)) {
            my @vers;
            map { push @vers, $_ if(!grep(/\Q$_/,@vers)) } grep {defined} @{$newer_exists{$pkg}};
            $notes{'update needed'} = join('<br>',@vers);
        }
        if(grep(/foreign_deps/,@res)) {
            $notes{'foreign dependencies'} = join('<br>', @{$depends_on_foreign{$pkg}});
        }
        if(grep(/file_mods/,@res)) {
            map { $notes{'file modifications'} .= "$_: ". pretty_print_result($_,''). '<br>' }
                @{$unsupportable{$pkg}};
        }
        if(grep(/unsat_deps/,@res)) {
            $notes{'unsatisfied dependencies'} = join('<br>', split(/, /, $unsatisfied{$pkg}));
        }
    }
    my $rowspan = scalar(keys %notes) > 1 ? 'rowspan="'. scalar(keys %notes).'"' : '';
    $s=$pkg;
    my $first=1;
    foreach(keys %notes) {
        $s=$s." ($_)";
        #$s=$s.$notes{$_}. ;	#FIXME how to show details?
        $first=0;
    }
    return $s;
}

my $xsp=2;

# return 2 column aligned table strings
# IN: key/value list or hash
sub fmt_table2 {
    my ($pfix, @rest) = @_;
    my $left = 0;
    for(my $i=0;$i<@rest;$i+=2) {
        $left=length($rest[$i]) if(length($rest[$i]) > $left);
    }
    my @out;
    for(my $i=0;$i<@rest;$i+=2) {
        my $l=$rest[$i];
        my $r=$rest[$i+1] // '';
        push @out,$pfix . "$l  " . ' 'x($left - length($l)) . "$r\n";
    }
    return join('',@out);
}
sub x_list {
    my @rest = @_;
    for(my $i=0;$i<@rest;$i+=2) {
        my $l=$rest[$i];
        $l =~ s/:$//;
        $l =~ s/\s/-/g;
        $l = lc($l);
        $l = clean_tag($l);
        my $r=$rest[$i+1] // '';
        x_out(' 'x($xsp*scalar(@xs)) . "<$l>" . x_quote($r) . "</$l>\n");
    }
}

# IN: attribute hash, attr name
sub attr_fmt($$) {
    my ($h,$a)=@_;
    return exists $h->{$a} ? " $a=\"" . $h->{$a} . '"' : '';
}
sub clean_tag($) {
    my ($tag)=@_;
    $tag =~ s/\//-/g;
    $tag =~ s/[()]//g;
    return $tag;
}

# quoted tag
sub x_t {
    my ($tag, $cont)=@_;
    $tag=clean_tag($tag);
    x_out(' 'x($xsp*scalar(@xs)) . "<$tag>" . x_quote($cont) . "</$tag>\n");
}
# unquoted tag
sub x_tnq {
    my ($tag, $cont)=@_;
    $tag=clean_tag($tag);
    x_out(' 'x($xsp*scalar(@xs)) . "<$tag>$cont</$tag>\n");
}
# attributed tag start
sub x_ts {
    my ($tag, $attr)=@_;
    my $s='';
    $tag=clean_tag($tag);
    foreach(keys %$attr) {
        $s .= attr_fmt($attr, $_);
    }
    x_out(' 'x($xsp*scalar(@xs)) . "<$tag$s>\n");
    push @xs, $tag;
}
# last tag end
sub x_te {
    my $t=pop @xs;
    x_out(' 'x($xsp*scalar(@xs)) . "</$t>\n");
}
# xml qoute
sub x_quote {
    my @a=split(/[&]/, join('',@_));
    foreach(@a) {
        s/</\&lt;/g;
        s/>/\&gt;/g;
        s/'/\&apos;/g;
        s/"/\&quot;/g;
    }
    return join('&amp;',@a);
}
sub x_cleantext {
    my ($_)=@_;
    s/\n/ /gm;
    s/^\s+-?\s*//;
    s/\s+/ /g;
    s/\s+$//;
    s/:$/./;
    return $_;
}

# ---------------------------------------------------------------------------
# check if installed satsolver contains required stuff
sub check_satsolver {
    my %needed_methods = (
        'Pool'      =>  ['providers'],
        'Repo'      =>  ['solvables'],
        'Solvable'  =>  ['compare', 'identical'],
    );

    foreach my $subpack (keys %needed_methods) {
        foreach my $sym (@{$needed_methods{$subpack}}) {
            if (!(defined $satsolver::{"${subpack}::"}->{$sym} or
                    defined $satsolver::{$sym})) {
                Die(2, "installed satsolver is missing symbol: ${subpack}::${sym}\n");
            }
        }
    }
}

# ---------------------------------------------------------------------------
# Read the version of the installed SAM packages
#
sub get_installed_sam_version() {
    my $sam_packages_re='(?:' . join('|',split(/\s+/,$sam_packages)).')';
    my $rpm_q = "$rpm_command -q --qf " .
        "'%{NAME}  %|EPOCH?{%{EPOCH}:}:{}|%{VERSION}-%{RELEASE}\n' " .
        "$sam_packages";

    LogCmd("+$rpm_q\n");
    open(FH, "$rpm_q |") || Die(1, "rpm -q: $!\n");
    while (<FH>) {
        chomp;
        if (/^(\S+)  (\S+)$/) {
	    $sam_version{$1} = $2;
	} elsif (/\s+($sam_packages_re)\s+is not installed/o) {
	    $sam_version{$1} = '(not installed)';
        } else {
            Log("    rpm -q: unexpected query response: '$_'\n");
	}

    }
    close(FH);
}

# Create reference data: convert tarballs to solv-files
# -  if reference data are found, create a repo structure and create solv files
sub create_reference_data() {
    Log("  using reference data from '$reference_datadir':\n");
    x_ts('reference-data');
    x_out("<pre>\n");

    # solv -> repoinfo
    if (-d "$reference_datadir/solv") {
        foreach my $path (sort(glob("$reference_datadir/solv/*"))) {
            my $subdir = basename($path);
            if (-d $path) {
                if (-f "$path/solv") {
                    Log("    $subdir (solv)\n");
                    x_out("$subdir (solv)\n");
                    $repoinfo{$subdir} = {
                        name     => $subdir,
                        repo_id  => $subdir,
                        subdir   => $subdir,
                        solvfile => "$path/solv",
                        reference_data => 1
                        # or not if supplied from non-default dir?
                        # FIXME: ... may be confusing
                    };
                } else {
                    Dbg("solv file not present in subdir '$subdir'");
                }
            } else {
                Dbg("non dir found under solv, skip: $subdir");
            }
        }
    }

    mkdir("$refsolvdir", 0700) || Die(1, "mkdir $refsolvdir: $!\n");
    mkdir("$refkeysdir", 0700) || Die(1, "mkdir $refkeysdir: $!\n");

    # metadata -> solv -> repoinfo
    if (-d "$reference_datadir/raw") {
        foreach my $path (sort(glob("$reference_datadir/raw/*"))) {
            my $subdir = basename($path);
            if (-d $path) {
                if (exists $repoinfo{$subdir}) {
                    Dbg("repo generated from solv file already, $_");
                    next;
                }
                my $solvfile = "$refsolvdir/$subdir/$solvfilename";
                mkdir("$refsolvdir/$subdir", 0700) || Die(1, "mkdir $refsolvdir/$subdir: $!\n");

                if ($opt_header_sig_check) {
                    # save gpg keys for later
                    my @gpg_files = glob("$path/*.{key,asc}");
                    if (@gpg_files) {
                        my $cmd = "$cp_command -- " . join(' ', @gpg_files) . " $refkeysdir";
                        System($cmd);
                    }
                }

                System("$repo2solv_command $path > $solvfile");

                Log("    $subdir (metadata)\n");
                x_out("$subdir (metadata)\n");
                $repoinfo{$subdir} = {
                    name     => $subdir,
                    repo_id  => $subdir,
                    subdir   => $subdir,
                    solvfile => $solvfile,
                    reference_data => 1
                };
            }
        }
    }

    # tar -> metadata -> solv -> repoinfo
    my %compr_flags = ( '.gz' => 'z', '.bz2' => 'j', '' => '');
    foreach my $tarfile (sort(glob("$reference_datadir/*.tar{,.gz,.bz2}"))) {
        $tarfile        =~ /^.*\/([^\/]*)\.tar(|\.gz|\.bz2)$/;
        my $subdir      = $1;
        my $compr_flag  = $compr_flags{$2};
        my $sp_version;

        if (exists $repoinfo{$subdir}) {
            Dbg("repo generated already, $_");
            next;
        }

        mkdir("$refsolvdir/$subdir", 0700) || Die(1, "mkdir $refsolvdir/$subdir: $!\n");
        mkdir("$reftempdir", 0700)         || Die(1, "mkdir $reftempdir: $!\n");

        my $cmd = "$tar_command xC${compr_flag}f $reftempdir $tarfile";
        System($cmd);

        if ($opt_header_sig_check) {
            # save gpg keys for later
            my @gpg_files = glob("$reftempdir/*.{key,asc}");
            if (@gpg_files) {
                $cmd = "$cp_command -- " . join(' ', @gpg_files) . " $refkeysdir";
                System($cmd);
            }
        }

        my $solvfile = "$refsolvdir/$subdir/$solvfilename";

        $cmd = "$repo2solv_command $reftempdir > $solvfile";
        System($cmd);

        # WORKAROUND
        # grab SP_VERSION here from reference data
        if (open(F, "<$reftempdir/content")) {
            foreach(<F>) {
                if(/^SP_VERSION\s+(\d+)/) {
                    $sp_version = $1;
                    close(F);
                    last;
                }
            }
        }

        $cmd = "$rm_command -rf -- $reftempdir";
        System($cmd);

        Log("    $subdir (tar)\n");
        x_out("$subdir (tar)\n");
        $repoinfo{$subdir} = {
            name            => $subdir,
            repo_id         => $subdir,
            subdir          => $subdir,
            solvfile        => $solvfile,
            reference_data  => 1
        };
        if (defined $sp_version) {
            $repoinfo{$subdir}->{'sp_version'} = $sp_version;
        }
    }
    if (!scalar(keys %repoinfo)) {
	Log("  no reference repository files found under '$reference_datadir'\n");
	x_out("no reference repository files found under '$reference_datadir'\n");
    }
    x_out("</pre>\n");
    x_te();
}


# Load lists of core packages
sub load_corepkg_lists()
{
    foreach my $corefile (sort(glob($reference_datadir . "/corepkgs/*"))) {
        my ($prod, $sp, $arch);
        if (! -f $corefile) { next; }
        open(FH, "gunzip -c '$corefile' |");
        if (!($prod = <FH>) || !($sp = <FH>) || !($arch = <FH>)) {
            Die(1, "unexpected end of file in $corefile");
        }
        chomp($prod);
        chomp($sp);

        my $pkg;
        while ($pkg = <FH>) {
            chomp($pkg);
            if (exists($corepkgs->{$prod})) {
                push(@{$corepkgs->{$prod}->{$pkg}}, $sp);
            } else {
                $corepkgs->{$prod} = {$pkg => [$sp]};
            }
        }
    }
}


# SUSE/Novell vendors of supported packages
my $Vendors = join('|',(
    'SuSE GmbH', 'SuSE AG', 'SuSE Linux AG', 'SUSE LINUX Products GmbH',
    'UnitedLinux LLC', 'Novell'));

# Collect from products.d:
#   - list of installed products
#   - list of "codestreams" aka "Build Service repositories" that are used as
#     package sources for the installed products
#
sub get_products() {
    my %codestreams = ();
    my $products_d = File::Spec->catdir($root_dir, $products_dir);

    if (not opendir(PD, $products_d)) {
        Die(1, "unable to open product directory '$products_d': $!\nPlease make sure you installed package(s) describing product(s), eg. sles-release.\n");
    } else {
        foreach my $file (readdir(PD)) {
            next    if $file !~ /^(?:baseproduct|.*\.prod)$/;
            my $path = "$products_d/$file";

            if ($file eq 'baseproduct') {
                $baseproduct = readlink($path);
                $baseproduct =~ s/^$products_d\/*//;
                next;
            }

            if (not -f $path) {
                Log("  skipping: not a regular file: $path\n");
                next;
            } elsif (not -r $path) {
                Log("  skipping: not readable: $path\n");
                next;
            }

            # XML::Simple is required to read prod files
            my $info = eval { XMLin($path, ForceArray => qr/^repository$/); };
            if ($@) {
                Die(2, "  error parsing product xml file \"$path\": $@\n");
                next;
            }

            $prodinfo{$file} = $info;

            if (defined $info->{'patchlevel'}) {
                $info->{'sp_version'} = $info->{'patchlevel'};
            }

            if (defined $info->{'vendor'} and $info->{'vendor'} =~ /^$Vendors/o) {
                $num_our_products++;
                if ( defined $info->{'register'} and
                    defined $info->{'register'}->{'repositories'} and
                    defined $info->{'register'}->{'repositories'}->{'repository'} ) {
                    foreach my $codestream (@{$info->{'register'}->{'repositories'}->{'repository'}}) {
                        if (defined $codestream->{'path'} and
                            $codestream->{'path'} =~ /$codestream_schema/o) {
                            push @{$prodinfo{$file}->{'allowed_codestreams'}},
                                $codestream->{'path'};
                            $codestreams{$codestream->{'path'}} = $file;
                            if($codestream->{'path'} =~ /:Update(?=\/)/) {
                                # additional Update:Test channel
                                $codestreams{"$`$&:Test$'"} = $file;
                            }
                        }
                    }
                    # PTF is a generally allowed codestream for SLE
                    $codestreams{'obs://build.suse.de/PTF:\d+/PTF'} = '(default)';
                }
            } else {
                Log(" skipping third-party product from vendor: %s\n", $info->{'vendor'} // '(unknown)');
            }
        }
        # regex from the list of codestreams allowed by installed SUSE/Novell products
        if(scalar(%codestreams)) {
            $allowed_codestreams = '(?:' . join('|', map(clean_codestream($_), (sort keys %codestreams))) . ')';
        } else {
            $allowed_codestreams = '(none)';
        }
        Log("  allowed codestreams:\n    %s\n", join("\n    ", sort keys %codestreams));
        x_ts('allowed-codestreams');
        foreach(sort keys %codestreams) {
            x_t('codestream', $_);
        }
        x_te();
    }
}

sub get_repo_conf() {
    $repo_config{$repo_schema}->{'get_conf'}->();
}
sub get_zypper_repo_conf() {
    my $rc = $repo_config{'zypper'};
    my $zypp_conf = $rc->{'zypp_conf'};
    my ($repos_dir, $solv_dir, $keys_dir);
    my $cachedir;

    $zypp_conf =~ /^(.*)\//;
    my $zypp_confdir = $1;

    if (!open(CONF, '<', "$root_dir/$zypp_conf")) {
        x_tnq('warning', "Unable to open zypper config <quote>". x_quote("$root_dir/$zypp_conf")."</quote>");
        Log("  unable to open zypper config '$root_dir/$zypp_conf', using defaults: $!\n");
    } else {
        # get reposdir (fallback) and solvfilesdir from zypp.conf
        while (<CONF>) {
            $cachedir  = $1, next if /^\s*cachedir\s*=\s*(\S+)\s*$/;
            $repos_dir = $1, next if /^\s*reposdir\s*=\s*(\S+)\s*$/;
            # metadatadir not used directly, but keys are stored there
            $keys_dir  = $1, next if /^\s*metadatadir\s*=\s*(\S+)\s*$/;
            $solv_dir  = $1, next if /^\s*solvfilesdir\s*=\s*(\S+)\s*$/;
        }
        close(CONF);
    }

    $cachedir = File::Spec->canonpath($rc->{'def_zypp_cache'}) if(!defined $cachedir);
    $repos_dir = "$zypp_confdir/repos.d" if(!defined $repos_dir);
    $keys_dir = "$cachedir/raw" if(!defined $keys_dir);
    $solv_dir = "$cachedir/solv" if(!defined $solv_dir);

    $rc->{'repos_dir'} = File::Spec->catdir($root_dir, $repos_dir);
    $rc->{'keys_dir'} = File::Spec->catdir($root_dir, $keys_dir);
    $rc->{'solv_dir'} = File::Spec->catdir($root_dir, $solv_dir);
}
sub get_studio_repo_conf() {
    my $rc = $repo_config{'studio'};

    for('repos','solv','keys') {
        Die(2, "studio-scheme: '$_' not specified on command line via --dir") if(!defined $opt_dirs{$_});
    }

    $rc->{'repos_dir'} = File::Spec->catdir($root_dir, $opt_dirs{'repos'});
    $rc->{'solv_dir'} = File::Spec->catdir($root_dir, $opt_dirs{'solv'});
    $rc->{'keys_dir'} = File::Spec->catdir($root_dir, $opt_dirs{'keys'});
}

#
# Read (product) information from the repositories
#
# Examples:
#
# name          SUSE-Linux-Enterprise-Server 11.0-0     SUSE-Linux-Enterprise-SDK-x86_64 11.0-0
# label         SUSE Linux Enterprise Server 11         SUSE Linux Enterprise Software Development Kit 11
# dist          SUSE_SLE                                SUSE_SDK
# product       SUSE_SLES -- match against installed product file
# version       11                                      11
# sp_version    0                                       (none)
#
my @required_fields     = ('name', 'label',
                           'distribution:distproduct', 'version:distversion');
my @all_required_fields = ();
foreach my $field (@required_fields) {
    push @all_required_fields, split(/:/, $field);
}

# read repos from pre-configured directories of current "schema"
sub get_repo_infos () {
    Log("  Repositories:\n");   # section defined earlier
    my $rc = $repo_config{$repo_schema};

    foreach my $repofile (sort (glob($rc->{'repos_dir'}."/*.repo"))) {
        if (!open(REPO, "<$repofile")) {
            Log("  skip repo, unable to open repo file '$repofile': $!\n");
            x_tnq('warning', "Skip repo, unable to open file <quote>".x_quote($repofile)."</quote>");
            $skippedrepos++;
        } else {
            # get entries from this *.repo file
            # we need reposubdir, name, and type
            #
            # Note: it does not matter whether the repo is enabled, we only
            # want to know whether it has packages identical or comparable to
            # installed ones, so that the packages in the repo might have been
            # a source for the installed packages
            my $repo_id;
            while (<REPO>) {
                $repo_id    = $1, last    if /^\s*\[(.*)\]\s*$/;
            }
            if (defined $repo_id) {
                my $subdir = $repo_id;
                $subdir =~ tr/\//_/;

		# hash key might be created in creat_reference_data()
                my $unique_suffix = '';
                $unique_suffix++ while (exists $repoinfo{$subdir . $unique_suffix});

                $repoinfo{$subdir . $unique_suffix} = {
                    repo_id     => $repo_id,
                    subdir      => $subdir,
                    solvfile    => $rc->{'solv_dir'}."/$subdir/$solvfilename",
                };

                $subdir = $subdir . $unique_suffix;
                # read all key=value lines from the file
                while (<REPO>) {
                    $repoinfo{$subdir}->{$1} = $2, next     if /^\s*(\w+)\s*=\s*(.+)\s*$/;
                    $repo_id = $1, next                     if /^\s*\[(.*)\]\s*$/;
                }
                close(REPO);
            } else {
                Log("  skip repo without repo id in '$repofile'\n");
                x_tnq('warning', "Skip repo without repo id in <quote>".x_quote($repofile)."</quote>");
                $skippedrepos++;
            }
        }
    }

    # skip repos without solv file
    foreach my $subdir (keys %repoinfo) {
        my $repo_ref = $repoinfo{$subdir};
        if (! -r $repo_ref->{'solvfile'}) {
            x_ts('warning');
            x_t('message', "Skip repo without solv file");
            x_t('name', $repo_ref->{'name'} // '(none)');
            x_t('solvfile', $repo_ref->{'solvfile'} // '(none)');
            x_te();
            Log("  skip repo '%s', no solv file found (refresh needed?):\n" .
                   "    solvfile: %s\n",
                $repo_ref->{'name'} // '(none)',
                $repo_ref->{'solvfile'} // '(none)'
            );
            delete $repoinfo{$subdir};
            $skippedrepos++;
        }
    }

    # set up default value for service pack
    foreach my $subdir (keys %repoinfo) {
        $repoinfo{$subdir}->{'sp_version'} //= 0;
    }

    # TODO: get solv file mod time and evaluate repository:timestamp and
    # repository:expire, and maybe consider evaluating the autorefresh tag
    # - get repo : timestamp field
    # - need to add perl binding for dumping repo data (satsolver 0.14+)

    # get label, dist, version, sp_version and others for repository
    foreach my $subdir (keys %repoinfo) {
        my $repo_ref = $repoinfo{$subdir};

        # create pool
        my $pool = new satsolver::Pool;

        # set architecture: only compatible packages are considered
        $pool->set_arch($sysarch);

        my $repo = $pool->create_repo($subdir) || Die(2, "satsolver: create_repo($subdir)\n");
        $repo->add_solv($repo_ref->{'solvfile'});
        # FIXME: define precedence
        # repository:timestamp - unused
        #my $repo_ts = get_repo_ts($repo_ref->{'solvfile'}, $repo);
        # file timestamp from cookie or stat
        my $solv_ts = $repo_ref->{'solv_ts'} = get_solv_ts($repo_ref->{'solvfile'});

        # find the "product:" solvable(s)
        foreach my $solvable ($repo->solvables()) {
            Die(2, "solvable not defined\n") if(!defined $solvable);

            # FIXME: find multiple products via "product:" and/or via
            # $prodinfo{...}->{release_{product_name,evr,arch}};
            # print all products found in the repo

            if ($solvable->name() =~ /^product:(.*)/i) {
                my $prod_ref;
                my $product_name = $1 // '(UNKNOWN)';
                $repo_ref->{'num_products'}++;
                if ($repo_ref->{'num_products'} > 1) {
                    # infos for product #2 and higher are stored under a
                    # "product#" key
                    $prod_ref = $repo_ref->{'product' . $repo_ref->{'num_products'}};
                } else {
                    $prod_ref = $repo_ref;
                }
                $prod_ref->{'product'}      = $product_name;
                $prod_ref->{'arch'}         = $solvable->attr('solvable:arch');
                $prod_ref->{'label'}        = $solvable->attr('solvable:summary');
                $prod_ref->{'distribution'} = $solvable->attr('solvable:distribution');
                $prod_ref->{'distproduct'}  = $solvable->attr('product:distproduct');
                $prod_ref->{'distversion'}  = $solvable->attr('product:distversion');
                if ($solvable->attr_exists('solvable:evr')) {
                    if ($solvable->attr('solvable:evr') =~ /^(\d+)(?:-(\d+))?$/) {
                        $prod_ref->{'version'} = $1;
                        $prod_ref->{'release'} = $2 // 0;
                    } else {
                        $prod_ref->{'version'} = 11;
                        $prod_ref->{'release'} = 0;
                    }
                }

                # newer satsolver-tools provide this
                if ($solvable->attr_exists('solvable:sp_version')) {
                    $prod_ref->{'sp_version'} = $solvable->attr('solvable:sp_version');
                } else {
                    $prod_ref->{'sp_version'} //= 0;
                }
            }
        }
    }

    # check for required fields, delete repo if fields are missing
    foreach my $subdir (keys %repoinfo) {
        my $repo_ref = $repoinfo{$subdir};
        my $deleted = 0;

        if(!$opt_strict_repo_description) {
            map { $repo_ref->{$_} //= '(undef)' } @all_required_fields;
        } else {
            foreach my $field_list (@required_fields) {
                my $found = 0;
                my $tries = 0;
                foreach my $field (split(/:/, $field_list)) {
                    $tries++;
                    $found = 1 if (defined $repo_ref->{$field});
                }
                if (!$found) {
                    my @a;
                    map { push @a, $_, defined $repo_ref->{$_} ? $repo_ref->{$_}.':' : '(undef)' } @all_required_fields;

                    Log("  skip repo '$subdir', undefined field%s '%s':\n",
                        $tries > 1 ? 's' : '',
                        join("' or '", split(/:/, $field_list)));
                    Log(fmt_table2('    ', @a));

                    x_ts('warning');
                    x_t('message', 'Skip repo with missing field');
                    x_ts('fields');
                    for(my $i=0;$i<=$#a;$i+=2) {
                        x_t('name', $a[$i]);
                        x_t('value', $a[$i+1]);
                    }
                    x_te();
                    x_te();

                    delete $repoinfo{$subdir};
                    $skippedrepos++;
                    $deleted=1;
                    last;
                }
            }
        }

        # skip product repos with defined and incompatible arches
        # not all repos have architecture, but solver will handle that
        if(!$deleted && defined($repo_ref->{'arch'}) && !is_compatible_arch($sysarch, $repo_ref->{'arch'})) {
            Log("  skip repo '$subdir', incompatible arch %s\n", $repo_ref->{'arch'});
            x_ts('warning');
            x_t('message', 'Skip repo, incompatible arch');
            x_t('name', $subdir);
            x_t('arch', $repo_ref->{'arch'});
            x_te();
            delete $repoinfo{$subdir};
            $skippedrepos++;
            next;
        }
    }

    # skip repositories for other than installed products, based on
    # 'product' key (not 'distribution')
    if (!$opt_use_all_products) {
        foreach my $repo (keys %repoinfo) {
            my $repo_ref = $repoinfo{$repo};
            my $found = 0;
            foreach my $prod (keys %prodinfo) {
                my $prod_ref = $prodinfo{$prod};
                if ($repo_ref->{'product'} eq $prod_ref->{'name'}) {
                    $found = 1;
                    last;
                }
            }
            if(!$found) {
                Log("  skip repo '%s', product '%s' not installed (use --use_all_products to use it)\n",
                    $repo_ref->{'name'}, $repo_ref->{'product'}, $repo_ref->{'sp_version'});
                x_ts('warning');
                x_t('message', "Skip repo, product not installed");
                x_t('name', $repo_ref->{'name'});
                x_t('product', $repo_ref->{'product'});
                x_te();
                delete $repoinfo{$repo};
                $skippedrepos++;
            }
        }
    }

    # delete repos for other than installed products (if desired)
    # offer older and current SP repos
    if ($opt_skip_unmatched_prod) {
        foreach my $repo (keys %repoinfo) {
            my $repo_ref = $repoinfo{$repo};
            my $found = 0;
            foreach my $prod (keys %prodinfo) {
                my $prod_ref = $prodinfo{$prod};
                if ($repo_ref->{'distribution'} eq $prod_ref->{'installconfig'}->{'distribution'}
                        && $repo_ref->{'sp_version'} <= $prod_ref->{'sp_version'}) {
                    $found = 1;
                    last;
                }
            }
            if(!$found) {
                Log("  skip repo '%s', product '%s' not installed or servicepack level '%d' too new\n",
                    $repo_ref->{'name'}, $repo_ref->{'distribution'}, $repo_ref->{'sp_version'});
                x_ts('warning');
                x_t('message', "Skip repo, product not installed");
                x_t('name', $repo_ref->{'name'});
                x_t('product', $repo_ref->{'distribution'});
                x_te();
                delete $repoinfo{$repo};
                $skippedrepos++;
            }
        }
    }

    # make duplicate names and labels unique
    foreach my $subdir (keys %repoinfo) {
        my $repo_ref = $repoinfo{$subdir};

        my $name            = $repo_ref->{'name'};
        my $label           = $repo_ref->{'label'};
        my $next_name_cnt   = 2;
        my $next_label_cnt  = 2;
        foreach my $subdir2 (keys %repoinfo) {
            next        if ($subdir eq $subdir2);

            if ($name eq $repoinfo{$subdir2}->{'name'}) {
                $repoinfo{$subdir2}->{'name'} = "$name (" . ($next_name_cnt++) . ')';
            }
            if ($label eq $repoinfo{$subdir2}->{'label'}) {
                $repoinfo{$subdir2}->{'label'} = "$label (" . ($next_label_cnt++) . ')';
            }
        }
        $repo_ref->{'name'}  = "$name (1)"     if $next_name_cnt > 2;
        $repo_ref->{'label'} = "$label (1)"    if $next_label_cnt > 2;
    }

    foreach my $subdir (keys %repoinfo) {
        # skip RO media repos, currently cd
        if(exists $repoinfo{$subdir}->{'baseurl'} && $repoinfo{$subdir}->{'baseurl'} =~ /^cd:\/\//) {
            Dbg("skip $subdir for refresh");
            next;
        }
        if(repo_too_old($repoinfo{$subdir}->{'solv_ts'})) {
            Log("  repository '$subdir' seems to be old, please refresh\n");
            x_ts('warning');
            x_t('message', 'Repository seems to be old, please refresh');
            x_t('name', $subdir);
            x_te();
            $needrefresh++;
            $repo_to_refresh{$subdir}=$repoinfo{$subdir};
            $repo_to_refresh{$subdir}->{'refresh_reason'}='not updated recently';
        }
    }


    # assign number and print found repos
    my $cnt = 0;
    foreach my $subdir (repo_keys_sorted(keys %repoinfo)) {
        my $repo_ref = $repoinfo{$subdir};
        $repo_ref->{'number'}   = ++$cnt;

        my @a;
        push @a, 'name:',$repo_ref->{'name'}; 
        push @a, 'label:',$repo_ref->{'label'}; 
        push @a, 'distribution:',$repo_ref->{'distribution'}; 
        push @a, 'reference_data:', $repo_ref->{'reference_data'} ? "yes" : "no";

        Log("  found repository #%d:\n", $repo_ref->{'number'});
        Log(fmt_table2('    ', @a));

        x_ts('repository');
        x_t('name', $repo_ref->{'name'});
        x_t('label', $repo_ref->{'label'});
        x_t('distribution', $repo_ref->{'distribution'});
        x_t('reference_data', $repo_ref->{'reference_data'} ? "yes" : "no");
        x_te();
    }
}

sub get_sysarch {
    if(defined $opt_sysarch) {
        # forced by user
        $sysarch = $opt_sysarch;
    } else {
        # arch from baseproduct
        if (exists $prodinfo{$baseproduct}) {
            $sysarch = $prodinfo{$baseproduct}->{'arch'};
        } else {
            $sysarch = `uname -m` || Die(1, "Unable to read system architecture by 'uname -m', please specify with --sysarch option.\n");
        }
        # the rest must be compatible
        foreach (values %prodinfo) {
            my $prodarch = $_->{'arch'};
            if ($prodarch eq '(none)' or !defined $prodarch) {
                Die(2, "  Found product without architecture. Please check your installation!\n");
            }
            if(!is_compatible_arch($sysarch, $prodarch)) {
                Die(2, "Architectures for installed products incompatible (sys: $sysarch, found: $prodarch), please specify with --sysarch option.\n");
            }
        }
    }
}

# ---------------------------------------------------------------------------
# Setting up a keyring with SUSE/Novell build keys
#

# SUSE/Novell build key of supported packages
# FIXME: what about 3rd party packages? get some trusted repo of keys?
my $Buildkeys = join('|', (
   'SuSE Package Signing Key',
   'SUSE PTF Signing Key',
   'SuSE Security Team',
   'Novell Provo Build',
   'Open Enterprise Server',
   'Novell Bangalore BuildService',
   'build@novell.com'
));

# SUSE/Novell repository content file labels for supported installation sources
my $Labels = qr/(?:SUSE|Novell)/;

# parse key data from gpg output
sub setup_key () {
    my $cmd;
    my ($key_id_string, $date, $pub_comment, $pub_line);

    # only consider *.key and *.asc files
    return if not /\.(?:key|asc)$/i;

    # find public keys and check comment string against SUSE/Novell vendor strings
    $cmd = "$gpg_command \"$File::Find::name\"";
    LogCmd("+$cmd\n");
    open(FH, "$cmd 2>&1 |") || Die(1, "$cmd: failed to execute: $!\n");
    while (<FH>) {
        chomp;
        if (/^pub\s+(\S+)\s+(\S+)\s+(.*)$/) {
            ($key_id_string, $date, $pub_comment) = ($1, $2, $3);
            $pub_line = $_;
        }
        LogCmd("  $_\n");
    }
    close(FH);

    if (!defined $pub_comment) {
        LogCmd("  gpg: not a public key file: $File::Find::name\n");
    } elsif ($pub_comment =~ /^$Buildkeys/o) {
        if (!defined $good_key_ids{$key_id_string}) {
            LogCmd("  gpg: using SUSE/Novell public key file:\n       $File::Find::name\n       $pub_line\n");
            $good_key_ids{$key_id_string} = $pub_line;

            $cmd = "$gpg_command --import \"$File::Find::name\"";
            System($cmd);
        } else {
            LogCmd("  gpg: already imported SUSE/Novell public key file:\n       $File::Find::name\n       $pub_line\n");
        }
    } else {
        LogCmd("  gpg: not using foreign public key file:\n       $File::Find::name\n       $pub_line\n");
    }
}

# ---------------------------------------------------------------------------
# Is the package from us?
#
sub is_our_package ($$$$$) {
    my ($rsaheadersig, $dsaheadersig, $rpmheader, $package_name, $vendor) = @_;
    my $headersig;
    my $cmd;
    my $is_ours = 0;

    # user asked to skip sig check or
    # no SUSE/Novell keys we could use for checking?
    if (not $opt_header_sig_check or scalar (keys %good_key_ids) == 0) {
	#Dbg("no checksig and no keys, match vendorname only");
        # cannot check, so fall back to the vendor string in the RPM DB and
        # continue anyway, hoping for the best

        $num_sig_ok_packs++;
        return $vendor =~ /^$Vendors/o;
    }

    # does the RPM DB have a signature for the header?
    # use RSAHEADER (more hash bits) if available, or fall back to DSAHEADER
    $headersig = ($rsaheadersig =~ /\(none\)/) ? $dsaheadersig : $rsaheadersig;
    if ($headersig =~ /\(none\)/) {
        # cannot check, prepare log message
        if ($vendor =~ /^$Vendors/o) {
            # if one of 'our' packages had no signature (should not happen),
            # if it is a "foreign" package without signature
            Log("  no header signature but looks like our package: $package_name\n    vendor: $vendor\n");
	} else {
            Log("  no header signature, not our package: $package_name\n    vendor: $vendor\n");
	}
        # we have keys to verify signatures, but this package has no signature:
        # not ours
        return 0;
    }

    # convert hex strings to binary
    my $rpmheader_bin = pack('H*H*', $headerprefix, $rpmheader);
    my $headersig_bin = pack('H*', $headersig);

    # save RPM header and signature
    open(FH, ">$signedfile") || Die(1, "open($signedfile): $!\n");
    print(FH $rpmheader_bin);
    close(FH);
    open(FH, ">$sigfile") || Die(1, "open($sigfile): $!\n");
    print(FH $headersig_bin);
    close(FH);

    # check the signature of the RPM header with our selected keys
    $cmd = "$gpg_command --verify $sigfile $signedfile";
    open(FH, "$cmd 2>&1 |") || Die(1, "command failed: $cmd: $!\n");
    while (<FH>) {
        chomp;
        if (/^gpg:\s*Good\s+signature/i) {
            LogCmd("  $_: $package_name: $vendor\n");
            $is_ours = 1;

            # warn if VENDOR does not look ok
            if ($vendor !~ /^$Vendors/o) {
                Log("  header signature ok, wrong vendor for: $package_name $vendor\n");
            }
        } elsif (/^gpg:\s*(?:Can't|Cannot)\s+check\s+signature/i) {
            LogCmd("  $_: $package_name: $vendor\n");
        }
    }
    close(FH);

    $num_sig_ok_packs += $is_ours;

    return $is_ours;
}

# ---------------------------------------------------------------------------
# Check if the package match the installed products (matching codestream)
sub matches_installed_products ($) {
    my ($disturl) = @_;
    my $matches_installed_products = 0;

    # does "codestream" part of disturl match codestreams from installed
    # SUSE/Novell prod files?
    # schema: obs://build.suse.de/SUSE:SLE-11:GA/standard
    # reduced to: obs://build.suse.de/SUSE:SLE-11
    $matches_installed_products = 1 if (!is_foreign_codestream($disturl));

    $num_prod_ok_packs += $matches_installed_products;

    return $matches_installed_products;
}


# return pretty-printed result
sub pretty_print_result($) {
    my ($file, $modstr) = @_;
    my ($pretty, $result);

    my %pretty_print_result = (
        'S' => 'size',
        'M' => 'mode',
        '5' => 'checksum',
        'D' => 'device-node',
        'L' => 'sym-link',
        'U' => 'owner',
        'G' => 'group',
        'T' => 'mod-time',
        '?' => 'cannot-read',
    );

    $result = $file2res{$file};
    if (!defined $result) {
        Dbg("undefined file result for $file");
        return 'UNKNOWN';
    }

    $modstr = 'mod: ' unless defined $modstr;
    $_ = $result;
    if (/^(U|T)\:miss\s+(.):(?:\s+(.*))?$/) {
        # type, kind, (details1), details2
        $pretty = 'missing';
        $pretty .= ' config' if($2 eq 'c');
        $pretty .= ' docs' if($2 eq 'd');
        $pretty .= " $3" if(defined $3);
        $pretty .= ' (tolerable)' if($1 eq 'T');
    } elsif (/^(U|T)\:mod (?:.):([SM5?DLUGT]+)(?: (?:.*)|)$/) {
        # type, (kind), summary, (rest)
        my @l = map( $pretty_print_result{$_}, split(//, $2));
        $pretty = ($1 eq 'U' ? $modstr : 'tolerable: ') . join(' ', @l);
    } else {
        # internal logic error, unsupported modification expected but
        # not matched (probably O:OK found)
        Die(2, "$progname: internal error. File $file with bad result $result\n");
    }
    return $pretty;
}

#
# Create pretty-printed string for a size in bytes
#
sub pretty_print_size($) {
    my ($n) = @_;

    my ($f, $p);
    my @P = ('M', 'G', 'T');

    if ($n < 0) {
        return sprintf('%3d kB??', $n);
    } elsif ( $n < 1000 ) {
        return sprintf('%3d kB', $n);
    }

    while ($n > 999) {
        $p = shift(@P);
        $f = $n % 1024;
        $n = $n >> 10;
    }

    if ($n > 9) {
        return sprintf('%3d %sB', $n, $p);
    }

    $f = int(($f * 10 ) / 1024);
    return sprintf('%d.%d %sB', $n, $f, $p);
}

#
# Execute program and die on errors with appropriate message
# Program output is logged at log level 2
# Also logs the command at log level 8
#
sub System ($) {
    my ($cmd) = @_;
    my @C = split(/ /, $cmd);

    LogCmd("+$cmd\n");

    # open a pipe to catch output as well
    open(FH, "$cmd 2>&1 |") || Die(1, "$C[0]: failed to execute: $!\n");
    LogCmd("  $_") while (<FH>);
    close(FH);

    if (WIFSIGNALED($?)) {
        Die(1, "$C[0]: died with signal %d, %s coredump\n",
                (WTERMSIG($?)),  ($? & 128) ? 'with' : 'without');
    } elsif (WEXITSTATUS($?) != 0) {
        Die(1, "$C[0]: failed with error code %d\n", WEXITSTATUS($?));
    }
}

# ---------------------------------------------------------------------------
# Find files that do not belong to any RPM package
#
# TODO: handle exclusion of directories
#

my @orphans = ('undef');
my %dirpath2devinode;
my %dircontents;

sub find_orphans($) {
    our ($rootdir) = @_;
    our ($rootlen, $rootdev, $ignoredir);
    # based on 'airbag,v 1.2 2001/10/02 15:04:30'
    # created by Torsten Duwe
    # modified by Raymund Will

    # "find" of additional files; more precisely files and directories that
    # do not come from installed RPMs.

    # We take a fsck-like approach: %dirpath2devinode holds a [dev:inode]
    # pair for given directory path(s) and %dircontents stores the
    # directory content's names, as if they had been received via
    # opendir() and readdir().

    # First we fill the %dirpath2devinode / %dircontents cache with
    # list info from "rpm -qal", then we do a "find /" and report all new
    # files and dirs encountered, pruning dirs, of course. A few
    # well-known candidates are suppressed, for convenience.

    # subroutine pathhash: make sure [dev:inode] pair for this path is
    # known as well as those of all of its parents. Argument is a path
    # string.
    sub pathhash($);
    sub pathhash($){
        my($path) = @_;
        my($dev,$ino,$mode,@rest,$parent,$myname);

        # defensive programming: make sure our path string has exactly
        # one slash at the beginning and for subdir separation, and no
        # slash at the end.
        $path =~ s,/+,/,g;
        #$path =~ s,/$,,g;
        $path =~ s,^/,,g;
        $path = "/$path";
        Dbg("pathhash($path): -> '$path'");

        if (defined $dirpath2devinode{$path}) {
            Dbg(" => known");
            return;
        } # already known
        Dbg(" : stat\n");

        ($dev,$ino,$mode,@rest) = stat($rootdir . $path);
        if (@rest < 10) {
            Dbg("cannot stat($rootdir,$path): $!");
            return;
        }

        # if we stat()ed a directory, let's remember it.
        if (($mode & 0xf000) == 0x4000) {
            $dirpath2devinode{$path} = "$dev:$ino";
            $dircontents{"$dev:$ino"} = '' unless defined($dircontents{"$dev:$ino"});
        }

        # so this one was new. how about the parent dir ? recursion will
        # stop at "/" (provided it's the real root!), which is its own
        # parent and will be "already known" above.
        return if ($path eq '/');

        $parent = $path;
        $parent =~ s,/([^/]*)/?$,,;
        $myname = $1;

        $parent =~ s,^/,,;
        $parent = "/$parent";
        #  print(STDERR "parent='$parent' myname='$myname'   %> ");

        pathhash($parent);

        # back from recursion -- ensure this path's name is listed in
        # parent's contents.
        if ($dircontents{$dirpath2devinode{$parent}} =~ m,/\Q$myname/, ){
            #    print " already have $parent##/##$myname\n";
        } else {
            $dircontents{$dirpath2devinode{$parent}} .= "/$myname/";
            #    print " $parent##/##$myname\n";
        }
    }

    $rootlen = length($rootdir);
    $rootdev = (lstat($rootdir))[0];
    $ignoredir = 1;
    $| = 1;

    if ($> == 0 && ( -x './bin/rpm')) {
        open(FLIST, "chroot '$rootdir' ./bin/rpm -qal |") ||
        Die(1, "cannot exec 'chroot rpm -qa': $!\n");
    } else {
        open(FLIST, "/bin/rpm -qal --root '$rootdir'|") ||
        Die(1, "cannot exec 'rpm -qa': $!\n");
    }

    while(<FLIST>){
        my($dir, $fname, $inode);
        chomp;
        s,/$,,;			# doesn't ever happen, anyway.
        s,/+,/,g;
        m,^(.*/)([^/]+)$, || next;
        $dir = $1;
        $fname = $2;

        $dir =~ s,^/,,;
        $dir = "/$dir";

        next unless (-d "$rootdir$dir");
        pathhash($dir);
        $inode = $dirpath2devinode{$dir};
        $dircontents{$inode} .= "/$fname/";
    }
    close(FLIST);

    # subroutine wanted: called by the file tree walk for every node, with
    # the basename() of the current node as string argument.
    sub wanted() {
        my($dir) = '/' . substr($File::Find::dir, $rootlen) . '/';
        $dir =~ s,/+,/,g;
        Dbg("wanted: $_, dir='$dir'") if ($debug > 1);

        # omit dot and dotdot, backup files, and well-known boring paths.
        /^\.\.?$/ && return;
        /~$/ && return;

        my ($dev,$ino,$mode,$size) = (lstat)[0,1,2,7];
        $sum_all_inodes++;
        $sum_all_fsize += ($size + 512) / 1024;
        # only root device is checked
        if ($dev != $rootdev ) { $File::Find::prune = 1; return; }
        if ($File::Find::name =~ m,^/vmlinu, ) { return; }
        if ($File::Find::name =~ m,^/initrd, ) { return; }
        if ($File::Find::name =~ m,/man/whatis$, ) { return; }
        if ($File::Find::name =~ m,^/proc, ) { $File::Find::prune = 1; return; }
        if ($File::Find::name =~ m,^/root, ) { $File::Find::prune = 1; return; }
        if ($File::Find::name =~ m,^/home, ) { $File::Find::prune = 1; return; }
        if ($File::Find::name =~ m,^/tmp, ) { $File::Find::prune = 1; return; }
        #if ($File::Find::name =~ m,^/var, ) { $File::Find::prune = 1; return; }
        #if ($File::Find::name =~ m,^/usr, ) { $File::Find::prune = 1; return; }
        if ($File::Find::name =~ m,^/etc/rc\.d/rc[0-6]\.d, )
            { $File::Find::prune = 1; return; }

        # see if we know the dir we're in
        pathhash($dir);
        my $inode = $dirpath2devinode{$dir};

        # does it know about the file/dir we're examining at this invocation ?
        if ($dircontents{$inode} =~ /\/\Q$_\//) {		# yes, ok.
            Dbg("known: ($dir) $_") if ($debug > 2);
            return;
        } elsif ($dir eq '/home/httpd/icons/') {
            Dbg("UNknown: ($dir) $_") if ($debug > 2);
            Dbg("$inode=>'$dircontents{$inode}'") if ($debug > 2);
        }

        # if not, let's have a closer look.

        # we're not interested in symlinks at all.
        if (($mode & 0xf000) == 0xa000) { return;  }

        my $isdir = '';
        if (($mode & 0xf000) == 0x4000) {
            return if ($ignoredir);
            $isdir =  '/';
            # maybe we know this directory, but by another name, if
            # the installation has followed symlinks like /opt -> /usr/opt
            return if (defined $dircontents{"$dev:$ino"});
        }

        $File::Find::prune = 1;
        # the rare case of a l+f directory under a mount point. Checked here
        # because of its low probability and because we want prune=1 for it.
        return if ($isdir eq '/' && $_ eq 'lost+found' && $inode =~ /:2$/);
        #print" $File::Find::name$isdir\n";
        push @orphans, "$dir$_$isdir";
    }

    find(\&wanted, $rootdir); # Launch !
}

# ---------------------------------------------------------------------------
# Return filehandle for the list of RPMs with ancillary data.
# May use cached data or pipe directly from the rpm command.
#
sub rpm_qa($) {
    my $FH;
    my $rpmQ = "$rpm_command -qa --qf " .
        "'%{NAME}  %{VERSION}-%{RELEASE}  %|EPOCH?{%{EPOCH}:}:{}|%{VERSION}-%{RELEASE}  %{ARCH}  " .
        "%{INSTALLTIME}  %{BUILDTIME}  " .
        "%{VENDOR:shescape}  %{DISTRIBUTION:shescape}  %{DISTURL}  " .
        "%{RSAHEADER}  %{DSAHEADER}  %{HEADERIMMUTABLE}\n'";

    # Either use cache if available...
    if ( -d $sam_cache && -r $rpm_qa_cache ) {
        open($FH, "< $rpm_qa_cache") || Die(1, "open(rpm -qa): $!\n");
        $_ = <$FH>;
        if (!/^# (\S+) -- (.*)$/ ) {
            Die(2, "$progname: unknown cache format! Please remove.\n" .
                "(e.g. with 'rm -rf $sam_cache/rpm-{qa,Vv})'\n");
        } else {
            my ($wrong_vers, $wrong_root) = ($cache_file_version ne $1, $root_dir ne $2);
            if ($wrong_vers or $wrong_root) {
                Die(2, "$progname: invalid cache: %s%s%s. Please remove it.\n" .
                    "(e.g. with 'rm -rf $sam_cache/*')\n",
                      ( $wrong_vers ?  "wrong version (found $1, need $cache_file_version)" : '' ),
                      ( $wrong_vers and $wrong_root ? ' and' : '' ),
                      ( $wrong_root ? "different root dir checked (found $2, checking $root_dir)" : '' ));
            } else {
                # use this cache only when debugging -- if not, we prefer to
                # have current information
                if ($debug) {
                    return $FH;
                } else {
                    close($FH);
                }
            }
        }
    }

    LogCmd("+$rpmQ\n");
    # ... or read directly from rpm command (and recreate cache if possible)
    open($FH, "$rpmQ |") || Die(1, "rpm: $!\n");
    if (-d $sam_cache) {
        if (open(OUT, "> $rpm_qa_cache") ) {
            print OUT "# $cache_file_version -- $root_dir\n";
	    print OUT while (<$FH>);
            close(OUT);
            close($FH);

            open($FH, "< $rpm_qa_cache") || Die(1, "reopen: $rpm_qa_cache: $!\n");
            # skip version / root_dir string
            $_ = <$FH>;
            # pre-create directory for rpm_V()
            if (! -d $rpm_Vv_cache) {
                mkdir($rpm_Vv_cache) || warn "mkdir $rpm_Vv_cache: $!\n";
            }
            # pre-create directory for rpm_e()
            if (! -d $rpm_e_cache) {
                mkdir($rpm_e_cache) || warn "mkdir $rpm_e_cache: $!\n";
            }
            # rpm -ql cache
            if (! -d $rpm_ql_cache) {
                mkdir($rpm_ql_cache) || warn "mkdir $rpm_ql_cache: $!\n";
            }
        } else {
            warn("create: $rpm_qa_cache: $!\n");
        }
    }
    return $FH;
}

#
# return filehandle for the output of "rpm -V..." on a package
# may use cached data or pipe directly from the rpm command
#
sub rpm_V($) {
    my ($package) = @_;

    my $FH;
    my $cache_file = "$rpm_Vv_cache/$package";
    my $cache_list_file = "$rpm_ql_cache/$package";
    my $extraflags = '';

    my %rpm_list;
    if (-r $cache_list_file) {
        open($FH, "< $cache_list_file") || Die(1, "open($cache_list_file): $!\n");
    } else {
        open($FH, "$rpm_command -ql '$package' |") || Die(1, "rpm -ql: $!\n");
        if (-d $rpm_ql_cache) {
            open(OUT, "> $cache_list_file");
            print OUT while (<$FH>);
            close(OUT);
            close($FH);
            open($FH, "< $cache_list_file");
        }
    }
    map { my $a=$_; chomp $a; $rpm_list{$a} = undef } <$FH>;
    close($FH);

    # skip running verify flags (need chroot) for non root
    # (yes, this *is* --noscripts option for rpm)
    $extraflags .= '--noscript ' if($root_dir ne '/' && $< != 0);
    $extraflags .= '--nomd5 ' if(!$opt_rpm_verify_md5);
    # not important for supportability check
    $extraflags .= '--nouser --nomtime --nogroup';
    # --nomode catches permissions AND file type, we want to catch dir 'in place of' file

    my $rpmV = "$rpm_command -Vv $extraflags '$package' 2>&1";

    if (-r $cache_file) {
        open($FH, "< $cache_file") || Die(1, "open($cache_file): $!\n");
        LogCmd("+(cached) $rpmV\n");
        return ($FH, \%rpm_list);
    }

    LogCmd("+$rpmV\n");
    open($FH, "$rpmV |") || Die(1, "rpm -V: $!\n");
    if (-d $rpm_Vv_cache) {
        if (open(OUT, "> $cache_file")) {
	    print OUT while (<$FH>);
            close(OUT);
            close($FH);

            open($FH, "< $cache_file") || Die(1, "reopen($cache_file): $!\n");
        } else {
            warn("create: $cache_file: $!\n");
        }
    }
    return ($FH, \%rpm_list);
}

#
# return filehandle for the output of "rpm -e --test ..." on a package
# may use cached data or pipe directly from the rpm command
#
sub rpm_e($) {
    my ($package) = @_;

    my $FH;
    my $cache_file  = "$rpm_e_cache/$package";
    my $rpme        = "$rpm_command -e --test '$package' 2>&1";

    if (-r $cache_file) {
        open($FH, "< $cache_file") || Die(1, "open($cache_file): $!\n");
        LogCmd("+(cached) $rpme\n");
        return $FH;
    }

    LogCmd("+$rpme\n");
    open($FH, "$rpme |") || Die(1, "rpm -e: $!\n");
    if (-d $rpm_e_cache) {
        if (open(OUT, "> $cache_file") ) {
            print OUT while (<$FH>);
            close(OUT);
            close($FH);

            open($FH, "< $cache_file") || Die(1, "reopen($cache_file): $!\n");
        } else {
            warn("create: $cache_file: $!\n");
        }
    }
    return $FH;
}

# ---------------------------------------------------------------------------
# Assess if this file was changed in an unsupportable way. Return descriptive
# string for the supportability information based on the evaluation of the
# "rpm -V..." output for a single file from some package.
#
# assessment results:
# O:   OK               (miss/mod: no,  supportability problem: no,  report: lvl 4)
# H:   Harmless         (miss/mod: yes, supportability problem: no,  report: lvl 3)
# T:   Tolerable        (miss/mod: yes, supportability problem: no,  report: lvl 2)
# U:   Unsupportable    (miss/mod: yes, supportability problem: yes, report: lvl 1)
#
# change state of files:
#   OK      OK, no changes
#   miss    missing
#   mod     modified
#
# TODO: check report levels are well chosen and documented corrrectly
#
sub assess($$$$$) {
    my ($rpm, $file, $kind, $result, $error) = @_;
    my $summary_result = $result;
    $summary_result =~ tr/.//d;
    $error = (defined $error ? " ($error)" : '');

    if ($result =~ /^\.{8}$/) {
        # file is not modified at all: OK
        return 'O:OK';
    } elsif ($result eq 'missing ' && $kind eq 'd') {
        # missing documentation: Harmless
        return 'H:miss d:' . $error;
    } elsif ($result eq 'missing ' && $kind eq 'c') {
        # missing config file, can be a problem or not: Tolerable
        return 'T:miss c:' . $error;
    } elsif ($kind eq 'c') {
        # existing config file with any kind of changes: Harmless
        return "H:mod c:$summary_result";
    } elsif ($result eq 'missing ') {
        # missing non-documentation file: Unsupportable
        return "U:miss $kind:" . $error;

    } elsif ($result =~ /^[L.]{8}$/) {
        # symlink problem, not always unsupported, just log as tolerated
        return "T:mod $kind:$summary_result";
    } elsif ($result =~ /^[UG.]{8}$/) {
        # existing (non-config) file with ownership change only:
        # Tolerable
        return "T:mod $kind:$summary_result";
    } elsif ($result =~ /^[MUG.]{8}$/) {
        # existing (non-config) file with exactly some kind of
        # ownership change and file mode change
        # can be source of problem: report as tolerable
        return "T:mod $kind:$summary_result";
    } elsif ($result =~ /^[T.]{8}$/) {
        # existing (non-config) file with some kind of metadata
        # change that does not affect ownership or file mode (and
        # no other changes): Tolerable
        return "T:mod $kind:$summary_result";

    } else {
        # existing (non-config) file
        #   - has a change in file size
        #   - has a content change
        #   - is a device node and major/minor has changed
        #   - is a softlink that has changed
        # -> Unsupportable
        return "U:mod $kind:$summary_result";
    }
}

#
# Enumerate packages, keep info about each package, filter out unneeded (gpg keys)
sub enumerate_packages {

    sub x_issue {
        x_ts('issue', $_[3]);   # + attributes
        x_t('package', $_[0]);
        x_t('message', $_[1]);
        x_t('details', $_[2]);
        x_te();
    }

    Log("%T: Enumerate packages\n");
    x_ts('package-enumeration');
    my $IN = rpm_qa($root_dir);
    while (<$IN>) {
        chomp;
        if (!/^(\S+)  (\S+)  (\S+)  (\S+)  ([0-9]+)  ([0-9]+)  '(.*?)'  '(.*?)'  (\S+)  (\S+)  (\S+)  (\S+)$/) {
            Log("  rpm: unexpected query response: '$_'\n");
            x_ts('warning');
            x_t('message', 'RPM unexpected query response');
            x_t('response', $_);
            x_te();
            next;
        }

        my ($name, $ver, $evr, $arch, $inst_time, $build_time, $vendor, $dist,
            $disturl, $rsaheadersig, $dsaheadersig, $rpmheader) =
            ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12);
        # 'ver' is not always the same as 'evr', both access methods into hashes are possible
        # keys share the same data
        my $package_name = "$name-$ver.$arch";
        my $package_name_evr = "$name-$evr.$arch";
        $vendor //= 'undef';

        if ($arch eq '(none)' and $package_name =~ /^gpg-pubkey-/) {
            # "silently" drop verification keys
            Log("  skip key package: $package_name\n");
            x_issue($package_name, 'pubkey package', 'skipped', {severity => 'harmless'});
            $skipped_packages{$package_name} = "$inst_time $vendor";
            next;
        }

        # check for SUSE/Novell package
        my $is_ours = is_our_package($rsaheadersig, $dsaheadersig, $rpmheader, $package_name, $vendor);
        my $matches_installed_products = matches_installed_products($disturl);

        if ($arch eq '(none)' and $is_ours) {
            #if ( $vendor =~ m(^$Vendors)o ) {
            # ignore SUSE/Novell packages without architecture info
            Log("  skip package without arch: $package_name\n");
            x_issue($package_name, 'package without arch', 'skipped', {severity => 'harmless'});
            $skipped_packages{$package_name} = "$inst_time $vendor";
            next;
        }

        if (!$is_ours or !$matches_installed_products) {
            # remember packages that do not match installed products or come from
            # other vendors
            if (!$is_ours and $vendor !~ /^$Vendors/o) {
                Log("  foreign vendor package: $package_name\n    vendor: $vendor\n");
                x_issue($package_name, 'foreign vendor', $vendor, {severity => 'critical'});
            } elsif (!$matches_installed_products) {
                Log("  foreign codestream package: $package_name\n    codestream: %s\n",
                    $disturl =~ /($codestream_schema)/o ? $1 : $disturl);
                x_issue($package_name, 'foreign codestream',
                    $disturl =~ /($codestream_schema)/o ? $1 : $disturl,
                    {severity => 'critical'});
            }
            $foreigninfo{$package_name} = {
                name       => $name,
                evr        => $evr,
                ver        => $ver,
                arch       => $arch,
                inst_time  => $inst_time,
                build_time => $build_time,
                vendor     => $vendor,
                dist       => $dist,
                disturl    => $disturl,
            };
            if ($package_name ne $package_name_evr) {
                $foreigninfo{$package_name_evr} = $foreigninfo{$package_name};
            }
            next;
        }

        $packinfo{$package_name} = {
            name       => $name,
            evr        => $evr,
            ver        => $ver,
            arch       => $arch,
            inst_time  => $inst_time,
            build_time => $build_time,
            vendor     => $vendor,
            dist       => $dist,
            disturl    => $disturl,
        };
        if ($package_name ne $package_name_evr) {
            $packinfo{$package_name_evr} = $packinfo{$package_name};
        }
    }
    close($IN);
    x_te();
}

# have we seen this filename already? -> handle duplicates
# - ignore foreign packages when file is unmodified and present
sub check_and_log_duplicate_file ($) {
    my ($args) = @_;
    my $file = $args->{'file'};
    my $kind = $args->{'kind'};
    my $rpm = $args->{'rpm'};
    my $is_ours = $args->{'is_ours'};
    my $log_buffer_ref = $args->{'r_logbuf'};
    my $verify_result = $args->{'verify_result'};
    my $error = $args->{'error'};
    # verify_result + error: passed down to assess
    # is_ours: need to push $file to the correct filelist

    my $issue_msg = '';
    my $issue_sev = '';

    # FIXME:
    # this will be used later for improved multihomed file handling: file2*
    # will become $file_ref->{*}->...  (except for %file2rpm, the index)
    #my $file_ref = $packhash_ref{$rpm}->{'file'}; # unused ATM

    if ($ALLOW_MULTIHOMED_OBJECTS) {
        # if multihomed files are allowed, all the packages for such a file are
        # remembered
        push @{ $file2rpm{$file} }, $rpm;
        if (exists $file2kind{$file} && $file2kind{$file} ne $kind) {
            # FIXME: "... please report" ? or log only for higher verbosity level ?
            Log( "    $file: conflicting attributes: $file2kind{$file} != $kind, packaging problem\n");
        } else {
            $file2kind{$file} = $kind;
            #Log("$file\n") if $kind eq "d" && $verify_result eq "missing ";
        }
    } else {
        # if multihomed files are not allowed, log entries will be generated
        if (exists $file2rpm{$file}) {
            # file is multihomed
            $_ = $file2res{$file};
            $$log_buffer_ref .= ' 'x4 . "$file in more than one package:\n";
            $$log_buffer_ref .= ' 'x6 . "$file2rpm{$file}: ";
            if (/^[UTH]:miss/) {
                # a duplicate of a missing object hardly makes it worse...
                $$log_buffer_ref .= "duplicate of missing file: unsupportable\n";
                $file2res{$file} .= " && U:dup:$rpm";
                $issue_msg='duplicate of a missing file';
                $issue_sev='critical';
                if($is_ours) {
                    push @file_missing, $file;
                    push @{ $unsupportable{$rpm} }, $file;
                } else {
                    push @foreign_file_missing, $file;
                }
            } elsif (/^U:/) {
                if ($file2type{$file} == FT_DIR) {
                    # packaging directories multiple times is OK...
                    if($opt_verbose >= 3) {
                        $$log_buffer_ref .= "duplicate directory: harmless\n";
                        $issue_msg='duplicate directory';
                        $issue_sev='harmless';
                    } else {
                        # stay silent, about this, very common and not useful
                        $$log_buffer_ref = undef;
                    }
                    $file2res{$file} .= " && H:dup:$rpm";
                } else {
                    # ...but not other objects
                    $$log_buffer_ref .= "duplicate non-directory: unsupportable\n";
                    $file2res{$file} .= " && U:dup:$rpm";
                    $issue_msg='duplicate non-directory';
                    $issue_sev='critical';
                    if($is_ours) {
                        push @file_modified, $file;
                        push @{ $unsupportable{$rpm} }, $file;
                    } else {
                        push @foreign_file_modified, $file;
                    }
                }
            } elsif ($file2type{$file} == FT_DIR) {
                # again, packaging directories multiple times is OK...
                if($opt_verbose >= 3) {
                    # stay silent, about this, very common and not useful
                    $$log_buffer_ref .= "duplicate directory: harmless\n";
                    $issue_msg='duplicate directory';
                    $issue_sev='harmless';
                } else {
                    $$log_buffer_ref = undef;
                }
                $file2res{$file} .= " && H:dup:$rpm";
            } else {
                $_ = assess($rpm, $file, $kind, $verify_result, $error);
                if (!/^U:/) {
                    # ...if it verifies OK, only note
                    if($opt_verbose >= 3) {
                        $$log_buffer_ref .= "duplicate files are identical\n";
                        $issue_msg='duplicate files are identical';
                        $issue_sev='harmless';
                    } else {
                        $$log_buffer_ref = undef;
                    }
                    $file2res{$file} .= " && H:dup:$rpm";
                } else {
                    # ...otherwise promote to "Unsupportable"
                    $$log_buffer_ref .= "duplicate files differ: unsupportable\n";
                    $file2res{$file} = "$_ && U:dup:$rpm && $file2res{$file}";
                    x_issue($rpm, 'duplicate files differ', $file, {severity=>'critical'});
                    $issue_msg='duplicate files differ';
                    $issue_sev='critical';
                    if($is_ours) {
                        push @file_modified, $file;
                        push @{ $unsupportable{$file2rpm{$file}} }, $file;
                        push @{ $unsupportable{$rpm} }, $file;
                    } else {
                        push @foreign_file_modified, $file;
                    }
                }
            }
            # duplicate issues not interesting for foreign packages
            if(!$is_ours && $opt_verbose < 2) {
                $$log_buffer_ref = '';
            } else {
                x_issue($rpm, $issue_msg, $file, {severity=>$issue_sev});
            }
            return 1;
        }

        # not multihomed: record package for this file
        $file2rpm{$file} = $rpm;
        $file2kind{$file} = $kind;
    }
    return 0;
}

sub evaluate_supportability_and_record_results ($$) {
    my ($args, $assess_output) = @_;
    my $file = $args->{'file'};
    my $kind = $args->{'kind'};
    my $rpm = $args->{'rpm'};
    my $is_ours = $args->{'is_ours'};

    $file2res{$file} = $_ = $assess_output;
    if (/^U:miss/) {
        if ($is_ours) {
            push @file_missing, $file;
            push @{ $unsupportable{$rpm} }, $file;
        } else {
            push @foreign_file_missing, $file;
        }
        return;
    } elsif (/^T:miss/) {
        if ($is_ours) {
            push @file_dispensable, $file;
            push @{ $tolerable{$rpm} }, $file;
        } else {
            push @foreign_file_dispensable, $file;
        }
        return;
    } elsif (/^H:miss/) {
        if ($is_ours) {
            push @file_dispensable, $file;
            push @{ $harmless{$rpm} }, $file;
        } else {
            push @foreign_file_dispensable, $file;
        }
        return;

    } elsif (/^U/) {
        if ($is_ours) {
            push @file_modified, $file;
            push @{ $unsupportable{$rpm} }, $file;
        } else {
            push @foreign_file_modified, $file;
        }
    } elsif (/^T/) {
        if ($is_ours) {
            push @file_tolerated, $file;
            push @{ $tolerable{$rpm} }, $file;
        } else {
            push @foreign_file_tolerated, $file;
        }
    } elsif (/^H/) {
        if ($is_ours) {
            push @{ $harmless{$rpm} }, $file;
        }
    } elsif (/^O/) {
    } else {
        Die(2, "$progname: internal error. Unknown assessment output '$_'\n");
    }

    # when we see the file for the first time, add to total size of all files,
    # increase number of different files and remember type of file (file, dir,
    # link, special)
    my ($dev,$ino,$size) = (lstat($root_dir . $file))[0,1,7];
    if(!defined($dev) || !defined($ino)) {
        # a file may be missing from filesystem when installed by --excludepath
        # or --excludedocs, but is not reported as missing or broken by rpm
        return if ($assess_output eq 'O:OK');

        if ($is_ours) {
            push @file_missing, $file;
            push @{ $unsupportable{$rpm} }, $file;
        } else {
            push @foreign_file_missing, $file;
        }
	return;
    }

    if (-f _) {
        $file2type{$file} = FT_FILE;
        if (!exists $inodes{"$dev:$ino"}) {
            $sum_pkg_fsize += ($size + 512) / 1024;
        }
    } elsif (-d _) {
        $file2type{$file} = FT_DIR;
    } elsif (-l _) {
        $file2type{$file} = FT_LINK;
    } else {
        $file2type{$file} = FT_SPECIAL;
    }

    if (!exists $inodes{"$dev:$ino"}) {
        $inodes{"$dev:$ino"} = 1;
        $sum_pkg_inodes++;
    }
}

# verify installed packages state
# run 'rpm -V' command, capture output and categorize the packages
#from rpm
#
#file kinds/attributes:
#    c %config configuration file.
#    d %doc documentation file.
#    g %ghost file (i.e. the file contents are not included in the package payload).
#    l %license license file.
#    r %readme readme file.


sub verify_packages ($$$$) {
    my ($packhash_ref, $unsatisfied_ref, $msg, $is_ours) = @_;

    foreach my $rpm (sort(keys %$packhash_ref)) {
        my $log_buffer = '';
        my %args=('r_logbuf' => \$log_buffer, 'rpm' => $rpm, 'is_ours' => $is_ours);

        Log("  $msg: $rpm\n");
        my ($IN, $rpm_list) = rpm_V($rpm);
        while (<$IN>) {
            chomp;
            /^.{12}(.*)$/;
            my $fn = $1;
            if (/^([S.][M.][5?.][D.][L.][U.][G.][T.]|missing )  ([cdglr ]) (\S.+)$/) {
                if (!exists $rpm_list->{$fn}) {
                    # probably installed with --excludepath
                    Log("    $fn: verified file does not exist in rpm's file list, skip\n");
                    next;
                }
                # note: rpm(8) calls the file kind (%config, %doc, ...) an
                # "attribute" of the file
                my ($verify_result, $kind, $file, $error) = ($1, $2, $3, undef);
                if ($verify_result =~ /missing/ and $file =~ /^(\S.+) \(([^\(\)]*)\)$/) {
                    $file = $1;
                    $error = $2;
                }
                $args{'file'}=$file;
                $args{'kind'}=$kind;
                $args{'verify_result'}=$verify_result;
                $args{'error'}=$error;

                next if(check_and_log_duplicate_file(\%args));

                # is the result for the file a supportability problem? classify...
                my $assess_output = assess($rpm, $file, $kind, $verify_result, $error);
                evaluate_supportability_and_record_results(\%args, $assess_output);
            } elsif (/^Unsatisfied dependencies for ([^:]+)\: (\S.+)$/) {
                my ($pkg, $deps) = ($1, $2);
                $$unsatisfied_ref{$pkg} = $deps;
            } elsif (/should be .*\(wrong( owner\/group )?.*( permissions)?/) {
                Log("    other rpm error: $_\n");
            } else {
                next if (/^package\s+(.*)\s+is not installed$/);
		# glue next line of output
                my $nextline = <$IN>;
                $_ .= "\n$nextline" if (defined $nextline);
                Die(1, "$progname: rpm: unexpected query response:\n$_\n");
            }
        }
        close($IN);

        Log($log_buffer) if($log_buffer);
    }
}

#
# identify package sourcess and do servicepack coverage report
#
sub identify_package_sources {

    # inlines

    # IN: package, type, repo, version
    # - log the entry in xml
    # OUT: formatted string
    sub x_version {
        x_ts('repo-entry');
        x_t('package', $_[0]);
        x_t('type', $_[1]);
        x_t('repository', $_[2]);
        x_tnq('version', $_[3]);
        x_te();
        #my $sp=$repoinfo{$_[2]}->{'distribution'}.'-'.$repoinfo{$_[2]}->{'sp_version'};

        return "    $_[1] version $_[3] in repo '$_[2]'\n"; # SP: $sp\n";
    }

    # IN: reference to the hash mapping service packs to version matching results
    # OUT: array reference
    # reference to empty array - error in reference data
    # [-1, -1] - package is older than any service pack
    # [n, m] - range of service packs to which the package belongs
    sub get_min_sp($) {
        my $sps_hash_ref = shift;
        my %sps_hash = %{$sps_hash_ref};
        my @sps = sort keys %{$sps_hash_ref};
        my %cmp = ( '-' => -1, '=' => 0, '~' => 0, '+' => 1 );

        # put stops around the sequence to simplify the inner loop
        # we assume that there will never be SP9999
        unshift(@sps, '-1');
        push(@sps, '9999');
        $sps_hash{'-1'} = '-';
        $sps_hash{'9999'} = '+';

        my $first_matching = -1;
        my $last_matching = -1;
        my $first_match_found = 0;
        my $done = 0;

        # matching packages to service packs works as follows:
        # 1) we assume non-decreasing package version numbers across service
        #    packs
        # 2) exact version match (=) means that the package belongs to the SP
        #    in question and all the following SPs with exact matches
        # 3) transition from "repo has older version" (-) to "repo has newer
        #    version" (+) signifies that the package is a maintenance update
        #    released between service packs, therefore we claim it belongs to
        #    the last service pack which has the older version
        for (my $i=1; $i<scalar(@sps); $i++) {
            my $a = $sps_hash{$sps[$i]};
            my $b = $sps_hash{$sps[$i-1]};

            # check monotoneity of package versioning across all available
            # service packs, report errors
            if ($cmp{$a} < $cmp{$b}) {
                Dbg("non-monotonous package versioning\n");
                return [];
            }

            next if ($done);

            if (($a eq '=' or $a eq '~') and !$first_match_found) {
                $first_matching = $i;
                $first_match_found = 1;
            }

            if ($a eq '+') {
                if ($first_match_found) {
                    $last_matching = $i-1;
                    $done = 1;
                } else {
                    $first_matching = $i-1;
                    $last_matching = $first_matching;
                    $done = 1;
                }
            }
        }

        return [$sps[$first_matching], $sps[$last_matching]];
    }

    # IN: the stats db
    # IN: product
    # IN: sp number
    # IN: type
    sub add_sp_key($$$$) {
        my ($db, $prod, $sp, $t)=@_;
        #Dbg("add key $prod $sp $t to spstats: ".Dumper($db));
        if(!exists $db->{$prod}) {
            $db->{$prod} = {$sp => $t};
        } else {
            # check inconsistent overwrite
            if (exists $db->{$prod}->{$sp} && $db->{$prod}->{$sp} ne $t) {
                Dbg("Existing key! ".$db->{$prod}->{$sp});
                my %cmp = ( '-' => 0, '~' => 1, '=' => 2, '+' => 3);
                # if sp table has older value, upgrade
                # we are interested in highest available value
                # arches are properly filtered beforehand
                if ($cmp{ $db->{$prod}->{$sp} } < $cmp{$t}) {
                    # = ... 1
                    # - ... 0
                    Dbg("Upgrading repo value to $t from ".$db->{$prod}->{$sp});
                } else {
                    Log("Internal error (refrepo consistency problem), --spreport will not give accurate results");
                    Dbg("Repo offered older version, we do not want it");
                    Dbg("pr $prod, sp $sp, t $t");
                    Die(0, "internal error (refrepo consistency problem) t=$t: ".Dumper($db));
                }
            }
            $db->{$prod}->{$sp}=$t;
        }
    }

    # exclusive (one SP) or shared (more SPs)
    sub add_to_spreport_excl($$) {
        @{$spreport{$_[0]}->{$_[1]}}[0]++;
        @{$spreport{$_[0]}->{$_[1]}}[2]++;  # total
    }
    sub add_to_spreport_shr($$) {
        @{$spreport{$_[0]}->{$_[1]}}[1]++;
        @{$spreport{$_[0]}->{$_[1]}}[2]++;  # total
    }

    # create pool
    my $pool = new satsolver::Pool;

    # set architecture: only compatible packages are considered
    $pool->set_arch($sysarch);

    # create repo with RPM database
    my $installed = $pool->create_repo('installed') || Die(2, "satsolver: cannot create repository of installed packages\n");
    $installed->add_rpmdb($root_dir);

    x_ts('package-sources');

    # create a repo each for SUSE/Novell installation sources
    foreach my $subdir (repo_keys_sorted(keys %repoinfo)) {
        my $label = $repoinfo{$subdir}->{'label'};
        # TODO: review this check
        if($label !~ /$Labels/o) {
            Log("  skip foreign repo '$label' ($subdir)\n") if($opt_verbose >= 1);
            next;
        }

        Log("  use repo '$label' ($subdir)\n");
        x_tnq('note', 'Use repository <quote>'.x_quote($label).'</quote>, subdir <quote>'.
            x_quote($subdir).'</quote>');

        my $repo = $pool->create_repo($subdir) || Die(2, "satsolver: cannot create repository for '$subdir'\n");
        $repo->add_solv($repoinfo{$subdir}->{'solvfile'});
    }

    # create dependencies to provides table
    $pool->prepare();

    my @a=(
        '+', 'repo has newer version',
        '=', 'repo has identical name/version/vendor/arch (verbose: 1)',
        '-', 'repo has older version (verbose: 1)',
        '~', 'repo has same version and compatible build arch',
        'r', 'not found in any reference repo',
        '!', 'found in reference repo but version is lower than possible',
        'm', 'no such package in any considered repo');
    Log("  Legend:\n");
    Log(fmt_table2('    ', @a));

    x_ts('legend');
    for(my $i=0;$i<scalar(@a);$i+=2) {
        x_ts('entry');
        x_t('symbol', $a[$i]);
        x_t('meaning', $a[$i+1]);
        x_te();
    }
    x_te();

    # find providers for each installed package
    my $in_refrepo;
    my $nonref_count = 0;
    foreach my $inst_solvable ($installed->solvables()) {
        Die(2, "undefined solvable in installed repo\n") if(!defined $inst_solvable);

        my $inst_solvname   = $inst_solvable->name();
        my $inst_solvevr    = $inst_solvable->evr();
        my $inst_solvstring = $inst_solvable->string();
        my $inst_solvarch   = $inst_solvable->arch();

        # skip foreign
        next if(!exists $packinfo{$inst_solvstring});

        $in_refrepo = 0;

        # per-package sp stats
        # key: product
        #   key: sp
        #   value: array per SP split into exclusive and shared packages
        my %spstats = ();

        my %vtype = ();   # key for package/repo relation
        my ($found_id, $found_new, $found_old, $found_similar) = (0,0,0,0);
        foreach my $solvable ($pool->providers($inst_solvname)) {
            next if (!defined $solvable);

	    if ($inst_solvable->name() ne $solvable->name()) {
                Log("Warning: satsolver returned %s as a solvable for %s\n",
                    $solvable->name(), $inst_solvable->name());
		next;
	    }

            my $subdir = $solvable->repo()->name();
            # do not use matches on the 'installed' repo
            next if $subdir eq 'installed';

            my $reponame = $repoinfo{$subdir}->{'name'};
            my $repoprod = $repoinfo{$subdir}->{'product'} . ' ' . $repoinfo{$subdir}->{'version'};
            my $reposp   = $repoinfo{$subdir}->{'sp_version'};
            my $refrepo  = $repoinfo{$subdir}->{'reference_data'} // 0;

            # weak arch comparison:
            # - we do offer updates for compatible arches both ways
            # - else we would miss eg installed i686 and solvable i586 which should
            #   pass to ~ category
            next if (!buildarch_compat_weak($inst_solvarch, $solvable->arch()));

            # identical package? (name, arch, evr, vendor, build time, requires, ...)
            if ($solvable->identical($inst_solvable)) {
                my $s = x_version($inst_solvstring, '=', $reponame, $inst_solvevr);
                if($opt_verbose >= 1) {
                    push @{$vtype{'='}}, $s;
                }
                $found_id++;

                if ($refrepo) {
                    add_sp_key(\%spstats, $repoprod, $reposp, '=');
                    $in_refrepo = 1;
                }
            } else {
                # find out if the repository provides an older or newer package
                my $result   = $solvable->compare($inst_solvable);
                my $solv_evr = $solvable->evr();

                if ($result < 0) {
                    my $s = x_version($inst_solvstring, '-', $reponame, $solv_evr);
                    if($opt_verbose >= 1) {
                        push @{$vtype{'-'}}, $s;
                    }
                    $found_old++;

                    if ($refrepo) {
                        add_sp_key(\%spstats, $repoprod, $reposp, '-');
                        $in_refrepo = 1;
                    }
                } elsif ($result > 0) {
                    push @{$vtype{'+'}}, x_version($inst_solvstring, '+', $reponame, $solv_evr);
                    ${$newer_exists{$inst_solvstring}}[$repoinfo{$subdir}->{'number'}] = $solv_evr;;
                    $found_new++;

                    if ($refrepo) {
                        add_sp_key(\%spstats, $repoprod, $reposp, '+');
                        $in_refrepo = 1;
                    }
                } else {
                    my $key = '~';
                    if ($solvable->arch() eq 'noarch') {
                        # noarch packages are interchangable
                        $key = '=';
                    }
                    # identical evr, build compatible arch
                    my $s = x_version($inst_solvstring, $key, $reponame, "$solv_evr (" . $solvable->arch() . ")");
                    push @{$vtype{$key}}, $s;
                    $found_similar++;

                    if ($refrepo) {
                        add_sp_key(\%spstats, $repoprod, $reposp, $key);
                        $in_refrepo = 1;
                    }
                }
            }
        }
        my $msg = '';

        if (!$in_refrepo) {
            $nonref_count++;
            if ($found_id + $found_new + $found_similar + $found_old == 0) {
                # exists in some repo, no matter which version
                push @{$vtype{'m'}}, "    m no such package name exists in considered repos\n";
                x_version($inst_solvstring, 'm', 'no such package name exists in considered repos', '');
            } else {
                # not in any repo
                push @{$vtype{'r'}}, "    r not found in reference repos\n";
                x_version($inst_solvstring, 'r', 'not found in reference repos', '');
            }
            # todo: further checks like 'newer available' ???
        } else {
            # in refrepo, cool
            if ($found_new) {
                # unsupportable changes in packages with available updates
                if (exists $unsupportable{$inst_solvstring}) {
                    # FIXME: C&P
                    my $xmods='';
                    foreach my $pfile (@{ $unsupportable{$inst_solvstring} }) {
                        my $res = pretty_print_result($pfile);
                        if (length($pfile) + length($res) > 78) {
                            $msg .= "    ! package modifications for: $pfile\n".' 'x6 ."$res\n";
                        } else {
                            $msg .= sprintf(' 'x5 ."%-*s  %s\n", 60 - max((78 - 60), length($res)), $pfile, $res);
                        }
                        $xmods .= 'package modifications for <quote>' . x_quote($pfile) .
                            '</quote>: <quote>' . x_quote($res) . '</quote>';
                    }
                    x_version($inst_solvstring, '!', 'package modifications', $xmods);
                }
            }
        }
        # print types grouped and sorted
        my @order=( '+', '-', '=', '~', 'r', 'm' );
        my $printfunc = $opt_verbose >= 1 ? \&Report : \&Log;

        &$printfunc("  $inst_solvstring\n");
        map {
            &$printfunc(join('', @{$vtype{$_}})) if (exists $vtype{$_});
        } @order;

        # key: product, value present if no match for given product
        my %no_sp_match = ();

        # add package stats to global
        foreach my $prod (keys %spstats) {
            my $sps = $spstats{$prod};

            my @spnumbers = sort keys %$sps;
            if (scalar(@spnumbers)) {
                my $r = get_min_sp($sps);
                if (!scalar(@{$r}) or $r->[1] == -1) {
                    Dbg("version of the package cannot be matched to a service pack ".
                                    "- too old or inconsistent repo data");
                    $no_sp_match{$prod} = 1;
                    next;
                }

                my $m = -1;
                foreach my $i (@{$corepkgs->{$prod}->{$inst_solvname}}) {
                    if (($i > $m) && ($r->[0] <= $i) && ($i <= $r->[1])) {
                        $m = $i;
                    }
                }
                if (exists($corepkg_max->{$prod})) {
                    $corepkg_max->{$prod}->{$inst_solvname} = $m;
                } else {
                    $corepkg_max->{$prod} = {$inst_solvname => $m};
                }
                if ($m > 0 &&
                    (!exists($max_corepkg_sp->{$prod}) || ($m > $max_corepkg_sp->{$prod}))) {
                    $max_corepkg_sp->{$prod} = $m;
                }

                if ($r->[0] == $r->[1]) {
                    add_to_spreport_excl($prod, $r->[0]);
                } else {
                    for (my $i=$r->[0]; $i<=$r->[1]; $i++) {
                        add_to_spreport_shr($prod, $i);
                    }
                }
            } else {
                Dbg("package missing, no sp stats");
            }
        }
        if (scalar(keys %no_sp_match) && scalar(keys %no_sp_match) == scalar(keys %spstats)) {
            &$printfunc("    ! installed version too low for any reference repo\n");
            x_version($inst_solvstring, '!', 'installed version too low for any reference repo', '');
            if ($in_refrepo) {
                # name found in refrepos, but version is too low, put it into
                # other category in the sp coverage report
                $nonref_count++;
            }
        }

        # other extra messages
        &$printfunc($msg) if ($msg ne '');
    }
    x_te();

    # boring table formating of servicepack counts and percentage

    my $log = $opt_spreport ? \&Report : \&Log;    # output diversion
    my $tot = $num_sig_ok_packs;
    &$log("*** Identified Service Packs for packages (total: $tot)\n");
    my @o_hdr=('Product', 'SP',  'Exclusive', '/ %',     'Shared', '/ %',     'Total', '/ %');
    my @o_fmt=('%-15s',   '%3s', '%d',        '%2.1f%%', '%d',     '%2.1f%%', '%d',    '%3.2f%%');
    my @o_len=();

    for (my $i=0;$i<scalar(@o_hdr);$i++) {
        $o_len[$i]=length($o_hdr[$i]);
    }

    my @the_sp=();

    my @o_lines=();
    foreach my $prod (sort keys %spreport) {
        foreach (sort keys %{$spreport{$prod}}) {
            my @l=(
                $prod,  # product
                $_ == 0 ? 'GA' : "SP$_",            # sp number
                @{$spreport{$prod}->{$_}}[0] // 0,     # count exclusive
                defined @{$spreport{$prod}->{$_}}[0] ? @{$spreport{$prod}->{$_}}[0] / $tot * 100 : 0,
                @{$spreport{$prod}->{$_}}[1] // 0,     # count shared
                defined @{$spreport{$prod}->{$_}}[1] ? @{$spreport{$prod}->{$_}}[1] / $tot * 100 : 0,
                @{$spreport{$prod}->{$_}}[2] // 0,      # count total
                defined @{$spreport{$prod}->{$_}}[2] ? @{$spreport{$prod}->{$_}}[2] / $tot * 100 : 0
            );
            push @o_lines, \@l;

            # TODO: wild guess of coverage of SP1, improve
            if (@{$spreport{$prod}->{$_}}[2] / $tot * 100 > 99) {
                Dbg("POSSIBLE coverage by SP$_\n");
                push @the_sp, "$prod ".($_==0?'GA':"SP$_");
            }
        }
    }

    # non-ref repos, unclassified sp
    push @o_lines, ['other','',undef,undef,undef,undef,$nonref_count,$nonref_count / $tot * 100];

    my @o_lines_fmt=();
    foreach my $line (@o_lines) {
        my @l=@{$line};
        # prepare formatted value and find maximum length for each column
        my @fmt=();
        for (my $i=0;$i<scalar(@l);$i++) {
            if (defined $l[$i]) {
                $fmt[$i] = sprintf($o_fmt[$i], $l[$i]);
                $o_len[$i] = length($fmt[$i]) if ($o_len[$i] < length($fmt[$i]));
            } else {
                $fmt[$i] = '';
                $o_len[$i] = length($fmt[$i]) if ($o_len[$i] < length($fmt[$i]));
            }
        }
        push @o_lines_fmt, \@fmt;
    }

    for (my $i=0;$i<scalar(@o_hdr);$i++) {
        my $pad=$o_len[$i] - length($o_hdr[$i]);
        if ($o_fmt[$i] =~ /-/) {
            &$log($o_hdr[$i].($i>0?' ':'').' 'x$pad);
        } else {
            $pad++;
            &$log(($i>0?' ':'').' 'x$pad .$o_hdr[$i]);
        }
    }

    my $s=2*scalar(@o_len);
    map { $s+=$_ } @o_len;
    &$log("\n" . '-'x $s . "\n");

    foreach my $line (@o_lines_fmt) {
        my @fl=@{$line};
        for (my $i=0;$i<scalar(@fl);$i++) {
            my $pad=$o_len[$i] - length($fl[$i]);
            $pad++ if ($o_fmt[$i] !~ /-/);
            &$log(($i>0?' ':'').' 'x$pad .$fl[$i]);
        }
        &$log("\n");
    }

    &$log("\nNotes:\n");
    &$log(" - Exclusive - packages in one servicepack only\n");
    &$log(" - Shared    - packages shared among several servicepacks\n");
    &$log(" - packages may reside in several SPs\n");
    # TODO: signed? what to do when --rpm-no-sigcheck ?
    &$log(" - percentage is calculated against total number of signed packages found\n   on system matching some reference repository\n");
    &$log(" - 'other' covers all signed SUSE/Novell packages not found in reference repos\n");
    &$log("\n");

    if (@the_sp) {
        &$log("Result: The installed system seems to be covered by these products:\n");
        foreach (@the_sp) {
            &$log("  - $_\n");
        }
    } else {
        &$log("Result: No product seems to fully cover the installed system.\n");
    }
    &$log("\n");
}

# ---------------------------------------------------------------------------
# check for mixed SP

sub check_mixed_sp()
{
    $mixed_sp = 0;

    foreach my $prod (keys %{$corepkg_max}) {
        my $m = $max_corepkg_sp->{$prod};
        if ((!defined $m) || ($m < 0)) { next }
        Log("Checking product '%s' (latest SP: %d)\n", $prod, $m);

        $corepkg_out_new->{$prod} = [];
        $corepkg_out_old->{$prod} = [];
        foreach my $pkg (keys %{$corepkgs->{$prod}}) {
            my $found = 0;
            foreach my $i (@{$corepkgs->{$prod}->{$pkg}}) {
                if ($i == $m) { $found = 1; }
            }
            if ($found == 0) { next; }
            if (!exists($corepkg_max->{$prod}->{$pkg})) { next; }
            my $inst_sp = $corepkg_max->{$prod}->{$pkg};
            if ($inst_sp < $m) {
                 push(@{$corepkg_out_old->{$prod}}, $pkg);
                 $mixed_sp++;
                 Log("    %-32s failed (SP %d)\n", $pkg, $inst_sp);
            } else {
                 push(@{$corepkg_out_new->{$prod}}, $pkg);
                 Log("    %-32s OK\n", $pkg);
            }
        }
    }
    if ($mixed_sp > 0) {
        Log("Result: failed, mixed service packs detected\n");
    } else {
        Log("Result: success, service packs not mixed\n");
    }
}

# ---------------------------------------------------------------------------
# dependency checker

sub check_dependencies {
# full dependency tree is needed, rpm -e --test does not give indirect deps
# we want to report this too: OUR1 -> OUR2 -> FOREIGN1
# now, OUR1 is not printed

# better workaround for rpm reporting nonexisting mountpoints as error
# there can be more of them
my @mountpoints = map { $_=(split / /)[2]; chomp; $_; } `mount`;

# build list of forward deps
our (%deps, %revdeps, %fulldeps);
foreach my $rpm ((keys %packinfo, keys %foreigninfo)) {
    my $IN = rpm_e($rpm);
    while (<$IN>) {
        chomp;
        if(/^error: Failed dependencies:$/) {
            $deps{$rpm} = [];
        } else {
            if (/^error: package\s+(.*)\s+is not installed$/) {
                # missing package found in cache or deleted meanwhile?
                next;
            }
            my $mountpoint_matched = 0;
            foreach my $re (@mountpoints) {
                if (/error: failed to stat \Q$re\E: No such file or directory/) {
                    #Dbg("Expected unexpected rpm error with a mountpoint for $rpm");
                    if ($opt_verbose >=2) {
                        Log("Warning: rpm returned an error:\n\"  error: failed to stat $re: No such file or directory\"\n... assuming empty output of the command\n");
                    }
                    # WORKAROUND
                    # strange error of rpm, if
                    # - /sys is present in /etc/mtab
                    # - /sys is not mounted (eg. on an image)
                    # - /sys/kernel/debug is not present (or any /sys/... mounted fs)
                    # - package has no failed dependencies
                    # solution: ignore for now
                    $mountpoint_matched=1;
                    last;
                }
            }
            next if ($mountpoint_matched);

            /^.*\s+(\S+)$/;
            if(!exists $deps{$rpm}) {
                Die(1, "$progname: rpm: unexpected query response:\n  $_\n");
            } else {
                push @{ $deps{$rpm} }, $1;
            }
        }
    }
    close($IN);
}

# reverse deps
foreach my $dep (keys %deps) {
    foreach (@{$deps{$dep}}) {
        $revdeps{$_} = [] if(!exists $revdeps{$_});
        push @{$revdeps{$_}}, $dep;
    }
}

# remove duplicates
foreach (keys %revdeps) {
    if(exists $revdeps{$_}) {
        my %seen = ();
        $revdeps{$_} = [ grep { !$seen{$_}++ } @{$revdeps{$_}} ];
    }
}

# generate full dependency list
sub fulldeps_r {
    my ($pkg,$vref,$oref)=@_;
    return if(exists $vref->{$pkg});
    $vref->{$pkg} = undef;
    return if(!exists $revdeps{$pkg});
    push @$oref, (@{$revdeps{$pkg}});
    map { fulldeps_r($_, $vref, $oref) } @{$revdeps{$pkg}};
};
sub fulldeps($) {
    return () if(!exists $revdeps{$_[0]});
    my %visited = ($_[0] => undef);
    my @out = @{$revdeps{$_[0]}};
    map { fulldeps_r($_, \%visited, \@out) } @{$revdeps{$_[0]}};
    my %seen = ();
    return grep { !$seen{$_}++ } @out;
};
map { @{ $fulldeps{$_} } = fulldeps($_) } keys %deps;

# find our with any dependency on foreign
foreach my $rpm (keys %deps) {
    next if(!exists $packinfo{$rpm});
    my @deplist = sort(grep { exists $foreigninfo{$_} } @{$fulldeps{$rpm}});
    next if(!scalar(@deplist));
    @{$depends_on_foreign{$rpm}} = @deplist;
}

}

# ---------------------------------------------------------------------------
# utility functions

# IN: sp number
# OUT: GA or SPx
sub sp2str($) {
    return 'GA' if($_[0] == 0);
    return 'SP' . $_[0];
}

# IN: installed, solvable
sub buildarch_compat_weak($$) {
    my ($i, $s) = @_;
    return 1 if ($s eq 'noarch');
    return 1 if( $i eq $s);
    return 1 if ($i =~ /i[3456]86/ && $s =~ /i[3456]86/);
    return 0;
}
sub buildarch_compat($$) {
    my ($i, $s) = @_;
    return 1 if ($s eq 'noarch');
    return 1 if( $i eq $s);
    return 1 if ($i eq 'i586' && $s eq 'i686');
    return 0;
}

sub max($$) {
    my ($a, $b) = @_;
    return ($a > $b) ? $a : $b;
}
# push reference repo keys to the end
sub repo_keys_sorted(@) {
    return sort {
	$repoinfo{$a}->{'reference_data'} && $repoinfo{$b}->{'reference_data'} ?  $a cmp $b :
	$repoinfo{$a}->{'reference_data'} ? 1 : # a < b
	-1 # a > b
    } @_;
}

# check if system arch is compatible with given arch
my %archstack;
sub is_compatible_arch_step($$);
sub is_compatible_arch_step($$) {
    my ($sysarch,$arch)=@_;
    return 1 if($sysarch eq $arch);
    return 0 if(exists $archstack{$sysarch});

    $archstack{$sysarch}=undef;
    for my $i (@{$archtable{$sysarch}}) {
        next if(exists $archstack{$i});
        return 1 if(is_compatible_arch_step($i,$arch));
    }
    return 0;
}
sub is_compatible_arch($$) {
    %archstack=();
    return is_compatible_arch_step($_[0], $_[1]);
}
sub filter_hw_arches(@) {
    return grep { defined && exists $archtable{$_} } @_;
}
# read repo timestamp (not 100% reliable)
sub get_repo_ts($$) {
    my ($solv, $repo) = @_;
    if (defined $satsolver::{"Repo::"}->{attr}) {
        return $repo->attr('repository:timestamp') // undef;
    }
    Dbg("Repo::attr not defined (old satsolver package), using fallback 'dumpsolv'");
    # solv file existence is checked earlier
    open(F, "dumpsolv $solv |") or Die(2, "cannot read solv file '$solv': $!");
    my @d = grep(/^repository:/, <F>);
    close(F);
    chomp @d;
    foreach(@d) {
        return $1 if(/repository:timestamp:\s*(\d+)/);
    }
    return undef;
}
sub get_solv_ts($) {
    my ($fn) = @_;
    my $dir = dirname($fn);
    if (open(F, "< $dir/cookie")) {
        $_ = <F>;
        /[a-z0-9]+\s+(\d+)/;
        close(F);
        return $1;
    } else {
        return (stat($fn))[9];   # mtime
    }
}

sub repo_too_old($) {
    my ($ts) = @_;
    return 0 if(!defined $ts);
    my $now = time;
    return 1 if ($now - $ts > 3600*24*$opt_repo_freshness_limit);
}

sub is_foreign_codestream($) {
    return $_[0] !~ /($codestream_schema)/o || $1 !~ /^$allowed_codestreams/o;
}

sub clean_codestream($) {
    # in:  obs://build.suse.de/SUSE:SLE-11-SP1:GA/standard
    # out: obs://build.suse.de/SUSE:SLE-11
    my ($cs) = @_;
    $cs =~ /$codestream_schema/o;
    my @sp_slash=split(/\//, $cs);
    my @sp_colon=split(/:/, $2);
    my $cleaned=join('/', @sp_slash[0..2], '');
    my $sp_hint=$sp_colon[1];
    # snip SP
    if ($sp_hint =~ /(-SP\d)/) {
        my $sp_strip=$1;
        $sp_colon[1] =~ s/$sp_strip//;
    }
    $cleaned .= join(':', @sp_colon[0..1]);
    return $cleaned;
}

sub format_result($) {
    return $_[0] eq '?' ? '(not checked)' : $_[0];
}

# ---------------------------------------------------------------------------
# Main program
#

my $log_timestamp = 1;
my $opt_outdir = './';
{
    use Getopt::Long;
    use Pod::Usage;
    $Getopt::Long::debug = 0;
    $Getopt::Long::ignorecase = 0;
    $Getopt::Long::bundling = 1;
    $Getopt::Long::passthrough = 0;
    my $help = 0;
    my $man = 0;

    # defaults
    $opt_verbose = 0;
    $opt_header_sig_check = 1;
    $opt_rpm_verify = 1;
    $opt_orphan_search = 0;
    $opt_rpm_verify_md5 = 1;
    $opt_print_pkg_summary = 0;
    $opt_log_commands = 0;
    $opt_strict_repo_description = 1;
    $opt_spreport = 0;

    pod2usage(1) unless (GetOptions(
          'help|h' => \$help,
          'man', \$man,
          'verbose|v+' => \$opt_verbose,
          'debug|d+' => \$debug,
          'tmpdir|t=s' => \$tmpdir,
          'outdir|o=s' => \$opt_outdir,
          'refdata|r=s' => \$reference_datadir,
          'sysarch=s' => \$opt_sysarch,
          'header-sig-check!' => \$opt_header_sig_check,
          'log-commands!' => \$opt_log_commands,
          'pkg-summary!' => \$opt_print_pkg_summary,
          'log-timestamp!' => \$log_timestamp,
          'rpm-verify!' => \$opt_rpm_verify,
          'rpm-verify-md5!' => \$opt_rpm_verify_md5,
          'use-all-products!' => \$opt_use_all_products,
          'skip-unmatched-prod!' => \$opt_skip_unmatched_prod,
          'orphan-search!' => \$opt_orphan_search,
          'strict-repo-description!' => \$opt_strict_repo_description,
          'spreport!' => \$opt_spreport,
          'dir=s%' => \%opt_dirs,
          'exp=s@' => \@opt_exp
      ));

    pod2usage(-noperldoc => 1, -exitval => 0, -verbose => 1, -message => "This is SAM $prog_version") if ($help);
    pod2usage(-noperldoc => 1, -exitval => 0, -verbose => 2) if ($man);
}
$debug = 0 if ($debug <= 0);

if (exists($ARGV[0]) && -d $ARGV[0]) {
    $root_dir = File::Spec->canonpath(abs_path($ARGV[0]));
    $rpm_command .= " --root \Q$root_dir\E";
}

# ---------------------------------------------------------------------------
# prepare runtime environment

# setup logfiles
my $ts='';
my (undef,$min,$hour,$mday,$mon,$year)=localtime(time);
my $report_ts = sprintf("%2d.%2d.%4d %02d:%02d", $mday, $mon, $year+1900, $hour, $min);
if($log_timestamp) {
    $ts=sprintf("-%4d%02d%02d-%02d:%02d", $year+1900,$mon+1,$mday,$hour,$min);
}

$opt_outdir = File::Spec->canonpath($opt_outdir);
mkpath($opt_outdir, { 'mode' => 0755, 'error' => \my $err, 'verbose' => 0 }) if(! -d $opt_outdir);
for my $diag (@$err) {
    my ($file, $msg) = each %$diag;
    print STDERR "FATAL: outdir: $file does not exist and cannot be created: $msg\n";
    exit(-1);
}
if(!(-d $opt_outdir && -w $opt_outdir)) {
    print STDERR "FATAL: outdir: $opt_outdir is not a writable directory\n";
    exit(-1);
}
$reference_datadir = File::Spec->canonpath(abs_path($reference_datadir));

if(!open(LOG, "> $opt_outdir/sam$ts.log")) {
    print STDERR "cannot create logfile: $!\n";
    exit(-1);
}
open(XML,      "> $opt_outdir/sam$ts.xml")    || Die(1, "open(XML): $!\n");
open(REPORT,   "> $opt_outdir/sam$ts.report") || Die(1, "open(REPORT): $!\n");
open(HTML,     "> $opt_outdir/sam$ts.html")   || Die(1, "open(HTML): $!\n");

# create a temp subdir and set up temp file names
Die(1, "tmpdir: $tmpdir is not a writable directory") if (!(-d $tmpdir and -w $tmpdir));

# create subdir name and create subdir
$tmpsubdirtemplate = File::Spec->canonpath("$tmpdir/$tmpsubdirprefix.XXXXXX");
eval { $tmpsubdir  = tempdir($tmpsubdirtemplate, CLEANUP => 1); };
Die(1, "cannot create temp subdir $tmpsubdirtemplate: $@\n") if ($@);

# set temp file names
$pubring    = "$tmpsubdir/$pubring";
$sigfile    = "$tmpsubdir/$sigfile";
$signedfile = "$tmpsubdir/$signedfile";
$refsolvdir = "$tmpsubdir/$refsolvdir";
$refkeysdir = "$tmpsubdir/$refkeysdir";
$reftempdir = "$tmpsubdir/$reftempdir";

check_satsolver();

# ---------------------------------------------------------------------------
# experimental stuff

print STDERR "experimental options: @opt_exp\n" if(@opt_exp);
Log("experimental options: @opt_exp\n") if(@opt_exp);

$repo_schema = 'studio', Dbg("schema studio") if(grep(/schema-studio/, @opt_exp));
$repo_schema = 'none', Dbg("schema none") if(grep(/schema-none/, @opt_exp));

# ---------------------------------------------------------------------------
# setup table of compatible arches
my $rpmrc = "$root_dir/usr/lib/rpm/rpmrc";
open(RC,"<$rpmrc") or Die(2, "cannot open rpmrc '$rpmrc': $!");
foreach(<RC>) {
    next if !/^arch_compat:\s*(\S+):\s*(.+)(?:\s+)?/;
    push @{$archtable{$1}}, split(/\s+/,$2);
}
close(RC);

# ---------------------------------------------------------------------------
# start of result reports
Report("Supportability Analysis Module $prog_version\n");
Report("*** Report by '$invocation_cmd_line'\n");

x_out("<sam-report>\n");
x_ts('invocation');
x_t('name', 'Supportability Analysis Module');
x_t('version', $prog_version);
x_t('command', x_quote($invocation_cmd_line));
x_te();

get_installed_sam_version();
Report("*** Installed versions:\n");
Report(fmt_table2('  ', %sam_version));

x_ts('sam-versions');
foreach(keys %sam_version) {
    x_ts('package');
    x_t('name', $_);
    x_t('version', $sam_version{$_});
    x_te();
}
x_te();

create_reference_data();
load_corepkg_lists();

# read available products, configuration and repository infos
# collect list of installed products and codestreams from products.d
get_products();
get_sysarch();  # check arch of product too ...
Report("*** Installed products: %d (known vendors: %d)\n", (scalar(keys %prodinfo)), $num_our_products);
Report("  System architecture: $sysarch%s\n",(defined $opt_sysarch?' (forced)':''));
Report("  Baseproduct: $baseproduct\n") if(defined $baseproduct);
x_ts('installed-products');
x_t('sysarch', $sysarch);
x_t('baseproduct', $baseproduct // '(undefined)');

foreach my $file (keys %prodinfo) {
    Report('  %s:', $file);
    x_ts('product');
    x_t('prod-file', $file);
    if (defined $prodinfo{$file}->{'vendor'} and $prodinfo{$file}->{'vendor'} =~ /^$Vendors/o) {
        Report("\n");
        my @a;
        push @a, 'summary:', $prodinfo{$file}->{'summary'} // '(none)';
        my $name_version = join(' ',
            $prodinfo{$file}->{'name'} // '(none)',
            $prodinfo{$file}->{'version'} // '(none)');
        my $sp_release = join(' ',
            $prodinfo{$file}->{'sp_version'} // '(none)',
            (defined($prodinfo{$file}->{'release'}) and !scalar($prodinfo{$file}->{'release'})) ?
		    $prodinfo{$file}->{'release'} : '(none)');

	$summary_nvra = join(' ',
            $prodinfo{$file}->{'name'} // '(none)',
            $prodinfo{$file}->{'version'} // '(none)',
            'SP:'.$prodinfo{$file}->{'sp_version'} // '(none)',
            'release:'.((defined($prodinfo{$file}->{'release'}) and
                    !scalar($prodinfo{$file}->{'release'})) ?
		    $prodinfo{$file}->{'release'} : '(none)'),
            $prodinfo{$file}->{'arch'} // '(none)');

        x_t('name', $prodinfo{$file}->{'name'} // '(none)');
        x_t('version', $prodinfo{$file}->{'version'} // '(none)');
        x_t('sp_version', $prodinfo{$file}->{'sp_version'} // '(none)');
        x_t('release', (defined($prodinfo{$file}->{'release'}) and
                    !scalar($prodinfo{$file}->{'release'})) ?
		    $prodinfo{$file}->{'release'} : '(none)');
        x_t('arch', $prodinfo{$file}->{'arch'} // '(none)');

        push @a, 'name version:', $name_version;
        push @a, 'SP, release:', $sp_release;
        push @a, 'arch:', $prodinfo{$file}->{'arch'} // '(none)';
        if (defined $prodinfo{$file}->{'allowed_codestreams'}) {
            foreach my $codestream (@{$prodinfo{$file}->{'allowed_codestreams'}}) {
                push @a, 'repository:', $codestream;
                x_t('repository', $codestream);
            }
        }
        Report(fmt_table2('    ', @a));
    } else {
        Report(" third-party product\n");
        x_t('thirdparty', 'true');
        x_t('vendor',$prodinfo{$file}->{'vendor'} // '(unknown vendor)');
    }
    x_te();
}
x_te();

# ---------------------------------------------------------------------------
x_ts('all-repositories');
get_repo_conf();    # get (configured) locations of repository files
get_repo_infos();   # get product-related infos about all repositories
x_te();

x_ts('local-repositories');
Report('*** Found package repositories: ');
my $num_repos = (keys %repoinfo);
if ($num_repos == 0) {
    Report("NONE\n");
    my $msg = <<EOF;
It is possible that your repos were not recognized or their descriptions
do not contain required information, check with log.
Reference repos reside in package suse-sam-data or can be specified by -r option.
EOF
    Die(2, "no system or reference repositories found, please check your installation!\n$msg\n");
} else {
    my $refrepos = 0;
    map { $refrepos++ if($repoinfo{$_}->{'reference_data'}) } (keys %repoinfo);

    if (!$refrepos) {
        Die(2, "no reference repositories found, please check that you have suse-sam-data installed or specify the directory to -r option");
    }

    Report("%d (reference $refrepos, skipped $skippedrepos, need refresh $needrefresh)\n", $num_repos - $refrepos);
    x_ts('summary');
    x_list('reference', $refrepos,'skipped', $skippedrepos, 'need-refresh', $needrefresh);
    x_te();

    foreach my $subdir (repo_keys_sorted(keys %repoinfo)) {
        my $repo_ref = $repoinfo{$subdir};
	# hide reference repos
	next if($repo_ref->{'reference_data'});

        my @a;
        foreach my $field (@required_fields) {
            foreach my $subfield (split(/:/, $field)) {
                push @a, "$subfield:", $repo_ref->{$subfield} // '(undef)';
                last if defined $repo_ref->{$subfield};
            }
        }

        Report("  Repository #%d:\n", $repo_ref->{'number'});
        Report(fmt_table2('    ', @a));

        x_ts('repository');
        x_t('number', $repo_ref->{'number'});
        x_list(@a);
        x_te();
    }
}
x_te();

# ---------------------------------------------------------------------------
# setup keys
x_ts('gpg-keys');
if (!$opt_header_sig_check) {
    Log("  rpm header signature check disabled: will not check package authenticity\n");
    x_t('warning',"RPM header signature check disabled: will not check package authenticity");
} elsif (not -x $gpg_exe) {
    Log("  GPG executable \"$gpg_exe\" not found: will not check package authenticity\n");
    x_ts('warning');
    x_t('message', "GPG executable not found");
    x_t('file', $gpg_exe);
    x_te();
} else {
    # setup keyring from reference data, then from local metadata
    find(\&setup_key, "$reference_datadir/keys") if (-d "$reference_datadir/keys");
    # keys from unpacked tarballs/metadata
    find(\&setup_key, $refkeysdir) if (-d $refkeysdir);
    # keys found in local repos
    find(\&setup_key, $repo_config{$repo_schema}->{'keys_dir'}) if (-d $repo_config{$repo_schema}->{'keys_dir'});

    if (scalar (keys %good_key_ids) > 0) {
        Log("  found %d SUSE/Novell build keys: will check package authenticity\n",
            scalar (keys %good_key_ids));
        Log("    %s\n", join("\n    ",  sort values %good_key_ids));

        foreach(sort values %good_key_ids) {
            x_t('gpg-key', $_);
        }
    } else {
        Log("  no SUSE/Novell build keys found: cannot check package authenticity\n");
        x_t('warning', "No SUSE/Novell build keys found: cannot check package authenticity");
    }
}
x_te();

# ---------------------------------------------------------------------------
# enumerate packages and get infos
enumerate_packages();

# ---------------------------------------------------------------------------
# Verify installed files against package headers:
# first "our" packages, then "foreign" packages

my $num_packages = scalar(keys %packinfo);
my $num_foreign  = scalar(keys %foreigninfo);

# product and signed counts may mismatch:
#  product packages are matched against product codestream
#  signed packages are signed properly
Report("*** Considered packages:\n");
my @a=('Packages belonging to defined products:', $num_packages,
    'Signed with accepted key:', $opt_header_sig_check ? $num_sig_ok_packs : 'not checked',
    '3rd party packages:', $num_foreign,
    'Skipped gpg-key packages:', scalar(keys %skipped_packages));
Report(fmt_table2('    ', @a));


#%d from defined products %d, %s not signed by SUSE/Novell, %d from 3rd party\n",
#        $num_packages, $opt_header_sig_check ? $num_sig_ok_packs : 'not checked',
#        $num_foreign, scalar(keys %skipped_packages));
x_ts('package-summary');
x_t('product', $num_packages);
x_t('signed', $opt_header_sig_check ? $num_sig_ok_packs : 'not checked');
x_t('foreign', $num_foreign);
x_te();

# ---------------------------------------------------------------------------
# verify installed packages stat
Log('%T: Verify packages by rpm: ');
x_ts('package-verify');
if (!$opt_rpm_verify) {
    Log("$num_packages packages: skipped\n");
    x_t('message', "$num_packages packages skipped");
} elsif ($num_packages == 0) {
    Die(2, "0 packages\nPanic: no packages to verify!?\n");
} else {
    Log("$num_packages packages\n");
    x_t('message', "$num_packages SUSE/Novell packages to verify");
    # verify "our" packages (ours = 1)
    verify_packages(\%packinfo, \%unsatisfied, 'verify', 1);

    # whitelist of docs, safe to ignore
    my @ignore_docs=('/usr/share/doc', '/usr/share/man', '/usr/share/info');
    my $re="(".join('|', @ignore_docs).")";

    # clear entries in all lists

    foreach my $pkg (keys %unsupportable) {
        my @filter = grep { !/$re/ } @{$unsupportable{$pkg}};
        if(!@filter) {
            delete $unsupportable{$pkg};
        } else {
            @{$unsupportable{$pkg}} = @filter;
        }
    }

    foreach my $pkg (keys %tolerable) {
        my @filter = grep { !/$re/ } @{$tolerable{$pkg}};
        if(!@filter) {
            delete $tolerable{$pkg};
        } else {
            @{$tolerable{$pkg}} = @filter;
        }
    }

    @file_missing = grep { !/$re/ } @file_missing;
    @file_modified = grep { !/$re/ } @file_modified;
}
x_te();

# ---------------------------------------------------------------------------
# give quick problem list like SPident

Log("%T: List foreign packages\n");
foreach (sort(keys %foreigninfo)) {
    Log("  $_\n");
    Log("    vendor: %s\n    codestream: %s\n", $foreigninfo{$_}->{'vendor'},
        $foreigninfo{$_}->{'disturl'}) if($opt_verbose >=1);
}

# ---------------------------------------------------------------------------
# Find SUSE/Novell source repos for installed packages, compare versions
Log("%T: Identify package sources (verbosity: $opt_verbose)\n");
identify_package_sources();

# ---------------------------------------------------------------------------
# Check mixed service packs
Log("%T: Check mixed service packs\n");
check_mixed_sp();

# ---------------------------------------------------------------------------
# finish the rest of verification
if(0) {
# this step is not really needed, the packages are unsupported by definition
# and any modification cannont change this
if ($opt_rpm_verify) {
    # verify "foreign" packages (ours = 0)
    verify_packages(\%foreigninfo, \%foreign_unsatisfied, 'verify foreign', 0);
}
}

# ---------------------------------------------------------------------------
Log("%T: Find our packages which depend on foreign packages\n");
check_dependencies();

# ---------------------------------------------------------------------------
Log("%T: Find orphaned files (not owned by any installed package)");
if (!$opt_orphan_search) {
    Log(": skipped\n");
    shift @orphans;
    $sum_all_fsize = $sum_all_inodes = -1;
} else {
    Log("\n");
    find_orphans($root_dir);
}

my $unsat = scalar(keys %unsatisfied);
Report('*** Unsatisfied package dependencies: ');
x_ts('unsatisfied-dependencies');
if (!$opt_rpm_verify) {
    # FIXME: correct?
    Report( "NOT CHECKED\n");
    $summary_unsatdeps='?';
} elsif ($unsat > 0) {
    Report("%d\n", $unsat);
    foreach my $package (sort(keys %unsatisfied)) {
        Log("  %s\n    dependency: %s\n", $package, $unsatisfied{$package});
        x_ts('issue', {severity=>'critical'});
        x_list('package', $package, 'dependencies', $unsatisfied{$package});
        x_te();
    }
    $summary_unsatdeps=$unsat;
} else {
    $summary_unsatdeps=0;
    Report("NONE\n");
}
x_te();

my $foreigndeps = scalar(keys %depends_on_foreign);
Report('*** SUSE/Novell packages depending on 3rd party packages: ');
x_ts('foreign-dependencies');
if ($foreigndeps > 0) {
    Report("%d\n", $foreigndeps);
    foreach my $package (sort(keys %depends_on_foreign)) {
        Log("  $package\n");
        foreach (@{$depends_on_foreign{$package}}) {
            Log("    foreign: $_\n");
            x_ts('issue', {severity=>'critical'});
            x_list('package', $package, 'dependencies', $_);
            x_te();
        }
    }
} else {
    Report("NONE\n");
}
x_te();

# ---------------------------------------------------------------------------
Report('*** Package version checks: ');
x_ts('available-updates');
$summary_updates = keys %newer_exists;
if ($summary_updates > 0) {
    Report("updates available for %d packages\n", $summary_updates);
    my @a;
    foreach my $pack (sort(keys %newer_exists)) {
        my %seen = ();
        push @a, $pack;
        push @a, join(', ', reverse sort grep {defined && !$seen{$_}++ } @{$newer_exists{$pack}});
    }
    Log(fmt_table2('  ', @a));

    for(my $i=0;$i<scalar(@a);$i+=2) {
        x_ts('issue', {severity=>'medium'});
        x_list('package', $a[$i], 'versions', $a[$i+1]);
        x_te();
    }
} else {
    Report("all up to date\n");
}
x_te();

# ---------------------------------------------------------------------------
Report('*** Modified filesystem objects: ');
x_ts('modified-files');
if (!$opt_rpm_verify) {
    Report("NOT CHECKED\n");
    $summary_modif='?';
} else {
    my ($m_mode, $m_owner, $m_miss, $m_size, $m_csum, $m_mtime, $m_other)=(0,0,0,0,0,0,0);
    my $m_dummy;
    my %imap = (
	'S' => \$m_size,
	'5' => \$m_csum,
        #'M' => \$m_mode,
	'M' => \$m_dummy,
        #'U' => \$m_owner,
	'U' => \$m_dummy,
        #'G' => \$m_owner,
	'G' => \$m_dummy,
        #'T' => \$m_mtime,
	'T' => \$m_dummy,
	'D' => \$m_other,
	'L' => \$m_other,
	'?' => \$m_other,
    );

    foreach my $pack (keys %unsupportable) {
        foreach my $file (@{ $unsupportable{$pack}}) {
	    my $r = $file2res{$file};
	    if ($r =~ /^U:miss/) {
		$m_miss++;
	    } elsif ($r =~ /^U:mod .:([SM5?DLUGT]+)(?: (?:.*)|)$/) {
		map {${ $imap{$_} }++ } split(//, $1);
	    }
	}
    }

    $summary_modif = scalar(@file_modified) + scalar(@file_missing);
    Report("%d (+%d tolerated)\n", $summary_modif, scalar(@file_tolerated));
    my @a=(
        'Missing:', $m_miss,
        #'Mode/File type:', $m_mode,
        #'Owner:', $m_owner,
        'Size:', $m_size,
        'Checksum:', $m_csum,
        #'Mod-time:', $m_mtime,
        'Other/unknown:', $m_other,
        'Tolerated:', scalar(@file_tolerated)
    );
    Report(fmt_table2('  ', @a));

    x_ts('modification-summary');
    x_list(@a);
    x_te();

    Log("\n");
    x_ts('unsupportable-modifications');
    foreach my $pack (sort(keys %unsupportable)) {
        Log("  $pack\n");
        foreach my $pfile (@{ $unsupportable{$pack} }) {
            my $res = pretty_print_result($pfile);
	    if (length($pfile) + length($res) > 78) {
                Log("    package modifications for: $pfile\n".' 'x6 ."$res\n");
            } else {
                Log(' 'x4 ."%-*s  %s\n", 60 - max((78 - 60), length($res)), $pfile, $res);
            }
            x_ts('issue', {severity=>'critical'});
            x_list('package', $pack, 'file', $pfile, 'result', $res);
            x_te();
	}
    }
    x_te();

    x_ts('tolerable-modifications');
    foreach my $pack (sort(keys %tolerable)) {
        Log("  $pack\n");
        foreach my $pfile (@{ $tolerable{$pack} }) {
            my $res = pretty_print_result($pfile);
            Log(' 'x4 ."%-*s  %s\n", 60 - max((78 - 60), length($res)), $pfile, $res);
            x_ts('issue', {severity=>'harmless'});
            x_list('package', $pack, 'file', $pfile, 'result', $res);
            x_te();
	}
    }
    x_te();
}
x_te();

my $num_unsupported = scalar(keys %unsupportable) + scalar(keys %depends_on_foreign);

# ---------------------------------------------------------------------------
Report('*** Files not owned by any package: ');
x_ts('orphaned-files');
if (!$opt_orphan_search) {
    Report("NOT CHECKED\n");
    $summary_orphaned = '?';
} elsif (scalar(@orphans) >= 0) {
    Report("%d\n", scalar(@orphans));
    $summary_orphaned = scalar(@orphans);
    shift @orphans;
    Log("  %s\n", join("\n  ", @orphans));

    foreach (@orphans) {
        x_t('file', $_);
    }
} else {
    Report("NONE\n");
    $summary_orphaned = 0;
}
x_te();

# ---------------------------------------------------------------------------
# print grouped information per package
my $log = $opt_print_pkg_summary ? \&Report : \&Log;
# TODO: per product too?
&$log("*** Unsupported packages summary:\n");
x_ts('unsupported-packages-summary');
my @packs = (keys %unsatisfied, keys %unsupportable, keys %depends_on_foreign,
    keys %newer_exists);

my $maxlen = 0;
map { my $a=length $_; $maxlen<$a ? $maxlen=$a : 0 } @packs;
$maxlen++;
my %seen=(); # use unique list
for my $pkg (sort grep { !$seen{$_}++ } @packs) {
    my @res = ();
    push @res, 'unsat_deps' if(exists $unsatisfied{$pkg});
    push @res, 'file_mods' if(exists $unsupportable{$pkg});
    push @res, 'foreign_deps' if(exists $depends_on_foreign{$pkg});
    push @res, 'update' if(exists $newer_exists{$pkg});
    &$log("  %-${maxlen}s %s\n", $pkg, join(' ',@res));
    x_ts('package-summary');
    x_t('package', $pkg);
    foreach(@res) {
        x_t('problem-category', $_);
    }
    x_te();
}
x_te();

x_ts('foreign-packages');
foreach (sort(keys %foreigninfo)) {
    x_ts('issue', {severity=>'critical'});
    x_list('package', $_, 'vendor', $foreigninfo{$_}->{'vendor'},
        'codestream', $foreigninfo{$_}->{'disturl'});
    x_te();
}
x_te();

x_ts('packages-without-problems');
    my @p_f = keys %foreigninfo;
    foreach (sort keys %packinfo) {
        next if(exists $unsatisfied{$_});
        next if(exists $depends_on_foreign{$_});
        next if(exists $unsupportable{$_});
        next if(exists $newer_exists{$_});
        x_t('package', $_);
    }
x_te();

# ---------------------------------------------------------------------------
# final summary
Report("\n");
Report("*** Summary (see above or log for details):\n\n");
Report("  Product: $summary_nvra\n\n");
Report ("Statistics:\n");
@a=(
    'Total packages installed:', scalar(keys %packinfo) + scalar(keys %foreigninfo) + scalar(keys %skipped_packages),
    'Packages signed by SUSE/Novell:', $num_sig_ok_packs,
    'Packages matching installed products:', $num_prod_ok_packs,
    'Packages not created by SUSE/Novell:', $num_foreign,
    'Unsupported SUSE/Novell packages:', $num_unsupported,
    'File modifications:', format_result($summary_modif),
    'Unsatisfied dependencies:', format_result($summary_unsatdeps),
    'SUSE/Novell packages depending on 3rd party packages:', $foreigndeps,
    'Updates needed:', $summary_updates,
    'Files not belonging to a package:', format_result($summary_orphaned));
Report(fmt_table2('    ', @a));

@a=('novell-packages', $num_sig_ok_packs,
    'product-packages', $num_prod_ok_packs,
    'foreign-packages', $num_foreign,
    'orphaned-files', $summary_orphaned,
    'unsupported-packages', $num_unsupported,
    'file-modifications', $summary_modif,
    'unsatisfied-dependencies', $summary_unsatdeps,
    'foreign-dependencies', $foreigndeps,
    'updates-needed', $summary_updates);

x_ts('final-summary');
x_t('product', $summary_nvra);
x_list(@a);
x_te();

Report("\n");
Report("Status and recommendations:\n");
Report("\n");
x_ts('recommendations');
my $noproblems = 1;
my $text;
my $msg;
if (       $needrefresh
        or $summary_updates > 0
        or $num_foreign > 0
        or $foreigndeps > 0
        or ($summary_unsatdeps ne '?' && $summary_unsatdeps > 0)
        or ($summary_modif ne '?' && $summary_modif > 0)
        or ($summary_orphaned ne '?' && $summary_orphaned > 0)
        or ($mixed_sp > 0)
    ) {
    Report(<<EOF);
  With a number of changes, your system can receive support from SUSE/Novell.
  In order to ensure supportability, please resolve the following item(s):

EOF

    if($needrefresh) {
        $msg=<<EOF;
    - One or more repositories need to be updated. SAM was not able to check if your
      installed SUSE/Novell software has the versions required to be supported.
      Please update your repositories for example by running 'zypper refresh'.
      Then re-run SAM.
EOF
        Report($msg);
        x_ts('recommendation');
        x_t('message', x_cleantext($msg));
        x_ts('content');
        foreach(sort(keys %repo_to_refresh)) {
            Report("        - repository '$_'\n");
            x_t('repository', $_);
        }
        x_te();
        x_te();
    }

    if ($summary_updates > 0) {
        $msg="    - One or more SUSE/Novell packages are not up to date:\n";
        Report($msg);
        x_ts('recommendation');
        x_t('message', x_cleantext($msg));
        x_ts('content');
        foreach(sort(keys %newer_exists)) {
            Report("        - $_\n");
            x_t('package', $_);
        }
        x_te();
        x_te();
        Report("    Please update these package(s) and then re-run SAM.\n");
    }

    if ($num_foreign > 0) {
        $msg="    - Package(s) not created by SUSE/Novell have been found:\n";
        Report($msg);
        x_ts('recommendation');
        x_t('message', x_cleantext($msg));
        x_ts('content');
        foreach(sort(keys %foreigninfo)) {
            Report("        - $_\n");
            x_t('package', $_);
        }
        x_te();
        x_te();

        $msg=<<EOF;
      These packages are not part of your SUSE/Novell product.
      SUSE/Novell support engineers might ask you to direct support requests to
      the manufacturer of these packages.
EOF
        Report($msg);
    }

    if(0) {
    # if
    Report("    - There are broken dependencies in the following packages:\n");
    $msg=<<EOF;
      According to the rpm database there are broken dependencies,
      meaning your system is incomplete. Please see the logfile for details.
      After resolving the situation, please re-run SAM.
EOF
    Report("....\n");
    }

    if ($foreigndeps > 0) {
        $msg="    - There are broken dependencies in SUSE/Novell packages:\n";
        Report($msg);
        x_ts('recommendation');
        x_t('message', x_cleantext($msg));
        x_ts('content');
        foreach(sort(keys %depends_on_foreign)) {
            Report("        - $_\n");
            x_t('package', $_);
        }
        x_te();
        x_te();

        $msg=<<EOF;
      According to the rpm database these packages depend on other
      packages not provided by SUSE/Novell.  Please repair dependencies by
      installing SUSE/Novell packages.
EOF
        Report($msg);
    }

    if ($summary_unsatdeps ne '?' && $summary_unsatdeps > 0) {
        $msg="    - Unsatisfied SUSE/Novell package dependencies:\n";
        Report($msg);
        x_ts('recommendation');
        x_t('message', x_cleantext($msg));
        x_ts('content');
        foreach(sort(keys %unsatisfied)) {
            Report("        - $_\n");
            x_t('package', $_);
        }
        x_te();
        x_te();

        $msg=<<EOF;
      According to the rpm database these SUSE/Novell packages depend on
      packages which are not installed.
EOF
        Report($msg);
    }

    if ($summary_modif ne '?' && $summary_modif > 0) {
        $msg="    - Package(s) with unsupported file modifications have been found:\n";
        Report($msg);
        x_ts('recommendation');
        x_t('message', x_cleantext($msg));
        x_ts('content');
        foreach(keys %unsupportable) {
            Report("        - $_\n");
            x_t('package', $_);
        }
        x_te();
        x_te();
    }

    if ($summary_orphaned ne '?' && $summary_orphaned > 0) {
        $msg="    - File(s) not belonging to any package have been found:\n";
        Report($msg);
        x_ts('recommendation');
        x_t('message', x_cleantext($msg));
        x_ts('content');
        foreach(@orphans) {
            Report("        - $_\n");
            x_t('package', $_);
        }
        x_te();
        x_te();

        Report("       Usually this is not a problem, but SAM cannot assess\n");
        Report("       supportability related to these files.\n");
    }

    if ($mixed_sp > 0) {
        $msg=<<EOF;
    - Mixed service packs detected. There are packages installed in version
      unsupported in the latest service pack detected:
EOF
        Report($msg);
        x_ts('recommendation');
        x_t('message', x_cleantext($msg));
        x_ts('content');
        foreach my $prod (keys %{$corepkg_out_old}) {
            my $cnt_old = scalar(@{$corepkg_out_old->{$prod}});
            if ($cnt_old == 0) { next }
            my $cnt_new = scalar(@{$corepkg_out_new->{$prod}});
            my $sp_name = sp2str($max_corepkg_sp->{$prod});
            Report("        - product '" . $prod . "':\n");
            Report("            - core packages of $sp_name: " . $cnt_new . "\n");
            if ($opt_verbose > 0) {
                foreach my $pkg (@{$corepkg_out_new->{$prod}}) {
                    Report("                - " . $pkg . "\n");
                }
            }
            Report("            - core packages installed in version unsupported in $sp_name: "
                   . $cnt_old . "\n");
            foreach my $pkg (@{$corepkg_out_old->{$prod}}) {
                if ($opt_verbose > 0) {
                    Report("                - " . $pkg . "\n");
                }
                x_t('package', $pkg);
            }
        }
        if ($opt_verbose <= 0) {
            Report("        - to see full lists of core packages (rather than just counts),\n" .
                   "          use '-v' option\n");
        }
        x_te();
        x_te();
    }

    $noproblems = 0;
}

if($noproblems) {
    $msg=<<EOF;
    Congratulations, your system has passed the supportability analysis!
      According to the tests performed by SAM, nothing has been detected
      which might exclude your system from receiving support from
      SUSE/Novell. You may confidently deploy this system with support
      from SUSE/Novell.
EOF
    Report($msg);
    x_ts('recommendation');
    x_t('message', x_cleantext($msg));
    x_te();
}
Report("\n");
x_te();

x_out("</sam-report>\n");

# ===========================================================================
# html output
{
    my ($user, $system, $cuser, $csystem) = times;
    my $time_elapsed = time - $time_of_start;

    init_html();
    print(HTML "<b>SAM report ($report_ts)</b><br>");
    print(HTML "Console output from sam ",showhidebutton('sam_report'),'<pre id="sam_report">');
    print(HTML @report);
    print(HTML '</pre><br>');
    my @p_ok;
    my @p_unsup;
    my @p_f = keys %foreigninfo;
    foreach (keys %packinfo) {
        push(@p_unsup, $_), next if(exists $unsatisfied{$_});
        push(@p_unsup, $_), next if(exists $depends_on_foreign{$_});
        push(@p_unsup, $_), next if(exists $unsupportable{$_});
        push(@p_unsup, $_), next if(exists $newer_exists{$_});
        push @p_ok, $_;
    }
    print_package_table('tab_our_ok', 'SUSE/Novell packages without problems', @p_ok);
    print_package_table('tab_our_problem', 'SUSE/Novell packages with problems', @p_unsup);
    print_package_table('tab_foreign', 'Foreign packages', @p_f);
    finish_html();

    Log("*** Run info ***\n");
    if(0) {
    Log("  Filesystem: %s, %d inodes over all\n",
        pretty_print_size($sum_all_fsize), $sum_all_inodes);
    }
    Log("  RPM database: %s, %d inodes from %d packages\n",
        pretty_print_size($sum_pkg_fsize), $sum_pkg_inodes, scalar(keys(%packinfo)));
    Log("  Runtime: user %.2fs, system %.2fs, elapsed %.2fs\n",
        $user, $system, $time_elapsed);
}
__DATA__
=head1 NAME

SAM - Supportability Analysis Module

=head1 SYNOPSIS

sam [options...] [root_dir]

=head1 DESCRIPTION

A tool to check status of installed packages and products for supportability.
Generates a report to F<sam.report>. More detailed information is written to F<sam.log> file. Summarized
report of per-package supportability status is written to F<sam.html> file.

=head1 OPTIONS

B<General options>

If B<root_path> is specified, it will be used as the path to the root of the
installation to verify. This means: RPM database, zypper config, repositories.
External commands and temporary directory are not affected.

I<Note>: if not run under root, additional B<--noscripts> option is passed to C<rpm>
to skip running verification scripts, because it involves chroot and B<sam> would not
be able to proceed.

I<Note>: root of the checked filesystem must be writable, this is required by RPM.

=over 4

=item B<-o> I<dir> | B<--outdir> I<dir>

output directory for log and report files, default is the current directory

=item B<-t> I<dir> | B<--tmpdir> I<dir>

write temporary files to I<tmpdir>

The environment variable C<TMPDIR> is evaluated first.
If it is not set, the built-in default F</tmp>
is used. Last command line value of B<-t> is used.

=item B<-r> I<dir> | B<--refdata> I<dir>

specify directory with reference data, default is F</usr/share/suse-sam>

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

specify system architecture of the checked system

By default, the architecture of baseproduct is taken. All installed
products must have compatible architectures,
according to list given in F</usr/lib/rpm/rpmrc>.

=item B<-h> | B<--help>

print this help message

=item B<--man>

print help as a man page

=item B<-d> | B<--debug>

increase debug level (development only)

=back

B<Check options>

Options to switch off or on various performed checks. I<Note>, that for full
supportability status you should not specify options which switch checks off!
In usage scenarios where execution time matters AND eg. origin of packages is
verified beforehand, some of these options come handy.

=over 4

=item B<--no-header-sig-check>

skip checking GPG signature of package headers

If specified, package vendors are classified by vendor string in rpm header, which
may be inaccurate.

=item B<--no-rpm-verify>

skip verifying installed files against the RPM database

All packaged files are checked for integrity against RPM database. Changes to
owner, group and modification time are not considered significant for supportability
and do not show up in reports.

=item B<--no-rpm-verify-md5>

do not check MD5 when running C<rpm --verify>

This option speeds up runtime by 70% at the cost of low accuracy of found
results and your system may not be in supportable state.

=item B<--orphan-search>

search for orphaned files (not part of any package)

Traverse root partition and match
against list of files from RPM database. Does not enter directories like F</proc>,
F</home>, F</tmp>, F</root>, F</man/whatis*>

=item B<--skip-unmatched-prod>

skip repositories for not installed products (not skipped by default)

Match only repositories whose C<distribution> field matches at least one installed
SUSE/Novell product and repository servicepack level is not greater than product level.

=item B<--use-all-products>

use metadata of all products (even those not installed)

Revert to the old behaviour where all packaged repository metadata were used,
even those for products not installed in the system (e.g. SLED repositories if
SLES is installed). Unlike B<--skip-unmatched-products>, this matches
the repositories by C<product> field rather than C<distribution>.

=item B<--strict-repo-description>

skip repositories with unfilled required description fields (default)

Repository description is expected to contain these fields: name, label, distribution.
If one of them is empty, the repository is skipped. You can override this behaviour
by B<--no-strict-repo-description>.

=back

B<Configuration settings>

=over 4

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

set configuration directory I<type> to I<path>, where type is one of:

=over 8

=item B<solv> - directory with repository F<solv> files

=item B<keys> - directory with GPG keys, files matching *.asc or *.key are considered

=item B<repos> - directory with *.repo files

=back

Solvfiles and metadata directories further expect directories named after repositories
(the repository id) in which F<solv> and repository metadata are found. For example see
structure of zypp in F</etc/zypp/repos.d> and F</var/cache/zypp>. This option is useful
when B<sam> is run on an image where no zypper has been run yet and solv files do not
exist yet. Then, you specify external directories instead.

=back

B<Output>

Options which affect amount or level of detail of printed information.

=over 4

=item B<--pkg-summary>

print per-package problem summary to screen as well (always printed to F<sam.log>)

=item B<--spreport>

print report of service pack coverage (always printed to F<sam.log>)

Example:

 Product           SP  Exclusive    / %  Shared    / %  Total      / %
 -----------------------------------------------------------------------
 SUSE_SLED 11      GA          1   0.2%     424  64.6%    425   64.79%
 SUSE_SLED 11     SP1        166  25.3%     424  64.6%    590   89.94%
 SUSE_SLES 11      GA          1   0.2%     478  72.9%    479   73.02%
 SUSE_SLES 11     SP1        177  27.0%     479  73.0%    656  100.00%
 other                                                      0    0.00%

Installed system is recognized as covered by SLES 11 SP1. Category 'other' contains all
packages which are not found in reference repositories. Coverage below 100% does
not directly mean the system is unsupported, logfiles need to be consulted.

=item B<--no-log-timestamp>

do not write log/report/html to timestamped file names, by default files
are named like F<sam-20090323-15:09.log> etc.

=item B<--log-commands>

log executed commands and output in logfile

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

generally log even more messages, can be specified multiple times to increase
verbosity

=back

B<Experimental options>

Options not yet stable for general use. May change in the future.

=over 4

=item B<--exp> I<name>

switch option 'name' on:

=over 8

=item B<schema-zypper> - select zypper as default repo setup schema

=item B<schema-studio> - select studio schema; needs additional --dir arguments for metadata directories

=item B<schema-none> - use just repos from reference directory, no local will be found; do not expect zypper repo, do not require --dir ...

=back

=back

=head1 FILES AND DIRECTORIES

=over 4

=item F<sam.report>

Supportability report containing product summary, repository list and final
summary with recommendations.

Exact copy of what is printed on screen.

=item F<sam.log>

Log of events during B<sam> execution. As individual checks go, results are
printed with various details which are not suitable for quick overview, but are
useful to find exact reason why package is unsupported.

=item F<sam.html>

List of packages divided into sections: SUSE/Novell packages without any
problems (supported), our packages with some problems with descriptions
(unsupported), the rest are non-SUSE/Novell packages (unsupported by definition).

=item F<sam.xml>

Log file enhanced with tags.

=item F</usr/share/sam-data>

Directory with package reference data of latest released media, and
signature keys.

=back

=head1 CHECKS

Performed checks in detail.

=over 4

=item B<find products>

Look into F</etc/products.d> directory for installed products. Third party
products are skipped and if no SUSE/Novell product is found, B<sam> exits with
error. At least one SUSE/Novell package must be installed.

=item B<find repositories>

Search for all local repositories, filter only relevant for later use.

=item B<check package signatures>

=begin man

Verify package header signatures stored in RPM database and identify SUSE/Novell
and non-SUSE/Novell packages. Use signature keys from reference data.
.br
.ul 1
unsupportable:
non-SUSE/Novell
.br
.ul 1

=end man

packages

=item B<check package dependencies I>

=begin man

Check SUSE/Novell packages for broken dependencies.
.br
.ul 1
unsupportable:
SUSE/Novell packages with unsatisfied dependencies
.br
.ul 1
proposed fix:
reinstall the missing

=end man

packages

=item B<check package dependencies II>

=begin man

Look for SUSE/Novell packages which depend on non-SUSE/Novell packages.
.br
.ul 1
proposed fix:
check package origin and vendors, and look for corresponding packages in SUSE/Novell

=end man

repositories

=item B<find packages with an update available>

=begin man

Scan all available repository metadata for newer versions. Repository
is considered up-to-date if it's not older than 7 days. Reference repositories
ensure minimal product versions.
.br
.ul 1
unsupportable:
SUSE/Novell packages with newer version available
.ul 1
.br
proposed fix:
refresh repositories and 

=end man

update

=item B<verify package files by rpm>

Run B<rpm --verify> on SUSE/Novell packages and find changes mainly in MD5 checksums,
file types and if all packaged files are present.
Configuration files are not taken into account for obvious reasons.
However, it is possible that the check gives
some false positives. Clarify supportability status with your support contact if
not sure.

Note: when a package is installed with B<--excludepath> option, the excluded
files should not be included during C<rpm --verify> checks, however B<rpm> does
not behave like this. B<Sam> only verifies files from the C<rpm -ql> list. In
other cases, false positives may be reported.

=back

=head1 EXAMPLES

=over 4

=item C<sam>

basic run, on-screen report summary, all checks performed, output to
F<sam-TIMESTAMP.log> .html/.report/.xml files

=item C<sam -o ~/sam-logs>

the report files are created inside the F<~/sam-logs> directory

=item C<sam --no-rpm-verify-md5>

quick run

=item C<sam -o ~/sam-logs --sysarch x86_64 /mnt/product-image>

check mounted image of some product, explicitly saying it's architecture (eg.
if running B<sam> from i386 or ia64)

=item C<sam -o ~/sam-logs --sysarch x86_64 --refdata ~/sam-prod-metadata /mnt/product-image>

like above but supply your reference metadata, which are related to the F<product-image>

=item C<sam --sysarch x86_64 --spreport>

print service pack report on screen too

=back

=head1 COPYRIGHT

2009, 2010 SuSE Linux AG, Nuernberg, Germany.

=cut
# man: pod2man --center 'SAM Documentation' --release `cat ./VERSION ` --section 1 sam > sam.1
# html: pod2html --title "SAM "`cat ./VERSION ` --infile=sam --outfile=sam.html
# vim: set et ts=8 sts=4 sw=4 ai si:
