usr.bin/whereis/whereis.pl

   1 #!/usr/bin/perl
   2 #
   3 # Copyright © 1995, 1996 Jörg Wunsch
   4 #
   5 # All rights reserved.
   6 #
   7 # Redistribution and use in source and binary forms, with or without
   8 # modification, are permitted provided that the following conditions
   9 # are met:
  10 # 1. Redistributions of source code must retain the above copyright
  11 #    notice, this list of conditions and the following disclaimer.
  12 # 2. Redistributions in binary form must reproduce the above copyright
  13 #    notice, this list of conditions and the following disclaimer in the
  14 #    documentation and/or other materials provided with the distribution.
  15 #
  16 # THIS SOFTWARE IS PROVIDED BY THE DEVELOPERS ``AS IS'' AND ANY EXPRESS OR
  17 # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  18 # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
  19 # IN NO EVENT SHALL THE DEVELOPERS BE LIABLE FOR ANY DIRECT, INDIRECT,
  20 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
  21 # NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  22 # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  23 # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  24 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
  25 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  26 #
  27 # whereis -- search for binaries, man pages and source directories.
  28 #
  29 # Rewritten from scratch for FreeBSD after the 4.3BSD manual page.
  30 #
  31 # $FreeBSD: src/usr.bin/whereis/whereis.pl,v 1.8 1999/08/28 01:07:37 peter Exp $
  32 #
  33
  34 sub usage
  35 {
  36     print STDERR "usage: $0 [-bms] [-u] [-BMS dir... -f] name ...\n";
  37     exit 1;
  38 }
  39
  40 sub scanopts
  41 {
  42     local($i, $j);
  43   arg:
  44     while ($ARGV[$i] =~ /^-/) {
  45       opt:
  46         for ($j = 1; $j < length($ARGV[$i]); $j++) {
  47             local($_) = substr($ARGV[$i], $j, 1);
  48             local($what, @list);
  49             $opt_b++, next opt if /b/;
  50             $opt_m++, next opt if /m/;
  51             $opt_s++, next opt if /s/;
  52             $opt_u++, next opt if /u/;
  53             &usage unless /[BMS]/;
  54
  55             # directory list processing
  56             $what = $_; @list = ();
  57             push(@list, substr($ARGV[$i], $j+1)) if $j+1 < length($ARGV[$i]);
  58             $i++;
  59             while ($i <= $#ARGV && $ARGV[$i] !~ /^-/) {
  60                 push(@list, $ARGV[$i++]);
  61             }
  62             if ($what eq "B") {@binaries = @list;}
  63             elsif ($what eq "M") {@manuals = @list;}
  64             elsif ($what eq "S") {@sources = @list;}
  65
  66             $i++, last arg if $ARGV[$i] =~ /^-f$/;
  67             next arg;
  68         }
  69         $i++;
  70     }
  71     &usage if $i > $#ARGV;
  72
  73     while ($ARGV[$i]) {
  74         push(@names, $ARGV[$i++]);
  75     }
  76 }
  77
  78
  79 sub decolonify
  80 {
  81     local($list) = @_;
  82     local($_, @rv);
  83     foreach(split(/:/, $list)) {
  84         push(@rv, $_);
  85     }
  86     return @rv;
  87 }
  88
  89
  90 &scanopts;
  91
  92 # default to all if no type requested
  93 if ($opt_b + $opt_m + $opt_s == 0) {$opt_b = $opt_m = $opt_s = 1;}
  94
  95 if (!defined(@binaries)) {
  96     #
  97     # first, use default path, then append /usr/libexec and the user's path
  98     #
  99     local($cs_path) = `/sbin/sysctl -n user.cs_path`;
 100     local(@list, %path);
 101
 102     chop($cs_path);
 103
 104     @list = &decolonify($cs_path);
 105     push(@list, "/usr/libexec");
 106     push(@list, &decolonify($ENV{'PATH'}));
 107
 108     # resolve ~, remove duplicates
 109     foreach (@list) {
 110         s/^~/$ENV{'HOME'}/ if /^~/;
 111         push(@binaries, $_) if !$path{$_};
 112         $path{$_}++;
 113     }
 114 }
 115
 116 if (!defined(@manuals)) {
 117     #
 118     # first, use default manpath, then append user's $MANPATH
 119     #
 120     local($usermanpath) = $ENV{'MANPATH'};
 121     delete $ENV{'MANPATH'};
 122     local($manpath) = `/usr/bin/manpath`;
 123     local(@list, %path, $i);
 124
 125     chop($manpath);
 126
 127     @list = &decolonify($manpath);
 128     push(@list, &decolonify($usermanpath));
 129
 130     # remove duplicates
 131     foreach (@list) {
 132         push(@manuals, $_) if !$path{$_};
 133         $path{$_}++;
 134     }
 135 }
 136
 137 if (!defined(@sources)) {
 138     #
 139     # default command sources
 140     #
 141     local($_);
 142
 143     @sources = ("/usr/src/bin", "/usr/src/usr.bin", "/usr/src/sbin",
 144                 "/usr/src/usr.sbin", "/usr/src/libexec",
 145                 "/usr/src/gnu/bin", "/usr/src/gnu/usr.bin",
 146                 "/usr/src/gnu/sbin", "/usr/src/gnu/usr.sbin",
 147                 "/usr/src/gnu/libexec", "/usr/src/contrib");
 148
 149     #
 150     # if /usr/ports exists, look in all its subdirs, too
 151     #
 152     if (-d "/usr/ports" && opendir(PORTS, "/usr/ports")) {
 153         while ($_ = readdir(PORTS)) {
 154             next if /^\.\.?$/;
 155             next if /^distfiles$/; # magic
 156             next if ! -d "/usr/ports/$_";
 157             push(@sources, "/usr/ports/$_");
 158         }
 159         closedir(PORTS);
 160     }
 161 }
 162
 163 if ($opt_m) {
 164     # construct a new MANPATH
 165     foreach (@manuals) {
 166         next if ! -d $_;
 167         if ($manpath) { $manpath .= ":$_"; }
 168         else { $manpath = $_; }
 169     }
 170 }
 171
 172 #
 173 # main loop
 174 #
 175 foreach $name (@names) {
 176     $name =~ s|^.*/||;          # strip leading path name component
 177     $name =~ s/,v$//; $name =~ s/^s\.//; # RCS or SCCS suffix/prefix
 178     $name =~ s/\.(Z|z|gz)$//;   # compression suffix
 179
 180     $line = "";
 181     $unusual = 0;
 182
 183     if ($opt_b) {
 184         #
 185         # Binaries have to match exactly, and must be regular executable
 186         # files.
 187         #
 188         $unusual++;
 189         foreach (@binaries) {
 190             $line .= " $_/$name", $unusual--, last if -f "$_/$name" && -x _;
 191         }
 192     }
 193
 194     if ($opt_m) {
 195         #
 196         # Ask the man command to do the search for us.
 197         #
 198         $unusual++;
 199         chop($result = `man -S 1:8 -M $manpath -w $name 2> /dev/null`);
 200         if ($result ne '') {
 201             $unusual--;
 202             ($cat, $junk, $src) = split(/[() \t\n]+/, $result);
 203             if ($src ne '') { $line .= " $src"; }
 204             else { $line .= " $cat"; }
 205         }
 206     }
 207
 208     if ($opt_s) {
 209         #
 210         # Sources match if a subdir with the exact name is found.
 211         #
 212         $found = 0;
 213         $unusual++;
 214         foreach (@sources) {
 215                 $line .= " $_/$name", $unusual--, $found++ if -d "$_/$name";
 216         }
 217         #
 218         # If not yet found, ask locate(1) to do the search for us.
 219         # This will find sources for things like lpr, but take longer.
 220         # Do only match locate output that starts with one of our
 221         # source directories, and at least one further level of
 222         # subdirectories.
 223         #
 224         if (!$found && open(LOCATE, "locate */$name 2>/dev/null |")) {
 225           locate_item:
 226             while (chop($loc = <LOCATE>)) {
 227                 foreach (@sources) {
 228                     $line .= " $loc", $unusual--, last locate_item
 229                         if $loc =~ m|^$_/[^/]+/|;
 230                 }
 231             }
 232             close(LOCATE);
 233         }
 234     }
 235
 236     if ($opt_u) {
 237         print "$name:\n" if $unusual;
 238     } else {
 239         print "$name:$line\n";
 240     }
 241 }
 242