urpm-tools/urpm-repoclosure.pl

#!/usr/bin/perl
########################################################
# URPM Repo Closure Checker 1.6.1 for Linux
# A tool for checking closure of a set of RPM packages
#
# Copyright (C) 2011-2012 ROSA Laboratory
# Written by Andrey Ponomarenko
#
# PLATFORMS
# =========
#  Linux (ROSA, Mandriva, Mageia)
#
# REQUIREMENTS
# ============
#  - urpmi
#  - Perl 5 (>=5.8)
#  - Wget
#
# 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.
#
# 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, see <http://www.gnu.org/licenses/>.
########################################################
use Getopt::Long;
Getopt::Long::Configure ("posix_default", "no_ignore_case");
use Cwd qw(abs_path cwd);
use POSIX qw(strftime);
use File::Path qw(mkpath rmtree);
use File::Temp qw(tempdir);
use File::Copy qw(copy move);
use Data::Dumper;
use strict;

my $TOOL_VERSION = "1.6.1";
my $CmdName = get_filename($0);

my ($Help, $ShowVersion, $RPMlist, $RPMdir, $StaticMode,
$DynamicMode, $NoClean, $HDlist, $FileDeps, $ReportDir,
$AddRPMs, $RTitle, $DepHDlists, $UpdateHDlists, $Profile,
$Target, $ExtInfo);

my $ShortUsage = "URPM Repo Closure Checker $TOOL_VERSION
A tool for checking closure of a set of RPM packages
Copyright (C) 2012 ROSA Laboratory
License: GNU GPL

Usage: $CmdName [options]
Example: $CmdName --hdlist=hdlist.txt

More info: $CmdName --help\n";

if($#ARGV==-1) {
    print $ShortUsage."\n";
    exit(0);
}

GetOptions("h|help!" => \$Help,
  "v|version!" => \$ShowVersion,
  "l|list=s" => \$RPMlist,
  "d|dir=s" => \$RPMdir,
  "hdlist=s" => \$HDlist,
  "add=s" => \$AddRPMs,
  "file-deps=s" => \$FileDeps,
  "s|static!" => \$StaticMode,
  "dynamic!" => \$DynamicMode,
  "noclean!" => \$NoClean,
  "report-dir=s" => \$ReportDir,
  "title=s" => \$RTitle,
  "dep-hdlists=s" => \$DepHDlists,
  "update-hdlists=s" => \$UpdateHDlists,
  "profile=s" => \$Profile,
  "target=s" => \$Target,
  "info=s" => \$ExtInfo
) or ERR_MESSAGE();

my %EXIT_CODES = (
    "SUCCESS" => 0,
    "ERROR" => 1,
    "FAILED" => 2
);

my $HelpMessage = "
NAME:
  URPM Repo Closure Checker $TOOL_VERSION
  A tool for checking closure of a set of RPM packages

USAGE:
  $CmdName --hdlist=http://mirror.yandex.ru/mandriva/.../synthesis.hdlist.cz
  $CmdName --dir=rpms/ --static --file-deps=file-deps.txt
  $CmdName --list=list.txt --dynamic
  $CmdName --profile=profile.xml

OPTIONS:
  -h|-help
      Print this help.

  -v|-version
      Print version information.

  -hdlist <path>
      Path or URL of HDlist (synthesis) to check.

  -d|-dir <path>
      The directory with RPM packages to check.

  -l|-list <path>
      The list of packages to check.

  -updates <path>
      The directory with updated RPM packages.

  -file-deps <path>
      Read file-deps to ignore some unresolved
      dependencies.

  -s|-static
      Check statically if all required dependencies are
      satisfied by provided dependencies in the set of
      RPM packages.

  -dynamic
      Install a set of RPM packages to the local chroot
      and check if extra packages were installed.

  -noclean
      Do not clean urpmi cache.
      
  -report-dir <dir>
      The directory where to generate report(s).
      
  -title <name>
      Name of the repository in the title of HTML report.

  -dep-hdlists <path>
      The list of HDlists that will
      be used to resolve dependencies.
      
  -update-hdlists <path>
      The list of HDlists from update repositories.
      
  -profile <path>
      Profile of the test run.
      
  -target <name>
      Run particular test described in the profile.
      
  -info <path>
      The list of paths to info.xml.lzma files.
      
PROFILE FORMAT:

    <repos>
        <distr>
            2012lts
        </distr>
        
        <name>
            ROSA 2012 LTS
        </name>
        
        <arch>
            i586
        </arch>
        
        <section>
            contrib
        </section>
        
        <hdlist>
            http://abf.rosalinux.ru/downloads/rosa2012lts/repository/i586/contrib/release/media_info/synthesis.hdlist.cz
        </hdlist>
        
        <updates>
            http://abf.rosalinux.ru/downloads/rosa2012lts/repository/i586/contrib/updates/media_info/synthesis.hdlist.cz
        </updates>
        
        <deps>
            http://abf.rosalinux.ru/downloads/rosa2012lts/repository/i586/main/release/media_info/synthesis.hdlist.cz
            http://abf.rosalinux.ru/downloads/rosa2012lts/repository/i586/main/updates/media_info/synthesis.hdlist.cz
        </deps>
        
        <info>
            http://abf.rosalinux.ru/downloads/rosa2012lts/repository/i586/contrib/release/media_info/info.xml.lzma
            http://abf.rosalinux.ru/downloads/rosa2012lts/repository/i586/contrib/updates/media_info/info.xml.lzma
        </info>
    </repos>
    
    <repos>
        ...
    </repos>


EXIT CODES:
      0 - Suceess. The tool has run without any errors
      non-zero - Failed or the tool has run with errors. In particular:
      1 - Failed to run the tool
      2 - Discovered dependency problems
      
\n";

sub HELP_MESSAGE() {
    print $HelpMessage;
}

sub ERR_MESSAGE()
{
    print $ShortUsage;
    exit(1);
}

my %Cache;
my $RPM_CACHE = "/var/cache/urpmi/rpms";
my $TMP_DIR = tempdir(CLEANUP=>1);
my %InstalledPackage;
my %RequiredBy;
my %Packages;
my %BrokenSignature;
my %InstallFailed;
my $RESULTS_DIR = "repoclosure_reports";

