#!/usr/bin/perl -w
#
# (C) Copyright IBM Corporation 2006.
#       Released under GPL v2.
#       Author : Russ Weight (rweight@us.ibm.com)
#
#	Changed and modified by
#	Doug Rosser (drosser@us.ibm.com)
#	Ram Pai	(linuxram@us.ibm.com)
#

use strict;

my $version = 0.9;
sub usage {
	print("Usage: $0 <kernel-module or kernel-image files>\n");
	print("script version=$version\n");
	exit(1);
}

# There is no specific option to get script version. Let a usage error
# throw the script version like all other scripts!
if (@ARGV == 0) {
	usage();
}

my @input;  # Temporarily store characters that we are not done with,
            # even though they have been read off the input stream

sub module_is_26_version {
	my $mod = shift;
	#check if the module is identifiable
	qx(readelf -h $mod 2>&1 > /dev/null);
	if ($?) {
		print "$mod not identified\n";
		exit 1;
	}
	qx(readelf -S $mod | grep '__versions');
	return ($? == 0);
}

foreach my $object (@ARGV) {
	if ( $object =~ m/vmlinuz/ ) {
		if (grep {m/:.*\s+boot/} `file $object` ) {
			# TODO:
			# this is tested only for rhel4 vmlinuz. Dont 
			# attempt to use it for any other distro/releases.
			&x86_vmlinuz_exported_symbols($object);
		} elsif (grep {m/ELF 64-bit MSB/} `file $object` ) {
			&ppc64_vmlinuz_exported_symbols($object);
		} elsif (grep {m/Applesoft BASIC/} `file $object` ) {
			&s390_vmlinuz_exported_symbols($object);
		} else {
			die("Error: Unknown file type");
		}
	} elsif ($object =~ m/vmlinux/ and grep {m/ELF/} `file $object`) {
		my $cmd = "strings $object | grep '^Linux version'";
		my $version = qx($cmd) or die("couldn't run $cmd");
		if ($version =~ /^Linux version 2.6.[0-9]/) {
			&module_26_exported_symbols($object);
		} elsif ($version =~ /^Linux version 2.4.[0-9]/) {
			&module_24_exported_symbols($object);
		} else {
			die("Error: Unknown kernel image: $object");
		}
	} elsif (grep {m/ELF/} `file $object`) {
		if (&module_is_26_version($object)) {
			&module_26_exported_symbols($object);
		} else {
			&module_24_exported_symbols($object);
		}
	} else {
		die("Error: Unknown file type");
	}
}

sub get_sysmap_symbols {
	my $symfile = shift;
	my $arch = shift;
	my $base_offset;

	my %symbols;
	#
	# Read symbol names and offsets from System.map file
	#
	open (SYMS, "<$symfile") or die "Unable to read $symfile: $!\n";
	my ($symbol, $crc_p, $str_p, $sym_p);
	while (my $line = <SYMS>) {
	  chomp $line;
	  my $first=(split('\s+',$line))[0];
	  my $tfirst = substr($first, -8);
	  $line =~ s/$first/$tfirst/;
	
	  if ($arch eq "x86" or $arch eq "s390") {
		  if (!defined($base_offset) &&
		     (($base_offset) = ($line =~ /^([0-9a-f]{8}) A _text/))) {
		  } elsif (($crc_p, $symbol) = ($line =~ /^([0-9a-f]{8}) r __kcrctab_(.*)/)) {
		    $symbols{$symbol}{"crc"} = hex($crc_p) - hex($base_offset);
		  } 
	  } elsif ($arch eq "ppc64") {
		if (($crc_p, $symbol) = ($line =~ /^([0-9a-f]{8}) d __kcrctab_(.*)/)) {
		    $symbols{$symbol}{"crc"} = hex($crc_p) + 0x10000;
		}
	  }
	}
	close (SYMS);
	return %symbols;
}

sub x86_vmlinuz_exported_symbols() {
	my $tmpfile = "/tmp/vmlinux-syms.$$";
	my $name = shift;
	my @gzip_magic = ("1f", "8b", "08", "00");
	my $offset;

	(my $version = $name) =~ s/.*vmlinuz-(.*)$/$1/;
	(my $symfile = $name ) =~ s/vmlinuz/System.map/;

	my %symbols = get_sysmap_symbols($symfile, "x86");

	#
	# Search for the magic number that indicates the beginning of a gzip
	# file.
	#
	#print "Stripping vmlinuz header\n";
	open (VMLINUZ, "<$name") or die "Unable to read $name: $!\n";
	if (($offset = &seek_pattern(*VMLINUZ, @gzip_magic)) == -1) {
	  die "Failed to find gzip header!\n";
	}

	#
	# Seek to the Gzip header and then write the rest of the file out in
	# 64k chunks
	#
	my $zcat_pid;
	if ($zcat_pid = &pipe_to_fork(*ZCAT)) {
	  # parent - redirect output zcat
	  seek VMLINUZ, $offset, 0;
	  while (read VMLINUZ, my $data, 65536) {
	    syswrite ZCAT, $data;
	  }
	  close (ZCAT);
	  close (VMLINUZ);
	} else {
	  # child - zcat
	  exec ("zcat > $tmpfile");
	}

	# Only the parent will get to this point, but the parent needs to wait
	# until the child is done.
	waitpid $zcat_pid, 0;
	print_module_symvers($tmpfile, \%symbols, "x86");
	unlink $tmpfile;
}

