xref: /illumos-gate/usr/src/cmd/abi/appcert/scripts/symcheck.pl (revision 7c478bd95313f5f23a4c958a745db2134aa03244)

#!/usr/perl5/bin/perl -w
#
# CDDL HEADER START
#
# The contents of this file are subject to the terms of the
# Common Development and Distribution License, Version 1.0 only
# (the "License").  You may not use this file except in compliance
# with the License.
#
# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
# or http://www.opensolaris.org/os/licensing.
# See the License for the specific language governing permissions
# and limitations under the License.
#
# When distributing Covered Code, include this CDDL HEADER in each
# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
# If applicable, add the following below this CDDL HEADER, with the
# fields enclosed by brackets "[]" replaced with your own identifying
# information: Portions Copyright [yyyy] [name of copyright owner]
#
# CDDL HEADER END
#
#
# ident	"%Z%%M%	%I%	%E% SMI"
#
# Copyright 2004 Sun Microsystems, Inc.  All rights reserved.
# Use is subject to license terms.
#

#
# This utility program loads the unstable behavior databases, then reads
# the symprof output for each binary, and record any detected unstable
# behavior in the binary's output directory.
#

require 5.005;
use strict;
use locale;
use POSIX qw(locale_h);
use Sun::Solaris::Utils qw(textdomain gettext);
use File::Basename;
use File::Path;

use lib qw(/usr/lib/abi/appcert);
use AppcertUtil;

setlocale(LC_ALL, "");
textdomain(TEXT_DOMAIN);

use vars qw(
	$LIBC
	$tmp_check_dir
	$binaries_checked_count
	$misc_check_databases_loaded_ok
	%load_model_default
	%load_error
	%model_loaded
	%model
	%is_system_library_cache
);

set_clean_up_exit_routine(\&clean_up_exit);

initialize_variables();

import_vars_from_environment();

signals('on', \&interrupted);

set_working_dir();

load_model_index();

check_objects();

clean_up();

exit 0;

#
# Set up any variables.
#
sub initialize_variables
{
	# Here is what we call libc:
	$LIBC = '/usr/lib/libc.so.1';
}

#
# working_dir has been imported by import_vars_from_environment()
# A sanity check is performed here to make sure it exists.
#
sub set_working_dir
{
	if (! defined($working_dir) || ! -d $working_dir) {
		exiter("$command_name: " . sprintf(gettext(
		    "cannot locate working directory: %s\n"), $working_dir));
	}
}

#
# Called when interrupted by a signal.
#
sub interrupted
{
	$SIG{$_[0]} = 'DEFAULT';
	signals('off');
	clean_up_exit(1);
}

#
# Does the cleanup then exit with return code $rc.  Note: The utility
# routine exiter() will call this routine.
#
sub clean_up_exit
{
	my ($rc) = @_;
	$rc = 0 unless ($rc);

	clean_up();
	exit $rc;
}

#
# General cleanup activities are placed here.  There may not be an
# immediate exit after this cleanup.
#
sub clean_up
{
	if (defined($tmp_check_dir) && -d $tmp_check_dir) {
		rmtree($tmp_check_dir);
	}
}

#
# Top level routine to initialize databases and then loop over the
# objects and call the checking routines on each one.
#
sub check_objects
{
	# Make a tmp dir for the checking work.
	$tmp_check_dir = create_tmp_dir($tmp_dir);

	if (! -d $tmp_check_dir) {
		exiter(nocreatedir($tmp_check_dir, $!));
	}

	emsg("\n" . gettext(
	    "checking binary objects for unstable practices") . " ...\n\n");

	my ($dir, $path_to_object);

	#
	# Loop over each object item in the working_dir.
	#  - $dir will be each one of these object directories.
	#  - $path_to_object will be the corresponding actual path
	#    to the the binary to be checked.
	# Output will be placed down in $dir, e.g. "$dir/check.foo"
	#

	$binaries_checked_count = 0;

	#
	# We need to load the Misc Databases to get any modifications to
	# the symbol database. E.g. gethostname should be public.
	#
	$misc_check_databases_loaded_ok = load_misc_check_databases();

	while (defined($dir = next_dir_name())) {

		# Map object output dir to actual path of the object:
		$path_to_object = dir_name_to_path($dir);

		if (! -f $path_to_object) {
			exiter(nopathexist($path_to_object, $!));
		}

		# Check it:
		emsg(gettext("checking: %s\n"), $path_to_object);

		static_check_object($path_to_object, $dir);
		dynamic_check_object($path_to_object, $dir);
	}

	if ($binaries_checked_count == 0) {
		exiter("$command_name: " . gettext(
		    "no binary objects where checked."));
	}

	# Do additional heuristic checks of unstable behavior:
	perform_misc_checks();

	clean_up();	# Remove any tmp dirs and files.
}

