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 # $DragonFly: src/usr.bin/whereis/Attic/whereis.pl,v 1.2 2003/06/17 04:29:33 dillon Exp $
  33 #
  34
  35 sub usage
  36 {
  37     print STDERR "usage: $0 [-bms] [-u] [-BMS dir... -f] name ...\n";
  38     exit 1;
  39 }
  40
  41 sub scanopts
  42 {
  43     local($i, $j);
  44   arg:
  45     while ($ARGV[$i] =~ /^-/) {
  46       opt:
  47         for ($j = 1; $j < length($ARGV[$i]); $j++) {
  48             local($_) = substr($ARGV[$i], $j, 1);
  49             local($what, @list);
  50             $opt_b++, next opt if /b/;
  51             $opt_m++, next opt if /m/;
  52             $opt_s++, next opt if /s/;
  53             $opt_u++, next opt if /u/;
  54             &usage unless /[BMS]/;
  55
  56             # directory list processing
  57             $what = $_; @list = ();
  58             push(@list, substr($ARGV[$i], $j+1)) if $j+1 < length($ARGV[$i]);
  59             $i++;
  60             while ($i <= $#ARGV && $ARGV[$i] !~ /^-/) {
  61                 push(@list, $ARGV[$i++]);
  62             }
  63             if ($what eq "B") {@binaries = @list;}
  64             elsif ($what eq "M") {@manuals = @list;}
  65             elsif ($what eq "S") {@sources = @list;}
  66
  67             $i++, last arg if $ARGV[$i] =~ /^-f$/;
  68             next arg;
  69         }
  70         $i++;
  71     }
  72     &usage if $i > $#ARGV;
  73
  74     while ($ARGV[$i]) {
  75         push(@names, $ARGV[$i++]);
  76     }
  77 }
  78
  79
  80 sub decolonify
  81 {
  82     local($list) = @_;
  83     local($_, @rv);
  84     foreach(split(/:/, $list)) {
  85         push(@rv, $_);
  86     }
  87     return @rv;
  88 }
  89
  90
  91 &scanopts;
  92
  93 # default to all if no type requested
  94 if ($opt_b + $opt_m + $opt_s == 0) {$opt_b = $opt_m = $opt_s = 1;}
  95
  96 if (!defined(@binaries)) {
  97     #
  98     # first, use default path, then append /usr/libexec and the user's path
  99     #
 100     local($cs_path) = `/sbin/sysctl -n user.cs_path`;
 101     local(@list, %path);
 102
 103     chop($cs_path);
 104
 105     @list = &decolonify($cs_path);
 106     push(@list, "/usr/libexec");
 107     push(@list, &decolonify($ENV{'PATH'}));
 108
 109     # resolve ~, remove duplicates
 110     foreach (@list) {
 111         s/^~/$ENV{'HOME'}/ if /^~/;
 112         push(@binaries, $_) if !$path{$_};
 113         $path{$_}++;
 114     }
 115 }
 116
 117 if (!defined(@manuals)) {
 118     #
 119     # first, use default manpath, then append user's $MANPATH
 120     #
 121     local($usermanpath) = $ENV{'MANPATH'};
 122     delete $ENV{'MANPATH'};
 123     local($manpath) = `/usr/bin/manpath`;
 124     local(@list, %path, $i);
 125
 126     chop($manpath);
 127
 128     @list = &decolonify($manpath);
 129     push(@list, &decolonify($usermanpath));
 130
 131     # remove duplicates
 132     foreach (@list) {
 133         push(@manuals, $_) if !$path{$_};
 134         $path{$_}++;
 135     }
 136 }
 137
 138 if (!defined(@sources)) {
 139     #
 140     # default command sources
 141     #
 142     local($_);
 143
 144     @sources = ("/usr/src/bin", "/usr/src/usr.bin", "/usr/src/sbin",
 145                 "/usr/src/usr.sbin", "/usr/src/libexec",
 146                 "/usr/src/gnu/bin", "/usr/src/gnu/usr.bin",
 147                 "/usr/src/gnu/sbin", "/usr/src/gnu/usr.sbin",
 148                 "/usr/src/gnu/libexec", "/usr/src/contrib");
 149
 150     #
 151     # if /usr/ports exists, look in all its subdirs, too
 152     #
 153     if (-d "/usr/ports" && opendir(PORTS, "/usr/ports")) {
 154         while ($_ = readdir(PORTS)) {
 155             next if /^\.\.?$/;
 156             next if /^distfiles$/; # magic
 157             next if ! -d "/usr/ports/$_";
 158             push(@sources, "/usr/ports/$_");
 159         }
 160         closedir(PORTS);
 161     }
 162 }
 163
 164 if ($opt_m) {
 165     # construct a new MANPATH
 166     foreach (@manuals) {
 167         next if ! -d $_;
 168         if ($manpath) { $manpath .= ":$_"; }
 169         else { $manpath = $_; }
 170     }
 171 }
 172
 173 #
 174 # main loop
 175 #
 176 foreach $name (@names) {
 177     $name =~ s|^.*/||;          # strip leading path name component
 178     $name =~ s/,v$//; $name =~ s/^s\.//; # RCS or SCCS suffix/prefix
 179     $name =~ s/\.(Z|z|gz)$//;   # compression suffix
 180
 181     $line = "";
 182     $unusual = 0;
 183
 184     if ($opt_b) {
 185         #
 186         # Binaries have to match exactly, and must be regular executable
 187         # files.
 188         #
 189         $unusual++;
 190         foreach (@binaries) {
 191             $line .= " $_/$name", $unusual--, last if -f "$_/$name" && -x _;
 192         }
 193     }
 194
 195     if ($opt_m) {
 196         #
 197         # Ask the man command to do the search for us.
 198         #
 199         $unusual++;
 200         chop($result = `man -S 1:8 -M $manpath -w $name 2> /dev/null`);
 201         if ($result ne '') {
 202             $unusual--;
 203             ($cat, $junk, $src) = split(/[() \t\n]+/, $result);
 204             if ($src ne '') { $line .= " $src"; }
 205             else { $line .= " $cat"; }
 206         }
 207     }
 208
 209     if ($opt_s) {
 210         #
 211         # Sources match if a subdir with the exact name is found.
 212         #
 213         $found = 0;
 214         $unusual++;
 215         foreach (@sources) {
 216                 $line .= " $_/$name", $unusual--, $found++ if -d "$_/$name";
 217         }
 218         #
 219         # If not yet found, ask locate(1) to do the search for us.
 220         # This will find sources for things like lpr, but take longer.
 221         # Do only match locate output that starts with one of our
 222         # source directories, and at least one further level of
 223         # subdirectories.
 224         #
 225         if (!$found && open(LOCATE, "locate */$name 2>/dev/null |")) {
 226           locate_item:
 227             while (chop($loc = <LOCATE>)) {
 228                 foreach (@sources) {
 229                     $line .= " $loc", $unusual--, last locate_item
 230                         if $loc =~ m|^$_/[^/]+/|;
 231                 }
 232             }
 233             close(LOCATE);
 234         }
 235     }
 236
 237     if ($opt_u) {
 238         print "$name:\n" if $unusual;
 239     } else {
 240         print "$name:$line\n";
 241     }
 242 }
 243