diff options
author | Olivier Thauvin <nanardon@mandriva.org> | 2005-04-29 03:14:31 +0000 |
---|---|---|
committer | Olivier Thauvin <nanardon@mandriva.org> | 2005-04-29 03:14:31 +0000 |
commit | c1e98e63ced7c7cf0a96eb7344dce8c70a2374a3 (patch) | |
tree | e7dc6d41932984de61e19b5c31645adef2873166 /magic.prov | |
parent | 0476b45b8e1efd8ceba51446bbe5312935726e49 (diff) | |
download | rpm-setup-c1e98e63ced7c7cf0a96eb7344dce8c70a2374a3.tar rpm-setup-c1e98e63ced7c7cf0a96eb7344dce8c70a2374a3.tar.gz rpm-setup-c1e98e63ced7c7cf0a96eb7344dce8c70a2374a3.tar.bz2 rpm-setup-c1e98e63ced7c7cf0a96eb7344dce8c70a2374a3.tar.xz rpm-setup-c1e98e63ced7c7cf0a96eb7344dce8c70a2374a3.zip |
- remove Makefile.in from cvs0.1
- more scripts
- version is 0.1 (in way)
- use spec-helper at time
Diffstat (limited to 'magic.prov')
-rwxr-xr-x | magic.prov | 167 |
1 files changed, 167 insertions, 0 deletions
diff --git a/magic.prov b/magic.prov new file mode 100755 index 0000000..ba3a45c --- /dev/null +++ b/magic.prov @@ -0,0 +1,167 @@ +#!/usr/bin/perl + +use File::Basename; +use Getopt::Long; + +# this dependency analysis program is the only one which need to know +# the RPM buildroot to do its work. + +# Figuring out what files are really executables via magic numbers is +# hard. Not only is every '#!' an executable of some type (with a +# potentially infinite supply of interpreters) but there are thousands +# of valid binary magic numbers for old OS's and old CPU types. + +# Permissions do not always help discriminate binaries from the rest +# of the files, on Solaris the shared libraries are marked as +# 'executable'. + +# -rwxr-xr-x 1 bin bin 1013248 Jul 1 1998 /lib/libc.so.1 + +# I would like to let the 'file' command take care of the magic +# numbers for us. Alas! under linux file prints different kind of +# messages for each interpreter, there is no common word 'script' to +# look for. + +# ' perl commands text' +# ' Bourne shell script text' +# ' a /usr/bin/wish -f script text' + +# WORSE on solaris there are entries which say: + +# ' current ar archive, not a dynamic executable or shared object' + +# how do I grep for 'executable' when people put a 'not executable' in +# there? I trim off everything after the first comma (if there is +# one) and if the result has the string 'executable' in it then it may +# be one. + + +# so we must also do some magic number processing ourselves, and be +# satisfied with 'good enough'. + +# I look for files which have atleast one of the executable bits set +# and are either labled 'executable' by the file command (see above +# restriction) OR have a '#!' as their first two characters. + + +$is_mode_executable=oct(111); + +# set a known path + +$ENV{'PATH'}= ( + ':/usr/bin'. + ':/bin'. + ''); + +# taint perl requires we clean up these bad environmental variables. + +delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'}; + +$BUILDROOT = ''; +%option_linkage = ( + "buildroot" => \$BUILDROOT, + ); + +if( !GetOptions (\%option_linkage, "buildroot=s") ) { + die("Illegal options in \@ARGV: '@ARGV'\n"); + +} + +if ($BUILDROOT == '/') { + $BUILDROOT = ''; +} + +if ("@ARGV") { + foreach (@ARGV) { + process_file($_); + } +} else { + + # notice we are passed a list of filenames NOT as common in unix the + # contents of the file. + + foreach (<>) { + process_file($_); + } +} + + +foreach $module (sort keys %provides) { + print "executable($module)\n"; +} + +exit 0; + + + + +sub is_file_script { + + my ($file) = @_; + chomp $file; + + my $out = 0; + open(FILE, "<$file")|| + die("$0: Could not open file: '$file' : $!\n"); + + my $rc = sysread(FILE,$line,2); + + if ( ($rc > 1) && ($line =~ m/^\#\!/) ) { + $out = 1; + } + + close(FILE) || + die("$0: Could not close file: '$file' : $!\n"); + + return $out; +} + + + +sub is_file_binary_executable { + my ($file) = @_; + + $file_out=`file $file`; + # trim off any extra descriptions. + $file_out =~ s/\,.*$//; + + my $out = 0; + if ($file_out =~ m/executable/ ) { + $out = 1; + } + return $out; +} + + +sub process_file { + my ($file) = @_; + chomp $file; + + my $prov_name = $file; + $prov_name =~ s!^$BUILDROOT!!; + + # If its a link find the file it points to. Dead links do not + # provide anything. + + while (-l $file) { + my $newfile = readlink($file); + if ($newfile !~ m!^/!) { + $newfile = dirname($file).'/'.$newfile; + } else { + $newfile = $BUILDROOT.$newfile; + } + $file = $newfile; + } + + (-f $file) || return ; + ( (stat($file))[2] & $is_mode_executable ) || return ; + + is_file_script($file) || + is_file_binary_executable($file) || + return ; + + $provides{$prov_name}=1; + $provides{basename($prov_name)}=1; + + return ; +} |