#
# Reads in the static profile (i.e. the symbols exported by bin in
# .text section) and calls the static archive checking routine.
#
sub static_check_object
{
	my ($path_to_object, $dir) = @_;

	# The profile output file created by static_profile() in symprof.

	my $profile_file = "$dir/profile.static";

	my $err_fmt = gettext(
	    "binary object %s has no static profile: %s: %s\n");
	if (! -f $profile_file) {
		emsg("$command_name: " . $err_fmt, $path_to_object,
		    $profile_file, $!);
		return 0;
	}

	my $profile_fh = do { local *FH; *FH };
	if (! open($profile_fh, "<$profile_file")) {
		exiter(nofile($profile_file, $!));
	}

	my ($profile, $lib, $lib2, $base, %libs_needed);

	my $completely_statically_linked = 0;

	while (<$profile_fh>) {
		$profile .= $_;
		if (/^\s*#dtneeded:\s*(.*)$/) {
			#
			# record the bare name, e.g. "libc" of the
			# (direct) dtneededs.
			#
			foreach $lib (split(/\s+/, $1)) {
				next if ($lib eq '');
				$base = $lib;
				# record it as libc.so.1 -> libc
				$base =~ s/\.so\..*$//;
				$base =~ s/\.so$//;
				$libs_needed{$base} = $lib;
				$libs_needed{basename($base)} = $lib;
			}
		} elsif (/^\s*#SKIPPED_TEST:\s+STATICALLY_LINKED/) {
			#
			# Record statical linking if it takes place
			# since it indicates to skip the test.
			#
			$completely_statically_linked = 1;
		}
	}
	close($profile_fh);

	my $problems = "$dir/check.problems";

	my $problems_fh = do { local *FH; *FH };
	if (! open($problems_fh, ">>$problems")) {
		exiter(nofile($problems, $!));
	}

	if ($completely_statically_linked) {
		print $problems_fh "STATIC: COMPLETELY_STATIC"  . "\n";
	}

	my (%saw_lib);
	if (! defined($profile)) {
		close($problems_fh);
		return;
	}
	foreach $lib (lib_static_check($profile)) {
		#
		# lib_static_check returns a list of statically linked
		# libraries, however to be on the safe side we will skip
		# false positives our dtneeded's show they are really
		# dynamically linked in.
		#

		next if ($libs_needed{$lib});
		next if ($libs_needed{basename($lib)});
		next if ($saw_lib{basename($lib)}++);

		$lib2 = $lib;
		$lib2 =~ s/\.a$//;
		next if ($libs_needed{$lib2});
		next if ($libs_needed{basename($lib2)});

		# Otherwise, record in the problems file:
		print $problems_fh "STATIC: LINKED_ARCHIVE $lib" . "\n";
	}
	close($problems_fh);
}

#
# Takes as input the static profile (e.g. the .text symbols) and returns
# a list of suspected statically linked Solaris archive libraries.
#
sub lib_static_check
{
	my ($profile) = @_;

	my ($line, $area, $extent, $type, $sym, $obj);

	my (%symbols);

	#
	# Working on lines like:
	# /bin/ftp|TEXT|GLOB|FUNC|glob
	# /bin/ftp|TEXT|GLOB|FUNC|help
	#

	# First record all the symbols in the TEXT area:

	foreach $line (split(/\n/, $profile)) {
		next unless ($line =~ /\bTEXT\b/);
		($obj, $area, $extent, $type, $sym) = split(/\|/, $line);

		$symbols{$sym} = 1;
	}

	my (@static_libs);

	# Next, check against the library heuristics for static linking:

	# libc.a:

	if (exists($symbols{'_exit'})) {
		push(@static_libs, "/usr/lib/libc.a");
	}

	# libsocket.a:

	if (exists($symbols{'socket'}) && exists($symbols{'_socket'}) &&
	    exists($symbols{'bind'}) && exists($symbols{'_bind'}) &&
	    exists($symbols{'connect'}) && exists($symbols{'_connect'})) {
			push(@static_libs, "/usr/lib/libsocket.a");
	}

	# libnsl.a:

	if (exists($symbols{'_xti_bind'}) && exists($symbols{'_xti_connect'}) &&
	    exists($symbols{'_tx_bind'}) && exists($symbols{'_tx_connect'})) {
			push(@static_libs, "/usr/lib/libnsl.a");
	}

	return @static_libs;
}

