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