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