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# Copyright 2004 Sun Microsystems, Inc.  All rights reserved.
24# Use is subject to license terms.
25#
26
27#
28# This utility program reads the contents file to extract Solaris ELF
29# libraries, and then runs pvs(1) on them to find the library versioning
30# information (if any).  This info is printed to stdout in an index file
31# format.
32#
33
34require 5.005;
35use strict;
36use locale;
37use POSIX qw(locale_h);
38use Sun::Solaris::Utils qw(textdomain gettext);
39use File::Basename;
40
41use vars qw(
42	@liblist
43	%symlink
44	%inode_hash
45	%fileoutput
46	%didlib
47);
48
49setlocale(LC_ALL, "");
50textdomain(TEXT_DOMAIN);
51
52# parameters for what types of libraries to list out:
53my $must_be_versioned = 0;
54my $must_be_public = 0;
55
56# paths to skip outright.
57my @skip_list = qw(
58	/etc
59	/usr/perl5
60);
61my $path_skip = join('|', @skip_list);
62$path_skip = qr/^($path_skip)/;
63
64# find library names:
65#
66# We have to use pkgchk -l output (even though it is much slower than
67# parsing /var/sadm/install/contents ourselves) because the contents
68# file will go away or change incompatibly at some point.
69#
70my $old = $ENV{'LC_ALL'};
71$ENV{'LC_ALL'} = 'C';
72my $contents_fh = do { local *FH; *FH };
73open($contents_fh, "/usr/sbin/pkgchk -l|") || die "$!\n";
74if (defined($old)) {
75	$ENV{'LC_ALL'} = $old;
76} else {
77	delete($ENV{'LC_ALL'});
78}
79
80my $pathname = '';
81my $type = '';
82my $link = '';
83my $pkgs = '';
84my $status = '';
85my $inpkgs = 0;
86while (<$contents_fh>) {
87	next if (/^Ex/);
88	chomp;
89	if (/^Pathname:\s*/i) {
90		$pathname = $';
91		$type = '';
92		$link = '';
93		$status = '';
94		$pkgs = '';
95		$inpkgs = 0;
96		next;
97	} elsif (/^Type:\s*/i) {
98		$type = $';
99		next;
100	} elsif (/^Source of link:\s*/i) {
101		$link = $';
102		next;
103	} elsif (/^Referenced by/i) {
104		$inpkgs = 1;
105	} elsif (/^Current status:\s*/i) {
106		$status = $';
107		$inpkgs = 0;
108		next;
109	} elsif (/^\s*$/) {
110		next unless ($pathname =~ m,\.so,);
111		next unless ($pathname =~ m,/lib,);
112		next unless ($pathname =~ m,/lib[^/]*\.so\b,);
113		next unless ($type =~ /regular file|symbolic link/i);
114		next unless ($status =~ /^\s*installed\s*$/);
115		$pathname = trim($pathname);
116		$link = trim($link);
117		filter($pathname, $link, $pkgs);
118	}
119	if ($inpkgs) {
120		$pkgs .= $_ . ' ';
121	}
122}
123close($contents_fh);
124
125# run pvs(1) on the libraries found:
126my $batch = 30;	# batch size to use (running in batches is faster).
127
128my @list = ();
129for (my $i = 1; $i <= scalar(@liblist); $i++) {
130	push(@list, $liblist[$i-1]);
131	if ($i % $batch == 0) {
132		do_pvs(@list) if (@list);
133		@list = ();
134	}
135}
136do_pvs(@list) if (@list);	# finish any remainder.
137
138exit 0;
139
140#
141# Take a pkgchk -l entry and decide if it corresponds to a Solaris
142# library. If so, save it in the list @liblist, and record info in
143# %symlink & %inode_hash associative arrays as appropriate.
144#
145sub filter
146{
147	my ($path, $link, $pkgs) = @_;
148
149
150	# consider only SUNW packages:
151	return unless ($pkgs =~ /\bSUNW\S+/);
152
153	my $basename;
154
155	$basename = basename($path);
156
157	if ($link ne '') {
158		# include developer build-time symlinks:
159		return unless ($basename =~ /^lib.*\.so[\.\d]*$/);
160	} else {
161		return unless ($basename =~ /^lib.*\.so\.[\.\d]+$/);
162	}
163	return if ($path =~ /$path_skip/);
164
165	return unless (-f $path);
166
167	# inode is used to identify what file a symlink point to:
168	my $inode;
169	$inode = (stat($path))[1];
170	return unless (defined($inode));
171
172	if ($link ne '') {
173		# record info about symlinks:
174		if (exists($symlink{$inode})) {
175			$symlink{$inode} .= ":" . $path;
176		} else {
177			$symlink{$inode} = ":" . $path;
178		}
179	} else {
180		# ordinary file case:
181		$inode_hash{$path} = $inode;
182		push(@liblist, $path);
183	}
184}
185
186#
187# Run pvs(1) on a list of libraries. More than one is done at a time to
188# speed things up.
189#
190# Extracts the version information and passes it to the output() routine
191# for final processing.
192#
193sub do_pvs
194{
195	my (@list) = @_;
196
197	my (%list, $paths, $path, $cnt);
198
199	#
200	# record info about the library paths and construct the list of
201	# files for the pvs command line.
202	#
203	$cnt = 0;
204	$paths = '';
205	foreach $path (@list) {
206		$list{$path} = 1;
207		$paths .= ' ' if ($paths ne '');
208		#
209		# $path should never have single quote in it in
210		# all normal usage. Make sure this is so:
211		#
212		next if ($path =~ /'/);
213		#
214		# quote the filename in case it has meta-characters
215		# (which should never happen in all normal usage)
216		#
217		$paths .= "'$path'";
218		$cnt++;
219	}
220
221	return if ($cnt == 0);
222
223	# set locale to C for running command, since we interpret the output:
224	my $old = $ENV{'LC_ALL'};
225	$ENV{'LC_ALL'} = 'C';
226
227	# get the file(1) output for each item:
228	my $file_fh = do { local *FH; *FH };
229	open($file_fh, "/usr/bin/file $paths 2>&1 |") || die "$!\n";
230	my ($file, $out);
231	while (<$file_fh>) {
232		($file, $out) = split(/:/, $_, 2);
233		if ($list{$file} && $out =~ /\bELF\b/) {
234			$fileoutput{$file} = $out;
235		}
236	}
237	close($file_fh);
238
239	#
240	# in the case of only 1 item, we place it on the command line
241	# twice to induce pvs(1) to indicate which file it is reporting
242	# on.
243	#
244	if ($cnt == 1) {
245		$paths .= " $paths";
246	}
247
248	#
249	# $paths are entries from /var/sadm/install/contents and
250	# so should not contain spaces or meta characters:
251	#
252	my $pvs_fh = do { local *FH; *FH };
253	open($pvs_fh, "/usr/bin/pvs -dn $paths 2>&1 |") || die "$!\n";
254
255	# reset LC_ALL, if there was any:
256	if (defined($old)) {
257		$ENV{'LC_ALL'} = $old;
258	} else {
259		delete($ENV{'LC_ALL'});
260	}
261
262	my ($pub, $pri, $obs, $evo, $vers, $new_path);
263
264	undef($path);
265
266	# initialize strings used below for appending info to:
267	$pub = '';
268	$pri = '';
269	$obs = '';
270	$evo = '';
271
272	while (<$pvs_fh>) {
273		$_ =~ s/\s*$//;
274		if (m,^([^:]+):$,) {
275		    # a new pvs file header, e.g. "/usr/lib/libc.so.1:"
276		    if ($list{$1}) {
277			$new_path = $1;
278
279			# output the previous one and reset accumulators:
280			if (defined($path)) {
281				output($path, $pub, $pri, $obs, $evo);
282
283				$pub = '';
284				$pri = '';
285				$obs = '';
286				$evo = '';
287			}
288			$path = $new_path;
289			next;	# done with pvs header case
290		    }
291		}
292
293		# extract SUNW version head end:
294
295		$vers = trim($_);
296		$vers =~ s/;//g;
297
298		# handle the various non-standard cases in Solaris libraries:
299		if ($vers =~ /^(SUNW.*private|SUNW_XIL_GPI)/i) {
300			$pri .= $vers . ":";
301		} elsif ($vers =~ /^(SUNW_\d|SYSVABI|SISCD)/) {
302			$pub .= $vers . ":";
303		} elsif ($vers =~ /^(SUNW\.\d|SUNW_XIL)/) {
304			$pub .= $vers . ":";
305		} elsif ($vers =~ /^SUNWobsolete/) {
306			$obs .= $vers . ":";
307		} elsif ($vers =~ /^SUNWevolving/) {
308			$evo .= $vers . ":";
309		} else {
310			next;
311		}
312	}
313	close($pvs_fh);
314
315	# output the last one (if any):
316	if (defined($path)) {
317		output($path, $pub, $pri, $obs, $evo);
318	}
319}
320
321#
322# Take the raw library versioning information and process it into index
323# file format and then print it out.
324#
325sub output
326{
327	my ($path, $pub, $pri, $obs, $evo) = @_;
328
329	return if ($didlib{$path});	# skip repeating a library
330
331	# trim off any trailing separators:
332	$pub =~ s/:$//;
333	$pri =~ s/:$//;
334	$obs =~ s/:$//;
335	$evo =~ s/:$//;
336
337	# work out the type of library:
338	my $type;
339	my $defn;
340	my $n;
341	if ($pri && ! $pub && ! $obs && ! $evo) {
342		$type = 'INTERNAL';
343		$defn = 'NO_PUBLIC_SYMS';
344	} elsif ($obs) {
345		$type = 'OBSOLETE';
346		$defn = $obs;
347	} elsif ($pub) {
348		$type = 'PUBLIC';
349		$defn = $pub;
350		if ($defn =~ /:/) {
351			$defn =~ s/:/,/g;
352			$defn = "PUBLIC=$defn";
353		}
354	} elsif ($evo) {
355		$type = 'EVOLVING';
356		$defn = $evo;
357	} elsif (! $pri && ! $pub && ! $obs && ! $evo) {
358		$type = 'UNVERSIONED';
359		$defn = '-';
360	} else {
361		return;
362	}
363
364	# return if instructed to skip either of these cases:
365	if ($must_be_versioned && $type eq 'UNVERSIONED') {
366		return;
367	}
368	if ($must_be_public && $type eq 'INTERNAL') {
369		return;
370	}
371
372
373	# prepare the output line, including any symlink information:
374	my $inode = $inode_hash{$path};
375	my $links;
376	if ($inode && exists($symlink{$inode})) {
377		$links = "${path}$symlink{$inode}";
378	} else {
379		$links = "$path";
380	}
381
382	# count the total number of references:
383	my (@n) = split(/:/, $links);
384	$n = scalar(@n);
385
386	# determine the abi to which the library file belongs:
387	my ($fout, $abi);
388	$abi = 'unknown';
389	$fout = $fileoutput{$path};
390	if ($fout =~ /\bSPARCV9\b/) {
391		$abi = 'sparcv9';
392	} elsif ($fout =~ /\bSPARC/) {
393		$abi = 'sparc';
394	} elsif ($fout =~ /\bAMD64\b/ || $fout =~ /\bELF\s+64-bit\s+LSB\b/) {
395		$abi = 'amd64';
396	} elsif ($fout =~ /\b80386\b/) {
397		$abi = 'i386';
398	}
399	print STDOUT "$abi|$path|$defn|$n|$links\n";
400
401	# record that we did this library so we do not process it a second time.
402	$didlib{$path} = 1;
403}
404
405#
406# Remove leading and trailing spaces.
407#
408sub trim
409{
410	my ($x) = @_;
411	$x =~ s/^\s*//;
412	$x =~ s/\s*$//;
413
414	return $x;
415}
416