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