diff options
Diffstat (limited to 'magic.prov')
-rwxr-xr-x | magic.prov | 167 |
1 files changed, 0 insertions, 167 deletions
diff --git a/magic.prov b/magic.prov deleted file mode 100755 index ba3a45c..0000000 --- a/magic.prov +++ /dev/null @@ -1,167 +0,0 @@ -#!/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 ; -} |