home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-385-Vol-1of3.iso / c / cops_104.zip / cops_104 / perl / chk_strings.pl < prev    next >
Perl Script  |  1992-03-10  |  4KB  |  139 lines
  1. #
  2. #  This is a big one.  Support routines to check for strings 
  3. # that look like pathnames and make sure they're not writable.
  4. # Will recurse if $recurse is set.  the shell version can't do
  5. # this (yet).  call &ignore with list of regexps that you don't
  6. # care about.  (or set @ignores)
  7. #
  8. # originally by Tom Christiansen <tchrist@convex.com>
  9. # since hacked on by parties various and sundry.
  10.  
  11. require 'is_able.pl';
  12. require 'file_mode.pl';
  13. require 'pathconf.pl';
  14.  
  15. package chk_strings;
  16.  
  17.  
  18. $'STRINGS = $'STRINGS || '/usr/ucb/strings';
  19.  
  20. for ( '/dev/null', '/dev/tty' ) {
  21.     $seen{$_}++;
  22. } 
  23.  
  24. sub main'chk_strings {
  25.     local($ARGV) = @_;
  26.     local($_);
  27.     local($word);
  28.     local(*STRINGS);  # XXX: might run out of fd's on deep recursion!  -tchrist
  29.     local(%paths, $text); 
  30.     local($STRINGS) = "$'STRINGS $ARGV |";
  31.  
  32.     &ignore(@ignores) if defined @ignores && !$already_ignored;
  33.  
  34.     $STRINGS="< $ARGV", $text=1 if -T $ARGV;
  35.     print "Opening via: $STRINGS\n" if $debug;
  36.  
  37.     open (STRINGS, $STRINGS); 
  38.     while (<STRINGS>) { 
  39.     next unless m#/#;   # was m#/.*/#;
  40. #---------------------------------------------------------------------------
  41. # Comments and modifications by Martin Foord (maf%dbsm.oz.au@munnari.oz.au).
  42.     #s/#.*$// if $text;  # strip out comments if -T file
  43.     # Comments start in the shell at the beginning of a word or at the
  44.     # beggining of a line
  45.     if ($text) {
  46.         s/\s+#.*$//;
  47.         s/^#.*$//;
  48.     }
  49.  
  50.     # Get rid of semicolons, they can hang around on filenames ...
  51.     s/;//g;
  52. #---------------------------------------------------------------------------
  53.  
  54.     s/"([^"]*)"/ $1 /g;
  55.     s/'([^']*)'/ $1 /g;
  56.     # See my comments below on how to deal with this stuff ... (line 64).
  57.     #s/`([^`]*)`/ $1 /g;
  58.  
  59.  
  60.     s!([<>])\s+/!$1/!g;  # "> /foo" goes to ">/foo";
  61.  
  62.     s/=/ /g;  # warning -- mangled files with = in them
  63.     for $word (split) {
  64.         if ($word =~ m#:/#) {
  65.         print "push $word (split on the colons)\n" if $debug;
  66.         @paths{split(/:/, $word)} = ();
  67.         } elsif ($word =~ m#^[<>]?/#) {
  68.         print "push $word\n" if $debug;
  69.         $paths{$word}++;
  70.         }
  71.     }
  72.     }
  73.     close (STRINGS);
  74.     push(@files, $ARGV);
  75.  
  76.     for (keys %paths) {
  77.     s/\)$//;
  78.     s/^\(//;
  79.     s#^/+#/#;
  80.     s#^(/.*)/$#$1#;        # get rid of trailing slash
  81.  
  82. #---------------------------------------------------------------------------
  83. # Comments and modifications by Martin Foord (maf%dbsm.oz.au@munnari.oz.au).
  84.     # It's best to evaluate what's in backquotes rather than remove them
  85.     # as in the substitution above, due to files which
  86.     # look like this /var/yp/`domainname` (eg in my /etc/rc.local).
  87.     s`\`(.+)\``$1`; # eval what's in backquotes.
  88.     chop if /\n$/;    # fang off \n if there ...
  89. #---------------------------------------------------------------------------
  90.     next if &ignored($_);
  91.     s/^[<>]//;
  92.     next if $_ eq '';
  93.     next unless !$seen{$_}++ && -e && !-S _;
  94.     print "checking $_\n" if $debug;
  95.     if ($how = &'is_writable($_)) {
  96.         print "Warning!  File $_ (inside ",
  97.             join(' inside ', reverse @files), ") is _World_ $how!\n";
  98.     } elsif ($recurse && (&'Mode($_) & 0111) && -f _) {
  99.          print "recursing $_\n" if $debug;
  100.          &'chk_strings($_);   
  101.     } 
  102.     }
  103.      pop(@files);
  104. } 
  105.  
  106. sub ignore {
  107.     local($_);
  108.     local($prog);
  109.  
  110.     $already_ignored = 1;
  111.  
  112.     $prog = <<'EOCODE';
  113.  
  114. sub ignored {
  115.     local($return) = 1;
  116.     local($prog);
  117.     local($_) = @_;
  118.     {
  119. EOCODE
  120.     for (@_) {
  121.     $prog .= "\tlast if m\201${_}\201;\n";
  122.     } 
  123.     $prog .= <<'EOCODE';
  124.     $return = 0;
  125.     }
  126.     print "$_ IGNORED\n" if $debug && $return;
  127.     $return;
  128. }
  129. EOCODE
  130.     
  131.     print $prog if $debug;
  132.     eval $prog;
  133.     die $@ if $@;
  134. } 
  135.  
  136. sub ignored {}; # in case they never ignore anything
  137.  
  138. 1;
  139.