File kabi.pl of Package kernel-default
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long;
use Data::Dumper;
# ( { sym => regexp, mod => regexp, verdict -> FAIL/PASS/EXCLUDE }, ... )
my @rules;
my ($opt_verbose, $opt_rules, $opt_filter);
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 = {};
$verdict = uc($verdict);
if ($verdict !~ /^(FAIL|PASS|EXCLUDE)$/) {
print STDERR "$file:$.: invalid verdict \"$verdict\", must be either PASS or FAIL.\n";
$errors++;
next;
}
$new->{verdict} = $verdict;
# simple glob -> regexp conversion
$pattern =~ s/\*/.*/g;
$pattern =~ s/\?/./g;
$pattern =~ s/.*/^$&\$/;
if ($pattern =~ /:/) {
($new->{mod}, $new->{sym}) = split(/:/, $pattern);
} elsif ($pattern =~ /\/|^vmlinux$/) {
$new->{mod} = $pattern;
} else {
$new->{sym} = $pattern;
}
push(@rules, $new);
}
if ($errors && !@rules) {
print STDERR "error: only garbage found in $file.\n";
exit 1;
}
close($fh);
}
sub find_verdict {
my ($mod, $sym) = @_;
for my $rule (@rules) {
if ($rule->{mod} && $mod =~ $rule->{mod} ||
$rule->{sym} && $sym =~ $rule->{sym}) {
return $rule->{verdict};
}
}
return "";
}
sub filter_symbols {
my $symvers = shift;
while (<>) {
my ($sym, $mod);
# support the Module.symvers format or rpm provides format
if (/^0x/) {
my @a = split;
chomp @a;
$sym = $a[1];
$mod = $a[2];
} else {
if (!/^ksym\(/) {
print;
next;
}
$sym = $_;
chomp $sym;
$sym =~ s/^ksym\(.*://;
$sym =~ s/\).*//;
$mod = $symvers->{$sym}->{mod};
if (!$mod) {
print STDERR "Warning: symbol $sym not found in symvers file\n";
print;
next;
}
}
next if find_verdict($symvers->{$sym}->{mod}, $sym) eq "EXCLUDE";
print;
}
}
sub load_symvers {
my $file = shift;
my %res;
my $errors = 0;
xopen(my $fh, '<', $file);
while (<$fh>) {
my @l = split(/\s+/);
if (@l < 3) {
print STDERR "$file:$.: unknown line\n";
$errors++;
next;
}
my $new = { crc => $l[0], mod => $l[2] };
$res{$l[1]} = $new;
}
if (!%res) {
print STDERR "error: no symvers found in $file.\n";
exit 1;
}
close($fh);
return %res;
}
my $kabi_errors = 0;
sub kabi_change {
my ($sym, $mod, $oldcrc, $newcrc) = @_;
my $fail;
$fail = (find_verdict($mod, $sym) eq "FAIL");
return unless $fail or $opt_verbose;
print STDERR "KABI: symbol $sym($mod) ";
if ($newcrc) {
print STDERR "changed crc from $oldcrc to $newcrc"
} else {
print STDERR "lost";
}
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,
'filter-symbols' => \$opt_filter,
'rules|r=s' => \$opt_rules,
);
if (!($res && (@ARGV == 2 && !$opt_filter|| @ARGV == 1 && $opt_filter))) {
print STDERR "Usage: $0 [--rules <rules file>] Module.symvers.old Module.symvers\n";
print STDERR " $0 [--rules <rules file>] --filter-symbols Module.symvers < list-of-symbols\n";
exit 1;
}
if (defined($opt_rules)) {
load_rules($opt_rules);
}
my %old = load_symvers(shift @ARGV);
if ($opt_filter) {
filter_symbols(\%old);
exit 0;
}
my %new = load_symvers(shift @ARGV);
for my $sym (sort keys(%old)) {
if (!$new{$sym}) {
kabi_change($sym, $old{$sym}->{mod}, $old{$sym}->{crc}, 0);
} elsif ($old{$sym}->{crc} ne $new{$sym}->{crc}) {
kabi_change($sym, $new{$sym}->{mod}, $old{$sym}->{crc},
$new{$sym}->{crc});
}
}
if ($kabi_errors) {
print STDERR "KABI: aborting due to kabi changes.\n";
exit 1;
}
exit 0;