diff --git a/scripts/Makefile.am b/scripts/Makefile.am index 7ab1869..de0fd19 100644 --- a/scripts/Makefile.am +++ b/scripts/Makefile.am @@ -3,15 +3,15 @@ AUTOMAKE_OPTIONS = 1.4 foreign EXTRA_DIST = \ - brp-compress brp-redhat brp-strip brp-strip-comment-note \ - brp-strip-shared \ - brp-sparc64-linux check-prereqs convertrpmrc.sh cross-build \ - find-lang.sh find-prov.pl find-req.pl \ + brp-adjust_libraries brp-alt brp-bytecompile_python \ + brp-cleanup brp-compress brp-fix-perms brp-strip \ + compress_files check-prereqs convertrpmrc.sh cross-build \ + delayed_rebuilddb find-lang find-package find-prov.pl find-req.pl \ cpanflute cpanflute2 Specfile.pm find-provides.perl \ find-requires.perl get_magic.pl getpo.sh http.req \ - magic.prov magic.req perl.prov perl.req rpmdiff rpmdiff.cgi \ + magic.prov magic.req pam.prov pam.req perl.prov perl.req rpmdiff rpmdiff.cgi \ rpm.daily rpm.log rpm.xinetd rpm2cpio.sh \ - sql.prov sql.req tcl.req trpm u_pkg.sh \ + shell.req sql.prov sql.req strip_files tcl.req trpm u_pkg.sh \ vpkg-provides.sh vpkg-provides2.sh installprefix = $(DESTDIR) @@ -20,13 +20,13 @@ all: configdir = ${prefix}/lib/rpm config_SCRIPTS = \ - brp-compress brp-redhat brp-strip brp-strip-comment-note \ - brp-strip-shared \ - brp-sparc64-linux check-prereqs convertrpmrc.sh cross-build \ - find-lang.sh find-prov.pl find-req.pl \ + brp-adjust_libraries brp-alt brp-bytecompile_python \ + brp-cleanup brp-compress brp-fix-perms brp-strip \ + compress_files check-prereqs convertrpmrc.sh cross-build \ + delayed_rebuilddb find-lang find-package find-prov.pl find-req.pl \ cpanflute cpanflute2 Specfile.pm find-provides.perl \ find-requires.perl get_magic.pl getpo.sh http.req \ - magic.prov magic.req perl.prov perl.req rpmdiff rpmdiff.cgi \ + magic.prov magic.req pam.prov pam.req perl.prov perl.req rpmdiff rpmdiff.cgi \ rpm.daily rpm.log rpm.xinetd rpm2cpio.sh \ - sql.prov sql.req tcl.req trpm u_pkg.sh \ + shell.req sql.prov sql.req strip_files tcl.req trpm u_pkg.sh \ vpkg-provides.sh vpkg-provides2.sh diff --git a/scripts/perl.prov b/scripts/perl.prov index adf987f..ba71a4c 100755 --- a/scripts/perl.prov +++ b/scripts/perl.prov @@ -32,20 +32,51 @@ # If there are lines in the file which match the pattern # (m/^\s*\$VERSION\s*=\s+/) # then these are taken to be the version numbers of the modules. -# Special care is taken with a few known idioms for specifying version -# numbers of files under rcs/cvs control. # If there are strings in the file which match the pattern # m/^\s*\$RPM_Provides\s*=\s*["'](.*)['"]/i # then these are treated as additional names which are provided by the # file and are printed as well. -# I plan to rewrite this in C so that perl is not required by RPM at -# build time. +# The RPM_PERL_LIB_PATH environment variable, if set, must contain the list of +# absolute paths, separated by colons, spaces or commas. These paths are +# considered as library paths used to determine relative names of provided +# perl files. If RPM_PERL_LIB_PATH is not set, paths from @INC Perl variable +# are used instead. # by Ken Estes Mail.com kestes@staff.mail.com +# modified by Mikhail Zabaluev -if ("@ARGV") { +require v5.6.0; + +use Safe; + +use strict; + +use vars qw(%provide @perl_inc); + + +# obtain the list of library directories. If not provided, use @INC + +if (exists $ENV{RPM_PERL_LIB_PATH}) { + @perl_inc = split(/[:,\s]+/, $ENV{RPM_PERL_LIB_PATH}); +} +else { + @perl_inc = grep { m|^/| } @INC; +} + +# Sort @perl_inc descending by length to search for longest prefix rapidly. + +@perl_inc = sort { length($b) <=> length($a) } @perl_inc; + +# Prepend $RPM_BUILD_ROOT to paths. + +my $buildroot = $ENV{RPM_BUILD_ROOT}; +@perl_inc = map { "${buildroot}$_" } @perl_inc; + +# process files + +if (@ARGV) { foreach (@ARGV) { process_file($_); } @@ -59,17 +90,28 @@ if ("@ARGV") { } } +# print out sorted results -foreach $module (sort keys %require) { - if (length($require{$module}) == 0) { +foreach my $module (sort keys %provide) { + my $version = $provide{$module}; + if (length($version) == 0) { print "perl($module)\n"; } else { + print "perl($module) = $version\n"; + if ($version =~ /^1:(.*)/) { - # I am not using rpm3.0 so I do not want spaces arround my - # operators. Also I will need to change the processing of the - # $RPM_* variable when I upgrade. + # provide an additional epoch 0 version converted using Perl's rules - print "perl($module) = $require{$module}\n"; + my $fpver = 0; + my $ratio = 1; + my @series = split(/\./, $1); + for (@series) { + $fpver += $_ * $ratio; + $ratio *= 0.001; + } + my $fdigits = $#series * 3; + printf("perl($module) = 0:%.${fdigits}f\n", $fpver); + } } } @@ -81,10 +123,36 @@ sub process_file { my ($file) = @_; chomp $file; - - open(FILE, "<$file") || return; - my ($package, $version, $incomment, $inover) = (); + return if $file eq ''; + + # find the longest matching prefix among Perl library search directories + + my $prefix = ''; + foreach (@perl_inc) { + if (substr($file, 0, length($_)) eq $_) { + $prefix = $_; + last; + } + } + + return if $prefix eq ''; + + # get path to the module file without prefix + + my $module_file = substr($file, length($prefix)); + $module_file =~ s{^/}{}; + + $provide{$module_file} = undef; + + return if $module_file !~ /\.pm$/; + + # try to extract version number for this package + + open(FILE, "<$file")|| + die("$0: Could not open file: '$file' : $!\n"); + + my $inpackage = 0; while () { @@ -94,25 +162,8 @@ sub process_file { # properly belongs in the over/back section) but people do not # read the perldoc. - if (m/^=(head1|head2|pod|item)/) { - $incomment = 1; - } - - if (m/^=(cut)/) { - $incomment = 0; - $inover = 0; - } - - if (m/^=(over)/) { - $inover = 1; - } - - if (m/^=(back)/) { - $inover = 0; - } - - if ($incomment || $inover) { - next; + if ((m/^=(head[12]|pod|over|item|for|begin)/) .. (m/^=(cut)/)) { + next; } # skip the data section @@ -121,60 +172,95 @@ sub process_file { } # not everyone puts the package name of the file as the first - # package name so we report all namespaces as if they were - # provided packages (really ugly). + # package name so we browse through all namespaces - if (m/^\s*package\s+([_:a-zA-Z0-9]+)\s*;/) { - $package=$1; - undef $version; - $require{$package}=undef; + if (m/^\s*package\s+([\w:']+)\s*;/) { + $inpackage = (module_filename($1) eq $module_file)? 1 : 0; + next; } # after we found the package name take the first assignment to # $VERSION as the version number. Exporter requires that the # variable be called VERSION so we are safe. - # here are examples of VERSION lines from the perl distribution - - #FindBin.pm:$VERSION = $VERSION = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/); - #ExtUtils/Install.pm:$VERSION = substr q$Revision$, 10; - #CGI/Apache.pm:$VERSION = (qw$Revision$)[1]; - #DynaLoader.pm:$VERSION = $VERSION = "1.03"; # avoid typo warning - - if ( - ($package) && - (m/^\s*\$VERSION\s*=\s+/) - ) { - - # first see if the version string contains the string - # '$Revision' this often causes bizzare strings and is the most - # common method of non static numbering. - - if (m/(\$Revision: (\d+[.0-9]+))/) { - $version= $2; - } elsif (m/[\'\"]?(\d+[.0-9]+)[\'\"]?/) { - - # look for a static number hard coded in the script - - $version= $1; - } - $require{$package}=$version; + if ($inpackage && + s/^([\s(]*)(our\s*)?\$VERSION\s*=/$1\$VERSION =/) { + $provide{$module_file} = extract_version($_); + next; } - + + # also consider version initializations with explicit package specification + + if (s/^([\s(]*)(our\s*)?\$([\w:']+)::VERSION\s*=/$1\$VERSION =/) { + if (module_filename($3) eq $module_file) { + $provide{$module_file} = extract_version($_); + } + next; + } + # Each keyword can appear multiple times. Don't # bother with datastructures to store these strings, # if we need to print it print it now. if ( m/^\s*\$RPM_Provides\s*=\s*["'](.*)['"]/i) { - foreach $_ (spit(/\s+/, $1)) { + foreach (split(/\s+/, $1)) { print "$_\n"; } } } - close(FILE) || + close(FILE)|| die("$0: Could not close file: '$file' : $!\n"); return ; } + + +# module_filename($name) - +# converts module name to relative file path + +sub module_filename { + my $name = shift; + $name =~ s{::|'}{/}g; + return $name . '.pm'; +} + + +# extract_version - +# this subroutine tries to evaluate line containing assignment to $VERSION +# in order to achieve version number + +sub extract_version { + + my $line = shift; + + # Try to evaluate the assignment to get the value of $VERSION. + # It is usually computed without using data external to the expression, + # so we would have no problems. + + local $SIG{__WARN__} = sub { }; + + my $safe = new Safe; + $safe->permit_only(qw(:base_core :base_mem :base_orig entereval + grepstart grepwhile mapstart mapwhile)); + my $version = $safe->reval("$line; \$VERSION;"); + + return undef if $@ || length($version) == 0; + + if ($version =~ s/^\s*(\d[\d_]*(\.[\d_]*)?|\.[\d_]+)/$1/) { + + # plain old numeric version + + return '0:' . $version; + } + else { + + # Supposedly, a new style version evaluated as a string constant. + # Return an epoch 1 version + + return sprintf('1:%vd', $version); + } + + return undef; +} diff --git a/scripts/perl.req b/scripts/perl.req index 5ffe6e2..ac9dfc6 100755 --- a/scripts/perl.req +++ b/scripts/perl.req @@ -38,8 +38,12 @@ # build time. # by Ken Estes Mail.com kestes@staff.mail.com +# modified by Mikhail Zabaluev -if ("@ARGV") { +require File::Spec; + + +if (@ARGV) { foreach (@ARGV) { process_file($_); } @@ -54,15 +58,37 @@ if ("@ARGV") { } +# obtain the list of library directories. If not provided, use @INC + +if (exists $ENV{RPM_PERL_LIB_PATH}) { + @perl_inc = split(/[:,\s]+/, $ENV{RPM_PERL_LIB_PATH}); +} +else { + @perl_inc = grep { m|^/| } @INC; +} + +# add installation mirrors to the library search list + +my $buildroot = $ENV{RPM_BUILD_ROOT}; +push @perl_inc, map { "${buildroot}$_" } @perl_inc; + + foreach $module (sort keys %require) { + + # search for the file to be installed in the system or in this same package + + my $found = 0; + for (@perl_inc) { + if (-e "$_/$module") { + $found = 1; + last; + } + } + next unless $found; + if (length($require{$module}) == 0) { print "perl($module)\n"; } else { - - # I am not using rpm3.0 so I do not want spaces arround my - # operators. Also I will need to change the processing of the - # $RPM_* vairable when I upgrage. - print "perl($module) >= $require{$module}\n"; } } @@ -74,9 +100,12 @@ exit 0; sub process_file { my ($file) = @_; - chomp $file; - - open(FILE, "<$file") || return; + chomp($file); + + return if $file eq ''; + + open(FILE, "<$file")|| + die("$0: Could not open file: '$file' : $!\n"); while () { @@ -86,11 +115,7 @@ sub process_file { # properly belongs in the over/back section) but people do not # read the perldoc. - if ( (m/^=(head1|head2|pod|item)/) .. (m/^=(cut)/) ) { - next; - } - - if ( (m/^=(over)/) .. (m/^=(back)/) ) { + if ((m/^=(head[12]|pod|over|item|for|begin)/) .. (m/^=(cut)/)) { next; } @@ -104,121 +129,112 @@ sub process_file { # if we need to print it print it now. if ( m/^\s*\$RPM_Requires\s*=\s*["'](.*)['"]/i) { - foreach $_ (spit(/\s+/, $1)) { + foreach (split(/\s+/, $1)) { print "$_\n"; } + next; } - if ( + my ($module, $version) = (); -# ouch could be in a eval, perhaps we do not want these since we catch -# an exception they must not be required + if (m/^\s*(require|use)\s+(v?\d[.\d_]*)/) { -# eval { require Term::ReadLine } or die $@; -# eval "require Term::Rendezvous;" or die $@; -# eval { require Carp } if defined $^S; # If error/warning during compilation, + # statement requires a particular version of Perl + print "perl >= " . package_version($2, '%.5f') . "\n"; + next; + } + elsif (m/^\s*require[\s(]+([_A-Za-z][\w:']*)/) { - (m/^(\s*) # we hope the inclusion starts the line - (require|use)\s+(?!\{) # do not want 'do {' loops - # quotes around name are always legal - [\'\"]?([^\;\ \'\"\t]*)[\'\"]?[\t\;\ ] - # the syntax for 'use' allows version requirements - \s*([.0-9]*) - /x) - ) { - my ($whitespace, $statement, $module, $version) = ($1, $2, $3,$4); + # require Module::Name - # we only consider require statements that are flush against - # the left edge. any other require statements give too many - # false positives, as they are usually inside of an if statement - # as a fallback module or a rarely used option + $module = module_filename($1); + } + elsif (m/^\s*use\s+([_A-Za-z][\w:']*)(\s+(v?[._\d]+))?/) { - ($whitespace ne "" && $statement eq "require") && next; + # use Module::Name [VERSION] + + $module = module_filename($1); + if (defined($2)) { + $version = package_version($3); + } + } + elsif (m/^\s*(do|require)[\s(]*(['"])([^'"\s\\]+)\2[\s)]*;/) { + + # invocation of a file by its name + + $module = $3; # if there is some interpolation of variables just skip this # dependency, we do not want # do "$ENV{LOGDIR}/$rcfile"; - - ($module =~ m/\$/) && next; - # skip if the phrase was "use of" -- shows up in gimp-perl, et al - next if $module eq 'of'; + next if $2 eq '"' && $module =~ /\$/; - # if the module ends in a comma we probaly caught some - # documentation of the form 'check stuff,\n do stuff, clean - # stuff.' there are several of these in the perl distribution + $module = File::Spec->canonpath($module); - ($module =~ m/[,>]$/) && next; + if (File::Spec->file_name_is_absolute) { - # if the module name starts in a dot it is not a module name. - # Is this necessary? Please give me an example if you turn this - # back on. + # references to absolute filenames are reported explicitly - # ($module =~ m/^\./) && next; - - # if the module ends with .pm strip it to leave only basename. - # starts with /, which means its an absolute path to a file - if ($module =~ m(^/)) { - print "$module\n"; - next; + print "$module\n"; + next; } - # sometimes people do use POSIX qw(foo), or use POSIX(qw(foo)) etc - # we can strip qw.*$, as well as (.*$: - $module =~ s/qw.*$//; - $module =~ s/\(*$//; + # unsure what to do with paths that lead to parent directories - $module =~ s/\.pm$//; + next if $module =~ /(^|\/)\.\.\//; - # some perl programmers write 'require URI/URL;' when - # they mean 'require URI::URL;' + # otherwise, continue with $module set - $module =~ s/\//::/; - - # trim off trailing parenthesis if any. Sometimes people pass - # the module an empty list. - - $module =~ s/\(\s*\)$//; - - if ( $module =~ m/^[0-9._]+$/ ) { - # if module is a number then both require and use interpret that - # to mean that a particular version of perl is specified - - if ($module =~ /5.00/) { - print "perl >= 0:$module\n"; - next; - } - else { - print "perl >= 1:$module\n"; - next; - } - - }; - - # ph files do not use the package name inside the file. - # perlmodlib documentation says: - - # the .ph files made by h2ph will probably end up as - # extension modules made by h2xs. - - # so do not expend much effort on these. - - - # there is no easy way to find out if a file named systeminfo.ph - # will be included with the name sys/systeminfo.ph so only use the - # basename of *.ph files - - ($module =~ m/\.ph$/) && next; - - $require{$module}=$version; - $line{$module}=$_; } - + elsif (m/^\s*([_A-Za-z][\w:']*)\s*->\s*require_version\s*\(\s*(v?[._\d]+)\s*\)/ + || m/^\s*require_version\s+([_A-Za-z][\w:']*)\s+(v?[._\d]+)/) { + $module = module_filename($1); + $version = package_version($2); + } + + if (defined($module)) { + $require{$module} = $version + unless defined($require{$module}) && $require{$module} >= $version; + } } - close(FILE) || + close(FILE)|| die("$0: Could not close file: '$file' : $!\n"); return ; } + + +# module_filename($name) - +# converts module name to relative file path + +sub module_filename { + my $name = shift; + $name =~ s{::|'}{/}g; + return $name . '.pm'; #' +} + + +# package_version($version[, $oldformat]) - +# converts Perl version constant to RPM package version. +# New style 'vN.N.N' numbers are converted to epoch 1 versions, +# whereas old-style floating point versions are given epoch 0 and +# optionally formatted by sprintf() using supplied format. +# Parameters: +# $version - version number in 'vN.N.N' or 'N.NNN_NN' format +# $oldformat - format specifier for sprintf() used to format old-style +# floating-point version number + +sub package_version { + my $version = shift; + if ($version =~ s/^v// || $version =~ /\.[\d_]+\./) { + return "1:$version"; + } + else { + my $format = shift; + $format = '%s' unless defined $format; + return '0:' . sprintf($format, $version); + } +} diff --git a/scripts/rpm.daily b/scripts/rpm.daily index c447887..f3ef918 100755 --- a/scripts/rpm.daily +++ b/scripts/rpm.daily @@ -1,4 +1,5 @@ #!/bin/sh -rpm -qa --qf '%{name}-%{version}-%{release}.%{arch}.rpm\n' 2>&1 \ - | sort > /var/log/rpmpkgs +umask 077 +rpm -qa --qf '%{NAME}-%|SERIAL?{%{SERIAL}:}|%{VERSION}-%{RELEASE}.%{ARCH}.rpm\n' 2>&1 | + LC_COLLATE=C sort >/var/log/rpmpkgs diff --git a/tools/Makefile.am b/tools/Makefile.am index 16454b6..1c62452 100644 --- a/tools/Makefile.am +++ b/tools/Makefile.am @@ -8,8 +8,6 @@ INCLUDES = \ -I$(top_srcdir)/lib \ -I$(top_srcdir)/rpmdb \ -I$(top_srcdir)/rpmio \ - -I$(top_srcdir)/popt \ - @WITH_ZLIB_INCLUDE@ \ @INCPATH@ \ -I$(top_srcdir)/misc @@ -18,15 +16,13 @@ EXTRA_DIST = rpmchecksig.c EXTRA_PROGRAMS = rpminject rpmsort #myLDFLAGS= -L$(top_builddir)/build -L$(top_builddir)/lib \ -# -L$(top_builddir)/rpmio -L$(top_builddir)/popt +# -L$(top_builddir)/rpmio myLDADD = \ $(top_builddir)/build/librpmbuild.la \ $(top_builddir)/lib/librpm.la \ $(top_builddir)/rpmdb/librpmdb.la \ $(top_builddir)/rpmio/librpmio.la \ - $(top_builddir)/popt/libpopt.la \ - @WITH_ZLIB_LIB@ \ @INTLLIBS@ LIBS = @@ -37,13 +33,19 @@ noinst_PROGRAMS = \ dump dumpdb rpmarchive rpmheader rpmlead rpmsignature pkgbindir = @RPMCONFIGDIR@ -pkgbin_PROGRAMS = javadeps +pkgbin_PROGRAMS = javadeps filesize relative pdeath_execute rpmsort_SOURCES = rpmsort.c rpmsort_LDFLAGS = @LDFLAGS_STATIC@ javadeps_SOURCES = javadeps.c +filesize_SOURCES = filesize.c + +relative_SOURCES = relative.c + +pdeath_execute_SOURCES = pdeath_execute.c + $(PROGRAMS): $(myLDADD) gnash.o: gnash.c