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 44use strict; 45 46use vars qw($Prog %Output @SaveArgv); 47use 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# 54use vars qw(%id_hash %alias_hash); 55 56use POSIX qw(getenv); 57use Getopt::Std; 58use File::Basename; 59use 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# 73sub 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# 172sub 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# 231sub 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. 313chomp($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. 318my $moddir = dirname($0); 319$moddir = "$moddir/../lib/perl" if ! -f "$moddir/onbld_elfmod.pm"; 320require "$moddir/onbld_elfmod.pm"; 321 322# Check that we have arguments. 323@SaveArgv = @ARGV; 324if ((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 338my $Arg = $ARGV[0]; 339my $Error = 0; 340 341ARG: { 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. 374my %alias_text = (); 375foreach 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. 391foreach my $Path (sort keys %Output) { 392 print $Output{$Path}; 393 print $alias_text{$Path} if defined($alias_text{$Path}); 394} 395 396exit $Error; 397