xref: /illumos-gate/usr/src/tools/scripts/interface_cmp.pl (revision 598f4ceed9327d2d6c2325dd67cae3aa06f7fea6)
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