2012-09-05 15:45:44 +04:00
#!/usr/bin/perl
########################################################
2012-09-21 14:59:24 +04:00
# URPM Repo Closure Checker 1.5.1 for Linux
2012-09-05 15:45:44 +04:00
# A tool for checking closure of a set of RPM packages
#
2012-09-14 12:33:26 +04:00
# Copyright (C) 2011-2012 ROSA Laboratory
2012-09-05 15:45:44 +04:00
# Written by Andrey Ponomarenko
#
# PLATFORMS
# =========
2012-09-14 12:33:26 +04:00
# Linux (ROSA, Mandriva, Mageia)
2012-09-05 15:45:44 +04:00
#
# 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 ) ;
2012-09-12 17:13:36 +04:00
use POSIX qw( strftime ) ;
2012-09-05 15:45:44 +04:00
use File::Path qw( mkpath rmtree ) ;
use File::Temp qw( tempdir ) ;
use File::Copy qw( copy move ) ;
use Data::Dumper ;
use strict ;
2012-09-21 14:59:24 +04:00
my $ TOOL_VERSION = "1.5.1" ;
2012-09-05 15:45:44 +04:00
my $ CmdName = get_filename ( $ 0 ) ;
my ( $ Help , $ ShowVersion , $ RPMlist , $ RPMdir , $ StaticMode ,
2012-09-12 19:04:58 +04:00
$ DynamicMode , $ NoClean , $ HDlist , $ FileDeps , $ ReportDir ,
2012-09-19 16:13:26 +04:00
$ AddRPMs , $ RTitle , $ DepHDlists , $ UpdateHDlists , $ Profile ,
$ Target , $ ExtInfo ) ;
2012-09-05 15:45:44 +04:00
2012-09-14 12:33:26 +04:00
my $ ShortUsage = " URPM Repo Closure Checker $ TOOL_VERSION
2012-09-05 15:45:44 +04:00
A tool for checking closure of a set of RPM packages
Copyright ( C ) 2012 ROSA Laboratory
License: GNU GPL
2012-09-12 19:04:58 +04:00
Usage: $ CmdName [ options ]
Example: $ CmdName - - hdlist = hdlist . txt
2012-09-05 15:45:44 +04:00
2012-09-12 19:04:58 +04:00
More info: $ CmdName - - help \ n " ;
2012-09-05 15:45:44 +04:00
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 ,
2012-09-12 19:04:58 +04:00
"report-dir=s" = > \ $ ReportDir ,
2012-09-12 17:13:36 +04:00
"title=s" = > \ $ RTitle ,
2012-09-14 15:26:55 +04:00
"dep-hdlists=s" = > \ $ DepHDlists ,
2012-09-19 16:13:26 +04:00
"update-hdlists=s" = > \ $ UpdateHDlists ,
"profile=s" = > \ $ Profile ,
"target=s" = > \ $ Target ,
"info=s" = > \ $ ExtInfo
2012-09-05 15:45:44 +04:00
) or ERR_MESSAGE ( ) ;
my % EXIT_CODES = (
"SUCCESS" = > 0 ,
"ERROR" = > 1 ,
"FAILED" = > 2
) ;
2012-09-12 19:04:58 +04:00
my $ HelpMessage = "
2012-09-05 15:45:44 +04:00
NAME:
2012-09-14 12:33:26 +04:00
URPM Repo Closure Checker $ TOOL_VERSION
2012-09-05 15:45:44 +04:00
A tool for checking closure of a set of RPM packages
USAGE:
2012-09-12 19:04:58 +04:00
$ CmdName - - hdlist = http: //mi rror . yandex . ru /mandriva/ ... / synthesis . hdlist . cz
$ CmdName - - dir = rpms / - - static - - file - deps = file - deps . txt
$ CmdName - - list = list . txt - - dynamic
2012-09-05 15:45:44 +04:00
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 .
2012-09-12 19:04:58 +04:00
- updates <path>
The directory with updated RPM packages .
2012-09-05 15:45:44 +04:00
- 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 .
2012-09-12 19:04:58 +04:00
- report - dir <dir>
The directory where to generate report ( s ) .
- title <name>
Name of the repository in the title of HTML report .
2012-09-05 15:45:44 +04:00
2012-09-12 17:13:36 +04:00
- dep - hdlists <path>
2012-09-12 19:04:58 +04:00
The list of HDlists that will
2012-09-12 17:13:36 +04:00
be used to resolve dependencies .
2012-09-14 15:26:55 +04:00
- update - hdlists <path>
The list of HDlists from update repositories .
2012-09-19 16:13:26 +04:00
- 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>
2012 lts
</distr>
<name>
ROSA 2012 LTS
</name>
<arch>
i586
</arch>
<section>
contrib
</section>
<hdlist>
http: // abf . rosalinux . ru /downloads/ rosa2012lts /repository/i 586 /contrib/ release /media_info/s ynthesis . hdlist . cz
</hdlist>
<updates>
http: // abf . rosalinux . ru /downloads/ rosa2012lts /repository/i 586 /contrib/ updates /media_info/s ynthesis . hdlist . cz
</updates>
<deps>
http: // abf . rosalinux . ru /downloads/ rosa2012lts /repository/i 586 /main/ release /media_info/s ynthesis . hdlist . cz
http: // abf . rosalinux . ru /downloads/ rosa2012lts /repository/i 586 /main/ updates /media_info/s ynthesis . hdlist . cz
</deps>
<info>
http: // abf . rosalinux . ru /downloads/ rosa2012lts /repository/i 586 /contrib/ release /media_info/i nfo . xml . lzma
http: // abf . rosalinux . ru /downloads/ rosa2012lts /repository/i 586 /contrib/ updates /media_info/i nfo . xml . lzma
</info>
</repos>
<repos>
...
</repos>
2012-09-12 17:13:36 +04:00
2012-09-05 15:45:44 +04:00
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
2012-09-12 19:04:58 +04:00
\ n " ;
2012-09-05 15:45:44 +04:00
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" ;
2012-09-19 16:13:26 +04:00
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 ;
}
2012-09-05 15:45:44 +04:00
sub appendFile ($$)
{
my ( $ Path , $ Content ) = @ _ ;
return if ( not $ Path ) ;
if ( my $ Dir = get_dirname ( $ Path ) ) {
mkpath ( $ Dir ) ;
}
2012-09-12 19:04:58 +04:00
open ( FILE , ">>" . $ Path ) || die "can't open file \'$Path\': $!\n" ;
2012-09-05 15:45:44 +04:00
print FILE $ Content ;
close ( FILE ) ;
}
sub writeFile ($$)
{
my ( $ Path , $ Content ) = @ _ ;
return if ( not $ Path ) ;
if ( my $ Dir = get_dirname ( $ Path ) ) {
mkpath ( $ Dir ) ;
}
2012-09-12 19:04:58 +04:00
open ( FILE , ">" . $ Path ) || die "can't open file \'$Path\': $!\n" ;
2012-09-05 15:45:44 +04:00
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" ) ;
}
2012-09-12 19:04:58 +04:00
$ Cmd . = " --no-install" ;
$ Cmd . = " --root=\"$TMP_DIR/root\"" ;
2012-09-05 15:45:44 +04:00
$ 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" ;
}
2012-09-12 19:04:58 +04:00
# downloaded
while ( $ Log =~ s/(\/)([^\/\s]+\.rpm)(\s|\Z)/$1$3/ )
{
my $ RpmName = $ 2 ;
print " $RpmName\n" ;
$ RequiredBy { getPName ( $ RPM_CACHE . "/" . $ RpmName ) } = getPName ( $ Package ) ;
2012-09-05 15:45:44 +04:00
}
}
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" ) {
2012-09-12 19:04:58 +04:00
print STDERR "ERROR: you should be root\n" ;
2012-09-05 15:45:44 +04:00
exit ( 1 ) ;
}
}
sub readRPMlist ($$)
{
my ( $ Path , $ Type ) = @ _ ;
if ( not - f $ Path )
{
2012-09-12 19:04:58 +04:00
print STDERR "ERROR: cannot access \'$Path\'\n" ;
2012-09-05 15:45:44 +04:00
exit ( 1 ) ;
}
my @ RPMs = split ( /\s+/ , readFile ( $ Path ) ) ;
if ( $# RPMs == - 1 ) {
2012-09-12 19:04:58 +04:00
print STDERR "ERROR: the list of packages is empty\n" ;
2012-09-05 15:45:44 +04:00
exit ( 1 ) ;
}
if ( $ Type eq "RPMs" )
{
foreach my $ P ( @ RPMs )
{
if ( $ P !~ /\.rpm\Z/ )
{
2012-09-12 19:04:58 +04:00
print STDERR "ERROR: file \'$P\' is not RPM package\n" ;
2012-09-05 15:45:44 +04:00
exit ( 1 ) ;
}
elsif ( not - f $ P )
{
2012-09-12 19:04:58 +04:00
print STDERR "ERROR: cannot access \'$P\'\n" ;
2012-09-05 15:45:44 +04:00
exit ( 1 ) ;
}
}
}
return @ RPMs ;
}
sub dynamicCheck ()
{
checkRoot ( ) ;
if ( not $ RPMdir and not $ RPMlist )
{
2012-09-12 19:04:58 +04:00
print STDERR "ERROR: --dir or --list option should be specified\n" ;
2012-09-05 15:45:44 +04:00
exit ( 1 ) ;
}
clearCache ( ) ;
my @ RPMs = ( ) ;
if ( $ RPMdir )
{ # --dir option
if ( not - d $ RPMdir )
{
2012-09-12 19:04:58 +04:00
print STDERR "ERROR: cannot access \'$RPMdir\'\n" ;
2012-09-05 15:45:44 +04:00
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 ;
}
2012-09-12 19:04:58 +04:00
if ( not $ InstalledPackage { $ Name } ) {
return 0 ;
2012-09-05 15:45:44 +04:00
}
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 ) )
{
2012-09-12 19:04:58 +04:00
my $ Report = "Extra Packages:\n\n" ;
2012-09-05 15:45:44 +04:00
foreach my $ Name ( @ Names )
{
$ Report . = $ Name ;
if ( my $ Req = $ RequiredBy { $ Name } ) {
2012-09-12 19:04:58 +04:00
$ Report . = " (required by: $Req)" ;
2012-09-05 15:45:44 +04:00
}
$ Report . = "\n" ;
}
print $ Report ;
writeFile ( "$RESULTS_DIR/extra-packages.txt" , $ Report ) ;
}
if ( my @ Names = sort { lc ( $ a ) cmp lc ( $ b ) } keys ( % BrokenPackages ) )
{
2012-09-12 19:04:58 +04:00
my $ Report = "Broken Packages:\n\n" ;
2012-09-05 15:45:44 +04:00
foreach my $ Name ( @ Names ) {
$ Report . = "$Name\n" ;
}
print $ Report ;
writeFile ( "$RESULTS_DIR/broken-packages.txt" , $ Report ) ;
}
2012-09-12 19:04:58 +04:00
print "Report has been generated to:" ;
2012-09-05 15:45:44 +04:00
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 ;
}
}
}
2012-09-19 16:13:26 +04:00
sub downloadFile ($)
2012-09-12 17:13:36 +04:00
{
2012-09-19 16:13:26 +04:00
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 ) ;
}
2012-09-14 15:26:55 +04:00
2012-09-19 16:13:26 +04:00
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 ) = @ _ ;
2012-09-12 17:13:36 +04:00
my $ Content = "" ;
if ( $ Path =~ /(http|https|ftp):\/\// )
{
2012-09-19 16:13:26 +04:00
print "Downloading Info ...\n" ;
$ Path = downloadFile ( $ Path ) ;
}
else
{
if ( not - f $ Path )
2012-09-12 17:13:36 +04:00
{
2012-09-12 19:04:58 +04:00
print STDERR "ERROR: cannot access \'$Path\'\n" ;
2012-09-12 17:13:36 +04:00
exit ( 1 ) ;
}
2012-09-19 16:13:26 +04:00
}
my $ RPM = "" ;
open ( INFO , $ Path ) || die "can't open file \'$Path\': $!\n" ;
while ( <INFO> )
{
if ( index ( $ _ , "fn=" ) != - 1 )
2012-09-12 17:13:36 +04:00
{
2012-09-19 16:13:26 +04:00
if ( /fn=\"(.+?)\"/ ) {
$ RPM = $ 1 ;
}
else {
$ RPM = "" ;
2012-09-12 17:13:36 +04:00
}
2012-09-19 16:13:26 +04:00
}
if ( $ RPM )
{
if ( index ( $ _ , "sourcerpm=" ) != - 1 )
2012-09-12 17:13:36 +04:00
{
2012-09-19 16:13:26 +04:00
if ( /sourcerpm=\'(.+?)\'/ )
{
my $ SRPM = $ 1 ;
$ SRPM =~ s/\.src\.rpm//g ;
$ SRPM =~ s/\.srpm//g ;
$ Info - > { $ RPM } { "SRPM" } = $ SRPM ;
}
else {
$ RPM = "" ;
}
2012-09-12 17:13:36 +04:00
}
}
2012-09-19 16:13:26 +04:00
}
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 ) ;
2012-09-12 17:13:36 +04:00
if ( my $ Line = readLineNum ( $ DownloadTo , 1 ) )
{
if ( $ Line !~ /\A\@\w+\@/ )
{
2012-09-12 19:04:58 +04:00
print STDERR "ERROR: unknown format of hdlist\n" ;
2012-09-12 17:13:36 +04:00
exit ( 1 ) ;
}
}
$ Content = readFile ( $ DownloadTo ) ;
}
else
{
if ( not - f $ Path )
{
2012-09-12 19:04:58 +04:00
print STDERR "ERROR: cannot access \'$Path\'\n" ;
2012-09-12 17:13:36 +04:00
exit ( 1 ) ;
}
$ Content = readFile ( $ Path ) ;
}
2012-09-14 15:26:55 +04:00
print "Reading $Kind HDlist ...\n" ;
my $ TKind = $ Kind ;
if ( $ TKind eq "Update" ) {
$ TKind = "Target" ;
}
my % PkgName = ( ) ;
2012-09-12 17:13:36 +04:00
my $ Name = "" ;
foreach ( reverse ( split ( /\n/ , $ Content ) ) )
{
$ _ =~ s/\A\@//g ;
my @ Parts = split ( "\@" , $ _ ) ;
my $ Type = shift ( @ Parts ) ;
if ( $ Type eq "info" )
{
2012-09-14 15:26:55 +04:00
if ( $ Kind eq "Update" )
{
if ( $ Name )
{ # register previous
$ Registered - > { $ TKind } { $ PkgName { $ Name } } = 1 ;
}
}
2012-09-12 17:13:36 +04:00
$ Name = $ Parts [ 0 ] ;
next ;
}
2012-09-14 15:26:55 +04:00
if ( my $ PName = parse_RPMname ( $ Name ) )
2012-09-12 17:13:36 +04:00
{
2012-09-14 15:26:55 +04:00
$ PkgName { $ Name } = $ PName ;
if ( $ Kind eq "Target" )
2012-09-12 17:13:36 +04:00
{
2012-09-14 15:26:55 +04:00
if ( $ Registered - > { $ TKind } { $ PName } )
2012-09-12 17:13:36 +04:00
{ # already added
next ;
}
}
}
2012-09-14 15:26:55 +04:00
2012-09-12 17:13:36 +04:00
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 ;
}
}
}
2012-09-14 15:26:55 +04:00
if ( $ Kind eq "Update" )
{
if ( $ Name )
{ # register last
$ Registered - > { $ TKind } { $ PkgName { $ Name } } = 1 ;
}
}
2012-09-19 16:13:26 +04:00
rmtree ( $ TMP_DIR . "/extract/" ) ;
2012-09-12 17:13:36 +04:00
}
2012-09-05 15:45:44 +04:00
sub staticCheck ()
{
if ( not $ RPMdir and not $ HDlist and not $ RPMlist )
{
2012-09-12 19:04:58 +04:00
print STDERR "ERROR: --hdlist, --dir or --list option should be specified\n" ;
2012-09-05 15:45:44 +04:00
exit ( 1 ) ;
}
2012-09-19 16:13:26 +04:00
my % AddInfo = ( ) ;
if ( $ ExtInfo )
{
foreach my $ Url ( split ( /\s+/ , readFile ( $ ExtInfo ) ) ) {
readInfo ( $ Url , \ % AddInfo ) ;
}
}
2012-09-14 15:26:55 +04:00
my ( % Dep , % RPMdep , % Registered ) = ( ) ;
2012-09-12 17:13:36 +04:00
my ( % Dep_D , % RPMdep_D ) = ( ) ;
2012-09-05 15:45:44 +04:00
if ( $ AddRPMs )
{
if ( not - d $ AddRPMs )
{
2012-09-12 19:04:58 +04:00
print STDERR "ERROR: cannot access \'$AddRPMs\'\n" ;
2012-09-05 15:45:44 +04:00
exit ( 1 ) ;
}
if ( my @ AddedRPMs = searchRPMs ( $ AddRPMs ) )
{
foreach my $ Path ( @ AddedRPMs )
{
readDeps ( $ Path , \ % Dep , \ % RPMdep ) ;
if ( my $ Name = get_RPMname ( $ Path ) ) {
2012-09-14 15:26:55 +04:00
$ Registered { $ Name } = 1 ;
2012-09-05 15:45:44 +04:00
}
}
}
}
2012-09-14 15:26:55 +04:00
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" ) ;
}
}
2012-09-05 15:45:44 +04:00
if ( $ RPMdir or $ RPMlist )
{
2012-09-12 19:04:58 +04:00
print "Checking RPMs ...\n" ;
2012-09-05 15:45:44 +04:00
my @ RPMs = ( ) ;
if ( $ RPMdir )
{
if ( not - d $ RPMdir )
{
2012-09-12 19:04:58 +04:00
print STDERR "ERROR: cannot access \'$RPMdir\'\n" ;
2012-09-05 15:45:44 +04:00
exit ( 1 ) ;
}
@ RPMs = searchRPMs ( $ RPMdir ) ;
}
elsif ( $ RPMlist ) {
@ RPMs = readRPMlist ( $ RPMlist , "RPMs" ) ;
}
foreach my $ Path ( @ RPMs )
{
2012-09-14 15:26:55 +04:00
if ( my $ Name = get_RPMname ( $ Path ) )
2012-09-05 15:45:44 +04:00
{
2012-09-14 15:26:55 +04:00
if ( $ Registered { $ Name } )
{ # already added
next ;
2012-09-05 15:45:44 +04:00
}
}
readDeps ( $ Path , \ % Dep , \ % RPMdep ) ;
}
}
2012-09-12 17:13:36 +04:00
elsif ( $ HDlist ) {
2012-09-14 15:26:55 +04:00
readHDlist ( $ HDlist , \ % Dep , \ % RPMdep , \ % Registered , "Target" ) ;
2012-09-12 17:13:36 +04:00
}
if ( $ DepHDlists )
2012-09-05 15:45:44 +04:00
{
2012-09-12 17:13:36 +04:00
if ( not - f $ DepHDlists )
2012-09-05 15:45:44 +04:00
{
2012-09-12 19:04:58 +04:00
print STDERR "ERROR: cannot access \'$DepHDlists\'\n" ;
2012-09-12 17:13:36 +04:00
exit ( 1 ) ;
2012-09-05 15:45:44 +04:00
}
2012-09-12 17:13:36 +04:00
foreach my $ Url ( split ( /\s+/ , readFile ( $ DepHDlists ) ) ) {
2012-09-14 15:26:55 +04:00
readHDlist ( $ Url , \ % Dep_D , \ % RPMdep_D , \ % Registered , "Dep" ) ;
2012-09-05 15:45:44 +04:00
}
}
2012-09-12 17:13:36 +04:00
2012-09-05 15:45:44 +04:00
my % IgnoreDeps = ( ) ;
if ( $ FileDeps )
{
if ( not - f $ FileDeps )
{
2012-09-12 19:04:58 +04:00
print STDERR "ERROR: cannot access \'$FileDeps\'\n" ;
2012-09-05 15:45:44 +04:00
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 } } ) )
{
2012-09-12 17:13:36 +04:00
if ( ( not defined $ Dep { "provides" } { $ N }
2012-09-05 15:45:44 +04:00
or not checkDeps ( $ N , $ O , $ V , $ Dep { "provides" } { $ N } ) )
2012-09-12 17:13:36 +04:00
and ( not defined $ Dep_D { "provides" } { $ N }
or not checkDeps ( $ N , $ O , $ V , $ Dep_D { "provides" } { $ N } ) ) )
2012-09-05 15:45:44 +04:00
{ # 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 ;
}
}
}
}
2012-09-12 17:13:36 +04:00
my $ TotalPkgs = keys ( % { $ RPMdep { "requires" } } ) ;
my $ TotalDeps = keys ( % { $ Dep { "requires" } } ) ;
my ( $ Report , $ VReport ) = ( ) ;
2012-09-18 15:47:23 +04:00
$ VReport = "URPM-repoclosure report" ;
2012-09-12 17:13:36 +04:00
if ( $ RTitle ) {
2012-09-18 15:47:23 +04:00
# $VReport .= " for <span style='color:Blue;'>$RTitle</span>";
2012-09-12 17:13:36 +04:00
}
2012-09-18 15:47:23 +04:00
$ VReport = "<h1>$VReport</h1>\n" ;
$ VReport . = "This report has been generated" ;
if ( $ HDlist ) {
2012-09-12 17:13:36 +04:00
$ VReport . = " for this <a href=\'$HDlist\'>hdlist</a>" ;
}
$ VReport . = " on " . strftime ( "%b %e %H:%M %Y" , localtime ( time ) ) . "." ;
$ VReport . = "<br/>\n" ;
2012-09-14 12:33:26 +04:00
$ VReport . = "<h2>Test Info</h2>\n" ;
#$VReport .= "<hr/>\n";
2012-09-12 17:13:36 +04:00
$ VReport . = "<table class='summary'>\n" ;
2012-09-18 15:47:23 +04:00
if ( $ RTitle ) {
$ VReport . = "<tr><th>Repository</th><td width='100px'>$RTitle</td></tr>\n" ;
}
2012-09-14 12:33:26 +04:00
my $ UnresolvedLink = "0 (0.0%)" ;
2012-09-12 17:13:36 +04:00
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" ;
2012-09-14 12:33:26 +04:00
my $ BrokenLink = "0 (0.0%)" ;
2012-09-12 17:13:36 +04:00
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" ;
2012-09-14 12:33:26 +04:00
$ VReport . = "<br/>\n" ;
$ VReport . = "<br/>\n" ;
2012-09-05 15:45:44 +04:00
if ( my @ Ns = sort { lc ( $ a ) cmp lc ( $ b ) } keys ( % Unresolved ) )
{
2012-09-12 19:04:58 +04:00
my $ Title = "Unresolved Dependencies (" . ( $# Ns + 1 ) . ")" ;
2012-09-12 17:13:36 +04:00
$ Report . = "\n$Title:\n\n" ;
$ VReport . = "<a name='Unresolved'></a>\n" ;
$ VReport . = "<table class='report'>\n" ;
2012-09-19 16:13:26 +04:00
$ 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" ;
2012-09-14 12:33:26 +04:00
my $ Num = 1 ;
2012-09-12 17:13:36 +04:00
2012-09-05 15:45:44 +04:00
foreach my $ N ( @ Ns )
{
2012-09-19 16:13:26 +04:00
foreach my $ O ( sort keys ( % { $ Unresolved { $ N } } ) )
2012-09-05 15:45:44 +04:00
{
2012-09-19 16:13:26 +04:00
foreach my $ V ( sort keys ( % { $ Unresolved { $ N } { $ O } } ) )
2012-09-05 15:45:44 +04:00
{
2012-09-12 17:13:36 +04:00
my $ Dep = showDep ( $ N , $ O , $ V ) ;
my $ Pkg = $ Unresolved { $ N } { $ O } { $ V } ;
2012-09-12 19:04:58 +04:00
$ Report . = $ Dep . " (required by $Pkg)\n" ;
2012-09-14 12:33:26 +04:00
my $ Class = " class='even'" ;
$ Class = "" if ( $ Num + + % 2 != 0 ) ;
2012-09-19 16:13:26 +04:00
$ VReport . = "<tr$Class>" ;
$ VReport . = "<td>" . htmlSpecChars ( $ Dep ) . "</td><td>$Pkg</td>" ;
if ( $ ExtInfo ) {
$ VReport . = "<td>" . $ AddInfo { $ Pkg } { "SRPM" } . "</td>" ;
}
$ VReport . = "</tr>\n" ;
2012-09-05 15:45:44 +04:00
}
}
}
2012-09-12 17:13:36 +04:00
$ VReport . = "</table>" ;
2012-09-05 15:45:44 +04:00
}
if ( my @ Ns = sort { lc ( $ a ) cmp lc ( $ b ) } keys ( % UnresolvedSuggested ) )
{
2012-09-19 16:13:26 +04:00
if ( $ Report )
{
2012-09-05 15:45:44 +04:00
$ Report . = "\n" ;
2012-09-19 16:13:26 +04:00
$ VReport . = "<br/>\n" ;
2012-09-05 15:45:44 +04:00
}
2012-09-12 17:13:36 +04:00
2012-09-12 19:04:58 +04:00
my $ Title = "Unresolved Suggests (" . ( $# Ns + 1 ) . ")" ;
2012-09-12 17:13:36 +04:00
$ Report . = "\n$Title:\n\n" ;
$ VReport . = "<table class='report'>\n" ;
2012-09-19 16:13:26 +04:00
$ 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" ;
2012-09-14 12:33:26 +04:00
my $ Num = 1 ;
2012-09-12 17:13:36 +04:00
2012-09-05 15:45:44 +04:00
foreach my $ N ( @ Ns )
{
2012-09-19 16:13:26 +04:00
foreach my $ O ( sort keys ( % { $ UnresolvedSuggested { $ N } } ) )
2012-09-05 15:45:44 +04:00
{
2012-09-19 16:13:26 +04:00
foreach my $ V ( sort keys ( % { $ UnresolvedSuggested { $ N } { $ O } } ) )
2012-09-05 15:45:44 +04:00
{
2012-09-12 17:13:36 +04:00
my $ Dep = showDep ( $ N , $ O , $ V ) ;
my $ Pkg = $ UnresolvedSuggested { $ N } { $ O } { $ V } ;
2012-09-12 19:04:58 +04:00
$ Report . = $ Dep . " (required by $Pkg)\n" ;
2012-09-14 12:33:26 +04:00
my $ Class = " class='even'" ;
$ Class = "" if ( $ Num + + % 2 != 0 ) ;
2012-09-19 16:13:26 +04:00
$ VReport . = "<tr$Class>" ;
$ VReport . = "<td>" . htmlSpecChars ( $ Dep ) . "</td><td>$Pkg</td>" ;
if ( $ ExtInfo ) {
$ VReport . = "<td>" . $ AddInfo { $ Pkg } { "SRPM" } . "</td>" ;
}
$ VReport . = "</tr>\n" ;
2012-09-05 15:45:44 +04:00
}
}
}
2012-09-12 17:13:36 +04:00
$ VReport . = "</table>" ;
2012-09-05 15:45:44 +04:00
}
2012-09-14 12:33:26 +04:00
$ VReport . = "<br/>\n" ;
2012-09-05 15:45:44 +04:00
if ( my @ Ns = sort { lc ( $ a ) cmp lc ( $ b ) } keys ( % Broken ) )
{
2012-09-12 17:13:36 +04:00
if ( $ Report ) {
$ Report . = "\n" ;
2012-09-05 15:45:44 +04:00
}
2012-09-12 17:13:36 +04:00
2012-09-12 19:04:58 +04:00
my $ Title = "Broken Packages (" . ( $# Ns + 1 ) . ")" ;
2012-09-12 17:13:36 +04:00
$ Report . = "\n$Title:\n\n" ;
$ VReport . = "<a name='Broken'></a>\n" ;
$ VReport . = "<table class='report'>\n" ;
2012-09-19 16:13:26 +04:00
$ VReport . = "<tr><th onclick=\"sort(this)\">Broken Packages (" . ( $# Ns + 1 ) . ")</th></tr>\n" ;
2012-09-14 12:33:26 +04:00
my $ Num = 1 ;
2012-09-12 17:13:36 +04:00
foreach my $ N ( @ Ns )
{
my $ Name = parse_RPMname ( $ N ) ;
$ Report . = $ Name . "\n" ;
2012-09-14 12:33:26 +04:00
my $ Class = " class='even'" ;
$ Class = "" if ( $ Num + + % 2 != 0 ) ;
$ VReport . = "<tr$Class><td>$Name</td></tr>\n" ;
2012-09-12 17:13:36 +04:00
}
$ VReport . = "</table>" ;
}
my $ Styles = "
2012-09-19 16:13:26 +04:00
body {
margin: 1.5 em ;
color:Black ;
}
h1 {
font - size: 2 em ;
margin - bottom:5px ;
}
h2 {
font - size: 1.5 em ;
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: 3 px ;
}
table . summary td {
text - align:right ;
border:1px inset gray ;
padding: 3 px 5 px 3 px 10 px ;
}
tr . even {
background - color: #CCCCCC;
}
table . report th {
border - bottom - style:double ;
font - weight:bold ;
text - align:center ;
font - size: 1.3 em ;
padding:3px ;
cursor:pointer ;
}
table . report td {
text - align:left ;
padding - right:15px ;
} " ;
2012-09-12 17:13:36 +04:00
2012-09-18 15:47:23 +04:00
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>" ;
2012-09-12 17:13:36 +04:00
2012-09-19 16:13:26 +04:00
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" ;
2012-09-12 17:13:36 +04:00
# report
2012-09-14 12:33:26 +04:00
if ( $ Report or $ VReport )
2012-09-05 15:45:44 +04:00
{
2012-09-12 17:13:36 +04:00
print $ Report . "\n" ; # on the screen
writeFile ( "$RESULTS_DIR/report.html" , $ VReport ) ;
2012-09-05 15:45:44 +04:00
writeFile ( "$RESULTS_DIR/report.txt" , $ Report ) ;
}
2012-09-12 17:13:36 +04:00
# debug info
2012-09-18 15:47:23 +04:00
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" } ) ) ;
}
2012-09-12 17:13:36 +04:00
2012-09-12 19:04:58 +04:00
print "Report has been generated to:" ;
2012-09-12 17:13:36 +04:00
print "\n $RESULTS_DIR/report.txt (html)\n\n" ;
# exit code
2012-09-05 15:45:44 +04:00
if ( keys ( % Unresolved ) ) {
exit ( $ EXIT_CODES { "FAILED" } ) ;
}
else {
exit ( $ EXIT_CODES { "SUCCESS" } ) ;
}
}
2012-09-19 16:13:26 +04:00
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/x html1 /DTD/x html1 - transitional . dtd \ " >
< html xmlns = \ " http: // www . w3 . org /1999/x html \ " 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> " ;
}
2012-09-18 16:21:15 +04:00
sub htmlSpecChars ($)
{
my $ Str = $ _ [ 0 ] ;
$ Str =~ s/\&([^#]|\Z)/&$1/g ;
$ Str =~ s/</</g ;
$ Str =~ s/>/>/g ;
return $ Str ;
}
2012-09-12 17:13:36 +04:00
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 ;
}
2012-09-05 15:45:44 +04:00
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 ) ;
}
}
2012-09-19 16:13:26 +04:00
sub checkProfile ()
{
if ( not - f $ Profile )
{
print STDERR "ERROR: can't access \'$Profile\'\n" ;
exit ( 1 ) ;
}
my $ Content = readFile ( $ Profile ) ;
my % Index = ( ) ;
2012-09-21 14:59:24 +04:00
my ( % Order , % Order_S ) = ( ) ;
2012-09-19 16:13:26 +04:00
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 + + ;
2012-09-21 14:59:24 +04:00
$ Order_S { $ Info { "name" } } { $ Info { "section" } } = $ Num + + ;
$ Order_S { $ Info { "name" } } { $ Info { "arch" } } = $ Num + + ;
2012-09-19 16:13:26 +04:00
}
my $ Styles = "
body {
margin: 1.5 em ;
color:Black ;
}
h1 {
font - size: 2 em ;
margin - bottom:5px ;
}
h2 {
font - size: 1.5 em ;
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: 3 px ;
border:1px Black solid ;
}
table . summary td {
text - align:center ;
padding: 3 px ;
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" ;
2012-09-21 14:59:24 +04:00
foreach my $ Name ( sort { $ Order { $ a } <=> $ Order { $ b } } keys ( % Index ) )
2012-09-19 16:13:26 +04:00
{
my $ Anchor = $ Name ;
$ Anchor =~ s/\s+/_/g ;
$ Contents . = "<tr><td><a href=\'#$Anchor\'>$Name</a></td></tr>\n" ;
}
$ Contents . = "</table>\n" ;
2012-09-21 14:59:24 +04:00
if ( keys ( % Index ) >= 3 )
{
$ INDEX . = $ Contents ;
$ INDEX . = "<br/>\n" ;
}
2012-09-19 16:13:26 +04:00
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" ;
2012-09-21 14:59:24 +04:00
foreach my $ Arch ( sort { $ Order_S { $ Name } { $ a } <=> $ Order_S { $ Name } { $ b } } keys ( % { $ Index { $ Name } } ) )
2012-09-19 16:13:26 +04:00
{
2012-09-21 14:59:24 +04:00
foreach my $ Section ( sort { $ Order_S { $ Name } { $ a } <=> $ Order_S { $ Name } { $ b } } keys ( % { $ Index { $ Name } { $ Arch } } ) )
2012-09-19 16:13:26 +04:00
{
$ INDEX . = "<th>$Section</th>\n" ;
}
last ;
}
$ INDEX . = "</tr>\n" ;
2012-09-21 14:59:24 +04:00
foreach my $ Arch ( sort { $ Order_S { $ Name } { $ a } <=> $ Order_S { $ Name } { $ b } } keys ( % { $ Index { $ Name } } ) )
2012-09-19 16:13:26 +04:00
{
$ INDEX . = "<tr>\n" ;
$ INDEX . = "<th>$Arch</th>\n" ;
2012-09-21 14:59:24 +04:00
foreach my $ Section ( sort { $ Order_S { $ Name } { $ a } <=> $ Order_S { $ Name } { $ b } } keys ( % { $ Index { $ Name } { $ Arch } } ) )
2012-09-19 16:13:26 +04:00
{
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" ;
}
2012-09-21 14:59:24 +04:00
if ( keys ( % Index ) >= 3 )
{
$ INDEX . = "<div style='height:999px;'></div>\n" ;
}
2012-09-19 16:13:26 +04:00
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" ;
}
2012-09-05 15:45:44 +04:00
sub scenario ()
{
if ( $ Help )
{
HELP_MESSAGE ( ) ;
exit ( 0 ) ;
}
if ( $ ShowVersion )
{
2012-09-14 12:33:26 +04:00
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" ;
2012-09-05 15:45:44 +04:00
exit ( 0 ) ;
}
2012-09-19 16:13:26 +04:00
if ( $ Profile )
{
checkProfile ( ) ;
exit ( 0 ) ;
}
2012-09-05 15:45:44 +04:00
if ( $ HDlist ) {
$ StaticMode = 1 ;
}
2012-09-12 19:04:58 +04:00
if ( $ ReportDir ) {
$ RESULTS_DIR = $ ReportDir ;
2012-09-05 15:45:44 +04:00
}
2012-09-12 17:13:36 +04:00
if ( - d $ RESULTS_DIR ) {
2012-09-05 15:45:44 +04:00
rmtree ( $ RESULTS_DIR ) ;
}
if ( $ StaticMode )
{
2012-09-12 19:04:58 +04:00
if ( not $ ReportDir ) {
2012-09-05 15:45:44 +04:00
$ RESULTS_DIR . = "/static" ;
}
staticCheck ( ) ;
}
if ( $ DynamicMode )
{
2012-09-12 19:04:58 +04:00
if ( not $ ReportDir ) {
2012-09-05 15:45:44 +04:00
$ RESULTS_DIR . = "/dynamic" ;
}
dynamicCheck ( ) ;
}
exit ( 0 ) ;
}
scenario ( ) ;