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 2009 Sun Microsystems, Inc. All rights reserved. 25# Use is subject to license terms. 26# 27 28# 29# Find ELF executables and sharable objects 30# 31# This script descends a directory hierarchy and reports the ELF 32# objects found, one object per line of output. 33# 34# find_elf [-frs] path 35# 36# Where path is a file or directory. 37# 38# Each line of output is of the form: 39# 40# ELFCLASS ELFTYPE VERDEF|NOVERDEF relpath 41# 42# where relpath is the path relative to the directory from which the 43# search started. 44 45use strict; 46 47use vars qw($Prog %Output @SaveArgv); 48use vars qw(%opt $HaveElfedit); 49 50# Hashes used to detect aliases --- symlinks that reference a common file 51# 52# id_hash - Maps the unique st_dev/st_ino pair to the real file 53# alias_hash - Maps symlinks to the real file they reference 54# 55use vars qw(%id_hash %alias_hash); 56 57use POSIX qw(getenv); 58use Getopt::Std; 59use File::Basename; 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) { 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 if (opendir(DIR, $FullDir)) { 237 foreach $Entry (readdir(DIR)) { 238 239 if ($Entry =~ /^\./) { 240 next; 241 } 242 $NewFull = join('/', $FullDir, $Entry); 243 244 # We need to follow symlinks in order to capture 245 # all possible aliases for each object. However, 246 # symlinks that point back at the same directory 247 # (e.g. 32->.) must be flagged via the SelfSymlink 248 # argument to our recursive self in order to avoid 249 # taking it more than one level down. 250 my $RecurseAliasedPath = $AliasedPath; 251 my $RecurseSelfSymlink = 0; 252 my $IsSymLink = -l $NewFull; 253 if ($IsSymLink) { 254 my $trans = readlink($NewFull); 255 256 $trans =~ s/\/*$//; 257 $RecurseSelfSymlink = 1 if $trans eq '.'; 258 $RecurseAliasedPath = 1; 259 } 260 261 if (!stat($NewFull)) { 262 next; 263 } 264 $NewRel = join('/', $RelDir, $Entry); 265 266 # Descend into and process any directories. 267 if (-d _) { 268 # If we have recursed here via a $SelfSymlink, 269 # then do not persue directories. We only 270 # want to find objects in the same directory 271 # via that link. 272 next if $SelfSymlink; 273 274 ProcDir($NewFull, $NewRel, $RecurseAliasedPath, 275 $RecurseSelfSymlink); 276 next; 277 } 278 279 # In fast mode, we skip objects unless they end with 280 # a .so extension, or are executable. We touch 281 # considerably fewer files this way. 282 if ($opt{f} && !($Entry =~ /\.so$/) && 283 !($Entry =~ /\.so\./) && 284 ($opt{s} || (! -x _))) { 285 next; 286 } 287 288 # Process any standard files. 289 if (-f _) { 290 my ($dev, $ino) = stat(_); 291 ProcFile($NewFull, $NewRel, $AliasedPath, 292 $IsSymLink, $dev, $ino); 293 next; 294 } 295 296 } 297 closedir(DIR); 298 } 299} 300 301 302# ----------------------------------------------------------------------------- 303 304# Establish a program name for any error diagnostics. 305chomp($Prog = `basename $0`); 306 307# The onbld_elfmod package is maintained in the same directory as this 308# script, and is installed in ../lib/perl. Use the local one if present, 309# and the installed one otherwise. 310my $moddir = dirname($0); 311$moddir = "$moddir/../lib/perl" if ! -f "$moddir/onbld_elfmod.pm"; 312require "$moddir/onbld_elfmod.pm"; 313 314# Check that we have arguments. 315@SaveArgv = @ARGV; 316if ((getopts('frs', \%opt) == 0) || (scalar(@ARGV) != 1)) { 317 print "usage: $Prog [-frs] file | dir\n"; 318 print "\t[-f]\tuse file name at mode to speed search\n"; 319 print "\t[-r]\treport relative paths\n"; 320 print "\t[-s]\tonly remote sharable (ET_DYN) objects\n"; 321 exit 1; 322} 323 324%Output = (); 325%id_hash = (); 326%alias_hash = (); 327$HaveElfedit = -x '/usr/bin/elfedit'; 328 329my $Arg = $ARGV[0]; 330my $Error = 0; 331 332ARG: { 333 # Process simple files. 334 if (-f $Arg) { 335 my($RelPath) = $Arg; 336 337 if ($opt{r}) { 338 my $Prefix = $Arg; 339 340 $Prefix =~ s/(^.*)\/.*$/$1/; 341 $Prefix = '.' if ($Prefix eq $Arg); 342 print "PREFIX $Prefix\n"; 343 } 344 $RelPath =~ s/^.*\//.\//; 345 my ($dev, $ino) = stat(_); 346 my $IsSymLink = -l $Arg; 347 ProcFile($Arg, $RelPath, 0, $IsSymLink, $dev, $ino); 348 next; 349 } 350 351 # Process directories. 352 if (-d $Arg) { 353 $Arg =~ s/\/$//; 354 print "PREFIX $Arg\n" if $opt{r}; 355 ProcDir($Arg, ".", 0, 0); 356 next; 357 } 358 359 print "$Arg is not a file or directory\n"; 360 $Error = 1; 361} 362 363# Build a hash, using the primary file name as the key, that has the 364# strings for any aliases to that file. 365my %alias_text = (); 366foreach my $Alias (sort keys %alias_hash) { 367 my $id = $alias_hash{$Alias}; 368 if (defined($id_hash{$id})) { 369 my $obj = $id_hash{$id}; 370 my $str = "ALIAS $id_hash{$id}\t$Alias\n"; 371 372 if (defined($alias_text{$obj})) { 373 $alias_text{$obj} .= $str; 374 } else { 375 $alias_text{$obj} = $str; 376 } 377 } 378} 379 380# Output the main files sorted by name. Place the alias lines immediately 381# following each main file. 382foreach my $Path (sort keys %Output) { 383 print $Output{$Path}; 384 print $alias_text{$Path} if defined($alias_text{$Path}); 385} 386 387exit $Error; 388