<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl
use strict;
use warnings;

use Getopt::Long;
use Data::Dumper;

# ( { sym =&gt; regexp, mod =&gt; regexp, fail =&gt; 0/1 }, ... )
my @rules;
my ($opt_verbose, $opt_rules);

# if Module.symvers also lists namespaces (&gt;=5.4)
my $use_namespaces;

sub load_rules {
	my $file = shift;
	my $errors = 0;

	xopen(my $fh, '&lt;', $file);
	while (&lt;$fh&gt;) {
		chomp;
		s/#.*//;
		next if /^\s*$/;
		my ($pattern, $verdict) = split(/\s+/);
		my $new = {};
		if (uc($verdict) eq "PASS") {
			$new-&gt;{fail} = 0;
		} elsif (uc($verdict) eq "FAIL") {
			$new-&gt;{fail} = 1;
		} else {
			print STDERR "$file:$.: invalid verdict \"$verdict\", must be either PASS or FAIL.\n";
			$errors++;
			next;
		}
		# simple glob -&gt; regexp conversion
		$pattern =~ s/\*/.*/g;
		$pattern =~ s/\?/./g;
		$pattern =~ s/.*/^$&amp;\$/;

		# If it matches a module path or vmlinux
		if ($pattern =~ /\/|^vmlinux$/) {
			$new-&gt;{mod} = $pattern;
		# If it's not a path and the string is all uppercase, assume it's a namespace
		} elsif ($use_namespaces &amp;&amp;
			$pattern !~ /\// &amp;&amp; $pattern eq uc($pattern)) {
			$new-&gt;{namespace} = $pattern;
		} else {
			$new-&gt;{sym} = $pattern;
		}
		push(@rules, $new);
	}
	if ($errors &amp;&amp; !@rules) {
		print STDERR "error: only garbage found in $file.\n";
		exit 1;
	}
	close($fh);
}

# Return 1 if using new (&gt;=5.4) Module.symvers format with namespaces
sub symvers_uses_namespaces {
	my $file = shift;
	xopen(my $fh, '&lt;', $file);
	my $line =  &lt;$fh&gt;;
	chomp $line;

	# The new (&gt;=5.4) Module.symvers format has 4 tabs (5 fields):
	#
	#    crc\tsymbol\tmodule\texport_type\tnamespace
	#
	# The older Module.symvers format only has 3 tabs (4 fields):
	#
	#    crc\tsymbol\tmodule\texport_type

	my $num_tabs = $line =~ tr/\t//;
	if ($num_tabs &gt; 3) {
		return 1;
	} else {
		return 0;
	}
}

sub load_symvers {
	my $file = shift;
	my %res;
	my $errors = 0;
	my $new;

	xopen(my $fh, '&lt;', $file);
	while (&lt;$fh&gt;) {
		chomp;
		my @l = split(/\t/, $_, -1);
		if (@l &lt; 4) {
			print STDERR "$file:$.: unknown line\n";
			$errors++;
			next;
		}
		if ($use_namespaces) {
			$new = { crc =&gt; $l[0], mod =&gt; $l[2], type =&gt; $l[3], namespace =&gt; $l[4] };
		} else {
			$new = { crc =&gt; $l[0], mod =&gt; $l[2], type =&gt; $l[3] };
		}
		$res{$l[1]} = $new;
	}
	if (!%res) {
		print STDERR "error: no symvers found in $file.\n";
		exit 1;
	}
	close($fh);
	return %res;
}

# Each bit represents a restriction of the export and adding a restriction
# fails the check
my $type_GPL    = 0x1;
my $type_NOW    = 0x2;
my $type_UNUSED = 0x4;
my %types = (
	EXPORT_SYMBOL            =&gt; 0x0,
	EXPORT_SYMBOL_GPL        =&gt; $type_GPL | $type_NOW,
	EXPORT_SYMBOL_GPL_FUTURE =&gt; $type_GPL,
	EXPORT_UNUSED_SYMBOL     =&gt; $type_UNUSED,
	EXPORT_UNUSED_SYMBOL_GPL =&gt; $type_UNUSED | $type_GPL | $type_NOW
);

sub type_compatible {
	my ($old, $new) = @_;

	for my $type ($old, $new) {
		if (!exists($types{$type})) {
			print STDERR "error: unrecognized export type $type.\n";
			exit 1;
		}
	}
	# if $new has a bit set that $old does not -&gt; fail
	return !(~$types{$old} &amp; $types{$new});
}

my $kabi_errors = 0;
sub kabi_change {
	my ($sym, $symvers, $message) = @_;
	my $fail = 1;

	for my $rule (@rules) {
		if ($rule-&gt;{mod} &amp;&amp; $symvers-&gt;{mod} =~ $rule-&gt;{mod} ||
		    $rule-&gt;{sym} &amp;&amp; $sym =~ $rule-&gt;{sym} ||
			($use_namespaces &amp;&amp; $rule-&gt;{namespace} &amp;&amp;
				$symvers-&gt;{namespace} =~ $rule-&gt;{namespace})) {
			$fail = $rule-&gt;{fail};
			last;
		}
	}
	return unless $fail or $opt_verbose;

	print STDERR "KABI: symbol $sym(mod:$symvers-&gt;{mod}";
	if ($use_namespaces &amp;&amp; $symvers-&gt;{namespace}) {
		print STDERR " ns:$symvers-&gt;{namespace}";
	}
	print STDERR ") $message";
	if ($fail) {
		$kabi_errors++;
		print STDERR "\n";
	} else {
		print STDERR " (tolerated)\n";
	}
}

sub xopen {
	open($_[0], $_[1], @_[2..$#_]) or die "$_[2]: $!\n";
}

my $res = GetOptions(
	'verbose|v' =&gt; \$opt_verbose,
	'rules|r=s' =&gt; \$opt_rules,
);
if (!$res || @ARGV != 2) {
	print STDERR "Usage: $0 [--rules &lt;rules file&gt;] Module.symvers.old Module.symvers\n";
	exit 1;
}

# Determine symvers format
$use_namespaces = symvers_uses_namespaces($ARGV[0]);

if (defined($opt_rules)) {
	load_rules($opt_rules);
}
my %old = load_symvers($ARGV[0]);
my %new = load_symvers($ARGV[1]);

for my $sym (sort keys(%old)) {
	if (!$new{$sym}) {
		kabi_change($sym, $old{$sym}, "lost");
	} elsif ($old{$sym}-&gt;{crc} ne $new{$sym}-&gt;{crc}) {
		kabi_change($sym, $old{$sym}, "changed crc from " .
			"$old{$sym}-&gt;{crc} to $new{$sym}-&gt;{crc}");
	} elsif (!type_compatible($old{$sym}-&gt;{type}, $new{$sym}-&gt;{type})) {
		kabi_change($sym, $old{$sym}, "changed type from " .
			"$old{$sym}-&gt;{type} to $new{$sym}-&gt;{type}");
	}
}
if ($kabi_errors) {
	print STDERR "KABI: aborting due to kabi changes.\n";
	exit 1;
}
exit 0;
</pre></body></html>