#!/usr/bin/env perl
# vmware-kmod-rebuild --- build vmware workstation kernel modules for linux

# Author: Noah Friedman <friedman@splode.com>
# Created: 2012-09-08
# Public domain.

# $Id: vmware-ws-kmod-rebuild,v 1.5 2017/09/21 22:39:35 friedman Exp $

# Commentary:

# This basically does what "vmware-modconfig --console --install-all" would
# do, except that it doesn't stop/restart services and it's possible to
# build modules for a different kernel version than the running one.

# Code:

$^W = 1;

use strict;
use Symbol;
use POSIX;
use XML::XPath;

my $modules_xml = "/usr/lib/vmware/modules/modules.xml" ;
my $config_file = "/etc/vmware/config" ;
(my $progname = $0) =~ s=.*/==;

my %uname;
@uname{qw(sysname nodename release version machine)} = POSIX::uname ();


sub file_contents
{
  my $fh = gensym;
  open ($fh, $_[0]) || die "open: $_[0]: $!\n";
  local $/ = undef;
  return scalar <$fh>;
}

my $xsystem_errors_fatal = 1;
my $xsystem_verbose      = 1;
sub xsystem
{
  my $buf = "";

  if ($xsystem_verbose)
    {
      my @args = @_;
      map { $_ = "'$_'" if /\s/ } @args if @args > 1;
      print STDERR "+ @args\n";
    }

  if (defined wantarray)
    {
      my $fh = gensym;
      my $pid = open ($fh, "-|", @_);
      my ($p, $o) = (0, 0);
      $p += $o while ($o = sysread ($fh, $buf, 4096, $p));
      waitpid $pid, 0;
    }
  else
    {
      system (@_);
    }

  if ($xsystem_errors_fatal && $?)
    {
      my $status = $? >> 8;
      my $signal = $? & 0x7f;
      my $exit = $status || ($signal + 128);
      print STDERR "$progname: exit code $exit; aborting.\n";
      exit ($exit);
    }
  chomp $buf;
  return $buf;
}

sub xsymlink
{
  my ($from, $to) = @_;

  my $result = symlink ($from, $to);
  return $result if $result;

  # Don't complain if existing link is identical to old one
  my $errno = $! + 0;
  if ($errno == EEXIST && -l $to)
    {
      my $oldlink = readlink ($to);
      return 1 if $oldlink eq $from;
    }

  $! = $errno; # reset, because $! has magic string context
  die "symlink: $to: $!\n";
}


sub get_config
{
  map { my ($key, $val) = split (/\s*=\s*/, $_, 2);
        $val =~ s/^"(.*)"$/$1/;
        $key => $val;
      } split (/[\r\n]+/, file_contents ($_[0]));
}

sub get_modules
{
  my %config = get_config ($config_file);
  my %module;

  my $kv = $uname{release};

  my $xp = XML::XPath->new ( filename => $modules_xml );
  for my $mod ($xp->findnodes ('/modules/module'))
    {
      my $name = $mod->getAttribute ('name');

      # Skip modules which are in the kernel tree already
      chomp (my $fk = `modinfo -F intree -k $kv vmw_$name $name 2>/dev/null`);
      next if $fk =~ /^Y/;

      # Skip modules not supported in our kernel.
      my $mkv = $mod->findvalue ('restrictions/maxkernelversion')->value;
      next if $mkv && $uname{release} gt $mkv;

      $module{$name} = $mod->get_pos
        if (           $mod->getAttribute ('required') eq "true"
            || $config{$mod->getAttribute ('key')}     eq 'yes');
    }
  return sort { $module{$a} <=> $module{$b} } keys %module;
}

sub modconfig
{
  xsystem (qw(vmware-modconfig --console), @_);
}

sub main
{
  # causes problems with vmis-installer trying to look up gconf
  # accessibility settings.
  delete $ENV{SUDO_USER};

  my $utsRelease = $_[0] || $uname{release};

  # Linux 3.7 moved the version.h header that modconfig needs.  Doh!
  my $include = "/lib/modules/$utsRelease/build/include";
  xsymlink ("../generated/uapi/linux/version.h", "$include/linux/version.h")
    if (!  -e "$include/linux/version.h"
        && -e "$include/generated/uapi/linux/version.h");

  my $headers    = modconfig (qw(--get-kernel-headers -k), $utsRelease);
  my $gcc        = $_[1] || modconfig (qw(--get-gcc));

  modconfig (qw(--validate-kernel-headers -k), $utsRelease, $headers);
  modconfig (qw(--validate-gcc), $gcc);

  for my $mod (get_modules ())
    {
      modconfig (qw(--build-mod -k), $utsRelease, $mod, $gcc, $headers);
      print "Built $mod module\n";
    }
  xsystem (qw(depmod -a), $utsRelease);
  exit (0);
}

main (@ARGV);

1;