Djam/urpm-tools
1
0
Fork 0
mirror of https://abf.rosa.ru/djam/urpm-tools.git synced 2025-02-23 17:32:46 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions
urpm-tools/urpm-repoclosure.pl
Andrey Ponomarenko 174c798bd9 URPM-repoclosure 1.4: added visual HTML report
2012-09-12 17:13:36 +04:00

1404 lines
34 KiB
Perl
Executable file
Raw Blame History

#!/usr/bin/perl
########################################################
# URPM Repos Closure Checker 1.4 for Linux
# A tool for checking closure of a set of RPM packages
#
# Copyright (C) 2012 ROSA Laboratory
# Written by Andrey Ponomarenko
#
# PLATFORMS
# =========
# Linux (ROSA, Mandriva)
#
# 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 Locale::gettext;
use strict;
my $TOOL_VERSION = "1.4";
my $CmdName = get_filename($0);
my ($Help, $ShowVersion, $RPMlist, $RPMdir, $StaticMode,
$DynamicMode, $CheckRelease, $CheckSignature, $SelectRepos,
$NoClean, $Root, $HDlist, $FileDeps, $ResDir, $AddRPMs,
$RTitle, $DepHDlists);
textdomain("urpm-tools");
sub N_(@)
{
my ($Str, @Params) = @_;
if(not $Str) {
return "";
}
$Str = gettext($Str);
foreach my $N (1 .. $#Params+1)
{
my $P = $Params[$N-1];
$Str=~s/\[_$N\]/$P/g;
}
return $Str;
}
my $ShortUsage = N_("URPM Repos Closure Checker [_1] for Mandriva Linux
A tool for checking closure of a set of RPM packages
Copyright (C) 2012 ROSA Laboratory
License: GNU GPL
Usage: [_2] [options]
Example: [_2] --hdlist=hdlist.txt
More info: [_2] --help\n", $TOOL_VERSION, $CmdName);
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,
"r|check-release!" => \$CheckRelease,
"sign|check-signature!" => \$CheckSignature,
"media=s" => \$SelectRepos,
"noclean!" => \$NoClean,
"root=s" => \$Root,
"o|res=s" => \$ResDir,
"title=s" => \$RTitle,
"dep-hdlists=s" => \$DepHDlists
) or ERR_MESSAGE();
my %EXIT_CODES = (
"SUCCESS" => 0,
"ERROR" => 1,
"FAILED" => 2
);
my $HelpMessage = N_("
NAME:
URPM Repos Closure Checker 1.0 for Mandriva Linux
A tool for checking closure of a set of RPM packages
USAGE:
[_1] --hdlist=hdlist.txt
[_1] --hdlist=http://mirror.yandex.ru/mandriva/.../synthesis.hdlist.cz
[_1] --dir=rpms/ --static --file-deps=file-deps.txt
[_1] --list=list.txt --dynamic
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.
-add|-update <path>
The directory with RPM packages that should
be added to the repository or updated.
-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.
-r|-check-release
Check installation media (DVD).
-sign|-check-signature
Validate package signatures.
-noclean
Do not clean urpmi cache.
-root <path>
Where to install packages.
Default:
/tmp/...
-dep-hdlists <path>
The list of hdlists that will
be used to resolve dependencies.
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", $CmdName);
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 $TEST_MEDIA = "test_media";
my %Packages;
my %BrokenSignature;
my %InstallFailed;
my $RESULTS_DIR = "repoclosure_reports";
sub appendFile($$)
{
my ($Path, $Content) = @_;
return if(not $Path);
if(my $Dir = get_dirname($Path)) {
mkpath($Dir);
}
open(FILE, ">>".$Path) || die N_("can't open file \'[_1]\': [_2]\n", $Path, $!);
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 N_("can't open file \'[_1]\': [_2]\n", $Path, $!);
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 addMedia($)
{
my $Dir = $_[0];
if(not $Dir or not -d $Dir) {
return;
}
my %Media = map {$_=>1} split(/\n+/, `urpmq --list-media`);
if($Media{$TEST_MEDIA}) {
removeMedia();
}
$Dir = abs_path($Dir);
system("/usr/sbin/urpmi.addmedia $TEST_MEDIA $Dir");
system("/usr/sbin/urpmi.update $TEST_MEDIA");
}
sub removeMedia() {
system("/usr/sbin/urpmi.removemedia $TEST_MEDIA");
}
sub installPackage($)
{
my $Package = $_[0];
my $Cmd = "/usr/sbin/urpmi";
if($CheckRelease)
{ # from CD or DVD
$Cmd .= " --media=$TEST_MEDIA";
}
elsif($SelectRepos)
{
if(-d $SelectRepos) {
$Cmd .= " --media=$TEST_MEDIA";
}
else {
$Cmd .= " --media=$SelectRepos";
}
}
# create root where to install packages
if(not -d $TMP_DIR."/root") {
mkpath($TMP_DIR."/root");
}
if(not $CheckRelease) {
$Cmd .= " --no-install";
}
if($Root) {
$Cmd .= " --root=\"$Root\"";
}
else {
$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";
}
if($CheckRelease)
{ # installed
while($Log=~s/(installing\s+)([^\/\s]+\.rpm)(\s|\Z)/$1/)
{
my $RpmName = $2;
print " $RpmName\n";
}
}
else
{ # 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 N_("ERROR: you should be root\n");
exit(1);
}
}
sub readRPMlist($$)
{
my ($Path, $Type) = @_;
if(not -f $Path)
{
print STDERR N_("ERROR: cannot access \'[_1]\'\n", $Path);
exit(1);
}
my @RPMs = split(/\s+/, readFile($Path));
if($#RPMs==-1) {
print STDERR N_("ERROR: the list of packages is empty\n");
exit(1);
}
if($Type eq "RPMs")
{
foreach my $P (@RPMs)
{
if($P!~/\.rpm\Z/)
{
print STDERR N_("ERROR: file \'[_1]\' is not RPM package\n", $P);
exit(1);
}
elsif(not -f $P)
{
print STDERR N_("ERROR: cannot access \'[_1]\'\n", $P);
exit(1);
}
}
}
return @RPMs;
}
sub checkRelease()
{
checkRoot();
if(not $RPMdir and not $RPMlist)
{
print STDERR N_("ERROR: --dir or --list option should be specified\n");
exit(1);
}
clearCache();
my @RPMs = ();
if($RPMlist)
{
@RPMs = readRPMlist($RPMlist, "RPMs");
$RPMdir = get_dirname($RPMs[0]);
if(not $RPMdir) {
$RPMdir = ".";
}
}
else
{
if(not -d $RPMdir)
{
print STDERR N_("ERROR: cannot access \'[_1]\'\n", $RPMdir);
exit(1);
}
@RPMs = searchRPMs($RPMdir);
}
addMedia($RPMdir);
foreach my $Path (@RPMs)
{ # add to cache
if(not -f $RPM_CACHE."/".get_filename($Path)) {
# copy($Path, $RPM_CACHE);
}
}
foreach my $Path (@RPMs)
{
installPackage($Path);
$Packages{get_filename($Path)} = 1;
}
removeMedia();
checkResult();
}
sub dynamicCheck()
{
checkRoot();
if(not $RPMdir and not $RPMlist)
{
print STDERR N_("ERROR: --dir or --list option should be specified\n");
exit(1);
}
clearCache();
my @RPMs = ();
if($RPMdir)
{ # --dir option
if(not -d $RPMdir)
{
print STDERR N_("ERROR: cannot access \'[_1]\'\n", $RPMdir);
exit(1);
}
@RPMs = searchRPMs($RPMdir);
foreach my $Path (@RPMs)
{ # add to cache
copy($Path, $RPM_CACHE);
}
if(-d $SelectRepos) {
addMedia($SelectRepos);
}
foreach my $Path (@RPMs)
{
installPackage($Path);
$Packages{get_RPMname($Path)} = 1;
$Packages{get_filename($Path)} = 1;
}
if(-d $SelectRepos) {
removeMedia();
}
}
elsif($RPMlist)
{
@RPMs = readRPMlist($RPMlist, "Names");
if(-d $SelectRepos) {
addMedia($SelectRepos);
}
foreach my $Name (@RPMs)
{
installPackage($Name);
$Packages{$Name} = 1;
}
if(-d $SelectRepos) {
removeMedia();
}
}
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 $CheckRelease) {
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 = N_("Extra Packages:\n\n");
foreach my $Name (@Names)
{
$Report .= $Name;
if(my $Req = $RequiredBy{$Name}) {
$Report .= N_(" (required by: [_1])", $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 = N_("Broken Packages:\n\n");
foreach my $Name (@Names) {
$Report .= "$Name\n";
}
print $Report;
writeFile("$RESULTS_DIR/broken-packages.txt", $Report);
}
print N_("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 sigCheck()
{
if(not $RPMdir and not $RPMlist)
{
print STDERR N_("ERROR: --dir or --list option should be specified\n");
exit(1);
}
print N_("Checking RPMs ...\n");
my @RPMs = ();
if($RPMdir)
{
if(not -d $RPMdir)
{
print STDERR N_("ERROR: cannot access \'[_1]\'\n", $RPMdir);
exit(1);
}
@RPMs = searchRPMs($RPMdir);
}
elsif($RPMlist) {
@RPMs = readRPMlist($RPMlist, "RPMs");
}
foreach my $Path (@RPMs)
{
print N_("Checking [_1]\n", get_filename($Path));
if(not checkSignature($Path)) {
print N_(" FAILED: invalid signature\n");
}
}
if(my @Names = sort {lc($a) cmp lc($b)} keys(%BrokenSignature))
{
my $Report = N_("Broken Signature:\n\n");
foreach my $Name (@Names) {
$Report .= "$Name\n";
}
print $Report;
writeFile("$RESULTS_DIR/report.txt", $Report);
}
print N_("Report has been generated to:");
print "\n $RESULTS_DIR/report.txt\n";
if(keys(%BrokenSignature)) {
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;
$RPMdep->{$Type}{$Name}{$N}=1;
}
}
}
sub readHDlist($$$$)
{
my ($Path, $Dep, $RPMdep, $AddedRPMs) = @_;
my $Content = "";
if($Path=~/(http|https|ftp):\/\//)
{
print N_("Downloading HDlist ...\n");
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 N_("ERROR: cannot access \'[_1]\'\n", $Path);
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 N_("ERROR: cannot extract \'[_1]\'\n", $Path);
exit(1);
}
unlink($DownloadTo);
$DownloadTo = $Files[0];
}
if(my $Line = readLineNum($DownloadTo, 1))
{
if($Line!~/\A\@\w+\@/)
{
print STDERR N_("ERROR: unknown format of hdlist\n");
exit(1);
}
}
$Content = readFile($DownloadTo);
unlink($DownloadTo);
}
else
{
if(not -f $Path)
{
print STDERR N_("ERROR: cannot access \'[_1]\'\n", $Path);
exit(1);
}
$Content = readFile($Path);
}
print N_("Checking HDlist ...\n");
my $Name = "";
foreach (reverse(split(/\n/, $Content)))
{
$_=~s/\A\@//g;
my @Parts = split("\@", $_);
my $Type = shift(@Parts);
if($Type eq "info")
{
$Name = $Parts[0];
next;
}
if($AddRPMs)
{
if(my $PName = parse_RPMname($Name))
{
if($AddedRPMs->{$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;
$RPMdep->{$Type}{$Name}{$D} = 1;
}
}
}
}
sub staticCheck()
{
if(not $RPMdir and not $HDlist and not $RPMlist)
{
print STDERR N_("ERROR: --hdlist, --dir or --list option should be specified\n");
exit(1);
}
my (%Dep, %RPMdep, %AddedRPMs) = ();
my (%Dep_D, %RPMdep_D) = ();
if($AddRPMs)
{
if(not -d $AddRPMs)
{
print STDERR N_("ERROR: cannot access \'[_1]\'\n", $AddRPMs);
exit(1);
}
if(my @AddedRPMs = searchRPMs($AddRPMs))
{
foreach my $Path (@AddedRPMs)
{
readDeps($Path, \%Dep, \%RPMdep);
if(my $Name = get_RPMname($Path)) {
$AddedRPMs{$Name}=1;
}
}
}
}
if($RPMdir or $RPMlist)
{
print N_("Checking RPMs ...\n");
my @RPMs = ();
if($RPMdir)
{
if(not -d $RPMdir)
{
print STDERR N_("ERROR: cannot access \'[_1]\'\n", $RPMdir);
exit(1);
}
@RPMs = searchRPMs($RPMdir);
}
elsif($RPMlist) {
@RPMs = readRPMlist($RPMlist, "RPMs");
}
foreach my $Path (@RPMs)
{
if($AddRPMs)
{
if(my $Name = get_RPMname($Path))
{
if($AddedRPMs{$Name})
{ # already added
next;
}
}
}
readDeps($Path, \%Dep, \%RPMdep);
}
}
elsif($HDlist) {
readHDlist($HDlist, \%Dep, \%RPMdep, \%AddedRPMs);
}
if($DepHDlists)
{
if(not -f $DepHDlists)
{
print STDERR N_("ERROR: cannot access \'[_1]\'\n", $DepHDlists);
exit(1);
}
foreach my $Url (split(/\s+/, readFile($DepHDlists))) {
readHDlist($Url, \%Dep_D, \%RPMdep_D, \%AddedRPMs);
}
}
my %IgnoreDeps = ();
if($FileDeps)
{
if(not -f $FileDeps)
{
print STDERR N_("ERROR: cannot access \'[_1]\'\n", $FileDeps);
exit(1);
}
%IgnoreDeps = map {$_=>1} split(/\s+/, readFile($FileDeps));
}
my (%Unresolved, %UnresolvedSuggested, %Broken) = ();
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;
}
my $Name = $Dep{"requires"}{$N}{$O}{$V};
if($RPMdep{"suggests"}{$Name}{$N}) {
$UnresolvedSuggested{$N}{$O}{$V} = $Name;
}
else {
$Unresolved{$N}{$O}{$V} = $Name;
}
$Broken{$Name}=1;
}
}
}
}
my $TotalPkgs = keys(%{$RPMdep{"requires"}});
my $TotalDeps = keys(%{$Dep{"requires"}});
my ($Report, $VReport) = ();
$VReport .= "<h1>Urpm-repoclosure report</h1>\n";
$VReport .= "This report has been generated";
if($RTitle) {
$VReport .= " for <b>$RTitle</b>";
}
elsif($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><hr/>\n";
$VReport .= "<table class='summary'>\n";
my $UnresolvedLink = "0";
if(my $Num = keys(%Unresolved)) {
$UnresolvedLink = "<a href='#Unresolved'>".$Num."</a>"." (".show_number($Num*100/$TotalDeps)."%)";
}
$VReport .= "<tr><th>Unresolved<br/>Dependencies</th><td>$UnresolvedLink</td></tr>\n";
my $BrokenLink = "0";
if(my $Num = keys(%Broken)) {
$BrokenLink = "<a href='#Broken'>".$Num."</a>"." (".show_number($Num*100/$TotalPkgs)."%)";
}
$VReport .= "<tr><th>Broken<br/>Packages</th><td>$BrokenLink</td></tr>\n";
$VReport .= "</table>\n";
if(my @Ns = sort {lc($a) cmp lc($b)} keys(%Unresolved))
{
my $Title = N_("Unresolved Dependencies ([_1])", $#Ns+1);
$Report .= "\n$Title:\n\n";
$VReport .= "<a name='Unresolved'></a>\n";
$VReport .= "<h2>$Title</h2><hr/>\n";
$VReport .= "<table class='report'>\n";
$VReport .= "<tr><th>Dependency</th><th>Required by</th></tr>\n";
foreach my $N (@Ns)
{
foreach my $O (keys(%{$Unresolved{$N}}))
{
foreach my $V (keys(%{$Unresolved{$N}{$O}}))
{
my $Dep = showDep($N, $O, $V);
my $Pkg = $Unresolved{$N}{$O}{$V};
$Report .= $Dep." (".N_("required by [_1]", $Pkg).")\n";
$VReport .= "<tr><td>$Dep</td><td>$Pkg</td></tr>\n";
}
}
}
$VReport .= "</table>";
}
if(my @Ns = sort {lc($a) cmp lc($b)} keys(%UnresolvedSuggested))
{
if($Report) {
$Report .= "\n";
}
my $Title = N_("Unresolved Suggests ([_1])", $#Ns+1);
$Report .= "\n$Title:\n\n";
$VReport .= "<h2>$Title</h2><hr/>\n";
$VReport .= "<table class='report'>\n";
$VReport .= "<tr><th>Dependency</th><th>Suggested by</th></tr>\n";
foreach my $N (@Ns)
{
foreach my $O (keys(%{$UnresolvedSuggested{$N}}))
{
foreach my $V (keys(%{$UnresolvedSuggested{$N}{$O}}))
{
my $Dep = showDep($N, $O, $V);
my $Pkg = $UnresolvedSuggested{$N}{$O}{$V};
$Report .= $Dep." (".N_("required by [_1]", $Pkg).")\n";
$VReport .= "<tr><td>$Dep</td><td>$Pkg</td></tr>\n";
}
}
}
$VReport .= "</table>";
}
if(my @Ns = sort {lc($a) cmp lc($b)} keys(%Broken))
{
if($Report) {
$Report .= "\n";
}
my $Title = N_("Broken Packages ([_1])", $#Ns+1);
$Report .= "\n$Title:\n\n";
$VReport .= "<a name='Broken'></a>\n";
$VReport .= "<h2>$Title</h2><hr/>\n";
$VReport .= "<table class='report'>\n";
$VReport .= "<tr><th>Package</th></tr>\n";
foreach my $N (@Ns)
{
my $Name = parse_RPMname($N);
$Report .= $Name."\n";
$VReport .= "<tr><td>$Name</td></tr>\n";
}
$VReport .= "</table>";
}
my $Styles = "
body {
font-family:Arial, sans-serif;
color:Black;
font-size:14px;
padding-left:15px;
}
hr {
color:Black;
background-color:Black;
height:1px;
border:0;
}
h1 {
margin-bottom:3px;
padding-bottom:3px;
}
h2 {
margin-bottom:0px;
padding-bottom:0px;
}
table.summary {
border-collapse:collapse;
border:1px outset black;
}
table.summary th {
background-color:#eeeeee;
font-weight:100;
text-align:left;
font-size:15px;
white-space:nowrap;
border:1px inset gray;
padding: 3px;
}
table.summary td {
text-align:right;
font-size:16px;
white-space:nowrap;
border:1px inset gray;
padding: 3px 5px 3px 10px;
}
table.report {
border-collapse:collapse;
border:1px outset black;
}
table.report th {
background-color:#eeeeee;
font-weight:bold;
text-align:left;
font-size:15px;
white-space:nowrap;
border:1px inset gray;
padding: 3px;
}
table.report td {
text-align:left;
font-size:16px;
white-space:nowrap;
border:1px inset gray;
padding: 3px;
}";
my $Footer = "<hr/><div style='width:99%;font-size:11px;' 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>";
$VReport = "<!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\" />
<title>
Urpm-repoclosure report
</title>
<style type=\"text/css\">
$Styles
</style></head><body>".$VReport."\n".$Footer."\n</body></html>\n";
# report
if($Report)
{
print $Report."\n"; # on the screen
writeFile("$RESULTS_DIR/report.html", $VReport);
writeFile("$RESULTS_DIR/report.txt", $Report);
}
# debug info
writeFile("$RESULTS_DIR/debug/rpm-provides.txt", Dumper($RPMdep{"provides"}));
writeFile("$RESULTS_DIR/debug/rpm-requires.txt", Dumper($RPMdep{"requires"}));
writeFile("$RESULTS_DIR/debug/rpm-suggests.txt", Dumper($RPMdep{"suggests"}));
print N_("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 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 scenario()
{
if($Help)
{
HELP_MESSAGE();
exit(0);
}
if($ShowVersion)
{
print N_("URPM Repos Closure Checker [_1] for Mandriva Linux\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", $TOOL_VERSION);
exit(0);
}
if($HDlist) {
$StaticMode = 1;
}
if($Root)
{
if(not -d $Root) {
print STDERR N_("ERROR: cannot access \'[_1]\'\n", $Root);
exit(1);
}
}
if($ResDir) {
$RESULTS_DIR = $ResDir;
}
if(-d $RESULTS_DIR) {
rmtree($RESULTS_DIR);
}
if($CheckSignature)
{
if(not $ResDir) {
$RESULTS_DIR .= "/signature";
}
sigCheck();
exit(0);
}
if($StaticMode)
{
if(not $ResDir) {
$RESULTS_DIR .= "/static";
}
staticCheck();
}
if($CheckRelease)
{
if(not $ResDir) {
$RESULTS_DIR .= "/release";
}
checkRelease();
exit(0);
}
if($DynamicMode)
{
if(not $ResDir) {
$RESULTS_DIR .= "/dynamic";
}
dynamicCheck();
}
exit(0);
}
scenario();
Reference in a new issue View git blame Copy permalink