home *** CD-ROM | disk | FTP | other *** search
/ Chip 2007 January, February, March & April / Chip-Cover-CD-2007-02.iso / boot / i386 / rescue / usr / lib / rpm / magic.prov < prev    next >
Text File  |  2006-11-29  |  4KB  |  168 lines
  1. #!/usr/bin/perl
  2.  
  3. use File::Basename;
  4. use Getopt::Long;
  5.  
  6. # this dependency analysis program is the only one which need to know
  7. # the RPM buildroot to do its work.
  8.  
  9. # Figuring out what files are really executables via magic numbers is
  10. # hard.  Not only is every '#!' an executable of some type (with a
  11. # potentially infinite supply of interpreters) but there are thousands
  12. # of valid binary magic numbers for old OS's and old CPU types.
  13.  
  14. # Permissions do not always help discriminate binaries from the rest
  15. # of the files, on Solaris the shared libraries are marked as
  16. # 'executable'.
  17.  
  18. #    -rwxr-xr-x   1 bin      bin      1013248 Jul  1  1998 /lib/libc.so.1
  19.  
  20. # I would like to let the 'file' command take care of the magic
  21. # numbers for us. Alas! under linux file prints different kind of
  22. # messages for each interpreter, there is no common word 'script' to
  23. # look for.
  24.  
  25. #    ' perl commands text'
  26. #    ' Bourne shell script text'
  27. #    ' a /usr/bin/wish -f script text'
  28.  
  29. # WORSE on solaris there are entries which say:
  30.  
  31. #     ' current ar archive, not a dynamic executable or shared object' 
  32.  
  33. # how do I grep for 'executable' when people put a 'not executable' in
  34. # there?  I trim off everything after the first comma (if there is
  35. # one) and if the result has the string 'executable' in it then it may
  36. # be one.
  37.  
  38.  
  39. # so we must also do some magic number processing ourselves, and be
  40. # satisfied with 'good enough'.
  41.  
  42. # I look for files which have atleast one of the executable bits set
  43. # and are either labled 'executable' by the file command (see above
  44. # restriction) OR have a '#!' as their first two characters.
  45.  
  46.  
  47. $is_mode_executable=oct(111);
  48.  
  49. # set a known path
  50.   
  51. $ENV{'PATH'}= (
  52.            ':/usr/bin'.
  53.            ':/bin'.
  54.            '');
  55.  
  56. # taint perl requires we clean up these bad environmental variables.
  57.   
  58. delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
  59.  
  60. $BUILDROOT = '';
  61. %option_linkage = (
  62.            "buildroot" => \$BUILDROOT,
  63.           );
  64.  
  65. if( !GetOptions (\%option_linkage, "buildroot=s") ) {
  66.   die("Illegal options in \@ARGV: '@ARGV'\n");
  67.  
  68. }
  69.  
  70. if ($BUILDROOT == '/') {
  71.   $BUILDROOT = '';
  72. }
  73.  
  74. if ("@ARGV") {
  75.   foreach (@ARGV) {
  76.     process_file($_);
  77.   }
  78. } else {
  79.   
  80.   # notice we are passed a list of filenames NOT as common in unix the
  81.   # contents of the file.
  82.   
  83.   foreach (<>) {
  84.     process_file($_);
  85.   }
  86. }
  87.  
  88.  
  89. foreach $module (sort keys %provides) {
  90.   print "executable($module)\n";
  91. }
  92.  
  93. exit 0;
  94.  
  95.  
  96.  
  97.  
  98. sub is_file_script {
  99.   
  100.   my ($file) = @_;
  101.   chomp $file;
  102.   
  103.   my $out = 0;
  104.   open(FILE, "<$file")||
  105.     die("$0: Could not open file: '$file' : $!\n");
  106.   
  107.   my $rc = sysread(FILE,$line,2);
  108.   
  109.   if ( ($rc > 1) && ($line =~ m/^\#\!/) ) {
  110.     $out = 1;
  111.   } 
  112.  
  113.   close(FILE) ||
  114.     die("$0: Could not close file: '$file' : $!\n");
  115.   
  116.   return $out; 
  117. }
  118.  
  119.  
  120.  
  121. sub is_file_binary_executable {
  122.   my ($file) = @_;
  123.  
  124.   $file_out=`file $file`;
  125.   # trim off any extra descriptions.
  126.   $file_out =~ s/\,.*$//;
  127.   
  128.   my $out = 0;
  129.   if ($file_out =~ m/executable/ ) {
  130.     $out = 1;
  131.   }
  132.   return $out;
  133. }
  134.  
  135.  
  136. sub process_file {
  137.   my ($file) = @_;
  138.   chomp $file;
  139.  
  140.   my $prov_name = $file;
  141.   $prov_name =~ s!^$BUILDROOT!!;
  142.  
  143.   # If its a link find the file it points to.  Dead links do not
  144.   # provide anything.
  145.  
  146.   while (-l $file) {
  147.     my $newfile = readlink($file);
  148.     if ($newfile !~ m!^/!) {
  149.       $newfile = dirname($file).'/'.$newfile;
  150.     } else {
  151.       $newfile = $BUILDROOT.$newfile;
  152.     }
  153.     $file = $newfile;
  154.   }
  155.  
  156.   (-f $file) || return ;  
  157.   ( (stat($file))[2] & $is_mode_executable ) || return ;
  158.  
  159.   is_file_script($file) || 
  160.     is_file_binary_executable($file) || 
  161.       return ;
  162.  
  163.   $provides{$prov_name}=1;
  164.   $provides{basename($prov_name)}=1;
  165.     
  166.   return ; 
  167. }
  168.