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