sub ppc64_vmlinuz_exported_symbols() {
	my $name = shift;
	(my $version = $name) =~ s/.*vmlinuz-(.*)$/$1/;
	(my $symfile = $name ) =~ s/vmlinuz/System.map/;

	my %symbols = get_sysmap_symbols($symfile, "ppc64");

	print_module_symvers($name, \%symbols, "ppc64");
}

sub s390_vmlinuz_exported_symbols() {
	my $name = shift;
	(my $version = $name) =~ s/.*vmlinuz-(.*)$/$1/;
	(my $symfile = $name ) =~ s/vmlinuz/System.map/;

	my %symbols = get_sysmap_symbols($symfile, "s390");

	print_module_symvers($name, \%symbols, "s390");
}

sub print_module_symvers {
	my $name = shift;
	my $symbols = shift;
	my $arch = shift;
	open (VMLINUX, "<$name") or die "Cannot read $name: $!\n";
	for my $symbol (sort keys %{$symbols}) {
	  my @crc;
	  seek VMLINUX, $$symbols{$symbol}{"crc"}, 0;
	  if ($arch ne "x86") {
	  	&getchar(*VMLINUX); &getchar(*VMLINUX); &getchar(*VMLINUX);
		  &getchar(*VMLINUX);
	  }
	  push @crc, &getchar(*VMLINUX);
	  push @crc, &getchar(*VMLINUX);
	  push @crc, &getchar(*VMLINUX);
	  push @crc, &getchar(*VMLINUX);
	  if ($arch eq "x86") {
		@crc = reverse @crc;
	  }
	  printf "0x%s%s%s%s\t$symbol\t$name\n", (@crc);
	}
	close (VMLINUX);
}

#
# Read one character and return it as a hex byte
#
sub getchar {
  my $fd = shift;

  if (eof($fd)) {
    return undef;
  } else {
    return sprintf ("%02x", ord(getc($fd)));
  }
}

#
# Search for a series of hex bytes in a binary file
#
sub seek_pattern {
  my $fd = shift;
  my @pattern = @_;
  my $offset = 0;
  @input = ();

  while (defined(my $char = &nextchar($fd))) {
    if ($char eq $pattern[0]) {
      if (&check_pattern($fd, @pattern[1 .. $#pattern])) {
        return $offset;
      }
    }
    $offset++;
  }
  return -1;
}

#
# If there are any characters in @input, it is because they were read
# from the input stream as part of pattern checking. Since the pattern
# check failed, we still need to consider these characters in the
# order that they came off the stream.
#
sub nextchar {
  my $fd = shift;
  if (@input) {
    return shift @input;
  } else {
    return &getchar($fd);
  }
}

#
# Check the rest of the characters in the pattern. If we fail the
# pattern check, the characters that were read from the input stream
# will be left in @input for future consideration.
#
sub check_pattern {
  my ($fd, @pattern) = @_;
  my $char;

  while (@pattern) {
    my $pat = shift @pattern;
    if (!defined ($char = &getchar($fd))) {
      return 0;
    }
    push @input, $char;
    if ($char ne $pat) {
      return 0;
    }
  }
  return 1;
}

#
# simulate open(FOO, "|-")
#
# This function comes straight out of the perlfunc man page
#
sub pipe_to_fork () {
  my $fd = shift;
	pipe my $child, $fd or die "Failed to create pipe\n";
	my $pid = fork();
	die "fork() failed: $!" unless defined $pid;
	if ($pid) {
		close $child;
	} else {
		close $fd;
		open(STDIN, "<&=" . fileno($child)) or die;
	}
	return $pid;
}

sub module_26_exported_symbols () {
	my $module = shift;
        my @symbols = qx(nm $module);
        $module =~ s/^.*\///;
        $module =~ s/.ko$//;
        for (@symbols) {
		print "0x$2\t$3\t$module\n" if (/^(00000000)?([a-f0-9]+) A __crc_(.*)$/);
        }
}

sub module_24_exported_symbols {
        my $module = shift;
        my @symbols = split /[\0\s]+/, qx(objcopy -j .kstrtab -O binary $module /dev/stdout 2>/dev/null);
	if ($?) {
		print "Error:Module $module not recognized. Check if its 2.4module\n";
		return (1);
	}
        $module =~ s/^.*\///;
        $module =~ s/.o$//;
        for (@symbols) {
		print "$2\t$1\t$module\n" if(/^([\w_\.]+)_(R\w*[a-f0-9]{7,8})$/);
        }
}
