mirror of
https://abf.rosa.ru/djam/urpm-tools.git
synced 2025-02-23 17:32:46 +00:00
1720 lines
43 KiB
Perl
Executable file
1720 lines
43 KiB
Perl
Executable file
#!/usr/bin/perl
|
|
########################################################
|
|
# URPM Repo Closure Checker 1.5.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.5.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
|
|
|
|
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;
|
|
$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;
|
|
$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, %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 = "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/$TotalDeps)."%)";
|
|
}
|
|
$VReport .= "<tr><th>Unresolved<br/>Dependencies</th><td>$UnresolvedLink</td></tr>\n";
|
|
my $BrokenLink = "0 (0.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";
|
|
|
|
$VReport .= "<br/>\n";
|
|
$VReport .= "<br/>\n";
|
|
|
|
if(my @Ns = sort {lc($a) cmp lc($b)} keys(%Unresolved))
|
|
{
|
|
my $Title = "Unresolved Dependencies (".($#Ns+1).")";
|
|
$Report .= "\n$Title:\n\n";
|
|
|
|
$VReport .= "<a name='Unresolved'></a>\n";
|
|
$VReport .= "<table class='report'>\n";
|
|
$VReport .= "<tr>";
|
|
$VReport .= "<th onclick='javascript:sort(this)'>Dependency (".($#Ns+1).")</th><th onclick=\"sort(this)\">RPM</th>";
|
|
|
|
if($ExtInfo) {
|
|
$VReport .= "<th onclick=\"sort(this)\">SRPM</th>";
|
|
}
|
|
|
|
$VReport .= "</tr>\n";
|
|
|
|
my $Num = 1;
|
|
|
|
foreach my $N (@Ns)
|
|
{
|
|
foreach my $O (sort keys(%{$Unresolved{$N}}))
|
|
{
|
|
foreach my $V (sort keys(%{$Unresolved{$N}{$O}}))
|
|
{
|
|
my $Dep = showDep($N, $O, $V);
|
|
my $Pkg = $Unresolved{$N}{$O}{$V};
|
|
$Report .= $Dep." (required by $Pkg)\n";
|
|
my $Class = " class='even'";
|
|
$Class = "" if($Num++ % 2 != 0);
|
|
$VReport .= "<tr$Class>";
|
|
$VReport .= "<td>".htmlSpecChars($Dep)."</td><td>$Pkg</td>";
|
|
if($ExtInfo) {
|
|
$VReport .= "<td>".$AddInfo{$Pkg}{"SRPM"}."</td>";
|
|
}
|
|
$VReport .= "</tr>\n";
|
|
}
|
|
}
|
|
}
|
|
|
|
$VReport .= "</table>";
|
|
}
|
|
if(my @Ns = sort {lc($a) cmp lc($b)} keys(%UnresolvedSuggested))
|
|
{
|
|
if($Report)
|
|
{
|
|
$Report .= "\n";
|
|
$VReport .= "<br/>\n";
|
|
}
|
|
|
|
my $Title = "Unresolved Suggests (".($#Ns+1).")";
|
|
$Report .= "\n$Title:\n\n";
|
|
|
|
$VReport .= "<table class='report'>\n";
|
|
$VReport .= "<tr>";
|
|
$VReport .= "<th onclick='javascript:sort(this)'>Suggestion (".($#Ns+1).")</th><th onclick=\"sort(this)\">RPM</th>";
|
|
|
|
if($ExtInfo) {
|
|
$VReport .= "<th onclick=\"sort(this)\">SRPM</th>";
|
|
}
|
|
|
|
$VReport .= "</tr>\n";
|
|
|
|
my $Num = 1;
|
|
|
|
foreach my $N (@Ns)
|
|
{
|
|
foreach my $O (sort keys(%{$UnresolvedSuggested{$N}}))
|
|
{
|
|
foreach my $V (sort keys(%{$UnresolvedSuggested{$N}{$O}}))
|
|
{
|
|
my $Dep = showDep($N, $O, $V);
|
|
my $Pkg = $UnresolvedSuggested{$N}{$O}{$V};
|
|
$Report .= $Dep." (required by $Pkg)\n";
|
|
my $Class = " class='even'";
|
|
$Class = "" if($Num++ % 2 != 0);
|
|
$VReport .= "<tr$Class>";
|
|
$VReport .= "<td>".htmlSpecChars($Dep)."</td><td>$Pkg</td>";
|
|
if($ExtInfo) {
|
|
$VReport .= "<td>".$AddInfo{$Pkg}{"SRPM"}."</td>";
|
|
}
|
|
$VReport .= "</tr>\n";
|
|
}
|
|
}
|
|
}
|
|
|
|
$VReport .= "</table>";
|
|
}
|
|
|
|
$VReport .= "<br/>\n";
|
|
|
|
if(my @Ns = sort {lc($a) cmp lc($b)} keys(%Broken))
|
|
{
|
|
if($Report) {
|
|
$Report .= "\n";
|
|
}
|
|
|
|
my $Title = "Broken Packages (".($#Ns+1).")";
|
|
$Report .= "\n$Title:\n\n";
|
|
|
|
$VReport .= "<a name='Broken'></a>\n";
|
|
$VReport .= "<table class='report'>\n";
|
|
$VReport .= "<tr><th onclick=\"sort(this)\">Broken Packages (".($#Ns+1).")</th></tr>\n";
|
|
|
|
my $Num = 1;
|
|
|
|
foreach my $N (@Ns)
|
|
{
|
|
my $Name = parse_RPMname($N);
|
|
$Report .= $Name."\n";
|
|
my $Class = " class='even'";
|
|
$Class = "" if($Num++ % 2 != 0);
|
|
$VReport .= "<tr$Class><td>$Name</td></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  </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)/&$1/g;
|
|
$Str=~s/</</g;
|
|
$Str=~s/>/>/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();
|
|
|