usr/src/tools/scripts/find_elf.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # CDDL HEADER START
   4 #
   5 # The contents of this file are subject to the terms of the
   6 # Common Development and Distribution License (the "License").
   7 # You may not use this file except in compliance with the License.
   8 #
   9 # You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
  10 # or http://www.opensolaris.org/os/licensing.
  11 # See the License for the specific language governing permissions
  12 # and limitations under the License.
  13 #
  14 # When distributing Covered Code, include this CDDL HEADER in each
  15 # file and include the License file at usr/src/OPENSOLARIS.LICENSE.
  16 # If applicable, add the following below this CDDL HEADER, with the
  17 # fields enclosed by brackets "[]" replaced with your own identifying
  18 # information: Portions Copyright [yyyy] [name of copyright owner]
  19 #
  20 # CDDL HEADER END
  21 #
  22
  23 #
  24 # Copyright (c) 2009, 2010, Oracle and/or its affiliates. All rights reserved.
  25 #
  26
  27 #
  28 # Find ELF executables and sharable objects
  29 #
  30 # This script descends a directory hierarchy and reports the ELF
  31 # objects found, one object per line of output.
  32 #
  33 #       find_elf [-frs] path
  34 #
  35 # Where path is a file or directory.
  36 #
  37 # Each line of output is of the form:
  38 #
  39 #       ELFCLASS  ELFTYPE VERDEF|NOVERDEF relpath
  40 #
  41 # where relpath is the path relative to the directory from which the
  42 # search started.
  43
  44 use strict;
  45
  46 use vars  qw($Prog %Output @SaveArgv);
  47 use vars  qw(%opt $HaveElfedit);
  48
  49 # Hashes used to detect aliases --- symlinks that reference a common file
  50 #
  51 #       id_hash - Maps the unique st_dev/st_ino pair to the real file
  52 #       alias_hash - Maps symlinks to the real file they reference
  53 #
  54 use vars  qw(%id_hash %alias_hash);
  55
  56 use POSIX qw(getenv);
  57 use Getopt::Std;
  58 use File::Basename;
  59 use IO::Dir;
  60
  61
  62 ## GetObjectInfo(path)
  63 #
  64 # Return a 3 element output array describing the object
  65 # given by path. The elements of the array contain:
  66 #
  67 #       Index   Meaning
  68 #       -----------------------------------------------
  69 #       0       ELFCLASS of object (0 if not an ELF object)
  70 #       1       Type of object (NONE if not an ELF object)
  71 #       2       VERDEF if object defines versions, NOVERDEF otherwise
  72 #
  73 sub GetObjectInfo {
  74         my $path = $_[0];
  75
  76         # If elfedit is available, we use it to obtain the desired information
  77         # by executing three commands in order, to produce a 0, 2, or 3
  78         # element output array.
  79         #
  80         #       Command                 Meaning
  81         #       -----------------------------------------------
  82         #       ehdr:ei_class           ELFCLASS of object
  83         #       ehdr:ei_e_type          Type of object
  84         #       dyn:tag verdef          Address of verdef items
  85         #
  86         # We discard stderr, and simply examine the resulting array to
  87         # determine the situation:
  88         #
  89         #       # Array Elements        Meaning
  90         #       -----------------------------------------------
  91         #         0                     File is not ELF object
  92         #         2                     Object with no versions (no VERDEF)
  93         #         3                     Object that has versions
  94         if ($HaveElfedit) {
  95                 my $ecmd = "elfedit -r -o simple -e ehdr:ei_class " .
  96                     "-e ehdr:e_type -e 'dyn:tag verdef'";
  97                 my @Elf = split(/\n/, `$ecmd $path 2>/dev/null`);
  98
  99                 my $ElfCnt = scalar @Elf;
 100
 101                 # Return ET_NONE array if not an ELF object
 102                 return (0, 'NONE', 'NOVERDEF') if ($ElfCnt == 0);
 103
 104                 # Otherwise, convert the result to standard form
 105                 $Elf[0] =~ s/^ELFCLASS//;
 106                 $Elf[1] =~ s/^ET_//;
 107                 $Elf[2] = ($ElfCnt == 3) ? 'VERDEF' : 'NOVERDEF';
 108                 return @Elf;
 109         }
 110
 111         # For older platforms, we use elfdump to get the desired information.
 112         my @Elf = split(/\n/, `elfdump -ed $path 2>&1`);
 113         my $Header = 'None';
 114         my $Verdef = 'NOVERDEF';
 115         my ($Class, $Type);
 116
 117         foreach my $Line (@Elf) {
 118                 # If we have an invalid file type (which we can tell from the
 119                 # first line), or we're processing an archive, bail.
 120                 if ($Header eq 'None') {
 121                         if (($Line =~ /invalid file/) ||
 122                             ($Line =~ /$path(.*):/)) {
 123                                 return (0, 'NONE', 'NOVERDEF');
 124                         }
 125                 }
 126
 127                 if ($Line =~ /^ELF Header/) {
 128                         $Header = 'Ehdr';
 129                         next;
 130                 }
 131
 132                 if ($Line =~ /^Dynamic Section/) {
 133                         $Header = 'Dyn';
 134                         next;
 135                 }
 136
 137                 if ($Header eq 'Ehdr') {
 138                         if ($Line =~ /e_type:\s*ET_([^\s]+)/) {
 139                                 $Type = $1;
 140                                 next;
 141                         }
 142                         if ($Line =~ /ei_class:\s+ELFCLASS(\d+)/) {
 143                                 $Class = $1;
 144                                 next;
 145                         }
 146                         next;
 147                 }
 148
 149                 if (($Header eq 'Dyn') &&
 150                     ($Line =~ /^\s*\[\d+\]\s+VERDEF\s+/)) {
 151                         $Verdef = 'VERDEF';
 152                         next;
 153                 }
 154         }
 155         return ($Class, $Type, $Verdef);
 156 }
 157
 158
 159 ## ProcFile(FullPath, RelPath, AliasedPath, IsSymLink, dev, ino)
 160 #
 161 # Determine whether this a ELF dynamic object and if so, add a line
 162 # of output for it to @Output describing it.
 163 #
 164 # entry:
 165 #       FullPath - Fully qualified path
 166 #       RelPath - Path relative to starting root directory
 167 #       AliasedPath - True if RelPath contains a symlink directory component.
 168 #               Such a path represents an alias to the same file found
 169 #               completely via actual directories.
 170 #       IsSymLink - True if basename (final component) of path is a symlink.
 171 #
 172 sub ProcFile {
 173         my($FullPath, $RelPath, $AliasedPath, $IsSymLink, $dev, $ino) = @_;
 174         my(@Elf, @Pvs, @Pvs_don, @Vers, %TopVer);
 175         my($Aud, $Max, $Priv, $Pub, $ElfCnt, $Val, $Ttl, $NotPlugin);
 176
 177         my $uniqid = sprintf("%llx-%llx", $dev, $ino);
 178
 179         # Remove ./ from front of relative path
 180         $RelPath =~ s/^\.\///;
 181
 182         my $name = $opt{r} ? $RelPath : $FullPath;
 183
 184         # If this is a symlink, or the path contains a symlink, put it in
 185         # the alias hash for later analysis. We do this before testing to
 186         # see if it is an ELF file, because that's a relatively expensive
 187         # test. The tradeoff is that the alias hash will contain some files
 188         # we don't care about. That is a small cost.
 189         if (($IsSymLink || $AliasedPath) && !$opt{a}) {
 190                 $alias_hash{$name} = $uniqid;
 191                 return;
 192         }
 193
 194         # Obtain the ELF information for this object.
 195         @Elf = GetObjectInfo($FullPath);
 196
 197         # Return quietly if:
 198         #       - Not an executable or sharable object
 199         #       - An executable, but the -s option was used.
 200         if ((($Elf[1] ne 'EXEC') && ($Elf[1] ne 'DYN')) ||
 201             (($Elf[1] eq 'EXEC') && $opt{s})) {
 202                 return;
 203         }
 204
 205         $Output{$name} = sprintf("OBJECT %2s %-4s %-8s %s\n",
 206             $Elf[0], $Elf[1], $Elf[2], $name);
 207
 208         # Remember it for later alias analysis
 209         $id_hash{$uniqid} = $name;
 210 }
 211
 212
 213 ## ProcDir(FullPath, RelPath, AliasedPath, SelfSymlink)
 214 #
 215 # Recursively search directory for dynamic ELF objects, calling
 216 # ProcFile() on each one.
 217 #
 218 # entry:
 219 #       FullPath - Fully qualified path
 220 #       RelPath - Path relative to starting root directory
 221 #       AliasedPath - True if RelPath contains a symlink directory component.
 222 #               Such a path represents an alias to the same file found
 223 #               completely via actual directories.
 224 #       SelfSymlink - True (1) if the last segment in the path is a symlink
 225 #               that points at the same directory (i.e. 32->.). If SelfSymlink
 226 #               is True, ProcDir() examines the given directory for objects,
 227 #               but does not recurse past it. This captures the aliases for
 228 #               those objects, while avoiding entering a recursive loop,
 229 #               or generating nonsensical paths (i.e., 32/amd64/...).
 230 #
 231 sub ProcDir {
 232         my($FullDir, $RelDir, $AliasedPath, $SelfSymlink) = @_;
 233         my($NewFull, $NewRel, $Entry);
 234
 235         # Open the directory and read each entry, omit files starting with "."
 236         my $Dir = IO::Dir->new($FullDir);
 237         if (defined($Dir)) {
 238                 foreach $Entry ($Dir->read()) {
 239
 240                         # In fast mode, we skip any file name that starts
 241                         # with a dot, which by side effect also skips the
 242                         # '.' and '..' entries. In regular mode, we must
 243                         # explicitly filter out those entries.
 244                         if ($opt{f}) {
 245                                 next if ($Entry =~ /^\./);
 246                         } else {
 247                                 next if ($Entry =~ /^\.\.?$/);
 248                         }
 249
 250                         $NewFull = join('/', $FullDir, $Entry);
 251
 252                         # We need to follow symlinks in order to capture
 253                         # all possible aliases for each object. However,
 254                         # symlinks that point back at the same directory
 255                         # (e.g. 32->.) must be flagged via the SelfSymlink
 256                         # argument to our recursive self in order to avoid
 257                         # taking it more than one level down.
 258                         my $RecurseAliasedPath = $AliasedPath;
 259                         my $RecurseSelfSymlink = 0;
 260                         my $IsSymLink = -l $NewFull;
 261                         if ($IsSymLink) {
 262                                 my $trans = readlink($NewFull);
 263
 264                                 $trans =~ s/\/*$//;
 265                                 $RecurseSelfSymlink = 1 if $trans eq '.';
 266                                 $RecurseAliasedPath = 1;
 267                         }
 268
 269                         if (!stat($NewFull)) {
 270                                 next;
 271                         }
 272                         $NewRel = join('/', $RelDir, $Entry);
 273
 274                         # Descend into and process any directories.
 275                         if (-d _) {
 276                                 # If we have recursed here via a $SelfSymlink,
 277                                 # then do not persue directories. We only
 278                                 # want to find objects in the same directory
 279                                 # via that link.
 280                                 next if $SelfSymlink;
 281
 282                                 ProcDir($NewFull, $NewRel, $RecurseAliasedPath,
 283                                     $RecurseSelfSymlink);
 284                                 next;
 285                         }
 286
 287                         # In fast mode, we skip objects unless they end with
 288                         # a .so extension, or are executable. We touch
 289                         # considerably fewer files this way.
 290                         if ($opt{f} && !($Entry =~ /\.so$/) &&
 291                             !($Entry =~ /\.so\./) &&
 292                             ($opt{s} || (! -x _))) {
 293                             next;
 294                         }
 295
 296                         # Process any standard files.
 297                         if (-f _) {
 298                                 my ($dev, $ino) = stat(_);
 299                                 ProcFile($NewFull, $NewRel, $AliasedPath,
 300                                     $IsSymLink, $dev, $ino);
 301                                 next;
 302                         }
 303
 304                 }
 305                 $Dir->close();
 306         }
 307 }
 308
 309
 310 # -----------------------------------------------------------------------------
 311
 312 # Establish a program name for any error diagnostics.
 313 chomp($Prog = `basename $0`);
 314
 315 # The onbld_elfmod package is maintained in the same directory as this
 316 # script, and is installed in ../lib/perl. Use the local one if present,
 317 # and the installed one otherwise.
 318 my $moddir = dirname($0);
 319 $moddir = "$moddir/../lib/perl" if ! -f "$moddir/onbld_elfmod.pm";
 320 require "$moddir/onbld_elfmod.pm";
 321
 322 # Check that we have arguments.
 323 @SaveArgv = @ARGV;
 324 if ((getopts('afrs', \%opt) == 0) || (scalar(@ARGV) != 1)) {
 325         print "usage: $Prog [-frs] file | dir\n";
 326         print "\t[-a]\texpand symlink aliases\n";
 327         print "\t[-f]\tuse file name at mode to speed search\n";
 328         print "\t[-r]\treport relative paths\n";
 329         print "\t[-s]\tonly remote sharable (ET_DYN) objects\n";
 330         exit 1;
 331 }
 332
 333 %Output = ();
 334 %id_hash = ();
 335 %alias_hash = ();
 336 $HaveElfedit = -x '/usr/bin/elfedit';
 337
 338 my $Arg = $ARGV[0];
 339 my $Error = 0;
 340
 341 ARG: {
 342         # Process simple files.
 343         if (-f $Arg) {
 344                 my($RelPath) = $Arg;
 345
 346                 if ($opt{r}) {
 347                         my $Prefix = $Arg;
 348
 349                         $Prefix =~ s/(^.*)\/.*$/$1/;
 350                         $Prefix = '.' if ($Prefix eq $Arg);
 351                         print "PREFIX $Prefix\n";
 352                 }
 353                 $RelPath =~ s/^.*\//.\//;
 354                 my ($dev, $ino) = stat(_);
 355                 my $IsSymLink = -l $Arg;
 356                 ProcFile($Arg, $RelPath, 0, $IsSymLink, $dev, $ino);
 357                 next;
 358         }
 359
 360         # Process directories.
 361         if (-d $Arg) {
 362                 $Arg =~ s/\/$//;
 363                 print "PREFIX $Arg\n" if $opt{r};
 364                 ProcDir($Arg, ".", 0, 0);
 365                 next;
 366         }
 367
 368         print STDERR "$Prog: not a file or directory: $Arg\n";
 369         $Error = 1;
 370 }
 371
 372 # Build a hash, using the primary file name as the key, that has the
 373 # strings for any aliases to that file.
 374 my %alias_text = ();
 375 foreach my $Alias (sort keys %alias_hash) {
 376         my $id = $alias_hash{$Alias};
 377         if (defined($id_hash{$id})) {
 378                 my $obj = $id_hash{$id};
 379                 my $str = "ALIAS                   $id_hash{$id}\t$Alias\n";
 380
 381                 if (defined($alias_text{$obj})) {
 382                         $alias_text{$obj} .= $str;
 383                 } else {
 384                         $alias_text{$obj} = $str;
 385                 }
 386         }
 387 }
 388
 389 # Output the main files sorted by name. Place the alias lines immediately
 390 # following each main file.
 391 foreach my $Path (sort keys %Output) {
 392         print $Output{$Path};
 393         print $alias_text{$Path} if defined($alias_text{$Path});
 394 }
 395
 396 exit $Error;