#
# Reads in the dynamic profile from the object's output directory.
# Loads any needed public/private Solaris library symbol models.
# Records unstable use of any private Solaris symbols in the object's
# output directory.
#
sub dynamic_check_object
{
	my ($path_to_object, $dir) = @_;

	# Location of the dynamic profile output:
	my $profile_file = "$dir/profile.dynamic";

	my $err_fmt = gettext(
	    "binary object %s has no dynamic profile: %s: %s\n");
	if (! -f $profile_file) {
		emsg("$command_name: " . $err_fmt, $path_to_object,
		    $profile_file, $!);
		return 0;
	}

	my $profile_fh = do { local *FH; *FH };
	if (! open($profile_fh, "<$profile_file")) {
		exiter(nofile($profile_file, $!));
	}

	$binaries_checked_count++;

	#
	# Variables to hold temporary items:
	#
	# %library_list will be a hash of "to" libraries we need to load.
	# @symbol_list will be an array of the "lib|sym" pairs.
	#

	my (%library_list, @symbol_list, @unbound_list);
	my ($to, $sym, $from, $binary, $line);

	my ($to_is_sys_lib, $from_is_sys_lib);

	#
	# profile lines look like:
	# /bin/ftp|*DIRECT*|libsocket.so.1|socket
	# /bin/ftp|libnsl.so.1|libc.so.1|mutex_lock
	#
	# or:
	#
	# /bin/ftp|*DIRECT*|/usr/lib/libsocket.so.1|socket
	# /bin/ftp|/usr/lib/libnsl.so.1|/usr/lib/libc.so.1|mutex_lock
	#

	my ($abi, $type, $wordsize, $endian, $e_machine) =
	    bin_type($path_to_object);

	#
	# Setting abi to 'any' will allow continuation when
	# we encounter an abi we do not recognize.
	#
	if (! defined($abi) || $abi eq 'unknown') {
		$abi = 'any';
	} else {
		#
		# Always try to load libc.  This will be used for symbol
		# migration to libc checks.
		#
		if (! exists($load_model_default{$abi})) {
			load_model($LIBC, $abi);
		}
		$load_model_default{$abi} = 1;
	}

	my $dynamic_bindings_count = 0;
	my $no_bindings_msg;

	while (<$profile_fh>) {
		chomp;

		if (/^\s*#/) {
		    if (/NO_BINDINGS_FOUND\s*(.*)$/) {
			my $msg = $1;
			if ($msg =~ /^\s*$/) {
				$no_bindings_msg = 'NO_SYMBOL_BINDINGS_FOUND';
			} else {
				$no_bindings_msg = $msg;
			}
		    }
		    next;
		}

		($binary, $from, $to, $sym) = split(/\|/, $_, 4);

		$dynamic_bindings_count++;

		# Skip the checking of reverse calls:
		next if ($from eq "*REVERSE*");

		# Skip the checking of special symbols:
		next if (exists($skip_symbols{$sym}));

		# Accumulate unbounds, but otherwise skip them:
		if ($to eq "*UNBOUND*") {
			push(@unbound_list, "$from|$sym");
			next;
		}

		# Record if the "to" object is a system library:
		$to_is_sys_lib = is_system_library($to, $abi);

		if ($from eq "*DIRECT*") {
			$from_is_sys_lib = 0;
		} else {
			#
			# Otherwise we may check its calls. See if it is
			# a system lib:
			#
			$from_is_sys_lib = is_system_library($from, $abi);
		}

		#
		# We will pass judgement on *DIRECT* calls and indirect
		# calls from a library we do not recognize.
		#
		if ($from_is_sys_lib) {
			next;
		}
		if (! $to_is_sys_lib) {
			# Call to a middleware or supporting library.
			next;
		}

		$library_list{$to} = 1;
		push(@symbol_list, "$from|$to|$abi|$sym");
	}

	close($profile_fh);

	my $file;

	my $problems_fh = do { local *FH; *FH };
	if ($dynamic_bindings_count == 0 && defined($no_bindings_msg)) {
		$file = "$dir/check.problems";

		if (! open($problems_fh, ">>$file")) {
			exiter(nofile($file, $!));
		}

		print $problems_fh "DYNAMIC: NO_DYNAMIC_BINDINGS_FOUND" .
		    " $no_bindings_msg\n";
		close($problems_fh);
		return;
	}

	my ($lib, $str);

	$file = "$dir/check.dynamic.abi_models";
	my $model_info_fh = do { local *FH; *FH };
	if (! open($model_info_fh, ">$file")) {
		exiter(nofile($file, $!));
	}

	# Load all the needed library models:
	my ($s1, $s2);
	$s1 = ",NO_PUBLIC/PRIVATE_MODEL_FOUND-SKIPPING_CHECK_FOR_THIS_LIBRARY";
	$s2 = "ERROR_LOADING_PUBLIC/PRIVATE_MODEL";

	foreach $lib (keys %library_list) {
		if (! load_model($lib, $abi) && ! $load_error{"$lib|$abi"}) {
			$load_error{"$lib|$abi"} = 1;
		}
		$str = $model_loaded{"$lib|$abi"};
		if ($str eq '__FAILED__') {
			$str .= $s1;
		} elsif (! $str) {
			$str = $s2;
		}
		print $model_info_fh "$lib:$str\n";
	}
	close($model_info_fh);

	my ($lib_abi_sym, $class, %result_list);

	my ($l, $a, $s);
	foreach $lib_abi_sym (@symbol_list) {

		($from, $lib_abi_sym) = split(/\|/, $lib_abi_sym, 2);

		($l, $a, $s) = split(/\|/, $lib_abi_sym);

		if (! exists($model{$lib_abi_sym})) {
			#
			# Check the library.  If it is not in
			# model_loaded, then we claim it is not a
			# library we are interested in.
			#
			next if (! exists($model_loaded{"$l|$a"}));
			next if ($model_loaded{"$l|$a"} eq '__FAILED__');

			# it is an unrecognized symbol:
			$result_list{'unrecognized'} .=
			    "$from|$lib_abi_sym" . "\n";
			next;
		}

		# N.B. $lib_abi_sym and $l may have been altered above.
		$class = $model{$lib_abi_sym};
		$line = "$path_to_object|$a|$from|$l|$class|$s" . "\n";

		if ($class !~ /^(public|private|unclassified)$/) {
			exiter("$command_name" . sprintf(gettext(
			    "unrecognized symbol class: %s"), $class));
		}

		$result_list{$class} .= $line;
	}

	if (@unbound_list) {
		my $ldd_file = "$dir/profile.dynamic.ldd";
		my $tmp;
		if (-f $ldd_file) {
			my $ldd_info_fh = do { local *FH; *FH };
			if (! open($ldd_info_fh, "<$ldd_file")) {
				exiter(nofile($ldd_file, $!));
			}
			while (<$ldd_info_fh>) {
				$tmp .= '# ' . $_ if (/not\s+found/);
			}
			close($ldd_info_fh);
		}
		if (defined($tmp)) {
			$result_list{'unbound'} = $tmp;
		}
		$result_list{'unbound'} .= join("\n", @unbound_list) . "\n";
	}

	my $count;

	my @classes = qw(private public unbound unclassified unrecognized);

	foreach $class (@classes) {

		next if (! exists($result_list{$class}));

		$file = "$dir/check.dynamic.$class";

		my $outfile_fh = do { local *FH; *FH };
		if (! open($outfile_fh, ">$file")) {
			exiter(nofile($file, $!));
		}
		if ($class eq 'private') {
			print $outfile_fh
			    $text{'Message_Private_Symbols_Check_Outfile'};
		} elsif ($class eq 'public') {
			print $outfile_fh
			    $text{'Message_Public_Symbols_Check_Outfile'};
		}
		print $outfile_fh $result_list{$class};
		close($outfile_fh);
	}

	$file = "$dir/check.problems";

	if (! open($problems_fh, ">>$file")) {
		exiter(nofile($file, $!));
	}

	if (exists($result_list{'private'})) {
		$count = scalar(my @a = split(/\n/, $result_list{'private'}));
		print $problems_fh "DYNAMIC: PRIVATE_SYMBOL_USE $count\n";
	}
	if (exists($result_list{'unbound'})) {
		$count = scalar(@unbound_list);
		print $problems_fh "DYNAMIC: UNBOUND_SYMBOL_USE $count\n";
	}
	if (exists($result_list{'unrecognized'})) {
		$count =
		    scalar(my @a = split(/\n/, $result_list{'unrecognized'}));
		print $problems_fh "DYNAMIC: UNRECOGNIZED_SYMBOL_USE $count\n";
	}

	close($problems_fh);
}