sub parseTag(@)
{
    my $CodeRef = shift(@_);
    my $Tag = shift(@_);
    if(not $Tag or not $CodeRef) {
        return undef;
    }
    my $Sp = 0;
    if(@_) {
        $Sp = shift(@_);
    }
    my $Start = index(${$CodeRef}, "<$Tag>");
    if($Start!=-1)
    {
        my $End = index(${$CodeRef}, "</$Tag>");
        if($End!=-1)
        {
            my $TS = length($Tag)+3;
            my $Content = substr(${$CodeRef}, $Start, $End-$Start+$TS, "");
            substr($Content, 0, $TS-1, ""); # cut start tag
            substr($Content, -$TS, $TS, ""); # cut end tag
            if(not $Sp)
            {
                $Content=~s/\A\s+//g;
                $Content=~s/\s+\Z//g;
            }
            return $Content;
        }
    }
    return undef;
}

sub appendFile($$)
{
    my ($Path, $Content) = @_;
    return if(not $Path);
    if(my $Dir = get_dirname($Path)) {
        mkpath($Dir);
    }
    open(FILE, ">>".$Path) || die "can't open file \'$Path\': $!\n";
    print FILE $Content;
    close(FILE);
}

sub writeFile($$)
{
    my ($Path, $Content) = @_;
    return if(not $Path);
    if(my $Dir = get_dirname($Path)) {
        mkpath($Dir);
    }
    open (FILE, ">".$Path) || die "can't open file \'$Path\': $!\n";
    print FILE $Content;
    close(FILE);
}

sub readFile($)
{
    my $Path = $_[0];
    return "" if(not $Path or not -f $Path);
    open (FILE, $Path);
    local $/ = undef;
    my $Content = <FILE>;
    close(FILE);
    return $Content;
}

sub get_filename($)
{ # much faster than basename() from File::Basename module
    if($_[0]=~/([^\/\\]+)[\/\\]*\Z/) {
        return $1;
    }
    return "";
}

sub get_dirname($)
{ # much faster than dirname() from File::Basename module
    if($_[0]=~/\A(.*?)[\/\\]+[^\/\\]*[\/\\]*\Z/) {
        return $1;
    }
    return "";
}

sub searchRPMs($)
{
    my $Path = $_[0];
    if(not $Path or not -d $Path) {
        return ();
    }
    my @RPMs = split("\n", `find $Path -type f -name "*.rpm"`); # -maxdepth 1
    return sort {lc($a) cmp lc($b)} @RPMs;
}

sub installPackage($)
{
    my $Package = $_[0];
    my $Cmd = "/usr/sbin/urpmi";
    # create root where to install packages
    if(not -d $TMP_DIR."/root") {
        mkpath($TMP_DIR."/root");
    }
    $Cmd .= " --no-install";
    $Cmd .= " --root=\"$TMP_DIR/root\"";
    $Cmd .= " --noclean --auto --force";
    $Cmd .= " $Package";
    print "Running $Cmd\n";
    my $LogPath = $TMP_DIR."/ilog.txt";
    system($Cmd." >$LogPath 2>&1");
    my $Log = readFile($LogPath);
    appendFile("$RESULTS_DIR/install-log.txt", $Log);
    $Log=~s/The following packages have to be removed (.|\n)*\Z//g;
    if($Log=~/ (unsatisfied|conflicts with|missing) ([\w\-\/]*)/i)
    {
        my ($Reason, $Dep) = ($1, $2);
        $InstallFailed{getPName($Package)}=1;
        print "  FAILED: due to $Reason $Dep\n";
    }
    # downloaded
    while($Log=~s/(\/)([^\/\s]+\.rpm)(\s|\Z)/$1$3/)
    {
        my $RpmName = $2;
        print "  $RpmName\n";
        $RequiredBy{getPName($RPM_CACHE."/".$RpmName)} = getPName($Package);
    }
}

sub get_RPMname($)
{
    my $Path = $_[0];
    my $Name = get_filename($Path);
    if($Cache{"get_RPMname"}{$Name}) {
        return $Cache{"get_RPMname"}{$Name};
    }
    if(not $Path or not -f $Path) {
        return "";
    }
    return ($Cache{"get_RPMname"}{$Name} = `rpm -qp --queryformat \%{name} \"$Path\"`);
}

sub sepDep($)
{
    my $Dep = $_[0];
    if($Dep=~/\A(.+?)(\s+|\[)(=|==|<=|>=|<|>)\s+(.+?)(\]|\Z)/)
    {
        my ($N, $O, $V) = ($1, $3, $4);
        # canonify version (1:3.2.5-5:2011.0)
        return ($N, $O, $V);
    }
    else {
        return ($Dep, "", "");
    }
}

sub showDep($$$)
{
    my ($N, $O, $V) = @_;
    if($O and $V) {
        return $N." ".$O." ".$V;
    }
    else {
        return $N
    }
}

sub sepVersion($)
{
    my $V = $_[0];
    if($V=~/\A(.+)(\-[^\-\:]+)(\:[^\:]+|)\Z/)
    { # 3.2.5-5:2011.0
        return ($1, $2, $3);
    }
    return ($V, "", "");
}

sub simpleVersion($)
{ # x.y.z-r:n to x.y.z.r.n
    my $V = $_[0];
    $V=~s/[\-:]/\./g; # -5:2011.0
    $V=~s/[a-z]+/\./ig; # 10-12mdk
    $V=~s/\.\Z//g;
    return $V;
}

sub formatVersions(@)
{ # V1 - provided
  # V2 - required
    my ($V1, $V2) = @_;
    my ($E1, $E2) = ();
    if($V1=~s/\A([^\-\:]+)\://) {
        $E1 = $1;
    }
    if($V2=~s/\A([^\-\:]+)\://) {
        $E2 = $1;
    }
    my ($V1_M, $V1_R, $V1_RR) = sepVersion($V1);
    my ($V2_M, $V2_R, $V2_RR) = sepVersion($V2);
    if(not $V2_RR) {
        $V1_RR = "";
    }
    if(not $V2_R) {
        $V1_R = "";
    }
    $V1 = $V1_M.$V1_R.$V1_RR;
    $V2 = $V2_M.$V2_R.$V2_RR;
    if(defined $E1 and defined $E2)
    {
        $V1 = $E1.".".$V1;
        $V2 = $E2.".".$V2;
    }
    return (simpleVersion($V1), simpleVersion($V2));
}

