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# interface_cmp audits two interface definition files (as created by 29# interface_check) against one another, and confirms that: 30# 31# o All versioned libraries that were present in the previous interface 32# are present in the new interface 33# 34# o for each non-private interface in a library confirm that no symbols 35# have been removed and that no symbols have been added to it between 36# the two revisions 37# 38# Return codes: 39# 40# 0 All interfaces in the new release are identical in old release. 41# 1 Something is different refer to the error messages. 42 43 44use strict; 45 46use POSIX qw(getenv); 47use Getopt::Std; 48use File::Basename; 49 50#### Define all global variables (required for strict) 51use vars qw($Prog); 52use vars qw(%opt); 53use vars qw(%old_hash %old_alias %new_hash %new_alias); 54 55# Exception Arrays: 56# 57# The ADDSYM and DELSYM exceptions are maintained on the @AddSymList 58# and @DelSymList arrays, respectively. Each array element is a reference 59# to a subarray of triples: 60# (sym_re, ver_re, obj_re) 61# where each item in the tripple is a regular expression, used to 62# match a particular symbol/version/object combination. 63# 64# The EMPTY_TOPVERSION exceptions are maintained on the @EmptyTopVerList 65# array. Each array element is a reference to a subarray of pairs: 66# (ver_re, obj_re) 67# where each item in the pair is a regular expression, used to 68# match a particular version/object combination. 69# 70use vars qw(@AddSymList @DelSymList @EmptyTopVerList); 71 72 73## LoadExceptions 74# 75# Locate the exceptions file and process its contents. We can't use 76# onbld_elfmod::LoadExceptionsToEXRE() for this, because our exceptions 77# need to support more than a single regular expression. 78# 79# exit: 80# @AddSymList, @DelSymList, and @EmptyTopVerList have been updated 81# 82# note: 83# We expand strings of the form MACH(dir) to match the given 84# directory as well as any 64-bit architecture subdirectory that 85# might be present (i.e. amd64, sparcv9). 86# 87sub LoadExceptions { 88 my $file; 89 my $Line; 90 my $LineNum = 0; 91 my $err = 0; 92 93 # Locate the exception file 94 FILE: { 95 # If -e is specified, that file must be used 96 if ($opt{e}) { 97 $file = $opt{e}; 98 last FILE; 99 } 100 101 # If this is an activated workspace, use the exception 102 # file found in the exceptions_list directory. 103 if (defined($ENV{CODEMGR_WS})) { 104 $file = "$ENV{CODEMGR_WS}/exception_lists/interface_cmp"; 105 last FILE if (-f $file); 106 } 107 108 # As a final backstop, the SUNWonbld package provides a 109 # copy of the exception file. This can be useful if we 110 # are being used with an older workspace. 111 # 112 # This script is installed in the SUNWonbld bin directory, 113 # while the exception file is in etc/exception_lists. Find 114 # it relative to the script location given by $0. 115 $file = dirname($0) . "/../etc/exception_lists/interface_cmp"; 116 last FILE if (-f $file); 117 118 # No exception file was found. 119 return; 120 } 121 122 open (EFILE, $file) || 123 die "$Prog: unable to open exceptions file: $file"; 124 while ($Line = onbld_elfmod::GetLine(\*EFILE, \$LineNum)) { 125 126 # Expand MACH() 127 $Line =~ s/MACH\(([^)]+)\)/$1(\/amd64|\/sparcv9)?/g; 128 129 if ($Line =~ /^DELSYM\s+/) { 130 my ($item, $sym_re, $ver_re, $obj_re) = 131 split(/\s+/, $Line, 4); 132 push @DelSymList, [ $sym_re, $ver_re, $obj_re ]; 133 next; 134 } 135 136 if ($Line =~ /^ADDSYM\s+/) { 137 my ($item, $sym_re, $ver_re, $obj_re) = 138 split(/\s+/, $Line, 4); 139 push @AddSymList, [ $sym_re, $ver_re, $obj_re ]; 140 next; 141 } 142 143 if ($Line =~ /^EMPTY_TOPVERSION\s+/) { 144 my ($item, $ver_re, $obj_re) = split(/\s+/, $Line, 3); 145 push @EmptyTopVerList, [ $ver_re, $obj_re ]; 146 next; 147 } 148 149 $err++; 150 printf(STDERR "$file: Unrecognized option: ". 151 "line $LineNum: $Line\n"); 152 } 153 close EFILE; 154 155 exit 1 if ($err != 0); 156} 157 158## ExSym(SymList, sym, ver, obj) 159# 160# Compare a given symbol/version/object combination against the 161# exceptions found in the given list. 162# 163# entry: 164# SymList - Reference to @AddSymList, or @DelSymList. 165# sym, ver, obj - Combination to be compared against exception list 166# 167# exit: 168# Returns True (1) if there is a match, and False (0) otherwise. 169# 170sub ExSym { 171 my ($SymList, $sym, $ver, $obj) = @_; 172 173 foreach my $ex (@$SymList) { 174 return 1 if ($obj =~ /$$ex[2]/) && ($ver =~ /$$ex[1]/) && 175 ($sym =~ /$$ex[0]/); 176 } 177 178 return 0; 179} 180 181## ExTopVer(ver, obj) 182# 183# Compare a given version/object combination against the pairs found 184# in @EmptyTopVerList. 185# 186# entry: 187# ver, obj - Combination to be compared against empty top version list 188# 189# exit: 190# Returns True (1) if there is a match, and False (0) otherwise. 191# 192sub ExTopVer { 193 my ($ver, $obj) = @_; 194 195 foreach my $ex (@EmptyTopVerList) { 196 return 1 if ($obj =~ /$$ex[1]/) && ($ver =~ /$$ex[0]/); 197 } 198 199 return 0; 200} 201 202## ExpandInheritance(objhashref) 203# 204# For each version contained in the specified object hash reference, 205# add the inherited symbols. 206# 207sub ExpandInheritance { 208 my $obj = $_[0]; 209 210 # Versions to process. Typically, inheriting versions come before 211 # the versions they inherit. Processing the list in reverse order 212 # maximizes the odds that a needed sub-version will have already 213 # have been processed. 214 my @vers = reverse(@{$obj->{'VERSION_NAMES'}}); 215 216 # Versions to process in the next pass 217 my @next_vers = (); 218 219 # Hash, indexed by version name, that reflects whether the version 220 # has been expanded yet or not. 221 my %done = (); 222 223 while (scalar(@vers) > 0) { 224 foreach my $name (@vers) { 225 my $i; 226 my $defer = 0; 227 my $cur_version = $obj->{'VERSION_INFO'}{$name}; 228 my ($top, $direct, $total, $symhash, $inheritarr) = 229 @{$cur_version}; 230 231 # In order to expand this version, all the inherited 232 # versions must already have been done. If not, put 233 # this version on @next_vers for the next pass. 234 my $num = scalar(@$inheritarr); 235 for ($i = 0; $i < $num; $i++) { 236 if (!$done{$inheritarr->[$i]}) { 237 $defer = 1; 238 push @next_vers, $name; 239 last; 240 } 241 } 242 next if ($defer); 243 244 # Add all the symbols from the inherited versions 245 # to this one. 246 for ($i = 0; $i < $num; $i++) { 247 my $i_version = 248 $obj->{'VERSION_INFO'}{$inheritarr->[$i]}; 249 my $i_symhash = $i_version->[3]; 250 251 foreach my $sym (keys %$i_symhash) { 252 if (!defined($cur_version->[3]{$sym})) { 253 $cur_version->[2]++; 254 $cur_version->[3]{$sym} = 'INHERIT'; 255 } 256 } 257 } 258 259 $done{$name} = 1; 260 } 261 262 @vers = @next_vers; 263 @next_vers = (); 264 } 265} 266 267## ReadInterface(file, alias) 268# 269# Read the interface description file, as produced by interface_check, and 270# return a hash describing it. 271# 272# entry: 273# file - Interface file to read. 274# alias - Refence to hash to be filled in with any aliases 275# that are seen in the file. The alias name is the key, 276# and the object is the value. 277# 278# exit: 279# The hash referenced by alias has been updated. 280# 281# The return value is a hash that encapsulates the interface 282# information. This hash returned uses the object names as the 283# key. Each key references a sub-hash that contains information 284# for that object: 285# 286# CLASS -> ELFCLASS 287# TYPE -> ELF type 288# VERSION_NAMES -> Reference to array [1..n] of version names, in the 289# order they come from the input file. 290# VERSION_INFO -> Reference to hash indexed by version name, yielding 291# a reference to an array containing information about 292# that version. 293# 294# The arrays referenced via VERSION_INFO are of the form: 295# 296# (top, new, total, symhashref, inheritarrref) 297# 298# where: 299# top - 1 if version is a TOP_VERSION, 0 for a regular VERSION 300# new - Number of symbols defined explicitly by version 301# total - Number of symbols included in version, both new, 302# and via inheritance. 303# symhashref - Reference to hash indexed by symbol names, and 304# yielding true (1). 305# inheritarrref - Reference to array of names of versions 306# inherited by this one. 307# 308sub ReadInterface { 309 my ($file, $alias) = @_; 310 my %main_hash = (); 311 my $Line; 312 my $LineNum = 0; 313 my $obj_name; 314 my $obj_hash; 315 my $sym_ok = 0; 316 my $cur_version; 317 318 open(FILE, $file) || die "$Prog: Unable to open: $file"; 319 320 # Until we see an OBJECT line, nothing else is valid. To 321 # simplify the error handling, use a simple initial loop to 322 # read the file up to that point 323 while ($Line = onbld_elfmod::GetLine(\*FILE, \$LineNum)) { 324 if ($Line =~ s/^OBJECT\s+//i) { 325 $obj_name = $Line; 326 $main_hash{$obj_name} = {}; 327 $obj_hash = $main_hash{$obj_name}; 328 last; 329 } 330 die "$file: OBJECT expected on line $LineNum: $Line\n"; 331 } 332 333 # Read the remainder of the file 334 while ($Line = onbld_elfmod::GetLine(\*FILE, \$LineNum)) { 335 # Items are parsed in order of decreasing frequency 336 337 if ($Line =~ 338 /^SYMBOL\s+([^\s]+)$/i) { 339 my $sym = $1; 340 341 die "$file: SYMBOL not expected on line $LineNum: $Line\n" 342 if !$sym_ok; 343 344 $cur_version->[1]++; 345 $cur_version->[2]++; 346 $cur_version->[3]{$sym} = 'NEW'; 347 next; 348 } 349 350 if ($Line =~ /^((TOP_)?VERSION)\s+([^\s]+)(\s+\{(.*)\})?\s*$/i) { 351 my ($top, $name, $inherit) = ($2, $3, $5); 352 353 $top = defined($top) ? 1 : 0; 354 355 my @inheritarr = defined($inherit) ? 356 split /[,{\s]+/, $inherit : (); 357 358 $cur_version = [ $top, 0, 0, {}, \@inheritarr ]; 359 $obj_hash->{'VERSION_INFO'}{$name} = $cur_version; 360 361 push @{$obj_hash->{'VERSION_NAMES'}}, $name; 362 $sym_ok = 1; 363 next; 364 } 365 366 if ($Line =~ /^OBJECT\s+([^\s]+)$/i) { 367 my $prev_obj_hash = $obj_hash; 368 $obj_name = $1; 369 $main_hash{$obj_name} = {}; 370 $obj_hash = $main_hash{$obj_name}; 371 372 # Expand the versions for the object just processed 373 ExpandInheritance($prev_obj_hash); 374 next; 375 } 376 377 if ($Line =~ /^CLASS\s+([^\s]+)$/i) { 378 $obj_hash->{'CLASS'} = $1; 379 next; 380 } 381 382 if ($Line =~ /^TYPE\s+([^\s]+)$/i) { 383 $obj_hash->{'TYPE'} = $1; 384 next; 385 } 386 387 if ($Line =~ /^ALIAS\s+([^\s]+)$/i) { 388 $$alias{$1} = $obj_name; 389 next; 390 } 391 392 die "$file: unrecognized item on line $LineNum: $Line\n"; 393 } 394 close FILE; 395 396 # Expand the versions for the final object from the file 397 ExpandInheritance($obj_hash); 398 399 return %main_hash; 400} 401 402## PrintInterface(main_hash, alias) 403# 404# Dump the contents of main_hash and alias to stdout in the same format 405# used by interface_check to produce the input interface file. This output 406# should diff cleanly against the original (ignoring the header comments). 407# 408sub PrintInterface { 409 my ($main_hash, $alias_hash) = @_; 410 411 foreach my $obj (sort keys %$main_hash) { 412 print "OBJECT\t$obj\n"; 413 print "CLASS\t$main_hash->{$obj}{'CLASS'}\n"; 414 print "TYPE\t$main_hash->{$obj}{'TYPE'}\n"; 415 416 # This is inefficient, but good enough for debugging 417 # Look at all the aliases and print those that belong 418 # to this object. 419 foreach my $alias (sort keys %$alias_hash) { 420 print "ALIAS\t$alias\n" 421 if ($obj eq $alias_hash->{$alias}); 422 } 423 424 next if !defined($main_hash->{$obj}{'VERSION_NAMES'}); 425 426 my $num = scalar(@{$main_hash->{$obj}{'VERSION_NAMES'}}); 427 my $i; 428 for ($i = 0; $i < $num; $i++) { 429 my $name = $main_hash->{$obj}{'VERSION_NAMES'}[$i]; 430 my ($top, $direct, $total, $symhash, $inheritarr) = 431 @{$main_hash->{$obj}{'VERSION_INFO'}{$name}}; 432 433 $top = $top ? "TOP_" : ''; 434 435 my $inherit = (scalar(@$inheritarr) > 0) ? 436 "\t{" . join(', ', @{$inheritarr}) . "}" : ''; 437 438 print "${top}VERSION\t$name$inherit\n"; 439 440 foreach my $sym (sort keys %$symhash) { 441 print "\t$symhash->{$sym}\t$sym\n"; 442 } 443 } 444 } 445} 446 447## compare() 448# 449# Compare the old interface definition contained in (%old_hash, %old_alias) 450# with the new interface contained in (%new_hash, %new_alias). 451# 452sub compare { 453 foreach my $old_obj (sort keys %old_hash) { 454 my $new_obj = $old_obj; 455 my $Ttl = 0; 456 457 # If the object does not exist in the new interface, 458 # then see if there's an alias for it. Failing that, 459 # we simply ignore the object. 460 if (!defined($new_hash{$new_obj})) { 461 next if !defined($new_alias{$new_obj}); 462 $new_obj = $new_alias{$new_obj}; 463 } 464 465 my $old = $old_hash{$old_obj}; 466 my $new = $new_hash{$new_obj}; 467 468 # Every version in the old object must exist in the new object, 469 # and there must be exactly the same symbols in each. 470 my $num = scalar(@{$old->{'VERSION_NAMES'}}); 471 for (my $i = 0; $i < $num; $i++) { 472 my $name = $old->{'VERSION_NAMES'}[$i]; 473 474 # New object must have this version 475 if (!defined($new->{'VERSION_INFO'}{$name})) { 476 onbld_elfmod::OutMsg2(\*STDOUT, \$Ttl, $old_obj, 477 $new_obj, "$name: deleted version"); 478 next; 479 } 480 481 my ($old_top, $old_direct, $old_total, $old_symhash) = 482 @{$old->{'VERSION_INFO'}{$name}}; 483 my ($new_top, $new_direct, $new_total, $new_symhash) = 484 @{$new->{'VERSION_INFO'}{$name}}; 485 486 # If this is an empty top version, and the old object 487 # has the EMPTY_TOPVERSION exception set, then we 488 # skip it as if it were not present. 489 next if $old_top && ($old_direct == 0) && 490 ExTopVer($name, $old_obj); 491 492 # We check that every symbol in the old object is 493 # in the new one to detect deleted symbols. We then 494 # check that every symbol in the new object is also 495 # in the old object, to find added symbols. If the 496 # "deleted" check is clean, and the two objects have 497 # the same number of symbols in their versions, then we 498 # can skip the "added" test, because we know that 499 # there is no room for an addition to have happened. 500 # Since most objects satisfy these constraints, we 501 # end up doing roughly half the number of comparisons 502 # that would otherwise be needed. 503 my $check_added_syms = 504 ($old_total == $new_total) ? 0: 1; 505 506 # Every symbol in the old version must be in the new one 507 foreach my $sym (sort keys %$old_symhash) { 508 if (!defined($new_symhash->{$sym})) { 509 onbld_elfmod::OutMsg2(\*STDOUT, 510 \$Ttl, $old_obj, $new_obj, 511 "$name: deleted interface: $sym") 512 if !ExSym(\@DelSymList, 513 $sym, $name, $new_obj); 514 $check_added_syms = 1; 515 } 516 } 517 518 # Do the "added" check, unless we can optimize it away. 519 # Every symbol in the new version must be in the old one. 520 if ($check_added_syms) { 521 foreach my $sym (sort keys %$new_symhash) { 522 if (!defined($old_symhash->{$sym})) { 523 next if ExSym(\@AddSymList, 524 $sym, $name, $new_obj); 525 onbld_elfmod::OutMsg2(\*STDOUT, 526 \$Ttl, $old_obj, $new_obj, 527 "$name: added interface: $sym"); 528 } 529 } 530 } 531 532 # We want to ensure that version numbers in an 533 # inheritance chain don't go up by more than 1 in 534 # any given release. If the version names are in the 535 # numbered <PREFIX>x.y[.z] format, we can compare the 536 # two top versions and see if this has happened. 537 # 538 # For a given <PREFIX>x.y[.z], valid sucessors would 539 # be <PREFIX>x.(y+1) or <PREFIX>x.y.(z+1), where z is 540 # assumed to be 0 if not present. 541 # 542 # This check only makes sense when the new interface 543 # is a direct decendent of the old one, as specified 544 # via the -d option. If the two interfaces are more 545 # than one release apart, we should not do this test. 546 next if !($opt{d} && $old_top && !$new_top); 547 548 # Known numbered version? 549 # 550 # Key to @Cat contents: 551 # [0] 'NUMBERED' 552 # [1] number of dot separated numeric fields. 2 or 3. 553 # [2] prefix 554 # [3] major # 555 # [4] minor # 556 # [5] micro # (only if [1] is 3) 557 my @Cat = onbld_elfmod_vertype::Category($name, ''); 558 next if ($Cat[0] ne 'NUMBERED'); 559 560 my $iname1 = "$Cat[2]$Cat[3]." . ($Cat[4] + 1); 561 my $iname2; 562 if ($Cat[1] == 3) { 563 $iname2 = "$Cat[2]$Cat[3].$Cat[4]." . ($Cat[5] + 1); 564 } else { 565 $iname2 = "$Cat[2]$Cat[3].$Cat[4].1"; 566 } 567 568 if (defined($new->{'VERSION_INFO'}{$iname1}) || 569 defined($new->{'VERSION_INFO'}{$iname2})) { 570 my $i_top = 571 $new->{'VERSION_INFO'}{$iname1}[0] || 572 $new->{'VERSION_INFO'}{$iname2}[0]; 573 if (!$i_top) { 574 onbld_elfmod::OutMsg2(\*STDOUT, 575 \$Ttl, $old_obj, $new_obj, 576 "$name: inconsistant " . 577 "version increment: " . 578 "expect $iname1 or $iname2 ". 579 "to replace top version"); 580 } 581 } else { 582 onbld_elfmod::OutMsg2(\*STDOUT, 583 \$Ttl, $old_obj, $new_obj, 584 "$name: expected superseding " . 585 "top version to $name not " . 586 "present: $iname1 or $iname2"); 587 } 588 } 589 590 591 # Empty versions in the established interface description 592 # are usually the result of fixing a versioning mistake 593 # at some point in the past. These versions are part of 594 # the public record, and cannot be changed now. However, if 595 # comparing two interface descriptions from the same gate, 596 # flag any empty versions in the new interface description 597 # that are not present in the old one. These have yet to 598 # become part of the official interface, and should be removed 599 # before they do. 600 next if !$opt{d}; 601 602 $num = scalar(@{$new->{'VERSION_NAMES'}}); 603 for (my $i = 0; $i < $num; $i++) { 604 my $name = $new->{'VERSION_NAMES'}[$i]; 605 606 # If old object has this version, skip it 607 next if defined($old->{'VERSION_INFO'}{$name}); 608 609 # If explicitly whitelisted, skip it 610 next if ExTopVer($name, $new_obj); 611 612 my ($new_top, $new_direct, $new_total, $new_symhash) = 613 @{$new->{'VERSION_INFO'}{$name}}; 614 615 if ($new_direct == 0) { 616 onbld_elfmod::OutMsg2(\*STDOUT, 617 \$Ttl, $old_obj, $new_obj, 618 "$name: invalid empty new version"); 619 } 620 } 621 } 622 623} 624 625 626 627# ----------------------------------------------------------------------------- 628 629# Establish a program name for any error diagnostics. 630chomp($Prog = `basename $0`); 631 632# Check that we have arguments. Normally, 2 plain arguments are required, 633# but if -t is present, only one is allowed. 634if ((getopts('c:de:ot', \%opt) == 0) || (scalar(@ARGV) != ($opt{t} ? 1 : 2))) { 635 print "usage: $Prog [-dot] [-c vtype_mod] [-e exfile] old new\n"; 636 print "\t[-c vtype_mod]\tsupply alternative version category module\n"; 637 print "\t[-d]\t\tnew is a direct decendent of old\n"; 638 print "\t[-e exfile]\texceptions file\n"; 639 print "\t[-o]\t\tproduce one-liner output (prefixed with pathname)\n"; 640 print "\t[-t]\tParse old, and recreate to stdout\n"; 641 exit 1; 642} 643 644# We depend on the onbld_elfmod and onbld_elfmod_vertype perl modules. 645# Both modules are maintained in the same directory as this script, 646# and are installed in ../lib/perl. Use the local one if present, 647# and the installed one otherwise. 648# 649# The caller is allowed to supply an alternative implementation for 650# onbld_elfmod_vertype via the -c option. In this case, the alternative 651# implementation is expected to provide the same interface as the standard 652# copy, and is loaded instead. 653# 654my $moddir = my $vermoddir = dirname($0); 655$moddir = "$moddir/../lib/perl" if ! -f "$moddir/onbld_elfmod.pm"; 656require "$moddir/onbld_elfmod.pm"; 657if ($opt{c}) { 658 require "$opt{c}"; 659} else { 660 $vermoddir = "$vermoddir/../lib/perl" 661 if ! -f "$vermoddir/onbld_elfmod_vertype.pm"; 662 require "$vermoddir/onbld_elfmod_vertype.pm"; 663} 664 665# Locate and process the exceptions file 666LoadExceptions(); 667 668%old_alias = (); 669%old_hash = ReadInterface($ARGV[0], \%old_alias); 670 671# If -t is present, only one argument is allowed --- we parse it, and then 672# print the same information back to stderr in the same format as the original. 673# This is useful for debugging, to verify that the parsing is correct. 674if ($opt{t}) { 675 PrintInterface(\%old_hash, \%old_alias); 676 exit 0; 677} 678 679%new_alias = (); 680%new_hash = ReadInterface($ARGV[1], \%new_alias); 681 682compare(); 683 684exit 0; 685