#
# Loads a system model for a library on demand.
#
# Input is a library to load and the architecture ABI.
#
# On successful completion, 1 is returned and the associative array:
#
#	%model{"$library|$abi|$symbol"} = {public,private}
#
#	is set.
#
sub load_model
{
	#
	# Returns 1 if the model was successfully loaded, or returns 0
	# if it was not.
	#

	my ($library, $abi) = @_;

	#
	# This %model_loaded hash records the following states:
	#    <string>	Method by which successfully loaded.
	#    __FAILED__	Failed to loaded successfully.
	#    undef      Have not tried to load yet.
	#
	if (exists($model_loaded{"$library|$abi"})) {
		if ($model_loaded{"$library|$abi"} eq '__FAILED__') {
			return 0;
		} elsif ($model_loaded{"$library|$abi"}) {
			return 1;
		}
	}

	my ($loaded, $ok);

	$loaded = 1 if (load_model_versioned_lib($library, $abi));

	# Record the result so we do not have to repeat the above:

	if ($loaded) {
		$ok = "OK";
		my $tweaks = load_tweaks($library, $abi);
		$ok .= ",Model_Tweaks\[$tweaks\]" if ($tweaks);
		$model_loaded{"$library|$abi"} = $ok;
	} else {
		$model_loaded{"$library|$abi"} = '__FAILED__';
	}

	return $loaded;
}