sub cmpVersions($$)
{ # compare two versions
  # 3.2.5-5:2011.0
  # NOTE: perl 5.00503 and 5.12
    my ($V1, $V2) = formatVersions(@_);
    return 0 if($V1 eq $V2);
    my @V1Parts = split(/\./, $V1);
    my @V2Parts = split(/\./, $V2);
    for (my $i = 0; $i <= $#V1Parts && $i <= $#V2Parts; $i++)
    {
        my $N1 = $V1Parts[$i];
        my $N2 = $V2Parts[$i];
        if(defined $N1 and not defined $N2) {
            return 1;
        }
        elsif(not defined $N1 and defined $N2) {
            return -1;
        }
        if(my $R = cmpNums($N1, $N2)) {
            return $R;
        }
    }
    return -1 if($#V1Parts < $#V2Parts);
    return 1 if($#V1Parts > $#V2Parts);
    return 0;
}

sub cmpNums($$)
{
    my ($N1, $N2) = @_;
    # 00503
    # 12
    if($N1 eq $N2) {
        return 0;
    }
    while($N1=~s/\A0([0]*[1-9]+)/$1/) {
        $N2.="0";
    }
    while($N2=~s/\A0([0]*[1-9]+)/$1/) {
        $N1.="0";
    }
    return int($N1)<=>int($N2);
}

sub checkDeps($$$$)
{
    my ($N, $O, $V, $Provides) = @_;
    if(not $O or not $V)
    { # requires any version
        return 1;
    }
    foreach my $OP (keys(%{$Provides}))
    {
        if(not $OP)
        { # provides any version
            return 1;
        }
        foreach my $VP (keys(%{$Provides->{$OP}}))
        {
            if($O eq "=" or $O eq "==")
            {
                if(cmpVersions($VP, $V)==0)
                { # requires the same version
                    return 1;
                }
            }
            elsif($O eq "<=")
            {
                if(cmpVersions($VP, $V)<=0) {
                    return 1;
                }
            }
            elsif($O eq ">=")
            {
                if(cmpVersions($VP, $V)>=0) {
                    return 1;
                }
            }
            elsif($O eq "<")
            {
                if(cmpVersions($VP, $V)<0) {
                    return 1;
                }
            }
            elsif($O eq ">")
            {
                if(cmpVersions($VP, $V)>0) {
                    return 1;
                }
            }
        }
    }
    return 0;
}

sub checkSignature($)
{
    my $Path = $_[0];
    my $Info = `rpm --checksig $Path`;
    if($Info!~/ OK(\s|\Z)/) {
        $BrokenSignature{getPName($Path)}=1;
        return 0;
    }
    return 1;
}

sub checkRoot()
{
    if(not -w "/usr") {
        print STDERR "ERROR: you should be root\n";
        exit(1);
    }
}

sub readRPMlist($$)
{
    my ($Path, $Type) = @_;
    if(not -f $Path)
    {
        print STDERR "ERROR: cannot access \'$Path\'\n";
        exit(1);
    }
    my @RPMs = split(/\s+/, readFile($Path));
    if($#RPMs==-1) {
        print STDERR "ERROR: the list of packages is empty\n";
        exit(1);
    }
    if($Type eq "RPMs")
    {
        foreach my $P (@RPMs)
        {
            if($P!~/\.rpm\Z/)
            {
                print STDERR "ERROR: file \'$P\' is not RPM package\n";
                exit(1);
            }
            elsif(not -f $P)
            {
                print STDERR "ERROR: cannot access \'$P\'\n";
                exit(1);
            }
        }
    }
    return @RPMs;
}

sub dynamicCheck()
{
    checkRoot();
    if(not $RPMdir and not $RPMlist)
    {
        print STDERR "ERROR: --dir or --list option should be specified\n";
        exit(1);
    }
    clearCache();
    my @RPMs = ();
    if($RPMdir)
    { # --dir option
        if(not -d $RPMdir)
        {
            print STDERR "ERROR: cannot access \'$RPMdir\'\n";
            exit(1);
        }
        @RPMs = searchRPMs($RPMdir);
        foreach my $Path (@RPMs)
        { # add to cache
            copy($Path, $RPM_CACHE);
        }
        foreach my $Path (@RPMs)
        {
            installPackage($Path);
            $Packages{get_RPMname($Path)} = 1;
            $Packages{get_filename($Path)} = 1;
        }
    }
    elsif($RPMlist)
    {
        @RPMs = readRPMlist($RPMlist, "Names");
        foreach my $Name (@RPMs)
        {
            installPackage($Name);
            $Packages{$Name} = 1;
        }
    }
    checkResult();
}

sub getPName($)
{ # package ID
    my $Path = $_[0];
    if($RPMdir or not -f $Path)
    { # input: RPMs
        return get_filename($Path);
    }
    else
    { # input: RPM names
        return get_RPMname($Path);
    }
}

sub isInstalled($)
{
    my $Name = $_[0];
    if($InstallFailed{$Name}) {
        return 0;
    }
    if(not $InstalledPackage{$Name}) {
        return 0;
    }
    return 1;
}

sub checkResult()
{
    my (%ExtraPackages, %BrokenPackages) = ();
    foreach my $Path (searchRPMs($RPM_CACHE))
    { # extra
        my $Name = getPName($Path);
        $InstalledPackage{$Name} = 1;
        if(not $Packages{$Name}) {
            $ExtraPackages{$Name} = $Path;
        }
    }
    foreach my $Name (keys(%Packages))
    { # broken
        if(not isInstalled($Name)) {
            $BrokenPackages{$Name}=1;
        }
    }
    if(my @Names = sort {lc($a) cmp lc($b)} keys(%ExtraPackages))
    {
        my $Report = "Extra Packages:\n\n";
        foreach my $Name (@Names)
        {
            $Report .= $Name;
            if(my $Req = $RequiredBy{$Name}) {
                $Report .= " (required by: $Req)";
            }
            $Report .= "\n";
        }
        print $Report;
        writeFile("$RESULTS_DIR/extra-packages.txt", $Report);
    }
    if(my @Names = sort {lc($a) cmp lc($b)} keys(%BrokenPackages))
    {
        my $Report = "Broken Packages:\n\n";
        foreach my $Name (@Names) {
            $Report .= "$Name\n";
        }
        print $Report;
        writeFile("$RESULTS_DIR/broken-packages.txt", $Report);
    }
    print "Report has been generated to:";
    print "\n  $RESULTS_DIR/extra-packages.txt\n  $RESULTS_DIR/broken-packages.txt\n";
    if(keys(%ExtraPackages) or keys(%BrokenPackages))
    {
        exit($EXIT_CODES{"FAILED"});
    }
    else {
        exit($EXIT_CODES{"SUCCESS"});
    }
}

sub readLineNum($$)
{
    my ($Path, $Num) = @_;
    return "" if(not $Path or not -f $Path);
    open (FILE, $Path);
    foreach (1 ... $Num) {
        <FILE>;
    }
    my $Line = <FILE>;
    close(FILE);
    return $Line;
}

sub cmd_find($$$$)
{
    my ($Path, $Type, $Name, $MaxDepth) = @_;
    return () if(not $Path or not -e $Path);
    my $Cmd = "find \"$Path\"";
    if($MaxDepth) {
        $Cmd .= " -maxdepth $MaxDepth";
    }
    if($Type) {
        $Cmd .= " -type $Type";
    }
    if($Name) {
        if($Name=~/\]/) {
            $Cmd .= " -regex \"$Name\"";
        }
        else {
            $Cmd .= " -name \"$Name\"";
        }
    }
    return split(/\n/, `$Cmd`);
}

sub readDeps($$$)
{
    my ($Path, $Dep, $RPMdep) = @_;
    my $Name = get_filename($Path);
    foreach my $Type ("provides", "suggests", "requires")
    {
        foreach my $D (split("\n", `rpm -qp -$Type $Path`))
        {
            my ($N, $O, $V) = sepDep($D);
            $Dep->{$Type}{$N}{$O}{$V}{$Name}=1;
            $RPMdep->{$Type}{$Name}{$N}=1;
        }
    }
}

sub downloadFile($)
{
    my $Path = $_[0];
    my $DownloadTo = $TMP_DIR."/extract/".get_filename($Path);
    $DownloadTo=~s/\.cz/\.gz/g; # cz == gz
    my $Dir = get_dirname($DownloadTo);
    mkdir($Dir);
    system("wget -U '' --no-check-certificate \"$Path\" --connect-timeout=5 --tries=1 --output-document=\"$DownloadTo\" >/dev/null 2>&1");
    if(not -f $DownloadTo
    or not -s $DownloadTo)
    {
        print STDERR "ERROR: cannot access \'$Path\'\n";
        exit(1);
    }
    
    my %Extract = (
        "xz"=>"unxz",
        "lzma"=>"unlzma",
        "gz"=>"gunzip"
    );
    if($DownloadTo=~/\.(gz|xz|lzma)\Z/)
    {
        my ($Format, $Cmd) = ($1, $Extract{$1});
        if($Cmd) {
            system("cd $Dir && $Cmd $DownloadTo");
        }
        my @Files = cmd_find($Dir, "f", "", "");
        if(not @Files)
        {
            print STDERR "ERROR: cannot extract \'$Path\'\n";
            exit(1);
        }
        unlink($DownloadTo);
        $DownloadTo = $Files[0];
    }
    return $DownloadTo;
}

sub readInfo($$)
{
    my ($Path, $Info) = @_;
    my $Content = "";
    if($Path=~/(http|https|ftp):\/\//)
    {
        print "Downloading Info ...\n";
        $Path = downloadFile($Path);
    }
    else
    {
        if(not -f $Path)
        {
            print STDERR "ERROR: cannot access \'$Path\'\n";
            exit(1);
        }
    }
    
    my $RPM = "";
    open(INFO, $Path) || die "can't open file \'$Path\': $!\n";
    while(<INFO>)
    {
        if(index($_, "fn=")!=-1)
        {
            if(/fn=\"(.+?)\"/) {
                $RPM = $1;
            }
            else {
                $RPM = "";
            }
        }
        if($RPM)
        {
            if(index($_, "sourcerpm=")!=-1)
            {
                if(/sourcerpm=\'(.+?)\'/)
                {
                    my $SRPM = $1;
                    $SRPM=~s/\.src\.rpm//g;
                    $SRPM=~s/\.srpm//g;
                    $Info->{$RPM}{"SRPM"} = $SRPM;
                }
                else {
                    $RPM = "";
                }
            }
        }
    }
    close(INFO);
    rmtree($TMP_DIR."/extract/");
}

sub readHDlist($$$$$)
{
    my ($Path, $Dep, $RPMdep, $Registered, $Kind) = @_;
    
    my $Content = "";
    if($Path=~/(http|https|ftp):\/\//)
    {
        print "Downloading $Kind HDlist ...\n";
        my $DownloadTo = downloadFile($Path);
        if(my $Line = readLineNum($DownloadTo, 1))
        {
            if($Line!~/\A\@\w+\@/)
            {
                print STDERR "ERROR: unknown format of hdlist\n";
                exit(1);
            }
        }
        $Content = readFile($DownloadTo);
    }
    else
    {
        if(not -f $Path)
        {
            print STDERR "ERROR: cannot access \'$Path\'\n";
            exit(1);
        }
        $Content = readFile($Path);
    }
    print "Reading $Kind HDlist ...\n";
    
    my $TKind = $Kind;
    if($TKind eq "Update") {
        $TKind = "Target";
    }
    
    my %PkgName = ();
    my $Name = "";
    foreach (reverse(split(/\n/, $Content)))
    {
        $_=~s/\A\@//g;
        my @Parts = split("\@", $_);
        my $Type = shift(@Parts);
        if($Type eq "info")
        {
            if($Kind eq "Update")
            {
                if($Name)
                { # register previous
                    $Registered->{$TKind}{$PkgName{$Name}} = 1;
                }
            }
            $Name = $Parts[0];
            next;
        }
        if(my $PName = parse_RPMname($Name))
        {
            $PkgName{$Name} = $PName;
            if($Kind eq "Target")
            {
                if($Registered->{$TKind}{$PName})
                { # already added
                    next;
                }
            }
        }
        
        if($Type=~/\A(requires|provides|suggests)\Z/)
        {
            foreach my $D (@Parts)
            {
                my ($N, $O, $V) = sepDep($D);
                $N=~s/\[\*\]//g; # /sbin/ldconfig[*]
                $Dep->{$Type}{$N}{$O}{$V}{$Name} = 1;
                $RPMdep->{$Type}{$Name}{$D} = 1;
            }
        }
    }
    if($Kind eq "Update")
    {
        if($Name)
        { # register last
            $Registered->{$TKind}{$PkgName{$Name}} = 1;
        }
    }
    rmtree($TMP_DIR."/extract/");
}

sub staticCheck()
{
    if(not $RPMdir and not $HDlist and not $RPMlist)
    {
        print STDERR "ERROR: --hdlist, --dir or --list option should be specified\n";
        exit(1);
    }
    
    my %AddInfo = ();
    
    if($ExtInfo)
    {
        foreach my $Url (split(/\s+/, readFile($ExtInfo))) {
            readInfo($Url, \%AddInfo);
        }
    }
    
    my (%Dep, %RPMdep, %Registered) = ();
    my (%Dep_D, %RPMdep_D) = ();
    if($AddRPMs)
    {
        if(not -d $AddRPMs)
        {
            print STDERR "ERROR: cannot access \'$AddRPMs\'\n";
            exit(1);
        }
        if(my @AddedRPMs = searchRPMs($AddRPMs))
        {
            foreach my $Path (@AddedRPMs)
            {
                readDeps($Path, \%Dep, \%RPMdep);
                if(my $Name = get_RPMname($Path)) {
                    $Registered{$Name} = 1;
                }
            }
        }
    }
    if($UpdateHDlists)
    {
        if(not -f $UpdateHDlists)
        {
            print STDERR "ERROR: cannot access \'$UpdateHDlists\'\n";
            exit(1);
        }
        foreach my $Url (split(/\s+/, readFile($UpdateHDlists))) {
            readHDlist($Url, \%Dep, \%RPMdep, \%Registered, "Update");
        }
        
    }
    if($RPMdir or $RPMlist)
    {
        print "Checking RPMs ...\n";
        my @RPMs = ();
        if($RPMdir)
        {
            if(not -d $RPMdir)
            {
                print STDERR "ERROR: cannot access \'$RPMdir\'\n";
                exit(1);
            }
            @RPMs = searchRPMs($RPMdir);
        }
        elsif($RPMlist) {
            @RPMs = readRPMlist($RPMlist, "RPMs");
        }
        foreach my $Path (@RPMs)
        {
            if(my $Name = get_RPMname($Path))
            {
                if($Registered{$Name})
                { # already added
                    next;
                }
            }
            readDeps($Path, \%Dep, \%RPMdep);
        }
    }
    elsif($HDlist) {
        readHDlist($HDlist, \%Dep, \%RPMdep, \%Registered, "Target");
    }
    
    if($DepHDlists)
    {
        if(not -f $DepHDlists)
        {
            print STDERR "ERROR: cannot access \'$DepHDlists\'\n";
            exit(1);
        }
        foreach my $Url (split(/\s+/, readFile($DepHDlists))) {
            readHDlist($Url, \%Dep_D, \%RPMdep_D, \%Registered, "Dep");
        }
    }
    
    my %IgnoreDeps = ();
    if($FileDeps)
    {
        if(not -f $FileDeps)
        {
            print STDERR "ERROR: cannot access \'$FileDeps\'\n";
            exit(1);
        }
        %IgnoreDeps = map {$_=>1} split(/\s+/, readFile($FileDeps));
    }
    my (%Unresolved, %UnresolvedSuggested) = ();
    foreach my $N (sort {lc($a) cmp lc($b)} keys(%{$Dep{"requires"}}))
    {
        foreach my $O (keys(%{$Dep{"requires"}{$N}}))
        {
            foreach my $V (keys(%{$Dep{"requires"}{$N}{$O}}))
            {
                if((not defined $Dep{"provides"}{$N}
                or not checkDeps($N, $O, $V, $Dep{"provides"}{$N}))
                and (not defined $Dep_D{"provides"}{$N}
                or not checkDeps($N, $O, $V, $Dep_D{"provides"}{$N})))
                { # unresolved
                    if($N=~/\A(rpmlib|executable)\(.+\)\Z/)
                    { # rpmlib(PayloadIsLzma), ...
                      # executable(rm), ...
                        next;
                    }
                    if($IgnoreDeps{$N}) {
                        next;
                    }
                    foreach my $Name (keys(%{$Dep{"requires"}{$N}{$O}{$V}}))
                    {
                        if($RPMdep{"suggests"}{$Name}{$N}) {
                            $UnresolvedSuggested{$Name}{$N}{$O}{$V} = 1;
                        }
                        else {
                            $Unresolved{$Name}{$N}{$O}{$V} = 1;
                        }
                    }
                }
            }
        }
    }
    
    my $TotalPkgs = keys(%{$RPMdep{"requires"}});
    
    my ($Report, $VReport) = ();
    
    $VReport = "URPM-repoclosure report";
    if($RTitle) {
        # $VReport .= " for <span style='color:Blue;'>$RTitle</span>";
    }
    $VReport = "<h1>$VReport</h1>\n";
    $VReport .= "This report has been generated";
    if($HDlist) {
        $VReport .= " for this <a href=\'$HDlist\'>hdlist</a>";
    }
    
    $VReport .= " on ".strftime("%b %e %H:%M %Y", localtime(time)).".";
    $VReport .= "<br/>\n";
    
    $VReport .= "<h2>Test Info</h2>\n";
    #$VReport .= "<hr/>\n";
    $VReport .= "<table class='summary'>\n";
    
    if($RTitle) {
        $VReport .= "<tr><th>Repository</th><td width='100px'>$RTitle</td></tr>\n";
    }
    
    my $UnresolvedLink = "0 (0.0%)";
    if(my $Num = keys(%Unresolved)) {
        $UnresolvedLink = "<a href='#Unresolved'>".$Num."</a>"." (".show_number($Num*100/$TotalPkgs)."%)";
    }
    $VReport .= "<tr><th>Broken<br/>Packages</th><td>$UnresolvedLink</td></tr>\n";
    $VReport .= "</table>\n";
    
    $VReport .= "<br/>\n";
    $VReport .= "<br/>\n";
    
    if(my @Pkgs = sort {lc($a) cmp lc($b)} keys(%Unresolved))
    {
        my $Title = "Broken Packages (".($#Pkgs+1).")";
        $Report .= "\n$Title:\n\n";
        
        $VReport .= "<a name='Unresolved'></a>\n";
        $VReport .= "<table class='report'>\n";
        $VReport .= "<tr>\n";
        $VReport .= "<th onclick='javascript:sort(this)'>RPM</th>\n";
        if($ExtInfo) {
            $VReport .= "<th onclick=\"sort(this)\">SRPM</th>\n";
        }
        $VReport .= "<th onclick=\"sort(this)\">Dependency</th>\n";
        $VReport .= "</tr>\n";
        
        my $Num = 1;
        foreach my $Pkg (@Pkgs)
        {
            foreach my $N (sort keys(%{$Unresolved{$Pkg}}))
            {
                foreach my $O (sort keys(%{$Unresolved{$Pkg}{$N}}))
                {
                    foreach my $V (sort keys(%{$Unresolved{$Pkg}{$N}{$O}}))
                    {
                        my $Dep = showDep($N, $O, $V);
                        $Report .= $Dep." (required by $Pkg)\n";
                        my $Class = " class='even'";
                        $Class = "" if($Num++ % 2 != 0);
                        $VReport .= "<tr$Class>\n";
                        $VReport .= "<td>$Pkg</td>\n";
                        if($ExtInfo) {
                            $VReport .= "<td>".$AddInfo{$Pkg}{"SRPM"}."</td>\n";
                        }
                        $VReport .= "<td>".htmlSpecChars($Dep)."</td>\n";
                        $VReport .= "</tr>\n";
                    }
                }
            }
        }
        
        $VReport .= "</table>";
    }
    if(my @Pkgs = sort {lc($a) cmp lc($b)} keys(%UnresolvedSuggested))
    {
        if($Report)
        {
            $Report .= "\n";
            $VReport .= "<br/>\n";
        }
        
        my $Title = "Unresolved Suggests (".($#Pkgs+1).")";
        $Report .= "\n$Title:\n\n";
        
        $VReport .= "<table class='report'>\n";
        $VReport .= "<tr>\n";
        $VReport .= "<th onclick='javascript:sort(this)'>Suggestion (".($#Pkgs+1).")</th>\n";
        if($ExtInfo) {
            $VReport .= "<th onclick=\"sort(this)\">SRPM</th>\n";
        }
        $VReport .= "<th onclick=\"sort(this)\">RPM</th>\n";
        $VReport .= "</tr>\n";
        
        my $Num = 1;
        foreach my $Pkg (@Pkgs)
        {
            foreach my $N (sort keys(%{$UnresolvedSuggested{$Pkg}}))
            {
                foreach my $O (sort keys(%{$UnresolvedSuggested{$Pkg}{$N}}))
                {
                    foreach my $V (sort keys(%{$UnresolvedSuggested{$Pkg}{$N}{$O}}))
                    {
                        my $Dep = showDep($N, $O, $V);
                        $Report .= $Dep." (required by $Pkg)\n";
                        my $Class = " class='even'";
                        $Class = "" if($Num++ % 2 != 0);
                        $VReport .= "<tr$Class>\n";
                        $VReport .= "<td>".htmlSpecChars($Dep)."</td>\n";
                        if($ExtInfo) {
                            $VReport .= "<td>".$AddInfo{$Pkg}{"SRPM"}."</td>\n";
                        }
                        $VReport .= "<td>$Pkg</td>\n";
                        $VReport .= "</tr>\n";
                    }
                }
            }
        }
        
        $VReport .= "</table>";
    }
    
    my $Styles = "
    body {
        margin: 1.5em;
        color:Black;
    }
    h1 {
        font-size: 2em;
        margin-bottom:5px;
    }
    h2 {
        font-size: 1.5em;
        margin-bottom:0px;
    }
    hr {
        color:Black;
        background-color:Black;
        height:1px;
        border:0;
    }
    table.summary {
        border-collapse:collapse;
        border:1px outset black;
    }
    table.summary th {
        background-color:#EEEEEE;
        font-weight:100;
        text-align:left;
        border:1px inset gray;
        padding: 3px;
    }
    table.summary td {
        text-align:right;
        border:1px inset gray;
        padding: 3px 5px 3px 10px;
    }
    tr.even {
        background-color:#CCCCCC;
    }
    table.report th {
        border-bottom-style:double;
        font-weight:bold;
        text-align:center;
        font-size: 1.3em;
        padding:3px;
        cursor:pointer;
    }
    table.report td {
        text-align:left;
        padding-right:15px;
    }";
    
    my $Footer = "<hr/><div style='width:100%;font-size:11px;font-family:Arial;' align='right'><i>Generated on ".(localtime time);
    $Footer .= " by <a href='https://abf.rosalinux.ru/import/urpm-tools/'>URPM-repoclosure</a> $TOOL_VERSION &#160;</i></div><div style='height:50px;'></div>";
    
    my $Scripts = "
    function sort(el)
    { 
        var col_sort = el.innerHTML;
        var tr = el.parentNode;
        var table = tr.parentNode;
        var td, col_sort_num;
        for (var i=0; (td = tr.getElementsByTagName('th').item(i)); i++)
        {
            if(td.innerHTML == col_sort)
            {
                col_sort_num = i;
                if(td.prevsort == 'y') {
                    el.up = Number(!el.up);
                }
                else if(td.prevsort == 'n') {
                    td.prevsort = 'y';
                    el.up = 0;
                }
                else
                {
                    if(col_sort_num==0)
                    { // already sorted
                        td.prevsort = 'n';
                        el.up = 1;
                    }
                    else
                    {
                        td.prevsort = 'y';
                        el.up = 0;
                    }
                }
            }
            else
            {
                if(td.prevsort == 'y') {
                    td.prevsort = 'n';
                }
            }
        }
        
        var a = new Array();
        for(i=1; i < table.rows.length; i++)
        {
            a[i-1] = new Array();
            a[i-1][0] = table.rows[i].getElementsByTagName('td').item(col_sort_num).innerHTML;
            a[i-1][1] = table.rows[i];
        }
        a.sort(sort_array);
        if(el.up) a.reverse();  
        for(i=0; i < a.length; i++)
            table.appendChild(a[i][1]);
            
        for (var i = 1, row; row = table.rows[i]; i++)
        {
            if(i % 2 == 0) {
                row.className = 'even';
                
            }
            else {
                row.className = '';
            }
        }
    }

    function sort_array(a,b)
    {
        a = a[0].toLowerCase();
        b = b[0].toLowerCase();
        if( a == b) return 0;
        if( a > b) return 1;
        return -1;
    }";
    
    
    my $Title = "URPM-repoclosure report";
    my $Keywords = "URPM, repository, closure, report";
    my $Description = "URPM-repoclosure report";
    
    $VReport = composeHTML_Head($Title, $Keywords, $Description, $Styles, $Scripts)."<body>".$VReport."\n".$Footer."\n</body></html>\n";
    
    # report
    if($Report or $VReport)
    {
        print $Report."\n"; # on the screen
        writeFile("$RESULTS_DIR/report.html", $VReport);
        writeFile("$RESULTS_DIR/report.txt", $Report);
    }
    
    # debug info
    writeFile("$RESULTS_DIR/debug/target/rpm-provides.txt", Dumper($RPMdep{"provides"}));
    writeFile("$RESULTS_DIR/debug/target/rpm-requires.txt", Dumper($RPMdep{"requires"}));
    writeFile("$RESULTS_DIR/debug/target/rpm-suggests.txt", Dumper($RPMdep{"suggests"}));
    
    if(keys(%RPMdep_D))
    {
        writeFile("$RESULTS_DIR/debug/deps/rpm-provides.txt", Dumper($RPMdep_D{"provides"}));
        writeFile("$RESULTS_DIR/debug/deps/rpm-requires.txt", Dumper($RPMdep_D{"requires"}));
        writeFile("$RESULTS_DIR/debug/deps/rpm-suggests.txt", Dumper($RPMdep_D{"suggests"}));
    }
    
    print "Report has been generated to:";
    print "\n  $RESULTS_DIR/report.txt (html)\n\n";
    
    # exit code
    if(keys(%Unresolved)) {
        exit($EXIT_CODES{"FAILED"});
    }
    else {
        exit($EXIT_CODES{"SUCCESS"});
    }
}

sub composeHTML_Head($$$$$)
{
    my ($Title, $Keywords, $Description, $Styles, $Scripts) = @_;
    return "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">
    <html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">
    <head>
    <meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\" />
    <meta name=\"keywords\" content=\"$Keywords\" />
    <meta name=\"description\" content=\"$Description\" />
    <title>
        $Title
    </title>
    <style type=\"text/css\">
    $Styles
    </style>
    <script type=\"text/javascript\" language=\"JavaScript\">
    <!--
    $Scripts
    -->
    </script>
    </head>";
}

sub htmlSpecChars($)
{
    my $Str = $_[0];
    $Str=~s/\&([^#]|\Z)/&amp;$1/g;
    $Str=~s/</&lt;/g;
    $Str=~s/>/&gt;/g;
    return $Str;
}

sub show_number($)
{
    if($_[0])
    {
        my $Num = cut_off_number($_[0], 2, 0);
        if($Num eq "0")
        {
            foreach my $P (3 .. 7)
            {
                $Num = cut_off_number($_[0], $P, 1);
                if($Num ne "0") {
                    last;
                }
            }
        }
        if($Num eq "0") {
            $Num = $_[0];
        }
        return $Num;
    }
    return $_[0];
}

sub cut_off_number($$$)
{
    my ($num, $digs_to_cut, $z) = @_;
    if($num!~/\./)
    {
        $num .= ".";
        foreach (1 .. $digs_to_cut-1) {
            $num .= "0";
        }
    }
    elsif($num=~/\.(.+)\Z/ and length($1)<$digs_to_cut-1)
    {
        foreach (1 .. $digs_to_cut - 1 - length($1)) {
            $num .= "0";
        }
    }
    elsif($num=~/\d+\.(\d){$digs_to_cut,}/) {
      $num=sprintf("%.".($digs_to_cut-1)."f", $num);
    }
    $num=~s/\.[0]+\Z//g;
    if($z) {
        $num=~s/(\.[1-9]+)[0]+\Z/$1/g;
    }
    return $num;
}

sub parse_RPMname($)
{
    my $Name = $_[0];
    if($Name=~/\d(mdv|mdk|rosa(\.\w+|))\d+/)
    { # plexus-interactivity-1.0-0.1.a5.2.2.5mdv2011.0.i586
        $Name=~s/\-[^\-]+\Z//;
        $Name=~s/\-[^\-]+\Z//;
    }
    else
    { # x11-server-source-1.10.3-1-mdv2011.0.i586
        $Name=~s/\-[^\-]+\Z//;
        $Name=~s/\-[^\-]+\Z//;
        $Name=~s/\-[^\-]+\Z//;
    }
    return $Name;
}

sub clearCache()
{
    if(not $NoClean)
    {
        rmtree($RPM_CACHE);
        mkpath($RPM_CACHE);
    }
}

sub checkProfile()
{
    if(not -f $Profile)
    {
        print STDERR "ERROR: can't access \'$Profile\'\n";
        exit(1);
    }
    my $Content = readFile($Profile);
    my %Index = ();
    my (%Order, %Order_S) = ();
    my $Num = 0;
    while(my $Repos = parseTag(\$Content, "repos"))
    {
        my %Info = ();
        foreach my $Tag ("distr", "name", "arch", "section", "hdlist", "updates", "deps", "info") {
            $Info{$Tag} = parseTag(\$Repos, $Tag);
        }
        
        my $Dir = $Info{"distr"}."/".$Info{"arch"}."/".$Info{"section"};
        
        if(defined $Target and $Target ne $Dir) {
            next;
        }
        
        writeFile("dep.hdlists", $Info{"deps"});
        writeFile("update.hdlists", $Info{"updates"});
        writeFile("info.hdlists", $Info{"info"});
        
        my $Cmd = "perl urpm-repoclosure.pl";
        $Cmd .= " --hdlist=".$Info{"hdlist"};
        if($Info{"name"}) {
            $Cmd .= " --title=\"".$Info{"name"}."/".$Info{"arch"}."-".$Info{"section"}."\"";
        }
        if($Info{"deps"}) {
            $Cmd .= " --dep-hdlists=dep.hdlists";
        }
        if($Info{"updates"}) {
            $Cmd .= " --update-hdlists=update.hdlists";
        }
        if($Info{"info"}) {
            $Cmd .= " --info=info.hdlists";
        }
        $Cmd .= " --file-deps=file-deps.txt";
        
        print "Running $Cmd\n";
        
        system($Cmd." >/dev/null");
        
        $Info{"HTML"} = $Dir."/report.html";
        $Info{"TXT"} = $Dir."/report.txt";
        
        mkpath($Dir);
        move($RESULTS_DIR."/static/report.html", $Info{"HTML"});
        move($RESULTS_DIR."/static/report.txt", $Info{"TXT"});
        
        if(not defined $Target) {
            rmtree($RESULTS_DIR);
        }
        unlink("dep.hdlists");
        unlink("update.hdlists");
        
        $Index{$Info{"name"}}{$Info{"arch"}}{$Info{"section"}} = \%Info;
        $Order{$Info{"name"}} = $Num++;
        $Order_S{$Info{"name"}}{$Info{"section"}} = $Num++;
        $Order_S{$Info{"name"}}{$Info{"arch"}} = $Num++;
    }
    
    my $Styles = "
    body {
        margin: 1.5em;
        color:Black;
    }
    h1 {
        font-size: 2em;
        margin-bottom:5px;
    }
    h2 {
        font-size: 1.5em;
        margin-bottom:10px;
    }
    table.contents {
        border-collapse:collapse;
        border:1px Black solid;
        margin-left:15px;
        font-family:\"Times New Roman\";
    }
    table.contents td {
        padding:5px;
        font-size:16px;
    }
    table.summary {
        border-collapse:collapse;
        border:1px Black solid;
        margin-left:20px;
    }
    table.summary th {
        background-color:#F2F2F2;
        text-align:center;
        font-weight:100;
        padding: 3px;
        border:1px Black solid;
    }
    table.summary td {
        text-align:center;
        padding: 3px;
        border:1px Black solid;
    }";
    
    my $INDEX = "<h1>URPM-repoclosure report</h1>";
    $INDEX .= "This report has been updated on ".strftime("%b %e %H:%M %Y", localtime(time)).".\n";
    
    $INDEX .= "<br/>\n";
    
    # contents
    my $Contents = "<br/>\n<table class='contents'>\n";
    $Contents .= "<tr><td><b>Contents</b></td></tr>\n";
    foreach my $Name (sort {$Order{$a}<=>$Order{$b}} keys(%Index))
    {
        my $Anchor = $Name;
        $Anchor=~s/\s+/_/g;
        $Contents .= "<tr><td><a href=\'#$Anchor\'>$Name</a></td></tr>\n";
    }
    $Contents .= "</table>\n";
    
    if(keys(%Index)>=3)
    {
        $INDEX .= $Contents;
        $INDEX .= "<br/>\n";
    }
    
    foreach my $Name (sort {$Order{$a}<=>$Order{$b}} keys(%Index))
    {
        my $Anchor = $Name;
        $Anchor=~s/\s+/_/g;
        $INDEX .= "<a name=\'$Anchor\'></a>\n";
        $INDEX .= "<h2>$Name</h2>\n";
        $INDEX .= "<table class='summary'>\n";
        $INDEX .= "<tr>\n";
        $INDEX .= "<td></td>\n";
        foreach my $Arch (sort {$Order_S{$Name}{$a}<=>$Order_S{$Name}{$b}} keys(%{$Index{$Name}}))
        {
            foreach my $Section (sort {$Order_S{$Name}{$a}<=>$Order_S{$Name}{$b}} keys(%{$Index{$Name}{$Arch}}))
            {
                $INDEX .= "<th>$Section</th>\n";
            }
            last;
        }
        $INDEX .= "</tr>\n";
        foreach my $Arch (sort {$Order_S{$Name}{$a}<=>$Order_S{$Name}{$b}} keys(%{$Index{$Name}}))
        {
            $INDEX .= "<tr>\n";
            $INDEX .= "<th>$Arch</th>\n";
            foreach my $Section (sort {$Order_S{$Name}{$a}<=>$Order_S{$Name}{$b}} keys(%{$Index{$Name}{$Arch}}))
            {
                my %Info = %{$Index{$Name}{$Arch}{$Section}};
                $INDEX .= "<td><a href=\'".$Info{"HTML"}."\'>Report</a> (<a href=\'".$Info{"TXT"}."\'>txt</a>)</td>\n"; #  (<a href=\'".$Info{"TXT"}."\'>txt</a>)
            }
            $INDEX .= "</tr>\n";
        }
        $INDEX .= "</table>\n";
    }
    
    if(keys(%Index)>=3)
    {
        $INDEX .= "<div style='height:999px;'></div>\n";
    }
    
    my $Title = "URPM-repoclosure report";
    my $Keywords = "URPM, repository, closure, report";
    my $Description = "URPM-repoclosure report";
    
    $INDEX = composeHTML_Head($Title, $Keywords, $Description, $Styles, "")."<body>".$INDEX."\n</body></html>\n";
    
    writeFile("index.html", $INDEX);
    print "index.html has been created\n";
}

sub scenario()
{
    if($Help)
    {
        HELP_MESSAGE();
        exit(0);
    }
    if($ShowVersion)
    {
        print "URPM Repo Closure Checker $TOOL_VERSION\nCopyright (C) 2012 ROSA Laboratory\nLicense: GPL <http://www.gnu.org/licenses/>\nThis program is free software: you can redistribute it and/or modify it.\n\nWritten by Andrey Ponomarenko.\n";
        exit(0);
    }
    
    if($Profile)
    {
        checkProfile();
        exit(0);
    }
    
    if($HDlist) {
        $StaticMode = 1;
    }
    if($ReportDir) {
        $RESULTS_DIR = $ReportDir;
    }
    if(-d $RESULTS_DIR) {
        rmtree($RESULTS_DIR);
    }
    if($StaticMode)
    {
        if(not $ReportDir) {
            $RESULTS_DIR .= "/static";
        }
        staticCheck();
    }
    if($DynamicMode)
    {
        if(not $ReportDir) {
            $RESULTS_DIR .= "/dynamic";
        }
        dynamicCheck();
    }
    exit(0);
}

scenario();