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