home *** CD-ROM | disk | FTP | other *** search
- #!/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 ;
- }
-