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 ; 
+}