xref: /titanic_51/usr/src/cmd/abi/appcert/scripts/symprof.pl (revision 7c478bd95313f5f23a4c958a745db2134aa03244)
1*7c478bd9Sstevel@tonic-gate#!/usr/perl5/bin/perl -w
2*7c478bd9Sstevel@tonic-gate#
3*7c478bd9Sstevel@tonic-gate# CDDL HEADER START
4*7c478bd9Sstevel@tonic-gate#
5*7c478bd9Sstevel@tonic-gate# The contents of this file are subject to the terms of the
6*7c478bd9Sstevel@tonic-gate# Common Development and Distribution License, Version 1.0 only
7*7c478bd9Sstevel@tonic-gate# (the "License").  You may not use this file except in compliance
8*7c478bd9Sstevel@tonic-gate# with the License.
9*7c478bd9Sstevel@tonic-gate#
10*7c478bd9Sstevel@tonic-gate# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
11*7c478bd9Sstevel@tonic-gate# or http://www.opensolaris.org/os/licensing.
12*7c478bd9Sstevel@tonic-gate# See the License for the specific language governing permissions
13*7c478bd9Sstevel@tonic-gate# and limitations under the License.
14*7c478bd9Sstevel@tonic-gate#
15*7c478bd9Sstevel@tonic-gate# When distributing Covered Code, include this CDDL HEADER in each
16*7c478bd9Sstevel@tonic-gate# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
17*7c478bd9Sstevel@tonic-gate# If applicable, add the following below this CDDL HEADER, with the
18*7c478bd9Sstevel@tonic-gate# fields enclosed by brackets "[]" replaced with your own identifying
19*7c478bd9Sstevel@tonic-gate# information: Portions Copyright [yyyy] [name of copyright owner]
20*7c478bd9Sstevel@tonic-gate#
21*7c478bd9Sstevel@tonic-gate# CDDL HEADER END
22*7c478bd9Sstevel@tonic-gate#
23*7c478bd9Sstevel@tonic-gate#
24*7c478bd9Sstevel@tonic-gate# ident	"%Z%%M%	%I%	%E% SMI"
25*7c478bd9Sstevel@tonic-gate#
26*7c478bd9Sstevel@tonic-gate# Copyright 2004 Sun Microsystems, Inc.  All rights reserved.
27*7c478bd9Sstevel@tonic-gate# Use is subject to license terms.
28*7c478bd9Sstevel@tonic-gate#
29*7c478bd9Sstevel@tonic-gate
30*7c478bd9Sstevel@tonic-gate#
31*7c478bd9Sstevel@tonic-gate# This utility program creates the profiles of the binaries to be
32*7c478bd9Sstevel@tonic-gate# checked.
33*7c478bd9Sstevel@tonic-gate#
34*7c478bd9Sstevel@tonic-gate# The dynamic profiling is done by running ldd -r on the binary with
35*7c478bd9Sstevel@tonic-gate# LD_DEBUG=files,bindings and parsing the linker debug output.
36*7c478bd9Sstevel@tonic-gate#
37*7c478bd9Sstevel@tonic-gate# The static profiling (gathering of .text symbols) is done by calling
38*7c478bd9Sstevel@tonic-gate# the utility program static_prof.
39*7c478bd9Sstevel@tonic-gate#
40*7c478bd9Sstevel@tonic-gate
41*7c478bd9Sstevel@tonic-gaterequire 5.005;
42*7c478bd9Sstevel@tonic-gateuse strict;
43*7c478bd9Sstevel@tonic-gateuse locale;
44*7c478bd9Sstevel@tonic-gateuse POSIX qw(locale_h);
45*7c478bd9Sstevel@tonic-gateuse Sun::Solaris::Utils qw(textdomain gettext);
46*7c478bd9Sstevel@tonic-gateuse File::Basename;
47*7c478bd9Sstevel@tonic-gateuse File::Path;
48*7c478bd9Sstevel@tonic-gate
49*7c478bd9Sstevel@tonic-gateuse lib qw(/usr/lib/abi/appcert);
50*7c478bd9Sstevel@tonic-gateuse AppcertUtil;
51*7c478bd9Sstevel@tonic-gate
52*7c478bd9Sstevel@tonic-gatesetlocale(LC_ALL, "");
53*7c478bd9Sstevel@tonic-gatetextdomain(TEXT_DOMAIN);
54*7c478bd9Sstevel@tonic-gate
55*7c478bd9Sstevel@tonic-gateuse vars qw(
56*7c478bd9Sstevel@tonic-gate	$tmp_prof_dir
57*7c478bd9Sstevel@tonic-gate);
58*7c478bd9Sstevel@tonic-gate
59*7c478bd9Sstevel@tonic-gateset_clean_up_exit_routine(\&clean_up_exit);
60*7c478bd9Sstevel@tonic-gate
61*7c478bd9Sstevel@tonic-gateimport_vars_from_environment();
62*7c478bd9Sstevel@tonic-gate
63*7c478bd9Sstevel@tonic-gatesignals('on', \&interrupted);
64*7c478bd9Sstevel@tonic-gate
65*7c478bd9Sstevel@tonic-gateset_working_dir();
66*7c478bd9Sstevel@tonic-gate
67*7c478bd9Sstevel@tonic-gateprofile_objects();
68*7c478bd9Sstevel@tonic-gate
69*7c478bd9Sstevel@tonic-gateclean_up();
70*7c478bd9Sstevel@tonic-gate
71*7c478bd9Sstevel@tonic-gateexit 0;
72*7c478bd9Sstevel@tonic-gate
73*7c478bd9Sstevel@tonic-gate#
74*7c478bd9Sstevel@tonic-gate# working_dir has been imported by import_vars_from_environment() from
75*7c478bd9Sstevel@tonic-gate# appcert.  A sanity check is performed here to make sure it exists.
76*7c478bd9Sstevel@tonic-gate#
77*7c478bd9Sstevel@tonic-gatesub set_working_dir
78*7c478bd9Sstevel@tonic-gate{
79*7c478bd9Sstevel@tonic-gate	if (! defined($working_dir) || ! -d $working_dir) {
80*7c478bd9Sstevel@tonic-gate		exiter("$command_name: " . sprintf(gettext(
81*7c478bd9Sstevel@tonic-gate		    "cannot locate working directory: %s\n"), $working_dir));
82*7c478bd9Sstevel@tonic-gate	}
83*7c478bd9Sstevel@tonic-gate}
84*7c478bd9Sstevel@tonic-gate
85*7c478bd9Sstevel@tonic-gate#
86*7c478bd9Sstevel@tonic-gate# Routine called when interrupted by user (e.g. SIGINT).
87*7c478bd9Sstevel@tonic-gate#
88*7c478bd9Sstevel@tonic-gatesub interrupted
89*7c478bd9Sstevel@tonic-gate{
90*7c478bd9Sstevel@tonic-gate	$SIG{$_[0]} = 'DEFAULT';
91*7c478bd9Sstevel@tonic-gate	signals('off');
92*7c478bd9Sstevel@tonic-gate	clean_up_exit(1);
93*7c478bd9Sstevel@tonic-gate}
94*7c478bd9Sstevel@tonic-gate
95*7c478bd9Sstevel@tonic-gate#
96*7c478bd9Sstevel@tonic-gate# Does the cleanup then exits with return code $rc.  Note: The utility
97*7c478bd9Sstevel@tonic-gate# routine exiter() calls this routine.
98*7c478bd9Sstevel@tonic-gate#
99*7c478bd9Sstevel@tonic-gatesub clean_up_exit
100*7c478bd9Sstevel@tonic-gate{
101*7c478bd9Sstevel@tonic-gate	my ($rc) = @_;
102*7c478bd9Sstevel@tonic-gate	$rc = 0 unless ($rc);
103*7c478bd9Sstevel@tonic-gate
104*7c478bd9Sstevel@tonic-gate	clean_up();
105*7c478bd9Sstevel@tonic-gate	exit $rc;
106*7c478bd9Sstevel@tonic-gate}
107*7c478bd9Sstevel@tonic-gate
108*7c478bd9Sstevel@tonic-gate#
109*7c478bd9Sstevel@tonic-gate# General cleanup activities.
110*7c478bd9Sstevel@tonic-gate#
111*7c478bd9Sstevel@tonic-gatesub clean_up
112*7c478bd9Sstevel@tonic-gate{
113*7c478bd9Sstevel@tonic-gate	if (defined($tmp_prof_dir) && -d $tmp_prof_dir) {
114*7c478bd9Sstevel@tonic-gate		rmtree($tmp_prof_dir);
115*7c478bd9Sstevel@tonic-gate	}
116*7c478bd9Sstevel@tonic-gate}
117*7c478bd9Sstevel@tonic-gate
118*7c478bd9Sstevel@tonic-gate#
119*7c478bd9Sstevel@tonic-gate# Top level routine to loop over the objects and call the profiling
120*7c478bd9Sstevel@tonic-gate# routines on each.
121*7c478bd9Sstevel@tonic-gate#
122*7c478bd9Sstevel@tonic-gatesub profile_objects
123*7c478bd9Sstevel@tonic-gate{
124*7c478bd9Sstevel@tonic-gate	# Make a tmp directory for the profiling work.
125*7c478bd9Sstevel@tonic-gate	$tmp_prof_dir = create_tmp_dir($tmp_dir);
126*7c478bd9Sstevel@tonic-gate
127*7c478bd9Sstevel@tonic-gate	if (! -d $tmp_prof_dir) {
128*7c478bd9Sstevel@tonic-gate		exiter(nocreatedir($tmp_prof_dir, $!));
129*7c478bd9Sstevel@tonic-gate	}
130*7c478bd9Sstevel@tonic-gate
131*7c478bd9Sstevel@tonic-gate	my ($dir, $path_to_object);
132*7c478bd9Sstevel@tonic-gate
133*7c478bd9Sstevel@tonic-gate	#
134*7c478bd9Sstevel@tonic-gate	# Loop over each object item in the working_dir.
135*7c478bd9Sstevel@tonic-gate	#  - $dir will be each one of these object directories.
136*7c478bd9Sstevel@tonic-gate	#  - $path_to_object will be the corresponding actual path
137*7c478bd9Sstevel@tonic-gate	#    to the the binary to be profiled.
138*7c478bd9Sstevel@tonic-gate	# Output will usually be placed down in $dir, e.g. "$dir/profile.static"
139*7c478bd9Sstevel@tonic-gate	#
140*7c478bd9Sstevel@tonic-gate
141*7c478bd9Sstevel@tonic-gate	my $cnt = -1;
142*7c478bd9Sstevel@tonic-gate	my $last_i;
143*7c478bd9Sstevel@tonic-gate	while (defined($dir = next_dir_name())) {
144*7c478bd9Sstevel@tonic-gate		$cnt++;
145*7c478bd9Sstevel@tonic-gate		if ($block_max ne '') {
146*7c478bd9Sstevel@tonic-gate			next if ($cnt < $block_min || $cnt >= $block_max);
147*7c478bd9Sstevel@tonic-gate		}
148*7c478bd9Sstevel@tonic-gate
149*7c478bd9Sstevel@tonic-gate		$last_i = $cnt;
150*7c478bd9Sstevel@tonic-gate
151*7c478bd9Sstevel@tonic-gate		# Map object output directory to actual path of the object:
152*7c478bd9Sstevel@tonic-gate		$path_to_object = dir_name_to_path($dir);
153*7c478bd9Sstevel@tonic-gate
154*7c478bd9Sstevel@tonic-gate		if (! -f $path_to_object) {
155*7c478bd9Sstevel@tonic-gate			exiter(nopathexist($path_to_object, $!));
156*7c478bd9Sstevel@tonic-gate		}
157*7c478bd9Sstevel@tonic-gate
158*7c478bd9Sstevel@tonic-gate		# Profile it:
159*7c478bd9Sstevel@tonic-gate
160*7c478bd9Sstevel@tonic-gate		emsg(gettext("profiling: %s\n"), $path_to_object);
161*7c478bd9Sstevel@tonic-gate
162*7c478bd9Sstevel@tonic-gate		static_profile($path_to_object, $dir);
163*7c478bd9Sstevel@tonic-gate
164*7c478bd9Sstevel@tonic-gate		dynamic_profile($path_to_object, $dir);
165*7c478bd9Sstevel@tonic-gate	}
166*7c478bd9Sstevel@tonic-gate
167*7c478bd9Sstevel@tonic-gate	# Only try this after everything has been initially profiled.
168*7c478bd9Sstevel@tonic-gate	if (! $block_max || $last_i >= $binary_count - 1) {
169*7c478bd9Sstevel@tonic-gate		redo_unbound_profile();
170*7c478bd9Sstevel@tonic-gate	}
171*7c478bd9Sstevel@tonic-gate	clean_up();	# Remove any tmp dirs and files.
172*7c478bd9Sstevel@tonic-gate}
173*7c478bd9Sstevel@tonic-gate
174*7c478bd9Sstevel@tonic-gate#
175*7c478bd9Sstevel@tonic-gate# Runs utility program static_prof on the object and places results in
176*7c478bd9Sstevel@tonic-gate# output directory.
177*7c478bd9Sstevel@tonic-gate#
178*7c478bd9Sstevel@tonic-gatesub static_profile($$)
179*7c478bd9Sstevel@tonic-gate{
180*7c478bd9Sstevel@tonic-gate	my ($object, $output_dir) = @_;
181*7c478bd9Sstevel@tonic-gate
182*7c478bd9Sstevel@tonic-gate	# This is the location of static_prof's output file:
183*7c478bd9Sstevel@tonic-gate
184*7c478bd9Sstevel@tonic-gate	my $outfile = "$output_dir/profile.static";
185*7c478bd9Sstevel@tonic-gate
186*7c478bd9Sstevel@tonic-gate	# It is consumed by static_check_object() in symcheck.
187*7c478bd9Sstevel@tonic-gate
188*7c478bd9Sstevel@tonic-gate	#
189*7c478bd9Sstevel@tonic-gate	# Do not run on *completely* statically linked objects.  This
190*7c478bd9Sstevel@tonic-gate	# case will be caught and noted in the dynamic profiling and
191*7c478bd9Sstevel@tonic-gate	# checking.
192*7c478bd9Sstevel@tonic-gate	#
193*7c478bd9Sstevel@tonic-gate	my $skip_it;
194*7c478bd9Sstevel@tonic-gate	if (is_statically_linked($object)) {
195*7c478bd9Sstevel@tonic-gate		$skip_it = "STATICALLY_LINKED";
196*7c478bd9Sstevel@tonic-gate	} elsif (! is_elf($object)) {
197*7c478bd9Sstevel@tonic-gate		$skip_it = "NON_ELF";
198*7c478bd9Sstevel@tonic-gate	}
199*7c478bd9Sstevel@tonic-gate
200*7c478bd9Sstevel@tonic-gate	my $static_prof_fh = do { local *FH; *FH };
201*7c478bd9Sstevel@tonic-gate	if (defined($skip_it)) {
202*7c478bd9Sstevel@tonic-gate		open($static_prof_fh, ">$outfile") ||
203*7c478bd9Sstevel@tonic-gate		    exiter(nofile($outfile, $!));
204*7c478bd9Sstevel@tonic-gate
205*7c478bd9Sstevel@tonic-gate		print $static_prof_fh "#SKIPPED_TEST: $skip_it\n";
206*7c478bd9Sstevel@tonic-gate		close($static_prof_fh);
207*7c478bd9Sstevel@tonic-gate
208*7c478bd9Sstevel@tonic-gate		return;
209*7c478bd9Sstevel@tonic-gate	}
210*7c478bd9Sstevel@tonic-gate
211*7c478bd9Sstevel@tonic-gate	#
212*7c478bd9Sstevel@tonic-gate	# system() when run in the following manner will prevent the
213*7c478bd9Sstevel@tonic-gate	# shell from expanding any strange characters in $object. Quotes
214*7c478bd9Sstevel@tonic-gate	# around '$object' would be almost as safe.  since excluded
215*7c478bd9Sstevel@tonic-gate	# earlier the cases where it contains the ' character.
216*7c478bd9Sstevel@tonic-gate	#
217*7c478bd9Sstevel@tonic-gate	system("$appcert_lib_dir/static_prof", '-p', '-s', '-o', $outfile,
218*7c478bd9Sstevel@tonic-gate	    $object);
219*7c478bd9Sstevel@tonic-gate
220*7c478bd9Sstevel@tonic-gate	if ($? != 0) {
221*7c478bd9Sstevel@tonic-gate		open($static_prof_fh, ">$outfile") ||
222*7c478bd9Sstevel@tonic-gate		    exiter(nofile($outfile, $!));
223*7c478bd9Sstevel@tonic-gate
224*7c478bd9Sstevel@tonic-gate		#
225*7c478bd9Sstevel@tonic-gate		# For completeness, we'll use elfdump to record the
226*7c478bd9Sstevel@tonic-gate		# static profile for 64 bit binaries, although the
227*7c478bd9Sstevel@tonic-gate		# static linking problems only occur for 32-bit
228*7c478bd9Sstevel@tonic-gate		# applications.
229*7c478bd9Sstevel@tonic-gate		#
230*7c478bd9Sstevel@tonic-gate		my ($prof, $sym);
231*7c478bd9Sstevel@tonic-gate		$prof = '';
232*7c478bd9Sstevel@tonic-gate		my $elfdump_fh = do { local *FH; *FH };
233*7c478bd9Sstevel@tonic-gate		if (open($elfdump_fh, "$cmd_elfdump -s -N .dynsym '$object' " .
234*7c478bd9Sstevel@tonic-gate		    " 2>/dev/null |")) {
235*7c478bd9Sstevel@tonic-gate			while (<$elfdump_fh>) {
236*7c478bd9Sstevel@tonic-gate				chomp;
237*7c478bd9Sstevel@tonic-gate				if (/\s\.text\s+(\S+)$/) {
238*7c478bd9Sstevel@tonic-gate					$sym = $1;
239*7c478bd9Sstevel@tonic-gate					if (! /\bFUNC\b/) {
240*7c478bd9Sstevel@tonic-gate						next;
241*7c478bd9Sstevel@tonic-gate					}
242*7c478bd9Sstevel@tonic-gate					if (/\bGLOB\b/) {
243*7c478bd9Sstevel@tonic-gate						$prof .= "$object|TEXT|GLOB|" .
244*7c478bd9Sstevel@tonic-gate						    "FUNC|$sym\n";
245*7c478bd9Sstevel@tonic-gate					} else {
246*7c478bd9Sstevel@tonic-gate						$prof .= "$object|TEXT|WEAK|" .
247*7c478bd9Sstevel@tonic-gate						    "FUNC|$sym\n";
248*7c478bd9Sstevel@tonic-gate					}
249*7c478bd9Sstevel@tonic-gate				}
250*7c478bd9Sstevel@tonic-gate			}
251*7c478bd9Sstevel@tonic-gate			close($elfdump_fh);
252*7c478bd9Sstevel@tonic-gate		}
253*7c478bd9Sstevel@tonic-gate		if ($prof ne '') {
254*7c478bd9Sstevel@tonic-gate			my $line;
255*7c478bd9Sstevel@tonic-gate			print $static_prof_fh "#generated by symprof/elfdump\n";
256*7c478bd9Sstevel@tonic-gate			print $static_prof_fh "#dtneeded:";
257*7c478bd9Sstevel@tonic-gate			foreach $line (split(/\n/, cmd_output_dump($object))) {
258*7c478bd9Sstevel@tonic-gate				if ($line =~ /\bNEEDED\s+(\S+)/) {
259*7c478bd9Sstevel@tonic-gate					print $static_prof_fh " $1";
260*7c478bd9Sstevel@tonic-gate				}
261*7c478bd9Sstevel@tonic-gate			}
262*7c478bd9Sstevel@tonic-gate			print $static_prof_fh "\n";
263*7c478bd9Sstevel@tonic-gate			print $static_prof_fh $prof;
264*7c478bd9Sstevel@tonic-gate		} else {
265*7c478bd9Sstevel@tonic-gate			print $static_prof_fh "#SKIPPED_TEST: " .
266*7c478bd9Sstevel@tonic-gate			    "PROFILER_PROGRAM_static_prof_RETURNED:$?\n";
267*7c478bd9Sstevel@tonic-gate		}
268*7c478bd9Sstevel@tonic-gate		close($static_prof_fh);
269*7c478bd9Sstevel@tonic-gate
270*7c478bd9Sstevel@tonic-gate
271*7c478bd9Sstevel@tonic-gate		return;
272*7c478bd9Sstevel@tonic-gate	}
273*7c478bd9Sstevel@tonic-gate
274*7c478bd9Sstevel@tonic-gate	# Also store the dtneededs from the static profile output.
275*7c478bd9Sstevel@tonic-gate	my $dtneeded = "$output_dir/info.dtneeded";
276*7c478bd9Sstevel@tonic-gate
277*7c478bd9Sstevel@tonic-gate	my $dtneeded_fh = do { local *FH; *FH };
278*7c478bd9Sstevel@tonic-gate	open($dtneeded_fh, ">$dtneeded") ||
279*7c478bd9Sstevel@tonic-gate	    exiter(nofile($dtneeded, $!));
280*7c478bd9Sstevel@tonic-gate
281*7c478bd9Sstevel@tonic-gate	open($static_prof_fh, "<$outfile") ||
282*7c478bd9Sstevel@tonic-gate	    exiter(nofile($outfile, $!));
283*7c478bd9Sstevel@tonic-gate
284*7c478bd9Sstevel@tonic-gate	my $lib;
285*7c478bd9Sstevel@tonic-gate	while (<$static_prof_fh>) {
286*7c478bd9Sstevel@tonic-gate
287*7c478bd9Sstevel@tonic-gate		next unless (/^\s*#/);
288*7c478bd9Sstevel@tonic-gate
289*7c478bd9Sstevel@tonic-gate		if (/^\s*#\s*dtneeded:\s*(\S.*)$/) {
290*7c478bd9Sstevel@tonic-gate			foreach $lib (split(/\s+/, $1)) {
291*7c478bd9Sstevel@tonic-gate				next if ($lib eq '');
292*7c478bd9Sstevel@tonic-gate				print $dtneeded_fh "$lib\n";
293*7c478bd9Sstevel@tonic-gate			}
294*7c478bd9Sstevel@tonic-gate			last;
295*7c478bd9Sstevel@tonic-gate		}
296*7c478bd9Sstevel@tonic-gate	}
297*7c478bd9Sstevel@tonic-gate	close($dtneeded_fh);
298*7c478bd9Sstevel@tonic-gate	close($static_prof_fh);
299*7c478bd9Sstevel@tonic-gate}
300*7c478bd9Sstevel@tonic-gate
301*7c478bd9Sstevel@tonic-gate#
302*7c478bd9Sstevel@tonic-gate# Top level subroutine for doing a dynamic profile of an object.  It
303*7c478bd9Sstevel@tonic-gate# calls get_dynamic_profile() which handles the details of the actual
304*7c478bd9Sstevel@tonic-gate# profiling and returns the newline separated "preprocessed format" to
305*7c478bd9Sstevel@tonic-gate# this subroutine.
306*7c478bd9Sstevel@tonic-gate#
307*7c478bd9Sstevel@tonic-gate# The records are then processed and placed in the output directory.
308*7c478bd9Sstevel@tonic-gate#
309*7c478bd9Sstevel@tonic-gatesub dynamic_profile
310*7c478bd9Sstevel@tonic-gate{
311*7c478bd9Sstevel@tonic-gate	my ($object, $output_dir) = @_;
312*7c478bd9Sstevel@tonic-gate
313*7c478bd9Sstevel@tonic-gate	my ($profile, $line, $tmp);
314*7c478bd9Sstevel@tonic-gate
315*7c478bd9Sstevel@tonic-gate	# This is the profile output file.
316*7c478bd9Sstevel@tonic-gate	my $outfile = "$output_dir/profile.dynamic";
317*7c478bd9Sstevel@tonic-gate
318*7c478bd9Sstevel@tonic-gate	$profile = get_dynamic_profile($object);
319*7c478bd9Sstevel@tonic-gate
320*7c478bd9Sstevel@tonic-gate	if ($profile =~ /^ERROR:\s*(.*)$/) {
321*7c478bd9Sstevel@tonic-gate		# There was some problem obtaining the dynamic profile
322*7c478bd9Sstevel@tonic-gate		my $msg = $1;
323*7c478bd9Sstevel@tonic-gate		my $errfile = "$output_dir/profile.dynamic.errors";
324*7c478bd9Sstevel@tonic-gate
325*7c478bd9Sstevel@tonic-gate		my $profile_error_fh = do { local *FH; *FH };
326*7c478bd9Sstevel@tonic-gate		open($profile_error_fh, ">>$errfile") ||
327*7c478bd9Sstevel@tonic-gate		    exiter(nofile($errfile, $!));
328*7c478bd9Sstevel@tonic-gate
329*7c478bd9Sstevel@tonic-gate		$msg =~ s/\n/ /g;
330*7c478bd9Sstevel@tonic-gate		$msg =~ s/;/,/g;
331*7c478bd9Sstevel@tonic-gate		print $profile_error_fh $msg, "\n";
332*7c478bd9Sstevel@tonic-gate		close($profile_error_fh);
333*7c478bd9Sstevel@tonic-gate
334*7c478bd9Sstevel@tonic-gate		# Write a comment to the profile file as well:
335*7c478bd9Sstevel@tonic-gate		my $profile_fh = do { local *FH; *FH };
336*7c478bd9Sstevel@tonic-gate		open($profile_fh, ">$outfile") ||
337*7c478bd9Sstevel@tonic-gate		    exiter(nofile($outfile, $!));
338*7c478bd9Sstevel@tonic-gate		print $profile_fh "#NO_BINDINGS_FOUND $msg\n";
339*7c478bd9Sstevel@tonic-gate		close($profile_fh);
340*7c478bd9Sstevel@tonic-gate
341*7c478bd9Sstevel@tonic-gate		return;
342*7c478bd9Sstevel@tonic-gate	}
343*7c478bd9Sstevel@tonic-gate
344*7c478bd9Sstevel@tonic-gate	my ($filter, $filtee, $from, $to, $sym);
345*7c478bd9Sstevel@tonic-gate	my ($type, $saw_bindings, $all_needed);
346*7c478bd9Sstevel@tonic-gate	my (%filter_map, %symlink_map);
347*7c478bd9Sstevel@tonic-gate
348*7c478bd9Sstevel@tonic-gate	# Resolve the symlink of the object, if any.
349*7c478bd9Sstevel@tonic-gate	$symlink_map{$object} = follow_symlink($object);
350*7c478bd9Sstevel@tonic-gate
351*7c478bd9Sstevel@tonic-gate	#
352*7c478bd9Sstevel@tonic-gate	# Collect the filter or static linking info first.  Since the
353*7c478bd9Sstevel@tonic-gate	# filter info may be used to alias libraries, it is safest to do
354*7c478bd9Sstevel@tonic-gate	# it before any bindings processing.  that is why we iterate
355*7c478bd9Sstevel@tonic-gate	# through $profile twice.
356*7c478bd9Sstevel@tonic-gate	#
357*7c478bd9Sstevel@tonic-gate	my @dynamic_profile_array = split(/\n/, $profile);
358*7c478bd9Sstevel@tonic-gate
359*7c478bd9Sstevel@tonic-gate	foreach $line (@dynamic_profile_array) {
360*7c478bd9Sstevel@tonic-gate
361*7c478bd9Sstevel@tonic-gate		if ($line =~ /^FILTER_AUX:(.*)$/) {
362*7c478bd9Sstevel@tonic-gate			#
363*7c478bd9Sstevel@tonic-gate			# Here is the basic example of an auxiliary filter:
364*7c478bd9Sstevel@tonic-gate			#
365*7c478bd9Sstevel@tonic-gate			# FILTER: /usr/lib/libc.so.1
366*7c478bd9Sstevel@tonic-gate			# FILTEE: /usr/platform/sun4u/lib/libc_psr.so.1
367*7c478bd9Sstevel@tonic-gate			#
368*7c478bd9Sstevel@tonic-gate			# The app links against symbol memcpy() in
369*7c478bd9Sstevel@tonic-gate			# libc.so.1 at build time. Now, at run time IF
370*7c478bd9Sstevel@tonic-gate			# memcpy() is provided by libc_psr.so.1 then
371*7c478bd9Sstevel@tonic-gate			# that "code" is used, otherwise it backs off to
372*7c478bd9Sstevel@tonic-gate			# use the memcpy()in libc.so.1. The
373*7c478bd9Sstevel@tonic-gate			# libc_psr.so.1 doesn't even have to exist.
374*7c478bd9Sstevel@tonic-gate			#
375*7c478bd9Sstevel@tonic-gate			# The dynamic linker happily informs us that it
376*7c478bd9Sstevel@tonic-gate			# has found (and will bind to) memcpy() in
377*7c478bd9Sstevel@tonic-gate			# /usr/platform/sun4u/lib/libc_psr.so.1.  We
378*7c478bd9Sstevel@tonic-gate			# want to alias libc_psr.so.1 => libc.so.1.
379*7c478bd9Sstevel@tonic-gate			# Why?
380*7c478bd9Sstevel@tonic-gate			#	- less models to maintain. Note the symlink
381*7c478bd9Sstevel@tonic-gate			#	  situation in /usr/platform.
382*7c478bd9Sstevel@tonic-gate			#	- libc_psr.so.1 is versioned, but we would be
383*7c478bd9Sstevel@tonic-gate			#	  incorrect since it has memcpy() as SUNWprivate
384*7c478bd9Sstevel@tonic-gate			#
385*7c478bd9Sstevel@tonic-gate			# Therefore we record this aliasing in the hash
386*7c478bd9Sstevel@tonic-gate			# %filter_map.  This will be used below to
387*7c478bd9Sstevel@tonic-gate			# replace occurrences of the FILTEE string by
388*7c478bd9Sstevel@tonic-gate			# the FILTER string. Never the other way round.
389*7c478bd9Sstevel@tonic-gate			#
390*7c478bd9Sstevel@tonic-gate
391*7c478bd9Sstevel@tonic-gate			($filter, $filtee) = split(/\|/, $1, 2);
392*7c478bd9Sstevel@tonic-gate			$filter_map{$filtee} = $filter;
393*7c478bd9Sstevel@tonic-gate
394*7c478bd9Sstevel@tonic-gate			# Map the basenames too:
395*7c478bd9Sstevel@tonic-gate			$filter = basename($filter);
396*7c478bd9Sstevel@tonic-gate			$filtee = basename($filtee);
397*7c478bd9Sstevel@tonic-gate			$filter_map{$filtee} = $filter;
398*7c478bd9Sstevel@tonic-gate
399*7c478bd9Sstevel@tonic-gate		} elsif ($line =~ /^FILTER_STD:(.*)$/) {
400*7c478bd9Sstevel@tonic-gate
401*7c478bd9Sstevel@tonic-gate			#
402*7c478bd9Sstevel@tonic-gate			# Here is the basic example(s) of a standard filter:
403*7c478bd9Sstevel@tonic-gate			#
404*7c478bd9Sstevel@tonic-gate			# FILTER: /usr/lib/libsys.so.1
405*7c478bd9Sstevel@tonic-gate			# FILTEE: /usr/lib/libc.so.1
406*7c478bd9Sstevel@tonic-gate			#
407*7c478bd9Sstevel@tonic-gate			# Here is another:
408*7c478bd9Sstevel@tonic-gate			#
409*7c478bd9Sstevel@tonic-gate			# FILTER: /usr/lib/libw.so.1
410*7c478bd9Sstevel@tonic-gate			# FILTEE: /usr/lib/libc.so.1
411*7c478bd9Sstevel@tonic-gate			#
412*7c478bd9Sstevel@tonic-gate			# Here is a more perverse one, libxnet.so.1 has 3
413*7c478bd9Sstevel@tonic-gate			# filtees:
414*7c478bd9Sstevel@tonic-gate			#
415*7c478bd9Sstevel@tonic-gate			# FILTER: /usr/lib/libxnet.so.1
416*7c478bd9Sstevel@tonic-gate			# FILTEE: /usr/lib/{libsocket.so.1,libnsl.so.1,libc.so.1}
417*7c478bd9Sstevel@tonic-gate			#
418*7c478bd9Sstevel@tonic-gate			# The important point to note about standard
419*7c478bd9Sstevel@tonic-gate			# filters is that they contain NO CODE AT ALL.
420*7c478bd9Sstevel@tonic-gate			# All of the symbols in the filter MUST be found
421*7c478bd9Sstevel@tonic-gate			# in (and bound to) the filtee(s) or there is a
422*7c478bd9Sstevel@tonic-gate			# relocation error.
423*7c478bd9Sstevel@tonic-gate			#
424*7c478bd9Sstevel@tonic-gate			# The app links against symbol getwc() in
425*7c478bd9Sstevel@tonic-gate			# libw.so.1 at build time. Now, at run time
426*7c478bd9Sstevel@tonic-gate			# getwc() is actually provided by libc.so.1.
427*7c478bd9Sstevel@tonic-gate			#
428*7c478bd9Sstevel@tonic-gate			# The dynamic linker happily informs us that it
429*7c478bd9Sstevel@tonic-gate			# has found (and will bind to) getwc() in
430*7c478bd9Sstevel@tonic-gate			# libc.so.1. IT NEVER DIRECTLY TELLS US getwc was
431*7c478bd9Sstevel@tonic-gate			# actually referred to in libw.so.1
432*7c478bd9Sstevel@tonic-gate			#
433*7c478bd9Sstevel@tonic-gate			# So, unless we open a model file while
434*7c478bd9Sstevel@tonic-gate			# PROFILING, we cannot figure out which ones
435*7c478bd9Sstevel@tonic-gate			# come from libw.so.1 and which ones come from
436*7c478bd9Sstevel@tonic-gate			# libc.so.1. In one sense this is too bad: the
437*7c478bd9Sstevel@tonic-gate			# libw.so.1 structure is lost.
438*7c478bd9Sstevel@tonic-gate			#
439*7c478bd9Sstevel@tonic-gate			# The bottom line is we should not alias
440*7c478bd9Sstevel@tonic-gate			# libc.so.1 => libw.so.1 (FILTEE => FILTER) as
441*7c478bd9Sstevel@tonic-gate			# we did above with FILTER_AUX. That would be a
442*7c478bd9Sstevel@tonic-gate			# disaster. (would say EVERYTHING in libc came
443*7c478bd9Sstevel@tonic-gate			# from libw!)
444*7c478bd9Sstevel@tonic-gate			#
445*7c478bd9Sstevel@tonic-gate			# So we DO NOT store the alias in this case, this
446*7c478bd9Sstevel@tonic-gate			# leads to:
447*7c478bd9Sstevel@tonic-gate			#	- more models to maintain.
448*7c478bd9Sstevel@tonic-gate			#
449*7c478bd9Sstevel@tonic-gate			# Thus we basically skip this info.
450*7c478bd9Sstevel@tonic-gate			# EXCEPT for one case, libdl.so.1, see below.
451*7c478bd9Sstevel@tonic-gate			#
452*7c478bd9Sstevel@tonic-gate
453*7c478bd9Sstevel@tonic-gate			($filter, $filtee) = split(/\|/, $1, 2);
454*7c478bd9Sstevel@tonic-gate
455*7c478bd9Sstevel@tonic-gate			#
456*7c478bd9Sstevel@tonic-gate			# The dlopen(), ... family of functions in
457*7c478bd9Sstevel@tonic-gate			# libdl.so.1 is implemented as a filter for
458*7c478bd9Sstevel@tonic-gate			# ld.so.1.  We DO NOT want to consider a symbol
459*7c478bd9Sstevel@tonic-gate			# model for ld.so.1. So in this case alone we
460*7c478bd9Sstevel@tonic-gate			# want to alias ld.so.1 => libdl.so.1
461*7c478bd9Sstevel@tonic-gate			#
462*7c478bd9Sstevel@tonic-gate			#
463*7c478bd9Sstevel@tonic-gate			# We only need to substitute the standard filter
464*7c478bd9Sstevel@tonic-gate			# libdl.so.n. Record the alias in that case.
465*7c478bd9Sstevel@tonic-gate			#
466*7c478bd9Sstevel@tonic-gate			if ($filter =~ /\blibdl\.so\.\d+/) {
467*7c478bd9Sstevel@tonic-gate				$filter_map{$filtee} = $filter;
468*7c478bd9Sstevel@tonic-gate
469*7c478bd9Sstevel@tonic-gate				# Map basenames too:
470*7c478bd9Sstevel@tonic-gate				$filter = basename($filter);
471*7c478bd9Sstevel@tonic-gate				$filtee = basename($filtee);
472*7c478bd9Sstevel@tonic-gate				$filter_map{$filtee} = $filter;
473*7c478bd9Sstevel@tonic-gate			}
474*7c478bd9Sstevel@tonic-gate
475*7c478bd9Sstevel@tonic-gate		} elsif ($line =~ /^DYNAMIC_PROFILE_SKIPPED_NOT_ELF/ ||
476*7c478bd9Sstevel@tonic-gate		    $line =~ /^STATICALLY_LINKED:/) {
477*7c478bd9Sstevel@tonic-gate			#
478*7c478bd9Sstevel@tonic-gate			# This info will go as a COMMENT into the
479*7c478bd9Sstevel@tonic-gate			# output.  n.b.: there is no checking whether
480*7c478bd9Sstevel@tonic-gate			# this piece of info is consistent with the rest
481*7c478bd9Sstevel@tonic-gate			# of the profile output.
482*7c478bd9Sstevel@tonic-gate			#
483*7c478bd9Sstevel@tonic-gate			# The $message string will come right after the
484*7c478bd9Sstevel@tonic-gate			# header, and before the bindings (if any).  See
485*7c478bd9Sstevel@tonic-gate			# below where we write to the PROF filehandle.
486*7c478bd9Sstevel@tonic-gate			#
487*7c478bd9Sstevel@tonic-gate
488*7c478bd9Sstevel@tonic-gate			my $profile_msg_fh = do { local *FH; *FH };
489*7c478bd9Sstevel@tonic-gate			open($profile_msg_fh, ">>$outfile") ||
490*7c478bd9Sstevel@tonic-gate			    exiter(nofile($outfile, $!));
491*7c478bd9Sstevel@tonic-gate			print $profile_msg_fh "#$line\n";
492*7c478bd9Sstevel@tonic-gate			close($profile_msg_fh);
493*7c478bd9Sstevel@tonic-gate
494*7c478bd9Sstevel@tonic-gate		} elsif ($line =~ /^NEEDED_FOUND:(.*)$/) {
495*7c478bd9Sstevel@tonic-gate			#
496*7c478bd9Sstevel@tonic-gate			# These libraries are basically information
497*7c478bd9Sstevel@tonic-gate			# contained in the ldd "libfoo.so.1 =>
498*7c478bd9Sstevel@tonic-gate			# /usr/lib/libfoo.so.1" output lines.  It is the
499*7c478bd9Sstevel@tonic-gate			# closure of the neededs (not just the directly
500*7c478bd9Sstevel@tonic-gate			# needed ones).
501*7c478bd9Sstevel@tonic-gate			#
502*7c478bd9Sstevel@tonic-gate
503*7c478bd9Sstevel@tonic-gate			$all_needed .= $1 . "\n";
504*7c478bd9Sstevel@tonic-gate		}
505*7c478bd9Sstevel@tonic-gate	}
506*7c478bd9Sstevel@tonic-gate
507*7c478bd9Sstevel@tonic-gate	#
508*7c478bd9Sstevel@tonic-gate	# Now collect the bindings info:
509*7c478bd9Sstevel@tonic-gate	#
510*7c478bd9Sstevel@tonic-gate	# Each BINDING record refers to 1 symbol. After manipulation
511*7c478bd9Sstevel@tonic-gate	# here it will go into 1 record into the profile output.
512*7c478bd9Sstevel@tonic-gate	#
513*7c478bd9Sstevel@tonic-gate	# What sort of manipulations? Looking below reveals:
514*7c478bd9Sstevel@tonic-gate	#
515*7c478bd9Sstevel@tonic-gate	#  - we apply the library FILTER_AUX aliases in %filter_map
516*7c478bd9Sstevel@tonic-gate	#  - for shared objects we resolve symbolic links to the actual
517*7c478bd9Sstevel@tonic-gate	#    files they point to.
518*7c478bd9Sstevel@tonic-gate	#  - we may be in a mode where we do not store full paths of
519*7c478bd9Sstevel@tonic-gate	#    the shared objects, e.g. /usr/lib/libc.so.1, but rather
520*7c478bd9Sstevel@tonic-gate	#    just their basename "libc.so.1"
521*7c478bd9Sstevel@tonic-gate	#
522*7c478bd9Sstevel@tonic-gate	# There are exactly four(4) types of bindings that will be
523*7c478bd9Sstevel@tonic-gate	# returned to us by get_dynamic_profile().  See
524*7c478bd9Sstevel@tonic-gate	# get_dynamic_profile() and Get_ldd_Profile() for more details.
525*7c478bd9Sstevel@tonic-gate	#
526*7c478bd9Sstevel@tonic-gate	# Here are the 4 types:
527*7c478bd9Sstevel@tonic-gate	#
528*7c478bd9Sstevel@tonic-gate	# BINDING_DIRECT:from|to|sym
529*7c478bd9Sstevel@tonic-gate	#	The object being profiled is the "from" here!
530*7c478bd9Sstevel@tonic-gate	#	It directly calls "sym" in library "to".
531*7c478bd9Sstevel@tonic-gate	#
532*7c478bd9Sstevel@tonic-gate	# BINDING_INDIRECT:from|to|sym
533*7c478bd9Sstevel@tonic-gate	#	The object being profiled is NOT the "from"  here.
534*7c478bd9Sstevel@tonic-gate	#	"from" is a shared object, and "from" calls "sym" in
535*7c478bd9Sstevel@tonic-gate	#	library "to".
536*7c478bd9Sstevel@tonic-gate	#
537*7c478bd9Sstevel@tonic-gate	# BINDING_REVERSE:from|to|sym
538*7c478bd9Sstevel@tonic-gate	#	The shared object "from" makes a reverse binding
539*7c478bd9Sstevel@tonic-gate	#	all the way back to the object being profiled! We call
540*7c478bd9Sstevel@tonic-gate	#	this *REVERSE*. "to" is the object being profiled.
541*7c478bd9Sstevel@tonic-gate	#
542*7c478bd9Sstevel@tonic-gate	# BINDING_UNBOUND:from|sym
543*7c478bd9Sstevel@tonic-gate	#	object "from" wants to call "sym", but "sym" was
544*7c478bd9Sstevel@tonic-gate	#	not found! We didn't find the "to", and so no
545*7c478bd9Sstevel@tonic-gate	#	"to" is passed to us.
546*7c478bd9Sstevel@tonic-gate	#
547*7c478bd9Sstevel@tonic-gate
548*7c478bd9Sstevel@tonic-gate	my $put_DIRECT_in_the_UNBOUND_record;
549*7c478bd9Sstevel@tonic-gate
550*7c478bd9Sstevel@tonic-gate	$saw_bindings = 0;
551*7c478bd9Sstevel@tonic-gate	#
552*7c478bd9Sstevel@tonic-gate	# Start the sorting pipeline that appends to the output file.
553*7c478bd9Sstevel@tonic-gate	# It will be written to in the following loop.
554*7c478bd9Sstevel@tonic-gate	#
555*7c478bd9Sstevel@tonic-gate	# Tracing back $outfile to $outdir to $working_dir, one sees $outfile
556*7c478bd9Sstevel@tonic-gate	# should have no single-quote characters.  We double check it does not
557*7c478bd9Sstevel@tonic-gate	# before running the command.
558*7c478bd9Sstevel@tonic-gate	#
559*7c478bd9Sstevel@tonic-gate	if ($outfile =~ /'/) {
560*7c478bd9Sstevel@tonic-gate	    exiter(norunprog("|$cmd_sort -t'|' +1 | $cmd_uniq >> '$outfile'"));
561*7c478bd9Sstevel@tonic-gate	}
562*7c478bd9Sstevel@tonic-gate
563*7c478bd9Sstevel@tonic-gate	my $prof_fh = do { local *FH; *FH };
564*7c478bd9Sstevel@tonic-gate	open($prof_fh, "|$cmd_sort -t'|' +1 | $cmd_uniq >> '$outfile'") ||
565*7c478bd9Sstevel@tonic-gate	    exiter(norunprog("|$cmd_sort -t'|' +1 | $cmd_uniq >> '$outfile'",
566*7c478bd9Sstevel@tonic-gate	    $!));
567*7c478bd9Sstevel@tonic-gate	local($SIG{'PIPE'}) = sub {
568*7c478bd9Sstevel@tonic-gate		exiter(norunprog(
569*7c478bd9Sstevel@tonic-gate		    "|$cmd_sort -t'|' +1 | $cmd_uniq >> '$outfile'", $!));
570*7c478bd9Sstevel@tonic-gate	};
571*7c478bd9Sstevel@tonic-gate
572*7c478bd9Sstevel@tonic-gate	foreach $line (@dynamic_profile_array) {
573*7c478bd9Sstevel@tonic-gate
574*7c478bd9Sstevel@tonic-gate		if ($line =~ /^BINDING_([^:]+):(.*)$/) {
575*7c478bd9Sstevel@tonic-gate
576*7c478bd9Sstevel@tonic-gate			$type = $1;
577*7c478bd9Sstevel@tonic-gate
578*7c478bd9Sstevel@tonic-gate			if ($type eq 'UNBOUND') {
579*7c478bd9Sstevel@tonic-gate				#
580*7c478bd9Sstevel@tonic-gate				# If the symbol was unbound, there is no
581*7c478bd9Sstevel@tonic-gate				# "to" library. We make an empty "to"
582*7c478bd9Sstevel@tonic-gate				# value so as to avoid special casing
583*7c478bd9Sstevel@tonic-gate				# "to" all through the code that
584*7c478bd9Sstevel@tonic-gate				# follows.  It is easy to verify no
585*7c478bd9Sstevel@tonic-gate				# matter what happens with the $to
586*7c478bd9Sstevel@tonic-gate				# variable, it will NOT be printed to the
587*7c478bd9Sstevel@tonic-gate				# profile output file in the UNBOUND
588*7c478bd9Sstevel@tonic-gate				# case.
589*7c478bd9Sstevel@tonic-gate				#
590*7c478bd9Sstevel@tonic-gate
591*7c478bd9Sstevel@tonic-gate				($from, $sym) = split(/\|/, $2, 2);
592*7c478bd9Sstevel@tonic-gate				$to = '';
593*7c478bd9Sstevel@tonic-gate
594*7c478bd9Sstevel@tonic-gate			} else {
595*7c478bd9Sstevel@tonic-gate				# Otherwise, we have the full triple:
596*7c478bd9Sstevel@tonic-gate
597*7c478bd9Sstevel@tonic-gate				($from, $to, $sym) = split(/\|/, $2, 3);
598*7c478bd9Sstevel@tonic-gate			}
599*7c478bd9Sstevel@tonic-gate
600*7c478bd9Sstevel@tonic-gate			#
601*7c478bd9Sstevel@tonic-gate			# We record here information to be used in
602*7c478bd9Sstevel@tonic-gate			# writing out UNBOUND records, namely if the
603*7c478bd9Sstevel@tonic-gate			# "from" happened to also be the object being
604*7c478bd9Sstevel@tonic-gate			# profiled. In that case The string "*DIRECT*"
605*7c478bd9Sstevel@tonic-gate			# will be placed in the "*UNBOUND*" record,
606*7c478bd9Sstevel@tonic-gate			# otherwise the "from" will stand as is in the
607*7c478bd9Sstevel@tonic-gate			# "*UNBOUND*" record. We do this check here
608*7c478bd9Sstevel@tonic-gate			# before the filter_map is applied. The chances
609*7c478bd9Sstevel@tonic-gate			# of it making a difference is small, but we had
610*7c478bd9Sstevel@tonic-gate			# best to do it here.
611*7c478bd9Sstevel@tonic-gate			#
612*7c478bd9Sstevel@tonic-gate			if (files_equal($from, $object)) {
613*7c478bd9Sstevel@tonic-gate				#
614*7c478bd9Sstevel@tonic-gate				# Switch to indicate placing *DIRECT* in
615*7c478bd9Sstevel@tonic-gate				# the *UNBOUND* line, etc.
616*7c478bd9Sstevel@tonic-gate				#
617*7c478bd9Sstevel@tonic-gate				$put_DIRECT_in_the_UNBOUND_record = 1;
618*7c478bd9Sstevel@tonic-gate			} else  {
619*7c478bd9Sstevel@tonic-gate				$put_DIRECT_in_the_UNBOUND_record = 0;
620*7c478bd9Sstevel@tonic-gate			}
621*7c478bd9Sstevel@tonic-gate
622*7c478bd9Sstevel@tonic-gate			#
623*7c478bd9Sstevel@tonic-gate			# See if there is a filter name that "aliases"
624*7c478bd9Sstevel@tonic-gate			# either of the "from" or "to" libraries, if so
625*7c478bd9Sstevel@tonic-gate			# then rename it.
626*7c478bd9Sstevel@tonic-gate			#
627*7c478bd9Sstevel@tonic-gate			if ($to ne '' && $filter_map{$to}) {
628*7c478bd9Sstevel@tonic-gate				$to = $filter_map{$to};
629*7c478bd9Sstevel@tonic-gate			}
630*7c478bd9Sstevel@tonic-gate			if ($type ne 'DIRECT' && $filter_map{$from}) {
631*7c478bd9Sstevel@tonic-gate				$from = $filter_map{$from};
632*7c478bd9Sstevel@tonic-gate			}
633*7c478bd9Sstevel@tonic-gate
634*7c478bd9Sstevel@tonic-gate			#
635*7c478bd9Sstevel@tonic-gate			# Record symlink information.
636*7c478bd9Sstevel@tonic-gate			#
637*7c478bd9Sstevel@tonic-gate			# Note that follow_symlink returns the file
638*7c478bd9Sstevel@tonic-gate			# name itself when the file is not a symlink.
639*7c478bd9Sstevel@tonic-gate			#
640*7c478bd9Sstevel@tonic-gate			# Work out if either "from" or "to" are
641*7c478bd9Sstevel@tonic-gate			# symlinks.  For efficiency we keep them in the
642*7c478bd9Sstevel@tonic-gate			# %symlink_map hash.  Recall that we are in a
643*7c478bd9Sstevel@tonic-gate			# loop here, so why do libc.so.1 200 times?
644*7c478bd9Sstevel@tonic-gate			#
645*7c478bd9Sstevel@tonic-gate			if ($from ne '') {
646*7c478bd9Sstevel@tonic-gate				if (! exists($symlink_map{$from})) {
647*7c478bd9Sstevel@tonic-gate					$symlink_map{$from} =
648*7c478bd9Sstevel@tonic-gate					    follow_symlink($from);
649*7c478bd9Sstevel@tonic-gate				}
650*7c478bd9Sstevel@tonic-gate			}
651*7c478bd9Sstevel@tonic-gate			if ($to ne '') {
652*7c478bd9Sstevel@tonic-gate				if (! exists($symlink_map{$to})) {
653*7c478bd9Sstevel@tonic-gate					$symlink_map{$to} =
654*7c478bd9Sstevel@tonic-gate					    follow_symlink($to);
655*7c478bd9Sstevel@tonic-gate				}
656*7c478bd9Sstevel@tonic-gate			}
657*7c478bd9Sstevel@tonic-gate
658*7c478bd9Sstevel@tonic-gate			#
659*7c478bd9Sstevel@tonic-gate			# Now make the actual profile output line. Construct
660*7c478bd9Sstevel@tonic-gate			# it in $tmp and then append it to $prof_fh pipeline.
661*7c478bd9Sstevel@tonic-gate			#
662*7c478bd9Sstevel@tonic-gate			$tmp = '';
663*7c478bd9Sstevel@tonic-gate
664*7c478bd9Sstevel@tonic-gate			if ($type eq "DIRECT") {
665*7c478bd9Sstevel@tonic-gate				$tmp = "$object|*DIRECT*|$to|$sym";
666*7c478bd9Sstevel@tonic-gate			} elsif ($type eq "INDIRECT") {
667*7c478bd9Sstevel@tonic-gate				$tmp = "$object|$from|$to|$sym";
668*7c478bd9Sstevel@tonic-gate			} elsif ($type eq "REVERSE") {
669*7c478bd9Sstevel@tonic-gate				$tmp = "$object|*REVERSE*|$from|$sym";
670*7c478bd9Sstevel@tonic-gate			} elsif ($type eq "UNBOUND") {
671*7c478bd9Sstevel@tonic-gate				if ($put_DIRECT_in_the_UNBOUND_record) {
672*7c478bd9Sstevel@tonic-gate					$tmp =
673*7c478bd9Sstevel@tonic-gate					    "$object|*DIRECT*|*UNBOUND*|$sym";
674*7c478bd9Sstevel@tonic-gate				} else {
675*7c478bd9Sstevel@tonic-gate					$tmp = "$object|$from|*UNBOUND*|$sym";
676*7c478bd9Sstevel@tonic-gate				}
677*7c478bd9Sstevel@tonic-gate			} else {
678*7c478bd9Sstevel@tonic-gate				exiter("$command_name: " . sprintf(gettext(
679*7c478bd9Sstevel@tonic-gate				    "unrecognized ldd(1) LD_DEBUG " .
680*7c478bd9Sstevel@tonic-gate				    "bindings line: %s\n"), $line));
681*7c478bd9Sstevel@tonic-gate			}
682*7c478bd9Sstevel@tonic-gate
683*7c478bd9Sstevel@tonic-gate			# write it to the sorting pipeline:
684*7c478bd9Sstevel@tonic-gate			print $prof_fh $tmp, "\n";
685*7c478bd9Sstevel@tonic-gate			$saw_bindings = 1;
686*7c478bd9Sstevel@tonic-gate		} elsif ($line =~ /^DYNAMIC_PROFILE_SKIPPED_NOT_ELF/) {
687*7c478bd9Sstevel@tonic-gate			# ignore no bindings warning for non-ELF
688*7c478bd9Sstevel@tonic-gate			$saw_bindings = 1;
689*7c478bd9Sstevel@tonic-gate		}
690*7c478bd9Sstevel@tonic-gate	}
691*7c478bd9Sstevel@tonic-gate
692*7c478bd9Sstevel@tonic-gate	if (! $saw_bindings) {
693*7c478bd9Sstevel@tonic-gate		print $prof_fh "#NO_BINDINGS_FOUND\n";
694*7c478bd9Sstevel@tonic-gate	}
695*7c478bd9Sstevel@tonic-gate	close($prof_fh);
696*7c478bd9Sstevel@tonic-gate	if ($? != 0) {
697*7c478bd9Sstevel@tonic-gate		exiter(norunprog(
698*7c478bd9Sstevel@tonic-gate		    "|$cmd_sort -t'|' +1 | $cmd_uniq >> '$outfile'", $!));
699*7c478bd9Sstevel@tonic-gate	}
700*7c478bd9Sstevel@tonic-gate
701*7c478bd9Sstevel@tonic-gate	# Print out the library location and symlink info.
702*7c478bd9Sstevel@tonic-gate	$outfile = "$output_dir/profile.dynamic.objects";
703*7c478bd9Sstevel@tonic-gate
704*7c478bd9Sstevel@tonic-gate	my $objects_fh = do { local *FH; *FH };
705*7c478bd9Sstevel@tonic-gate	open($objects_fh, ">$outfile") || exiter(nofile($outfile, $!));
706*7c478bd9Sstevel@tonic-gate
707*7c478bd9Sstevel@tonic-gate	my ($var, $val);
708*7c478bd9Sstevel@tonic-gate	while (($var, $val) = each(%ENV)) {
709*7c478bd9Sstevel@tonic-gate		if ($var =~ /^LD_/) {
710*7c478bd9Sstevel@tonic-gate			print $objects_fh "#info: $var=$val\n";
711*7c478bd9Sstevel@tonic-gate		}
712*7c478bd9Sstevel@tonic-gate	}
713*7c478bd9Sstevel@tonic-gate
714*7c478bd9Sstevel@tonic-gate	my $obj;
715*7c478bd9Sstevel@tonic-gate	foreach $obj (sort(keys(%symlink_map))) {
716*7c478bd9Sstevel@tonic-gate		next if ($obj eq '');
717*7c478bd9Sstevel@tonic-gate		print $objects_fh "$obj => $symlink_map{$obj}\n";
718*7c478bd9Sstevel@tonic-gate	}
719*7c478bd9Sstevel@tonic-gate	close($objects_fh);
720*7c478bd9Sstevel@tonic-gate
721*7c478bd9Sstevel@tonic-gate	# Print out ldd shared object resolution.
722*7c478bd9Sstevel@tonic-gate	$outfile = "$output_dir/profile.dynamic.ldd";
723*7c478bd9Sstevel@tonic-gate
724*7c478bd9Sstevel@tonic-gate	my $ldd_prof_fh = do { local *FH; *FH };
725*7c478bd9Sstevel@tonic-gate	open($ldd_prof_fh, ">$outfile") || exiter(nofile($outfile, $!));
726*7c478bd9Sstevel@tonic-gate
727*7c478bd9Sstevel@tonic-gate	if (defined($all_needed)) {
728*7c478bd9Sstevel@tonic-gate		print $ldd_prof_fh $all_needed;
729*7c478bd9Sstevel@tonic-gate	}
730*7c478bd9Sstevel@tonic-gate	close($ldd_prof_fh);
731*7c478bd9Sstevel@tonic-gate
732*7c478bd9Sstevel@tonic-gate}
733*7c478bd9Sstevel@tonic-gate
734*7c478bd9Sstevel@tonic-gate#
735*7c478bd9Sstevel@tonic-gate# If the users environment is not the same when running symprof as when
736*7c478bd9Sstevel@tonic-gate# running their application, the dynamic linker cannot resolve all of
737*7c478bd9Sstevel@tonic-gate# the dynamic bindings and we get "unbound symbols".
738*7c478bd9Sstevel@tonic-gate# redo_unbound_profile attempts to alleviate this somewhat. In
739*7c478bd9Sstevel@tonic-gate# particular, for shared objects that do not have all of their
740*7c478bd9Sstevel@tonic-gate# dependencies recorded, it attempts to use binding information in the
741*7c478bd9Sstevel@tonic-gate# other *executables* under test to supplement the binding information
742*7c478bd9Sstevel@tonic-gate# for the shared object with unbound symbols.  This is not the whole
743*7c478bd9Sstevel@tonic-gate# story (e.g. dlopen(3L)), but it often helps considerably.
744*7c478bd9Sstevel@tonic-gate#
745*7c478bd9Sstevel@tonic-gatesub redo_unbound_profile
746*7c478bd9Sstevel@tonic-gate{
747*7c478bd9Sstevel@tonic-gate	my ($dir, $path_to_object);
748*7c478bd9Sstevel@tonic-gate	my ($profile, $total, $count);
749*7c478bd9Sstevel@tonic-gate	my (%unbound_bins);
750*7c478bd9Sstevel@tonic-gate
751*7c478bd9Sstevel@tonic-gate	#
752*7c478bd9Sstevel@tonic-gate	# Find the objects with unbound symbols. Put them in the list
753*7c478bd9Sstevel@tonic-gate	# %unbound_bins.
754*7c478bd9Sstevel@tonic-gate	#
755*7c478bd9Sstevel@tonic-gate	$total = 0;
756*7c478bd9Sstevel@tonic-gate	while (defined($dir = next_dir_name())) {
757*7c478bd9Sstevel@tonic-gate
758*7c478bd9Sstevel@tonic-gate		$profile = "$dir/profile.dynamic";
759*7c478bd9Sstevel@tonic-gate		my $profile_fh = do { local *FH; *FH };
760*7c478bd9Sstevel@tonic-gate		if (! -f $profile || ! open($profile_fh, "<$profile")) {
761*7c478bd9Sstevel@tonic-gate			next;
762*7c478bd9Sstevel@tonic-gate		}
763*7c478bd9Sstevel@tonic-gate
764*7c478bd9Sstevel@tonic-gate		$count = 0;
765*7c478bd9Sstevel@tonic-gate		while (<$profile_fh>) {
766*7c478bd9Sstevel@tonic-gate			next if (/^\s*#/);
767*7c478bd9Sstevel@tonic-gate			$count++ if (/\|\*UNBOUND\*\|/);
768*7c478bd9Sstevel@tonic-gate		}
769*7c478bd9Sstevel@tonic-gate		close($profile_fh);
770*7c478bd9Sstevel@tonic-gate
771*7c478bd9Sstevel@tonic-gate		$unbound_bins{$dir} = $count if ($count);
772*7c478bd9Sstevel@tonic-gate		$total += $count;
773*7c478bd9Sstevel@tonic-gate	}
774*7c478bd9Sstevel@tonic-gate
775*7c478bd9Sstevel@tonic-gate	# we are done if no unbounds are detected.
776*7c478bd9Sstevel@tonic-gate	return unless (%unbound_bins);
777*7c478bd9Sstevel@tonic-gate	return if ($total == 0);
778*7c478bd9Sstevel@tonic-gate
779*7c478bd9Sstevel@tonic-gate	my (%dtneededs_lookup_full, %dtneededs_lookup_base);
780*7c478bd9Sstevel@tonic-gate
781*7c478bd9Sstevel@tonic-gate	# Read in *ALL* objects dt_neededs.
782*7c478bd9Sstevel@tonic-gate
783*7c478bd9Sstevel@tonic-gate	my ($soname, $base, $full);
784*7c478bd9Sstevel@tonic-gate	while (defined($dir = next_dir_name())) {
785*7c478bd9Sstevel@tonic-gate
786*7c478bd9Sstevel@tonic-gate		$profile = "$dir/profile.dynamic.ldd";
787*7c478bd9Sstevel@tonic-gate		my $all_neededs_fh = do { local *FH; *FH };
788*7c478bd9Sstevel@tonic-gate		if (! open($all_neededs_fh, "<$profile")) {
789*7c478bd9Sstevel@tonic-gate			# this is a heuristic, so we skip on to the next
790*7c478bd9Sstevel@tonic-gate			next;
791*7c478bd9Sstevel@tonic-gate		}
792*7c478bd9Sstevel@tonic-gate
793*7c478bd9Sstevel@tonic-gate		while (<$all_neededs_fh>) {
794*7c478bd9Sstevel@tonic-gate			chop;
795*7c478bd9Sstevel@tonic-gate			next if (/^\s*#/);
796*7c478bd9Sstevel@tonic-gate			# save the dtneeded info:
797*7c478bd9Sstevel@tonic-gate			($soname, $full) = split(/\s+=>\s+/, $_);
798*7c478bd9Sstevel@tonic-gate
799*7c478bd9Sstevel@tonic-gate			if ($full !~ /not found|\)/) {
800*7c478bd9Sstevel@tonic-gate				$dtneededs_lookup_full{$full}{$dir} = 1;
801*7c478bd9Sstevel@tonic-gate			}
802*7c478bd9Sstevel@tonic-gate			if ($soname !~ /not found|\)/) {
803*7c478bd9Sstevel@tonic-gate				$base = basename($soname);
804*7c478bd9Sstevel@tonic-gate				$dtneededs_lookup_base{$base}{$dir} = 1;
805*7c478bd9Sstevel@tonic-gate			}
806*7c478bd9Sstevel@tonic-gate		}
807*7c478bd9Sstevel@tonic-gate		close($all_neededs_fh);
808*7c478bd9Sstevel@tonic-gate	}
809*7c478bd9Sstevel@tonic-gate
810*7c478bd9Sstevel@tonic-gate	emsg("\n" . gettext(
811*7c478bd9Sstevel@tonic-gate	    "re-profiling binary objects with unbound symbols") . " ...\n");
812*7c478bd9Sstevel@tonic-gate
813*7c478bd9Sstevel@tonic-gate	# Now combine the above info with each object having unbounds:
814*7c478bd9Sstevel@tonic-gate
815*7c478bd9Sstevel@tonic-gate	my $uref = \%unbound_bins;
816*7c478bd9Sstevel@tonic-gate	foreach $dir (keys(%unbound_bins)) {
817*7c478bd9Sstevel@tonic-gate
818*7c478bd9Sstevel@tonic-gate		# Map object output directory to the actual path of the object:
819*7c478bd9Sstevel@tonic-gate		$path_to_object = dir_name_to_path($dir);
820*7c478bd9Sstevel@tonic-gate
821*7c478bd9Sstevel@tonic-gate		#
822*7c478bd9Sstevel@tonic-gate		# Here is the algorithm:
823*7c478bd9Sstevel@tonic-gate		#
824*7c478bd9Sstevel@tonic-gate		# 1) binary with unbounds must be a shared object.
825*7c478bd9Sstevel@tonic-gate		#
826*7c478bd9Sstevel@tonic-gate		# 2) check if it is in the dtneeded of other product binaries.
827*7c478bd9Sstevel@tonic-gate		#	if so, use the dynamic profile of those binaries
828*7c478bd9Sstevel@tonic-gate		#	to augment the bindings of the binary with unbounds
829*7c478bd9Sstevel@tonic-gate		#
830*7c478bd9Sstevel@tonic-gate
831*7c478bd9Sstevel@tonic-gate		if (! -f $path_to_object) {
832*7c478bd9Sstevel@tonic-gate			exiter(nopathexist($path_to_object, $!));
833*7c478bd9Sstevel@tonic-gate		}
834*7c478bd9Sstevel@tonic-gate
835*7c478bd9Sstevel@tonic-gate		# only consider shared objects (e.g. with no DTNEEDED recorded)
836*7c478bd9Sstevel@tonic-gate		if (! is_shared_object($path_to_object)) {
837*7c478bd9Sstevel@tonic-gate			next;
838*7c478bd9Sstevel@tonic-gate		}
839*7c478bd9Sstevel@tonic-gate
840*7c478bd9Sstevel@tonic-gate		$base = basename($path_to_object);
841*7c478bd9Sstevel@tonic-gate
842*7c478bd9Sstevel@tonic-gate		my (@dirlist);
843*7c478bd9Sstevel@tonic-gate
844*7c478bd9Sstevel@tonic-gate		my $result = 0;
845*7c478bd9Sstevel@tonic-gate
846*7c478bd9Sstevel@tonic-gate		if (defined($dtneededs_lookup_base{$base})) {
847*7c478bd9Sstevel@tonic-gate			# the basename is on another's dtneededs:
848*7c478bd9Sstevel@tonic-gate			@dirlist = keys(%{$dtneededs_lookup_base{$base}});
849*7c478bd9Sstevel@tonic-gate			# try using the bindings of these executables:
850*7c478bd9Sstevel@tonic-gate			$result =
851*7c478bd9Sstevel@tonic-gate			    try_executables_bindings($dir, $uref, @dirlist);
852*7c478bd9Sstevel@tonic-gate		}
853*7c478bd9Sstevel@tonic-gate		if ($result) {
854*7c478bd9Sstevel@tonic-gate			# we achieved some improvements and so are done:
855*7c478bd9Sstevel@tonic-gate			next;
856*7c478bd9Sstevel@tonic-gate		}
857*7c478bd9Sstevel@tonic-gate
858*7c478bd9Sstevel@tonic-gate		# Otherwise, try objects that have our full path in their
859*7c478bd9Sstevel@tonic-gate		# dtneededs:
860*7c478bd9Sstevel@tonic-gate		@dirlist = ();
861*7c478bd9Sstevel@tonic-gate		foreach $full (keys(%dtneededs_lookup_full)) {
862*7c478bd9Sstevel@tonic-gate			if (! files_equal($path_to_object, $full)) {
863*7c478bd9Sstevel@tonic-gate				next;
864*7c478bd9Sstevel@tonic-gate			}
865*7c478bd9Sstevel@tonic-gate			push(@dirlist, keys(%{$dtneededs_lookup_full{$full}}));
866*7c478bd9Sstevel@tonic-gate		}
867*7c478bd9Sstevel@tonic-gate		if (@dirlist) {
868*7c478bd9Sstevel@tonic-gate			$result =
869*7c478bd9Sstevel@tonic-gate			    try_executables_bindings($dir, $uref, @dirlist);
870*7c478bd9Sstevel@tonic-gate		}
871*7c478bd9Sstevel@tonic-gate	}
872*7c478bd9Sstevel@tonic-gate	emsg("\n");
873*7c478bd9Sstevel@tonic-gate}
874*7c478bd9Sstevel@tonic-gate
875*7c478bd9Sstevel@tonic-gate#
876*7c478bd9Sstevel@tonic-gate# We are trying to reduce unbound symbols of shared objects/libraries
877*7c478bd9Sstevel@tonic-gate# under test that *have not* recorded their dependencies (i.e.
878*7c478bd9Sstevel@tonic-gate# DTNEEDED's). So we look for Executables being checked that have *this*
879*7c478bd9Sstevel@tonic-gate# binary ($path_to_object, a shared object) on *its* DTNEEDED. If we
880*7c478bd9Sstevel@tonic-gate# find one, we use those bindings.
881*7c478bd9Sstevel@tonic-gate#
882*7c478bd9Sstevel@tonic-gatesub try_executables_bindings
883*7c478bd9Sstevel@tonic-gate{
884*7c478bd9Sstevel@tonic-gate	my ($dir, $uref, @dirlist) = @_;
885*7c478bd9Sstevel@tonic-gate
886*7c478bd9Sstevel@tonic-gate	my $path_to_object = dir_name_to_path($dir);
887*7c478bd9Sstevel@tonic-gate
888*7c478bd9Sstevel@tonic-gate	#
889*7c478bd9Sstevel@tonic-gate	# N.B. The word "try" here means for a binary (a shared library,
890*7c478bd9Sstevel@tonic-gate	# actually) that had unbound symbols, "try" to use OTHER
891*7c478bd9Sstevel@tonic-gate	# executables binding info to resolve those unbound symbols.
892*7c478bd9Sstevel@tonic-gate	#
893*7c478bd9Sstevel@tonic-gate	# At least one executable needs this library; we select the one
894*7c478bd9Sstevel@tonic-gate	# with minimal number of its own unbounds.
895*7c478bd9Sstevel@tonic-gate	#
896*7c478bd9Sstevel@tonic-gate	my (%sorting_list);
897*7c478bd9Sstevel@tonic-gate	my (@executables_to_try);
898*7c478bd9Sstevel@tonic-gate	my ($dir2, $cnt);
899*7c478bd9Sstevel@tonic-gate	foreach $dir2 (@dirlist) {
900*7c478bd9Sstevel@tonic-gate		next if (! defined($dir2));
901*7c478bd9Sstevel@tonic-gate		next if ($dir2 eq $dir);
902*7c478bd9Sstevel@tonic-gate		if (exists($uref->{$dir2})) {
903*7c478bd9Sstevel@tonic-gate			$cnt = $uref->{$dir2};
904*7c478bd9Sstevel@tonic-gate		} else {
905*7c478bd9Sstevel@tonic-gate			#
906*7c478bd9Sstevel@tonic-gate			# This binary is not on the unbounds list, so
907*7c478bd9Sstevel@tonic-gate			# give it the highest priority.
908*7c478bd9Sstevel@tonic-gate			#
909*7c478bd9Sstevel@tonic-gate			$cnt = 0;
910*7c478bd9Sstevel@tonic-gate		}
911*7c478bd9Sstevel@tonic-gate		$sorting_list{"$dir2 $cnt"} = $dir2;
912*7c478bd9Sstevel@tonic-gate	}
913*7c478bd9Sstevel@tonic-gate
914*7c478bd9Sstevel@tonic-gate	foreach my $key (reverse(sort_on_count(keys %sorting_list))) {
915*7c478bd9Sstevel@tonic-gate		push(@executables_to_try, $sorting_list{$key});
916*7c478bd9Sstevel@tonic-gate	}
917*7c478bd9Sstevel@tonic-gate
918*7c478bd9Sstevel@tonic-gate	my ($my_new_count, $my_new_profile, %my_new_symbols);
919*7c478bd9Sstevel@tonic-gate	my ($object, $caller, $callee, $sym, $profile);
920*7c478bd9Sstevel@tonic-gate	my $reprofiled = 0;
921*7c478bd9Sstevel@tonic-gate
922*7c478bd9Sstevel@tonic-gate	my ($line, $path2);
923*7c478bd9Sstevel@tonic-gate
924*7c478bd9Sstevel@tonic-gate	foreach $dir2 (@executables_to_try) {
925*7c478bd9Sstevel@tonic-gate		$path2 = dir_name_to_path($dir2);
926*7c478bd9Sstevel@tonic-gate		emsg(gettext(
927*7c478bd9Sstevel@tonic-gate		    "re-profiling: %s\n" .
928*7c478bd9Sstevel@tonic-gate		    "using:        %s\n"), $path_to_object, $path2);
929*7c478bd9Sstevel@tonic-gate
930*7c478bd9Sstevel@tonic-gate		# read the other binary's profile
931*7c478bd9Sstevel@tonic-gate
932*7c478bd9Sstevel@tonic-gate		$profile = "$dir2/profile.dynamic";
933*7c478bd9Sstevel@tonic-gate		if (! -f $profile) {
934*7c478bd9Sstevel@tonic-gate			next;
935*7c478bd9Sstevel@tonic-gate		}
936*7c478bd9Sstevel@tonic-gate
937*7c478bd9Sstevel@tonic-gate		my $prof_try_fh = do { local *FH; *FH };
938*7c478bd9Sstevel@tonic-gate		open($prof_try_fh, "<$profile") ||
939*7c478bd9Sstevel@tonic-gate		    exiter(nofile($profile, $!));
940*7c478bd9Sstevel@tonic-gate
941*7c478bd9Sstevel@tonic-gate		# initialize for the next try:
942*7c478bd9Sstevel@tonic-gate		$my_new_profile = '';
943*7c478bd9Sstevel@tonic-gate		$my_new_count = 0;
944*7c478bd9Sstevel@tonic-gate		%my_new_symbols = ();
945*7c478bd9Sstevel@tonic-gate
946*7c478bd9Sstevel@tonic-gate		# try to find bindings that involve us ($dir)
947*7c478bd9Sstevel@tonic-gate		while (<$prof_try_fh>) {
948*7c478bd9Sstevel@tonic-gate			chop($line = $_);
949*7c478bd9Sstevel@tonic-gate			next if (/^\s*#/);
950*7c478bd9Sstevel@tonic-gate			next if (/^\s*$/);
951*7c478bd9Sstevel@tonic-gate			($object, $caller, $callee, $sym) =
952*7c478bd9Sstevel@tonic-gate			    split(/\|/, $line, 4);
953*7c478bd9Sstevel@tonic-gate
954*7c478bd9Sstevel@tonic-gate			if ($caller eq '*REVERSE*') {
955*7c478bd9Sstevel@tonic-gate				next if ($callee =~ /^\*.*\*$/);
956*7c478bd9Sstevel@tonic-gate				if (! files_equal($callee, $path_to_object)) {
957*7c478bd9Sstevel@tonic-gate					next;
958*7c478bd9Sstevel@tonic-gate				}
959*7c478bd9Sstevel@tonic-gate
960*7c478bd9Sstevel@tonic-gate				$my_new_profile .=
961*7c478bd9Sstevel@tonic-gate				    "$callee|*DIRECT*|REVERSE_TO:" .
962*7c478bd9Sstevel@tonic-gate				    "$object|$sym\n";
963*7c478bd9Sstevel@tonic-gate
964*7c478bd9Sstevel@tonic-gate				$my_new_symbols{$sym}++;
965*7c478bd9Sstevel@tonic-gate				$my_new_count++;
966*7c478bd9Sstevel@tonic-gate
967*7c478bd9Sstevel@tonic-gate			} elsif (files_equal($caller, $path_to_object)) {
968*7c478bd9Sstevel@tonic-gate				$my_new_profile .=
969*7c478bd9Sstevel@tonic-gate				    "$caller|*DIRECT*|$callee|$sym\n";
970*7c478bd9Sstevel@tonic-gate
971*7c478bd9Sstevel@tonic-gate				$my_new_symbols{$sym}++;
972*7c478bd9Sstevel@tonic-gate				$my_new_count++;
973*7c478bd9Sstevel@tonic-gate			}
974*7c478bd9Sstevel@tonic-gate		}
975*7c478bd9Sstevel@tonic-gate		close($prof_try_fh);
976*7c478bd9Sstevel@tonic-gate
977*7c478bd9Sstevel@tonic-gate		next if (! $my_new_count);
978*7c478bd9Sstevel@tonic-gate
979*7c478bd9Sstevel@tonic-gate		# modify our profile with the new information:
980*7c478bd9Sstevel@tonic-gate		$profile = "$dir/profile.dynamic";
981*7c478bd9Sstevel@tonic-gate		if (! rename($profile, "$profile.0") || ! -f "$profile.0") {
982*7c478bd9Sstevel@tonic-gate			return 0;
983*7c478bd9Sstevel@tonic-gate		}
984*7c478bd9Sstevel@tonic-gate		my $prof_orig_fh = do { local *FH; *FH };
985*7c478bd9Sstevel@tonic-gate		if (! open($prof_orig_fh, "<$profile.0")) {
986*7c478bd9Sstevel@tonic-gate			rename("$profile.0", $profile);
987*7c478bd9Sstevel@tonic-gate			return 0;
988*7c478bd9Sstevel@tonic-gate		}
989*7c478bd9Sstevel@tonic-gate		my $prof_fh = do { local *FH; *FH };
990*7c478bd9Sstevel@tonic-gate		if (! open($prof_fh, ">$profile")) {
991*7c478bd9Sstevel@tonic-gate			rename("$profile.0", $profile);
992*7c478bd9Sstevel@tonic-gate			return 0;
993*7c478bd9Sstevel@tonic-gate		}
994*7c478bd9Sstevel@tonic-gate		my $resolved_from = dir_name_to_path($dir2);
995*7c478bd9Sstevel@tonic-gate		print $prof_fh "# REDUCING_UNBOUNDS_VIA_PROFILE_FROM: " .
996*7c478bd9Sstevel@tonic-gate		    "$resolved_from\n";
997*7c478bd9Sstevel@tonic-gate
998*7c478bd9Sstevel@tonic-gate		while (<$prof_orig_fh>) {
999*7c478bd9Sstevel@tonic-gate			if (/^\s*#/) {
1000*7c478bd9Sstevel@tonic-gate				print $prof_fh $_;
1001*7c478bd9Sstevel@tonic-gate				next;
1002*7c478bd9Sstevel@tonic-gate			}
1003*7c478bd9Sstevel@tonic-gate			chop($line = $_);
1004*7c478bd9Sstevel@tonic-gate			($object, $caller, $callee, $sym) =
1005*7c478bd9Sstevel@tonic-gate			    split(/\|/, $line, 4);
1006*7c478bd9Sstevel@tonic-gate			if (! exists($my_new_symbols{$sym})) {
1007*7c478bd9Sstevel@tonic-gate				print $prof_fh $_;
1008*7c478bd9Sstevel@tonic-gate				next;
1009*7c478bd9Sstevel@tonic-gate			}
1010*7c478bd9Sstevel@tonic-gate			print $prof_fh "# RESOLVED_FROM=$resolved_from: $_";
1011*7c478bd9Sstevel@tonic-gate		}
1012*7c478bd9Sstevel@tonic-gate		close($prof_orig_fh);
1013*7c478bd9Sstevel@tonic-gate		print $prof_fh "# NEW_PROFILE:\n" . $my_new_profile;
1014*7c478bd9Sstevel@tonic-gate		close($prof_fh);
1015*7c478bd9Sstevel@tonic-gate
1016*7c478bd9Sstevel@tonic-gate		$reprofiled = 1;
1017*7c478bd9Sstevel@tonic-gate		last;
1018*7c478bd9Sstevel@tonic-gate	}
1019*7c478bd9Sstevel@tonic-gate	return $reprofiled;
1020*7c478bd9Sstevel@tonic-gate}
1021*7c478bd9Sstevel@tonic-gate
1022*7c478bd9Sstevel@tonic-gate#
1023*7c478bd9Sstevel@tonic-gate# This routine calls get_ldd_output on the object and parses the
1024*7c478bd9Sstevel@tonic-gate# LD_DEBUG output. Returns a string containing the information in
1025*7c478bd9Sstevel@tonic-gate# standard form.
1026*7c478bd9Sstevel@tonic-gate#
1027*7c478bd9Sstevel@tonic-gatesub get_dynamic_profile
1028*7c478bd9Sstevel@tonic-gate{
1029*7c478bd9Sstevel@tonic-gate	my ($object) = @_;
1030*7c478bd9Sstevel@tonic-gate
1031*7c478bd9Sstevel@tonic-gate	# Check if the object is statically linked:
1032*7c478bd9Sstevel@tonic-gate
1033*7c478bd9Sstevel@tonic-gate	my $str;
1034*7c478bd9Sstevel@tonic-gate	if (! is_elf($object)) {
1035*7c478bd9Sstevel@tonic-gate		return "DYNAMIC_PROFILE_SKIPPED_NOT_ELF";
1036*7c478bd9Sstevel@tonic-gate	} elsif (is_statically_linked($object)) {
1037*7c478bd9Sstevel@tonic-gate		$str = cmd_output_file($object);
1038*7c478bd9Sstevel@tonic-gate		return "STATICALLY_LINKED: $str";
1039*7c478bd9Sstevel@tonic-gate	}
1040*7c478bd9Sstevel@tonic-gate
1041*7c478bd9Sstevel@tonic-gate	# Get the raw ldd output:
1042*7c478bd9Sstevel@tonic-gate	my $ldd_output = get_ldd_output($object);
1043*7c478bd9Sstevel@tonic-gate
1044*7c478bd9Sstevel@tonic-gate	if ($ldd_output =~ /^ERROR:/) {
1045*7c478bd9Sstevel@tonic-gate		# some problem occurred, pass the error upward:
1046*7c478bd9Sstevel@tonic-gate		return $ldd_output;
1047*7c478bd9Sstevel@tonic-gate	}
1048*7c478bd9Sstevel@tonic-gate
1049*7c478bd9Sstevel@tonic-gate	# variables for manipulating the output:
1050*7c478bd9Sstevel@tonic-gate	my ($line, $filters, $neededs, $rest);
1051*7c478bd9Sstevel@tonic-gate	my ($tmp, $tmp2, @bindings);
1052*7c478bd9Sstevel@tonic-gate
1053*7c478bd9Sstevel@tonic-gate	# Now parse it:
1054*7c478bd9Sstevel@tonic-gate
1055*7c478bd9Sstevel@tonic-gate	foreach $line (split(/\n/, $ldd_output)) {
1056*7c478bd9Sstevel@tonic-gate
1057*7c478bd9Sstevel@tonic-gate		if ($line =~ /^\d+:\s*(.*)$/) {
1058*7c478bd9Sstevel@tonic-gate			# LD_DEBUG profile line, starts with "NNNNN:"
1059*7c478bd9Sstevel@tonic-gate			$tmp = $1;
1060*7c478bd9Sstevel@tonic-gate			next if ($tmp eq '');
1061*7c478bd9Sstevel@tonic-gate
1062*7c478bd9Sstevel@tonic-gate			if ($tmp =~ /^binding (.*)$/) {
1063*7c478bd9Sstevel@tonic-gate				#
1064*7c478bd9Sstevel@tonic-gate				# First look for:
1065*7c478bd9Sstevel@tonic-gate				# binding file=/bin/pagesize to \
1066*7c478bd9Sstevel@tonic-gate				# file=/usr/lib/libc.so.1: symbol `exit'
1067*7c478bd9Sstevel@tonic-gate				#
1068*7c478bd9Sstevel@tonic-gate				$tmp = $1;
1069*7c478bd9Sstevel@tonic-gate				push(@bindings, ldd_binding_line($1, $object));
1070*7c478bd9Sstevel@tonic-gate
1071*7c478bd9Sstevel@tonic-gate			} elsif ($tmp =~ /^file=\S+\s+(.*)$/) {
1072*7c478bd9Sstevel@tonic-gate				#
1073*7c478bd9Sstevel@tonic-gate				# Next look for:
1074*7c478bd9Sstevel@tonic-gate				# file=/usr/platform/SUNW,Ultra-1/\
1075*7c478bd9Sstevel@tonic-gate				# lib/libc_psr.so.1;  filtered by /usr...
1076*7c478bd9Sstevel@tonic-gate				# file=libdl.so.1;  needed by /usr/lib/libc.so.1
1077*7c478bd9Sstevel@tonic-gate				#
1078*7c478bd9Sstevel@tonic-gate				$rest =  trim($1);
1079*7c478bd9Sstevel@tonic-gate
1080*7c478bd9Sstevel@tonic-gate				if ($rest =~ /^filtered by /) {
1081*7c478bd9Sstevel@tonic-gate					$filters .=
1082*7c478bd9Sstevel@tonic-gate					    ldd_filter_line($tmp);
1083*7c478bd9Sstevel@tonic-gate				} elsif ($rest =~ /^needed by /) {
1084*7c478bd9Sstevel@tonic-gate					$neededs .=
1085*7c478bd9Sstevel@tonic-gate					    ldd_needed_line($tmp, $object);
1086*7c478bd9Sstevel@tonic-gate				}
1087*7c478bd9Sstevel@tonic-gate
1088*7c478bd9Sstevel@tonic-gate			}
1089*7c478bd9Sstevel@tonic-gate
1090*7c478bd9Sstevel@tonic-gate		} elsif ($line =~ /^stdout:(.*)$/) {
1091*7c478bd9Sstevel@tonic-gate			# LD_DEBUG stdout line:
1092*7c478bd9Sstevel@tonic-gate
1093*7c478bd9Sstevel@tonic-gate			$tmp = trim($1);
1094*7c478bd9Sstevel@tonic-gate			next if ($tmp eq '');
1095*7c478bd9Sstevel@tonic-gate
1096*7c478bd9Sstevel@tonic-gate			if ($tmp =~ /\s+=>\s+/) {
1097*7c478bd9Sstevel@tonic-gate				#
1098*7c478bd9Sstevel@tonic-gate				# First look for standard dependency
1099*7c478bd9Sstevel@tonic-gate				# resolution lines:
1100*7c478bd9Sstevel@tonic-gate				#
1101*7c478bd9Sstevel@tonic-gate				#      libsocket.so.1 => /usr/lib/libsocket.so.1
1102*7c478bd9Sstevel@tonic-gate				#
1103*7c478bd9Sstevel@tonic-gate				# Note that these are *all* of the
1104*7c478bd9Sstevel@tonic-gate				# needed shared objects, not just the
1105*7c478bd9Sstevel@tonic-gate				# directly needed ones.
1106*7c478bd9Sstevel@tonic-gate				#
1107*7c478bd9Sstevel@tonic-gate				$tmp =~ s/\s+/ /g;
1108*7c478bd9Sstevel@tonic-gate				$neededs .= "NEEDED_FOUND:$tmp" . "\n";
1109*7c478bd9Sstevel@tonic-gate
1110*7c478bd9Sstevel@tonic-gate			} elsif ($tmp =~ /symbol not found: (.*)$/) {
1111*7c478bd9Sstevel@tonic-gate				#
1112*7c478bd9Sstevel@tonic-gate				# Next look for unbound symbols:
1113*7c478bd9Sstevel@tonic-gate				# symbol not found: gethz     (/usr/\
1114*7c478bd9Sstevel@tonic-gate				# local/bin/gethz)
1115*7c478bd9Sstevel@tonic-gate				#
1116*7c478bd9Sstevel@tonic-gate
1117*7c478bd9Sstevel@tonic-gate				$tmp = trim($1);
1118*7c478bd9Sstevel@tonic-gate				($tmp, $tmp2) = split(/\s+/, $tmp, 2);
1119*7c478bd9Sstevel@tonic-gate				$tmp2 =~ s/[\(\)]//g;	# trim off ().
1120*7c478bd9Sstevel@tonic-gate
1121*7c478bd9Sstevel@tonic-gate				# $tmp is the symbol, $tmp2 is the
1122*7c478bd9Sstevel@tonic-gate				# calling object.
1123*7c478bd9Sstevel@tonic-gate
1124*7c478bd9Sstevel@tonic-gate				push(@bindings,
1125*7c478bd9Sstevel@tonic-gate				    "BINDING_UNBOUND:$tmp2|$tmp" . "\n"
1126*7c478bd9Sstevel@tonic-gate				);
1127*7c478bd9Sstevel@tonic-gate			}
1128*7c478bd9Sstevel@tonic-gate		}
1129*7c478bd9Sstevel@tonic-gate	}
1130*7c478bd9Sstevel@tonic-gate
1131*7c478bd9Sstevel@tonic-gate	# Return the output:
1132*7c478bd9Sstevel@tonic-gate	my $ret = '';
1133*7c478bd9Sstevel@tonic-gate	$ret .= $filters if (defined($filters));
1134*7c478bd9Sstevel@tonic-gate	$ret .= $neededs if (defined($neededs));
1135*7c478bd9Sstevel@tonic-gate	$ret .= join('', @bindings);
1136*7c478bd9Sstevel@tonic-gate
1137*7c478bd9Sstevel@tonic-gate	return $ret;
1138*7c478bd9Sstevel@tonic-gate}
1139*7c478bd9Sstevel@tonic-gate
1140*7c478bd9Sstevel@tonic-gate#
1141*7c478bd9Sstevel@tonic-gate# Routine used to parse a LD_DEBUG "binding" line.
1142*7c478bd9Sstevel@tonic-gate#
1143*7c478bd9Sstevel@tonic-gate# Returns "preprocessed format line" if line is ok, or
1144*7c478bd9Sstevel@tonic-gate# null string otherwise.
1145*7c478bd9Sstevel@tonic-gate#
1146*7c478bd9Sstevel@tonic-gatesub ldd_binding_line
1147*7c478bd9Sstevel@tonic-gate{
1148*7c478bd9Sstevel@tonic-gate	my ($line, $object) = @_;
1149*7c478bd9Sstevel@tonic-gate
1150*7c478bd9Sstevel@tonic-gate	my ($from, $to, $sym);
1151*7c478bd9Sstevel@tonic-gate
1152*7c478bd9Sstevel@tonic-gate	my ($t1, $t2, $t3);	# tmp vars for regex output
1153*7c478bd9Sstevel@tonic-gate
1154*7c478bd9Sstevel@tonic-gate	#
1155*7c478bd9Sstevel@tonic-gate	# Working on a line like:
1156*7c478bd9Sstevel@tonic-gate	#
1157*7c478bd9Sstevel@tonic-gate	# binding file=/bin/pagesize to file=/usr/lib/libc.so.1: symbol `exit'
1158*7c478bd9Sstevel@tonic-gate	#
1159*7c478bd9Sstevel@tonic-gate	# (with the leading "binding " removed).
1160*7c478bd9Sstevel@tonic-gate	#
1161*7c478bd9Sstevel@tonic-gate
1162*7c478bd9Sstevel@tonic-gate	if ($line =~ /^file=(\S+)\s+to file=(\S+)\s+symbol(.*)$/) {
1163*7c478bd9Sstevel@tonic-gate		#
1164*7c478bd9Sstevel@tonic-gate		# The following trim off spaces, ', `, ;, and :, from
1165*7c478bd9Sstevel@tonic-gate		# the edges so if the filename had those there could
1166*7c478bd9Sstevel@tonic-gate		# be a problem.
1167*7c478bd9Sstevel@tonic-gate		#
1168*7c478bd9Sstevel@tonic-gate		$from = $1;
1169*7c478bd9Sstevel@tonic-gate		$to = $2;
1170*7c478bd9Sstevel@tonic-gate		$sym = $3;
1171*7c478bd9Sstevel@tonic-gate		#
1172*7c478bd9Sstevel@tonic-gate		# guard against future changes to the LD_DEBUG output
1173*7c478bd9Sstevel@tonic-gate		# (i.e. information appended to the end)
1174*7c478bd9Sstevel@tonic-gate		#
1175*7c478bd9Sstevel@tonic-gate		$sym =~ s/'\s+.*$//;
1176*7c478bd9Sstevel@tonic-gate
1177*7c478bd9Sstevel@tonic-gate		$to =~ s/:$//;
1178*7c478bd9Sstevel@tonic-gate
1179*7c478bd9Sstevel@tonic-gate		$sym =~ s/[\s:;`']*$//;
1180*7c478bd9Sstevel@tonic-gate		$sym =~ s/^[\s:;`']*//;
1181*7c478bd9Sstevel@tonic-gate
1182*7c478bd9Sstevel@tonic-gate	} elsif ($line =~ /^file=(.+) to file=(.+): symbol (.*)$/) {
1183*7c478bd9Sstevel@tonic-gate		# This will catch spaces, but is less robust.
1184*7c478bd9Sstevel@tonic-gate		$t1 = $1;
1185*7c478bd9Sstevel@tonic-gate		$t2 = $2;
1186*7c478bd9Sstevel@tonic-gate		$t3 = $3;
1187*7c478bd9Sstevel@tonic-gate		#
1188*7c478bd9Sstevel@tonic-gate		# guard against future changes to the LD_DEBUG output
1189*7c478bd9Sstevel@tonic-gate		# (i.e. information appended to the end)
1190*7c478bd9Sstevel@tonic-gate		#
1191*7c478bd9Sstevel@tonic-gate		$t3 =~ s/'\s+.*$//;
1192*7c478bd9Sstevel@tonic-gate
1193*7c478bd9Sstevel@tonic-gate		$from = wclean($t1, 1);
1194*7c478bd9Sstevel@tonic-gate		$to   = wclean($t2, 1);
1195*7c478bd9Sstevel@tonic-gate		$sym  = wclean($t3);
1196*7c478bd9Sstevel@tonic-gate
1197*7c478bd9Sstevel@tonic-gate	} else {
1198*7c478bd9Sstevel@tonic-gate		return '';
1199*7c478bd9Sstevel@tonic-gate	}
1200*7c478bd9Sstevel@tonic-gate
1201*7c478bd9Sstevel@tonic-gate	if ($from eq '' || $to eq '' || $sym eq '') {
1202*7c478bd9Sstevel@tonic-gate		return '';
1203*7c478bd9Sstevel@tonic-gate	}
1204*7c478bd9Sstevel@tonic-gate
1205*7c478bd9Sstevel@tonic-gate	#
1206*7c478bd9Sstevel@tonic-gate	# OK, we have 3 files: $from, $to, $object
1207*7c478bd9Sstevel@tonic-gate	# Which, if any, are the same file?
1208*7c478bd9Sstevel@tonic-gate	#
1209*7c478bd9Sstevel@tonic-gate	# Note that we have not yet done the Filter library
1210*7c478bd9Sstevel@tonic-gate	# substitutions yet. So one cannot be too trusting of the file
1211*7c478bd9Sstevel@tonic-gate	# comparisons done here.
1212*7c478bd9Sstevel@tonic-gate	#
1213*7c478bd9Sstevel@tonic-gate
1214*7c478bd9Sstevel@tonic-gate	if (files_equal($from, $to, 0)) {
1215*7c478bd9Sstevel@tonic-gate		#
1216*7c478bd9Sstevel@tonic-gate		# We skip the "from" = "to" case
1217*7c478bd9Sstevel@tonic-gate		# (could call this: BINDING_SELF).
1218*7c478bd9Sstevel@tonic-gate		#
1219*7c478bd9Sstevel@tonic-gate		return '';
1220*7c478bd9Sstevel@tonic-gate	} elsif (files_equal($object, $from, 0)) {
1221*7c478bd9Sstevel@tonic-gate		# DIRECT CASE (object calls library):
1222*7c478bd9Sstevel@tonic-gate		return "BINDING_DIRECT:$from|$to|$sym"   . "\n";
1223*7c478bd9Sstevel@tonic-gate	} elsif (files_equal($object, $to, 0)) {
1224*7c478bd9Sstevel@tonic-gate		# REVERSE CASE (library calls object):
1225*7c478bd9Sstevel@tonic-gate		return "BINDING_REVERSE:$from|$to|$sym"  . "\n";
1226*7c478bd9Sstevel@tonic-gate	} else {
1227*7c478bd9Sstevel@tonic-gate		#
1228*7c478bd9Sstevel@tonic-gate		# INDIRECT CASE (needed library calls library):
1229*7c478bd9Sstevel@tonic-gate		# (this will not be a library calling itself because
1230*7c478bd9Sstevel@tonic-gate		# we skip $from eq $to above).
1231*7c478bd9Sstevel@tonic-gate		#
1232*7c478bd9Sstevel@tonic-gate		return "BINDING_INDIRECT:$from|$to|$sym" . "\n";
1233*7c478bd9Sstevel@tonic-gate	}
1234*7c478bd9Sstevel@tonic-gate}
1235*7c478bd9Sstevel@tonic-gate
1236*7c478bd9Sstevel@tonic-gate#
1237*7c478bd9Sstevel@tonic-gate# Routine used to parse a LD_DEBUG "filtered by" line.
1238*7c478bd9Sstevel@tonic-gate#
1239*7c478bd9Sstevel@tonic-gate# Returns "preprocessed format line" if line is ok, or null string
1240*7c478bd9Sstevel@tonic-gate# otherwise.
1241*7c478bd9Sstevel@tonic-gate#
1242*7c478bd9Sstevel@tonic-gatesub ldd_filter_line
1243*7c478bd9Sstevel@tonic-gate{
1244*7c478bd9Sstevel@tonic-gate	my ($line) = @_;
1245*7c478bd9Sstevel@tonic-gate
1246*7c478bd9Sstevel@tonic-gate	my ($filter, $filtee);
1247*7c478bd9Sstevel@tonic-gate
1248*7c478bd9Sstevel@tonic-gate	#
1249*7c478bd9Sstevel@tonic-gate	# Working on a line like:
1250*7c478bd9Sstevel@tonic-gate	#
1251*7c478bd9Sstevel@tonic-gate	# file=/usr/platform/SUNW,Ultra-1/lib/libc_psr.so.1;  \
1252*7c478bd9Sstevel@tonic-gate	#					filtered by /usr/lib/libc.so.1
1253*7c478bd9Sstevel@tonic-gate	#
1254*7c478bd9Sstevel@tonic-gate
1255*7c478bd9Sstevel@tonic-gate	my ($t1, $t2);	# tmp vars for regex output
1256*7c478bd9Sstevel@tonic-gate
1257*7c478bd9Sstevel@tonic-gate	if ($line =~ /file=(\S+)\s+filtered by\s+(\S.*)$/) {
1258*7c478bd9Sstevel@tonic-gate		$t1 = $1;
1259*7c478bd9Sstevel@tonic-gate		$t2 = $2;
1260*7c478bd9Sstevel@tonic-gate		$filtee = wclean($t1);
1261*7c478bd9Sstevel@tonic-gate		$filter = wclean($t2);
1262*7c478bd9Sstevel@tonic-gate	} elsif ($line =~ /file=(.+);  filtered by (.*)$/) {
1263*7c478bd9Sstevel@tonic-gate		$t1 = $1;
1264*7c478bd9Sstevel@tonic-gate		$t2 = $2;
1265*7c478bd9Sstevel@tonic-gate		$filtee = wclean($t1, 1);
1266*7c478bd9Sstevel@tonic-gate		$filter = wclean($t2, 1);
1267*7c478bd9Sstevel@tonic-gate	} else {
1268*7c478bd9Sstevel@tonic-gate		return '';
1269*7c478bd9Sstevel@tonic-gate	}
1270*7c478bd9Sstevel@tonic-gate
1271*7c478bd9Sstevel@tonic-gate	if ($filtee eq '' || $filter eq '') {
1272*7c478bd9Sstevel@tonic-gate		return '';
1273*7c478bd9Sstevel@tonic-gate	}
1274*7c478bd9Sstevel@tonic-gate	#
1275*7c478bd9Sstevel@tonic-gate	# What kind of filter is $filter?
1276*7c478bd9Sstevel@tonic-gate	#	STANDARD  (contains no "real code", e.g. libxnet.so.1), or
1277*7c478bd9Sstevel@tonic-gate	#	AUXILIARY (provides "code" if needed, but
1278*7c478bd9Sstevel@tonic-gate	#	           prefers to pass filtee's "code", e.g. libc.so.1)
1279*7c478bd9Sstevel@tonic-gate	#
1280*7c478bd9Sstevel@tonic-gate	# LD_DEBUG output does not indicate this, so dump -Lv is run on it
1281*7c478bd9Sstevel@tonic-gate	# in filter_lib_type:
1282*7c478bd9Sstevel@tonic-gate	#
1283*7c478bd9Sstevel@tonic-gate
1284*7c478bd9Sstevel@tonic-gate	my $type = 'unknown';
1285*7c478bd9Sstevel@tonic-gate
1286*7c478bd9Sstevel@tonic-gate	$type = filter_lib_type($filter);
1287*7c478bd9Sstevel@tonic-gate
1288*7c478bd9Sstevel@tonic-gate	if ($type eq 'STD') {
1289*7c478bd9Sstevel@tonic-gate		return "FILTER_STD:$filter|$filtee" . "\n";
1290*7c478bd9Sstevel@tonic-gate	} elsif ($type eq 'AUX') {
1291*7c478bd9Sstevel@tonic-gate		return "FILTER_AUX:$filter|$filtee" . "\n";
1292*7c478bd9Sstevel@tonic-gate	} else {
1293*7c478bd9Sstevel@tonic-gate		return '';
1294*7c478bd9Sstevel@tonic-gate	}
1295*7c478bd9Sstevel@tonic-gate}
1296*7c478bd9Sstevel@tonic-gate
1297*7c478bd9Sstevel@tonic-gate#
1298*7c478bd9Sstevel@tonic-gate# Routine used to parse a LD_DEBUG "needed by" line.
1299*7c478bd9Sstevel@tonic-gate#
1300*7c478bd9Sstevel@tonic-gate# Returns "preprocessed format line" if line is ok, or the null string
1301*7c478bd9Sstevel@tonic-gate# otherwise.
1302*7c478bd9Sstevel@tonic-gate#
1303*7c478bd9Sstevel@tonic-gatesub ldd_needed_line
1304*7c478bd9Sstevel@tonic-gate{
1305*7c478bd9Sstevel@tonic-gate	my ($line, $object) = @_;
1306*7c478bd9Sstevel@tonic-gate
1307*7c478bd9Sstevel@tonic-gate	my ($thing_needed, $file);
1308*7c478bd9Sstevel@tonic-gate
1309*7c478bd9Sstevel@tonic-gate	my ($t1, $t2);	# tmp variables for regex output.
1310*7c478bd9Sstevel@tonic-gate
1311*7c478bd9Sstevel@tonic-gate	#
1312*7c478bd9Sstevel@tonic-gate	# Working on a line like:
1313*7c478bd9Sstevel@tonic-gate	#
1314*7c478bd9Sstevel@tonic-gate	# file=libdl.so.1;  needed by /usr/lib/libc.so.1
1315*7c478bd9Sstevel@tonic-gate	#
1316*7c478bd9Sstevel@tonic-gate
1317*7c478bd9Sstevel@tonic-gate	if ($line =~ /file=(\S+)\s+needed by\s+(\S.*)$/) {
1318*7c478bd9Sstevel@tonic-gate		$t1 = $1;
1319*7c478bd9Sstevel@tonic-gate		$t2 = $2;
1320*7c478bd9Sstevel@tonic-gate		$thing_needed	= wclean($t1);
1321*7c478bd9Sstevel@tonic-gate		$file		= wclean($t2);
1322*7c478bd9Sstevel@tonic-gate	} elsif ($line =~ /file=(.+);  needed by (.*)$/) {
1323*7c478bd9Sstevel@tonic-gate		$t1 = $1;
1324*7c478bd9Sstevel@tonic-gate		$t2 = $2;
1325*7c478bd9Sstevel@tonic-gate		$thing_needed	= wclean($t1, 1);
1326*7c478bd9Sstevel@tonic-gate		$file		= wclean($t2, 1);
1327*7c478bd9Sstevel@tonic-gate	} else {
1328*7c478bd9Sstevel@tonic-gate		return '';
1329*7c478bd9Sstevel@tonic-gate	}
1330*7c478bd9Sstevel@tonic-gate
1331*7c478bd9Sstevel@tonic-gate	if ($thing_needed eq '' || $file eq '') {
1332*7c478bd9Sstevel@tonic-gate		return '';
1333*7c478bd9Sstevel@tonic-gate	}
1334*7c478bd9Sstevel@tonic-gate
1335*7c478bd9Sstevel@tonic-gate	#
1336*7c478bd9Sstevel@tonic-gate	# Note that $thing_needed is not a path to a file, just the
1337*7c478bd9Sstevel@tonic-gate	# short name unresolved, e.g. "libc.so.1".  The next line of the
1338*7c478bd9Sstevel@tonic-gate	# LD_DEBUG output would tell us where $thing_needed is resolved
1339*7c478bd9Sstevel@tonic-gate	# to.
1340*7c478bd9Sstevel@tonic-gate	#
1341*7c478bd9Sstevel@tonic-gate
1342*7c478bd9Sstevel@tonic-gate	if (files_equal($object, $file)) {
1343*7c478bd9Sstevel@tonic-gate		return "NEEDED_DIRECT:$thing_needed|$file"   . "\n";
1344*7c478bd9Sstevel@tonic-gate	} else {
1345*7c478bd9Sstevel@tonic-gate		return "NEEDED_INDIRECT:$thing_needed|$file" . "\n";
1346*7c478bd9Sstevel@tonic-gate	}
1347*7c478bd9Sstevel@tonic-gate}
1348*7c478bd9Sstevel@tonic-gate
1349*7c478bd9Sstevel@tonic-gate#
1350*7c478bd9Sstevel@tonic-gate# Routine to clean up a "word" string from ldd output.
1351*7c478bd9Sstevel@tonic-gate#
1352*7c478bd9Sstevel@tonic-gate# This is specialized for removing the stuff surrounding files and
1353*7c478bd9Sstevel@tonic-gate# symbols in the LD_DEBUG output. It is usually a file name or symbol
1354*7c478bd9Sstevel@tonic-gate# name.
1355*7c478bd9Sstevel@tonic-gate#
1356*7c478bd9Sstevel@tonic-gatesub wclean
1357*7c478bd9Sstevel@tonic-gate{
1358*7c478bd9Sstevel@tonic-gate	my ($w, $keep_space) = @_;
1359*7c478bd9Sstevel@tonic-gate
1360*7c478bd9Sstevel@tonic-gate	if (! $keep_space) {
1361*7c478bd9Sstevel@tonic-gate		# make sure leading/trailing spaces are gone.
1362*7c478bd9Sstevel@tonic-gate		$w =~ s/[\s:;`']*$//;	# get rid of : ; ' and `
1363*7c478bd9Sstevel@tonic-gate		$w =~ s/^[\s:;`']*//;
1364*7c478bd9Sstevel@tonic-gate	} else {
1365*7c478bd9Sstevel@tonic-gate		$w =~ s/[:;`']*$//;	# get rid of : ; ' and `
1366*7c478bd9Sstevel@tonic-gate		$w =~ s/^[:;`']*//;
1367*7c478bd9Sstevel@tonic-gate	}
1368*7c478bd9Sstevel@tonic-gate
1369*7c478bd9Sstevel@tonic-gate	return $w;
1370*7c478bd9Sstevel@tonic-gate}
1371*7c478bd9Sstevel@tonic-gate
1372*7c478bd9Sstevel@tonic-gate#
1373*7c478bd9Sstevel@tonic-gate# This routine runs ldd -r on the object file with LD_DEBUG flags turned
1374*7c478bd9Sstevel@tonic-gate# on.  It collects the stdout and the LD_DEBUG profile data for the
1375*7c478bd9Sstevel@tonic-gate# object (it must skip the LD_DEBUG profile data for /usr/bin/ldd
1376*7c478bd9Sstevel@tonic-gate# /bin/sh, or any other extraneous processes).
1377*7c478bd9Sstevel@tonic-gate#
1378*7c478bd9Sstevel@tonic-gate# It returns the profile data as a single string with \n separated
1379*7c478bd9Sstevel@tonic-gate# records. Records starting with "stdout: " are the stdout lines,
1380*7c478bd9Sstevel@tonic-gate# Records starting with "NNNNN: " are the LD_DEBUG lines.  Our caller
1381*7c478bd9Sstevel@tonic-gate# must split and parse those lines.
1382*7c478bd9Sstevel@tonic-gate#
1383*7c478bd9Sstevel@tonic-gate# If there is some non-fatal error, it returns a 1-line string like:
1384*7c478bd9Sstevel@tonic-gate#	ERROR: <error-message>
1385*7c478bd9Sstevel@tonic-gate#
1386*7c478bd9Sstevel@tonic-gatesub get_ldd_output
1387*7c478bd9Sstevel@tonic-gate{
1388*7c478bd9Sstevel@tonic-gate
1389*7c478bd9Sstevel@tonic-gate	my ($object) = @_;
1390*7c478bd9Sstevel@tonic-gate
1391*7c478bd9Sstevel@tonic-gate	my ($tmpdir, $outfile, $errfile);
1392*7c478bd9Sstevel@tonic-gate
1393*7c478bd9Sstevel@tonic-gate	if (! -f $object) {
1394*7c478bd9Sstevel@tonic-gate		exiter(nopathexist($object));
1395*7c478bd9Sstevel@tonic-gate	}
1396*7c478bd9Sstevel@tonic-gate
1397*7c478bd9Sstevel@tonic-gate	# We use the tmp_dir for our work:
1398*7c478bd9Sstevel@tonic-gate	$tmpdir = $tmp_prof_dir;
1399*7c478bd9Sstevel@tonic-gate
1400*7c478bd9Sstevel@tonic-gate	# Clean out the tmpdir.
1401*7c478bd9Sstevel@tonic-gate	if ($tmpdir !~ m,^/*$,) {
1402*7c478bd9Sstevel@tonic-gate		unlink(<$tmpdir/*>);
1403*7c478bd9Sstevel@tonic-gate		#
1404*7c478bd9Sstevel@tonic-gate		# The following puts xgettext(1) back on track. It is
1405*7c478bd9Sstevel@tonic-gate		# confused and believes it is inside a C-style /* comment */
1406*7c478bd9Sstevel@tonic-gate		#
1407*7c478bd9Sstevel@tonic-gate		my $unused = "*/";
1408*7c478bd9Sstevel@tonic-gate	}
1409*7c478bd9Sstevel@tonic-gate
1410*7c478bd9Sstevel@tonic-gate	# Output files for collecting output of the ldd -r command:
1411*7c478bd9Sstevel@tonic-gate	$errfile = "$tmpdir/stderr";
1412*7c478bd9Sstevel@tonic-gate	$outfile = "$tmpdir/stdout";
1413*7c478bd9Sstevel@tonic-gate
1414*7c478bd9Sstevel@tonic-gate	my ($rc, $msg, $child, $result);
1415*7c478bd9Sstevel@tonic-gate
1416*7c478bd9Sstevel@tonic-gate	#
1417*7c478bd9Sstevel@tonic-gate	# This forking method should have 2 LD_DEBUG bind.<PID> files
1418*7c478bd9Sstevel@tonic-gate	# one for ldd and the other for $object. system() could have
1419*7c478bd9Sstevel@tonic-gate	# another from the shell.
1420*7c478bd9Sstevel@tonic-gate	#
1421*7c478bd9Sstevel@tonic-gate
1422*7c478bd9Sstevel@tonic-gate	# Fork off a child:
1423*7c478bd9Sstevel@tonic-gate	$child = fork();
1424*7c478bd9Sstevel@tonic-gate
1425*7c478bd9Sstevel@tonic-gate	#
1426*7c478bd9Sstevel@tonic-gate	# Note: the file "/tmp/.../bind.$child" should be the "ldd"
1427*7c478bd9Sstevel@tonic-gate	# profile, but we do not want to depend upon that.
1428*7c478bd9Sstevel@tonic-gate	#
1429*7c478bd9Sstevel@tonic-gate
1430*7c478bd9Sstevel@tonic-gate	if (! defined($child)) {
1431*7c478bd9Sstevel@tonic-gate		# Problem forking:
1432*7c478bd9Sstevel@tonic-gate		exiter(sprintf(gettext(
1433*7c478bd9Sstevel@tonic-gate		    "cannot fork for command: ldd -r %s: %s\n"), $object, $!));
1434*7c478bd9Sstevel@tonic-gate
1435*7c478bd9Sstevel@tonic-gate	} elsif ($child == 0) {
1436*7c478bd9Sstevel@tonic-gate
1437*7c478bd9Sstevel@tonic-gate		# Reopen std output to the desired output files:
1438*7c478bd9Sstevel@tonic-gate		open(STDOUT, ">$outfile") ||
1439*7c478bd9Sstevel@tonic-gate		    exiter(nofile($outfile, $!));
1440*7c478bd9Sstevel@tonic-gate
1441*7c478bd9Sstevel@tonic-gate		open(STDERR, ">$errfile") ||
1442*7c478bd9Sstevel@tonic-gate		    exiter(nofile($errfile, $!));
1443*7c478bd9Sstevel@tonic-gate
1444*7c478bd9Sstevel@tonic-gate		#
1445*7c478bd9Sstevel@tonic-gate		# Set the env to turn on debugging from the linker:
1446*7c478bd9Sstevel@tonic-gate		#
1447*7c478bd9Sstevel@tonic-gate		$ENV{'LD_DEBUG'} = "files,bindings";
1448*7c478bd9Sstevel@tonic-gate		$ENV{'LD_DEBUG_OUTPUT'} = "$tmpdir/bind";
1449*7c478bd9Sstevel@tonic-gate
1450*7c478bd9Sstevel@tonic-gate		#
1451*7c478bd9Sstevel@tonic-gate		# Set LD_NOAUXFLTR to avoid auxiliary filters (e.g. libc_psr)
1452*7c478bd9Sstevel@tonic-gate		# since they are not of interest to the public/private
1453*7c478bd9Sstevel@tonic-gate		# symbol status and confuse things more than anything else.
1454*7c478bd9Sstevel@tonic-gate		#
1455*7c478bd9Sstevel@tonic-gate		$ENV{'LD_NOAUXFLTR'} = "1";
1456*7c478bd9Sstevel@tonic-gate
1457*7c478bd9Sstevel@tonic-gate		# Run ldd -r:
1458*7c478bd9Sstevel@tonic-gate		c_locale(1);
1459*7c478bd9Sstevel@tonic-gate		exec($cmd_ldd, '-r', $object);
1460*7c478bd9Sstevel@tonic-gate		exit 1;		# only reached if exec fails.
1461*7c478bd9Sstevel@tonic-gate	} else {
1462*7c478bd9Sstevel@tonic-gate		wait;		# Wait for children to finish.
1463*7c478bd9Sstevel@tonic-gate		$rc = $?; 	# Record exit status.
1464*7c478bd9Sstevel@tonic-gate		$msg = $!;
1465*7c478bd9Sstevel@tonic-gate	}
1466*7c478bd9Sstevel@tonic-gate
1467*7c478bd9Sstevel@tonic-gate	# Check the exit status:
1468*7c478bd9Sstevel@tonic-gate	if ($rc != 0) {
1469*7c478bd9Sstevel@tonic-gate		if (-s $errfile) {
1470*7c478bd9Sstevel@tonic-gate			my $tmp;
1471*7c478bd9Sstevel@tonic-gate			my $errfile_fh = do { local *FH; *FH };
1472*7c478bd9Sstevel@tonic-gate			if (open($errfile_fh, "<$errfile")) {
1473*7c478bd9Sstevel@tonic-gate				while (<$errfile_fh>) {
1474*7c478bd9Sstevel@tonic-gate					if (/ldd:/) {
1475*7c478bd9Sstevel@tonic-gate						$tmp = $_;
1476*7c478bd9Sstevel@tonic-gate						last;
1477*7c478bd9Sstevel@tonic-gate					}
1478*7c478bd9Sstevel@tonic-gate				}
1479*7c478bd9Sstevel@tonic-gate				close($errfile_fh);
1480*7c478bd9Sstevel@tonic-gate			}
1481*7c478bd9Sstevel@tonic-gate			if (defined($tmp))  {
1482*7c478bd9Sstevel@tonic-gate				chomp($tmp);
1483*7c478bd9Sstevel@tonic-gate				if ($tmp =~ /ldd:\s*(\S.*)$/) {
1484*7c478bd9Sstevel@tonic-gate					$tmp = $1;
1485*7c478bd9Sstevel@tonic-gate				}
1486*7c478bd9Sstevel@tonic-gate				if ($tmp =~ /^[^:]+:\s*(\S.*)$/) {
1487*7c478bd9Sstevel@tonic-gate					my $t = $1;
1488*7c478bd9Sstevel@tonic-gate					if ($t !~ /^\s*$/) {
1489*7c478bd9Sstevel@tonic-gate						$tmp = $t;
1490*7c478bd9Sstevel@tonic-gate					}
1491*7c478bd9Sstevel@tonic-gate				}
1492*7c478bd9Sstevel@tonic-gate				$msg = $tmp if ($tmp !~ /^\s*$/);
1493*7c478bd9Sstevel@tonic-gate			}
1494*7c478bd9Sstevel@tonic-gate		}
1495*7c478bd9Sstevel@tonic-gate		emsg("%s", norunprog("$cmd_ldd -r $object", "$msg\n"));
1496*7c478bd9Sstevel@tonic-gate		$msg =~ s/\n/ /g;
1497*7c478bd9Sstevel@tonic-gate		$msg =~ s/;/,/g;
1498*7c478bd9Sstevel@tonic-gate		$msg = sprintf("ERROR: " . gettext(
1499*7c478bd9Sstevel@tonic-gate		    "Error running: ldd -r LD_DEBUG: %s"), $msg);
1500*7c478bd9Sstevel@tonic-gate		return $msg;
1501*7c478bd9Sstevel@tonic-gate	}
1502*7c478bd9Sstevel@tonic-gate
1503*7c478bd9Sstevel@tonic-gate	#
1504*7c478bd9Sstevel@tonic-gate	# We now have all the output files created. We read them and
1505*7c478bd9Sstevel@tonic-gate	# merge them into one long string to return to whoever called
1506*7c478bd9Sstevel@tonic-gate	# us.  The caller will parse it, not us. Our goal here is to
1507*7c478bd9Sstevel@tonic-gate	# just return the correct LD_DEBUG profile data.
1508*7c478bd9Sstevel@tonic-gate	#
1509*7c478bd9Sstevel@tonic-gate
1510*7c478bd9Sstevel@tonic-gate	if (-f "$tmpdir/stdout") {
1511*7c478bd9Sstevel@tonic-gate		my $out_fh = do { local *FH; *FH };
1512*7c478bd9Sstevel@tonic-gate		if (! open($out_fh, "<$tmpdir/stdout")) {
1513*7c478bd9Sstevel@tonic-gate			exiter(nofile("$tmpdir/stdout", $!));
1514*7c478bd9Sstevel@tonic-gate		}
1515*7c478bd9Sstevel@tonic-gate		while (<$out_fh>) {
1516*7c478bd9Sstevel@tonic-gate			# Add the special prefix for STDOUT:
1517*7c478bd9Sstevel@tonic-gate			$result .= "stdout: $_";
1518*7c478bd9Sstevel@tonic-gate		}
1519*7c478bd9Sstevel@tonic-gate		close($out_fh);
1520*7c478bd9Sstevel@tonic-gate	}
1521*7c478bd9Sstevel@tonic-gate
1522*7c478bd9Sstevel@tonic-gate	my ($file, $count, $goodone, $ok, $aok, @file);
1523*7c478bd9Sstevel@tonic-gate
1524*7c478bd9Sstevel@tonic-gate	$count = 0;
1525*7c478bd9Sstevel@tonic-gate
1526*7c478bd9Sstevel@tonic-gate	my $prevline;
1527*7c478bd9Sstevel@tonic-gate
1528*7c478bd9Sstevel@tonic-gate	# Loop over each "bind.NNNNN" file in the tmp directory:
1529*7c478bd9Sstevel@tonic-gate	foreach $file (<$tmpdir/bind.*>) {
1530*7c478bd9Sstevel@tonic-gate
1531*7c478bd9Sstevel@tonic-gate		# Open it for reading:
1532*7c478bd9Sstevel@tonic-gate		my $ldd_file_fh = do { local *FH; *FH };
1533*7c478bd9Sstevel@tonic-gate		if (! open($ldd_file_fh, "<$file")) {
1534*7c478bd9Sstevel@tonic-gate			exiter(nofile($file, $!));
1535*7c478bd9Sstevel@tonic-gate		}
1536*7c478bd9Sstevel@tonic-gate
1537*7c478bd9Sstevel@tonic-gate		#
1538*7c478bd9Sstevel@tonic-gate		# ok = 1 means this file we are reading the profile file
1539*7c478bd9Sstevel@tonic-gate		# corresponding to $object. We set ok = 0 as soon as we
1540*7c478bd9Sstevel@tonic-gate		# discover otherwise.
1541*7c478bd9Sstevel@tonic-gate		#
1542*7c478bd9Sstevel@tonic-gate		$ok = 1;
1543*7c478bd9Sstevel@tonic-gate
1544*7c478bd9Sstevel@tonic-gate		#
1545*7c478bd9Sstevel@tonic-gate		# $aok = 1 means always OK. I.e. we are definitely in the
1546*7c478bd9Sstevel@tonic-gate		# correct profile.
1547*7c478bd9Sstevel@tonic-gate		#
1548*7c478bd9Sstevel@tonic-gate		$aok = 0;
1549*7c478bd9Sstevel@tonic-gate
1550*7c478bd9Sstevel@tonic-gate		#
1551*7c478bd9Sstevel@tonic-gate		# this variable will hold the previous line so that we
1552*7c478bd9Sstevel@tonic-gate		# can skip adjacent duplicates.
1553*7c478bd9Sstevel@tonic-gate		#
1554*7c478bd9Sstevel@tonic-gate		$prevline = '';
1555*7c478bd9Sstevel@tonic-gate
1556*7c478bd9Sstevel@tonic-gate		my $idx;
1557*7c478bd9Sstevel@tonic-gate
1558*7c478bd9Sstevel@tonic-gate		while (<$ldd_file_fh>) {
1559*7c478bd9Sstevel@tonic-gate
1560*7c478bd9Sstevel@tonic-gate			#
1561*7c478bd9Sstevel@tonic-gate			# This check is done to perform a simple
1562*7c478bd9Sstevel@tonic-gate			# uniq'ing of the output. Non-PIC objects have
1563*7c478bd9Sstevel@tonic-gate			# lots of duplicates, many of them right after
1564*7c478bd9Sstevel@tonic-gate			# each other.
1565*7c478bd9Sstevel@tonic-gate			#
1566*7c478bd9Sstevel@tonic-gate
1567*7c478bd9Sstevel@tonic-gate			next if ($_ eq $prevline);
1568*7c478bd9Sstevel@tonic-gate			$prevline = $_;
1569*7c478bd9Sstevel@tonic-gate
1570*7c478bd9Sstevel@tonic-gate			#
1571*7c478bd9Sstevel@tonic-gate			# Check to see if this is the wrong profile
1572*7c478bd9Sstevel@tonic-gate			# file:  The ones we know about are "ldd" and
1573*7c478bd9Sstevel@tonic-gate			# "sh".  If the object under test is ever "ldd"
1574*7c478bd9Sstevel@tonic-gate			# or "sh" this will fail.
1575*7c478bd9Sstevel@tonic-gate			#
1576*7c478bd9Sstevel@tonic-gate			if ($aok) {
1577*7c478bd9Sstevel@tonic-gate				;
1578*7c478bd9Sstevel@tonic-gate			} elsif ($ok) {
1579*7c478bd9Sstevel@tonic-gate			#
1580*7c478bd9Sstevel@tonic-gate			# checks line:
1581*7c478bd9Sstevel@tonic-gate			# file=ldd;  analyzing  [ RTLD_GLOBAL  RTLD_LAZY ]
1582*7c478bd9Sstevel@tonic-gate			#
1583*7c478bd9Sstevel@tonic-gate				if (/\bfile=\S+\b(ldd|sh)\b/) {
1584*7c478bd9Sstevel@tonic-gate					$ok = 0;
1585*7c478bd9Sstevel@tonic-gate				} else {
1586*7c478bd9Sstevel@tonic-gate					$idx =
1587*7c478bd9Sstevel@tonic-gate					index($_, " file=$object;  analyzing");
1588*7c478bd9Sstevel@tonic-gate					$aok = 1 if ($idx != -1);
1589*7c478bd9Sstevel@tonic-gate				}
1590*7c478bd9Sstevel@tonic-gate			}
1591*7c478bd9Sstevel@tonic-gate
1592*7c478bd9Sstevel@tonic-gate			# We can skip this file as soon as we see $ok = 0.
1593*7c478bd9Sstevel@tonic-gate			last unless ($ok);
1594*7c478bd9Sstevel@tonic-gate
1595*7c478bd9Sstevel@tonic-gate			# Gather the profile output into a string:
1596*7c478bd9Sstevel@tonic-gate			$file[$count] .= $_;
1597*7c478bd9Sstevel@tonic-gate		}
1598*7c478bd9Sstevel@tonic-gate
1599*7c478bd9Sstevel@tonic-gate		#
1600*7c478bd9Sstevel@tonic-gate		# Note that this one is the desired profile
1601*7c478bd9Sstevel@tonic-gate		# (i.e. if $ok is still true):
1602*7c478bd9Sstevel@tonic-gate		#
1603*7c478bd9Sstevel@tonic-gate		$goodone .= "$count," if ($ok);
1604*7c478bd9Sstevel@tonic-gate
1605*7c478bd9Sstevel@tonic-gate		# On to the next $file:
1606*7c478bd9Sstevel@tonic-gate		close($ldd_file_fh);
1607*7c478bd9Sstevel@tonic-gate		$count++;
1608*7c478bd9Sstevel@tonic-gate	}
1609*7c478bd9Sstevel@tonic-gate
1610*7c478bd9Sstevel@tonic-gate	if (defined($goodone)) {
1611*7c478bd9Sstevel@tonic-gate		$goodone =~ s/,$//;	# Trim the last comma off.
1612*7c478bd9Sstevel@tonic-gate	}
1613*7c478bd9Sstevel@tonic-gate
1614*7c478bd9Sstevel@tonic-gate	# If we have none or more than one "good one" we are in trouble:
1615*7c478bd9Sstevel@tonic-gate	if (! defined($goodone) || ($goodone !~ /^\d+$/) || ($goodone =~ /,/)) {
1616*7c478bd9Sstevel@tonic-gate
1617*7c478bd9Sstevel@tonic-gate		#
1618*7c478bd9Sstevel@tonic-gate		# Note that this is the first point at which we would detect
1619*7c478bd9Sstevel@tonic-gate		# a problem with the checking of SUID/SGID objects, although
1620*7c478bd9Sstevel@tonic-gate		# in theory we could have skipped these objects earlier.
1621*7c478bd9Sstevel@tonic-gate		# We prefer to let the linker, ld.so.1, indicate this failure
1622*7c478bd9Sstevel@tonic-gate		# and then we catch it and diagnose it here.
1623*7c478bd9Sstevel@tonic-gate		#
1624*7c478bd9Sstevel@tonic-gate		my $suid = is_suid($object);
1625*7c478bd9Sstevel@tonic-gate
1626*7c478bd9Sstevel@tonic-gate		if ($suid == 1) {
1627*7c478bd9Sstevel@tonic-gate			$result = "ERROR: " . gettext(
1628*7c478bd9Sstevel@tonic-gate			    "SUID - ldd(1) LD_DEBUG profile failed");
1629*7c478bd9Sstevel@tonic-gate		} elsif ($suid == 2) {
1630*7c478bd9Sstevel@tonic-gate			$result = "ERROR: " . gettext(
1631*7c478bd9Sstevel@tonic-gate			    "SGID - ldd(1) LD_DEBUG profile failed");
1632*7c478bd9Sstevel@tonic-gate		} else {
1633*7c478bd9Sstevel@tonic-gate			$result = "ERROR: " . gettext(
1634*7c478bd9Sstevel@tonic-gate			    "could not get ldd(1) LD_DEBUG profile output");
1635*7c478bd9Sstevel@tonic-gate		}
1636*7c478bd9Sstevel@tonic-gate
1637*7c478bd9Sstevel@tonic-gate	} else {
1638*7c478bd9Sstevel@tonic-gate		# Append the correct profile to the result and return it:
1639*7c478bd9Sstevel@tonic-gate		$result .= $file[$goodone];
1640*7c478bd9Sstevel@tonic-gate	}
1641*7c478bd9Sstevel@tonic-gate
1642*7c478bd9Sstevel@tonic-gate	# Tidy up our mess by cleaning out the tmpdir.
1643*7c478bd9Sstevel@tonic-gate	unlink(<$tmpdir/*>) if ($tmpdir !~ m,^/*$,);
1644*7c478bd9Sstevel@tonic-gate
1645*7c478bd9Sstevel@tonic-gate	return $result;
1646*7c478bd9Sstevel@tonic-gate}
1647