#
# Routine to load into %model any special modifications to the Solaris
# symbol Models kept in the etc.* file.
#
sub load_tweaks
{
	my ($lib, $abi) = @_;

	my $key;
	if (exists($model_tweak{$lib}) && $model_tweak{$lib}) {
		$key = $lib;
	} else {
		#
		# check device/inode record so as to not get tricked by
		# symlinks.
		#
		my ($device, $inode) = (stat($lib))[0,1];
		if (! defined($device) || ! defined($inode)) {
			return 0;
		}
		$key = "$device/$inode";
		if (! exists($model_tweak{$key}) || ! $model_tweak{$key}) {
			return 0;
		}
		#
		# device/inode $key is recorded, so continue along
		# using it below in the model_tweak lookup.
		#
	}

	#
	# etc line looks like:
	# MODEL_TWEAK|/usr/lib/libnsl.so.1|sparc,i386|gethostname|public
	# value looks like:
	# gethostname|sparc,i386|public
	#

	my ($case, $abis, $sym, $class, $count);

	$count = 0;
	foreach $case (split(/,/, $model_tweak{$key})) {
		($sym, $abis, $class) = split(/\|/, $case);
		if ($abis eq '*' || ($abis =~ /\b${abi}\b/)) {
			$model{"$lib|$abi|$sym"} = $class;
			$count++;
		}
	}

	return $count;
}

#
# Determine the public/private symbol model for a versioned Solaris
# library. Returns 0 if no model could be extracted, otherwise returns a
# string detailing the model loading.
#
sub load_model_versioned_lib
{
	my ($library, $abi) = @_;

	#
	# This subroutine runs pvs -dos directly on the Solaris shared
	# object, and parses data that looks like this:
	#
	# % pvs -dos /usr/lib/libsocket.so.1
	# ...
	# /usr/lib/libsocket.so.1 -       SUNW_1.1: __xnet_sendmsg;
	# ...
	# /usr/lib/libsocket.so.1 -       SISCD_2.3: connect;
	# ...
	# /usr/lib/libsocket.so.1 -       SUNWprivate_1.2: getnetmaskbyaddr;
	#
	# Note that data types look like:
	# /usr/lib/libc.so.1 -    SUNWprivate_1.1: __environ_lock (24);
	#
	# we discard the size.
	#
	# On successful completion 1, is returned and the hash:
	#
	#	%model{"$library|$abi|$symbol"} = {public,private}
	#
	# is set.
	#

	# library must be a full path and exist:
	if (! -f $library) {
		return 0;
	}

	my ($rc, $output, $output_syslib);

	#
	# quote character should never happen in normal use, but if it
	# did it will foul up the pvs commands below, so we return
	# early.
	#
	if ($library =~ /'/) {
		return 0;
	}

	#
	# Get the entire list of symbols:
	# note that $library does not contain a single-quote.
	#
	c_locale(1);
	$output = `$cmd_pvs -dos '$library' 2>/dev/null`;
	$rc = $?;
	c_locale(0);

	if ($rc != 0 || ($output =~ /^[\s\n]*$/)) {
		# It is not versioned, so get out.
		return 0;
	}

	# Library is versioned with something from this point on.

	my ($line, $libtmp, $j1, $j2, $version, $symbol, $class);
	my ($count, $public_count, $private_count);
	my (%versions);
	my $libbase = basename($library);

	$count = 0;
	$public_count = 0;
	$private_count = 0;

	my $is_system_lib = is_system_library($library, $abi);

	my (@defs, $def);
	if (defined($is_system_lib)) {
		foreach $def (split(/:/, $is_system_lib)) {
			next if ($def =~ /^FILE=/);
			next if ($def =~ /^-$/);
			push(@defs, $def);
		}
		if (@defs == 1) {
			$is_system_lib = $defs[0];
		}
	}

	my (@version_heads, $vers, $default_class);
	if (defined($is_system_lib) && $is_system_lib ne 'NO_PUBLIC_SYMS') {
		#
		# It is a versioned system library.  Extract the public
		# symbols version head end(s)
		#
		if ($is_system_lib =~ /^PUBLIC=(.*)$/) {
			@version_heads = split(/,/, $1);
		} else {
			push(@version_heads, $is_system_lib);
		}

		#
		# Rerun pvs again to extract the symbols associated with
		# the *public* inheritance chain(s).
		#
		c_locale(1);
		foreach $vers (@version_heads) {
			# something is wrong if $vers has a quote
			$vers =~ s/'//g;

			# $library has been screened for single quotes earlier.
			$output_syslib .=
			    `$cmd_pvs -dos -N '$vers' '$library' 2>/dev/null`;
		}
		c_locale(0);
	}


	if (defined($output_syslib) && ($output_syslib !~ /^[\s\n]*$/)) {
		#
		# If non-empty there are some public symbols sets.
		# First, mark everything private:
		#
		$output = "DEFAULT_CLASS=private\n" . $output;
		# then overwrite the public ones:
		$output .= "DEFAULT_CLASS=public\n"  . $output_syslib;
	} elsif (defined($is_system_lib) &&
	    $is_system_lib eq 'NO_PUBLIC_SYMS') {
		# Everything is private:
		$output = "DEFAULT_CLASS=private\n" . $output;
	} else {
		#
		# assume public, the override will occur when version
		# string matches /private/i. This is for 3rd party
		# libraries.
		#
		$output = "DEFAULT_CLASS=public\n" . $output;
	}

	foreach $line (split(/\n/, $output)) {
		$line = trim($line);
		if ($line =~ /^DEFAULT_CLASS=(.*)$/) {
			$default_class = $1;
			next;
		}
		($libtmp, $j1, $version, $symbol, $j2) = split(/\s+/, $line);

		$symbol  =~ s/;*$//;
		$version =~ s/:*$//;

		next if ($symbol =~ /^\s*$/);
		next if ($version eq $libbase);	# see example output above

		$versions{$version}++;

		$class = $default_class;

		if (! $output_syslib && ($version =~ /private/i)) {
			$class = 'private';
		}

		if ($class eq 'private') {
			$private_count++;
		} else {
			if ($output_syslib) {
				# remove the double counting of this version:
				$versions{$version}--;
				$private_count--;
				$count--;
			}
			$public_count++;
		}

		$model{"$library|$abi|$symbol"} = $class;
		$count++;
	}

	if (! $count) {
		return 0;
	}

	# Construct the info string:
	$libtmp = "load_model_versioned_lib,$library,$abi:";
	foreach $version (sort(keys(%versions))) {
		$libtmp .= "$version\[$versions{$version}\],";
	}
	$libtmp .=
	    "\[${count}symbols=${public_count}public+${private_count}private\]";
	return $libtmp;
}

