1#!/usr/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 (the "License"). 7# You may not use this file except in compliance with the License. 8# 9# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE 10# or http://www.opensolaris.org/os/licensing. 11# See the License for the specific language governing permissions 12# and limitations under the License. 13# 14# When distributing Covered Code, include this CDDL HEADER in each 15# file and include the License file at usr/src/OPENSOLARIS.LICENSE. 16# If applicable, add the following below this CDDL HEADER, with the 17# fields enclosed by brackets "[]" replaced with your own identifying 18# information: Portions Copyright [yyyy] [name of copyright owner] 19# 20# CDDL HEADER END 21# 22 23# 24# Copyright 2009 Sun Microsystems, Inc. All rights reserved. 25# Use is subject to license terms. 26# 27 28# 29# Check versioning information. 30# 31# This script descends a directory hierarchy inspecting ELF shared objects for 32# version definitions. The general theme is to verify that common versioning 33# rules have been used to build these objects. 34# 35# As always, a number of components don't follow the rules, or require 36# special handling. An exceptions file is used to specify these cases. 37# 38# By default any file that has conditions that should be reported is first 39# listed and then each condition follows. The -o (one-line) option produces a 40# more terse output which is better for sorting/diffing with "nightly". 41# 42# Besides the default operation of checking the files within a directory 43# hierarchy, a detailed analysis of each files versions can be created with the 44# -d option. The database created is useful for auditing the difference between 45# different builds, and for thus monitoring that versioning changes are made in 46# a compatible manner. 47 48 49# Define all global variables (required for strict) 50use vars qw($Prog $Intfdir); 51use vars qw(%opt @SaveArgv $ErrFH $ObjCnt); 52 53 54# An exception file is used to specify regular expressions to match 55# objects. These directives specify special attributes of the object. 56# The regular expressions are read from the file and compiled into the 57# regular expression variables. 58# 59# The name of each regular expression variable is of the form 60# 61# $EXRE_xxx 62# 63# where xxx is the name of the exception in lower case. For example, 64# the regular expression variable for PLUGINS is $EXRE_plugins. 65# 66# onbld_elfmod::LoadExceptionsToEXRE() depends on this naming convention 67# to initialize the regular expression variables, and to detect invalid 68# exception names. 69# 70# If a given exception is not used in the exception file, its regular 71# expression variable will be undefined. Users of these variables must 72# test the variable with defined() prior to use: 73# 74# defined($EXRE_plugins) && ($foo =~ $EXRE_plugins) 75# 76# ---- 77# 78# The exceptions are: 79# 80# NONSTD_VERNAME 81# Objects are expected to use standard names for versions. 82# This directive is used to relax that requirement. 83# 84# NOVERDEF 85# Objects that are not required to have a versioned name. Note that 86# PLUGINS objects are implicitly NOVERDEF, so this directive is 87# for use with non-plugin objects. 88# 89# PLUGINS 90# Plugin objects are not required to have a versioned name, and are 91# not required to be internally versioned. 92# 93use vars qw($EXRE_nonstd_vername $EXRE_noverdef $EXRE_plugin); 94 95use strict; 96 97use POSIX qw(getenv); 98use Getopt::Std; 99use File::Basename; 100 101 102 103 104## ProcFile(BasePath, RelPath, Class, Type, Verdef, Alias) 105# 106# Investigate runtime attributes of a sharable object 107# 108# entry: 109# BasePath - Base path from which relative paths are taken 110# RelPath - Path of object taken relative to BasePath 111# Class - ELFCLASS of object 112# Type - ELF type of object 113# Verdef - VERDEF if object defines versions, NOVERDEF otherwise 114# Alias - Alias lines corresponding to the object, or an empty ('') 115# string if there are no aliases. 116# 117sub ProcFile { 118 my($BasePath, $RelPath, $Class, $Type, $Verdef, $Alias) = @_; 119 120 my($File, $FullPath, %Vers, $VersCnt, %TopVer); 121 my($Val, $Ttl, $NotPlugin); 122 123 $FullPath = "$BasePath/$RelPath"; 124 @_ = split /\//, $RelPath; 125 $File = $_[$#_]; 126 127 $Ttl = 0; 128 129 # If this object does not follow the runtime versioned name convention, 130 # and it does not reside underneath a directory identified as 131 # containing plugin objects intended for use with dlopen() only, 132 # issue a warning. 133 $NotPlugin = !defined($EXRE_plugin) || ($RelPath !~ $EXRE_plugin); 134 if (($File !~ /\.so\./) && $NotPlugin) { 135 onbld_elfmod::OutMsg($ErrFH, \$Ttl, $RelPath, 136 "does not have a versioned name"); 137 } 138 139 # If there are no versions in the file we're done. 140 if ($Verdef eq 'NOVERDEF') { 141 # Report the lack of versioning, unless the object is 142 # a known plugin, or is explicitly exempt. 143 if ($NotPlugin && 144 (!defined($EXRE_noverdef) || ($RelPath !~ $EXRE_noverdef))) { 145 onbld_elfmod::OutMsg($ErrFH, \$Ttl, $RelPath, 146 "no versions found"); 147 } 148 return; 149 } 150 151 # Get a hash of the top versions in the inheritance chains. 152 %TopVer = (); 153 foreach my $Line (split(/\n/, `pvs -don $FullPath 2>&1`)) { 154 $Line =~ s/^.*-\s*(.*);/$1/; 155 $TopVer{$Line} = 1; 156 } 157 158 # First determine what versions exist that offer interfaces. pvs -dos 159 # will list these. Note that other versions may exist, ones that 160 # don't offer interfaces ... we'll get to those next. 161 %Vers = (); 162 $VersCnt = 0; 163 my %TopSUNWVers = (); 164 foreach my $Line (split(/\n/, `pvs -dos $FullPath 2>&1`)) { 165 my($Ver) = $Line; 166 167 $Ver =~ s/^.*-\t(.*): .*/$1/; # isolate version 168 169 # See if we've already caught this version name. We only look 170 # at each version once. 171 next if ($Vers{$Ver}) ; 172 173 # Note that the non-empty version has been seen 174 $Vers{$Ver} = 1; 175 $VersCnt++; 176 177 # We expect the public SUNW_major.minor.micro versions to use 178 # inheritance, so there should only be one top version for 179 # each major number. It is possible, though rare, to have 180 # more than one top version if the major numbers differ. 181 # 182 # %TopSUNWVers uses the major name as the key, with each 183 # value yielding an array reference to the top versions for 184 # that major number. 185 if ($Ver =~ /^(SUNW_[0-9]+)[0-9.]+$/) { 186 push @{$TopSUNWVers{$1}}, $Ver if $TopVer{$Ver}; 187 next; 188 } 189 190 # Having already handled SUNW_ public versions above, is it 191 # a different version name that we recognise? 192 # 193 # Along with the standard version names, each object exports 194 # a "base" version which contains the linker generated symbols 195 # _etext, _edata, etc., and is named using the objects SONAME. 196 # This name should typically match the file name. 197 next if (($Ver =~ /^SYSVABI_1.[23]$/) || 198 ($Ver =~ /^SISCD_2.3[ab]*$/) || 199 ($Ver =~ /^SUNWprivate(_[0-9.]+)?$/) || 200 ($Ver =~ /$File/)); 201 202 # If we get here, it's a non-standard version. 203 if (!defined($EXRE_nonstd_vername) || 204 ($RelPath !~ $EXRE_nonstd_vername)) { 205 onbld_elfmod::OutMsg($ErrFH, \$Ttl, $RelPath, 206 "non-standard version name: $Ver"); 207 } 208 next; 209 } 210 211 # If this file has been scoped, but not versioned (i.e., a mapfile was 212 # used to demote symbols but no version name was applied to the 213 # global interfaces) then it's another non-standard case. 214 if ($VersCnt eq 0) { 215 onbld_elfmod::OutMsg($ErrFH, \$Ttl, $RelPath, 216 "scoped object contains no versions"); 217 return; 218 } 219 220 # If this file has multiple inheritance chains with the public 221 # SUNW_ name, that's wrong. 222 foreach my $Ver (sort keys %TopSUNWVers) { 223 if (scalar(@{$TopSUNWVers{$Ver}}) > 1) { 224 onbld_elfmod::OutMsg($ErrFH, \$Ttl, $RelPath, 225 "multiple $Ver inheritance chains (missing " . 226 "inheritance?): " . 227 join(', ', @{$TopSUNWVers{$Ver}})); 228 } 229 } 230 231 232 # Produce an interface description for the object. 233 # For each version, generate a VERSION declaration of the form: 234 # 235 # [TOP_]VERSION version direct-count total-count 236 # symname1 237 # symname2 238 # ... 239 # 240 # There are two types of version that we suppress from this 241 # output: 242 # 243 # BASE 244 # The "base" version is used to hold symbols that must be 245 # public, but which are not part of the versioning interface 246 # (_end, _GLOBAL_OFFSET_TABLE_, _PROCEDURE_LINKAGE_TABLE_, etc). 247 # 248 # Private 249 # Any version with "private" in its name is skipped. We 250 # expect these to be SUNWprivate, but are extra lenient in 251 # what we accept. 252 # 253 # If an object only has base or private versions, we do not produce 254 # an interface description for that object. 255 # 256 if ($opt{i}) { 257 my $header_done = 0; 258 259 # The use of 'pvs -v' is to identify the BASE version 260 foreach my $Line (split(/\n/, `pvs -dv $FullPath 2>&1`)) { 261 # Skip base version 262 next if ($Line =~ /\[BASE\]/); 263 264 # Skip private versions 265 next if ($Line =~ /private/i); 266 267 # Directly inherited versions follow the version name 268 # in a comma separated list within {} brackets. Capture 269 # that information, for use with our VERSION line. 270 my $InheritVers = ($Line =~ /(\{.*\});$/) ? "\t$1" : ''; 271 272 $Line =~ s/^\s*([^;: ]*).*/$1/; 273 274 # Older versions of pvs have a bug that prevents 275 # them from printing [BASE] on the base version. 276 # Work around this by excluding versions that end 277 # with a '.so.*' suffix. 278 # SONAME of the object. 279 next if $Line =~ /\.so\.\d+$/; 280 281 # We want to output the symbols in sorted order, so 282 # we gather them first, and then sort the results. 283 # An array would suffice, but we have observed objects 284 # with odd inheritance chains in which the same 285 # sub-version gets inherited more than once, leading 286 # to the same symbol showing up more than once. Using 287 # a hash instead of an array thins out the duplicates. 288 my %Syms = (); 289 my $symitem = $opt{I} ? 'NEW' : 'SYMBOL'; 290 my $version_cnt = 0; 291 foreach my $Sym 292 (split(/\n/, `pvs -ds -N $Line $FullPath 2>&1`)) { 293 if ($Sym =~ /:$/) { 294 $version_cnt++; 295 # If this is an inherited sub-version, 296 # we don't need to continue unless 297 # generating output in -I mode. 298 if ($version_cnt >= 2) { 299 last if !$opt{I}; 300 $symitem = 'INHERIT'; 301 } 302 next; 303 } 304 $Sym =~ s/[ \t]*(.*);$/$1/; 305 $Sym =~ s/ .*$//; # remove any data size 306 $Syms{$Sym} = $symitem; 307 } 308 309 if (!$header_done) { 310 print INTFILE "\n" if !$opt{h} && ($ObjCnt != 0); 311 $ObjCnt++; 312 print INTFILE "OBJECT\t$RelPath\n"; 313 print INTFILE "CLASS\tELFCLASS$Class\n"; 314 print INTFILE "TYPE\tET_$Type\n"; 315 print INTFILE $Alias if ($Alias ne ''); 316 $header_done = 1; 317 } 318 319 my $item = $TopVer{$Line} ? 'TOP_VERSION' : 'VERSION'; 320 print INTFILE "$item\t$Line$InheritVers\n"; 321 322 # Output symbols in sorted order 323 foreach my $Sym (sort keys %Syms) { 324 print INTFILE "\t$Syms{$Sym}\t$Sym\n"; 325 } 326 } 327 } 328} 329 330## ProcFindElf(file) 331# 332# Open the specified file, which must be produced by "find_elf -r", 333# and process the files it describes. 334sub ProcFindElf { 335 my $file = $_[0]; 336 my $line; 337 my $LineNum = 0; 338 my $prefix; 339 my @ObjList = (); 340 my %ObjToAlias = (); 341 342 open(FIND_ELF, $file) || die "$Prog: Unable to open $file"; 343 344 # This script requires relative paths, created by the 'find_elf -r' 345 # option. When this is done, the first non-comment line will always 346 # be PREFIX. Obtain that line, or issue a fatal error. 347 while ($line = onbld_elfmod::GetLine(\*FIND_ELF, \$LineNum)) { 348 if ($line =~ /^PREFIX\s+(.*)$/) { 349 $prefix = $1; 350 last; 351 } 352 353 die "$file: PREFIX expected on line $LineNum\n"; 354 } 355 356 357 # Process the remainder of the file. 358 while ($line = onbld_elfmod::GetLine(\*FIND_ELF, \$LineNum)) { 359 if ($line =~ /^OBJECT\s/i) { 360 push @ObjList, $line; 361 next; 362 } 363 364 if ($line =~ /^ALIAS\s/i) { 365 my ($item, $obj, $alias) = split(/\s+/, $line, 3); 366 my $str = "ALIAS\t$alias\n"; 367 368 if (defined($ObjToAlias{$obj})) { 369 $ObjToAlias{$obj} .= $str; 370 } else { 371 $ObjToAlias{$obj} = $str; 372 } 373 } 374 } 375 376 foreach $line (@ObjList) { 377 my ($item, $class, $type, $verdef, $obj) = 378 split(/\s+/, $line, 5); 379 380 my $alias = defined($ObjToAlias{$obj}) ? $ObjToAlias{$obj} : ''; 381 382 # We are only interested in sharable objects. We may see 383 # other file types if processing a list of objects 384 # supplied via the -f option. 385 next if ($type ne 'DYN'); 386 387 ProcFile($prefix, $obj, $class, $type, $verdef, $alias); 388 } 389 390 close FIND_ELF; 391} 392 393 394# ----------------------------------------------------------------------------- 395 396# Establish a program name for any error diagnostics. 397chomp($Prog = `basename $0`); 398 399# The onbld_elfmod package is maintained in the same directory as this 400# script, and is installed in ../lib/perl. Use the local one if present, 401# and the installed one otherwise. 402my $moddir = dirname($0); 403$moddir = "$moddir/../lib/perl" if ! -f "$moddir/onbld_elfmod.pm"; 404require "$moddir/onbld_elfmod.pm"; 405 406# Check that we have arguments. 407@SaveArgv = @ARGV; 408if ((getopts('E:e:f:hIi:ow:', \%opt) == 0) || (!$opt{f} && ($#ARGV == -1))) { 409 print "usage: $Prog [-hIo] [-E errfile] [-e exfile] [-f listfile]\n"; 410 print "\t\t[-i intffile] [-w outdir] file | dir, ...\n"; 411 print "\n"; 412 print "\t[-E errfile]\tdirect error output to file\n"; 413 print "\t[-e exfile]\texceptions file\n"; 414 print "\t[-f listfile]\tuse file list produced by find_elf -r\n"; 415 print "\t[-h]\tdo not produce a CDDL/Copyright header comment\n"; 416 print "\t[-I]\tExpand inheritance in -i output (debugging)\n"; 417 print "\t[-i intffile]\tcreate interface description output file\n"; 418 print "\t[-o]\t\tproduce one-liner output (prefixed with pathname)\n"; 419 print "\t[-w outdir]\tinterpret all files relative to given directory\n"; 420 exit 1; 421} 422 423# If -w, change working directory to given location 424!$opt{w} || chdir($opt{w}) || die "$Prog: can't cd to $opt{w}"; 425 426 427# Error messages go to stdout unless -E is specified. $ErrFH is a 428# file handle reference that points at the file handle where error messages 429# are sent. 430if ($opt{E}) { 431 open(ERROR, ">$opt{E}") || die "$Prog: open failed: $opt{E}"; 432 $ErrFH = \*ERROR; 433} else { 434 $ErrFH = \*STDOUT; 435} 436 437# Locate and process the exceptions file 438onbld_elfmod::LoadExceptionsToEXRE('interface_check'); 439 440# If creating an interface description output file, prepare it for use 441if ($opt{i}) { 442 open (INTFILE, ">$opt{i}") || 443 die "$Prog: Unable to create file: $opt{i}"; 444 445 # Generate the output header 446 onbld_elfmod::Header(\*INTFILE, $0, \@SaveArgv) if !$opt{h};; 447} 448 449# Number of OBJECTs output to INTFILE 450$ObjCnt = 0; 451 452# If we were passed a file previously produced by 'find_elf -r', use it. 453ProcFindElf($opt{f}) if $opt{f}; 454 455# Process each argument 456foreach my $Arg (@ARGV) { 457 # Run find_elf to find the files given by $Arg and process them 458 ProcFindElf("find_elf -frs $Arg|"); 459} 460 461# Close any working output files. 462close INTFILE if $opt{i}; 463close ERROR if $opt{E}; 464 465exit 0; 466