#!/usr/bin/perl
# afsmodname - return the name of the AFS module to load
# usage: afsmodname [path]
# THIS SCRIPT IS UNDER SOURCE CONTROL!
# The master copy is /afs/cs/misc/openafs/src/client-support/afsmodname

use Getopt::Std;

use strict;
use vars qw($modbase $VERSION @TrySyms @AddSyms $Prefix);
use vars qw($DEBUG $Mode $OutFile %SymCache);

$VERSION = '$Revision$';
$VERSION =~ s/^\$[a-z]*:?\s*(\S*)\s*\$$/$1/i;
$VERSION = 'testing' unless $VERSION;
$modbase = '/usr/vice/etc/modload';
@TrySyms = qw(__iget iget __iget4 iget4);
@AddSyms = qw(sock_create);
$Prefix = 'libafs';


sub vcmp {
  my (@a, @b, @aa, @bb);
  my ($i, $ii);

  @a = split /-/, $a;
  @b = split /-/, $b;
  foreach $i (0 .. ((@a > @b) ? $#b : $#a)) {
    @aa = split /\./, $a[$i];
    @bb = split /\./, $b[$i];  
    foreach $ii (0 .. ((@aa > @bb) ? $#bb : $#aa)) {
      return $aa[$ii] <=> $bb[$ii] if $aa[$ii] <=> $bb[$ii]
                                   && $aa[$ii] =~ /^\d+$/
                                   && $bb[$ii] =~ /^\d+$/;
      return $aa[$ii] cmp $bb[$ii] if $aa[$ii] cmp $bb[$ii];
    }
    return @aa <=> @bb if @aa <=> @bb;
  }
  return @a <=> @b;
}


sub parse_symbol ($) {
  my($symbol) = @_;

  if ($symbol =~ /^(.*)_R((?:smp)?(?:2gig)?_?[0-9a-f]{8})$/) {
    ($1, $2);
  } else {
    ($symbol, '--none--');
  }
}


sub get_ksym ($) {
  my($req_sym) = @_;
  my($addr, $symbol, $module, $version, @answer);


  if (exists($SymCache{$req_sym})) {
    print STDERR "get_ksym($req_sym) [cached]\n" if $DEBUG > 1;
    return $SymCache{$req_sym};
  }

  print STDERR "get_ksym($req_sym)" if $DEBUG;
  $SymCache{$req_sym} = undef;
  open(KSYMS, '/proc/ksyms') or die "open /proc/ksyms: $!\n";
  while (<KSYMS>) {
    if (/^(\w+)\s+(\w+)\s+\[(.*)\]/) {
      ($addr, $symbol, $module) = ($1, $2, $3)
    } elsif (/^(\w+)\s+(\w+)/) {
      ($addr, $symbol, $module) = ($1, $2, 'KERNEL')
    } else { next }

    ($symbol, $version) = parse_symbol($symbol);

    if ($symbol eq $req_sym) {
      $SymCache{$req_sym} = [$addr, $version, $module];
      print STDERR " => [addr=$addr, vers=$version, mod=$module]\n" if $DEBUG;
      last;
    }
  }
  close(KSYMS);

  print STDERR " => not found\n" if $DEBUG && !defined($SymCache{$req_sym});
  $SymCache{$req_sym};
}


sub get_modsyms ($) {
  my($modpath) = @_;
  my($symbol, $version, $V);

  $V = {};
  open(NM, "nm $modpath|") or die "nm $modpath: $!\n";
  while (<NM>) {
    chomp;
    next unless /^\s+U\s+/;
    ($symbol, $version) = parse_symbol($');
    $$V{$symbol} = $version unless $version eq '--none--';
  }
  close(NM);
  $V;
}


sub get_hdrsyms ($) {
  my($srcpath) = @_;
  my($moddir, @hdrs, $h);
  my($symbol, $version, $V);


  $moddir = "$srcpath/include/linux/modules";
  opendir(HDRS, $moddir) or die "$moddir: $!\n";
  @hdrs = readdir(HDRS);
  closedir(HDRS);

  $V = {};
  foreach $h (@hdrs) {
    next unless $h =~ /\.ver$/;
    open(HDR, "$moddir/$h") or die "$moddir/$h: $!\n";
    while (<HDR>) {
      chomp;
      next unless /#define __ver_(\S+)\s+(\S+)/;
      $$V{$1} = $2;
    }
    close(HDR);
  }
  $V;
}


sub get_cputype () {
  my($cputype, $family, $vendor, $model);

  open(CPUINFO, '/proc/cpuinfo') or die "open /proc/cpuinfo: $!\n";
  while (<CPUINFO>) {
    if    (/^cpu\s*\:\s*(\S+)/)       { $cputype = $1 }
    elsif (/^cpu family\s*:\s*(\S+)/) { $family  = $1 }
    elsif (/^vendor_id\s*:\s*(\S+)/)  { $vendor  = $1 }
    elsif (/^model\s*:\s*(\S+)/)      { $model   = $1 }
  }
  close(CPUINFO);
  if    ($vendor eq 'GenuineIntel') { $vendor = 'intel' }
  elsif ($vendor eq 'AuthenticAMD') { $vendor = 'amd'   }
  $cputype = "${family}86" if !defined($cputype);
  [$cputype, $vendor, $model];
}


sub table_lookup ($@) {
  my($cpu, @paths) = @_;
  my($path, $symbol, $version, $mincpu, @mincpu, $module, $info, @supp);
  my($prev_module);     # last module line we saw
  my($match_module);    # last matching module
  my($prev_match);      # true if last module matches so far

  foreach $path (@paths) {
    next unless -f $path;
    $prev_match = 0;
    open(TABLE, $path) or die "open $path: $!\n";
    while (<TABLE>) {
      # Skip comments
      next if (/^\#/ || /^\s*$/);

      # Check supplemental requirements
      if (/^\s*\>/) {
        @supp = split;
        foreach (@supp) {
          if (/([^=]*)=([^=]*)/) {
            ($symbol, $version) = ($1, $2);
            $info = get_ksym($symbol);
            $prev_match = 0 if !$info || $version ne $$info[1];
          }
        }
        next;
      }

      # This is a new module, so all supplemental requirements for the
      # previous module have been processed.  If they all passed, then
      # the previous module is a matching module.
      $match_module = $prev_module if $prev_match;

      # Parse the line and remember the module name
      ($symbol, $version, $mincpu, $module) = split;
      $prev_module = $module;
      $prev_match  = 0;
      if ($DEBUG) {
        print STDERR "Try $module ($symbol=$version)",
                     ($mincpu ne '-') ?  " mincpu = $mincpu" : "",
                     "\n";
      }

      # Check mincpu requirement
      if ($mincpu ne '-') {
        @mincpu = split(/\./, $mincpu);
        if ($mincpu[0] ne '' && $mincpu[0] >  $$cpu[0]) {  # min family
          print STDERR " mincpu failed: $mincpu[0] > $$cpu[0]\n" if $DEBUG;
          next;
        }
        if ($mincpu[1] ne '' && $mincpu[1] ne $$cpu[1]) {  # exact vendor
          print STDERR " mincpu failed: $mincpu[1] != $$cpu[1]\n" if $DEBUG;
          next;
        }
        if ($mincpu[2] ne '' && $mincpu[2] >  $$cpu[2]) {  # min model
          print STDERR " mincpu failed: $mincpu[2] > $$cpu[2]\n" if $DEBUG;
          next;
        }
      }

      # Check primary symbol requirement
      $info = get_ksym($symbol);
      next unless $info;
      next unless $version eq $$info[1];

      # OK; it's a match so far.  There may still be some supplemental
      # requirements that we need to check.
      $prev_match = 1;
    }
    close(TABLE);
    $match_module = $prev_module if $prev_match;
  }
  $match_module;
}


sub dump_versions ($) {
  my($cpu) = @_;
  my($version);

  print STDERR "CPU Type:       ", join('.', @$cpu), "\n";

  chomp($version = `uname -rv`);
  print STDERR "Linux version:  $version\n";

  if (open(RHR, "/etc/redhat-release")) {
    chomp($version = <RHR>);
     print STDERR "RedHat release: $version\n";
  }
}


sub dump_syms (@) {
  my(@syms) = @_;
  my($sym, $info);

  print STDERR "Symbol versions:\n";
  foreach $sym (@syms) {
    $info = get_ksym($sym);
    printf STDERR "  %-10s %s\n", $sym, $$info[1] if $info;
  }
}


sub gen_table (@) {
  my(@modules) = @_;
  my($module, $modname, $V, $sym, $count, @add);

  print <<'EOF';
# This file describes the available AFS kernel modules and what kernel
# versions they work with.  Each line matches against some kernel symbol
# version, and specifies a module which may be used with kernels containing
# that version of the specified symbol.  Only lines which match the
# currently-running kernel are considered.
#
# In addition, each line may specify a minimum CPU model on which the module
# will work.  If this value is present, the actual CPU model must be greater
# than or equal to the version specified; otherwise, the module is assumed
# to work on any CPU.
#
# The last match found will be used.
#
# Symbol  Version       MinCPU  Module
#=======  ============  ======  ====================
EOF
  foreach $module (sort vcmp @modules) {
    ($modname = $module) =~ s/.*\///;
    $modname =~ s/^$Prefix[-.](.*)\.o$/$1/;
    $V = get_modsyms($module);
    $count = 0;
    foreach $sym (@TrySyms) {
      next unless exists $$V{$sym};
      $count++;
      printf "%-8s  %-12s  %-6s  %s\n", $sym, $$V{$sym}, '-', $modname;
      last;
    }
    if (!$count) {
      print STDERR "Unable to find a suitable symbol reference in $modname!\n";
      next;
    }
    @add = ();
    foreach $sym (@AddSyms) {
      next unless exists $$V{$sym};
      push(@add, "$sym=$$V{$sym}");
    }
    print "> ", join(' ', @add), "\n" if @add;
  }
}


sub scan_kernels (@) {
  my(@kernels) = @_;
  my($kernel, $kpath, $kname, $V);

eval <<"EOF";
format =
@<<<<<<<<<<<<<<<<<<<<<<<< @{[' @<<<<<<<<<<<' x scalar(@TrySyms)]}
\$kname, @{[join(',', map(q/$$V{'/ . $_ . q/'}/, @TrySyms))]}
.
EOF

  $kname = 'Kernel';
  $V = { map(($_ => $_), @TrySyms) };
  write;

  $kname = '=========================';
  $V = { map(($_ => '============'), @TrySyms) };
  write;

  foreach $kernel (@kernels) {
    if    (-d "$kernel/src/include/linux/modules") { $kpath = "$kernel/src" }
    elsif (-d "$kernel/include/linux/modules")     { $kpath = $kernel       }
    else { next }
    ($kname = $kpath) =~ s#/src$##;
    $kname =~ s/.*\///;

    $V = get_hdrsyms($kpath);
    write;
  }
}


sub symcompare ($$) {
  my($module, $kernel) = @_;
  my($ksyms, $msyms, $sym, $kvers, $mvers, $info);

eval <<'EOF';
format =
@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  @<<<<<<<<<<<  @<<<<<<<<<<<
$sym, $kvers, $mvers
.
EOF

  if (defined($kernel)) { $ksyms = get_hdrsyms($kernel) }
  $msyms = get_modsyms($module);

  print "Symbol                          Kernel        Module\n";
  print "==============================  ============  ============\n";
  foreach (keys %$msyms) {
    $sym = $_;
    $mvers = $$msyms{$sym};
    if (defined($kernel)) {
      $kvers = $$ksyms{$sym};
    } else {
      $info = get_ksym($sym);
      $kvers = $$info[1];
    }
    next if $kvers eq $mvers;
    write;
  }
}


sub usage (;@) {

  print STDERR "$00: ", @_, "\n" if @_;
  print STDERR <<"EOF";
usage: $00 [opts] [modbase]                      (find module)
       $00 [opts] -g modules ...                 (make table)
       $00 [opts] -k kernels ...                 (scan kernels)
       $00 [opts] -c module [kernel]             (check module)
       $00 -h                                    (print help)
       $00 -v                                    (print version)

options:
  -d          enable debugging output
  -f outfile  set output file (default stdout)
  -P prefix   set module name prefix (default $Prefix)
  -S syms...  symbols to try for -x, -k (default @TrySyms)
  -A syms...  additional symbols to check for -x (default @AddSyms)

  Module lists for -S and -A may be space- or comma-separated.
  For backward-compatibility, -g is a synonym for -x.
EOF
    exit(0);
}

sub parse_opts () {
  my(%opts);

  ($00 = $0) =~ s/.*\///;
  getopts('dckgxf:hvP:S:A:', \%opts) or usage('invalid option(s)');
  usage() if $opts{'h'};

  if ($opts{'v'}) {
    print "afsmodname $VERSION\n";
    exit(0);
  }

  $opts{'g'} = 1 if $opts{'x'};
  if ($opts{'g'} + $opts{'k'} + $opts{'c'} > 1) {
    usage("At most one of -g, -k, -c can be used\n");
  }

  $DEBUG++                              if exists $opts{'d'};
  $Mode = 'g'                           if exists $opts{'g'};
  $Mode = 'k'                           if exists $opts{'k'};
  $Mode = 'c'                           if exists $opts{'c'};

  usage("Too many arguments")   if !$Mode && @ARGV > 1;
  usage("Too many arguments")   if $Mode eq 'c' && @ARGV > 2;
  usage("Module name required") if $Mode eq 'c' && !@ARGV;

  $OutFile = $opts{'f'}                 if exists $opts{'f'};
  $Prefix  = $opts{'p'}                 if exists $opts{'P'};
  @TrySyms = split(/[, ]+/, $opts{'S'}) if exists $opts{'S'};
  @AddSyms = split(/[, ]+/, $opts{'A'}) if exists $opts{'A'};
}


## MAIN PROGRAM

my($cpu, $module);

parse_opts();
if ($Mode) {
  if ($OutFile) {
    open(STDOUT, ">$OutFile") or die "$OutFile: $!\n";
  }
  if ($Mode eq 'g') { gen_table(@ARGV)               }
  if ($Mode eq 'k') { scan_kernels(@ARGV)            }
  if ($Mode eq 'c') { symcompare($ARGV[0], $ARGV[1]) }
  exit(0);
}

$modbase = $ARGV[0] if @ARGV;

$cpu = get_cputype();

$module = table_lookup($cpu, "$modbase/SymTable", "$modbase/SymTable.local");

if ($module) {
  print "$Prefix-$module.o";
  exit(0);
}

print STDERR <<'EOF';
Hmm...  I can't seem to find an AFS kernel module suitable for your Linux
kernel.  That means you will need to build or obtain a suitable module.
The following information may be of some use in obtaining assistance:
EOF

dump_versions($cpu);
dump_syms(sort (@TrySyms, keys %SymCache));

exit(1);