#
# Returns a non-empty string if the $path_to_library is recognized as a
# System (i.e. Solaris) ABI library for given abi.  Returns undef
# otherwise.  The returned string will either be the public symbol version
# name(s), "NO_PUBLIC_SYMS" if all symbols are private, or "-" if there
# is no versioning at all.
#
sub is_system_library
{
	my ($path_to_library, $abi) = @_;

	if (exists($is_system_library_cache{"$path_to_library|$abi"})) {
		return $is_system_library_cache{"$path_to_library|$abi"};
	}

	my ($dir, $def, $key);

	my ($device, $inode) = (stat($path_to_library))[0,1];
	foreach $dir (@lib_index_loaded) {

		$key = "$dir|$path_to_library|$abi";
		$def = $lib_index_definition{$key};
		if (defined($device) && defined($inode) && ! defined($def)) {
			# try inode lookup (chases down unexpected symlinks)
			$key = "$dir|$device/$inode|$abi";
			$def = $lib_index_definition{$key};
		}
		last if (defined($def));
	}
	if (!defined($def) && $path_to_library !~ /'/) {
		#
		# we skip the case $path_to_library containing
		# a single quote, so the cmd argument is protected.
		#
		my $tmp = `$cmd_pvs -dn '$path_to_library' 2>/dev/null`;
		if ($tmp =~ /\b(SUNW[^;]*);/) {
			$def = $1;
		}
	}

	$is_system_library_cache{"$path_to_library|$abi"} = $def;

	return $def;
}

#
# Loop over each object item in the working_dir.
#  - $dir will be each one of these object directories.
#  - $path_to_object will be the corresponding actual path
#    to the the binary to be checked.
# Output will usually be placed down in $dir, e.g. "$dir/check.foo"
#
sub perform_misc_checks
{
	my ($dir, $path_to_object);

	if (! $misc_check_databases_loaded_ok) {
		#
		# The load was attempted in check_objects() There is no
		# point in continuing if that loading failed.
		#
		return;
	}

	emsg("\n" . gettext(
	    "performing miscellaneous checks") . " ...\n\n");

	while (defined($dir = next_dir_name())) {

		# Map object output dir to actual path of the object:
		$path_to_object = dir_name_to_path($dir);

		if (! -f $path_to_object) {
			exiter(nopathexist($path_to_object, $!));
		}

		# Check it:
		misc_check($path_to_object, $dir);
	}
}

