1*7c478bd9Sstevel@tonic-gate#
2*7c478bd9Sstevel@tonic-gate# ident	"%Z%%M%	%I%	%E% SMI"
3*7c478bd9Sstevel@tonic-gate#
4*7c478bd9Sstevel@tonic-gate# Copyright 2005 Sun Microsystems, Inc.  All rights reserved.
5*7c478bd9Sstevel@tonic-gate# Use is subject to license terms.
6*7c478bd9Sstevel@tonic-gate#
7*7c478bd9Sstevel@tonic-gate# CDDL HEADER START
8*7c478bd9Sstevel@tonic-gate#
9*7c478bd9Sstevel@tonic-gate# The contents of this file are subject to the terms of the
10*7c478bd9Sstevel@tonic-gate# Common Development and Distribution License, Version 1.0 only
11*7c478bd9Sstevel@tonic-gate# (the "License").  You may not use this file except in compliance
12*7c478bd9Sstevel@tonic-gate# with the License.
13*7c478bd9Sstevel@tonic-gate#
14*7c478bd9Sstevel@tonic-gate# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
15*7c478bd9Sstevel@tonic-gate# or http://www.opensolaris.org/os/licensing.
16*7c478bd9Sstevel@tonic-gate# See the License for the specific language governing permissions
17*7c478bd9Sstevel@tonic-gate# and limitations under the License.
18*7c478bd9Sstevel@tonic-gate#
19*7c478bd9Sstevel@tonic-gate# When distributing Covered Code, include this CDDL HEADER in each
20*7c478bd9Sstevel@tonic-gate# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
21*7c478bd9Sstevel@tonic-gate# If applicable, add the following below this CDDL HEADER, with the
22*7c478bd9Sstevel@tonic-gate# fields enclosed by brackets "[]" replaced with your own identifying
23*7c478bd9Sstevel@tonic-gate# information: Portions Copyright [yyyy] [name of copyright owner]
24*7c478bd9Sstevel@tonic-gate#
25*7c478bd9Sstevel@tonic-gate# CDDL HEADER END
26*7c478bd9Sstevel@tonic-gate#
27*7c478bd9Sstevel@tonic-gate
28*7c478bd9Sstevel@tonic-gate#
29*7c478bd9Sstevel@tonic-gate# This module contains utility routines and data for use by the appcert
30*7c478bd9Sstevel@tonic-gate# programs: appcert, symprof, symcheck, and symreport.
31*7c478bd9Sstevel@tonic-gate#
32*7c478bd9Sstevel@tonic-gate
33*7c478bd9Sstevel@tonic-gatepackage AppcertUtil;
34*7c478bd9Sstevel@tonic-gate
35*7c478bd9Sstevel@tonic-gaterequire 5.005;
36*7c478bd9Sstevel@tonic-gateuse strict;
37*7c478bd9Sstevel@tonic-gateuse locale;
38*7c478bd9Sstevel@tonic-gateuse Getopt::Std;
39*7c478bd9Sstevel@tonic-gateuse POSIX qw(locale_h);
40*7c478bd9Sstevel@tonic-gateuse Sun::Solaris::Utils qw(textdomain gettext);
41*7c478bd9Sstevel@tonic-gateuse File::Basename;
42*7c478bd9Sstevel@tonic-gateuse File::Path;
43*7c478bd9Sstevel@tonic-gate
44*7c478bd9Sstevel@tonic-gateBEGIN {
45*7c478bd9Sstevel@tonic-gate	use Exporter();
46*7c478bd9Sstevel@tonic-gate	use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
47*7c478bd9Sstevel@tonic-gate
48*7c478bd9Sstevel@tonic-gate	@ISA = qw(Exporter);
49*7c478bd9Sstevel@tonic-gate	@EXPORT = qw(
50*7c478bd9Sstevel@tonic-gate		$command_name
51*7c478bd9Sstevel@tonic-gate		$object_dir
52*7c478bd9Sstevel@tonic-gate		$solaris_library_ld_path
53*7c478bd9Sstevel@tonic-gate		$uname_p
54*7c478bd9Sstevel@tonic-gate		$working_dir
55*7c478bd9Sstevel@tonic-gate		$appcert_lib_dir
56*7c478bd9Sstevel@tonic-gate		$batch_report
57*7c478bd9Sstevel@tonic-gate		$binary_count
58*7c478bd9Sstevel@tonic-gate		$block_min
59*7c478bd9Sstevel@tonic-gate		$block_max
60*7c478bd9Sstevel@tonic-gate		$tmp_dir
61*7c478bd9Sstevel@tonic-gate
62*7c478bd9Sstevel@tonic-gate		$cmd_dump
63*7c478bd9Sstevel@tonic-gate		$cmd_elfdump
64*7c478bd9Sstevel@tonic-gate		$cmd_file
65*7c478bd9Sstevel@tonic-gate		$cmd_find
66*7c478bd9Sstevel@tonic-gate		$cmd_ldd
67*7c478bd9Sstevel@tonic-gate		$cmd_ls
68*7c478bd9Sstevel@tonic-gate		$cmd_more
69*7c478bd9Sstevel@tonic-gate		$cmd_pvs
70*7c478bd9Sstevel@tonic-gate		$cmd_sort
71*7c478bd9Sstevel@tonic-gate		$cmd_uname
72*7c478bd9Sstevel@tonic-gate		$cmd_uniq
73*7c478bd9Sstevel@tonic-gate
74*7c478bd9Sstevel@tonic-gate		@lib_index_loaded
75*7c478bd9Sstevel@tonic-gate
76*7c478bd9Sstevel@tonic-gate		%lib_index_definition
77*7c478bd9Sstevel@tonic-gate		%text
78*7c478bd9Sstevel@tonic-gate		%model_tweak
79*7c478bd9Sstevel@tonic-gate		%skip_symbols
80*7c478bd9Sstevel@tonic-gate		%scoped_symbol
81*7c478bd9Sstevel@tonic-gate		%scoped_symbol_all
82*7c478bd9Sstevel@tonic-gate		%warnings_bind
83*7c478bd9Sstevel@tonic-gate		%warnings_desc
84*7c478bd9Sstevel@tonic-gate		%warnings_match
85*7c478bd9Sstevel@tonic-gate
86*7c478bd9Sstevel@tonic-gate		&object_to_dir_name
87*7c478bd9Sstevel@tonic-gate		&dir_name_to_path
88*7c478bd9Sstevel@tonic-gate		&next_dir_name
89*7c478bd9Sstevel@tonic-gate		&cmd_output_file
90*7c478bd9Sstevel@tonic-gate		&cmd_output_dump
91*7c478bd9Sstevel@tonic-gate		&all_ldd_neededs
92*7c478bd9Sstevel@tonic-gate		&all_ldd_neededs_string
93*7c478bd9Sstevel@tonic-gate		&direct_syms
94*7c478bd9Sstevel@tonic-gate		&import_vars_from_environment
95*7c478bd9Sstevel@tonic-gate		&export_vars_to_environment
96*7c478bd9Sstevel@tonic-gate		&c_locale
97*7c478bd9Sstevel@tonic-gate		&overall_result_code
98*7c478bd9Sstevel@tonic-gate		&trim
99*7c478bd9Sstevel@tonic-gate		&sort_on_count
100*7c478bd9Sstevel@tonic-gate		&print_line
101*7c478bd9Sstevel@tonic-gate		&list_format
102*7c478bd9Sstevel@tonic-gate		&emsg
103*7c478bd9Sstevel@tonic-gate		&pmsg
104*7c478bd9Sstevel@tonic-gate		&nofile
105*7c478bd9Sstevel@tonic-gate		&nopathexist
106*7c478bd9Sstevel@tonic-gate		&norunprog
107*7c478bd9Sstevel@tonic-gate		&nocreatedir
108*7c478bd9Sstevel@tonic-gate		&exiter
109*7c478bd9Sstevel@tonic-gate		&set_clean_up_exit_routine
110*7c478bd9Sstevel@tonic-gate		&signals
111*7c478bd9Sstevel@tonic-gate		&create_tmp_dir
112*7c478bd9Sstevel@tonic-gate		&dir_is_empty
113*7c478bd9Sstevel@tonic-gate		&follow_symlink
114*7c478bd9Sstevel@tonic-gate		&is_statically_linked
115*7c478bd9Sstevel@tonic-gate		&is_elf
116*7c478bd9Sstevel@tonic-gate		&is_shared_object
117*7c478bd9Sstevel@tonic-gate		&is_aout
118*7c478bd9Sstevel@tonic-gate		&is_suid
119*7c478bd9Sstevel@tonic-gate		&bin_type
120*7c478bd9Sstevel@tonic-gate		&files_equal
121*7c478bd9Sstevel@tonic-gate		&purge_caches
122*7c478bd9Sstevel@tonic-gate		&filter_lib_type
123*7c478bd9Sstevel@tonic-gate		&load_model_index
124*7c478bd9Sstevel@tonic-gate		&load_misc_check_databases
125*7c478bd9Sstevel@tonic-gate	);
126*7c478bd9Sstevel@tonic-gate
127*7c478bd9Sstevel@tonic-gate	@EXPORT_OK = ();
128*7c478bd9Sstevel@tonic-gate
129*7c478bd9Sstevel@tonic-gate	%EXPORT_TAGS = ();
130*7c478bd9Sstevel@tonic-gate}
131*7c478bd9Sstevel@tonic-gate
132*7c478bd9Sstevel@tonic-gateuse vars @EXPORT;
133*7c478bd9Sstevel@tonic-gateuse vars @EXPORT_OK;
134*7c478bd9Sstevel@tonic-gate
135*7c478bd9Sstevel@tonic-gateuse vars qw(
136*7c478bd9Sstevel@tonic-gate	$lib_match_initialized
137*7c478bd9Sstevel@tonic-gate
138*7c478bd9Sstevel@tonic-gate	%lib_index
139*7c478bd9Sstevel@tonic-gate	%lib_index_loaded
140*7c478bd9Sstevel@tonic-gate	%shared_object_index
141*7c478bd9Sstevel@tonic-gate
142*7c478bd9Sstevel@tonic-gate	%file_inode_cache
143*7c478bd9Sstevel@tonic-gate	%file_exists_cache
144*7c478bd9Sstevel@tonic-gate	%filter_lib_cache
145*7c478bd9Sstevel@tonic-gate	%lib_match_cache
146*7c478bd9Sstevel@tonic-gate	%cmd_output_file_cache
147*7c478bd9Sstevel@tonic-gate	%cmd_output_dump_cache
148*7c478bd9Sstevel@tonic-gate	%all_ldd_neededs_cache
149*7c478bd9Sstevel@tonic-gate);
150*7c478bd9Sstevel@tonic-gate
151*7c478bd9Sstevel@tonic-gatemy $clean_up_exit_routine;
152*7c478bd9Sstevel@tonic-gatemy $tmp_dir_count = 0;
153*7c478bd9Sstevel@tonic-gatemy $next_dir_name_dh;
154*7c478bd9Sstevel@tonic-gatemy $LC_ALL = '';
155*7c478bd9Sstevel@tonic-gate
156*7c478bd9Sstevel@tonic-gate# Get the name of the program:
157*7c478bd9Sstevel@tonic-gate$command_name = basename($0);
158*7c478bd9Sstevel@tonic-gate
159*7c478bd9Sstevel@tonic-gate$cmd_dump	= '/usr/ccs/bin/dump';
160*7c478bd9Sstevel@tonic-gate$cmd_elfdump	= '/usr/ccs/bin/elfdump';
161*7c478bd9Sstevel@tonic-gate$cmd_file	= '/usr/bin/file';
162*7c478bd9Sstevel@tonic-gate$cmd_find	= '/usr/bin/find';
163*7c478bd9Sstevel@tonic-gate$cmd_ldd	= '/usr/bin/ldd';
164*7c478bd9Sstevel@tonic-gate$cmd_ls		= '/usr/bin/ls';
165*7c478bd9Sstevel@tonic-gate$cmd_more	= '/usr/bin/more';
166*7c478bd9Sstevel@tonic-gate$cmd_pvs	= '/usr/bin/pvs';
167*7c478bd9Sstevel@tonic-gate$cmd_sort	= '/usr/bin/sort';
168*7c478bd9Sstevel@tonic-gate$cmd_uname	= '/usr/bin/uname';
169*7c478bd9Sstevel@tonic-gate$cmd_uniq	= '/usr/bin/uniq';
170*7c478bd9Sstevel@tonic-gate
171*7c478bd9Sstevel@tonic-gatechomp($uname_p	= `$cmd_uname -p`);
172*7c478bd9Sstevel@tonic-gate
173*7c478bd9Sstevel@tonic-gate
174*7c478bd9Sstevel@tonic-gate# Initialize constants:
175*7c478bd9Sstevel@tonic-gate
176*7c478bd9Sstevel@tonic-gate$solaris_library_ld_path = "/usr/openwin/lib:/usr/dt/lib";
177*7c478bd9Sstevel@tonic-gate
178*7c478bd9Sstevel@tonic-gate# Prefix for every object's profiling (etc) subdir in $working_dir.
179*7c478bd9Sstevel@tonic-gate$object_dir = 'objects/';
180*7c478bd9Sstevel@tonic-gate
181*7c478bd9Sstevel@tonic-gate$text{'Summary_Result_None_Checked'} = gettext(
182*7c478bd9Sstevel@tonic-gate    "No binaries were checked.");
183*7c478bd9Sstevel@tonic-gate$text{'Summary_Result_Some_Failed'} = gettext(
184*7c478bd9Sstevel@tonic-gate    "Potential binary stability problem(s) detected.");
185*7c478bd9Sstevel@tonic-gate$text{'Summary_Result_Some_Incomplete'} = gettext(
186*7c478bd9Sstevel@tonic-gate    "No stability problems detected, but not all binaries were checked.");
187*7c478bd9Sstevel@tonic-gate$text{'Summary_Result_All_Passed'} = gettext(
188*7c478bd9Sstevel@tonic-gate    "No binary stability problems detected.");
189*7c478bd9Sstevel@tonic-gate
190*7c478bd9Sstevel@tonic-gate
191*7c478bd9Sstevel@tonic-gate$text{'Message_Private_Symbols_Check_Outfile'} = <<"END";
192*7c478bd9Sstevel@tonic-gate#
193*7c478bd9Sstevel@tonic-gate# <binary>|<abi>|<caller>|<callee>|private|<symbol>
194*7c478bd9Sstevel@tonic-gate#
195*7c478bd9Sstevel@tonic-gateEND
196*7c478bd9Sstevel@tonic-gate
197*7c478bd9Sstevel@tonic-gate$text{'Message_Public_Symbols_Check_Outfile'} =
198*7c478bd9Sstevel@tonic-gate	$text{'Message_Private_Symbols_Check_Outfile'};
199*7c478bd9Sstevel@tonic-gate$text{'Message_Public_Symbols_Check_Outfile'} =~ s/private/public/g;
200*7c478bd9Sstevel@tonic-gate
201*7c478bd9Sstevel@tonic-gate#
202*7c478bd9Sstevel@tonic-gate# Maps a filesystem path of a binary object to a subdirectory name (in
203*7c478bd9Sstevel@tonic-gate# $working_dir).  $working_dir is NOT prepended.
204*7c478bd9Sstevel@tonic-gate#
205*7c478bd9Sstevel@tonic-gate# Maps, e.g., /home/auser/bin/netscape.sparc
206*7c478bd9Sstevel@tonic-gate#      ===> objects/:=home=auser=bin=netscape.sparc
207*7c478bd9Sstevel@tonic-gate#
208*7c478bd9Sstevel@tonic-gatesub object_to_dir_name
209*7c478bd9Sstevel@tonic-gate{
210*7c478bd9Sstevel@tonic-gate	my ($filename) = @_;
211*7c478bd9Sstevel@tonic-gate
212*7c478bd9Sstevel@tonic-gate	my $dirname = $filename;
213*7c478bd9Sstevel@tonic-gate
214*7c478bd9Sstevel@tonic-gate	# protect any percents there:
215*7c478bd9Sstevel@tonic-gate	$dirname =~ s,%,%%,g;
216*7c478bd9Sstevel@tonic-gate
217*7c478bd9Sstevel@tonic-gate	# protect any equals there:
218*7c478bd9Sstevel@tonic-gate	$dirname =~ s,=,%=,g;
219*7c478bd9Sstevel@tonic-gate
220*7c478bd9Sstevel@tonic-gate	# now change slashes to equals:
221*7c478bd9Sstevel@tonic-gate	$dirname =~ s,/,=,g;
222*7c478bd9Sstevel@tonic-gate
223*7c478bd9Sstevel@tonic-gate	#
224*7c478bd9Sstevel@tonic-gate	# Prepend "objects/" and ":" tag to avoid dirname starting
225*7c478bd9Sstevel@tonic-gate	# with "=" or "."
226*7c478bd9Sstevel@tonic-gate	#
227*7c478bd9Sstevel@tonic-gate	$dirname = $object_dir . ':' . $dirname;
228*7c478bd9Sstevel@tonic-gate
229*7c478bd9Sstevel@tonic-gate	return $dirname;
230*7c478bd9Sstevel@tonic-gate}
231*7c478bd9Sstevel@tonic-gate
232*7c478bd9Sstevel@tonic-gate#
233*7c478bd9Sstevel@tonic-gate# Takes the application output data directory and returns the path to
234*7c478bd9Sstevel@tonic-gate# the actual binary.
235*7c478bd9Sstevel@tonic-gate#
236*7c478bd9Sstevel@tonic-gatesub dir_name_to_path
237*7c478bd9Sstevel@tonic-gate{
238*7c478bd9Sstevel@tonic-gate	my ($dirname) = @_;
239*7c478bd9Sstevel@tonic-gate	my $path = '';
240*7c478bd9Sstevel@tonic-gate
241*7c478bd9Sstevel@tonic-gate	if (! -f "$dirname/info.path") {
242*7c478bd9Sstevel@tonic-gate		exiter(nofile("$dirname/info.path", $!));
243*7c478bd9Sstevel@tonic-gate	} else {
244*7c478bd9Sstevel@tonic-gate		my $info_path_fh = do { local *FH; *FH };
245*7c478bd9Sstevel@tonic-gate		open($info_path_fh, "<$dirname/info.path") ||
246*7c478bd9Sstevel@tonic-gate		    exiter(nofile("$dirname/info.path", $!));
247*7c478bd9Sstevel@tonic-gate		chomp($path = <$info_path_fh>);
248*7c478bd9Sstevel@tonic-gate		close($info_path_fh);
249*7c478bd9Sstevel@tonic-gate	}
250*7c478bd9Sstevel@tonic-gate
251*7c478bd9Sstevel@tonic-gate	return $path;
252*7c478bd9Sstevel@tonic-gate}
253*7c478bd9Sstevel@tonic-gate
254*7c478bd9Sstevel@tonic-gate#
255*7c478bd9Sstevel@tonic-gate# This subroutine repeatly returns the object dirnames in the
256*7c478bd9Sstevel@tonic-gate# working_dir.  The full path to the dirname is returned.  "undef" is
257*7c478bd9Sstevel@tonic-gate# returned when all have been cycled through.
258*7c478bd9Sstevel@tonic-gate#
259*7c478bd9Sstevel@tonic-gatesub next_dir_name
260*7c478bd9Sstevel@tonic-gate{
261*7c478bd9Sstevel@tonic-gate	# object directory:
262*7c478bd9Sstevel@tonic-gate	my $object_directory = $working_dir;
263*7c478bd9Sstevel@tonic-gate	$object_directory .= "/" . $object_dir if ($object_dir);
264*7c478bd9Sstevel@tonic-gate
265*7c478bd9Sstevel@tonic-gate	# Check if we have the directory handle already open:
266*7c478bd9Sstevel@tonic-gate	if (! defined($next_dir_name_dh)) {
267*7c478bd9Sstevel@tonic-gate		# If not, then opendir it:
268*7c478bd9Sstevel@tonic-gate		$next_dir_name_dh = do { local *FH; *FH };
269*7c478bd9Sstevel@tonic-gate		if (! opendir($next_dir_name_dh, $object_directory)) {
270*7c478bd9Sstevel@tonic-gate			exiter(nodir($object_directory, $!));
271*7c478bd9Sstevel@tonic-gate		}
272*7c478bd9Sstevel@tonic-gate	}
273*7c478bd9Sstevel@tonic-gate
274*7c478bd9Sstevel@tonic-gate	my $dirname;
275*7c478bd9Sstevel@tonic-gate
276*7c478bd9Sstevel@tonic-gate	#
277*7c478bd9Sstevel@tonic-gate	# Loop over directory entries until one matches the magic tag
278*7c478bd9Sstevel@tonic-gate	# "object:" Return undef when done reading the directory.
279*7c478bd9Sstevel@tonic-gate	#
280*7c478bd9Sstevel@tonic-gate	while (1) {
281*7c478bd9Sstevel@tonic-gate		$dirname = readdir($next_dir_name_dh);
282*7c478bd9Sstevel@tonic-gate
283*7c478bd9Sstevel@tonic-gate		if (! defined($dirname)) {
284*7c478bd9Sstevel@tonic-gate			# Done with dir. Clean up for next time:
285*7c478bd9Sstevel@tonic-gate			closedir($next_dir_name_dh);
286*7c478bd9Sstevel@tonic-gate			undef($next_dir_name_dh);
287*7c478bd9Sstevel@tonic-gate			return undef;
288*7c478bd9Sstevel@tonic-gate		} elsif ($dirname =~ m,^:,) {
289*7c478bd9Sstevel@tonic-gate			# Return the full path to object's directory:
290*7c478bd9Sstevel@tonic-gate			return "$object_directory/$dirname";
291*7c478bd9Sstevel@tonic-gate		}
292*7c478bd9Sstevel@tonic-gate	}
293*7c478bd9Sstevel@tonic-gate}
294*7c478bd9Sstevel@tonic-gate
295*7c478bd9Sstevel@tonic-gate#
296*7c478bd9Sstevel@tonic-gate# When appcert started up, it stored the /usr/bin/file output in the
297*7c478bd9Sstevel@tonic-gate# app's output directory (appcert: record_binary()). This subroutine
298*7c478bd9Sstevel@tonic-gate# retrieves it.  If it cannot find it, it runs the file command
299*7c478bd9Sstevel@tonic-gate# instead.  The result is stored in memory in %cmd_output_file_cache
300*7c478bd9Sstevel@tonic-gate#
301*7c478bd9Sstevel@tonic-gate# Returns the single line of "file" output including the "\n".  It
302*7c478bd9Sstevel@tonic-gate# returns the null string if it had trouble, usually only if filename
303*7c478bd9Sstevel@tonic-gate# doesn't exist.
304*7c478bd9Sstevel@tonic-gate#
305*7c478bd9Sstevel@tonic-gatesub cmd_output_file
306*7c478bd9Sstevel@tonic-gate{
307*7c478bd9Sstevel@tonic-gate	my ($filename) = @_;
308*7c478bd9Sstevel@tonic-gate
309*7c478bd9Sstevel@tonic-gate	# Check if we have it cached:
310*7c478bd9Sstevel@tonic-gate	if (exists($cmd_output_file_cache{$filename})) {
311*7c478bd9Sstevel@tonic-gate		return $cmd_output_file_cache{$filename};
312*7c478bd9Sstevel@tonic-gate	}
313*7c478bd9Sstevel@tonic-gate
314*7c478bd9Sstevel@tonic-gate	# Otherwise, try to look it up in the $working_dir:
315*7c478bd9Sstevel@tonic-gate	my $outfile = object_to_dir_name($filename);
316*7c478bd9Sstevel@tonic-gate	$outfile = "$working_dir/$outfile/info.file";
317*7c478bd9Sstevel@tonic-gate
318*7c478bd9Sstevel@tonic-gate	my $str;
319*7c478bd9Sstevel@tonic-gate
320*7c478bd9Sstevel@tonic-gate	if (-f $outfile) {
321*7c478bd9Sstevel@tonic-gate		my $file_cmd_fh = do { local *FH; *FH };
322*7c478bd9Sstevel@tonic-gate		if (open($file_cmd_fh, "<$outfile")) {
323*7c478bd9Sstevel@tonic-gate			$str = <$file_cmd_fh>;
324*7c478bd9Sstevel@tonic-gate			close($file_cmd_fh);
325*7c478bd9Sstevel@tonic-gate		}
326*7c478bd9Sstevel@tonic-gate	}
327*7c478bd9Sstevel@tonic-gate
328*7c478bd9Sstevel@tonic-gate	# Otherwise run /usr/bin/file on it:
329*7c478bd9Sstevel@tonic-gate	if (! defined($str) && -f $filename && $filename !~ /'/) {
330*7c478bd9Sstevel@tonic-gate		c_locale(1);
331*7c478bd9Sstevel@tonic-gate		$str = `$cmd_file '$filename' 2>/dev/null`;
332*7c478bd9Sstevel@tonic-gate		c_locale(0);
333*7c478bd9Sstevel@tonic-gate	}
334*7c478bd9Sstevel@tonic-gate
335*7c478bd9Sstevel@tonic-gate	$cmd_output_file_cache{$filename} = $str;
336*7c478bd9Sstevel@tonic-gate
337*7c478bd9Sstevel@tonic-gate	return $str;
338*7c478bd9Sstevel@tonic-gate}
339*7c478bd9Sstevel@tonic-gate
340*7c478bd9Sstevel@tonic-gate#
341*7c478bd9Sstevel@tonic-gate# When appcert started up, it stored the /usr/ccs/bin/dump output in the
342*7c478bd9Sstevel@tonic-gate# app's output directory (appcert: record_binary()). This subroutine
343*7c478bd9Sstevel@tonic-gate# retrieves it.  If it cannot find it, it runs the dump -Lv command
344*7c478bd9Sstevel@tonic-gate# instead.  The result is stored in memory in %cmd_output_dump_cache
345*7c478bd9Sstevel@tonic-gate#
346*7c478bd9Sstevel@tonic-gate# Returns the "dump -Lv" output.  It returns the null string if it had
347*7c478bd9Sstevel@tonic-gate# trouble, usually only if filename doesn't exist.
348*7c478bd9Sstevel@tonic-gate#
349*7c478bd9Sstevel@tonic-gatesub cmd_output_dump
350*7c478bd9Sstevel@tonic-gate{
351*7c478bd9Sstevel@tonic-gate	my ($filename) = @_;
352*7c478bd9Sstevel@tonic-gate
353*7c478bd9Sstevel@tonic-gate	# Check if we have it cached:
354*7c478bd9Sstevel@tonic-gate	if (exists($cmd_output_dump_cache{$filename})) {
355*7c478bd9Sstevel@tonic-gate		return $cmd_output_dump_cache{$filename};
356*7c478bd9Sstevel@tonic-gate	}
357*7c478bd9Sstevel@tonic-gate
358*7c478bd9Sstevel@tonic-gate	# Otherwise, try to look it up in the $working_dir:
359*7c478bd9Sstevel@tonic-gate	my $outfile = object_to_dir_name($filename);
360*7c478bd9Sstevel@tonic-gate	$outfile = "$working_dir/$outfile/info.dump";
361*7c478bd9Sstevel@tonic-gate
362*7c478bd9Sstevel@tonic-gate	my $str;
363*7c478bd9Sstevel@tonic-gate
364*7c478bd9Sstevel@tonic-gate	if (-f $outfile) {
365*7c478bd9Sstevel@tonic-gate		my $dump_cmd_fh = do { local *FH; *FH };
366*7c478bd9Sstevel@tonic-gate		if (open($dump_cmd_fh, "<$outfile")) {
367*7c478bd9Sstevel@tonic-gate			while (<$dump_cmd_fh>) {
368*7c478bd9Sstevel@tonic-gate				$str .= $_;
369*7c478bd9Sstevel@tonic-gate			}
370*7c478bd9Sstevel@tonic-gate			close($dump_cmd_fh);
371*7c478bd9Sstevel@tonic-gate		}
372*7c478bd9Sstevel@tonic-gate	}
373*7c478bd9Sstevel@tonic-gate
374*7c478bd9Sstevel@tonic-gate	# Otherwise run /usr/ccs/bin/dump -Lv on it:
375*7c478bd9Sstevel@tonic-gate	if (! defined($str) && -f $filename && $filename !~ /'/) {
376*7c478bd9Sstevel@tonic-gate		c_locale(1);
377*7c478bd9Sstevel@tonic-gate		$str = `$cmd_dump -Lv '$filename' 2>/dev/null`;
378*7c478bd9Sstevel@tonic-gate		c_locale(0);
379*7c478bd9Sstevel@tonic-gate	}
380*7c478bd9Sstevel@tonic-gate
381*7c478bd9Sstevel@tonic-gate	$cmd_output_dump_cache{$filename} = $str;
382*7c478bd9Sstevel@tonic-gate
383*7c478bd9Sstevel@tonic-gate	return $str;
384*7c478bd9Sstevel@tonic-gate}
385*7c478bd9Sstevel@tonic-gate
386*7c478bd9Sstevel@tonic-gate#
387*7c478bd9Sstevel@tonic-gate# When symprof runs it stores the /usr/bin/ldd output in the app's
388*7c478bd9Sstevel@tonic-gate# output directory (symprof: dynamic_profile()). This subroutine
389*7c478bd9Sstevel@tonic-gate# retrieves it. If it cannot find it, it runs the ldd command instead.
390*7c478bd9Sstevel@tonic-gate# The result is stored in memory in %all_ldd_neededs_cache
391*7c478bd9Sstevel@tonic-gate#
392*7c478bd9Sstevel@tonic-gate# Returns a "neededs hash" as output. The keys being the things needed
393*7c478bd9Sstevel@tonic-gate# (left side of " => ") and the values are the resolution (right side of
394*7c478bd9Sstevel@tonic-gate# " => ").  It returns the null hash if it had trouble, usually only if
395*7c478bd9Sstevel@tonic-gate# filename doesn't even exist, or if the object is not dynamically
396*7c478bd9Sstevel@tonic-gate# linked.
397*7c478bd9Sstevel@tonic-gate#
398*7c478bd9Sstevel@tonic-gatesub all_ldd_neededs
399*7c478bd9Sstevel@tonic-gate{
400*7c478bd9Sstevel@tonic-gate	my ($filename) = @_;
401*7c478bd9Sstevel@tonic-gate
402*7c478bd9Sstevel@tonic-gate	my (%all_neededs);
403*7c478bd9Sstevel@tonic-gate
404*7c478bd9Sstevel@tonic-gate	my $output;
405*7c478bd9Sstevel@tonic-gate
406*7c478bd9Sstevel@tonic-gate	# Check if we have it cached:
407*7c478bd9Sstevel@tonic-gate	if (exists($all_ldd_neededs_cache{$filename})) {
408*7c478bd9Sstevel@tonic-gate		$output = $all_ldd_neededs_cache{$filename};
409*7c478bd9Sstevel@tonic-gate	}
410*7c478bd9Sstevel@tonic-gate
411*7c478bd9Sstevel@tonic-gate	if (! defined($output)) {
412*7c478bd9Sstevel@tonic-gate		# Otherwise, try to look it up in the $working_dir:
413*7c478bd9Sstevel@tonic-gate		my $outfile = object_to_dir_name($filename);
414*7c478bd9Sstevel@tonic-gate		$outfile = "$working_dir/$outfile/profile.dynamic.ldd";
415*7c478bd9Sstevel@tonic-gate
416*7c478bd9Sstevel@tonic-gate		if (-f $outfile) {
417*7c478bd9Sstevel@tonic-gate			my $all_neededs_fh = do { local *FH; *FH };
418*7c478bd9Sstevel@tonic-gate			if (open($all_neededs_fh, "<$outfile")) {
419*7c478bd9Sstevel@tonic-gate				while (<$all_neededs_fh>) {
420*7c478bd9Sstevel@tonic-gate					next if (/^\s*#/);
421*7c478bd9Sstevel@tonic-gate					$output .= $_;
422*7c478bd9Sstevel@tonic-gate				}
423*7c478bd9Sstevel@tonic-gate			}
424*7c478bd9Sstevel@tonic-gate			close($all_neededs_fh);
425*7c478bd9Sstevel@tonic-gate		}
426*7c478bd9Sstevel@tonic-gate	}
427*7c478bd9Sstevel@tonic-gate
428*7c478bd9Sstevel@tonic-gate	my ($str, $line, $l1, $l2);
429*7c478bd9Sstevel@tonic-gate	if (! defined($output) && -f $filename && $filename !~ /'/) {
430*7c478bd9Sstevel@tonic-gate		# Otherwise run /usr/bin/ldd on it:
431*7c478bd9Sstevel@tonic-gate		c_locale(1);
432*7c478bd9Sstevel@tonic-gate		$str = `$cmd_ldd '$filename' 2>/dev/null`;
433*7c478bd9Sstevel@tonic-gate		c_locale(0);
434*7c478bd9Sstevel@tonic-gate		foreach $line (split(/\n/, $str)) {
435*7c478bd9Sstevel@tonic-gate			$line = trim($line);
436*7c478bd9Sstevel@tonic-gate			$output .= "$line\n";
437*7c478bd9Sstevel@tonic-gate		}
438*7c478bd9Sstevel@tonic-gate	}
439*7c478bd9Sstevel@tonic-gate
440*7c478bd9Sstevel@tonic-gate	if (! defined($output)) {
441*7c478bd9Sstevel@tonic-gate		#
442*7c478bd9Sstevel@tonic-gate		# Set the output to the null string so following loop
443*7c478bd9Sstevel@tonic-gate		# will do nothing and thus the empty hash will be
444*7c478bd9Sstevel@tonic-gate		# returned.
445*7c478bd9Sstevel@tonic-gate		#
446*7c478bd9Sstevel@tonic-gate		$output = '';
447*7c478bd9Sstevel@tonic-gate	}
448*7c478bd9Sstevel@tonic-gate
449*7c478bd9Sstevel@tonic-gate	$all_ldd_neededs_cache{$filename} = $output;
450*7c478bd9Sstevel@tonic-gate
451*7c478bd9Sstevel@tonic-gate	foreach $line (split(/\n/, $output)) {
452*7c478bd9Sstevel@tonic-gate		($l1, $l2) = split(/\s*=>\s*/, $line);
453*7c478bd9Sstevel@tonic-gate		$l1 = trim($l1);
454*7c478bd9Sstevel@tonic-gate		$l2 = trim($l2);
455*7c478bd9Sstevel@tonic-gate		$all_neededs{$l1} = $l2;
456*7c478bd9Sstevel@tonic-gate		if ($l2 !~ /file not found/) {
457*7c478bd9Sstevel@tonic-gate			$all_neededs{$l2} = $l2;
458*7c478bd9Sstevel@tonic-gate		}
459*7c478bd9Sstevel@tonic-gate	}
460*7c478bd9Sstevel@tonic-gate
461*7c478bd9Sstevel@tonic-gate	return %all_neededs;
462*7c478bd9Sstevel@tonic-gate}
463*7c478bd9Sstevel@tonic-gate
464*7c478bd9Sstevel@tonic-gate#
465*7c478bd9Sstevel@tonic-gate# Create a string with all of the needed objects (direct and indirect).
466*7c478bd9Sstevel@tonic-gate# This is intended for object name matching.  See the 'needed' MATCH
467*7c478bd9Sstevel@tonic-gate# entries in etc.warn.
468*7c478bd9Sstevel@tonic-gate#
469*7c478bd9Sstevel@tonic-gatesub all_ldd_neededs_string
470*7c478bd9Sstevel@tonic-gate{
471*7c478bd9Sstevel@tonic-gate	my ($filename) = @_;
472*7c478bd9Sstevel@tonic-gate	my (%hash, $key);
473*7c478bd9Sstevel@tonic-gate	my $str = '';
474*7c478bd9Sstevel@tonic-gate	%hash = all_ldd_neededs($filename);
475*7c478bd9Sstevel@tonic-gate	foreach $key (keys(%hash)) {
476*7c478bd9Sstevel@tonic-gate		$str .= "$key $hash{$key}\n";
477*7c478bd9Sstevel@tonic-gate	}
478*7c478bd9Sstevel@tonic-gate	return $str;
479*7c478bd9Sstevel@tonic-gate}
480*7c478bd9Sstevel@tonic-gate
481*7c478bd9Sstevel@tonic-gate#
482*7c478bd9Sstevel@tonic-gate# Create a list with all of the directly bound symbols.  This is
483*7c478bd9Sstevel@tonic-gate# intended for symbol call matching.  See the 'syms' MATCH entries in
484*7c478bd9Sstevel@tonic-gate# etc.warn.
485*7c478bd9Sstevel@tonic-gate#
486*7c478bd9Sstevel@tonic-gatesub direct_syms
487*7c478bd9Sstevel@tonic-gate{
488*7c478bd9Sstevel@tonic-gate	my ($filename) = @_;
489*7c478bd9Sstevel@tonic-gate	#
490*7c478bd9Sstevel@tonic-gate	# We stored the dynamic profile output in the app's output
491*7c478bd9Sstevel@tonic-gate	# directory. This subroutine retrieves it, identifies the
492*7c478bd9Sstevel@tonic-gate	# direct bindings symbol names and places them in a newline
493*7c478bd9Sstevel@tonic-gate	# separated string returned to caller.
494*7c478bd9Sstevel@tonic-gate	#
495*7c478bd9Sstevel@tonic-gate	my $direct_syms = '';
496*7c478bd9Sstevel@tonic-gate
497*7c478bd9Sstevel@tonic-gate	my $outfile = object_to_dir_name($filename);
498*7c478bd9Sstevel@tonic-gate	$outfile = "$working_dir/$outfile/profile.dynamic";
499*7c478bd9Sstevel@tonic-gate
500*7c478bd9Sstevel@tonic-gate	my $prof_fh = do { local *FH; *FH };
501*7c478bd9Sstevel@tonic-gate	if (! open($prof_fh, "<$outfile")) {
502*7c478bd9Sstevel@tonic-gate		exiter(nofile($outfile, $!));
503*7c478bd9Sstevel@tonic-gate	}
504*7c478bd9Sstevel@tonic-gate	my ($app, $caller, $lib, $sym);
505*7c478bd9Sstevel@tonic-gate	while (<$prof_fh>) {
506*7c478bd9Sstevel@tonic-gate		next if (/^\s*#/);
507*7c478bd9Sstevel@tonic-gate		next if (/^\s*$/);
508*7c478bd9Sstevel@tonic-gate		chop;
509*7c478bd9Sstevel@tonic-gate		($app, $caller, $lib, $sym) = split(/\|/, $_, 4);
510*7c478bd9Sstevel@tonic-gate		next unless ($caller eq '*DIRECT*');
511*7c478bd9Sstevel@tonic-gate		$direct_syms .= "$sym\n";
512*7c478bd9Sstevel@tonic-gate	}
513*7c478bd9Sstevel@tonic-gate	close($prof_fh);
514*7c478bd9Sstevel@tonic-gate
515*7c478bd9Sstevel@tonic-gate	return $direct_syms;
516*7c478bd9Sstevel@tonic-gate}
517*7c478bd9Sstevel@tonic-gate
518*7c478bd9Sstevel@tonic-gate#
519*7c478bd9Sstevel@tonic-gate# Block to keep export_list private
520*7c478bd9Sstevel@tonic-gate#
521*7c478bd9Sstevel@tonic-gate{
522*7c478bd9Sstevel@tonic-gate	my %export_list = (
523*7c478bd9Sstevel@tonic-gate		'AC_LIB_DIR',		'appcert_lib_dir',
524*7c478bd9Sstevel@tonic-gate		'AC_WORKING_DIR',	'working_dir',
525*7c478bd9Sstevel@tonic-gate		'AC_TMP_DIR',		'tmp_dir',
526*7c478bd9Sstevel@tonic-gate		'AC_BINARY_COUNT',	'binary_count',
527*7c478bd9Sstevel@tonic-gate		'AC_BLOCK_MIN',		'block_min',
528*7c478bd9Sstevel@tonic-gate		'AC_BLOCK_MAX',		'block_max',
529*7c478bd9Sstevel@tonic-gate		'AC_BATCH_REPORT',	'batch_report',
530*7c478bd9Sstevel@tonic-gate	);
531*7c478bd9Sstevel@tonic-gate
532*7c478bd9Sstevel@tonic-gate
533*7c478bd9Sstevel@tonic-gate	#
534*7c478bd9Sstevel@tonic-gate	# Subroutine to read in possibly exported variables
535*7c478bd9Sstevel@tonic-gate	#
536*7c478bd9Sstevel@tonic-gate	sub import_vars_from_environment
537*7c478bd9Sstevel@tonic-gate	{
538*7c478bd9Sstevel@tonic-gate		no strict qw(refs);
539*7c478bd9Sstevel@tonic-gate
540*7c478bd9Sstevel@tonic-gate		while (my ($evar, $pvar) = each(%export_list)) {
541*7c478bd9Sstevel@tonic-gate			$pvar = $export_list{$evar};
542*7c478bd9Sstevel@tonic-gate			if (exists($ENV{$evar})) {
543*7c478bd9Sstevel@tonic-gate				$$pvar = $ENV{$evar};
544*7c478bd9Sstevel@tonic-gate			} else {
545*7c478bd9Sstevel@tonic-gate				$$pvar = '';
546*7c478bd9Sstevel@tonic-gate			}
547*7c478bd9Sstevel@tonic-gate		}
548*7c478bd9Sstevel@tonic-gate	}
549*7c478bd9Sstevel@tonic-gate
550*7c478bd9Sstevel@tonic-gate	#
551*7c478bd9Sstevel@tonic-gate	# Exports the variables in %export_list to the environment.
552*7c478bd9Sstevel@tonic-gate	#
553*7c478bd9Sstevel@tonic-gate	sub export_vars_to_environment
554*7c478bd9Sstevel@tonic-gate	{
555*7c478bd9Sstevel@tonic-gate		my $pval;
556*7c478bd9Sstevel@tonic-gate		no strict qw(refs);
557*7c478bd9Sstevel@tonic-gate
558*7c478bd9Sstevel@tonic-gate		while (my ($evar, $pvar) = each(%export_list)) {
559*7c478bd9Sstevel@tonic-gate			$pvar = $export_list{$evar};
560*7c478bd9Sstevel@tonic-gate			$pval = $$pvar;
561*7c478bd9Sstevel@tonic-gate			if (defined($pval)) {
562*7c478bd9Sstevel@tonic-gate				$ENV{$evar} = $pval;
563*7c478bd9Sstevel@tonic-gate			}
564*7c478bd9Sstevel@tonic-gate		}
565*7c478bd9Sstevel@tonic-gate	}
566*7c478bd9Sstevel@tonic-gate}
567*7c478bd9Sstevel@tonic-gate
568*7c478bd9Sstevel@tonic-gate#
569*7c478bd9Sstevel@tonic-gate# Routine for turning on or off LC_ALL environment variable 'C'.  When
570*7c478bd9Sstevel@tonic-gate# we want command output that we will parse we set LC_ALL=C.  On the
571*7c478bd9Sstevel@tonic-gate# other hand, when we want to pass command output to the user we retain
572*7c478bd9Sstevel@tonic-gate# their locale (if any).
573*7c478bd9Sstevel@tonic-gate#
574*7c478bd9Sstevel@tonic-gatesub c_locale
575*7c478bd9Sstevel@tonic-gate{
576*7c478bd9Sstevel@tonic-gate	my ($action) = @_;
577*7c478bd9Sstevel@tonic-gate
578*7c478bd9Sstevel@tonic-gate	#
579*7c478bd9Sstevel@tonic-gate	# example usage:
580*7c478bd9Sstevel@tonic-gate	# 	c_locale(1);
581*7c478bd9Sstevel@tonic-gate	# 	$output = `some_cmd some_args 2>/dev/null`;
582*7c478bd9Sstevel@tonic-gate	# 	c_locale(0);
583*7c478bd9Sstevel@tonic-gate	#
584*7c478bd9Sstevel@tonic-gate
585*7c478bd9Sstevel@tonic-gate	if ($action) {
586*7c478bd9Sstevel@tonic-gate		if (defined($ENV{'LC_ALL'})) {
587*7c478bd9Sstevel@tonic-gate			$LC_ALL = $ENV{'LC_ALL'};
588*7c478bd9Sstevel@tonic-gate		} else {
589*7c478bd9Sstevel@tonic-gate			$LC_ALL = '__UNSET__';
590*7c478bd9Sstevel@tonic-gate		}
591*7c478bd9Sstevel@tonic-gate		$ENV{'LC_ALL'} = 'C';
592*7c478bd9Sstevel@tonic-gate	} else {
593*7c478bd9Sstevel@tonic-gate		if ($LC_ALL eq '__UNSET__') {
594*7c478bd9Sstevel@tonic-gate			delete $ENV{'LC_ALL'};
595*7c478bd9Sstevel@tonic-gate		} else {
596*7c478bd9Sstevel@tonic-gate			$ENV{'LC_ALL'} = $LC_ALL;
597*7c478bd9Sstevel@tonic-gate		}
598*7c478bd9Sstevel@tonic-gate	}
599*7c478bd9Sstevel@tonic-gate}
600*7c478bd9Sstevel@tonic-gate
601*7c478bd9Sstevel@tonic-gate#
602*7c478bd9Sstevel@tonic-gate# Set or get the overall appcert result/return code.
603*7c478bd9Sstevel@tonic-gate#
604*7c478bd9Sstevel@tonic-gatesub overall_result_code
605*7c478bd9Sstevel@tonic-gate{
606*7c478bd9Sstevel@tonic-gate	my ($val) = @_;
607*7c478bd9Sstevel@tonic-gate	#
608*7c478bd9Sstevel@tonic-gate	# The code has significance (see below) and is the numerical
609*7c478bd9Sstevel@tonic-gate	# exit() code for the appcert script.
610*7c478bd9Sstevel@tonic-gate	#
611*7c478bd9Sstevel@tonic-gate	# Code can be number followed by 1-line description.
612*7c478bd9Sstevel@tonic-gate	#
613*7c478bd9Sstevel@tonic-gate	# 0	appcert completed OK and ZERO binaries had problems detected
614*7c478bd9Sstevel@tonic-gate	#                            and ZERO binaries had "warnings".
615*7c478bd9Sstevel@tonic-gate	# 1	appcert failed somehow
616*7c478bd9Sstevel@tonic-gate	# 2	appcert completed OK and SOME binaries had problems detected.
617*7c478bd9Sstevel@tonic-gate	# 3	appcert completed OK and ZERO binaries had problems detected.
618*7c478bd9Sstevel@tonic-gate	#                            and SOME binaries had "warnings".
619*7c478bd9Sstevel@tonic-gate	#
620*7c478bd9Sstevel@tonic-gate	# When called with a no arguments, only the number is returned.
621*7c478bd9Sstevel@tonic-gate	# When called with a non-null argument it is written to the rc file.
622*7c478bd9Sstevel@tonic-gate	#
623*7c478bd9Sstevel@tonic-gate
624*7c478bd9Sstevel@tonic-gate	my ($return_code_file, $line);
625*7c478bd9Sstevel@tonic-gate
626*7c478bd9Sstevel@tonic-gate	$return_code_file = "$working_dir/ResultCode";
627*7c478bd9Sstevel@tonic-gate
628*7c478bd9Sstevel@tonic-gate	my $rc_file_fh = do { local *FH; *FH };
629*7c478bd9Sstevel@tonic-gate	if (! defined($val)) {
630*7c478bd9Sstevel@tonic-gate		if (! -f $return_code_file) {
631*7c478bd9Sstevel@tonic-gate			emsg("%s", nofile($return_code_file));
632*7c478bd9Sstevel@tonic-gate			return 1;
633*7c478bd9Sstevel@tonic-gate		}
634*7c478bd9Sstevel@tonic-gate		open($rc_file_fh, "<$return_code_file") ||
635*7c478bd9Sstevel@tonic-gate		    exiter(nofile($return_code_file, $!));
636*7c478bd9Sstevel@tonic-gate		chomp($line = <$rc_file_fh>);
637*7c478bd9Sstevel@tonic-gate		close($rc_file_fh);
638*7c478bd9Sstevel@tonic-gate		if ($line =~ /^(\d+)/) {
639*7c478bd9Sstevel@tonic-gate			return $1;
640*7c478bd9Sstevel@tonic-gate		} else {
641*7c478bd9Sstevel@tonic-gate			return $line;
642*7c478bd9Sstevel@tonic-gate		}
643*7c478bd9Sstevel@tonic-gate	} else {
644*7c478bd9Sstevel@tonic-gate		$val = trim($val);
645*7c478bd9Sstevel@tonic-gate		if ($val !~ /^\d+/) {
646*7c478bd9Sstevel@tonic-gate			$val = "1 $val";
647*7c478bd9Sstevel@tonic-gate		}
648*7c478bd9Sstevel@tonic-gate		open($rc_file_fh, ">$return_code_file") ||
649*7c478bd9Sstevel@tonic-gate		    exiter(nofile($return_code_file, $!));
650*7c478bd9Sstevel@tonic-gate		print $rc_file_fh $val, "\n";
651*7c478bd9Sstevel@tonic-gate		close($rc_file_fh);
652*7c478bd9Sstevel@tonic-gate		return;
653*7c478bd9Sstevel@tonic-gate	}
654*7c478bd9Sstevel@tonic-gate}
655*7c478bd9Sstevel@tonic-gate
656*7c478bd9Sstevel@tonic-gate#
657*7c478bd9Sstevel@tonic-gate# Sorter for strings like: "something 14", sorts on count (number)
658*7c478bd9Sstevel@tonic-gate# first, then by string.
659*7c478bd9Sstevel@tonic-gate#
660*7c478bd9Sstevel@tonic-gatesub sort_on_count
661*7c478bd9Sstevel@tonic-gate{
662*7c478bd9Sstevel@tonic-gate	my $soc_cmp = sub {
663*7c478bd9Sstevel@tonic-gate		my($n1, $n2);
664*7c478bd9Sstevel@tonic-gate		if ($a =~ /(\d+)\s*$/) {
665*7c478bd9Sstevel@tonic-gate			$n1 = $1;
666*7c478bd9Sstevel@tonic-gate		} else {
667*7c478bd9Sstevel@tonic-gate			$n1 = 0;
668*7c478bd9Sstevel@tonic-gate		}
669*7c478bd9Sstevel@tonic-gate		if ($b =~ /(\d+)\s*$/) {
670*7c478bd9Sstevel@tonic-gate			$n2 = $1;
671*7c478bd9Sstevel@tonic-gate		} else {
672*7c478bd9Sstevel@tonic-gate			$n2 = 0;
673*7c478bd9Sstevel@tonic-gate		}
674*7c478bd9Sstevel@tonic-gate
675*7c478bd9Sstevel@tonic-gate		if ($n1 == $n2) {
676*7c478bd9Sstevel@tonic-gate			# if the numbers are "tied", then compare the
677*7c478bd9Sstevel@tonic-gate			# string portion.
678*7c478bd9Sstevel@tonic-gate			$a cmp $b;
679*7c478bd9Sstevel@tonic-gate		} else {
680*7c478bd9Sstevel@tonic-gate			# otherwise compare numerically:
681*7c478bd9Sstevel@tonic-gate			$n2 <=> $n1;
682*7c478bd9Sstevel@tonic-gate		}
683*7c478bd9Sstevel@tonic-gate	};
684*7c478bd9Sstevel@tonic-gate	return sort $soc_cmp @_;
685*7c478bd9Sstevel@tonic-gate}
686*7c478bd9Sstevel@tonic-gate
687*7c478bd9Sstevel@tonic-gate#
688*7c478bd9Sstevel@tonic-gate# Trims leading and trailing whitespace from a string.
689*7c478bd9Sstevel@tonic-gate#
690*7c478bd9Sstevel@tonic-gatesub trim
691*7c478bd9Sstevel@tonic-gate{
692*7c478bd9Sstevel@tonic-gate	my ($x) = @_;
693*7c478bd9Sstevel@tonic-gate	if (! defined($x)) {
694*7c478bd9Sstevel@tonic-gate		return '';
695*7c478bd9Sstevel@tonic-gate	}
696*7c478bd9Sstevel@tonic-gate	$x =~ s/^\s*//;
697*7c478bd9Sstevel@tonic-gate	$x =~ s/\s*$//;
698*7c478bd9Sstevel@tonic-gate	return $x;
699*7c478bd9Sstevel@tonic-gate}
700*7c478bd9Sstevel@tonic-gate
701*7c478bd9Sstevel@tonic-gate#
702*7c478bd9Sstevel@tonic-gate# Prints a line to filehandle or STDOUT.
703*7c478bd9Sstevel@tonic-gate#
704*7c478bd9Sstevel@tonic-gatesub print_line
705*7c478bd9Sstevel@tonic-gate{
706*7c478bd9Sstevel@tonic-gate	my ($fh) = @_;
707*7c478bd9Sstevel@tonic-gate	if (defined($fh)) {
708*7c478bd9Sstevel@tonic-gate		print $fh '-' x 72, "\n";
709*7c478bd9Sstevel@tonic-gate	} else {
710*7c478bd9Sstevel@tonic-gate		print STDOUT '-' x 72, "\n";
711*7c478bd9Sstevel@tonic-gate	}
712*7c478bd9Sstevel@tonic-gate}
713*7c478bd9Sstevel@tonic-gate
714*7c478bd9Sstevel@tonic-gate#
715*7c478bd9Sstevel@tonic-gate# Returns formatted output of list items that fit in 80 columns, e.g.
716*7c478bd9Sstevel@tonic-gate# Gelf_got_title 1            Gelf_reloc_entry 1
717*7c478bd9Sstevel@tonic-gate# Gelf_ver_def_print 1        Gelf_syminfo_entry_title 1
718*7c478bd9Sstevel@tonic-gate# Gelf_sym_table_title 1      Gelf_elf_header 1
719*7c478bd9Sstevel@tonic-gate#
720*7c478bd9Sstevel@tonic-gatesub list_format
721*7c478bd9Sstevel@tonic-gate{
722*7c478bd9Sstevel@tonic-gate	my ($indent, @list) = @_;
723*7c478bd9Sstevel@tonic-gate
724*7c478bd9Sstevel@tonic-gate	# $indent is a string which shifts everything over to the right.
725*7c478bd9Sstevel@tonic-gate
726*7c478bd9Sstevel@tonic-gate	my $width = 0;
727*7c478bd9Sstevel@tonic-gate	my ($item, $len, $space);
728*7c478bd9Sstevel@tonic-gate
729*7c478bd9Sstevel@tonic-gate	foreach $item (@list) {		# find the widest list item.
730*7c478bd9Sstevel@tonic-gate		$len = length($item);
731*7c478bd9Sstevel@tonic-gate		$width = $len if ($len > $width);
732*7c478bd9Sstevel@tonic-gate	}
733*7c478bd9Sstevel@tonic-gate	$width += 2;			# pad 2 spaces for each column.
734*7c478bd9Sstevel@tonic-gate
735*7c478bd9Sstevel@tonic-gate	if ($width > (80 - length($indent))) {
736*7c478bd9Sstevel@tonic-gate		$width = 80 - length($indent);
737*7c478bd9Sstevel@tonic-gate	}
738*7c478bd9Sstevel@tonic-gate
739*7c478bd9Sstevel@tonic-gate	# compute number of columns:
740*7c478bd9Sstevel@tonic-gate	my $columns = int((80 - length($indent))/$width);
741*7c478bd9Sstevel@tonic-gate
742*7c478bd9Sstevel@tonic-gate	# initialize:
743*7c478bd9Sstevel@tonic-gate	my $current_column = 0;
744*7c478bd9Sstevel@tonic-gate	my $text = $indent;
745*7c478bd9Sstevel@tonic-gate
746*7c478bd9Sstevel@tonic-gate	# put the items into lined up columns:
747*7c478bd9Sstevel@tonic-gate	foreach $item (@list) {
748*7c478bd9Sstevel@tonic-gate		if ($current_column >= $columns) {
749*7c478bd9Sstevel@tonic-gate			$text .= "\n";
750*7c478bd9Sstevel@tonic-gate			$current_column = 0;
751*7c478bd9Sstevel@tonic-gate			$text .= $indent;
752*7c478bd9Sstevel@tonic-gate		}
753*7c478bd9Sstevel@tonic-gate		$space = $width - length($item);
754*7c478bd9Sstevel@tonic-gate		$text .= $item . ' ' x $space if ($space > 0);
755*7c478bd9Sstevel@tonic-gate		$current_column++;
756*7c478bd9Sstevel@tonic-gate	}
757*7c478bd9Sstevel@tonic-gate	$text .= "\n" if ($current_column);
758*7c478bd9Sstevel@tonic-gate
759*7c478bd9Sstevel@tonic-gate	return $text;
760*7c478bd9Sstevel@tonic-gate}
761*7c478bd9Sstevel@tonic-gate
762*7c478bd9Sstevel@tonic-gate#
763*7c478bd9Sstevel@tonic-gate# Wrapper for STDERR messages.
764*7c478bd9Sstevel@tonic-gate#
765*7c478bd9Sstevel@tonic-gatesub emsg
766*7c478bd9Sstevel@tonic-gate{
767*7c478bd9Sstevel@tonic-gate	printf STDERR @_;
768*7c478bd9Sstevel@tonic-gate}
769*7c478bd9Sstevel@tonic-gate
770*7c478bd9Sstevel@tonic-gate#
771*7c478bd9Sstevel@tonic-gate# Wrapper for STDOUT messages.
772*7c478bd9Sstevel@tonic-gate#
773*7c478bd9Sstevel@tonic-gatesub pmsg
774*7c478bd9Sstevel@tonic-gate{
775*7c478bd9Sstevel@tonic-gate	printf STDOUT @_;
776*7c478bd9Sstevel@tonic-gate}
777*7c478bd9Sstevel@tonic-gate
778*7c478bd9Sstevel@tonic-gate#
779*7c478bd9Sstevel@tonic-gate# Error message for a failed file open.
780*7c478bd9Sstevel@tonic-gate#
781*7c478bd9Sstevel@tonic-gatesub nofile
782*7c478bd9Sstevel@tonic-gate{
783*7c478bd9Sstevel@tonic-gate	my $msg = "$command_name: ";
784*7c478bd9Sstevel@tonic-gate	$msg .= gettext("cannot open file: %s\n");
785*7c478bd9Sstevel@tonic-gate	$msg = sprintf($msg, join(' ', @_));
786*7c478bd9Sstevel@tonic-gate
787*7c478bd9Sstevel@tonic-gate	return $msg;
788*7c478bd9Sstevel@tonic-gate}
789*7c478bd9Sstevel@tonic-gate
790*7c478bd9Sstevel@tonic-gate#
791*7c478bd9Sstevel@tonic-gate# Error message for an invalid file path.
792*7c478bd9Sstevel@tonic-gate#
793*7c478bd9Sstevel@tonic-gatesub nopathexist
794*7c478bd9Sstevel@tonic-gate{
795*7c478bd9Sstevel@tonic-gate	my $msg = "$command_name: ";
796*7c478bd9Sstevel@tonic-gate	$msg .= gettext("path does not exist: %s\n");
797*7c478bd9Sstevel@tonic-gate	$msg = sprintf($msg, join(' ', @_));
798*7c478bd9Sstevel@tonic-gate
799*7c478bd9Sstevel@tonic-gate	return $msg;
800*7c478bd9Sstevel@tonic-gate}
801*7c478bd9Sstevel@tonic-gate
802*7c478bd9Sstevel@tonic-gate#
803*7c478bd9Sstevel@tonic-gate# Error message for a failed running of a command.
804*7c478bd9Sstevel@tonic-gate#
805*7c478bd9Sstevel@tonic-gatesub norunprog
806*7c478bd9Sstevel@tonic-gate{
807*7c478bd9Sstevel@tonic-gate	my $msg = "$command_name: ";
808*7c478bd9Sstevel@tonic-gate	$msg .= gettext("cannot run program: %s\n");
809*7c478bd9Sstevel@tonic-gate	$msg = sprintf($msg, join(' ', @_));
810*7c478bd9Sstevel@tonic-gate
811*7c478bd9Sstevel@tonic-gate	return $msg;
812*7c478bd9Sstevel@tonic-gate}
813*7c478bd9Sstevel@tonic-gate
814*7c478bd9Sstevel@tonic-gate#
815*7c478bd9Sstevel@tonic-gate# Error message for a failed directory creation.
816*7c478bd9Sstevel@tonic-gate#
817*7c478bd9Sstevel@tonic-gatesub nocreatedir
818*7c478bd9Sstevel@tonic-gate{
819*7c478bd9Sstevel@tonic-gate	my $msg = "$command_name: ";
820*7c478bd9Sstevel@tonic-gate	$msg .= gettext("cannot create directory: %s\n");
821*7c478bd9Sstevel@tonic-gate	$msg = sprintf($msg, join(' ', @_));
822*7c478bd9Sstevel@tonic-gate
823*7c478bd9Sstevel@tonic-gate	return $msg;
824*7c478bd9Sstevel@tonic-gate}
825*7c478bd9Sstevel@tonic-gate
826*7c478bd9Sstevel@tonic-gate#
827*7c478bd9Sstevel@tonic-gate# Error message for a failed directory opendir.
828*7c478bd9Sstevel@tonic-gate#
829*7c478bd9Sstevel@tonic-gatesub nodir
830*7c478bd9Sstevel@tonic-gate{
831*7c478bd9Sstevel@tonic-gate	my $msg = "$command_name: ";
832*7c478bd9Sstevel@tonic-gate	$msg .= gettext("cannot open directory: %s\n");
833*7c478bd9Sstevel@tonic-gate	$msg = sprintf($msg, join(' ', @_));
834*7c478bd9Sstevel@tonic-gate
835*7c478bd9Sstevel@tonic-gate	return $msg;
836*7c478bd9Sstevel@tonic-gate}
837*7c478bd9Sstevel@tonic-gate
838*7c478bd9Sstevel@tonic-gate#
839*7c478bd9Sstevel@tonic-gate# exiter routine wrapper is used primarily to abort.  Calls
840*7c478bd9Sstevel@tonic-gate# clean_up_exit() routine if that routine is defined.  Prints $msg to
841*7c478bd9Sstevel@tonic-gate# STDERR and exits with exit code $status $status is 1 (aborted command)
842*7c478bd9Sstevel@tonic-gate# by default.
843*7c478bd9Sstevel@tonic-gate#
844*7c478bd9Sstevel@tonic-gatesub exiter
845*7c478bd9Sstevel@tonic-gate{
846*7c478bd9Sstevel@tonic-gate	my ($msg, $status) = @_;
847*7c478bd9Sstevel@tonic-gate
848*7c478bd9Sstevel@tonic-gate	if (defined($msg) && ! defined($status) && $msg =~ /^\d+$/) {
849*7c478bd9Sstevel@tonic-gate		$status = $msg;
850*7c478bd9Sstevel@tonic-gate		undef($msg);
851*7c478bd9Sstevel@tonic-gate	}
852*7c478bd9Sstevel@tonic-gate	if (! defined($status)) {
853*7c478bd9Sstevel@tonic-gate		$status = 1;
854*7c478bd9Sstevel@tonic-gate	}
855*7c478bd9Sstevel@tonic-gate
856*7c478bd9Sstevel@tonic-gate	if (defined($msg)) {
857*7c478bd9Sstevel@tonic-gate		#
858*7c478bd9Sstevel@tonic-gate		# append a newline unless one is already there or string
859*7c478bd9Sstevel@tonic-gate		# is empty:
860*7c478bd9Sstevel@tonic-gate		#
861*7c478bd9Sstevel@tonic-gate		$msg .= "\n" unless ($msg eq '' || $msg =~ /\n$/);
862*7c478bd9Sstevel@tonic-gate		emsg($msg);
863*7c478bd9Sstevel@tonic-gate	}
864*7c478bd9Sstevel@tonic-gate	if (defined($clean_up_exit_routine)) {
865*7c478bd9Sstevel@tonic-gate		&$clean_up_exit_routine($status);
866*7c478bd9Sstevel@tonic-gate	}
867*7c478bd9Sstevel@tonic-gate
868*7c478bd9Sstevel@tonic-gate	exit $status;
869*7c478bd9Sstevel@tonic-gate}
870*7c478bd9Sstevel@tonic-gate
871*7c478bd9Sstevel@tonic-gatesub set_clean_up_exit_routine
872*7c478bd9Sstevel@tonic-gate{
873*7c478bd9Sstevel@tonic-gate	my($code_ref) = @_;
874*7c478bd9Sstevel@tonic-gate	$clean_up_exit_routine = $code_ref;
875*7c478bd9Sstevel@tonic-gate}
876*7c478bd9Sstevel@tonic-gate
877*7c478bd9Sstevel@tonic-gate#
878*7c478bd9Sstevel@tonic-gate# Generic routine for setting up signal handling.  (usually just a clean
879*7c478bd9Sstevel@tonic-gate# up and exit routine).
880*7c478bd9Sstevel@tonic-gate#
881*7c478bd9Sstevel@tonic-gate# Call with mode 'on' and the name of the handler subroutine.
882*7c478bd9Sstevel@tonic-gate# Call with mode 'off' to set signal handling back to defaults
883*7c478bd9Sstevel@tonic-gate# (e.g. a handler wants to call signals('off')).
884*7c478bd9Sstevel@tonic-gate# Call it with 'ignore' to set them to ignore.
885*7c478bd9Sstevel@tonic-gate#
886*7c478bd9Sstevel@tonic-gatesub signals
887*7c478bd9Sstevel@tonic-gate{
888*7c478bd9Sstevel@tonic-gate	my ($mode, $handler) = @_;
889*7c478bd9Sstevel@tonic-gate
890*7c478bd9Sstevel@tonic-gate	# List of general signals to handle:
891*7c478bd9Sstevel@tonic-gate	my (@sigs) = qw(INT QUIT);
892*7c478bd9Sstevel@tonic-gate
893*7c478bd9Sstevel@tonic-gate	my $sig;
894*7c478bd9Sstevel@tonic-gate
895*7c478bd9Sstevel@tonic-gate	# Loop through signals and set the %SIG array accordingly.
896*7c478bd9Sstevel@tonic-gate
897*7c478bd9Sstevel@tonic-gate	if ($mode eq 'on') {
898*7c478bd9Sstevel@tonic-gate		foreach $sig (@sigs) {
899*7c478bd9Sstevel@tonic-gate			$SIG{$sig} = $handler;
900*7c478bd9Sstevel@tonic-gate		}
901*7c478bd9Sstevel@tonic-gate	} elsif ($mode eq 'off') {
902*7c478bd9Sstevel@tonic-gate		foreach $sig (@sigs) {
903*7c478bd9Sstevel@tonic-gate			$SIG{$sig} = 'DEFAULT';
904*7c478bd9Sstevel@tonic-gate		}
905*7c478bd9Sstevel@tonic-gate	} elsif ($mode eq 'ignore') {
906*7c478bd9Sstevel@tonic-gate		foreach $sig (@sigs) {
907*7c478bd9Sstevel@tonic-gate			$SIG{$sig} = 'IGNORE';
908*7c478bd9Sstevel@tonic-gate		}
909*7c478bd9Sstevel@tonic-gate	}
910*7c478bd9Sstevel@tonic-gate}
911*7c478bd9Sstevel@tonic-gate
912*7c478bd9Sstevel@tonic-gate#
913*7c478bd9Sstevel@tonic-gate# Creates a temporary directory with a unique name.  Directory is
914*7c478bd9Sstevel@tonic-gate# created and the directory name is return.  On failure to create it,
915*7c478bd9Sstevel@tonic-gate# null string is returned.
916*7c478bd9Sstevel@tonic-gate#
917*7c478bd9Sstevel@tonic-gatesub create_tmp_dir
918*7c478bd9Sstevel@tonic-gate{
919*7c478bd9Sstevel@tonic-gate	my ($basedir) = @_;
920*7c478bd9Sstevel@tonic-gate	#
921*7c478bd9Sstevel@tonic-gate	# If passed a prefix in $prefix, try to create a unique tmp dir
922*7c478bd9Sstevel@tonic-gate	# with that basedir. Otherwise, it will make a name in /tmp.
923*7c478bd9Sstevel@tonic-gate	#
924*7c478bd9Sstevel@tonic-gate	# If passed a directory that already exists, a subdir is created
925*7c478bd9Sstevel@tonic-gate	# with madeup basename "prefix.suffix"
926*7c478bd9Sstevel@tonic-gate	#
927*7c478bd9Sstevel@tonic-gate
928*7c478bd9Sstevel@tonic-gate	my $cmd = $command_name;
929*7c478bd9Sstevel@tonic-gate	$cmd = 'tempdir' unless (defined($cmd) && $cmd ne '');
930*7c478bd9Sstevel@tonic-gate
931*7c478bd9Sstevel@tonic-gate	if (! defined($basedir) || ! -d $basedir) {
932*7c478bd9Sstevel@tonic-gate		$basedir = "/tmp/$cmd";
933*7c478bd9Sstevel@tonic-gate	} else {
934*7c478bd9Sstevel@tonic-gate		$basedir = "$basedir/$cmd";
935*7c478bd9Sstevel@tonic-gate	}
936*7c478bd9Sstevel@tonic-gate
937*7c478bd9Sstevel@tonic-gate	my $suffix = $$;
938*7c478bd9Sstevel@tonic-gate	if ($tmp_dir_count) {
939*7c478bd9Sstevel@tonic-gate		$suffix .= ".$tmp_dir_count";
940*7c478bd9Sstevel@tonic-gate	}
941*7c478bd9Sstevel@tonic-gate	my $dir = "$basedir.$suffix";
942*7c478bd9Sstevel@tonic-gate	$tmp_dir_count++;
943*7c478bd9Sstevel@tonic-gate	if ($dir =~ m,^/tmp/,) {
944*7c478bd9Sstevel@tonic-gate		if (! mkpath($dir, 0, 0700) || ! -d $dir) {
945*7c478bd9Sstevel@tonic-gate			emsg("%s", nocreatedir($dir, $!));
946*7c478bd9Sstevel@tonic-gate			return '';
947*7c478bd9Sstevel@tonic-gate		}
948*7c478bd9Sstevel@tonic-gate	} else {
949*7c478bd9Sstevel@tonic-gate		if (! mkpath($dir) || ! -d $dir) {
950*7c478bd9Sstevel@tonic-gate			emsg("%s", nocreatedir($dir, $!));
951*7c478bd9Sstevel@tonic-gate			return '';
952*7c478bd9Sstevel@tonic-gate		}
953*7c478bd9Sstevel@tonic-gate	}
954*7c478bd9Sstevel@tonic-gate	return $dir;
955*7c478bd9Sstevel@tonic-gate}
956*7c478bd9Sstevel@tonic-gate
957*7c478bd9Sstevel@tonic-gate#
958*7c478bd9Sstevel@tonic-gate# Checks to see if a directory is empty.  Returns 1 if the directory is.
959*7c478bd9Sstevel@tonic-gate# returns 0 if it is not or if directory does not exist.
960*7c478bd9Sstevel@tonic-gate#
961*7c478bd9Sstevel@tonic-gatesub dir_is_empty
962*7c478bd9Sstevel@tonic-gate{
963*7c478bd9Sstevel@tonic-gate	my ($dir) = @_;
964*7c478bd9Sstevel@tonic-gate
965*7c478bd9Sstevel@tonic-gate	return 0 if (! -d $dir);
966*7c478bd9Sstevel@tonic-gate
967*7c478bd9Sstevel@tonic-gate	my $is_empty = 1;
968*7c478bd9Sstevel@tonic-gate
969*7c478bd9Sstevel@tonic-gate	my $dir_is_empty_dh = do { local *FH; *FH };
970*7c478bd9Sstevel@tonic-gate	if (opendir($dir_is_empty_dh, $dir)) {
971*7c478bd9Sstevel@tonic-gate		my $subdir;
972*7c478bd9Sstevel@tonic-gate		foreach $subdir (readdir($dir_is_empty_dh)) {
973*7c478bd9Sstevel@tonic-gate			if ($subdir ne '.' && $subdir ne '..') {
974*7c478bd9Sstevel@tonic-gate				$is_empty = 0;
975*7c478bd9Sstevel@tonic-gate				last;
976*7c478bd9Sstevel@tonic-gate			}
977*7c478bd9Sstevel@tonic-gate		}
978*7c478bd9Sstevel@tonic-gate		close($dir_is_empty_dh);
979*7c478bd9Sstevel@tonic-gate	} else {
980*7c478bd9Sstevel@tonic-gate		return 0;
981*7c478bd9Sstevel@tonic-gate	}
982*7c478bd9Sstevel@tonic-gate
983*7c478bd9Sstevel@tonic-gate	return $is_empty;
984*7c478bd9Sstevel@tonic-gate}
985*7c478bd9Sstevel@tonic-gate
986*7c478bd9Sstevel@tonic-gate#
987*7c478bd9Sstevel@tonic-gate# Follows a symbolic link until it points to a non-symbolic link.  If
988*7c478bd9Sstevel@tonic-gate# $file is not a symlink but rather a file, returns $file.  Returns null
989*7c478bd9Sstevel@tonic-gate# if what is pointed to does not exist.
990*7c478bd9Sstevel@tonic-gate#
991*7c478bd9Sstevel@tonic-gatesub follow_symlink
992*7c478bd9Sstevel@tonic-gate{
993*7c478bd9Sstevel@tonic-gate	my ($file) = @_;
994*7c478bd9Sstevel@tonic-gate
995*7c478bd9Sstevel@tonic-gate	if (! -e $file) {
996*7c478bd9Sstevel@tonic-gate		# We will never find anything:
997*7c478bd9Sstevel@tonic-gate		return '';
998*7c478bd9Sstevel@tonic-gate	}
999*7c478bd9Sstevel@tonic-gate
1000*7c478bd9Sstevel@tonic-gate	if (! -l $file) {
1001*7c478bd9Sstevel@tonic-gate		# Not a symlink:
1002*7c478bd9Sstevel@tonic-gate		return $file;
1003*7c478bd9Sstevel@tonic-gate	}
1004*7c478bd9Sstevel@tonic-gate
1005*7c478bd9Sstevel@tonic-gate	my ($tmp1, $tmp2);
1006*7c478bd9Sstevel@tonic-gate
1007*7c478bd9Sstevel@tonic-gate	$tmp1 = $file;
1008*7c478bd9Sstevel@tonic-gate
1009*7c478bd9Sstevel@tonic-gate	while ($tmp2 = readlink($tmp1)) {
1010*7c478bd9Sstevel@tonic-gate
1011*7c478bd9Sstevel@tonic-gate		if ($tmp2 !~ m,^/,) {
1012*7c478bd9Sstevel@tonic-gate			$tmp2 = dirname($tmp1) . "/" . $tmp2;
1013*7c478bd9Sstevel@tonic-gate		}
1014*7c478bd9Sstevel@tonic-gate
1015*7c478bd9Sstevel@tonic-gate		$tmp1 = $tmp2;			#
1016*7c478bd9Sstevel@tonic-gate		$tmp1 =~ s,/+,/,g;		# get rid of ////
1017*7c478bd9Sstevel@tonic-gate		$tmp1 =~ s,^\./,,g;		# remove leading ./
1018*7c478bd9Sstevel@tonic-gate		$tmp1 =~ s,/\./,/,g;		# remove /./
1019*7c478bd9Sstevel@tonic-gate		$tmp1 =~ s,/+,/,g;		# get rid of //// again
1020*7c478bd9Sstevel@tonic-gate		$tmp1 =~ s,/[^/]+/\.\./,/,g;	# remove "abc/.."
1021*7c478bd9Sstevel@tonic-gate						#
1022*7c478bd9Sstevel@tonic-gate
1023*7c478bd9Sstevel@tonic-gate		if (! -e $tmp1) {
1024*7c478bd9Sstevel@tonic-gate			$tmp1 = $tmp2;
1025*7c478bd9Sstevel@tonic-gate		}
1026*7c478bd9Sstevel@tonic-gate		if (! -e $tmp1) {
1027*7c478bd9Sstevel@tonic-gate			return '';
1028*7c478bd9Sstevel@tonic-gate		}
1029*7c478bd9Sstevel@tonic-gate	}
1030*7c478bd9Sstevel@tonic-gate
1031*7c478bd9Sstevel@tonic-gate	return $tmp1;
1032*7c478bd9Sstevel@tonic-gate}
1033*7c478bd9Sstevel@tonic-gate
1034*7c478bd9Sstevel@tonic-gate#
1035*7c478bd9Sstevel@tonic-gate# Examines if the file is statically linked.  Can be called on any file,
1036*7c478bd9Sstevel@tonic-gate# but it is preferable to run it on things known to be executables or
1037*7c478bd9Sstevel@tonic-gate# libraries.
1038*7c478bd9Sstevel@tonic-gate#
1039*7c478bd9Sstevel@tonic-gate# Returns 0 if not statically linked. Otherwise, returns 1.
1040*7c478bd9Sstevel@tonic-gate#
1041*7c478bd9Sstevel@tonic-gatesub is_statically_linked
1042*7c478bd9Sstevel@tonic-gate{
1043*7c478bd9Sstevel@tonic-gate	my ($file) = @_;
1044*7c478bd9Sstevel@tonic-gate
1045*7c478bd9Sstevel@tonic-gate	my $tmp;
1046*7c478bd9Sstevel@tonic-gate	my $file_cmd_output;
1047*7c478bd9Sstevel@tonic-gate	$file_cmd_output = cmd_output_file($file);
1048*7c478bd9Sstevel@tonic-gate
1049*7c478bd9Sstevel@tonic-gate	if ($file_cmd_output eq '') {
1050*7c478bd9Sstevel@tonic-gate		return 1;
1051*7c478bd9Sstevel@tonic-gate	}
1052*7c478bd9Sstevel@tonic-gate
1053*7c478bd9Sstevel@tonic-gate	if ($file_cmd_output =~ /[:\s](.*)$/) {
1054*7c478bd9Sstevel@tonic-gate		$tmp = $1;
1055*7c478bd9Sstevel@tonic-gate		if ($tmp =~ /ELF.*statically linked/) {
1056*7c478bd9Sstevel@tonic-gate			return 1;
1057*7c478bd9Sstevel@tonic-gate		} elsif ($tmp =~ /Sun demand paged/) {
1058*7c478bd9Sstevel@tonic-gate			if ($tmp !~ /dynamically linked/) {
1059*7c478bd9Sstevel@tonic-gate				return 1;
1060*7c478bd9Sstevel@tonic-gate			}
1061*7c478bd9Sstevel@tonic-gate		}
1062*7c478bd9Sstevel@tonic-gate	}
1063*7c478bd9Sstevel@tonic-gate
1064*7c478bd9Sstevel@tonic-gate	return 0;
1065*7c478bd9Sstevel@tonic-gate}
1066*7c478bd9Sstevel@tonic-gate
1067*7c478bd9Sstevel@tonic-gate#
1068*7c478bd9Sstevel@tonic-gate# Examines first 4 bytes of file.  Returns 1 if they are "\x7fELF".
1069*7c478bd9Sstevel@tonic-gate# Otherwise, returns 0.
1070*7c478bd9Sstevel@tonic-gate#
1071*7c478bd9Sstevel@tonic-gatesub is_elf
1072*7c478bd9Sstevel@tonic-gate{
1073*7c478bd9Sstevel@tonic-gate	my ($file) = @_;
1074*7c478bd9Sstevel@tonic-gate
1075*7c478bd9Sstevel@tonic-gate	my ($buf, $n);
1076*7c478bd9Sstevel@tonic-gate	my $cmp = "\x7fELF";
1077*7c478bd9Sstevel@tonic-gate	if (! -r $file) {
1078*7c478bd9Sstevel@tonic-gate		return 0;
1079*7c478bd9Sstevel@tonic-gate	}
1080*7c478bd9Sstevel@tonic-gate
1081*7c478bd9Sstevel@tonic-gate	my $is_elf_fh = do { local *FH; *FH };
1082*7c478bd9Sstevel@tonic-gate	if (open($is_elf_fh, "<$file")) {
1083*7c478bd9Sstevel@tonic-gate		$n = read($is_elf_fh, $buf, 4);
1084*7c478bd9Sstevel@tonic-gate		close($is_elf_fh);
1085*7c478bd9Sstevel@tonic-gate		if ($n != 4) {
1086*7c478bd9Sstevel@tonic-gate			return 0;
1087*7c478bd9Sstevel@tonic-gate		}
1088*7c478bd9Sstevel@tonic-gate		if ($buf eq $cmp) {
1089*7c478bd9Sstevel@tonic-gate			return 1;
1090*7c478bd9Sstevel@tonic-gate		}
1091*7c478bd9Sstevel@tonic-gate	}
1092*7c478bd9Sstevel@tonic-gate	return 0;
1093*7c478bd9Sstevel@tonic-gate}
1094*7c478bd9Sstevel@tonic-gate
1095*7c478bd9Sstevel@tonic-gate#
1096*7c478bd9Sstevel@tonic-gate# Returns 1 if $file is a shared object (i.e. ELF shared library)
1097*7c478bd9Sstevel@tonic-gate# Returns 0 if it is not.
1098*7c478bd9Sstevel@tonic-gate#
1099*7c478bd9Sstevel@tonic-gate# Routine uses the dump -Lv output to determine this.  Failing that, it
1100*7c478bd9Sstevel@tonic-gate# examines  the /usr/bin/file output.
1101*7c478bd9Sstevel@tonic-gate#
1102*7c478bd9Sstevel@tonic-gatesub is_shared_object
1103*7c478bd9Sstevel@tonic-gate{
1104*7c478bd9Sstevel@tonic-gate	my ($file) = @_;
1105*7c478bd9Sstevel@tonic-gate
1106*7c478bd9Sstevel@tonic-gate	return 0 unless (-f $file);
1107*7c478bd9Sstevel@tonic-gate
1108*7c478bd9Sstevel@tonic-gate	my ($on, $line, $is_shared_object);
1109*7c478bd9Sstevel@tonic-gate	my ($n, $tag, $val);
1110*7c478bd9Sstevel@tonic-gate
1111*7c478bd9Sstevel@tonic-gate	$on = 0;
1112*7c478bd9Sstevel@tonic-gate	$is_shared_object = 0;
1113*7c478bd9Sstevel@tonic-gate
1114*7c478bd9Sstevel@tonic-gate	foreach $line (split(/\n/, cmd_output_dump($file))) {
1115*7c478bd9Sstevel@tonic-gate
1116*7c478bd9Sstevel@tonic-gate		if ($line =~ /^\[INDEX\]/) {
1117*7c478bd9Sstevel@tonic-gate			$on = 1;
1118*7c478bd9Sstevel@tonic-gate			next;
1119*7c478bd9Sstevel@tonic-gate		}
1120*7c478bd9Sstevel@tonic-gate		next unless ($on);
1121*7c478bd9Sstevel@tonic-gate		($n, $tag, $val) = split(/\s+/, trim($line));
1122*7c478bd9Sstevel@tonic-gate		if ($tag eq "SONAME") {
1123*7c478bd9Sstevel@tonic-gate			$is_shared_object = 1;
1124*7c478bd9Sstevel@tonic-gate			last;
1125*7c478bd9Sstevel@tonic-gate		}
1126*7c478bd9Sstevel@tonic-gate	}
1127*7c478bd9Sstevel@tonic-gate
1128*7c478bd9Sstevel@tonic-gate	if (! $is_shared_object) {
1129*7c478bd9Sstevel@tonic-gate		# If it is ELF, file output will say "dynamic lib":
1130*7c478bd9Sstevel@tonic-gate		$line = cmd_output_file($file);
1131*7c478bd9Sstevel@tonic-gate		if ($line =~ /ELF.* dynamic lib /) {
1132*7c478bd9Sstevel@tonic-gate			$is_shared_object = 1;
1133*7c478bd9Sstevel@tonic-gate		}
1134*7c478bd9Sstevel@tonic-gate	}
1135*7c478bd9Sstevel@tonic-gate
1136*7c478bd9Sstevel@tonic-gate	return $is_shared_object;
1137*7c478bd9Sstevel@tonic-gate}
1138*7c478bd9Sstevel@tonic-gate
1139*7c478bd9Sstevel@tonic-gate#
1140*7c478bd9Sstevel@tonic-gate# Used for the a.out warning in etc.warn.  Examines first 4 bytes of
1141*7c478bd9Sstevel@tonic-gate# file, and returns 1 if SunOS 4.x a.out binary 0 otherwise.
1142*7c478bd9Sstevel@tonic-gate#
1143*7c478bd9Sstevel@tonic-gatesub is_aout
1144*7c478bd9Sstevel@tonic-gate{
1145*7c478bd9Sstevel@tonic-gate	my ($file) = @_;
1146*7c478bd9Sstevel@tonic-gate
1147*7c478bd9Sstevel@tonic-gate	my ($buf, $n);
1148*7c478bd9Sstevel@tonic-gate	my $cmp1 = "\001\013";
1149*7c478bd9Sstevel@tonic-gate	my $cmp2 = "\001\010";
1150*7c478bd9Sstevel@tonic-gate	my $cmp3 = "\001\007";
1151*7c478bd9Sstevel@tonic-gate	if (! -r $file) {
1152*7c478bd9Sstevel@tonic-gate		return 0;
1153*7c478bd9Sstevel@tonic-gate	}
1154*7c478bd9Sstevel@tonic-gate
1155*7c478bd9Sstevel@tonic-gate	my $is_aout_fh = do { local *FH; *FH };
1156*7c478bd9Sstevel@tonic-gate	if (open($is_aout_fh, "<$file")) {
1157*7c478bd9Sstevel@tonic-gate		$n = read($is_aout_fh, $buf, 4);
1158*7c478bd9Sstevel@tonic-gate		close($is_aout_fh);
1159*7c478bd9Sstevel@tonic-gate		if ($n != 4) {
1160*7c478bd9Sstevel@tonic-gate			return 0;
1161*7c478bd9Sstevel@tonic-gate		}
1162*7c478bd9Sstevel@tonic-gate		$buf = substr($buf, 2);
1163*7c478bd9Sstevel@tonic-gate		if ($buf eq $cmp1) {
1164*7c478bd9Sstevel@tonic-gate			return 1;
1165*7c478bd9Sstevel@tonic-gate		}
1166*7c478bd9Sstevel@tonic-gate		if ($buf eq $cmp2) {
1167*7c478bd9Sstevel@tonic-gate			return 1;
1168*7c478bd9Sstevel@tonic-gate		}
1169*7c478bd9Sstevel@tonic-gate		if ($buf eq $cmp3) {
1170*7c478bd9Sstevel@tonic-gate			return 1;
1171*7c478bd9Sstevel@tonic-gate		}
1172*7c478bd9Sstevel@tonic-gate	}
1173*7c478bd9Sstevel@tonic-gate	return 0;
1174*7c478bd9Sstevel@tonic-gate}
1175*7c478bd9Sstevel@tonic-gate
1176*7c478bd9Sstevel@tonic-gate#
1177*7c478bd9Sstevel@tonic-gate# is_suid
1178*7c478bd9Sstevel@tonic-gate# Returns 1 if $file is a set user ID file.
1179*7c478bd9Sstevel@tonic-gate# Returns 2 if $file otherwise is a set group ID (but not suid).
1180*7c478bd9Sstevel@tonic-gate# Returns 0 if it is neither or file does not exist.
1181*7c478bd9Sstevel@tonic-gate#
1182*7c478bd9Sstevel@tonic-gatesub is_suid
1183*7c478bd9Sstevel@tonic-gate{
1184*7c478bd9Sstevel@tonic-gate	my ($file) = @_;
1185*7c478bd9Sstevel@tonic-gate
1186*7c478bd9Sstevel@tonic-gate	return 0 unless (-f $file);
1187*7c478bd9Sstevel@tonic-gate
1188*7c478bd9Sstevel@tonic-gate	my ($mask, $mode, $test);
1189*7c478bd9Sstevel@tonic-gate	my @is_suid_masks = (04000, 02010, 02030, 02050, 02070);
1190*7c478bd9Sstevel@tonic-gate
1191*7c478bd9Sstevel@tonic-gate	$mode = (stat($file))[2];
1192*7c478bd9Sstevel@tonic-gate
1193*7c478bd9Sstevel@tonic-gate	foreach $mask (@is_suid_masks) {
1194*7c478bd9Sstevel@tonic-gate		$test = $mode & $mask;
1195*7c478bd9Sstevel@tonic-gate		if ($test == $mask) {
1196*7c478bd9Sstevel@tonic-gate			if ($mask == $is_suid_masks[0]) {
1197*7c478bd9Sstevel@tonic-gate				return 1;
1198*7c478bd9Sstevel@tonic-gate			} else {
1199*7c478bd9Sstevel@tonic-gate				return 2;
1200*7c478bd9Sstevel@tonic-gate			}
1201*7c478bd9Sstevel@tonic-gate		}
1202*7c478bd9Sstevel@tonic-gate	}
1203*7c478bd9Sstevel@tonic-gate	return 0;
1204*7c478bd9Sstevel@tonic-gate}
1205*7c478bd9Sstevel@tonic-gate
1206*7c478bd9Sstevel@tonic-gate#
1207*7c478bd9Sstevel@tonic-gate# Returns a list of (abi, [ELF|a.out], wordsize, endianness)
1208*7c478bd9Sstevel@tonic-gate#
1209*7c478bd9Sstevel@tonic-gatesub bin_type
1210*7c478bd9Sstevel@tonic-gate{
1211*7c478bd9Sstevel@tonic-gate	my ($filename) = @_;
1212*7c478bd9Sstevel@tonic-gate
1213*7c478bd9Sstevel@tonic-gate	my ($abi, $e_machine, $type, $wordsize, $endian, $rest);
1214*7c478bd9Sstevel@tonic-gate
1215*7c478bd9Sstevel@tonic-gate	$abi		= 'unknown';
1216*7c478bd9Sstevel@tonic-gate	$e_machine	= 'unknown';
1217*7c478bd9Sstevel@tonic-gate	$type		= 'unknown';
1218*7c478bd9Sstevel@tonic-gate	$wordsize	= 'unknown';
1219*7c478bd9Sstevel@tonic-gate	$endian		= 'unknown';
1220*7c478bd9Sstevel@tonic-gate
1221*7c478bd9Sstevel@tonic-gate	# Try to look it up in the $working_dir:
1222*7c478bd9Sstevel@tonic-gate	my $outfile = object_to_dir_name($filename);
1223*7c478bd9Sstevel@tonic-gate	$outfile = "$working_dir/$outfile/info.arch";
1224*7c478bd9Sstevel@tonic-gate
1225*7c478bd9Sstevel@tonic-gate	if (-f $outfile) {
1226*7c478bd9Sstevel@tonic-gate		my $arch_info_fh = do { local *FH; *FH };
1227*7c478bd9Sstevel@tonic-gate		if (open($arch_info_fh, "<$outfile")) {
1228*7c478bd9Sstevel@tonic-gate			while (<$arch_info_fh>) {
1229*7c478bd9Sstevel@tonic-gate				chomp;
1230*7c478bd9Sstevel@tonic-gate				if (/^ARCH:\s*(\S.*)$/) {
1231*7c478bd9Sstevel@tonic-gate					$abi = $1;
1232*7c478bd9Sstevel@tonic-gate				} elsif (/^TYPE:\s*(\S.*)$/) {
1233*7c478bd9Sstevel@tonic-gate					$type = $1;
1234*7c478bd9Sstevel@tonic-gate				} elsif (/^WORDSIZE:\s*(\S.*)$/) {
1235*7c478bd9Sstevel@tonic-gate					$wordsize = $1;
1236*7c478bd9Sstevel@tonic-gate				} elsif (/^BYTEORDER:\s*(\S.*)$/) {
1237*7c478bd9Sstevel@tonic-gate					$endian = $1;
1238*7c478bd9Sstevel@tonic-gate				}
1239*7c478bd9Sstevel@tonic-gate			}
1240*7c478bd9Sstevel@tonic-gate			close($arch_info_fh);
1241*7c478bd9Sstevel@tonic-gate		}
1242*7c478bd9Sstevel@tonic-gate		return ($abi, $type, $wordsize, $endian);
1243*7c478bd9Sstevel@tonic-gate	}
1244*7c478bd9Sstevel@tonic-gate
1245*7c478bd9Sstevel@tonic-gate	# Otherwise, process /usr/bin/file output:
1246*7c478bd9Sstevel@tonic-gate	my $file_output;
1247*7c478bd9Sstevel@tonic-gate	$file_output = cmd_output_file($filename);
1248*7c478bd9Sstevel@tonic-gate
1249*7c478bd9Sstevel@tonic-gate	if ($file_output =~ /Sun demand paged SPARC|pure SPARC/) {
1250*7c478bd9Sstevel@tonic-gate		$type = 'a.out';
1251*7c478bd9Sstevel@tonic-gate		$abi = 'sparc';
1252*7c478bd9Sstevel@tonic-gate		$e_machine = 'SPARC';
1253*7c478bd9Sstevel@tonic-gate		$wordsize = '32';
1254*7c478bd9Sstevel@tonic-gate		$endian = 'MSB';
1255*7c478bd9Sstevel@tonic-gate	} elsif ($file_output =~ /ELF\s+/) {
1256*7c478bd9Sstevel@tonic-gate		$type = 'ELF';
1257*7c478bd9Sstevel@tonic-gate		$rest = $';
1258*7c478bd9Sstevel@tonic-gate		if ($rest =~ /^(\d+)-bit\s+/) {
1259*7c478bd9Sstevel@tonic-gate			$wordsize = $1;
1260*7c478bd9Sstevel@tonic-gate			$rest = $';
1261*7c478bd9Sstevel@tonic-gate		}
1262*7c478bd9Sstevel@tonic-gate		if ($rest =~ /^(LSB|MSB)\s+/) {
1263*7c478bd9Sstevel@tonic-gate			$endian = $1;
1264*7c478bd9Sstevel@tonic-gate			$rest = $';
1265*7c478bd9Sstevel@tonic-gate		}
1266*7c478bd9Sstevel@tonic-gate		if ($rest =~ /SPARC/) {
1267*7c478bd9Sstevel@tonic-gate			if ($rest =~ /\bSPARC\b/) {
1268*7c478bd9Sstevel@tonic-gate				$abi = 'sparc';
1269*7c478bd9Sstevel@tonic-gate				$e_machine = 'SPARC';
1270*7c478bd9Sstevel@tonic-gate			} elsif ($rest =~ /\bSPARC32PLUS\b/) {
1271*7c478bd9Sstevel@tonic-gate				$abi = 'sparc';
1272*7c478bd9