#!/usr/bin/perl -w
#
# (C) Copyright IBM Corporation 2005.
#	Released under GPL v2.
#	Author : Ram Pai (linuxram@us.ibm.com)
#

#do some initial processing of the command line input.
use Getopt::Std;
use strict;

my $version="0.9";
my $abiextract="abiextract";

sub usage {
	print "@_: version = $version\n";
	die "Usage: @_ [-k Module.symvers] [-h] { -m module | -f file_containing_modules -r rpm } [ -c abiextract.c ]\n";
}

sub unpackrpm {
	my $rpm = shift;
	my $rpmdir = shift;
	my $modules = shift;

	my $cwd=qx(pwd); chomp $cwd;
	$rpm = ($rpm =~ m(^/)) ? "$rpm" : "$cwd/$rpm";

	qx(mkdir -p $rpmdir; cd $rpmdir; rpm2cpio $rpm | cpio -ivd --no-absolute-filenames --quiet \* 2>&1);
	return 1 if ($?);
	@{$modules}=qx(find $rpmdir -name \*.o -or -name \*.ko);
	chomp @{$modules};
	return 0;
}

my (%opt, @modulelist, $tmp, %SYMBOL);

if (not getopts("hk:m:f:r:c:", \%opt) or defined $opt{'h'}) {
	usage($0);
}

if (defined $opt{'m'}) {
	push (@modulelist , $opt{'m'});
}

if (defined($opt{'f'})) {
	if ( not -f $opt{'f'} ) {
		die "Sorry, cannot open the file $opt{'f'} $!\n";
	}
	my @file = split /\s+/, qx(cat $opt{'f'});
	push (@modulelist, @file);
	chomp @modulelist;
}

$tmp=qx(mktemp -dq /var/tmp/ibm.abiXXXXXX);chomp $tmp;

if (defined($opt{'r'})) {
	qx(mkdir -p $tmp/rpm);
	if (unpackrpm($opt{'r'}, "${tmp}/rpm", \@modulelist)) {
		die "Sorry, rpm corrupt\n";
	}
}

if (defined($opt{'c'})) {
	if (not -f $opt{'c'}) {
		die "Sorry $opt{'c'}: $!\n";
	}
	qx(file -i $opt{'c'} | grep 'C program');
	if ($? eq 0) {
		qx(mkdir -p $tmp/abi);
		my $cmd = "gcc -O2 -Wall $opt{'c'} -o $tmp/abi/abiextract";
		system($cmd) == 0 or die "$cmd failed\n";
		$abiextract="${tmp}/abi/abiextract";
	} else {
		$abiextract="perl $opt{'c'}";
	}
}

system("which $abiextract > /dev/null 2>&1") && 
	die "The executable $abiextract executable does not exist\n";

if (defined($opt{'k'})) {
	if (open(MODULE_SYMVERS, $opt{'k'})) {
		while ( <MODULE_SYMVERS> ) {
			chomp;
			my ($crc, $symbol, $module) = (split)[0,1,2];
			$SYMBOL { $symbol } =  [ $crc, $module ];
		}
	} else {
		die "Sorry, cannot open the kernel's symbol version file $opt{'k'}: $!\n";
	}
	close (MODULE_SYMVERS);
	if (open(MODULE_SYMVERS, "kexport_extract @modulelist |")) {
		while ( <MODULE_SYMVERS> ) {
			chomp;
			my ($crc, $symbol, $module) = (split)[0,1,2];
			$SYMBOL { $symbol } =  [ $crc, $module ];
		}
	} else {
		die "Sorry, couldn't run kexport_extract on modules\n";
	}
}

if (not (@modulelist)) {
	print("one of -m, -f or -r option is a must!!!\n");
	usage($0);
}

my $ret=0;
foreach my $modfile (@modulelist) {
	my $stat=0;
	#read the symbols out of the module

	(my $tmodfile=$modfile) =~ s/$tmp//;

	print "-----------$tmodfile-----------\n";

	unless (-f "$modfile") {
		print "Sorry, $modfile does not exist: $!\n";
		next;
	}

	unless (open(MODULE_MODULE, "$abiextract $modfile |")) {
		close(MODULE_SYMVERS);
		print "Sorry, cannot open the module's object file $!\n";
		next;
	}

	#compare the symbols to $SYMBOL
	while ( <MODULE_MODULE> ) {
		chomp;
		my ($m_crc, $symbol) = split;
		if ($m_crc =~ /license=/) {
			my $license = (split /=/, $_)[1];
		}
		if ( $m_crc !~ /^(0x|R\w+_|R)[0-9a-f]{7,8}$/ ) {
			next;
		}

		next if ($symbol eq "__this_module" and $m_crc =~ /^R/);

		if (not defined $SYMBOL{$symbol}) {
			print "ERROR: $symbol: not exported\n";
			$stat=1;
			next;
		}

		my ($crc, $module) = @{$SYMBOL{$symbol}};
		if ($crc ne $m_crc) {
			print "ERROR: $symbol: ABI do not match\n";
			$stat=1;
			next;
		}
	}

	if ($stat == 0) {
		print "$tmodfile passes ABI test\n";
	} else {
		print "$tmodfile fails ABI test\n";
		$ret=1;
	}

	close(MODULE_MODULE);
}

if ((defined($opt{'c'}) && -f $opt{'c'}) or defined($opt{'r'})) {
	system("rm -rf $tmp");
}

close(MODULE_SYMVERS);
exit($ret);