#
# Routine to perform the misc. checks on a given binary object.  Records
# the findings in object's output directory.
#
sub misc_check
{
	my ($path_to_object, $dir) = @_;

	# Load the entire dynamic profile for this object:

	my (@profile, @profile_short, %direct_syms, $file);
	my $tmp;

	$file = "$dir/profile.dynamic";

	my ($app, $caller, $lib, $base, $sym);
	my ($libsymcaller, $cnt, %sawlib);
	if (-f $file) {
		my $prof_fh = do { local *FH; *FH };
		if (! open($prof_fh, "<$file")) {
			exiter(nofile($file, $!));
		}
		$cnt = 0;
		while (<$prof_fh>) {
			next if (/^\s*#/);
			next if (/^\s*$/);
			chomp;
			($app, $caller, $lib, $sym) = split(/\|/, $_, 4);

			# Skip the checking of special symbols:
			next if (exists($skip_symbols{$sym}));

			push(@profile, "$lib|$sym|$caller");

			#
			# We collect in @profile_short up to 10
			# lib-sym-caller triples where all the libs are
			# distinct.  This is used to speed up some
			# loops over the profile below: when we catch
			# the lib-matching checks early in the loop we
			# can exclude those checks from the remainder
			# of the loop.  Since a profile may involve
			# 1000's of symbols this can be a savings.
			#
			if ($cnt < 10 && ! exists($sawlib{$lib})) {
				push(@profile_short, "$lib|$sym|$caller");
				$sawlib{$lib} = 1;
				$cnt++;
			}
		}
		close($prof_fh);
	}
	#
	# Misc Check #1:
	# Go through dynamic profile looking for scoped local symbols:
	#

	my (%all_neededs, %lib_not_found);
	my ($scoped_list, $scoped_msg);
	my ($sc_rel, $sc_lib, $sc_sym, $sc_val);

	%all_neededs = all_ldd_neededs($path_to_object);
	my ($key, $key_trim);
	foreach $key (keys(%all_neededs)) {
		$key_trim = basename($key);
		$all_neededs{$key_trim} = $all_neededs{$key};
		if ($all_neededs{$key} =~ /file not found/) {
			# %lib_not_found will be used below in check #2
			$lib_not_found{$key}++;
			$lib_not_found{$key_trim}++;
		}
	}

	# We will need the abi of the object:
	my $abi;
	($abi) = bin_type($path_to_object);
	if ($abi eq '' || ($abi =~ /^(unknown|any)$/)) {
		if ($uname_p =~ /sparc/i) {
			$abi = 'sparc';
		} else {
			$abi = 'i386';
		}
	}

	foreach $libsymcaller (@profile) {
		next unless ($libsymcaller =~ /\*DIRECT\*$/);

		($lib, $sym, $caller) = split(/\|/, $libsymcaller, 3);

		#
		# Record direct symbols to improve our %wskip list used
		# to speed up loops over symbols.
		#
		$direct_syms{$sym} = 1;
		next unless (exists($scoped_symbol_all{$sym}));

		$base = basename($lib);

		#
		# We only worry if a scoped call is a direct one.  This
		# assumes the user's support shared objects are also
		# checked by appcert.
		#

		if (exists($scoped_symbol{"$lib|$sym"}) ||
		    exists($scoped_symbol{"$base|$sym"})) {
			#
			# This one is for checking on releases BEFORE
			# the scoping actually occurred.
			#
			$scoped_msg  .= "$base:$sym ";
			$scoped_list .= "$path_to_object|$caller|$lib|$sym\n";

		} elsif ($lib eq '*UNBOUND*' &&
		    exists($scoped_symbol_all{$sym})) {
			#
			# This one is for checking on releases AFTER the
			# scoping.
			#
			# Assume these type of unbounds are deprecated
			# if found in scoped_symbol_all. Double check it
			# is in the all-needed-libs though:
			#

			if (defined($sc_sym) &&
			    exists($model{"$LIBC|$abi|$sc_sym"})) {
				next;
			}

			foreach $sc_val (split(/,/, $scoped_symbol_all{$sym})) {
				($sc_rel, $sc_lib, $sc_sym) =
				    split(/\|/, $sc_val);

				#
				# The general scoping that occurred for
				# ld.so.1 makes the current heuristic
				# somewhat less accurate. Unboundedness
				# from other means has too good a chance
				# of overlapping with the ld.so.1
				# scoping. Note that the app likely does
				# NOT have ld.so.1 in its neededs, but
				# we still skip this case.
				#

				next if ($sc_lib eq 'ld.so.1');

				if ($all_neededs{$sc_lib}) {
					# note that $lib is '*UNBOUND*'
					$scoped_msg  .= "<unbound>:$sym ";
					$scoped_list .=
					"$path_to_object|$caller|$lib|$sym\n";
				}
			}
		}
	}

	if (defined($scoped_msg)) {
		my $problems = "$dir/check.problems";

		# problems will be appended to the file:
		my $problems_fh = do { local *FH; *FH };
		if (! open($problems_fh, ">>$problems")) {
			exiter(nofile($problems, $!));
		}
		print $problems_fh
		    "MISC: REMOVED_SCOPED_SYMBOLS: $scoped_msg\n";
		close($problems_fh);

		$problems = "$dir/check.demoted_symbols";

		# problems will be appended to the file:
		my $check_fh = do { local *FH; *FH };
		if (! open($check_fh, ">>$problems")) {
			exiter(nofile($problems, $!));
		}
		print $check_fh $scoped_list;
		close($check_fh);
	}

	#
	# Misc Check #2
	# Go through dynamic profile looking for special warnings.
	#

	my (%warnings, %wskip);
	my (%lib_star, %sym_star, %caller_star);
	my ($tag, $tag0, $sub, $res);

	while (($tag, $sub) = each(%warnings_match)) {
		next if (! $sub);

		$res = &{$sub}($path_to_object);
		$warnings{$tag} = 1 if ($res);
	}

	my $warnings_bind_has_non_direct = 0;

	while (($tag0, $tmp) =  each(%warnings_bind)) {
		($lib, $sym, $caller) = split(/\|/, $tmp, 3);
		$lib_star{$tag0}	= 1 if ($lib eq '*');
		$sym_star{$tag0}	= 1 if ($sym eq '*');
		$caller_star{$tag0}	= 1 if ($caller eq '*');
		if ($lib ne '*' && $lib !~ m,/, && ! $all_neededs{$lib}) {
			# it can never match:
			$wskip{$tag0} = 1;
		}
		if ($caller ne '*DIRECT*') {
			# this will be used to speed up the *DIRECT* only case:
			$warnings_bind_has_non_direct = 1;
		} elsif ($sym ne '*' && ! $direct_syms{$sym}) {
			# it can never match:
			$wskip{$tag0} = 1;
		}
	}

	foreach $lib (keys(%lib_not_found)) {
		#
		# add a placeholder symbol in %profile to indicate
		# $lib is on dtneeded, but wasn't found. This will
		# match a $sym = '*' warnings_bind misc check:
		#
		push(@profile,
		    "$lib|__ldd_indicated_file_not_found__|*DIRECT*");
	}

	my ($l_t, $s_t, $c_t, $match_t);

	my (@tag_list, @tag_list2, $new_tags);
	#
	# create a list of tags excluding the ones we know will be
	# skipped in the $libsymcaller loop below.
	#
	foreach $tag0 (keys(%warnings_bind)) {
		next if ($wskip{$tag0});
		push(@tag_list, $tag0);
	}

	#
	# we loop over @profile_short first, these will give us up to
	# 10 different libraries early to help us shrink @tag_list
	# as we go through the profile.
	#
	foreach $libsymcaller (@profile_short, @profile) {
		@tag_list = @tag_list2 if ($new_tags);
		last if (! @tag_list);

		($lib, $sym, $caller) = split(/\|/, $libsymcaller, 3);

		if (! $warnings_bind_has_non_direct && $caller ne '*DIRECT*') {
			next;
		}

		$base = basename($lib);
		$new_tags = 0;

		foreach $tag0 (@tag_list) {

			# try to get out early:
			next if ($wskip{$tag0});

			($tag, $tmp) = split(/\|/, $tag0, 2);
			# try to get out early:
			next if ($warnings{$tag});

			$match_t = $warnings_bind{$tag0};

			$l_t = $lib;
			$s_t = $sym;
			$c_t = $caller;

			$l_t = '*' if ($lib_star{$tag0});
			$s_t = '*' if ($sym_star{$tag0});
			$c_t = '*' if ($caller_star{$tag0});

			if ("$l_t|$s_t|$c_t" eq $match_t ||
			    "$base|$s_t|$c_t" eq $match_t) {
				$warnings{$tag} = 1;
				$wskip{$tag0} = 1;

				# shorten tag list:
				my (@t, $tg, $tg2, $tp);
				foreach $tg (@tag_list) {
					next if ($tg eq $tag0);
					($tg2, $tp) = split(/\|/, $tg, 2);
					next if ($tg2 eq $tag);
					push(@t, $tg);
				}
				@tag_list2 = @t;
				$new_tags = 1;
			}
		}
	}

	if (%warnings) {
		my $problems = "$dir/check.problems";

		# append problems to the file:
		my $problems_fh = do { local *FH; *FH };
		if (! open($problems_fh, ">>$problems")) {
			exiter(nofile($problems, $!));
		}

		my $tag;
		foreach $tag (keys(%warnings)) {
			print $problems_fh "MISC: WARNING: $tag\n";
		}
		close($problems_fh);
	}
}