1#!/usr/perl5/bin/perl -w
2#
3# CDDL HEADER START
4#
5# The contents of this file are subject to the terms of the
6# Common Development and Distribution License, Version 1.0 only
7# (the "License").  You may not use this file except in compliance
8# with the License.
9#
10# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
11# or http://www.opensolaris.org/os/licensing.
12# See the License for the specific language governing permissions
13# and limitations under the License.
14#
15# When distributing Covered Code, include this CDDL HEADER in each
16# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
17# If applicable, add the following below this CDDL HEADER, with the
18# fields enclosed by brackets "[]" replaced with your own identifying
19# information: Portions Copyright [yyyy] [name of copyright owner]
20#
21# CDDL HEADER END
22#
23#
24# ident	"%Z%%M%	%I%	%E% SMI"
25#
26# Copyright 2004 Sun Microsystems, Inc.  All rights reserved.
27# Use is subject to license terms.
28#
29
30#
31# This utility program loads the unstable behavior databases, then reads
32# the symprof output for each binary, and record any detected unstable
33# behavior in the binary's output directory.
34#
35
36require 5.005;
37use strict;
38use locale;
39use POSIX qw(locale_h);
40use Sun::Solaris::Utils qw(textdomain gettext);
41use File::Basename;
42use File::Path;
43
44use lib qw(/usr/lib/abi/appcert);
45use AppcertUtil;
46
47setlocale(LC_ALL, "");
48textdomain(TEXT_DOMAIN);
49
50use vars qw(
51	$LIBC
52	$tmp_check_dir
53	$binaries_checked_count
54	$misc_check_databases_loaded_ok
55	%load_model_default
56	%load_error
57	%model_loaded
58	%model
59	%is_system_library_cache
60);
61
62set_clean_up_exit_routine(\&clean_up_exit);
63
64initialize_variables();
65
66import_vars_from_environment();
67
68signals('on', \&interrupted);
69
70set_working_dir();
71
72load_model_index();
73
74check_objects();
75
76clean_up();
77
78exit 0;
79
80#
81# Set up any variables.
82#
83sub initialize_variables
84{
85	# Here is what we call libc:
86	$LIBC = '/usr/lib/libc.so.1';
87}
88
89#
90# working_dir has been imported by import_vars_from_environment()
91# A sanity check is performed here to make sure it exists.
92#
93sub set_working_dir
94{
95	if (! defined($working_dir) || ! -d $working_dir) {
96		exiter("$command_name: " . sprintf(gettext(
97		    "cannot locate working directory: %s\n"), $working_dir));
98	}
99}
100
101#
102# Called when interrupted by a signal.
103#
104sub interrupted
105{
106	$SIG{$_[0]} = 'DEFAULT';
107	signals('off');
108	clean_up_exit(1);
109}
110
111#
112# Does the cleanup then exit with return code $rc.  Note: The utility
113# routine exiter() will call this routine.
114#
115sub clean_up_exit
116{
117	my ($rc) = @_;
118	$rc = 0 unless ($rc);
119
120	clean_up();
121	exit $rc;
122}
123
124#
125# General cleanup activities are placed here.  There may not be an
126# immediate exit after this cleanup.
127#
128sub clean_up
129{
130	if (defined($tmp_check_dir) && -d $tmp_check_dir) {
131		rmtree($tmp_check_dir);
132	}
133}
134
135#
136# Top level routine to initialize databases and then loop over the
137# objects and call the checking routines on each one.
138#
139sub check_objects
140{
141	# Make a tmp dir for the checking work.
142	$tmp_check_dir = create_tmp_dir($tmp_dir);
143
144	if (! -d $tmp_check_dir) {
145		exiter(nocreatedir($tmp_check_dir, $!));
146	}
147
148	emsg("\n" . gettext(
149	    "checking binary objects for unstable practices") . " ...\n\n");
150
151	my ($dir, $path_to_object);
152
153	#
154	# Loop over each object item in the working_dir.
155	#  - $dir will be each one of these object directories.
156	#  - $path_to_object will be the corresponding actual path
157	#    to the the binary to be checked.
158	# Output will be placed down in $dir, e.g. "$dir/check.foo"
159	#
160
161	$binaries_checked_count = 0;
162
163	#
164	# We need to load the Misc Databases to get any modifications to
165	# the symbol database. E.g. gethostname should be public.
166	#
167	$misc_check_databases_loaded_ok = load_misc_check_databases();
168
169	while (defined($dir = next_dir_name())) {
170
171		# Map object output dir to actual path of the object:
172		$path_to_object = dir_name_to_path($dir);
173
174		if (! -f $path_to_object) {
175			exiter(nopathexist($path_to_object, $!));
176		}
177
178		# Check it:
179		emsg(gettext("checking: %s\n"), $path_to_object);
180
181		static_check_object($path_to_object, $dir);
182		dynamic_check_object($path_to_object, $dir);
183	}
184
185	if ($binaries_checked_count == 0) {
186		exiter("$command_name: " . gettext(
187		    "no binary objects where checked."));
188	}
189
190	# Do additional heuristic checks of unstable behavior:
191	perform_misc_checks();
192
193	clean_up();	# Remove any tmp dirs and files.
194}
195
196#
197# Reads in the static profile (i.e. the symbols exported by bin in
198# .text section) and calls the static archive checking routine.
199#
200sub static_check_object
201{
202	my ($path_to_object, $dir) = @_;
203
204	# The profile output file created by static_profile() in symprof.
205
206	my $profile_file = "$dir/profile.static";
207
208	my $err_fmt = gettext(
209	    "binary object %s has no static profile: %s: %s\n");
210	if (! -f $profile_file) {
211		emsg("$command_name: " . $err_fmt, $path_to_object,
212		    $profile_file, $!);
213		return 0;
214	}
215
216	my $profile_fh = do { local *FH; *FH };
217	if (! open($profile_fh, "<$profile_file")) {
218		exiter(nofile($profile_file, $!));
219	}
220
221	my ($profile, $lib, $lib2, $base, %libs_needed);
222
223	my $completely_statically_linked = 0;
224
225	while (<$profile_fh>) {
226		$profile .= $_;
227		if (/^\s*#dtneeded:\s*(.*)$/) {
228			#
229			# record the bare name, e.g. "libc" of the
230			# (direct) dtneededs.
231			#
232			foreach $lib (split(/\s+/, $1)) {
233				next if ($lib eq '');
234				$base = $lib;
235				# record it as libc.so.1 -> libc
236				$base =~ s/\.so\..*$//;
237				$base =~ s/\.so$//;
238				$libs_needed{$base} = $lib;
239				$libs_needed{basename($base)} = $lib;
240			}
241		} elsif (/^\s*#SKIPPED_TEST:\s+STATICALLY_LINKED/) {
242			#
243			# Record statical linking if it takes place
244			# since it indicates to skip the test.
245			#
246			$completely_statically_linked = 1;
247		}
248	}
249	close($profile_fh);
250
251	my $problems = "$dir/check.problems";
252
253	my $problems_fh = do { local *FH; *FH };
254	if (! open($problems_fh, ">>$problems")) {
255		exiter(nofile($problems, $!));
256	}
257
258	if ($completely_statically_linked) {
259		print $problems_fh "STATIC: COMPLETELY_STATIC"  . "\n";
260	}
261
262	my (%saw_lib);
263	if (! defined($profile)) {
264		close($problems_fh);
265		return;
266	}
267	foreach $lib (lib_static_check($profile)) {
268		#
269		# lib_static_check returns a list of statically linked
270		# libraries, however to be on the safe side we will skip
271		# false positives our dtneeded's show they are really
272		# dynamically linked in.
273		#
274
275		next if ($libs_needed{$lib});
276		next if ($libs_needed{basename($lib)});
277		next if ($saw_lib{basename($lib)}++);
278
279		$lib2 = $lib;
280		$lib2 =~ s/\.a$//;
281		next if ($libs_needed{$lib2});
282		next if ($libs_needed{basename($lib2)});
283
284		# Otherwise, record in the problems file:
285		print $problems_fh "STATIC: LINKED_ARCHIVE $lib" . "\n";
286	}
287	close($problems_fh);
288}
289
290#
291# Takes as input the static profile (e.g. the .text symbols) and returns
292# a list of suspected statically linked Solaris archive libraries.
293#
294sub lib_static_check
295{
296	my ($profile) = @_;
297
298	my ($line, $area, $extent, $type, $sym, $obj);
299
300	my (%symbols);
301
302	#
303	# Working on lines like:
304	# /bin/ftp|TEXT|GLOB|FUNC|glob
305	# /bin/ftp|TEXT|GLOB|FUNC|help
306	#
307
308	# First record all the symbols in the TEXT area:
309
310	foreach $line (split(/\n/, $profile)) {
311		next unless ($line =~ /\bTEXT\b/);
312		($obj, $area, $extent, $type, $sym) = split(/\|/, $line);
313
314		$symbols{$sym} = 1;
315	}
316
317	my (@static_libs);
318
319	# Next, check against the library heuristics for static linking:
320
321	# libc.a:
322
323	if (exists($symbols{'_exit'})) {
324		push(@static_libs, "/usr/lib/libc.a");
325	}
326
327	# libsocket.a:
328
329	if (exists($symbols{'socket'}) && exists($symbols{'_socket'}) &&
330	    exists($symbols{'bind'}) && exists($symbols{'_bind'}) &&
331	    exists($symbols{'connect'}) && exists($symbols{'_connect'})) {
332			push(@static_libs, "/usr/lib/libsocket.a");
333	}
334
335	# libnsl.a:
336
337	if (exists($symbols{'_xti_bind'}) && exists($symbols{'_xti_connect'}) &&
338	    exists($symbols{'_tx_bind'}) && exists($symbols{'_tx_connect'})) {
339			push(@static_libs, "/usr/lib/libnsl.a");
340	}
341
342	return @static_libs;
343}
344
345#
346# Reads in the dynamic profile from the object's output directory.
347# Loads any needed public/private Solaris library symbol models.
348# Records unstable use of any private Solaris symbols in the object's
349# output directory.
350#
351sub dynamic_check_object
352{
353	my ($path_to_object, $dir) = @_;
354
355	# Location of the dynamic profile output:
356	my $profile_file = "$dir/profile.dynamic";
357
358	my $err_fmt = gettext(
359	    "binary object %s has no dynamic profile: %s: %s\n");
360	if (! -f $profile_file) {
361		emsg("$command_name: " . $err_fmt, $path_to_object,
362		    $profile_file, $!);
363		return 0;
364	}
365
366	my $profile_fh = do { local *FH; *FH };
367	if (! open($profile_fh, "<$profile_file")) {
368		exiter(nofile($profile_file, $!));
369	}
370
371	$binaries_checked_count++;
372
373	#
374	# Variables to hold temporary items:
375	#
376	# %library_list will be a hash of "to" libraries we need to load.
377	# @symbol_list will be an array of the "lib|sym" pairs.
378	#
379
380	my (%library_list, @symbol_list, @unbound_list);
381	my ($to, $sym, $from, $binary, $line);
382
383	my ($to_is_sys_lib, $from_is_sys_lib);
384
385	#
386	# profile lines look like:
387	# /bin/ftp|*DIRECT*|libsocket.so.1|socket
388	# /bin/ftp|libnsl.so.1|libc.so.1|mutex_lock
389	#
390	# or:
391	#
392	# /bin/ftp|*DIRECT*|/usr/lib/libsocket.so.1|socket
393	# /bin/ftp|/usr/lib/libnsl.so.1|/usr/lib/libc.so.1|mutex_lock
394	#
395
396	my ($abi, $type, $wordsize, $endian, $e_machine) =
397	    bin_type($path_to_object);
398
399	#
400	# Setting abi to 'any' will allow continuation when
401	# we encounter an abi we do not recognize.
402	#
403	if (! defined($abi) || $abi eq 'unknown') {
404		$abi = 'any';
405	} else {
406		#
407		# Always try to load libc.  This will be used for symbol
408		# migration to libc checks.
409		#
410		if (! exists($load_model_default{$abi})) {
411			load_model($LIBC, $abi);
412		}
413		$load_model_default{$abi} = 1;
414	}
415
416	my $dynamic_bindings_count = 0;
417	my $no_bindings_msg;
418
419	while (<$profile_fh>) {
420		chomp;
421
422		if (/^\s*#/) {
423		    if (/NO_BINDINGS_FOUND\s*(.*)$/) {
424			my $msg = $1;
425			if ($msg =~ /^\s*$/) {
426				$no_bindings_msg = 'NO_SYMBOL_BINDINGS_FOUND';
427			} else {
428				$no_bindings_msg = $msg;
429			}
430		    }
431		    next;
432		}
433
434		($binary, $from, $to, $sym) = split(/\|/, $_, 4);
435
436		$dynamic_bindings_count++;
437
438		# Skip the checking of reverse calls:
439		next if ($from eq "*REVERSE*");
440
441		# Skip the checking of special symbols:
442		next if (exists($skip_symbols{$sym}));
443
444		# Accumulate unbounds, but otherwise skip them:
445		if ($to eq "*UNBOUND*") {
446			push(@unbound_list, "$from|$sym");
447			next;
448		}
449
450		# Record if the "to" object is a system library:
451		$to_is_sys_lib = is_system_library($to, $abi);
452
453		if ($from eq "*DIRECT*") {
454			$from_is_sys_lib = 0;
455		} else {
456			#
457			# Otherwise we may check its calls. See if it is
458			# a system lib:
459			#
460			$from_is_sys_lib = is_system_library($from, $abi);
461		}
462
463		#
464		# We will pass judgement on *DIRECT* calls and indirect
465		# calls from a library we do not recognize.
466		#
467		if ($from_is_sys_lib) {
468			next;
469		}
470		if (! $to_is_sys_lib) {
471			# Call to a middleware or supporting library.
472			next;
473		}
474
475		$library_list{$to} = 1;
476		push(@symbol_list, "$from|$to|$abi|$sym");
477	}
478
479	close($profile_fh);
480
481	my $file;
482
483	my $problems_fh = do { local *FH; *FH };
484	if ($dynamic_bindings_count == 0 && defined($no_bindings_msg)) {
485		$file = "$dir/check.problems";
486
487		if (! open($problems_fh, ">>$file")) {
488			exiter(nofile($file, $!));
489		}
490
491		print $problems_fh "DYNAMIC: NO_DYNAMIC_BINDINGS_FOUND" .
492		    " $no_bindings_msg\n";
493		close($problems_fh);
494		return;
495	}
496
497	my ($lib, $str);
498
499	$file = "$dir/check.dynamic.abi_models";
500	my $model_info_fh = do { local *FH; *FH };
501	if (! open($model_info_fh, ">$file")) {
502		exiter(nofile($file, $!));
503	}
504
505	# Load all the needed library models:
506	my ($s1, $s2);
507	$s1 = ",NO_PUBLIC/PRIVATE_MODEL_FOUND-SKIPPING_CHECK_FOR_THIS_LIBRARY";
508	$s2 = "ERROR_LOADING_PUBLIC/PRIVATE_MODEL";
509
510	foreach $lib (keys %library_list) {
511		if (! load_model($lib, $abi) && ! $load_error{"$lib|$abi"}) {
512			$load_error{"$lib|$abi"} = 1;
513		}
514		$str = $model_loaded{"$lib|$abi"};
515		if ($str eq '__FAILED__') {
516			$str .= $s1;
517		} elsif (! $str) {
518			$str = $s2;
519		}
520		print $model_info_fh "$lib:$str\n";
521	}
522	close($model_info_fh);
523
524	my ($lib_abi_sym, $class, %result_list);
525
526	my ($l, $a, $s);
527	foreach $lib_abi_sym (@symbol_list) {
528
529		($from, $lib_abi_sym) = split(/\|/, $lib_abi_sym, 2);
530
531		($l, $a, $s) = split(/\|/, $lib_abi_sym);
532
533		if (! exists($model{$lib_abi_sym})) {
534			#
535			# Check the library.  If it is not in
536			# model_loaded, then we claim it is not a
537			# library we are interested in.
538			#
539			next if (! exists($model_loaded{"$l|$a"}));
540			next if ($model_loaded{"$l|$a"} eq '__FAILED__');
541
542			# it is an unrecognized symbol:
543			$result_list{'unrecognized'} .=
544			    "$from|$lib_abi_sym" . "\n";
545			next;
546		}
547
548		# N.B. $lib_abi_sym and $l may have been altered above.
549		$class = $model{$lib_abi_sym};
550		$line = "$path_to_object|$a|$from|$l|$class|$s" . "\n";
551
552		if ($class !~ /^(public|private|unclassified)$/) {
553			exiter("$command_name" . sprintf(gettext(
554			    "unrecognized symbol class: %s"), $class));
555		}
556
557		$result_list{$class} .= $line;
558	}
559
560	if (@unbound_list) {
561		my $ldd_file = "$dir/profile.dynamic.ldd";
562		my $tmp;
563		if (-f $ldd_file) {
564			my $ldd_info_fh = do { local *FH; *FH };
565			if (! open($ldd_info_fh, "<$ldd_file")) {
566				exiter(nofile($ldd_file, $!));
567			}
568			while (<$ldd_info_fh>) {
569				$tmp .= '# ' . $_ if (/not\s+found/);
570			}
571			close($ldd_info_fh);
572		}
573		if (defined($tmp)) {
574			$result_list{'unbound'} = $tmp;
575		}
576		$result_list{'unbound'} .= join("\n", @unbound_list) . "\n";
577	}
578
579	my $count;
580
581	my @classes = qw(private public unbound unclassified unrecognized);
582
583	foreach $class (@classes) {
584
585		next if (! exists($result_list{$class}));
586
587		$file = "$dir/check.dynamic.$class";
588
589		my $outfile_fh = do { local *FH; *FH };
590		if (! open($outfile_fh, ">$file")) {
591			exiter(nofile($file, $!));
592		}
593		if ($class eq 'private') {
594			print $outfile_fh
595			    $text{'Message_Private_Symbols_Check_Outfile'};
596		} elsif ($class eq 'public') {
597			print $outfile_fh
598			    $text{'Message_Public_Symbols_Check_Outfile'};
599		}
600		print $outfile_fh $result_list{$class};
601		close($outfile_fh);
602	}
603
604	$file = "$dir/check.problems";
605
606	if (! open($problems_fh, ">>$file")) {
607		exiter(nofile($file, $!));
608	}
609
610	if (exists($result_list{'private'})) {
611		$count = scalar(my @a = split(/\n/, $result_list{'private'}));
612		print $problems_fh "DYNAMIC: PRIVATE_SYMBOL_USE $count\n";
613	}
614	if (exists($result_list{'unbound'})) {
615		$count = scalar(@unbound_list);
616		print $problems_fh "DYNAMIC: UNBOUND_SYMBOL_USE $count\n";
617	}
618	if (exists($result_list{'unrecognized'})) {
619		$count =
620		    scalar(my @a = split(/\n/, $result_list{'unrecognized'}));
621		print $problems_fh "DYNAMIC: UNRECOGNIZED_SYMBOL_USE $count\n";
622	}
623
624	close($problems_fh);
625}
626
627#
628# Loads a system model for a library on demand.
629#
630# Input is a library to load and the architecture ABI.
631#
632# On successful completion, 1 is returned and the associative array:
633#
634#	%model{"$library|$abi|$symbol"} = {public,private}
635#
636#	is set.
637#
638sub load_model
639{
640	#
641	# Returns 1 if the model was successfully loaded, or returns 0
642	# if it was not.
643	#
644
645	my ($library, $abi) = @_;
646
647	#
648	# This %model_loaded hash records the following states:
649	#    <string>	Method by which successfully loaded.
650	#    __FAILED__	Failed to loaded successfully.
651	#    undef      Have not tried to load yet.
652	#
653	if (exists($model_loaded{"$library|$abi"})) {
654		if ($model_loaded{"$library|$abi"} eq '__FAILED__') {
655			return 0;
656		} elsif ($model_loaded{"$library|$abi"}) {
657			return 1;
658		}
659	}
660
661	my ($loaded, $ok);
662
663	$loaded = 1 if (load_model_versioned_lib($library, $abi));
664
665	# Record the result so we do not have to repeat the above:
666
667	if ($loaded) {
668		$ok = "OK";
669		my $tweaks = load_tweaks($library, $abi);
670		$ok .= ",Model_Tweaks\[$tweaks\]" if ($tweaks);
671		$model_loaded{"$library|$abi"} = $ok;
672	} else {
673		$model_loaded{"$library|$abi"} = '__FAILED__';
674	}
675
676	return $loaded;
677}
678
679#
680# Routine to load into %model any special modifications to the Solaris
681# symbol Models kept in the etc.* file.
682#
683sub load_tweaks
684{
685	my ($lib, $abi) = @_;
686
687	my $key;
688	if (exists($model_tweak{$lib}) && $model_tweak{$lib}) {
689		$key = $lib;
690	} else {
691		#
692		# check device/inode record so as to not get tricked by
693		# symlinks.
694		#
695		my ($device, $inode) = (stat($lib))[0,1];
696		if (! defined($device) || ! defined($inode)) {
697			return 0;
698		}
699		$key = "$device/$inode";
700		if (! exists($model_tweak{$key}) || ! $model_tweak{$key}) {
701			return 0;
702		}
703		#
704		# device/inode $key is recorded, so continue along
705		# using it below in the model_tweak lookup.
706		#
707	}
708
709	#
710	# etc line looks like:
711	# MODEL_TWEAK|/usr/lib/libnsl.so.1|sparc,i386|gethostname|public
712	# value looks like:
713	# gethostname|sparc,i386|public
714	#
715
716	my ($case, $abis, $sym, $class, $count);
717
718	$count = 0;
719	foreach $case (split(/,/, $model_tweak{$key})) {
720		($sym, $abis, $class) = split(/\|/, $case);
721		if ($abis eq '*' || ($abis =~ /\b${abi}\b/)) {
722			$model{"$lib|$abi|$sym"} = $class;
723			$count++;
724		}
725	}
726
727	return $count;
728}
729
730#
731# Determine the public/private symbol model for a versioned Solaris
732# library. Returns 0 if no model could be extracted, otherwise returns a
733# string detailing the model loading.
734#
735sub load_model_versioned_lib
736{
737	my ($library, $abi) = @_;
738
739	#
740	# This subroutine runs pvs -dos directly on the Solaris shared
741	# object, and parses data that looks like this:
742	#
743	# % pvs -dos /usr/lib/libsocket.so.1
744	# ...
745	# /usr/lib/libsocket.so.1 -       SUNW_1.1: __xnet_sendmsg;
746	# ...
747	# /usr/lib/libsocket.so.1 -       SISCD_2.3: connect;
748	# ...
749	# /usr/lib/libsocket.so.1 -       SUNWprivate_1.2: getnetmaskbyaddr;
750	#
751	# Note that data types look like:
752	# /usr/lib/libc.so.1 -    SUNWprivate_1.1: __environ_lock (24);
753	#
754	# we discard the size.
755	#
756	# On successful completion 1, is returned and the hash:
757	#
758	#	%model{"$library|$abi|$symbol"} = {public,private}
759	#
760	# is set.
761	#
762
763	# library must be a full path and exist:
764	if (! -f $library) {
765		return 0;
766	}
767
768	my ($rc, $output, $output_syslib);
769
770	#
771	# quote character should never happen in normal use, but if it
772	# did it will foul up the pvs commands below, so we return
773	# early.
774	#
775	if ($library =~ /'/) {
776		return 0;
777	}
778
779	#
780	# Get the entire list of symbols:
781	# note that $library does not contain a single-quote.
782	#
783	c_locale(1);
784	$output = `$cmd_pvs -dos '$library' 2>/dev/null`;
785	$rc = $?;
786	c_locale(0);
787
788	if ($rc != 0 || ($output =~ /^[\s\n]*$/)) {
789		# It is not versioned, so get out.
790		return 0;
791	}
792
793	# Library is versioned with something from this point on.
794
795	my ($line, $libtmp, $j1, $j2, $version, $symbol, $class);
796	my ($count, $public_count, $private_count);
797	my (%versions);
798	my $libbase = basename($library);
799
800	$count = 0;
801	$public_count = 0;
802	$private_count = 0;
803
804	my $is_system_lib = is_system_library($library, $abi);
805
806	my (@defs, $def);
807	if (defined($is_system_lib)) {
808		foreach $def (split(/:/, $is_system_lib)) {
809			next if ($def =~ /^FILE=/);
810			next if ($def =~ /^-$/);
811			push(@defs, $def);
812		}
813		if (@defs == 1) {
814			$is_system_lib = $defs[0];
815		}
816	}
817
818	my (@version_heads, $vers, $default_class);
819	if (defined($is_system_lib) && $is_system_lib ne 'NO_PUBLIC_SYMS') {
820		#
821		# It is a versioned system library.  Extract the public
822		# symbols version head end(s)
823		#
824		if ($is_system_lib =~ /^PUBLIC=(.*)$/) {
825			@version_heads = split(/,/, $1);
826		} else {
827			push(@version_heads, $is_system_lib);
828		}
829
830		#
831		# Rerun pvs again to extract the symbols associated with
832		# the *public* inheritance chain(s).
833		#
834		c_locale(1);
835		foreach $vers (@version_heads) {
836			# something is wrong if $vers has a quote
837			$vers =~ s/'//g;
838
839			# $library has been screened for single quotes earlier.
840			$output_syslib .=
841			    `$cmd_pvs -dos -N '$vers' '$library' 2>/dev/null`;
842		}
843		c_locale(0);
844	}
845
846
847	if (defined($output_syslib) && ($output_syslib !~ /^[\s\n]*$/)) {
848		#
849		# If non-empty there are some public symbols sets.
850		# First, mark everything private:
851		#
852		$output = "DEFAULT_CLASS=private\n" . $output;
853		# then overwrite the public ones:
854		$output .= "DEFAULT_CLASS=public\n"  . $output_syslib;
855	} elsif (defined($is_system_lib) &&
856	    $is_system_lib eq 'NO_PUBLIC_SYMS') {
857		# Everything is private:
858		$output = "DEFAULT_CLASS=private\n" . $output;
859	} else {
860		#
861		# assume public, the override will occur when version
862		# string matches /private/i. This is for 3rd party
863		# libraries.
864		#
865		$output = "DEFAULT_CLASS=public\n" . $output;
866	}
867
868	foreach $line (split(/\n/, $output)) {
869		$line = trim($line);
870		if ($line =~ /^DEFAULT_CLASS=(.*)$/) {
871			$default_class = $1;
872			next;
873		}
874		($libtmp, $j1, $version, $symbol, $j2) = split(/\s+/, $line);
875
876		$symbol  =~ s/;*$//;
877		$version =~ s/:*$//;
878
879		next if ($symbol =~ /^\s*$/);
880		next if ($version eq $libbase);	# see example output above
881
882		$versions{$version}++;
883
884		$class = $default_class;
885
886		if (! $output_syslib && ($version =~ /private/i)) {
887			$class = 'private';
888		}
889
890		if ($class eq 'private') {
891			$private_count++;
892		} else {
893			if ($output_syslib) {
894				# remove the double counting of this version:
895				$versions{$version}--;
896				$private_count--;
897				$count--;
898			}
899			$public_count++;
900		}
901
902		$model{"$library|$abi|$symbol"} = $class;
903		$count++;
904	}
905
906	if (! $count) {
907		return 0;
908	}
909
910	# Construct the info string:
911	$libtmp = "load_model_versioned_lib,$library,$abi:";
912	foreach $version (sort(keys(%versions))) {
913		$libtmp .= "$version\[$versions{$version}\],";
914	}
915	$libtmp .=
916	    "\[${count}symbols=${public_count}public+${private_count}private\]";
917	return $libtmp;
918}
919
920#
921# Returns a non-empty string if the $path_to_library is recognized as a
922# System (i.e. Solaris) ABI library for given abi.  Returns undef
923# otherwise.  The returned string will either be the public symbol version
924# name(s), "NO_PUBLIC_SYMS" if all symbols are private, or "-" if there
925# is no versioning at all.
926#
927sub is_system_library
928{
929	my ($path_to_library, $abi) = @_;
930
931	if (exists($is_system_library_cache{"$path_to_library|$abi"})) {
932		return $is_system_library_cache{"$path_to_library|$abi"};
933	}
934
935	my ($dir, $def, $key);
936
937	my ($device, $inode) = (stat($path_to_library))[0,1];
938	foreach $dir (@lib_index_loaded) {
939
940		$key = "$dir|$path_to_library|$abi";
941		$def = $lib_index_definition{$key};
942		if (defined($device) && defined($inode) && ! defined($def)) {
943			# try inode lookup (chases down unexpected symlinks)
944			$key = "$dir|$device/$inode|$abi";
945			$def = $lib_index_definition{$key};
946		}
947		last if (defined($def));
948	}
949	if (!defined($def) && $path_to_library !~ /'/) {
950		#
951		# we skip the case $path_to_library containing
952		# a single quote, so the cmd argument is protected.
953		#
954		my $tmp = `$cmd_pvs -dn '$path_to_library' 2>/dev/null`;
955		if ($tmp =~ /\b(SUNW[^;]*);/) {
956			$def = $1;
957		}
958	}
959
960	$is_system_library_cache{"$path_to_library|$abi"} = $def;
961
962	return $def;
963}
964
965#
966# Loop over each object item in the working_dir.
967#  - $dir will be each one of these object directories.
968#  - $path_to_object will be the corresponding actual path
969#    to the the binary to be checked.
970# Output will usually be placed down in $dir, e.g. "$dir/check.foo"
971#
972sub perform_misc_checks
973{
974	my ($dir, $path_to_object);
975
976	if (! $misc_check_databases_loaded_ok) {
977		#
978		# The load was attempted in check_objects() There is no
979		# point in continuing if that loading failed.
980		#
981		return;
982	}
983
984	emsg("\n" . gettext(
985	    "performing miscellaneous checks") . " ...\n\n");
986
987	while (defined($dir = next_dir_name())) {
988
989		# Map object output dir to actual path of the object:
990		$path_to_object = dir_name_to_path($dir);
991
992		if (! -f $path_to_object) {
993			exiter(nopathexist($path_to_object, $!));
994		}
995
996		# Check it:
997		misc_check($path_to_object, $dir);
998	}
999}
1000
1001#
1002# Routine to perform the misc. checks on a given binary object.  Records
1003# the findings in object's output directory.
1004#
1005sub misc_check
1006{
1007	my ($path_to_object, $dir) = @_;
1008
1009	# Load the entire dynamic profile for this object:
1010
1011	my (@profile, @profile_short, %direct_syms, $file);
1012	my $tmp;
1013
1014	$file = "$dir/profile.dynamic";
1015
1016	my ($app, $caller, $lib, $base, $sym);
1017	my ($libsymcaller, $cnt, %sawlib);
1018	if (-f $file) {
1019		my $prof_fh = do { local *FH; *FH };
1020		if (! open($prof_fh, "<$file")) {
1021			exiter(nofile($file, $!));
1022		}
1023		$cnt = 0;
1024		while (<$prof_fh>) {
1025			next if (/^\s*#/);
1026			next if (/^\s*$/);
1027			chomp;
1028			($app, $caller, $lib, $sym) = split(/\|/, $_, 4);
1029
1030			# Skip the checking of special symbols:
1031			next if (exists($skip_symbols{$sym}));
1032
1033			push(@profile, "$lib|$sym|$caller");
1034
1035			#
1036			# We collect in @profile_short up to 10
1037			# lib-sym-caller triples where all the libs are
1038			# distinct.  This is used to speed up some
1039			# loops over the profile below: when we catch
1040			# the lib-matching checks early in the loop we
1041			# can exclude those checks from the remainder
1042			# of the loop.  Since a profile may involve
1043			# 1000's of symbols this can be a savings.
1044			#
1045			if ($cnt < 10 && ! exists($sawlib{$lib})) {
1046				push(@profile_short, "$lib|$sym|$caller");
1047				$sawlib{$lib} = 1;
1048				$cnt++;
1049			}
1050		}
1051		close($prof_fh);
1052	}
1053	#
1054	# Misc Check #1:
1055	# Go through dynamic profile looking for scoped local symbols:
1056	#
1057
1058	my (%all_neededs, %lib_not_found);
1059	my ($scoped_list, $scoped_msg);
1060	my ($sc_rel, $sc_lib, $sc_sym, $sc_val);
1061
1062	%all_neededs = all_ldd_neededs($path_to_object);
1063	my ($key, $key_trim);
1064	foreach $key (keys(%all_neededs)) {
1065		$key_trim = basename($key);
1066		$all_neededs{$key_trim} = $all_neededs{$key};
1067		if ($all_neededs{$key} =~ /file not found/) {
1068			# %lib_not_found will be used below in check #2
1069			$lib_not_found{$key}++;
1070			$lib_not_found{$key_trim}++;
1071		}
1072	}
1073
1074	# We will need the abi of the object:
1075	my $abi;
1076	($abi) = bin_type($path_to_object);
1077	if ($abi eq '' || ($abi =~ /^(unknown|any)$/)) {
1078		if ($uname_p =~ /sparc/i) {
1079			$abi = 'sparc';
1080		} else {
1081			$abi = 'i386';
1082		}
1083	}
1084
1085	foreach $libsymcaller (@profile) {
1086		next unless ($libsymcaller =~ /\*DIRECT\*$/);
1087
1088		($lib, $sym, $caller) = split(/\|/, $libsymcaller, 3);
1089
1090		#
1091		# Record direct symbols to improve our %wskip list used
1092		# to speed up loops over symbols.
1093		#
1094		$direct_syms{$sym} = 1;
1095		next unless (exists($scoped_symbol_all{$sym}));
1096
1097		$base = basename($lib);
1098
1099		#
1100		# We only worry if a scoped call is a direct one.  This
1101		# assumes the user's support shared objects are also
1102		# checked by appcert.
1103		#
1104
1105		if (exists($scoped_symbol{"$lib|$sym"}) ||
1106		    exists($scoped_symbol{"$base|$sym"})) {
1107			#
1108			# This one is for checking on releases BEFORE
1109			# the scoping actually occurred.
1110			#
1111			$scoped_msg  .= "$base:$sym ";
1112			$scoped_list .= "$path_to_object|$caller|$lib|$sym\n";
1113
1114		} elsif ($lib eq '*UNBOUND*' &&
1115		    exists($scoped_symbol_all{$sym})) {
1116			#
1117			# This one is for checking on releases AFTER the
1118			# scoping.
1119			#
1120			# Assume these type of unbounds are deprecated
1121			# if found in scoped_symbol_all. Double check it
1122			# is in the all-needed-libs though:
1123			#
1124
1125			if (defined($sc_sym) &&
1126			    exists($model{"$LIBC|$abi|$sc_sym"})) {
1127				next;
1128			}
1129
1130			foreach $sc_val (split(/,/, $scoped_symbol_all{$sym})) {
1131				($sc_rel, $sc_lib, $sc_sym) =
1132				    split(/\|/, $sc_val);
1133
1134				#
1135				# The general scoping that occurred for
1136				# ld.so.1 makes the current heuristic
1137				# somewhat less accurate. Unboundedness
1138				# from other means has too good a chance
1139				# of overlapping with the ld.so.1
1140				# scoping. Note that the app likely does
1141				# NOT have ld.so.1 in its neededs, but
1142				# we still skip this case.
1143				#
1144
1145				next if ($sc_lib eq 'ld.so.1');
1146
1147				if ($all_neededs{$sc_lib}) {
1148					# note that $lib is '*UNBOUND*'
1149					$scoped_msg  .= "<unbound>:$sym ";
1150					$scoped_list .=
1151					"$path_to_object|$caller|$lib|$sym\n";
1152				}
1153			}
1154		}
1155	}
1156
1157	if (defined($scoped_msg)) {
1158		my $problems = "$dir/check.problems";
1159
1160		# problems will be appended to the file:
1161		my $problems_fh = do { local *FH; *FH };
1162		if (! open($problems_fh, ">>$problems")) {
1163			exiter(nofile($problems, $!));
1164		}
1165		print $problems_fh
1166		    "MISC: REMOVED_SCOPED_SYMBOLS: $scoped_msg\n";
1167		close($problems_fh);
1168
1169		$problems = "$dir/check.demoted_symbols";
1170
1171		# problems will be appended to the file:
1172		my $check_fh = do { local *FH; *FH };
1173		if (! open($check_fh, ">>$problems")) {
1174			exiter(nofile($problems, $!));
1175		}
1176		print $check_fh $scoped_list;
1177		close($check_fh);
1178	}
1179
1180	#
1181	# Misc Check #2
1182	# Go through dynamic profile looking for special warnings.
1183	#
1184
1185	my (%warnings, %wskip);
1186	my (%lib_star, %sym_star, %caller_star);
1187	my ($tag, $tag0, $sub, $res);
1188
1189	while (($tag, $sub) = each(%warnings_match)) {
1190		next if (! $sub);
1191
1192		$res = &{$sub}($path_to_object);
1193		$warnings{$tag} = 1 if ($res);
1194	}
1195
1196	my $warnings_bind_has_non_direct = 0;
1197
1198	while (($tag0, $tmp) =  each(%warnings_bind)) {
1199		($lib, $sym, $caller) = split(/\|/, $tmp, 3);
1200		$lib_star{$tag0}	= 1 if ($lib eq '*');
1201		$sym_star{$tag0}	= 1 if ($sym eq '*');
1202		$caller_star{$tag0}	= 1 if ($caller eq '*');
1203		if ($lib ne '*' && $lib !~ m,/, && ! $all_neededs{$lib}) {
1204			# it can never match:
1205			$wskip{$tag0} = 1;
1206		}
1207		if ($caller ne '*DIRECT*') {
1208			# this will be used to speed up the *DIRECT* only case:
1209			$warnings_bind_has_non_direct = 1;
1210		} elsif ($sym ne '*' && ! $direct_syms{$sym}) {
1211			# it can never match:
1212			$wskip{$tag0} = 1;
1213		}
1214	}
1215
1216	foreach $lib (keys(%lib_not_found)) {
1217		#
1218		# add a placeholder symbol in %profile to indicate
1219		# $lib is on dtneeded, but wasn't found. This will
1220		# match a $sym = '*' warnings_bind misc check:
1221		#
1222		push(@profile,
1223		    "$lib|__ldd_indicated_file_not_found__|*DIRECT*");
1224	}
1225
1226	my ($l_t, $s_t, $c_t, $match_t);
1227
1228	my (@tag_list, @tag_list2, $new_tags);
1229	#
1230	# create a list of tags excluding the ones we know will be
1231	# skipped in the $libsymcaller loop below.
1232	#
1233	foreach $tag0 (keys(%warnings_bind)) {
1234		next if ($wskip{$tag0});
1235		push(@tag_list, $tag0);
1236	}
1237
1238	#
1239	# we loop over @profile_short first, these will give us up to
1240	# 10 different libraries early to help us shrink @tag_list
1241	# as we go through the profile.
1242	#
1243	foreach $libsymcaller (@profile_short, @profile) {
1244		@tag_list = @tag_list2 if ($new_tags);
1245		last if (! @tag_list);
1246
1247		($lib, $sym, $caller) = split(/\|/, $libsymcaller, 3);
1248
1249		if (! $warnings_bind_has_non_direct && $caller ne '*DIRECT*') {
1250			next;
1251		}
1252
1253		$base = basename($lib);
1254		$new_tags = 0;
1255
1256		foreach $tag0 (@tag_list) {
1257
1258			# try to get out early:
1259			next if ($wskip{$tag0});
1260
1261			($tag, $tmp) = split(/\|/, $tag0, 2);
1262			# try to get out early:
1263			next if ($warnings{$tag});
1264
1265			$match_t = $warnings_bind{$tag0};
1266
1267			$l_t = $lib;
1268			$s_t = $sym;
1269			$c_t = $caller;
1270
1271			$l_t = '*' if ($lib_star{$tag0});
1272			$s_t = '*' if ($sym_star{$tag0});
1273			$c_t = '*' if ($caller_star{$tag0});
1274
1275			if ("$l_t|$s_t|$c_t" eq $match_t ||
1276			    "$base|$s_t|$c_t" eq $match_t) {
1277				$warnings{$tag} = 1;
1278				$wskip{$tag0} = 1;
1279
1280				# shorten tag list:
1281				my (@t, $tg, $tg2, $tp);
1282				foreach $tg (@tag_list) {
1283					next if ($tg eq $tag0);
1284					($tg2, $tp) = split(/\|/, $tg, 2);
1285					next if ($tg2 eq $tag);
1286					push(@t, $tg);
1287				}
1288				@tag_list2 = @t;
1289				$new_tags = 1;
1290			}
1291		}
1292	}
1293
1294	if (%warnings) {
1295		my $problems = "$dir/check.problems";
1296
1297		# append problems to the file:
1298		my $problems_fh = do { local *FH; *FH };
1299		if (! open($problems_fh, ">>$problems")) {
1300			exiter(nofile($problems, $!));
1301		}
1302
1303		my $tag;
1304		foreach $tag (keys(%warnings)) {
1305			print $problems_fh "MISC: WARNING: $tag\n";
1306		}
1307		close($problems_fh);
1308	}
1309}
1310