#! /usr/bin/perl
# kabi - Linux Kernel Application Binary Interface manager
#
# Copyright  2008 Sun Microsystems, Inc. All rights reserved
# Use is subject to license terms.
#
# Gordon Matzigkeit <gord@clusterfs.com>, 2005-10-21

use warnings;
use strict;

my $VERSION = '0.2';

my $CC = $ENV{'CC'} || 'gcc';
my $LINUX = '/usr/src/linux';
my $MODE;
my $OUTPUT;
my @ARGS;
my $VERBOSE = 0;

my $progname = $0;
$progname =~ s/^.*\///;
my $modename = $progname;

sub usage
{
    my ($status) = @_;
    if ($status) {
	print STDERR "Try \`$0 --help' for more information\n";
    } else {
	print <<EOF;
Usage: [CC=COMPILER] $0 [OPTION]... MODE ARGS...

Manage binary compatibility between a Linux kernel and kernel modules.

The CC environment variable specifies the compiler used to build the
kernel and modules.

    --help            display this message and exit
-o, --output=KABI     specify the name of the KABI file created by the
                      \`module\' mode [default=strip .ko and add .kabi]
-v, --verbose         give reasons for rejecting KABI matches
    --version         print version information
    --with-linux=DIR  set the path to the kernel sources

MODE and ARGS can be one of the following:

    archive DIR KMOD  install a KABI and kernel module in a unique place in DIR
    match FILE...     print a list of KABI files which are compatible with
                      the specified kernel and any specified kernel modules

    module KMOD       generate a KABI file for the specified kernel module

Written by Gordon Matzigkeit <gord\@clusterfs.com> for Sun Microsystems, Inc.
EOF
    }
    exit $status;
}

my @args = @ARGV;
while ($#args >= 0) {
    if ($args[0] =~ /^--with-l(i(n(u(x)?)?)?)?=(.*)/) {
	$LINUX = $5;
    } elsif ($args[0] =~ /^--with-l(i(n(u(x)?)?)?)?$/) {
	shift @args;
	$LINUX = $args[0];
    } elsif ($args[0] =~ /^--h(e(l(p)?)?)?$/) {
	usage(0);
    } elsif ($args[0] =~ /^--vers(i(o(n)?)?)?$/) {
	print "KABI $VERSION\n";
	exit 0;
    } elsif ($args[0] eq '-v' || $args[0] =~ /^--verb(o(s(e)?)?)?$/) {
	$VERBOSE = 1;
    } elsif ($args[0] =~ /^-/) {
	print STDERR "$progname: unrecognized option \`$args[0]'\n";
	usage(1);
    } elsif (!defined $MODE) {
	$MODE = $args[0];
    } else {
	push @ARGS, $args[0];
    }
    shift @args;
}


if (!defined $MODE) {
    print STDERR "$progname: you must specify a MODE\n";
    usage(1);
}

$modename .= ": $MODE";
if ($MODE eq 'archive') {
    if ($#ARGS != 1) {
	print STDERR "$modename: you must specify a DIR and KMOD\n";
	usage(1);
    }

    my $ARCHIVE = $ARGS[0];
    my $KMOD = $ARGS[1];

    my $KABI = $KMOD;
    $KABI =~ s/\.k?o$//;
    $KABI .= '.kabi';

    open(MD5SUM, "md5sum $KABI|") or
	die "$modename: cannot execute \`md5sum': $!\n";
    my $hash = <MD5SUM>;
    close(MD5SUM);
    $hash =~ s/\s+.*//s;

    my $TAG = '';
    if (-d 'CVS') {
	open(TAG, '<CVS/Tag') or
	    die "$modename: cannot read \`CVS/Tag': $!\n";
	$TAG = <TAG>;
	close(TAG);
	chomp $TAG;
	$TAG = "/$TAG";
    }

    my ($dir, @sh_c, @cp);
    if ($ARCHIVE =~ /^([^:][^:]+):(.*)$/) {
	$dir = $2;
	@sh_c = ('ssh', '-o', 'BatchMode=yes', $1);
	@cp = ('scp', '-B');
    } else {
	$dir = $ARCHIVE;
	@sh_c = ('sh', '-c');
	@cp = ('cp');
    }

    system(@sh_c, "test -d $dir");
    if ($? >> 8 != 0) {
	print STDERR "$modename: warning: \`$dir' is not reachable or does not exist\n";
	exit 0;
    }

    print "archiving $KMOD in $ARCHIVE$TAG/$KMOD/$hash\n"
	if $VERBOSE;
    foreach my $d ("$dir$TAG", "$dir$TAG/$KMOD", "$dir$TAG/$KMOD/$hash") {
	system(@sh_c, "test -d $d || mkdir $d");
	if ($? >> 8 != 0) {
	    exit $? >> 8;
	}
    }
    system(@cp, $KMOD, $KABI, "$ARCHIVE$TAG/$KMOD/$hash");
    exit $? >> 8;
} elsif ($MODE eq 'module') {
    
    if ($#ARGS != 0) {
	print STDERR "$modename: you must specify exactly one KMOD\n";
	usage(1);
    }

    my $KMOD = $ARGS[0];

    if (!defined $OUTPUT) {
	$OUTPUT = $KMOD;
	$OUTPUT =~ s/\.k?o$//;
	$OUTPUT .= '.kabi';
    }
    print "create $OUTPUT\n" if $VERBOSE;
    open(OUT, ">$OUTPUT") or
	die "$modename: cannot create \`$OUTPUT': $!\n";

    my $outname = $OUTPUT;
    $outname =~ s/^.*\///;
    print OUT <<EOF;
# $outname - Kernel module ABI descriptor file
# DO NOT EDIT - Automatically generated by $progname $VERSION
EOF

    # Get the kernel version.
    print OUT "kver " . kernel_version() . "\n";

    # Gather the undefined symbols with version numbers from the
    # kernel module.
    my %vers;
    my @undefs;

    # Gather the version numbers, if any.
    my $modfile = $KMOD;
    if ($modfile =~ s/\.ko$/.mod.c/) {
	open(MOD, "<$modfile") or
	    die "$modename: cannot read \`$modfile': $!\n";
	my $versions = 0;
	while ($_ = <MOD>) {
	    if (/\"__versions\"/) {
		$versions = 1;
	    } elsif ($versions) {
		if (/^\s*\{\s*(0x[0-9a-f]+)\s*,\s*\"([^\"]*)\"\s*\}\s*,\s*$/) {
		    $vers{$2} = $1;
		    push(@undefs, $2);
		} elsif (/^\s*\}\s*;\s*$/) {
		    $versions = 0;
		}
	    }
	}
	close(MOD);
    } else {
	open(NM, "nm $KMOD |") or
	    die "$modename: cannot execute \`nm $KMOD': $!\n";
	while ($_ = <NM>) {
	    if (/^\s*U\s*(.*\S)\s*$/) {
		push @undefs, $1;
	    }
	}
	close(NM);
    }

    foreach my $undef (sort @undefs)
    {
	print OUT "usym $undef";
	if (defined $vers{$undef}) {
	    print OUT " ", $vers{$undef};
	}
	print OUT "\n";
    }

    close(OUT) or
	die "$modename: cannot write \`$OUTPUT': $!\n";

} elsif ($MODE eq 'match') {
    my @KABIS;
    my @KMODS;

    my @todo = @ARGS;
    while ($#todo >= 0) {
	my $t = shift @todo;
	if ($t =~ /\.kabi$/) {
	    push @KABIS, $t;
	} elsif (-d $t) {
	    # Add all the contents of the directory to our todo list.
	    opendir(DIR, $t);
	    while (my $ent = readdir(DIR)) {
		if ($ent =~ /^\./) {
		    # Skip dotfiles.
		} elsif (-d "$t/$ent") {
		    # Recurse into subdirectories.
		    unshift @todo, "$t/$ent";
		} elsif ($ent =~ /\.k?o$/) {
		    # Add kernel modules.
		    unshift @todo, "$t/$ent";
		}
	    }
	    closedir(DIR);
	} else {
	    # It's an explicit kernel module.
	    push @KMODS, $t;
	}
    }

    if ($#KABIS < 0) {
	print STDERR "$modename: you must specify at least one KABI\n";
	usage(1);
    }

    my %dsyms;

    if (-f "$LINUX/Module.symvers") {
	# Look up the version numbers in Module.symvers.
	open(VERS, "<$LINUX/Module.symvers") or
	    die "$modename: cannot read \`$LINUX/Module.symvers': $!\n";
	while ($_ = <VERS>) {
	    if (/^(0x[0-9a-f]+)\s+(\S+)/) {
		$dsyms{$2} = hex($1);
	    }
	}
	close(VERS);
    } else {
	# Read in all the non-versioned symbols defined by this kernel.
	open(MAP, "<$LINUX/System.map") or
	    die "$modename: cannot read \`$LINUX/System.map': $!\n";
	while ($_ = <MAP>) {
	    if (/^[0-9a-fA-F]*\s+[ABCDGIRSTW]+\s*(.*\S)\s*$/) {
		$dsyms{$1} = 0;
	    }
	}
	close(MAP);
    }

    # Find the symbols for the installed modules, too.
    foreach my $mod (@KMODS) {
	open(NM, "nm $mod |") or
	    die "$modename: cannot execute \`nm $mod': $!\n";
	while ($_ = <NM>) {
	    if (/^[0-9a-fA-F]*\s+[ABCDGIRSTW]+\s*(.*\S)\s*$/) {
		$dsyms{$1} = 0;
	    }
	}
	close(NM);
    }

    # Also get the kernel version.
    my $kver = kernel_version();

    # Read each kabi file and print out the ones that are plausible
    # matches.
    foreach my $kabi (@KABIS) {
	open(KABI, "<$kabi") or
	    die "$modename: cannot read \`$kabi': $!\n";
	my $possible = 1;
	while ($possible && ($_ = <KABI>)) {
	    if (/^\s*#/) {
		# Skip comments.
	    } elsif (/^\s*kver\s+(.*\S)\s*$/) {
		my $modkver = $1;
		if ($modkver ne $kver) {
		    print STDERR "$kabi:$.: module version \`$modkver' differs from \`$kver'\n"
			if $VERBOSE;
		    $possible = 0;
		}
	    } elsif (/^\s*usym\s+(\S+)\s*(\S+)?\s*$/) {
		my ($modsym, $symver) = ($1, hex($2));
		if (!defined $dsyms{$modsym}) {
		    print STDERR "$kabi:$.: module symbol \`$modsym' is not defined\n"
			if $VERBOSE;
		    $possible = 0;
		} elsif (defined $symver && $dsyms{$modsym} != 0 && $dsyms{$modsym} != $symver) {
		    printf STDERR "$kabi:$.: module symbol \`$modsym' is version 0x%x, not 0x%x\n", $dsyms{$modsym}, $symver
			if $VERBOSE;
		    $possible = 0;
		}
	    } elsif (/^\s*(\S+)/) {
		print STDERR "$kabi:$.: unrecognized descriptor line \`$1'\n";
	    }
	}
	close(KABI);
	
	if ($possible) {
	    # We got a match.
	    print "$kabi\n";
	}
    }

} else {
    print STDERR "$progname: unrecognized mode \`$MODE'\n";
    usage(1);
}


# Read the kernel version from its built source tree.
sub kernel_version
{
    my $verfile = "$LINUX/include/linux/version.h";
    open(VERSION, "<$verfile") or
	die "$modename: cannot read \`$verfile': $!\n";

    my $ver;
    while ($_ = <VERSION>) {
	if (/^\s*#\s*define\s+UTS_RELEASE\s+"(.*)"\s*$/) {
	    $ver = $1;
	    last;
	}
    }

    close(VERSION);

    if (!defined $ver) {
	die "$modename: cannot find UTS_RELEASE in \`$verfile'\n";
    }
    return "linux-$ver";
}

exit 0;