File kabi.pl of Package kernel-source.17044
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long;
use Data::Dumper;
# ( { sym => regexp, mod => regexp, fail => 0/1 }, ... )
my @rules;
my ($opt_verbose, $opt_rules);
# if Module.symvers also lists namespaces (>=5.4)
my $use_namespaces;
sub load_rules {
my $file = shift;
my $errors = 0;
xopen(my $fh, '<', $file);
while (<$fh>) {
chomp;
s/#.*//;
next if /^\s*$/;
my ($pattern, $verdict) = split(/\s+/);
my $new = {};
if (uc($verdict) eq "PASS") {
$new->{fail} = 0;
} elsif (uc($verdict) eq "FAIL") {
$new->{fail} = 1;
} else {
print STDERR "$file:$.: invalid verdict \"$verdict\", must be either PASS or FAIL.\n";
$errors++;
next;
}
# simple glob -> regexp conversion
$pattern =~ s/\*/.*/g;
$pattern =~ s/\?/./g;
$pattern =~ s/.*/^$&\$/;
# If it matches a module path or vmlinux
if ($pattern =~ /\/|^vmlinux$/) {
$new->{mod} = $pattern;
# If it's not a path and the string is all uppercase, assume it's a namespace
} elsif ($use_namespaces &&
$pattern !~ /\// && $pattern eq uc($pattern)) {
$new->{namespace} = $pattern;
} else {
$new->{sym} = $pattern;
}
push(@rules, $new);
}
if ($errors && !@rules) {
print STDERR "error: only garbage found in $file.\n";
exit 1;
}
close($fh);
}
# Return 1 if using new (>=5.4) Module.symvers format with namespaces
sub symvers_uses_namespaces {
my $file = shift;
xopen(my $fh, '<', $file);
my $line = <$fh>;
chomp $line;
# The new (>=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 > 3) {
return 1;
} else {
return 0;
}
}
sub load_symvers {
my $file = shift;
my %res;
my $errors = 0;
my $new;
xopen(my $fh, '<', $file);
while (<$fh>) {
chomp;
my @l = split(/\t/, $_, -1);
if (@l < 4) {
print STDERR "$file:$.: unknown line\n";
$errors++;
next;
}
if ($use_namespaces) {
$new = { crc => $l[0], mod => $l[2], type => $l[3], namespace => $l[4] };
} else {
$new = { crc => $l[0], mod => $l[2], type => $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 => 0x0,
EXPORT_SYMBOL_GPL => $type_GPL | $type_NOW,
EXPORT_SYMBOL_GPL_FUTURE => $type_GPL,
EXPORT_UNUSED_SYMBOL => $type_UNUSED,
EXPORT_UNUSED_SYMBOL_GPL => $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 -> fail
return !(~$types{$old} & $types{$new});
}
my $kabi_errors = 0;
sub kabi_change {
my ($sym, $symvers, $message) = @_;
my $fail = 1;
for my $rule (@rules) {
if ($rule->{mod} && $symvers->{mod} =~ $rule->{mod} ||
$rule->{sym} && $sym =~ $rule->{sym} ||
($use_namespaces && $rule->{namespace} &&
$symvers->{namespace} =~ $rule->{namespace})) {
$fail = $rule->{fail};
last;
}
}
return unless $fail or $opt_verbose;
print STDERR "KABI: symbol $sym(mod:$symvers->{mod}";
if ($use_namespaces && $symvers->{namespace}) {
print STDERR " ns:$symvers->{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' => \$opt_verbose,
'rules|r=s' => \$opt_rules,
);
if (!$res || @ARGV != 2) {
print STDERR "Usage: $0 [--rules <rules file>] 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}->{crc} ne $new{$sym}->{crc}) {
kabi_change($sym, $old{$sym}, "changed crc from " .
"$old{$sym}->{crc} to $new{$sym}->{crc}");
} elsif (!type_compatible($old{$sym}->{type}, $new{$sym}->{type})) {
kabi_change($sym, $old{$sym}, "changed type from " .
"$old{$sym}->{type} to $new{$sym}->{type}");
}
}
if ($kabi_errors) {
print STDERR "KABI: aborting due to kabi changes.\n";
exit 1;
}
exit 0;