#!/usr/bin/perl -w
# If your copy of perl is not in /usr/bin, please adjust the line above.
#
# Copyright 1998 VMware, Inc.  All rights reserved.
#
# Host configurator for VMware

use strict;

# Use Config module to update VMware host-wide configuration file
# BEGINNING_OF_CONFIG_DOT_PM
#!/usr/bin/perl

###
### TODOs:
###  config file hierarchies
###  open/close/check file
###  error handling
###  config file checker
###  pretty print should print not present devices not in misc
###

use strict;
package VMware::Config;

my %PREF;

#$PREF{'commentChanges'} = 1;

sub new() {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my $self = $proto->create();
  bless($self, $class);
  return($self);
}

sub create {
  my $self = {};
  $self->{db} = {};
  $self->{tr} = 1;
  return($self);  
}

sub preserve_case($) {
  my $self = shift;
  my $preserve = shift;
  $self->{tr} = !$preserve;
}

sub clear() {
  my $self = {};
  $self->{db} = {};
}

sub readin($) {
  my $self = shift;
  my ($file) = @_;

  my $text = "";
  
  my @stat = stat($file);
  $self->{timestamp} = $stat[9];

  open(CFG, "< $file") || return undef;
  
  while (<CFG>) {
    $text = $text . $_;
  }
  
  close(CFG);

  my $ret = $self->parse($text);
  if (!defined($ret)) {
    return undef;
  }

  $self->{file} = $file;
  $self->{text} = $text;

  return 1;
}

sub writeout($) {
  my $self = shift;
  my ($file) = @_;

  if (!defined($file)) {
    $file = $self->{file};
  }

  open(CFG, "> $file") || return undef;
  print CFG $self->update($self->{text});
  close(CFG);

  return 1;
}

sub overwrite($$) {
  my $self = shift;
  my($orig, $file) = @_;
  
  if (!defined($file)) {
    $file = $orig->{file};
  }
  
  open(CFG, "> $file") || return undef;
  print CFG $self->update($orig->{text});
  close(CFG);

  return 1;  
}

sub pretty_overwrite {
  my $self = shift;
  my($file) = @_;
  
  if (!defined($file)) {
    $file = $self->{file};
  }
  
  open(CFG, "> $file") || return undef;
  print CFG $self->pretty_print();
  close(CFG);

  return 1;  
}

sub parse($) {
  my $self = shift;
  my ($text) = @_;
  my(@lines, $line, $num);
  
  @lines = split(/\n/, $text);
  $num = 1;
  
  foreach $line (@lines) {
    my($status, $name, $value, $start, $end) = $self->parse_line($line);
    if (!defined($status)) {
      $self->clear();
      # syntax error on line $num
      return undef;
    } elsif ($status == 1) {
      if ($self->{tr}) {
        $name =~ tr/A-Z/a-z/;
      }
      $self->{db}{$name}{value} = $value;
      $self->{db}{$name}{modified} = 0;
      $self->{db}{$name}{mark} = 0;
    } elsif ($status == 0) {
      # noop
    } else {
      $self->clear();
      # internal error
      return undef;
    }
    $num++;
  }
  
  return 1;
}

sub timestamp() {
  my $self = shift;
  return $self->{timestamp};
}

sub get() {
  my $self = shift;
  my($name, $default) = @_;
  if ($self->{tr}) {
    $name =~ tr/A-Z/a-z/;
  }
  if (defined($self->{db}{$name})) {
    $self->{db}{$name}{mark} = 1;
    return $self->{db}{$name}{value};
  } else {
    return $default;
  }
}
        
sub get_bool() {
  my $self = shift;
  my($name, $default) = @_;
  my $val = $self->get($name);
  if (!defined($val)) {
    $val = $default;
  }
  if ($val =~ /TRUE|1|Y|YES/i) {
    $val = 1;
  } else {
    $val = 0;
  }
  return $val;
}
        
sub set($$) {
  my $self = shift;
  my($name, $value) = @_;
  if ($self->{tr}) {
    $name =~ tr/A-Z/a-z/;
  }
  $self->{db}{$name}{value} = $value;
  $self->{db}{$name}{modified} = 1;
  $self->{db}{$name}{mark} = 0;
}

sub remove($) {
  my $self = shift;
  my($name) = @_;
  if ($self->{tr}) {
    $name =~ tr/A-Z/a-z/;
  }
  delete $self->{db}{$name};
}

sub list($) {
  my $self = shift;
  my($pattern) = @_;
  return sort(grep(/$pattern/, keys(%{$self->{db}})));
}

sub device_list {
  my $self = shift;
  my($name, $pattern, $show_all) = @_;
  my($dev, $val, %present);

  $show_all = 0 if (!defined($show_all));

  foreach $_ (keys(%{$self->{db}})) {
    if (/$name($pattern)\.present/) {
      $dev = $name . $1;
      $val = $self->get_bool("$dev.present");
      if ($show_all || !defined($val) || ($val)) {
        $present{$dev} = 1;
      }
    }
  }

  return sort(keys(%present));
}

sub update($) {
  my $self = shift;
  my ($text) = @_;
  my $out = "";
  my($line, $name);
  
  my @lines;
  if (defined($text)) {
    @lines = split(/\n/, $text);
  }
  my $num = 1;

  $self->unmark_all();
  
  foreach $line (@lines) {
    my($status, $name, $value, $start, $end) = $self->parse_line($line);

    if (defined($name)) {
      if ($self->{tr}) {
        $name =~ tr/A-Z/a-z/;
      }
    }

    ###
    ### five cases
    ###
    ###   1. deleted
    ###   2. modified
    ###   3. unmodified
    ###   4. comment or blank line
    ###   5. new (handled at the end)
    ###

    $line = $line . "\n";

    if (!defined($status)) {
      # XXX syntax error on line $num
      return undef;
      
    } elsif ($status == 1) {
      if (!defined($self->{db}{$name})) {
        ###
        ### Case 1. removed
        ###
        
        if (defined($PREF{'commentChanges'})) {
          $line = "# " . $line;
        } else {
          $line = "";
        }
        
      } else {
        $self->mark($name);

        if ($self->{db}{$name}{value} ne $value) {  
          ###
          ### Case 2. modified
          ###
          
          my $newline = substr($line, 0, $start) 
            . "\"" . $self->{db}{$name}{value} . "\"" . substr($line, $end);
          
          if (defined($PREF{'commentChanges'})) {
            $line = "# " . $line . $newline;
          } else {
            $line = $newline;
          }
          
        } else {
          ###
          ### Case 3. unmodified
          ###
        }
      }

    } elsif ($status == 0) {
      ###
      ### Case 4. comment or blank line
      ###
      
    } else {
      # XXX internal error: parse_line returned unknown status \"$status\"
      return undef;
    }
    
    $out = $out . "$line";
    $num++;
  }

  ###
  ### Case 5. new entries
  ###

  $out = $out . $self->print_unmarked();

  return $out;
}

sub dump_all() {
  my $self = shift;
  my $out = "";
  my $name;
  
  foreach $name (keys(%{$self->{db}})) {
    $out = $out . "$name = \"$self->{db}{$name}{value}\"\n";
  }
  
  return $out;
}

sub pretty_print($) {
  my $self = shift;
  my($templ) = @_;
  my $out = "";
  my $sec;

  $self->unmark_all();
  
  foreach $sec (@{$templ}) {  
    $out = $out . $self->print_section($sec, "");
  }
  
  $out = $out . "###\n### Misc.\n###\n\n";
  $out = $out . $self->print_unmarked();

  return $out;
}

sub print_section {
  my $self = shift;
  my($sec, $prefix) = @_;
  my $out = "";

  my @list;
  my $dev;
  
  if (defined($sec->{header})) {
    $out = $out . "###\n### $sec->{header}\n###\n\n";
  }
  
  ## name is here for compatibility, it should go away soon.
  my $name = defined($sec->{name}) ? $sec->{name} : "";

  if (defined($sec->{pattern})) {
    @list = $self->device_list($prefix . $name, $sec->{pattern}, 1);
    foreach $dev (@list) {
      if (defined($sec->{title})) {
        $out = $out . sprintf("# $sec->{title}\n\n", $dev);
      }
      $out = $out . $self->print_values("$dev", $sec->{values});
      if (defined($sec->{sublist})) {
        $out = $out . $self->print_section($sec->{sublist}, "$dev");
      }
    }
  } else {
    if (defined($sec->{values})) {
      $out = $out . $self->print_values($prefix . $name, $sec->{values});
    } else {
      $out = $out . $self->print_value($prefix . $name, "is not set");
      $out = $out . "\n";
    }
  }

  return $out;
}

sub print_values {
  my $self = shift;
  my($name, $vars) = @_;
  my $var;

  my $out = "";
  
   foreach $var (@{$vars}) {
     my $v = ($name ne "") ? "$name.$var" : $var;
     $out = $out . $self->print_value($v);
  }

  $out = $out . "\n";

  return $out;
}

sub print_value {
  my $self = shift;
  my($name, $notset) = @_;
  my $val = $self->get($name);
  if (defined($val)) {
    $self->mark($name);
    return "$name = \"$val\"\n";
  } elsif (defined($notset)) {
    return "# $name $notset\n";
  }
}

sub mark($) {
  my $self = shift;
  my($name) = @_;
  if ($self->{tr}) {
    $name =~ tr/A-Z/a-z/;
  }
  $self->{db}{$name}{mark} = 1;
}

sub unmark_all() {
  my $self = shift;
  my $name;
  foreach $name (keys %{$self->{db}}) {
    $self->{db}{$name}{mark} = 0;
  }
}

sub get_unmarked() {
  my $self = shift;
  my $name;
  my @list = ();
  foreach $name (keys %{$self->{db}}) {
    if (!$self->{db}{$name}{mark}) {
      push(@list, $name);
    }
  }
  return @list;
}

sub print_unmarked() {
  my $self = shift;
  my @unmarked = $self->get_unmarked();
  my $out = "";
  my $name;
  
  foreach $name (@unmarked) {
    $out = $out . "$name = \"$self->{db}{$name}{value}\"\n";
  }

  return $out;
}

sub parse_line($) {
  my $self = shift;
  ($_) = @_;

  if (/^\s*(\#.*)?$/) {
    return (0);
  } elsif (/^((\s*(\S+)\s*=\s*)(([\"]([^\"]*)[\"])|(\S+)))\s*(\#.*)?$/) {
    my $prefix1 = $2;
    my $prefix2 = $1;
    my $name = $3;
    my $value;
    if (defined($6)) {
      $value = $6;
    } else {
      $value = $7;
    }

    return (1, $name, $value, length($prefix1), length($prefix2));
  } 

  return (undef);  
}



1;

# END_OF_CONFIG_DOT_PM

# Constants
my $cKernelModuleDir = '/lib/modules';
my $cTmpDirPrefix = 'vmware-config';
my $cVmnixVersion = '@@VMNIXVERSION@@';
my $cConnectSocketDir = '/var/run/vmware';
my $machine = 'host';
my $os = 'host';
if (vmware_product() eq 'server') {
  $machine = 'machine';
  $os = "Console OS";
}

#
# Global variables
#
my $gRegistryDir;
my $gInstallerMainDB;
my $gConfFlag;
my %gSystem;
my %gHelper;
# List of all ethernet adapters on the system
my @gAllEthIf;
# List of ethernet adapters that have not been bridged
my @gAvailEthIf;
# By convention, vmnet1 is the virtual ethernet interface connected to the
# private virtual network that Samba uses.  We are also reserving vmnet0
# for bridged networks.  These are reserved vmnets.
my $gDefBridged = '0';
my $gDefHostOnly = '1';
my $gDefNat = '8';
# Reserved vmnets
my @gReservedVmnet = ($gDefBridged, $gDefHostOnly, $gDefNat);
# Constant defined as the smallest vmnet that is allowed
my $gMinVmnet = '0';
# Linux doesn't allow more than 7 characters in the names of network
# interfaces. We prefix host only interfaces with 'vmnet' leaving us only 2
# characters.
# Constant defined as the largest vmnet that is allowed
my $gMaxVmnet = '99';
# Constant defines as the number of vmnets to be pre-created
my $gNumVmnet = 10;
my $gFirstModuleBuild;
my $gDefaultAuthdPort = 902;

# BEGINNING OF THE SECOND LIBRARY FUNCTIONS
# Global variables
my %gDBAnswer;
my %gDBFile;
my %gDBDir;
my $cBackupExtension = '.BeforeVMwareToolsInstall';
my $cRestorePrefix = 'RESTORE_';
my $cRestoreBackupSuffix = '_BAK';
my $cRestoreBackList = 'RESTORE_BACK_LIST';
my $cSwitchedToHost = 'SWITCHED_TO_HOST';

# Load the installer database
sub db_load {
  undef %gDBAnswer;
  undef %gDBFile;
  undef %gDBDir;

  if (not open(INSTALLDB, '<' . $gInstallerMainDB)) {
    error('Unable to open the installer database ' . $gInstallerMainDB
          . ' in read-mode.' . "\n\n");
  }
  while (<INSTALLDB>) {
    if (/^answer (\S+) (\S+)/) {
      $gDBAnswer{$1} = $2;
    } elsif (/^answer (\S+)/) {
      $gDBAnswer{$1} = '';
    } elsif (/^remove_answer (\S+)/) {
      delete $gDBAnswer{$1};
    } elsif (/^file (\S+) (\S+)/) {
      $gDBFile{$1} = $2;
    } elsif (/^file (\S+)/) {
      $gDBFile{$1} = 0;
    } elsif (/^remove_file (\S+)/) {
      delete $gDBFile{$1};
    } elsif (/^directory (\S+)/) {
      $gDBDir{$1} = '';
    } elsif (/^remove_directory (\S+)/) {
      delete $gDBDir{$1};
    }
  }
  close(INSTALLDB);
}

# Open the database on disk in append mode
sub db_append {
  if (not open(INSTALLDB, '>>' . $gInstallerMainDB)) {
    error('Unable to open the installer database ' . $gInstallerMainDB
          . ' in append-mode.' . "\n\n");
  }
  # Force a flush after every write operation.
  # See 'Programming Perl', p. 110
  select((select(INSTALLDB), $| = 1)[0]);
}

# Add a file to the tar installer database
# flags:
#  0x1 write time stamp
sub db_add_file {
  my $file = shift;
  my $flags = shift;

  if ($flags & 0x1) {
    my @statbuf;

    @statbuf = stat($file);
    if (not (defined($statbuf[9]))) {
      error('Unable to get the last modification timestamp of the destination '
            . 'file ' . $file . '.' . "\n\n");
    }

    $gDBFile{$file} = $statbuf[9];
    print INSTALLDB 'file ' . $file . ' ' . $statbuf[9] . "\n";
  } else {
    $gDBFile{$file} = 0;
    print INSTALLDB 'file ' . $file . "\n";
  }
}

# Remove a file from the tar installer database
sub db_remove_file {
  my $file = shift;

  print INSTALLDB 'remove_file ' . $file . "\n";
  delete $gDBFile{$file};
}

# Remove a directory from the tar installer database
sub db_remove_dir {
  my $dir = shift;

  print INSTALLDB 'remove_directory ' . $dir . "\n";
  delete $gDBDir{$dir};
}

# Determine if a file belongs to the tar installer database
sub db_file_in {
  my $file = shift;

  return defined($gDBFile{$file});
}

# Determine if a directory belongs to the tar installer database
sub db_dir_in {
  my $dir = shift;

  return defined($gDBDir{$dir});
}

# Return the timestamp of an installed file
sub db_file_ts {
  my $file = shift;

  return $gDBFile{$file};
}

# Add a directory to the tar installer database
sub db_add_dir {
  my $dir = shift;

  $gDBDir{$dir} = '';
  print INSTALLDB 'directory ' . $dir . "\n";
}

# Remove an answer from the tar installer database
sub db_remove_answer {
  my $id = shift;

  if (defined($gDBAnswer{$id})) {
    print INSTALLDB 'remove_answer ' . $id . "\n";
    delete $gDBAnswer{$id};
  }
}

# Add an answer to the tar installer database
sub db_add_answer {
  my $id = shift;
  my $value = shift;

  db_remove_answer($id);
  $gDBAnswer{$id} = $value;
  print INSTALLDB 'answer ' . $id . ' ' . $value . "\n";
}

# Retrieve an answer that must be present in the database
sub db_get_answer {
  my $id = shift;

  if (not defined($gDBAnswer{$id})) {
    error('Unable to find the answer ' . $id . ' in the installer database ('
          . $gInstallerMainDB . ').  You may want to re-install '
          . vmware_product_name() . ".\n\n");
  }

  return $gDBAnswer{$id};
}


# Retrieves an answer if it exists in the database, else returns undef;
sub db_get_answer_if_exists {
  my $id = shift;
  if (not defined($gDBAnswer{$id})) {
    return undef;
  }
  if ($gDBAnswer{$id} eq '') {
    return undef;
  }
  return $gDBAnswer{$id};
}

# Save the tar installer database
sub db_save {
  close(INSTALLDB);
}
# END OF THE SECOND LIBRARY FUNCTIONS

# BEGINNING OF THE LIBRARY FUNCTIONS
# Constants
my $cTerminalLineSize = 80;

# Global variables
my %gOption;
my %gAnswerSize;
my %gCheckAnswerFct;

# Tell if the user is the super user
sub is_root {
  return $> == 0;
}

# Wordwrap system: append some content to the output
sub append_output {
  my $output = shift;
  my $pos = shift;
  my $append = shift;

  $output .= $append;
  $pos += length($append);
  if ($pos >= $cTerminalLineSize) {
    $output .= "\n";
    $pos = 0;
  }

  return ($output, $pos);
}

# Wordwrap system: deal with the next character
sub wrap_one_char {
  my $output = shift;
  my $pos = shift;
  my $word = shift;
  my $char = shift;
  my $reserved = shift;
  my $length;

  if (not (($char eq "\n") || ($char eq ' ') || ($char eq ''))) {
    $word .= $char;

    return ($output, $pos, $word);
  }

  # We found a separator.  Process the last word

  $length = length($word) + $reserved;
  if (($pos + $length) > $cTerminalLineSize) {
    # The last word doesn't fit in the end of the line. Break the line before
    # it
    $output .= "\n";
    $pos = 0;
  }
  ($output, $pos) = append_output($output, $pos, $word);
  $word = '';

  if ($char eq "\n") {
    $output .= "\n";
    $pos = 0;
  } elsif ($char eq ' ') {
    if ($pos) {
      ($output, $pos) = append_output($output, $pos, ' ');
    }
  }

  return ($output, $pos, $word);
}

# Wordwrap system: word-wrap a string plus some reserved trailing space
sub wrap {
  my $input = shift;
  my $reserved = shift;
  my $output;
  my $pos;
  my $word;
  my $i;

  $output = '';
  $pos = 0;
  $word = '';
  for ($i = 0; $i < length($input); $i++) {
    ($output, $pos, $word) = wrap_one_char($output, $pos, $word,
                                           substr($input, $i, 1), 0);
  }
  # Use an artifical last '' separator to process the last word
  ($output, $pos, $word) = wrap_one_char($output, $pos, $word, '', $reserved);

  return $output;
}

# Print an error message and exit
sub error {
  my $msg = shift;

  print STDERR wrap($msg . 'Execution aborted.' . "\n\n", 0);
  exit 1;
}

# Convert a string to its equivalent shell representation
sub shell_string {
  my $single_quoted = shift;

  $single_quoted =~ s/'/'"'"'/g;
  # This comment is a fix for emacs's broken syntax-highlighting code --hpreg
  return '\'' . $single_quoted . '\'';
}

# Contrary to a popular belief, 'which' is not always a shell builtin command.
# So we cannot trust it to determine the location of other binaries.
# Moreover, SuSE 6.1's 'which' is unable to handle program names beginning with
# a '/'...
#
# Return value is the complete path if found, or '' if not found
sub internal_which {
  my $bin = shift;

  if (substr($bin, 0, 1) eq '/') {
    # Absolute name
    if ((-f $bin) && (-x $bin)) {
      return $bin;
    }
  } else {
    # Relative name
    my @paths;
    my $path;

    if (index($bin, '/') == -1) {
      # There is no other '/' in the name
      @paths = split(':', $ENV{'PATH'});
      foreach $path (@paths) {
         my $fullbin;

         $fullbin = $path . '/' . $bin;
         if ((-f $fullbin) && (-x $fullbin)) {
               return $fullbin;
         }
      }
    }
  }

  return '';
}

# Remove leading and trailing whitespaces
sub remove_whitespaces {
  my $string = shift;

  $string =~ s/^\s*//;
  $string =~ s/\s*$//;
  return $string;
}

# Ask a question to the user and propose an optional default value
# Use this when you don't care about the validity of the answer
sub query {
    my $message = shift;
    my $defaultreply = shift;
    my $reserved = shift;
    my $reply;

    # Reserve some room for the reply
    print wrap($message . (($defaultreply eq '')
                            ? ''
                            : (' [' . $defaultreply . ']')),
               1 + $reserved);
    # This is what the 1 is for
    print ' ';

    if ($gOption{'default'} == 1) {
      # Simulate the enter key
      print "\n";
      $reply = '';
    } else {
      chomp($reply = <STDIN>);
    }

    print "\n";
    $reply = remove_whitespaces($reply);
    if ($reply eq '') {
      $reply = $defaultreply;
    }
    return $reply;
}

# Check the validity of an answer whose type is yesno
# Return a clean answer if valid, or ''
sub check_answer_binpath {
  my $answer = shift;
  my $source = shift;

  if (not (internal_which($answer) eq '')) {
    return $answer;
  }

  if ($source eq 'user') {
    print wrap('The answer "' . $answer . '" is invalid.  It must be the '
               . 'complete name of a binary file.' . "\n\n", 0);
  }
  return '';
}
$gAnswerSize{'binpath'} = 20;
$gCheckAnswerFct{'binpath'} = \&check_answer_binpath;

# Prompts the user if a binary is not found
# Return value is:
#  '': the binary has not been found
#  the binary name if it has been found
sub DoesBinaryExist_Prompt {
  my $bin = shift;
  my $answer;
  my $prefix = 'BIN_';

  $answer = check_answer_binpath($bin, 'default');
  if (not ($answer eq '')) {
    return $answer;
  } else {
    if (defined db_get_answer_if_exists($prefix . $bin)) {
      return db_get_answer($prefix . $bin);
    }
  }

  if (get_answer('Setup is unable to find the "' . $bin . '" program on your '
                 . 'machine.  Please make sure it is installed.  Do you want '
                 . 'to specify the location of this program by hand?', 'yesno',
                 'yes') eq 'no') {
    return '';
  }

  $answer = get_answer('What is the location of the "' . $bin . '" program on '
                    . 'your machine?', 'binpath', '');
  if (!defined db_get_answer_if_exists($prefix . $bin)) {
    db_add_answer($prefix . $bin, $answer);
  }
  return $answer;
}

# Execute the command passed as an argument
# _without_ interpolating variables (Perl does it by default)
sub direct_command {
  return `$_[0]`;
}

# chmod() that reports errors
sub safe_chmod {
  my $mode = shift;
  my $file = shift;

  if (chmod($mode, $file) != 1) {
    error('Unable to change the access rights of the file ' . $file . '.'
          . "\n\n");
  }
}

# Emulate a simplified ls program for directories
sub internal_ls {
  my $dir = shift;
  my @fn;

  opendir(LS, $dir);
  @fn = grep(!/^\.\.?$/, readdir(LS));
  closedir(LS);

  return @fn;
}

# Install a file permission
sub install_permission {
  my $src = shift;
  my $dst = shift;
  my @statbuf;

  @statbuf = stat($src);
  if (not (defined($statbuf[2]))) {
    error('Unable to get the access rights of source file "' . $src . '".'
          . "\n\n");
  }
  safe_chmod($statbuf[2] & 07777, $dst);
}

# Emulate a simplified sed program
# Return 1 if success, 0 if failure
# XXX as a side effect, if the string being replaced is '', remove
# the entire line.  Remove this, once we have better "block handling" of
# our config data in config files.
sub internal_sed {
  my $src = shift;
  my $dst = shift;
  my $append = shift;
  my $patchRef = shift;
  my @patchKeys;

  if (not open(SRC, '<' . $src)) {
    return 0;
  }
  if (not open(DST, (($append == 1) ? '>>' : '>') . $dst)) {
    return 0;
  }

  @patchKeys = keys(%$patchRef);
  if ($#patchKeys == -1) {
    while (defined($_ = <SRC>)) {
      print DST $_;
    }
  } else {
    while (defined($_ = <SRC>)) {
      my $patchKey;
      my $del = 0;

      foreach $patchKey (@patchKeys) {
        if (s/$patchKey/$$patchRef{$patchKey}/g) {
          if ($_ eq "\n") {
            $del = 1;
          }
        }
      }
      if ($del) {
        next;
      }
      print DST $_;
    }
  }

  close(SRC);
  close(DST);
  return 1;
}

# Check if a file name exists
sub file_name_exist {
  my $file = shift;

  # Note: We must test for -l before, because if an existing symlink points to
  #       a non-existing file, -e will be false
  return ((-l $file) || (-e $file))
}

# Check if a file name already exists and prompt the user
# Return 0 if the file can be written safely, 1 otherwise
sub file_check_exist {
  my $file = shift;

  if (not file_name_exist($file)) {
    return 0;
  }

  # The default must make sure that the product will be correctly installed
  # We give the user the choice so that a sysadmin can perform a normal
  # install on a NFS server and then answer 'no' NFS clients
  return (get_answer('The file ' . $file . ' that this program was about to '
                     . 'install already exists.  Overwrite?', 'yesno', 'yes')
            eq 'yes') ? 0 : 1;
}

# Install one file
# flags are forwarded to db_add_file()
sub install_file {
  my $src = shift;
  my $dst = shift;
  my $patchRef = shift;
  my $flags = shift;

  uninstall_file($dst);
  if (file_check_exist($dst)) {
    return;
  }
  # The file could be a symlink to another location.  Remove it
  unlink($dst);
  if (not internal_sed($src, $dst, 0, $patchRef)) {
    error('Unable to copy the source file ' . $src . ' to the destination '
          . 'file ' . $dst . '.' . "\n\n");
  }
  db_add_file($dst, $flags);
  install_permission($src, $dst);
}

# mkdir() that reports errors
sub safe_mkdir {
  my $file = shift;

  if (mkdir($file, 0000) == 0) {
    error('Unable to create the directory ' . $file . '.' . "\n\n");
  }
}

# Remove trailing slashes in a dir path
sub dir_remove_trailing_slashes {
  my $path = shift;

  for (;;) {
    my $len;
    my $pos;

    $len = length($path);
    if ($len < 2) {
      # Could be '/' or any other character.  Ok.
      return $path;
    }

    $pos = rindex($path, '/');
    if ($pos != $len - 1) {
      # No trailing slash
      return $path;
    }

    # Remove the trailing slash
    $path = substr($path, 0, $len - 1)
  }
}

# Emulate a simplified basename program
sub internal_basename {
  return substr($_[0], rindex($_[0], '/') + 1);
}

# Emulate a simplified dirname program
sub internal_dirname {
  my $path = shift;
  my $pos;

  $path = dir_remove_trailing_slashes($path);

  $pos = rindex($path, '/');
  if ($pos == -1) {
    # No slash
    return '.';
  }

  if ($pos == 0) {
    # The only slash is at the beginning
    return '/';
  }

  return substr($path, 0, $pos);
}

# Create a hierarchy of directories with permission 0755
# flags:
#  0x1 write this directory creation in the installer database
# Return 1 if the directory existed before
sub create_dir {
  my $dir = shift;
  my $flags = shift;

  if (-d $dir) {
    return 1;
  }

  if (index($dir, '/') != -1) {
    create_dir(internal_dirname($dir), $flags);
  }
  safe_mkdir($dir);
  if ($flags & 0x1) {
    db_add_dir($dir);
  }
  safe_chmod(0755, $dir);
  return 0;
}

# Get a valid non-persistent answer to a question
# Use this when the answer shouldn't be stored in the database
sub get_answer {
  my $msg = shift;
  my $type = shift;
  my $default = shift;
  my $answer;

  if (not defined($gAnswerSize{$type})) {
    die 'get_answer(): type ' . $type . ' not implemented :(' . "\n\n";
  }
  for (;;) {
    $answer = check_answer(query($msg, $default, $gAnswerSize{$type}), $type,
                           'user');
    if (not ($answer eq '')) {
      return $answer;
    }
  }
}

# Get a valid persistent answer to a question
# Use this when you want an answer to be stored in the database
sub get_persistent_answer {
  my $msg = shift;
  my $id = shift;
  my $type = shift;
  my $default = shift;
  my $answer;

  if (defined($gDBAnswer{$id})) {
    # There is a previous answer in the database
    $answer = check_answer($gDBAnswer{$id}, $type, 'db');
    if (not ($answer eq '')) {
      # The previous answer is valid.  Make it the default value
      $default = $answer;
    }
  }

  $answer = get_answer($msg, $type, $default);
  db_add_answer($id, $answer);
  return $answer;
}

# Find a suitable backup name and backup a file
sub backup_file {
  my $file = shift;
  my $i;

  for ($i = 0; $i < 100; $i++) {
    if (not file_name_exist($file . '.old.' . $i)) {
      my %patch;

      undef %patch;
      if (internal_sed($file, $file . '.old.' . $i, 0, \%patch)) {
         print wrap('File ' . $file . ' is backed up to ' . $file . '.old.'
                    . $i . '.' . "\n\n", 0);
      } else {
         print STDERR wrap('Unable to backup the file ' . $file . ' to '
                           . $file . '.old.' . $i .'.' . "\n\n", 0);
      }
      return;
    }
  }

  print STDERR wrap('Unable to backup the file ' . $file . '.  You have too '
                    . 'many backups files.  They are files of the form '
                    . $file . '.old.N, where N is a number.  Please delete '
                    . 'some of them.' . "\n\n", 0);
}

# Backup a file in the idea to restore it in the future.
sub backup_file_to_restore {
  my $file = shift;
  my $restoreStr = shift;
  if (file_name_exist($file) &&
      (not file_name_exist($file . $cBackupExtension))) {
    my %p;
    undef %p;
    rename $file, $file . $cBackupExtension;
    db_add_answer($cRestorePrefix . $restoreStr, $file);
    db_add_answer($cRestorePrefix . $restoreStr . $cRestoreBackupSuffix,
                  $file . $cBackupExtension);

    if (defined db_get_answer_if_exists($cRestoreBackList)) {
      my $allRestoreStr;
      $allRestoreStr = db_get_answer($cRestoreBackList);
      db_add_answer($cRestoreBackList,$allRestoreStr . ':' . $restoreStr);
    } else {
      db_add_answer($cRestoreBackList, $restoreStr);
    }
  }
}

# XXX Duplicated in pkg_mgr.pl
# format of the returned hash:
#          - key is the system file
#          - value is the backed up file.
# This function should never know about filenames. Only database
# operations.
sub db_get_files_to_restore {
  my %fileToRestore;
  undef %fileToRestore;

  if (defined db_get_answer_if_exists($cRestoreBackList)) {
    my $restoreStr;
    foreach $restoreStr (split(/:/, db_get_answer($cRestoreBackList))) {
      if (defined db_get_answer_if_exists($cRestorePrefix . $restoreStr)) {
        $fileToRestore{db_get_answer($cRestorePrefix . $restoreStr)} =
          db_get_answer($cRestorePrefix . $restoreStr
                        . $cRestoreBackupSuffix);
      }
    }
  }
  return %fileToRestore;
}

# Uninstall a file previously installed by us
sub uninstall_file {
  my $file = shift;

  if (not db_file_in($file)) {
    # Not installed by this program
    return;
  }

  if (file_name_exist($file)) {
    if (db_file_ts($file)) {
      my @statbuf;

      @statbuf = stat($file);
      if (defined($statbuf[9])) {
         if (db_file_ts($file) != $statbuf[9]) {
           # Modified since this program installed it
           backup_file($file);
         }
      } else {
        print STDERR wrap('Unable to get the last modification timestamp of '
                          . 'the file ' . $file . '.' . "\n\n", 0);
      }
    }

    if (not unlink($file)) {
      print STDERR wrap('Unable to remove the file ' . $file . '.' . "\n\n",
                        0);
    }
  } else {
    print wrap('This program previously created the file ' . $file . ', and '
               . 'was about to remove it.  Somebody else apparently did it '
               . 'already.' . "\n\n", 0);
  }

  db_remove_file($file);
}

# Uninstall a directory previously installed by us
sub uninstall_dir {
  my $dir = shift;

  if (not db_dir_in($dir)) {
    # Not installed by this program
    return;
  }

  if (-d $dir) {
    if (not rmdir($dir)) {
      print wrap('This program previously created the directory ' . $dir . ', '
                 . 'and was about to remove it. Since there are files in that '
                 . 'directory that this program did not create, it will not be '
                 . 'removed.' . "\n\n", 0);
      if (   defined($ENV{'VMWARE_DEBUG'})
          && ($ENV{'VMWARE_DEBUG'} eq 'yes')) {
        system('ls -AlR ' . shell_string($dir));
      }
    }
  } else {
    print wrap('This program previously created the directory ' . $dir
               . ', and was about to remove it. Somebody else apparently did '
               . 'it already.' . "\n\n", 0);
  }

  db_remove_dir($dir);
}

# Uninstall files and directories beginning with a given prefix
sub uninstall_prefix {
  my $prefix = shift;
  my $prefix_len;
  my $file;
  my $dir;

  $prefix_len = length($prefix);

  # Remove all files beginning with $prefix
  foreach $file (keys %gDBFile) {
    if (substr($file, 0, $prefix_len) eq $prefix) {
      uninstall_file($file);
    }
  }

  # Remove all directories beginning with $prefix
  # We sort them by decreasing order of their length, to ensure that we will
  # remove the inner ones before the outer ones
  foreach $dir (sort {length($b) <=> length($a)} keys %gDBDir) {
    if (substr($dir, 0, $prefix_len) eq $prefix) {
      uninstall_dir($dir);
    }
  }
}

# Return the version of VMware
sub vmware_version {
  my $buildNr;

  $buildNr = '4.0.0 build-4460';
  return remove_whitespaces($buildNr);
}

# Return product name and version
sub vmware_longname {
   my $name = vmware_product_name() . ' ' . vmware_version();

   if (not (vmware_product() eq 'server')) {
      $name .= ' for Linux'
   }

   return $name;
}

# Check the validity of an answer whose type is yesno
# Return a clean answer if valid, or ''
sub check_answer_yesno {
  my $answer = shift;
  my $source = shift;

  if (lc($answer) =~ /^y(es)?$/) {
    return 'yes';
  }

  if (lc($answer) =~ /^n(o)?$/) {
    return 'no';
  }

  if ($source eq 'user') {
    print wrap('The answer "' . $answer . '" is invalid.  It must be one of '
               . '"y" or "n".' . "\n\n", 0);
  }
  return '';
}
$gAnswerSize{'yesno'} = 3;
$gCheckAnswerFct{'yesno'} = \&check_answer_yesno;

# Check the validity of an answer based on its type
# Return a clean answer if valid, or ''
sub check_answer {
  my $answer = shift;
  my $type = shift;
  my $source = shift;

  if (not defined($gCheckAnswerFct{$type})) {
    die 'check_answer(): type ' . $type . ' not implemented :(' . "\n\n";
  }
  return &{$gCheckAnswerFct{$type}}($answer, $source);
}
# END OF THE LIBRARY FUNCTIONS

# BEGINNING_OF_TMPDIR_DOT_PL
#!/usr/bin/perl

use strict;

# Create a temporary directory
#
# They are a lot of small utility programs to create temporary files in a
# secure way, but none of them is standard. So I wrote this --hpreg
sub make_tmp_dir {
  my $prefix = shift;
  my $tmp;
  my $serial;
  my $loop;

  $tmp = defined($ENV{'TMPDIR'}) ? $ENV{'TMPDIR'} : '/tmp';

  # Don't overwrite existing user data
  # -> Create a directory with a name that didn't exist before
  #
  # This may never succeed (if we are racing with a malicious process), but at
  # least it is secure
  $serial = 0;
  for (;;) {
    # Check the validity of the temporary directory. We do this in the loop
    # because it can change over time
    if (not (-d $tmp)) {
      error('"' . $tmp . '" is not a directory.' . "\n\n");
    }
    if (not ((-w $tmp) && (-x $tmp))) {
      error('"' . $tmp . '" should be writable and executable.' . "\n\n");
    }

    # Be secure
    # -> Don't give write access to other users (so that they can not use this
    # directory to launch a symlink attack)
    if (mkdir($tmp . '/' . $prefix . $serial, 0755)) {
      last;
    }

    $serial++;
    if ($serial % 200 == 0) {
      print STDERR 'Warning: The "' . $tmp . '" directory may be under attack.' . "\n\n";
    }
  }

  return $tmp . '/' . $prefix . $serial;
}

# END_OF_TMPDIR_DOT_PL

# Set the name of the main /etc/vmware* directory.
sub initialize_globals {

  if (vmware_product() eq 'console') {
    $gRegistryDir = '/etc/vmware-console';
  } elsif (vmware_product() eq 'mui') {
    $gRegistryDir = '/etc/vmware-mui';
  } elsif (vmware_product() eq 'tools-for-linux') {
    $gRegistryDir = '/etc/vmware-tools';
  } else {
    $gRegistryDir = '/etc/vmware';
  }
  $gInstallerMainDB = $gRegistryDir . '/locations';
  $gConfFlag = $gRegistryDir . '/not_configured';

  $gOption{'default'} = 0;
  $gOption{'compile'} = 0;
  $gOption{'prebuilt'} = 0;
  $gOption{'try-modules'} = 0;
  $gOption{'tools-switch'} = 0;

}


# Set up the location of external helpers
sub initialize_external_helpers {
  my $program;

  if (not defined($gHelper{'more'})) {
    $gHelper{'more'} = '';
    if (defined($ENV{'PAGER'})) {
      my @tokens;

      # The environment variable sometimes contains the pager name _followed by
      # a few command line options_.
      #
      # Isolate the program name (we are certain it does not contain a
      # whitespace) before dealing with it.
      @tokens = split(' ', $ENV{'PAGER'});
      $tokens[0] = DoesBinaryExist_Prompt($tokens[0]);
      if (not ($tokens[0] eq '')) {
        # This is _already_ a shell string
        $gHelper{'more'} = join(' ', @tokens);
      }
    }
    if ($gHelper{'more'} eq '') {
      $gHelper{'more'} = DoesBinaryExist_Prompt('more');
      if ($gHelper{'more'} eq '') {
        error('Unable to continue.' . "\n\n");
      }
      # Save it as a shell string
      $gHelper{'more'} = shell_string($gHelper{'more'});
    }
  }

  foreach $program ('uname', 'grep', 'ldd', 'mknod', 'insmod', 'modprobe',
                    'rmmod', 'ifconfig', 'lspci') {
    if (not defined($gHelper{$program})) {
      $gHelper{$program} = DoesBinaryExist_Prompt($program);
      if ($gHelper{$program} eq '') {
        error('Unable to continue.' . "\n\n");
      }
    }
  }

  $gHelper{'insserv'} = internal_which('insserv');
}

# Check the validity of an answer whose type is headerdir
# Return a clean answer if valid, or ''
sub check_answer_headerdir {
  my $answer = shift;
  my $source = shift;
  my $pattern = '@@VMWARE@@';
  my $header_version_uts;
  my $header_smp;
  my $header_page_offset;

  $answer = dir_remove_trailing_slashes($answer);

  if (not (-d $answer)) {
    if ($source eq 'user') {
      print wrap('The path "' . $answer . '" is not an existing directory.'
                 . "\n\n", 0);
    }
    return '';
  }

  if (   (not (-d $answer . '/linux'))
      || (not (-d $answer . '/asm'))
      || (not (-d $answer . '/net'))) {
    if ($source eq 'user') {
      print wrap('The path "' . $answer . '" is an existing directory, but it '
                 . 'does not contain at least one of these directories '
                 . '"linux", "asm", "net" as expected.' . "\n\n", 0);
    }
    return '';
  }

  #
  # Check that the running kernel matches the set of header files
  #

  if (not (-r $answer . '/linux/version.h')) {
    if ($source eq 'user') {
      print wrap('The path "' . $answer . '" is a kernel header file '
                 . 'directory, but it does not contain the file '
                 . '"linux/version.h" as expected.  This can happen if the '
                 . 'kernel has never been built, or if you have invoked the '
                 . '"make mrproper" command in your kernel directory.  In any '
                 . 'case, you may want to rebuild your kernel.' . "\n\n", 0);
    }
    return '';
  }
  $header_version_uts = direct_command(
    shell_string($gHelper{'echo'}) . ' '
    . shell_string('#include <linux/version.h>' . "\n" . $pattern
                   . ' UTS_RELEASE') . ' | ' . shell_string($gHelper{'gcc'})
    . ' ' . shell_string('-I' . $answer) . ' -E - | '
    . shell_string($gHelper{'grep'}) . ' ' . shell_string($pattern));
  chomp($header_version_uts);
  $header_version_uts =~ s/^$pattern \"([^\"]*)\".*$/$1/;
  if (not ($header_version_uts eq $gSystem{'uts_release'})) {
    if ($source eq 'user') {
      print wrap('The directory of kernel headers (version '
                 . $header_version_uts . ') does not match your running '
                 . 'kernel (version ' . $gSystem{'uts_release'} . ').  Even '
                 . 'if the module were to compile successfully, it would not '
                 . 'load into the running kernel.' . "\n\n", 0);
    }
    return '';
  }

  if (not (-r $answer . '/linux/autoconf.h')) {
    if ($source eq 'user') {
      print wrap('The path "' . $answer . '" is a kernel header file '
                 . 'directory, but it does not contain the file '
                 . '"linux/autoconf.h" as expected.  This can happen if the '
                 . 'kernel has never been built, or if you have invoked the '
                 . '"make mrproper" command in your kernel directory.  In any '
                 . 'case, you may want to rebuild your kernel.' . "\n\n", 0);
    }
    return '';
  }
  $header_smp = direct_command(shell_string($gHelper{'grep'}) . ' CONFIG_SMP '
                               . shell_string($answer . '/linux/autoconf.h'));
  if (not ($header_smp eq '')) {
    # linux/autoconf.h contains the up/smp information
    $header_smp = direct_command(
      shell_string($gHelper{'echo'}) . ' '
      . shell_string('#include <linux/autoconf.h>' . "\n" . $pattern
                     . ' CONFIG_SMP') . ' | ' . shell_string($gHelper{'gcc'})
      . ' ' . shell_string('-I' . $answer) . ' -E - | '
      . shell_string($gHelper{'grep'}) . ' ' . shell_string($pattern));
    chomp($header_smp);
    $header_smp =~ s/^$pattern (\S+).*$/$1/;
    $header_smp = ($header_smp eq '1') ? 'yes' : 'no';
    if (not (lc($header_smp) eq lc($gSystem{'smp'}))) {
      if ($source eq 'user') {
        print wrap('The kernel defined by this directory of header files is '
                   . (($header_smp eq 'yes') ? 'multiprocessor'
                                             : 'uniprocessor') . ', while '
                   . 'your running kernel is '
                   . (($gSystem{'smp'} eq 'yes') ? 'multiprocessor'
                                                 : 'uniprocessor') . '.'
                   . "\n\n", 0);
      }
      return '';
    }
  }

  if (not (-r $answer . '/asm/page.h')) {
    if ($source eq 'user') {
      print wrap('The path "' . $answer . '" is a kernel header file '
                 . 'directory, but it does not contain the file "asm/page.h" '
                 . 'as expected.' . "\n\n", 0);
    }
    return '';
  }
  $header_page_offset = direct_command(
    shell_string($gHelper{'echo'}) . ' '
    . shell_string('#define __KERNEL__' . "\n" . '#include <asm/page.h>'
                   . "\n" . $pattern . ' __PAGE_OFFSET') . ' | '
    . shell_string($gHelper{'gcc'}) . ' ' . shell_string('-I' . $answer)
    . ' -E - | ' . shell_string($gHelper{'grep'}) . ' '
    . shell_string($pattern));
  chomp($header_page_offset);
  $header_page_offset =~ s/^$pattern \(0x([0-9a-fA-F]{8}).*$/$1/;
  if ($header_page_offset =~ /[0-9a-fA-F]{8}/) {
    # We found a valid page offset
    if (not (lc($header_page_offset) eq lc($gSystem{'page_offset'}))) {
      if ($source eq 'user') {
        print wrap('The kernel defined by this directory of header files does '
                   . 'not have the same address space size as your running '
                   . 'kernel.' . "\n\n", 0);
      }
      return '';
    }
  }

  return $answer;
}
$gAnswerSize{'headerdir'} = 20;
$gCheckAnswerFct{'headerdir'} = \&check_answer_headerdir;

# Check the validity of an answer whose type is ip
# Return a clean answer if valid, or ''
sub check_answer_ip {
  my $answer = shift;
  my $source = shift;
  my $re;

  # I'm in love with regular expressions --hpreg
  $re = '^([0-9]|[1-9][0-9]|1[0-9][0-9]|2([0-4][0-9]|5[0-5]))'
        . '(\.([0-9]|[1-9][0-9]|1[0-9][0-9]|2([0-4][0-9]|5[0-5]))){3}$';
  # This comment fixes emacs's broken syntax highlighting
  if ($answer =~ /$re/) {
    return $answer;
  }

  if ($source eq 'user') {
    print wrap('The answer "' . $answer . '" is invalid.  It must be of the '
               . 'form a.b.c.d where a, b, c and d are decimal numbers '
               . 'between 0 and 255.' . "\n\n", 0);
  }
  return '';
}
$gAnswerSize{'ip'} = 15;
$gCheckAnswerFct{'ip'} = \&check_answer_ip;

# Check the validity of an answer whose type is editorwizardhelp
# Return a clean answer if valid, or ''
sub check_answer_editorwizardhelp {
  my $answer = shift;
  my $source = shift;

  if (lc($answer) =~ /^e(ditor)?$/) {
    return 'editor';
  }

  if (lc($answer) =~ /^w(izard)?$/) {
    return 'wizard';
  }

  if (lc($answer) =~ /^h(elp)?$/) {
    return 'help';
  }

  if ($source eq 'user') {
    print wrap('The answer "' . $answer . '" is invalid. It must be one of '
               . '"w", "e" or "h".' . "\n\n", 0);
  }
  return '';
}
$gAnswerSize{'editorwizardhelp'} = 6;
$gCheckAnswerFct{'editorwizardhelp'} = \&check_answer_editorwizardhelp;

# Check the validity of an answer whose type is yesnohelp
# Return a clean answer if valid, or ''
sub check_answer_yesnohelp {
  my $answer = shift;
  my $source = shift;

  if (lc($answer) =~ /^y(es)?$/) {
    return 'yes';
  }

  if (lc($answer) =~ /^n(o)?$/) {
    return 'no';
  }

  if (lc($answer) =~ /^h(elp)?$/) {
    return 'help';
  }

  if ($source eq 'user') {
    print wrap('The answer "' . $answer . '" is invalid.  It must be one of '
               . '"y", "n" or "h".' . "\n\n", 0);
  }
  return '';
}
$gAnswerSize{'yesnohelp'} = 4;
$gCheckAnswerFct{'yesnohelp'} = \&check_answer_yesnohelp;

# Check the validity of an answer whose type is vmnet
# Return a clean answer if valid, or ''
sub check_answer_vmnet {
  my $answer = shift;
  my $source = shift;

  if ($answer =~ /^\d+$/) {
    if ($answer >= $gMinVmnet && $answer <= $gMaxVmnet) {
      return $answer;
    }
  }

  if ($source eq 'user') {
    print wrap('The answer "' . $answer . '" is invalid. It must be an '
               . 'integer between ' . $gMinVmnet . ' and ' . $gMaxVmnet . '.'
               . "\n\n", 0);
  }

  return '';
}
$gAnswerSize{'vmnet'} = length("$gMaxVmnet");
$gCheckAnswerFct{'vmnet'} = \&check_answer_vmnet;

# Check the validity of an answer whose type is nettype
# Return a clean answer if valid, or ''
sub check_answer_nettype {
  my $answer = shift;
  my $source = shift;

  if (lc($answer) =~ /^h(ostonly)?$/) {
    return 'hostonly';
  }

  if (lc($answer =~ /^b(ridged)?$/)) {
    return 'bridged';
  }

  if (lc($answer =~ /^n(at)?$/)) {
    return 'nat';
  }

  if (lc($answer =~ /^none$/)) {
    return 'none';
  }

  if ($source eq 'user') {
    print wrap('The answer "' . $answer . '" is invalid. It must be either '
               . '"b", "h", "n", or "none".' . "\n\n", 0);
  }
  return '';
}
$gAnswerSize{'nettype'} = 8;
$gCheckAnswerFct{'nettype'} = \&check_answer_nettype;

# Check the validity of an answer whose type is availethif
# Return a clean answer if valid, or ''
sub check_answer_availethif {
  my $answer = shift;
  my $source = shift;

  if (grep($answer eq $_, @gAvailEthIf)) {
    return $answer;
  }

  if ($source eq 'user') {
    if (grep($answer eq $_, @gAllEthIf)) {
      print wrap('The ethernet device "' . $answer . '" is already configured '
                 . 'as a bridged device.' . "\n\n", 0);
      return '';
    }
    if (get_answer('The ethernet device "' . $answer . '" was not detected on '
                   . 'your system.  Available ethernet devices detected on '
                   . 'your system include ' . join(', ', @gAvailEthIf) . '.  '
                   . 'Are you sure you want to use this device? (yes/no)',
                   'yesno', 'no') eq 'no') {
      return '';
    } else {
      return $answer;
    }
  }
  return '';
}
$gAnswerSize{'availethif'} = 4;
$gCheckAnswerFct{'availethif'} = \&check_answer_availethif;

# check the validity of a user or group name
# return the answer if valid or ''
sub check_answer_usergp {
  my $answer = shift;
  my $source = shift;

  if (($answer=~/^\S+$/) && ($answer=~/^[a-zA-Z]/)) {
    return $answer;
  }

  if ($source eq 'user') {
    print wrap('The answer "' . $answer . '" is invalid. Please enter a valid'
               . ' name of length < 32 and beginning with a letter'
               . "\n\n", 0);
  }

  return '';
}

$gAnswerSize{'usergp'} = 32;
$gCheckAnswerFct{'usergp'} = \&check_answer_usergp;

# check the validity of a timeout value
# return the answer if valid or ''
sub check_answer_timeout {
  my $answer = shift;
  my $source = shift;

  if ($answer=~/^\d+$/ && $answer >= 0) {
    return $answer;
  }

  if ($source eq 'user') {
    print wrap('The answer "' . $answer . '" is invalid. Please enter a valid'
               . ' number of minutes in the range 0 to 99999' . "\n\n", 0);
  }

  return '';
}

$gAnswerSize{'timeout'} = 5;
$gCheckAnswerFct{'timeout'} = \&check_answer_timeout;


# Check the validity of an answer whose type is nocheck
# Always returns answer.
sub check_answer_anyethif {
  my $answer = shift;
  my $source = shift;

  return $answer;
}
$gAnswerSize{'anyethif'} = 4;
$gCheckAnswerFct{'anyethif'} = \&check_answer_anyethif;

# Check the validity of an answer whose type is authdport
# Return a clean answer if valid, or ''
sub check_answer_authdport {
  my $answer = shift;
  my $source = shift;

  if ($source eq 'default') {
    if (check_if_port_free($answer) != 1) {
      return '';
    }
  }

  if (($answer =~ /^\d+$/) && ($answer > 0) && ($answer < 65536)) {
    return $answer;
  }

  if ($source eq 'user') {
    print wrap('The answer "' . $answer . '" is invalid. Please enter a valid '
               . 'port number in the range 1 to 65535.' . "\n\n", 0);
  }

  return '';
}
$gAnswerSize{'authdport'} = 5;
$gCheckAnswerFct{'authdport'} = \&check_answer_authdport;

# Check the validity of an answer whose type is number
# Return a clean number if valid, or '0'
# Default value for the 'number' type of answer.
# This $gMaxNumber as well as the $gAnswerSize{'number'} has to be updated
# before calling get_*_answer functions so that wrap() leaves enough room
# for the reply.
my $gMaxNumber = 0;
sub check_answer_number {
  my $answer = shift;
  my $source = shift;

  if (($answer =~ /^\d+$/) && ($answer > 0) && ($answer <= $gMaxNumber)) {
    return $answer;
  }

  if ($source eq 'user') {
    print wrap('The answer "' . $answer . '" is invalid. Please enter a valid '
               . 'number in the range 1 to ' . $gMaxNumber . "\n\n", 0);
  }

  return '';
}
$gAnswerSize{'number'} = length($gMaxNumber);
$gCheckAnswerFct{'number'} = \&check_answer_number;

my %gPortCache;
# Check /etc/services file for specified port
# If /etc/services cant be read, return -1
# If port not in /etc/services return 1
# If port is in /etc/services return 0
sub check_port_not_registered {
  my $port = shift;
  my $services_file = '/etc/services';
  if (defined($gPortCache{$port}) && $gPortCache{$port} == 2) {
    return 0;
  }
  if (not open(CONF, $services_file)) {
    return -1;
  }
  while (<CONF>) {
    if (/\b(\d+)\/(tcp)\b/i) {
      $gPortCache{$1} = 2;
    }
  }
  close(CONF);
  if (defined($gPortCache{$port}) && $gPortCache{$port} == 2) {
    return 0;
  }
  return 1;

}


# Check the /etc/services file and use /proc/net/tcp to see 
# if the port is already in use.
# If we fail to check, return -1
# If port is free, return 1;
# If port is in use, return 0;
sub check_if_port_free {
  my $port = shift;
  if (defined($gPortCache{$port})) {
    return 0;
  }
  # Check /proc/net/tcp and /proc/net/udp
  if (open(TCP, "</proc/net/tcp")) {
    while (<TCP>) {
      if (/^\s*\d+:\s*[0-9a-fA-F]{8}:([0-9a-fA-F]{4})\s*[0-9a-fA-F]{8}:[0-9a-fA-F]{4}\s*([0-9a-fA-F]{2}).*$/) {
        # We'll consider a socket free if it is in TIME_WAIT state
        if ($2 ne "06") {
          $gPortCache{hex($1)} = 1;
        }
      }
    }
    close TCP;
  }
  if (defined($gPortCache{$port})) {
    return 0;
  }
  return check_port_not_registered($port);
}

# Display the end-user license agreement
sub show_EULA {
  if (   (not defined($gDBAnswer{'EULA_AGREED'}))
      || (db_get_answer('EULA_AGREED') eq 'no')) {
    query('You must read and accept the End User License Agreement to '
          . 'continue.' . "\n" . 'Press enter to display it.', '', 0);

    # $gHelper{'more'} is already a shell string
    system($gHelper{'more'} . ' ' . shell_string(db_get_answer('DOCDIR')
                                                 . '/EULA'));
    print "\n";

    # Make sure there is no default answer here
    if (get_persistent_answer('Do you accept? (yes/no)', 'EULA_AGREED',
                              'yesno', '') eq 'no') {
      print wrap('Please try again when you are ready to accept.' . "\n\n", 0);
      exit 0;
    }

    print wrap('Thank you.' . "\n\n", 0);
  }
}

# Build a Linux kernel integer version
sub kernel_version_integer {
  my $version = shift;
  my $patchLevel = shift;
  my $subLevel = shift;

  return $version * 65536 + $patchLevel * 256 + $subLevel;
}

# Retrieve distribution information
sub distribution_info {
  my $issue = '/etc/issue';
  my $system;

  # First use the accurate method that are intended to work reliably on recent
  # distributions (if an FHS guy is listening, we really need a generic way to
  # do this)
  if (-e '/etc/debian_version') {
    return 'debian';
  }
  if (-e '/etc/redhat-release') {
    return 'redhat';
  }
  if (-e '/etc/SuSE-release') {
    return 'suse';
  }
  if (-e '/etc/turbolinux-release') {
    return 'turbolinux';
  }
  if (-e '/etc/mandrake-release') {
    return 'mandrake';
  }

  # Then use less accurate methods that should work even on old distributions,
  # if people haven't customized their system too much
  if (-e $issue) {
    if (not (direct_command(shell_string($gHelper{'grep'}) . ' -i '
                            . shell_string('debian') . ' '
                            . shell_string($issue)) eq '')) {
      return 'debian';
    }
    if (not (direct_command(shell_string($gHelper{'grep'}) . ' -i '
                            . shell_string('red *hat') . ' '
                            . shell_string($issue)) eq '')) {
      return 'redhat';
    }
    if (not (direct_command(shell_string($gHelper{'grep'}) . ' -i '
                            . shell_string('suse\|s\.u\.s\.e') . ' '
                            . shell_string($issue)) eq '')) {
      return 'suse';
    }
    if (not (direct_command(shell_string($gHelper{'grep'}) . ' -i '
                            . shell_string('caldera') . ' '
                            . shell_string($issue)) eq '')) {
      return 'caldera';
    }
  }

  return 'unknown';
}

sub vmware_check_vm_app_name {
  return db_get_answer('SBINDIR') . '/vmware-checkvm';
}

sub vmware_vmx_app_name {
  return db_get_answer('LIBDIR') . '/bin/vmware-vmx';
}

# Retrieve and check system information
sub system_info {
  my $fullVersion;
  my $version;
  my $patchLevel;
  my $subLevel;

  $gSystem{'system'} = direct_command(shell_string($gHelper{'uname'}) . ' -s');
  chomp($gSystem{'system'});
  if (not ($gSystem{'system'} eq 'Linux')) {
    error('You are not running Linux.  This version of the product only runs '
          . 'on Linux.' . "\n\n");
  }

  if (vmware_product() eq 'server') {
    # Force the answer even if they're running Linux right now.
    $gSystem{'uts_release'} = '@@VMNIXVERSION@@';
  } else {
    $gSystem{'uts_release'} = direct_command(shell_string($gHelper{'uname'})
                                             . ' -r');
    chomp($gSystem{'uts_release'});
  }
  $gSystem{'uts_version'} = direct_command(shell_string($gHelper{'uname'})
                                           . ' -v');
  chomp($gSystem{'uts_version'});

  ($version, $patchLevel, $subLevel) = split(/\./, $gSystem{'uts_release'});
  # Clean the subLevel in case there is an extraversion
  ($subLevel) = split(/[^0-9]/, $subLevel);
  $gSystem{'version_utsclean'} = $version . '.' . $patchLevel . '.'
                                 . $subLevel;

  $gSystem{'version_integer'} = kernel_version_integer($version, $patchLevel,
                                                       $subLevel);
  if ($gSystem{'version_integer'} < kernel_version_integer(2, 0, 0)) {
    error('You are running Linux version ' . $gSystem{'version_utsclean'}
          . '.  This product only runs on 2.0.0 and later kernels.' . "\n\n");
  }

  if (vmware_product() eq 'server') {
    $gSystem{'smp'} = 'no';
    $gSystem{'versioned'} = 'yes';
  } else {
    $gSystem{'smp'} = (direct_command(shell_string($gHelper{'uname'})
                                      . ' -v') =~ / SMP /) ? 'yes' : 'no';
    $gSystem{'versioned'} = (direct_command(shell_string($gHelper{'grep'}) . ' '
      . shell_string('^[0-9a-fA-F]\{8\} Using_Versions') . ' /proc/ksyms')
        eq '') ? 'no' : 'yes';
  }

  $gSystem{'distribution'} = distribution_info();

  $gSystem{'page_offset'} = 'C0000000';
  if ($gSystem{'version_integer'} >= kernel_version_integer(2, 1, 0)) {
    # 2.1.0+ kernels have hardware verify_area() support --hpreg
    my @fields;

    @fields = split(' ', direct_command(
      shell_string($gHelper{'grep'}) . ' '
      . shell_string('^[0-9a-fA-F]\{8\} printk') . ' /proc/ksyms'));
    if (defined($fields[0])) {
      my $first;

      $first = lc(substr($fields[0], 0, 1));
      if ($first =~ /^[4567]$/) {
        $first = '4';
      } elsif ($first =~ /^[89ab]$/) {
        $first = '8';
      } elsif ($first =~ /^[cd]$/) {
        $first = 'C';
      } elsif ($first =~ /^[ef]$/) {
        $first = 'E';
      } else {
        # Unexpected --hpreg
        $first = 'C';
      }
      $gSystem{'page_offset'} = $first . '0000000';
    }
  }

  # Linux kernel build bug
  $gSystem{'build_bug'} = (direct_command(shell_string($gHelper{'grep'}) . ' '
    . shell_string('^[0-9a-fA-F]\{8\} __global_cli_R__ver___global_cli')
    . ' /proc/ksyms') eq '') ? 'no' : 'yes';

  # Warning, the return after the end of the if statement
  # will void everything after.
  if (vmware_product() eq 'tools-for-linux') {
    $gSystem{'product'} =
      direct_command(shell_string(vmware_check_vm_app_name()) . ' -p');
    if (direct_command(shell_string(vmware_check_vm_app_name())) =~ /good/) {
      $gSystem{'invm'} = 'yes';
    } else {
      $gSystem{'invm'} = 'no';
    }
    $gSystem{'resolution'} =
      direct_command(shell_string(vmware_check_vm_app_name()) . ' -r');
    return;
  }

  if (vmware_product() eq 'wgs') {
    if ($gSystem{'uts_release'} =~ m/2\.2\.14-(5|5\.0)/) {
         print wrap('You are running kernel ' . $gSystem{'uts_release'} . '. '
                    . 'There is a known issue with this specific kernel that '
                    . 'can cause corruption of memory on a system wide level '
                    . 'under heavy load, such as when running '
                    . vmware_product_name() . '.' . "\n\n" . 'We recommend '
                    . 'you download the patch from Red Hat, or upgrade your '
                    . 'kernel to 2.2.17.' . "\n" . 'See http://www.redhat.com'
                    . '/support/errata/RHBA-2000013-01.html and consult your '
                    . 'distribution\'s documentation for instructions on how '
                    . 'to upgrade your kernel.' . "\n\n", 0);
    }
  }

  # CONFIG_UMISC on 2.0 kernels
  if ($gSystem{'version_integer'} < kernel_version_integer(2, 1, 0)) {
    if (   (direct_command(shell_string($gHelper{'grep'}) . ' '
                           . shell_string('^[0-9a-fA-F]\{8\} misc_register')
                           . ' /proc/ksyms') eq '')
        || (direct_command(shell_string($gHelper{'grep'}) . ' '
                           . shell_string('^[0-9a-fA-F]\{8\} misc_deregister')
                           . ' /proc/ksyms') eq '')) {
      error('You are running a Linux kernel version '
            . $gSystem{'version_utsclean'} . ' that was not built with the '
            . 'CONFIG_UMISC configuration parameter set.  '
            . vmware_product_name() . ' will not run on this system.'
            . "\n\n");
    }
  }

  # 3Com bug on 2.0.3[45] kernels
  if (   ($gSystem{'version_integer'} >= kernel_version_integer(2, 0, 34))
      && ($gSystem{'version_integer'} <= kernel_version_integer(2, 0, 35))) {
    if (   (not (-r '/proc/ioports'))
        || (not (direct_command(shell_string($gHelper{'grep'}) . ' -i '
                                . shell_string('3c90\|3c59')
                                . ' /proc/ioports') eq ''))) {
      if (get_answer('You are running Linux version '
                     . $gSystem{'version_utsclean'} . ' possibly with a 3Com '
                     . 'networking card.  Linux kernel versions 2.0.34 and '
                     . '2.0.35 have a bug in the 3Com driver that interacts '
                     . 'badly with this product.  Specifically, your physical '
                     . 'machine will occasionally hang and will require a '
                     . 'hard reset.  This bug has been fixed in 2.0.36 and '
                     . 'later kernels.  Do you want to continue the '
                     . 'configuration anyway?', 'yesno', 'no') eq 'no') {
         exit 1;
      }
    }
  }

  # C library
  # XXX This relies on the locale
  if (system(shell_string($gHelper{'ldd'}) . ' '
             . shell_string(vmware_vmx_app_name()) . ' | '
             . shell_string($gHelper{'grep'}) . ' -q -i '
             . shell_string('not found')) == 0) {
    print wrap('The correct version of one or more libraries needed to run '
               . vmware_product_name()
               . ' may be missing.  This is the output of '
               . $gHelper{'ldd'} . ' ' . db_get_answer('BINDIR') . '/vmware:'
               . "\n", 0);
    system(shell_string($gHelper{'ldd'}) . ' '
           . shell_string(vmware_vmx_app_name()));
    print "\n";
    query('This program cannot tell for sure, but you may need to upgrade '
          . 'libc5 to glibc before you can run ' . vmware_product_name()
          . ".\n\n"
          . 'Hit enter ' . 'to continue.', '', 0);
  }

  # Processor
  foreach my $instruction ('^cpuid', 'cmov') {
    if (direct_command(shell_string($gHelper{'grep'}) . ' '
        . shell_string($instruction) . ' /proc/cpuinfo') eq '') {
      error('Your ' . (($gSystem{'smp'} eq 'yes') ? 'processors do'
                                                  : 'processor does') . ' not '
            . 'support the ' . $instruction . ' instruction. '
            . vmware_product_name() . ' will not run on this system.' . "\n\n");
    }
  }
  # The "flags" field became the "features" field in 2.4.0-test11-pre5 --hpreg
  if (direct_command(shell_string($gHelper{'grep'}) . ' '
                     . shell_string('^\(flags\|features\).* tsc')
                     . ' /proc/cpuinfo') eq '') {
    error('Your ' . (($gSystem{'smp'} eq 'yes') ? 'processors do'
                                                : 'processor does') . ' not '
          . 'have a Time Stamp Counter.  ' . vmware_product_name()
          . ' will not run on this system.' . "\n\n");
  }
}

# Point the user to a URL dealing with module-related problems and exits
sub module_error {
  error('For more information on how to troubleshoot module-related problems, '
        . 'please visit our Web site at "http://www.vmware.com/download'
        . '/modules/modules.html" and "http://www.vmware.com/support/reference'
        . '/linux/prebuilt_modules_linux.html".' . "\n\n");
}

# Install a module if it suitable
# Return 1 if success, 0 if failure
sub try_module {
  my $name = shift;
  my $mod = shift;
  my $force = shift;
  my $silent = shift;
  my $dst_dir;
  my %patch;

  if (not (-e $mod)) {
    # The module does not exist
    return 0;
  }

  if (not (vmware_product() eq 'server')) {
    # Probe the module without loading it or executing its code.  It is cool
    # because it avoids problems like 'Device or resource busy'
    # Note: -f bypasses only the kernel version check, not the symbol
    # resolution
    if (system(shell_string($gHelper{'insmod'}) . ' -p '
               . ($force ? '-f ' : '') . shell_string($mod)
               . ($silent ? ' >/dev/null 2>&1' : ''))) {
      return 0;
    }
    # If we are using new module-init-tools, they just ignore
    # '-p' option, and they just loaded module into the memory.
    # Just try rmmod-ing it. Silently.
    system(shell_string($gHelper{'rmmod'}) . ' ' . shell_string($name)
    	   . ' >/dev/null 2>&1');
  }

  if (-d $cKernelModuleDir . '/'. $gSystem{'uts_release'}) {
    $dst_dir = $cKernelModuleDir . '/' . $gSystem{'uts_release'};
  } else {
    print wrap('This program does not know where to install the ' . $name
               . ' module because the "' . $cKernelModuleDir . '/'
               . $gSystem{'uts_release'} . '" directory (the usual '
               . 'location where the running kernel would look for the '
               . 'module) is missing.  Please make sure that this '
               . 'directory exists before re-running this program.'
               . "\n\n", 0);
    module_error();
  }
  create_dir($dst_dir . '/misc', 0x1);
  undef %patch;
  # Install the module with a .o extension, as the Linux kernel does
  install_file($mod, $dst_dir . '/misc/' . $name . '.o', \%patch, 0x1);
  # The old installer allowed people to manually build modules without .o
  # extension.  Such modules were not removed by the old uninstaller, and
  # unfortunately, insmod tries them first.  Let's move them.
  if (file_name_exist($dst_dir . '/misc/' . $name)) {
    backup_file($dst_dir . '/misc/' . $name);
    if (not unlink($dst_dir . '/misc/' . $name)) {
      print STDERR wrap('Unable to remove the file ' . $dst_dir . '/misc/'
                        . $name . '.' . "\n\n", 0);
    }
  }

  return 1;
}

# Remove a temporary directory
sub remove_tmp_dir {
  my $dir = shift;

  if (system(shell_string($gHelper{'rm'}) . ' -rf ' . shell_string($dir))) {
    print STDERR wrap('Unable to remove the temporary directory ' . $dir . '.'
                      . "\n\n", 0);
  };
}

sub get_cc {
  $gHelper{'gcc'} = '';
  if (defined($ENV{'CC'}) && (not ($ENV{'CC'} eq ''))) {
    $gHelper{'gcc'} = internal_which($ENV{'CC'});
    if ($gHelper{'gcc'} eq '') {
      print wrap('Unable to find the compiler specified in the CC environnment variable: "'
                 . $ENV{'CC'} . '".' . "\n\n", 0);
    }
  }
  if ($gHelper{'gcc'} eq '') {
    $gHelper{'gcc'} = internal_which('gcc');
    if ($gHelper{'gcc'} eq '') {
      $gHelper{'gcc'} = internal_which('egcs');
      if ($gHelper{'gcc'} eq '') {
        $gHelper{'gcc'} = internal_which('kgcc');
        if ($gHelper{'gcc'} eq '') {
          $gHelper{'gcc'} = DoesBinaryExist_Prompt('gcc');
        }
      }
    }
  }
  print wrap('Using compiler "' . $gHelper{'gcc'}
             . '". Use environment variable CC to override.' . "\n\n", 0);
  return $gHelper{'gcc'};
}

# Verify gcc version
sub check_gcc_version {
  my ($gcc_version) = @_;
  my ($kernel_gcc_version) = undef;

  if (open(PROC_VERSION, '</proc/version')) {
    my $line;
    if (defined($line = <PROC_VERSION>)) {
      close PROC_VERSION;
      if ($line =~ /gcc version (egcs-)?(\d+(\.\d+)*)/) {
        $kernel_gcc_version = $2;
	if ($kernel_gcc_version eq $gcc_version) {
	  return 0;
	}
      }
    } else {
      close PROC_VERSION;
    }
  }
  my $msg;
  my $g_m = '0';
  if ($gcc_version =~ /^(\d+)\./) {
    $g_m = $1;
  }
  if (defined($kernel_gcc_version)) {
    my $k_m = '0';

    if ($kernel_gcc_version =~ /^(\d+)\./) {
      $k_m = $1;
    }
    $msg = 'Your kernel was built with "gcc" version "' . $kernel_gcc_version .
           '", while you are trying to use "' . $gHelper{'gcc'} . 
	   '" version "' . $gcc_version . '". ';
    if ($g_m ne $k_m) {
      $msg .= 'This configuration is not supported and ' . 
              vmware_product_name() . ' cannot work in such configuration. ' .
              'Please either recompile your kernel with "' . $gHelper{'gcc'} .
              '" version "'. $gcc_version . '", or restart ' . $0 . 
	      ' with CC environment variable pointing to the "gcc" version "' .
	      $kernel_gcc_version . '".' . "\n\n";
      print wrap($msg, 0);
      module_error();
    }
    $msg .= 'This configuration is not recommended and ' .
            vmware_product_name() . ' may crash if you\'ll continue. ' .
	    'Please try to use exactly same compiler as one used for ' .
	    'building your kernel. Do you want to go with compiler "' .
	    $gHelper{'gcc'} .'" version "' . $gcc_version .'" anyway?';
  } else {
    if ($g_m >= 3) {
      $msg = 'As of March 2003, gcc version 3 and later is not yet ' .
             'a supported compiler by the Linux kernel development team. ' .
             'Have a look at Documentation/Changes in your kernel source ' .
	     'directory to get the correct compiler installed. Do you want ' .
	     'to go with compiler "' . $gHelper{'gcc'} . '" version "' . 
	     $gcc_version . '"?';
    }
  }
  if (defined($msg) and get_answer($msg, 'yesno', 'no') eq 'no') {
    print wrap('Unable to continue.' . "\n\n", 0);
    module_error();
  }
  return 1;
}

# Build a module
sub build_module {
  my $name = shift;
  my $dir = shift;
  my $ideal = shift;
  my $build_dir;
  my $gcc_version;

  # Lazy initialization
  if ($gFirstModuleBuild == 1) {
    my $program;
    my $headerdir;

    foreach $program ('make', 'echo', 'tar', 'rm') {
      if (not defined($gHelper{$program})) {
        $gHelper{$program} = DoesBinaryExist_Prompt($program);
        if ($gHelper{$program} eq '') {
          print wrap('Unable to continue.' . "\n\n", 0);
          module_error();
        }
      }
    }

    if (get_cc() eq '') {
      print wrap('Unable to continue.' . "\n\n", 0);
      module_error();
    }

    $gcc_version = direct_command(shell_string($gHelper{'gcc'})
                                  . ' -dumpversion');
    chomp($gcc_version);
    if ($gcc_version =~ /^(egcs-)?(\d+(\.\d+)*)/) {
      $gSystem{'gcc_version'} = $2;
    } else {
      print wrap('Your compiler "' . $gHelper{'gcc'} . '" version "' . 
      		 $gcc_version . '" is not supported ' . 
		 'by this version of ' . vmware_product_name() . '.' . 
		 "\n\n", 0);
      print wrap('Unable to continue.' . "\n\n", 0);
      module_error();
    }

    check_gcc_version($gSystem{'gcc_version'});

    # When installing the modules, kernels 2.4+ setup a symlink to the kernel
    # source directory
    $headerdir = $cKernelModuleDir . '/preferred/build/include';
    if (check_answer_headerdir($headerdir, 'default') eq '') {
      $headerdir = $cKernelModuleDir . '/' . $gSystem{'uts_release'}
                   . '/build/include';
      if (check_answer_headerdir($headerdir, 'default') eq '') {
        # Use a default usual location
        $headerdir = '/usr/src/linux/include';
      }
    }
    get_persistent_answer('What is the location of the directory of C header '
                          . 'files that match your running kernel?',
                          'HEADER_DIR', 'headerdir', $headerdir);

    $gFirstModuleBuild = 0;
  }

  print wrap('Extracting the sources of the ' . $name . ' module.' . "\n\n",
             0);
  $build_dir = make_tmp_dir($cTmpDirPrefix);

  if (system(shell_string($gHelper{'tar'}) . ' -C ' . shell_string($build_dir)
             . ' -xopf ' . shell_string($dir . '/' . $name . '.tar'))) {
    print wrap('Unable to untar the "' . $dir . '/' . $name . '.tar'
               . '" file in the "' . $build_dir . '" directory.' . "\n\n", 0);
    module_error();
  }

  print wrap('Building the ' . $name . ' module.' . "\n\n", 0);
  if (system(shell_string($gHelper{'make'}) . ' -C '
             . shell_string($build_dir . '/' . $name . '-only')
             . ' auto-build ' . (($gSystem{'smp'} eq 'yes') ? 'SUPPORT_SMP=1 '
                                                            : '')
             . shell_string('HEADER_DIR=' . db_get_answer('HEADER_DIR')) . ' '
             . shell_string('CC=' . $gHelper{'gcc'}) . ' '
             . shell_string('GREP=' . $gHelper{'grep'}) . ' '
             . shell_string('IS_GCC_3='
             . (($gSystem{'gcc_version'} =~ /^3\./) ? 'yes' : 'no')))) {
    print wrap('Unable to build the ' . $name . ' module.' . "\n\n", 0);
    module_error();
  }

  # Don't use the force flag: the module is supposed to perfectly load
  if (try_module($name, $build_dir . '/' . $name . '.o', 0, 1)) {
    print wrap('The module loads perfectly in the running kernel.' . "\n\n",
               0);
    remove_tmp_dir($build_dir);
    return;
  }

  # Don't remove the build dir so that the user can investiguate
  print wrap('Unable to make a ' . $name . ' module that can be loaded in the '
             . 'running kernel:' . "\n", 0);
  try_module($name, $build_dir . '/' . $name . '.o', 0, 0);
  # Try to analyze some usual suspects
  if ($gSystem{'build_bug'} eq 'yes') {
    print wrap('It appears that your running kernel has not been built from a '
               . 'kernel source tree that was completely clean (i.e. the '
               . 'person who built your running kernel did not use the "make '
               . 'mrproper" command).  You may want to ask the provider of '
               . 'your Linux distribution to fix the problem.  In the '
               . 'meantime, you can do it yourself by rebuilding a kernel '
               . 'from a kernel source tree that is completely clean.'
               . "\n\n", 0);
  } else {
    print wrap('There is probably a slight difference in the kernel '
               . 'configuration between the set of C header files you '
               . 'specified and your running kernel.  You may want to rebuild '
               . 'a kernel based on that directory, or specify another '
               . 'directory.' . "\n\n", 0);
  }
  module_error();
}

# Create a list of modules suitable for the running kernel
# The kernel module loader does quite a good job when modules are versioned.
# But in the other case, we must be _very_ careful
sub get_suitable_modules {
  my $dir = shift;
  my @list;
  my $candidate;

  @list = ();
  foreach $candidate (internal_ls($dir)) {
    my %prop;

    # Read the properties file
    if (not open(PROP, '<' . $dir . '/' . $candidate . '/properties')) {
      print STDERR wrap('Unable to open the property file "' . $dir . '/'
                        . $candidate . '/properties".  Skipping this kernel.'
                        . "\n\n", 0);
      next;
    }
    undef %prop;
    while (<PROP>) {
      if (/^UtsVersion (.+)$/) {
        $prop{'UtsVersion'} = $1;
      } elsif (/^(\S+) (\S+)/) {
        $prop{$1} = $2;
      }
    }
    close(PROP);

    if (not (lc($gSystem{'smp'}) eq lc($prop{'SMP'}))) {
      # SMP does not match
      next;
    }
    if (not (lc($gSystem{'page_offset'}) eq lc($prop{'PageOffset'}))) {
      # Page offset does not match
      next;
    }

    if ($gSystem{'uts_release'} eq $prop{'UtsRelease'}
        && (!defined($prop{'UtsVersion'})
            || $gSystem{'uts_version'} eq $prop{'UtsVersion'})) {
      # Perfect match.  Try this module first
      unshift(@list, ($candidate, $prop{'ModVersion'}));
    } else {
      # This is a problem in some cases even with symbol versionning.
      # See bug number 18371.
      # --Jeremy Bar
      if ($gOption{'try-modules'} == 1) {
        push(@list, ($candidate, $prop{'ModVersion'}));
      }
    }
  }

  return @list;
}

# Configure a module
sub configure_module {
  my $name = shift;
  my $mod_dir;

  if (   defined($gDBAnswer{'ALT_MOD_DIR'})
      && ($gDBAnswer{'ALT_MOD_DIR'} eq 'yes')) {
    $mod_dir = db_get_answer('LIBDIR') . '/modules.new';
  } else {
    $mod_dir = db_get_answer('LIBDIR') . '/modules';
  }

  if ($gOption{'compile'} == 1) {
    db_add_answer('BUILDR_' . $name, 'yes');
  } else {
    my @mod_list;

    print wrap('Trying to find a suitable ' . $name
               . ' module for your running kernel.' . "\n\n", 0);
    @mod_list = get_suitable_modules($mod_dir . '/binary');
    while ($#mod_list > -1) {
      my $candidate = shift(@mod_list);
      my $modversion = shift(@mod_list);

      # Note: When using the force flag,
      #        Non-versioned modules can load into a     versioned kernel.
      #            Versioned modules can load into a non-versioned kernel.
      #
      # Consequently, it is only safe to use the force flag if _both_ the
      # kernel and the module are versioned.
      # This is not always the case as demonstrated by bug 18371.

      if (try_module($name,
                     $mod_dir . '/binary/' . $candidate . '/objects/'
                     . $name . '.o',
                        ($gSystem{'versioned'} eq 'yes')
                     && ($modversion eq 'yes'), 1)) {
        print wrap('The module ' . $candidate . ' loads perfectly in the '
                   . 'running kernel.' . "\n\n", 0);
        return;
      }
    }

    if ($gOption{'prebuilt'} == 1) {
      db_add_answer('BUILDR_' . $name, 'no');
      print wrap('None of ' .  vmware_product_name() . '\'s pre-built '
                 . $name . ' modules is suitable for your running kernel.  '
                 . 'Unable to continue.' . "\n\n", 0);
      module_error();
    }

    if (get_persistent_answer('None of ' . vmware_product_name() . '\'s '
                              . 'pre-built ' . $name . ' modules is suitable '
                              . 'for your running kernel.  Do you want this '
                              . 'program to try to build the ' . $name
                              . ' module for your system (you need to have a '
                              . 'C compiler installed on your system)?',
                              'BUILDR_' . $name, 'yesno', 'yes') eq 'no') {
      print wrap('Unable to continue.' . "\n\n", 0);
      module_error();
    }
  }

  build_module($name, $mod_dir . '/source');
  $gOption{'compile'} = 1;
}

# Create a device name
sub configure_dev {
  my $name = shift;
  my $major = shift;
  my $minor = shift;
  my $chr = shift;
  my $type;
  my $typename;

  if ($chr == 1) {
    $type = 'c';
    $typename = 'character';
  }
  else {
    $type = 'b';
    $typename = 'block';
  }
  uninstall_file($name);
  if (-e $name) {
    if (-c $name) {
      my @statbuf;

      @statbuf = stat($name);
      if (   defined($statbuf[6])
          && (($statbuf[6] >> 8) == $major)
          && (($statbuf[6] & 0xFF) == $minor)
          && ($chr == 1 && ($statbuf[2] & 0020000) != 0 ||
               $chr == 0 && ($statbuf[2] & 0020000) == 0)) {
         # The device is already correctly configured
         return;
      }
    }

    if (get_answer('This program wanted to create the ' . $typename . ' device '
                   . $name . ' with major number ' . $major . ' and minor '
                   . 'number ' . $minor . ', but there is already a different '
                   . 'kind of file at this location.  Overwrite?', 'yesno',
                   'yes') eq 'no') {
      error('Unable to continue.' . "\n\n");
    }

    # mknod doesn't like when the file already exists
    unlink($name);
  }

  if (system(shell_string($gHelper{'mknod'}) . ' ' . shell_string($name) . ' '
             . shell_string($type) . ' ' . shell_string($major) . ' '
             . shell_string($minor))) {
    error('Unable to create the ' . $typename . ' device ' . $name . ' with '
          . 'major number ' . $major . ' and minor number ' . $minor . '.'
          . "\n\n");
  }
  safe_chmod(0600, $name);
  # These "files" don't have a content, don't timestamp them
  db_add_file($name, 0);
}

# Configuration related to the monitor
sub configure_mon {
  configure_module('vmmon');
  if (-e '/dev/.devfsd') {
    # The "devfs" filesystem is mounted on the "/dev" directory, so the
    # "/dev/vmmon" block device file is magically created/removed when the
    # "vmmon" module is loaded/unloaded (was bug 15571) --hpreg
  } else {
    configure_dev('/dev/vmmon', 10, 165, 1);
  }
}

# Configuration related to parallel ports
sub configure_pp {
  my $i;

  if ($gSystem{'version_integer'} < kernel_version_integer(2, 1, 127)) {
    query('You are running Linux version ' . $gSystem{'version_utsclean'}
          . ', and this kernel cannot provide ' . vmware_product_name()
          . ' with Bidirectional Parallel Port support.  A fully-featured '
          . vmware_product_name() . ' requires Linux version 2.1.127 or '
          . 'higher.' . "\n\n" . 'Without this support, '
          . vmware_product_name() . ' will run flawlessly, but will lack the '
          . 'ability to use parallel ports in a bidirectional way.  This '
          . 'means that it is possible that some parallel port devices '
          . '(scanners, dongles, ...) will not work inside a virtual machine.'
          . "\n\n" . 'Hit enter to continue.', '', 0);
    return;
  }

  if ($gSystem{'version_integer'} <= kernel_version_integer(2, 3, 9)) {
    # Those kernels don't support ppdev.  We need to supply our vmppuser module

    print wrap('Making sure that both the parport and parport_pc kernel '
               . 'services are available.' . "\n\n", 0);

    # The vmppuser module relies on the parport modules.  Let's
    # make sure it is loaded before beginning our tests
    if (direct_command(shell_string($gHelper{'grep'}) . '  '
                       . shell_string(' parport_release[^' . "\t" . ']*$')
                       . ' /proc/ksyms') eq '') {
      # This comment fixes emacs's broken syntax highlighting
      # parport support is not built in the kernel
      if (system(shell_string($gHelper{'modprobe'})
                 . ' parport >/dev/null 2>&1')) {
        query('Unable to load the parport module that is required by the '
              . 'vmppuser module.  You may want to load it manually before '
              . 're-running this program.' . "\n\n" . 'Without this support, '
              . vmware_product_name() . ' will run flawlessly, but will lack '
              . 'the ability to use parallel ports in a bidirectional way.  '
              . 'This means that it is possible that some parallel port '
              . 'devices (scanners, dongles, ...) will not work inside a '
              . 'virtual machine.' . "\n\n"
              . 'Hit enter to continue.', '', 0);
        return;
      }
    }

    # The vmppuser module relies on the parport_pc modules.  Let's
    # make sure it is loaded before beginning our tests
    if (direct_command(shell_string($gHelper{'grep'}) . '  '
                       . shell_string(' parport_pc_[^' . "\t" . ']*$')
                       . ' /proc/ksyms') eq '') {
      # This comment fixes emacs's broken syntax highlighting
      # parport_pc support is not built in the kernel
      if (system(shell_string($gHelper{'modprobe'})
                 . ' parport_pc >/dev/null 2>&1')) {
        query('Unable to load the parport_pc module that is required by the '
              . 'vmppuser module.  You may want to load it manually before '
              . 're-running this program.' . "\n\n" . 'Without this support, '
              . vmware_product_name() . ' will run flawlessly, but will lack '
              . 'the ability to use parallel ports in a bidirectional way.  '
              . 'This means that it is possible that some parallel port '
              . 'devices (scanners, dongles, ...) will not work inside a '
              . 'virtual machine.' . "\n\n" . 'Hit enter to continue.', '', 0);
        return;
      }
    }

    configure_module('vmppuser');

    # Try to unload the modules.  Failure is allowed because some other
    # process could be using them.
    system(shell_string($gHelper{'modprobe'})
           . ' -r parport_pc >/dev/null 2>&1');
    system(shell_string($gHelper{'modprobe'}) . ' -r parport >/dev/null 2>&1');
  }

  # The parport numbering scheme in 2.2.X is confusing:
  # Because devices can be daisy-chained on a port, the first port
  # (/proc/parport/0) is /dev/parport0, but the second one (/proc/parport/1)
  # is /dev/parport16 (not /dev/parport1), and so on...

  # This message is wrong.  I have found no evidence for this.
  # On all the linux machines that I've looked at /dev/parport1 is the 2nd port
  # That's my story and I'm sticking to it  - DavidE

  for ($i = 0; $i < 4; $i++) {
    configure_dev('/dev/parport' . $i, 99, $i, 1);
  }
}

# Configuration of the vmmemctl tools device
sub configure_vmmemctl {
  # For the time being, only ESX uses the vmmemctl driver.
  if ($gSystem{'product'} =~ /ESX/) {
    configure_module('vmmemctl');
  }
}

# Configuration of the vmhgfs tools device
sub configure_vmhgfs {
  # vmhgfs is supported only since 2.4.0
  if ($gSystem{'uts_release'} =~ /^(\d+)\.(\d+)/ &&
      $1 * 1000 + $2 >= 2004) {
    create_dir('/mnt/hgfs', 0x1);
    configure_module('vmhgfs');
  }
}

#
# This function is taken from the old tools installer.
# The first argument is a complete path to a file which will be read and 
# overwritten with the result.
# The second argument will be only read and should be the system file present
# before configuration.
#
sub configure_modules_dot_conf {

  my ($newModulesConf, $systemModulesConf) = @_;
  my $count;
  my $ethfound;
  my $inline;
  my @inputs;
  my @inwords;
  my $line;
  my $optchk;
  my $sbfound;
  my $use_vmxnet;

  if (not file_name_exist($systemModulesConf)) {
    my %patch;
    undef %patch;
    internal_sed('/dev/null', $systemModulesConf, 0, \%patch);
  }

  # Capture current contents before overwriting
  if (not open(SAVEMODCONF, "<$newModulesConf")) {
    error('Unable to open the file "' . $newModulesConf . '".' . "\n\n");
  }
  @inputs = readline(*SAVEMODCONF);
  close(SAVEMODCONF);

  if (not open(SYSMODCONF, "<$systemModulesConf")) {
    error('Unable to open the file "' . $systemModulesConf . '".' . "\n\n");
  }

  if (not open(NEWMODCONF, ">$newModulesConf")) {
    error('Unable to open the file "' . $newModulesConf . '".' . "\n\n");
  }

  # Look for matches and selectively replace drivers
  $ethfound = 0;
  $sbfound = 0;
  $use_vmxnet = 0;
  while (defined($inline = <SYSMODCONF>)) {
    $optchk = 0;
    foreach $line (@inputs) {
      @inwords = split (/\s+/, $line);
      $count = @inwords;
      if (defined($inline) and ($count >= 2)) {
        if ($inline =~ /^\s*$inwords[0]\s+$inwords[1]/) {
          if (($inwords[0] =~ /options/) and ($optchk == 1)) {
            $optchk = 0;
            print NEWMODCONF $line;
            $inline = <SYSMODCONF>;
          } elsif ($inwords[0] =~ /alias/) {
            if ($inwords[1] =~ /eth0/) {
              $ethfound = 1; 
              if ($inline =~ /vmxnet/) {
                $use_vmxnet = 1;
              }
            } elsif (($inwords[1] =~ /sound/) or
                     ($inwords[1] =~ /char-major-14/)) {
              $sbfound = 1;
            }
            $optchk = 1;
            if ($use_vmxnet) {
              print NEWMODCONF $inline;
              $use_vmxnet = 0;
            } else {
              print NEWMODCONF $line;
            }
            $inline = <SYSMODCONF>;
          }
        } elsif ($optchk) {
          if ($inwords[0] =~ /options/) {
            print NEWMODCONF $line;
          }
          if ($inline =~ /^\s*options\s+/) {
            $inline = <SYSMODCONF>;
          }
          $optchk = 0;
        }
      } 
    }
    if (defined($inline)) {
      print NEWMODCONF $inline;
    }
  }

  # Then pick up any drivers we haven't got yet.
  if (($ethfound == 0) or ($sbfound == 0)) {
    foreach $line (@inputs) {
      @inwords = split (/\s+/, $line);
      $count = @inwords;
      if ($count >= 2) {
        if (($ethfound == 0) and ($inwords[1] =~ /eth0/)) {
          if ($inwords[0] =~ /options/) {
            $optchk = 0;
          } else {
            $optchk = 1;
          }
          print NEWMODCONF $line;
          $ethfound = 1;
        } elsif (($sbfound == 0) and 
             (($inwords[1] =~ /sound/) or
              ($inwords[1] =~ /char-major-14/)) ) {
          if ($inwords[0] =~ /options/) {
            $optchk = 0;
          } else {
            $optchk = 1;
          }
          print NEWMODCONF $line;
          $sbfound = 1;
        } elsif ($optchk) {
          if ($inwords[0] =~ /options/) {
            print NEWMODCONF $line;
          }
          $optchk = 0;
        }
      }
    }
  }
  close (SYSMODCONF);
  close (NEWMODCONF);
}

# Configuration of the vmxnet tools network device
sub write_module_config {
  # Save the files we have to change.
  my $modules_file = file_name_exist('/etc/conf.modules') ?
                     '/etc/conf.modules' : '/etc/modules.conf';
  #
  # We should use the pcnet32 driver, if it is available, otherwise
  # use the lance network driver.  If lspci shows
  # a vmxnet device, use the vmxnet driver.
  #
  my $modules_src_file = db_get_answer('LIBDIR')
                         . '/configurator/conf.modules.vm';

  my $drivers = direct_command('LANG=C ' . shell_string($gHelper{'modprobe'})
                               . ' -l -t net');

  backup_file_to_restore($modules_file, 'MODULES_CONF');

  if ((system('LANG=C ' . shell_string($gHelper{'lspci'}) . ' -n | '
              . shell_string($gHelper{'grep'}) . ' -q 15ad:0720') / 256) == 0) {
    configure_module('vmxnet');
    $modules_src_file = db_get_answer('LIBDIR')
                        . '/configurator/conf.modules.vmxnet';
  } elsif ($drivers =~ /pcnet32/) {
    $modules_src_file = db_get_answer('LIBDIR')
                        . '/configurator/conf.modules.vm';
  } elsif ($drivers =~ /lance/) {
    $modules_src_file = db_get_answer('LIBDIR')
                        . '/configurator/conf.modules.vm_lance';
  }

  # Replace the conf.modules with the one we chose.
  my %p;
  undef %p;
  internal_sed($modules_src_file, $modules_file, 0, \%p);

  configure_modules_dot_conf($modules_file, $modules_file . $cBackupExtension);
}

sub xserver_bin {
  return '/usr/X11R6/bin';
}

sub xserver4 {
  return xserver_bin() . '/XFree86';
}

sub xserver3 {
  return xserver_bin() . '/XF86_VMware';
}

sub xconfig_file_abs_path {
  my $xconfig_path = shift;
  my $xconfig_file_name = shift;
  return $xconfig_path . '/' . $xconfig_file_name;
}

#
# path_compare(dir, path1, path2)
#
# Compare the two paths, and return true if they are identical
# Evaluate the paths with respect to the passed in directory
#
sub path_compare {
  my ($dir, $path1, $path2) = @_;

  # Prepend directory for relative paths
  $path1 =~ s|^([^/])|$dir/$1|;
  $path2 =~ s|^([^/])|$dir/$1|;

  # Squash out ..'s in paths
  while ($path1 =~ /\/.*\/\.\.\//) {
    $path1 =~ s|/[^/]*/\.\./|/|;
  }

  while ($path2 =~ /\/.*\/\.\.\//) {
    $path2 =~ s|/[^/]*/\.\./|/|;
  }

  # Squash out .'s in paths
  while ($path1 =~ /\/\.\//) {
    $path1 =~ s|/\./|/|;
  }

  while ($path2 =~ /\/\.\//) {
    $path2 =~ s|/\./|/|;
  }

  # Squash out //'s in paths
  while ($path1 =~ /\/\//) {
    $path1 =~ s|//|/|;
  }

  while ($path2 =~ /\/\//) {
    $path2 =~ s|//|/|;
  }

  if ($path1 eq $path2) {
    return 'yes';
  } else {
    return 'no';
  }
}

# check_link 
# Checks that a given link is pointing to the given file.
sub check_link {
  my $file = shift;
  my $link = shift;
  my $linkDest;
  my $dirname;
  $linkDest = readlink($link);
  if (!defined $linkDest) {
    return 'no';
  }
  $dirname = internal_dirname($link);
  return path_compare($dirname, $linkDest, $file);
}

# Install one symbolic link
sub install_symlink {
  my $to = shift;
  my $name = shift;

  uninstall_file($name);
  if (file_check_exist($name)) {
    return;
  }
  # The file could be a symlink to another location.  Remove it
  unlink($name);
  if (not symlink($to, $name)) {
    error('Unable to create symbolic link "' . $name . '" pointing to file "'
          . $to . '".' . "\n\n");
  }
  db_add_file($name, 0);
}

my $gLinkCount = 0;
sub symlink_if_needed {
  my $file = shift;
  my $link = shift;
  if (file_name_exist($file)) {
    if (-l $link && check_link($file, $link) eq 'yes') {
      return;
    }
    $gLinkCount = $gLinkCount + 1;
    backup_file_to_restore($link, 'LINK_' . $gLinkCount);
    install_symlink($file, $link);
  }
}

sub set_uid_X_server {
  my $x_server_file = shift;
  if (!-u $x_server_file) {
    safe_chmod(04711, $x_server_file);
  }
}

sub fix_X_link {
  my $x_version = shift;
  my $x_server_link;
  my $x_server_link_bin = xserver_bin() . '/X';
  my $x_wrapper_file_name = 'Xwrapper';
  my $x_wrapper_file = xserver_bin() . '/' . $x_wrapper_file_name;
  my $x_server_file = $x_version == 3 ? xserver3(): xserver4();
  my $x_server_file_name = internal_basename($x_server_file);

  # Case 1:
  # In this case, the Xwrapper is used if /etc/X11/X exists (could be broken)
  # _and_ /usr/X11R6/bin/X points to Xwrapper.
  # In this case, the Xwrapper will execute setuid anything /etc/X11/X
  # is pointing to. So /etc/X11/X has to be pointing to the correct X
  # server, this is XFree86 if XFree 4 is used, our driver if XFree 3 is ueed.
  # WARNING: In this case, someone could very easily create a link /etc/X11/X
  # pointing to the Xwrapper, which, of course creates and infinite loop.
  # On SuSE, this mechanism is completely broken because Xwrapper tries to run
  # /usr/X11R6/bin/X !
  # In general, The wrapper is stupid.
  $x_server_link = '/etc/X11/X';
  if (-l $x_server_link &&
      check_link($x_wrapper_file, $x_server_link_bin) eq 'yes') {
    symlink_if_needed($x_server_file, $x_server_link);
    set_uid_X_server($x_server_file);
    return;
  }

  # Case 2:
  # This case is often encountered on a SuSE system.
  # Where /var/X11R6/bin/X is a little like /etc/X11/X but the Xwrapper is
  # never used on a SuSE system, of course, there could be special cases.
  # We might be tempted to zap the use of this var place
  # but startx checks for X link and refuses to start if not present in var.
  # Of course, it doesn't check where it points to :-)
  $x_server_link = '/var/X11R6/bin/X';
  if (-d internal_dirname($x_server_link)) {
    symlink_if_needed($x_server_file, $x_server_link);
    symlink_if_needed($x_server_link, $x_server_link_bin);
    set_uid_X_server($x_server_file);
    return;
  }

  # Case 3:
  # All the remaining cases, where the /usr/X11R6/bin/X bin link should be 
  # pointing to a setuid root X server.
  $x_server_link = '/usr/X11R6/bin/X';
  symlink_if_needed($x_server_file, $x_server_link_bin);
  set_uid_X_server($x_server_file);
}

sub xfree_4 {
  my $xconfig_path = '/etc/X11';
  my $xconfig_file_name = 'XF86Config-4';
  my $xversion = '';
  my $xversionAll = '';
  my $X4DriverFile = '/usr/X11R6/lib/modules/drivers/vmware_drv.o';
  my $xserver_link = '';

  $xversionAll = direct_command(shell_string(xserver4()) . ' -version 2>&1') =~
    /XFree86 Version (\d+\.\d+\.?\d*)/ ? $1: '4';
  $xversion = '4';

  # This search order is issued from the XF86Config man page.
  if (defined $ENV{'XF86CONFIG'} && file_name_exist($xconfig_path . '/' .
      $ENV{'XF86CONFIG'})) {
    $xconfig_file_name = $ENV{'XF86CONFIG'};
  } elsif (defined $ENV{'XF86CONFIG'} &&
           file_name_exist('/usr/X11R6/etc/X11/' . $ENV{'XF86CONFIG'})) {
    $xconfig_path = '/usr/X11R6/etc/X11';
    $xconfig_file_name = $ENV{'XF86CONFIG'};
  } elsif (file_name_exist($xconfig_path . '/XF86Config-4')) {
    $xconfig_file_name = 'XF86Config-4';
  } elsif (file_name_exist($xconfig_path . '/XF86Config')) {
    # In this case, we are in the situation of having a mix between
    # XFree 3 and XFree 4, which is usually the case on RH 7.x and
    # Mandrake 7.x systems. As far as the syntax is concerned, XF86Config 
    # is the 3.x version and XF86Config-4 is the 4.x version. 
    # fix_X_conf patches some of the fields of the old config file into the new
    # one. There are issues if 3.x syntax fields are patched in a 4.x config
    # file. By providing a non existing file fix_X_conf will generate a correct
    # one.
    # See bug 23196.
    # --Jeremy Bar
    $xconfig_file_name = 'XF86Config-4';
  } elsif (file_name_exist('/etc/XF86Config')) {
    $xconfig_path = '/etc';
    $xconfig_file_name = 'XF86Config';
  } elsif (file_name_exist('/usr/X11R6/etc/X11/XF86Config-4')) {
    $xconfig_path = '/usr/X11R6/etc/X11';
    $xconfig_file_name = 'XF86Config-4';
  } elsif (file_name_exist('/usr/X11R6/etc/X11/XF86Config')) {
    $xconfig_path = '/usr/X11R6/etc/X11';
    $xconfig_file_name = 'XF86Config';
  }

  print wrap("\n\n" . 'Detected XFree86 version ' . $xversionAll . '.'
             . "\n\n", 0);

  # If there is an existing driver, replace it by ours.
  backup_file_to_restore($X4DriverFile, 'OLD_X4_DRV');

  if ($xversionAll =~ /(\d+)\.(\d+)\.?(\d*)/) {
    my $major = $1;
    my $minor = $2;
    my $sub = defined($3) ? $3: '0';
    if ($major == 4 && $minor == 2) {
      # For XFree 4.2.x, we need to replace xaa and shadowfb
      my $xaaDrv = '/usr/X11R6/lib/modules/libxaa.a';
      my $shadowFbDrv = '/usr/X11R6/lib/modules/libshadowfb.a';
      backup_file_to_restore($xaaDrv, 'OLD_X4_XAA_DRV');
      backup_file_to_restore($shadowFbDrv, 'OLD_X4_SHADOW_FB_DRV');
      unlink $xaaDrv;
      unlink $shadowFbDrv;
      if (file_name_exist($X4DriverFile)) {
        unlink $X4DriverFile;
      }
      my %p;
      undef %p;
      install_file(db_get_answer('LIBDIR')
                   . '/configurator/XFree86-4/4.2.x/libxaa.a',
                   $xaaDrv, \%p, 1);
      install_file(db_get_answer('LIBDIR')
                   . '/configurator/XFree86-4/4.2.x/libshadowfb.a',
                   $shadowFbDrv, \%p, 1);
      install_file(db_get_answer('LIBDIR')
                   . '/configurator/XFree86-4/4.2.x/vmware_drv.o',
                   $X4DriverFile, \%p, 1);
    } elsif ($minor > 2 && (not file_name_exist($X4DriverFile))) {
      # In this case, all the XAA and ShadowFB changes are present
      # in the XFree Code and we only need to install the latest
      # driver.
      my %p;
      undef %p;
      install_file(db_get_answer('LIBDIR')
                   . '/configurator/XFree86-4/4.2.x/vmware_drv.o',
                   $X4DriverFile, \%p, 1);
    } elsif ($minor < 2) {
      # The default, install the X free 4 driver which works with
      # the first versions of X.
      my %p;
      undef %p;
      if (file_name_exist($X4DriverFile)) {
        unlink $X4DriverFile;
      }
      install_file(db_get_answer('LIBDIR')
                   . '/configurator/XFree86-4/4.x/vmware_drv.o',
                   $X4DriverFile, \%p, 1);
    }
    fix_X_link('4');
  } else {
    error ('Problem extracting verion of XFree 4' . "\n\n");
  }
  return ($xversion, xconfig_file_abs_path($xconfig_path, $xconfig_file_name));
}

sub xfree_3 {
  my $xconfig_path = '/etc';
  my $xconfig_file_name = 'XF86Config';
  my $xversion = '';
  my $xversionAll = '';
  my $xserver3default = xserver_bin() . '/XF86_VGA16';
  my $xserver_link = '';

  $xversionAll = file_name_exist($xserver3default) ? 
              direct_command(shell_string($xserver3default) .
                             ' -version 2>&1') =~
                             /XFree86 Version (\d+\.\d+\.?\d*)/ ? $1: '3'
                             : '3';
  $xversion = '3';

  if (file_name_exist('/etc/XF86Config')) {
    $xconfig_path = '/etc';
    $xconfig_file_name = 'XF86Config';
  } elsif (file_name_exist('/usr/X11R6/lib/X11/XF86Config') &&
           (not -l '/usr/X11R6/lib/X11/XF86Config')) {
    $xconfig_path = '/usr/X11R6/lib/X11';
    $xconfig_file_name = 'XF86Config';
  } else {
    $xconfig_path = '/etc';
    $xconfig_file_name = 'XF86Config';
  }
  print wrap("\n\n" . 'Detected XFree86 version ' . $xversionAll . '.'
             . "\n\n", 0);

  if (file_name_exist(xserver3())) {
    backup_file(xserver3());
    unlink xserver3();
  }
  my %p;
  undef %p;
  install_file(db_get_answer('LIBDIR')
               . '/configurator/XFree86-3/XF86_VMware',
               xserver3(), \%p, 1);

  fix_X_link('3');
  return ($xversion, xconfig_file_abs_path($xconfig_path, $xconfig_file_name));
}

sub fix_mouse_file {
  my $mouse_file = '/etc/sysconfig/mouse';
  #
  # If gpm supports imps2, use that as the gpm mouse driver
  # for both X & gpm. If gpm doesn't support imps2, or isn't set
  # in this mode, the mouse will be erratic when exiting X if
  # X was set to use imps2
  # 
  my $enableXImps2 = 'no';
  my $GPMBinary = internal_which('gpm');
  if (file_name_exist($GPMBinary) && file_name_exist($mouse_file)) {
    my $enableGpmImps2;

    $enableGpmImps2 =
      (system(shell_string($GPMBinary) . ' -t help | '
              . $gHelper{'grep'} . ' -q imps2')/256) == 0 ? 'yes': 'no';
    $enableXImps2 = $enableGpmImps2;
    
    if ($enableGpmImps2 eq 'yes' ) {
      backup_file_to_restore($mouse_file, 'MOUSE_CONF');
      unlink $mouse_file;
      my %p;
      undef %p;
      $p{'^MOUSETYPE=.*$'} = 'MOUSETYPE=imps2';
      $p{'^XMOUSETYPE=.*$'} = 'XMOUSETYPE=IMPS/2';
      internal_sed($mouse_file . $cBackupExtension,
                   $mouse_file, 0, \%p);
      if (!$gOption{'skipstopstart'}) {
        system(shell_string(db_get_answer('INITSCRIPTSDIR') . '/gpm')
               . ' restart');
      }
    }
  }
  return $enableXImps2;
}

# Create a list of available resolutions for the VMware virtual monitor
sub get_suitable_resolutions {
  my $xf86config = shift;
  my @list;
  my $in;
  my $identifier;

  open(XF86CONFIG, '<' . $xf86config) or 
   error('Unable to open the XFree86 configuration file "'
         . $xf86config . '" in read-mode.' . "\n\n");

  $in = 0;
  while (<XF86CONFIG>) {
    if (/^[ \t]*Section[ \t]*"Monitor"[ \t]*$/) {
      $in = 1;
      $identifier = '';
      @list = ();
    } elsif ($in) {
      if (/^[ \t]*Identifier[ \t]*"(\S+)"[ \t]*$/) {
        $identifier = $1;
      } elsif (/^[ \t]*ModeLine[ \t]*(\S+)[ \t]*(\S+)[ \t]*(\S+)[ \t]*(\S+)[ \t]*(\S+)[ \t]*(\S+)[ \t]*(\S+)[ \t]*(\S+)[ \t]*(\S+)[ \t]*(\S+)[ \t]*$/) {
        push(@list, ($1, $3, $7));
      } elsif (/^[ \t]*EndSection[ \t]*$/) {
        if ($identifier eq 'vmware') {
          last;
        }
        $in = 0;
      }
    }
  }

  close(XF86CONFIG);

  return @list;
}

# Determine the name of the maximum available resolution that can fit in the
# VMware virtual monitor
sub get_best_resolution {
  my $xf86config = shift;
  my $width = shift;
  my $height = shift;
  my @avail_modes;
  my $best_name;
  my $best_res;

  @avail_modes = get_suitable_resolutions($xf86config);

  $best_name = '';
  $best_res = -1;
  while ($#avail_modes > -1) {
    my $mode_name = shift(@avail_modes);
    my $mode_width = shift(@avail_modes);
    my $mode_height = shift(@avail_modes);

    if (($mode_width < $width)
        && ($mode_height < $height)
        && ($mode_width * $mode_height > $best_res)) {
      $best_res = $mode_width * $mode_height;
      $best_name = $mode_name;
    }
  }
  return $best_name;
}

# Sort available resolutions for the VMware virtual monitor in increasing order
sub sort_resolutions {
  my $xf86config = shift;
  my @avail_modes;
  my %resolutions;
  my $res;
  my $names;

  @avail_modes = get_suitable_resolutions($xf86config);

  undef %resolutions;
  while ($#avail_modes > -1) {
    my $mode_name = shift(@avail_modes);
    my $mode_width = shift(@avail_modes);
    my $mode_height = shift(@avail_modes);

    $resolutions{$mode_width * $mode_height} .= $mode_name . ' ';
  }
  
  $names = '';
  foreach $res (sort { $a <=> $b } keys %resolutions) {
    $names .= $resolutions{$res};
  }
  if (not ($names eq '')) {
    chomp($names);
  }
  return $names;
}

#
# Try to determine the current screen size
#
sub get_screen_mode {
  my $xversion = shift;
  my $width = 0;
  my $height = 0;

  chomp($gSystem{'resolution'});
  ($width, $height) = split(' ', $gSystem{'resolution'});

  #
  # Set mode according to current screen size, or prompt the user for a
  # choice of screen size if we can't determine it.
  #
  my $screen_mode;
  if (($width == 0) or ($height == 0)) {
    my ($i, $n, $mode, $choice, @mode_list);

    $screen_mode =
      sort_resolutions(db_get_answer('LIBDIR') . '/configurator/XFree86-'
                       . $xversion . '/XF86Config'
                       . ($xversion eq '4' ? '-4': ''));
    @mode_list = split(' ', $screen_mode);
    $n = $#mode_list + 1;

    print wrap("\n" . 'Unable to determine the display size, please choose '
               . 'one of the following display sizes (1 - ' . $n . '):' . "\n\n",
               0);
    $i = 1;
    foreach $mode (@mode_list) {
      print wrap('  [' . $i . ']  ' . $mode . "\n", 0);
      $i = $i + 1;
    }

    $gMaxNumber = $n;
    $gAnswerSize{'number'} = length($gMaxNumber);
    $choice = get_persistent_answer('Please enter a number between 1 and ' . $n
                                   . ':' . "\n\n", 'XRESNUMBER', 'number', '3');

    $screen_mode = $mode_list[$choice - 1];
  } else {
    $screen_mode =
      get_best_resolution(db_get_answer('LIBDIR') . '/configurator/XFree86-'
                          . $xversion . '/XF86Config'
								  . ($xversion eq '4' ? '-4': ''), $width, $height);
  }
  return $screen_mode;
}

#
# This function is taken from the old tools installer.
# The first argument is a complete path to a file which will be read and 
# overwritten with the result.
# The second argument will be only read and should be the system file present
# before configuration.
# The third argument is the version of XFree86
# The fourth is a boolean informing weather the Imwheel mouse is used
# in gpm or not.
#
sub fix_X_conf {
  my ($newXF86Config, $systemXF86Config, $xversion, $enableXImps2) = @_;
  my ($filessection, $kbdsection, $transcribe);
  my ($line, $copy);
  my $XFree4_scanpci = xserver_bin() . '/scanpci';
  my @inputs;

  if (not file_name_exist($systemXF86Config)) {
    my %patch;
    undef %patch;
    internal_sed('/dev/null', $systemXF86Config, 0, \%patch);
  }

  #
  # Check to see if the vmware svga driver is non-unified b/c we have to 
  # specifiy the BusId in the XF86Config-4 file in that case
  #
  my $writeBusIDLine = 0;
  if ($xversion eq '4' &&
      file_name_exist($XFree4_scanpci) &&
      (system(shell_string($XFree4_scanpci) . ' | '
              . shell_string($gHelper{'grep'}) . ' -q 0x0710')/256) == 0 ) {
     $writeBusIDLine = 1;
     # print wrap ('Found the devide 0x0710' . "\n\n", 0);
  }

  $filessection = 0;
  $kbdsection = 0;
  $transcribe = 0;

  # Capture current contents before overwriting
  if (not open(SAVEXCONF, "<$newXF86Config")) {
    error('Unable to open the file "' . $newXF86Config . '".' . "\n\n");
  }
  @inputs = readline(*SAVEXCONF);
  close(SAVEXCONF);

  if (not open(SYSXF86CONFIG, "<$systemXF86Config")) {
    error('Unable to open the file "' . $systemXF86Config . '".' . "\n\n");
  }

  if (not open(NEWXF86CONFIG, ">$newXF86Config")) {
    error('Unable to open the file "' . $newXF86Config . '".' . "\n\n");
  }

  while (defined($_ = <SYSXF86CONFIG>)) {
    $line = $_;
    if (/^\s*#/) {
      if ($transcribe == 0) {
        print NEWXF86CONFIG $line;
      }
    } else {
      if (/^\s*EndSection/) {
        if ($transcribe == 1) {
          $transcribe = 2;
        }
      } elsif (/^\s*Section/) {
        s/^\s*Section\s*\(["a-zA-Z]*\).*/$1/;
        if (/Files/) {
          $filessection = 1;
          $transcribe = 1;
        } elsif (/Keyboard/) {
          $kbdsection = 1;
          $transcribe = 1;
        }
      }
    }
    if ($transcribe == 1) {
      print NEWXF86CONFIG $line;
    } elsif ($transcribe == 2) {
      $transcribe = 3;
      print NEWXF86CONFIG $line;
    }
  }

  # Then append our sections that weren't superceded
  $transcribe = 0;
  foreach $line (@inputs) {
    # Replace %BUSID_LINE%
    if ($writeBusIDLine) {
      $line =~ s/%BUSID_LINE%/BusID \t\"PCI:0:15:0\"/g;
    } else {
      $line =~ s/%BUSID_LINE%//g;
    }

    # Replace %MOUSE_PROTOCOL%
    if ($enableXImps2 eq 'yes') {
      $line =~ s/%MOUSE_PROTOCOL%/IMPS\/2/g;
    } else {
      $line =~ s/%MOUSE_PROTOCOL%/ps\/2/g;
    }

    $copy = $line;
    if (not ($copy =~ /^\s*#/)) {
      if ($copy =~ /^\s*EndSection/) {
        if ($transcribe == 1) {
          $transcribe = 2;
        }
      } elsif ($copy =~ /^\s*Section/) {
        $copy =~ s/^\s*Section\s*\(["a-zA-Z]*\).*/$1/;
        if ($copy =~ /Files/) {
          if ($filessection) {
            $transcribe = 1;
          }
        } elsif ($copy =~ /Keyboard/) {
          if ($kbdsection) {
            $transcribe = 1;
          }
        }
      }
    }

    if (($transcribe != 1) and ($transcribe != 2)) {
      print NEWXF86CONFIG $line;
    }

    if ($transcribe == 2) {
      $transcribe = 3;
    }
  }
  close (SYSXF86CONFIG);
  close (NEWXF86CONFIG);
}

sub configure_X {
  my $xversion = '';
  my $xconfig_file = '';
  my $enableXImps2 = '';
  my $screen_mode = '';

  if (file_name_exist(xserver4())) {
    ($xversion, $xconfig_file) = xfree_4();
  } elsif (file_name_exist(xserver_bin() . '/xterm')) {
    ($xversion, $xconfig_file) = xfree_3();
  } else {
     print wrap ('No XFree86 install found.' . "\n\n", 0);
     return;
  }

  $enableXImps2 = fix_mouse_file();
  $screen_mode = get_screen_mode($xversion);

  backup_file_to_restore($xconfig_file, 'XCONFIG_FILE');

  my %p;
  undef %p;
  $p{'%SCREEN_MODE%'} = $screen_mode;
  internal_sed(db_get_answer('LIBDIR') . '/configurator/XFree86-'
               . $xversion . '/XF86Config' . ($xversion eq '4' ? '-4': ''),
               $xconfig_file, 0, \%p);

  fix_X_conf($xconfig_file, $xconfig_file . $cBackupExtension,
             $xversion, $enableXImps2);
}

# Configuration related to the vmkernel
sub configure_vmkernel {
  my $mod_dir;
  my $candidate;
  my $name;
  my $ver;
  my %patch;
  my $i;
  my $j;
  my $k;
  my $dev;
  my $answer;

  configure_dev('/dev/vmkmem', 10, 165, 1);
  configure_dev('/dev/vmkcnx', 10, 166, 1);

  for ($i = 0; $i < 128; $i++) {
    configure_dev('/dev/vsd' . $i, 88, $i, 0);
  }

  # Install vmnix module in /lib/modules
  $mod_dir = db_get_answer('LIBDIR') . '/modules';
  $ver = $cVmnixVersion;
  $name = "vmnixmod.o";
  undef %patch;
  create_dir('/lib/modules/' . $ver . '/misc', 0x1);
  install_file($mod_dir . '/binary/' . $ver . '/objects/' . $name,
               '/lib/modules/' . $ver . '/misc/' . $name, \%patch, 0x1);
  $name = "vmxnet_console.o";
  undef %patch;
  install_file($mod_dir . '/binary/' . $ver . '/objects/' . $name,
               '/lib/modules/' . $ver . '/misc/' . $name, \%patch, 0x1);

  # Restore vm-list and hwconfig if they were saved
  # by a previous installation during an upgrade.
  if (defined($gDBAnswer{'VSS_VM_LIST'})
      && (-e $gDBAnswer{'VSS_VM_LIST'})) {
    undef %patch;
    install_file($gDBAnswer{'VSS_VM_LIST'}, $gRegistryDir . '/vm-list',
                 \%patch, 0);
    db_remove_answer('VSS_VM_LIST');
  }
  else {
    db_add_file($gRegistryDir . '/vm-list', 0);
  }

  if (defined($gDBAnswer{'VSS_HWCONF_SAV'})
      && (-e $gDBAnswer{'VSS_HWCONF_SAV'})) {
    if (!file_name_exist($gRegistryDir .'/hwconfig')) {
      undef %patch;
      install_file($gDBAnswer{'VSS_HWCONF_SAV'}, $gRegistryDir . '/hwconfig',
                   \%patch, 0);
    } else {
      db_add_file($gRegistryDir . '/hwconfig', 0);
    }
    db_remove_answer('VSS_HWCONF_SAV');
  }
  else {
    db_add_file($gRegistryDir . '/hwconfig', 0);
  }

  $answer = get_persistent_answer('Do you want to automatically start up '
                                  . vmware_product_name() . ' now and on each '
                                  . 'bootup?', 'STARTUP_SERVER', 'yesno',
                                  'yes');
}

# Configuration of bridged networking
sub configure_bridged_net {
  my $vHubNr = shift;
  my $vHostIf = shift;
  my $answer;

  if ($vHubNr < $gMinVmnet || $vHubNr > $gMaxVmnet) {
    print wrap('Number of virtual networks exceeded.  Not creating virtual '
               . 'network.' . "\n\n", 0);
    return;
  }

  # If this wasn't a bridged network before, wipe out the old configuration
  # info as it may confuse us later.
  if (!is_bridged_network($vHubNr)) {
    remove_net($vHubNr, $vHostIf);
  }

  print wrap('Configuring a bridged network for vmnet' . $vHubNr . '.'
             . "\n\n", 0);

  if (count_all_networks() == 0 && $#gAllEthIf == -1) {
    # No interface.  We provide a valid default so that everything works.
    make_bridged_net($vHubNr, $vHostIf, "eth0");
    return;
  }

  if ($#gAvailEthIf == 0) {
    # Only one interface.  Use it.  This gives no choice even when the editor
    # is being used.
    make_bridged_net($vHubNr, $vHostIf,  $gAvailEthIf[0]);
    return;
  }

  if ($#gAvailEthIf == -1) {
    # We have other interfaces, but they have all been allocated.
    if (get_answer('All your ethernet interfaces are already bridged.  Are '
                   . 'you sure you want to configure a bridged ethernet '
                   . 'interface for vmnet' . $vHubNr . '? (yes/no)',
                   'yesno', 'no') eq 'no') {
      print wrap('Not changing network settings for vmnet' . $vHubNr . '.'
                 . "\n\n", 0);
      return;
    }
    $answer = get_persistent_answer('Your computer has the following ethernet '
                                    . 'devices: ' . join(', ', @gAllEthIf)
                                    . '. Which one do you want to bridge to '
                                    . 'vmnet' . $vHubNr . '?',
                                    'VNET_' . $vHubNr . '_INTERFACE',
                                    'anyethif', 'eth0');
    make_bridged_net($vHubNr, $vHostIf, $answer);
    return;
  }

  my $queryString = 'Your computer has multiple ethernet network interfaces '
                    . 'available: ' . join(', ', @gAvailEthIf) . '. Which one '
                    . 'do you want to bridge to vmnet' . $vHubNr . '?';
  $answer = get_persistent_answer($queryString,
                                  'VNET_' . $vHubNr . '_INTERFACE',
                                  'availethif', 'eth0');
  make_bridged_net($vHubNr, $vHostIf, $answer);
}

# Creates a bridged network.
sub make_bridged_net {
  my $vHubNr = shift;
  my $vHostIf = shift;
  my $ethIf = shift;

  db_add_answer('VNET_' . $vHubNr . '_INTERFACE', $ethIf);
  configure_dev('/dev/' . $vHostIf, 119, $vHubNr, 1);

  # Reload the list of available ethernet adapters
  load_ethif_info();
}

# Probe for an unused private subnet
# Return value is (status, subnet, netmask).
#  status is 1 on success (subnet and netmask are set),
#  status is 0 on failure.
sub subnet_probe {
  my $vHubNr = shift;
  my $vHostIf = shift;
  # Ref to an array of used subnets
  my $usedSubnets = shift;
  my $i;
  my @subnets;
  my $tries;
  my $maxTries = 100;
  my $pings;
  my $maxPings = 10;
  # XXX We only consider class C subnets for the moment
  my $netmask = '255.255.255.0';
  my %used_subnets;

  # Generate the table of private class C subnets
  @subnets = ();
  for ($i = 0; $i < 255; $i++) {
    $subnets[2 * $i    ] = '192.168.' . $i . '.0';
    $subnets[2 * $i + 1] = '172.16.'  . $i . '.0';
  }

  # Generate a list of used subnets and clear out the ones that have already
  # been used
  foreach $i (@$usedSubnets) {
    $used_subnets{$i} = 1;
  }
  for ($i = 0; $i < $#subnets + 1; $i++) {
    if ($used_subnets{$subnets[$i]}) {
      $subnets[$i] = '';
    }
  }

  print wrap('Probing for an unused private subnet (this can take some '
             . 'time)...' . "\n\n", 0);
  $tries = 0;
  $pings = 0;
  srand(time);
  # Beware, 'last' doesn't seem to work in 'do'-'while' loops
  for (;;) {
    my $r;
    my $subnet;
    my $status;

    $tries++;

    $r = int(rand($#subnets + 1));
    if ($subnets[$r] eq '') {
      # Already tried
      if ($tries == $maxTries) {
        print STDERR wrap('We were unable to locate an unused Class C subnet '
                          . 'in the range of private network numbers.  For '
                          . 'each subnet that we tried we received a response '
                          . 'to our ICMP ping packets from a ' . $machine
                          . ' at the network address intended for assignment '
                          . 'to this machine.  Because no private subnet '
                          . 'appears to be unused you will need to explicitly '
                          . 'specify a network number by hand.' . "\n\n", 0);
        return (0, undef, undef);
      }
      next;
    }
    $subnet = $subnets[$r];
    $subnets[$r] = '';

    # Our convention is that the host OS IP address is <subnet>.1
    $status = system(shell_string(db_get_answer('BINDIR') . '/vmware-ping')
                     . ' -q '
                     . shell_string(int_to_quaddot(quaddot_to_int($subnet)
                                                   + 1))) >> 8;

    if ($status == 3) {
      print STDERR wrap('We were unable to locate an unused Class C subnet in '
                        . 'the range of private network numbers.  You will '
                        . 'need to explicitly specify a network number by '
                        . 'hand.' . "\n\n", 0);
      return (0, undef, undef);
    }

    if ($status == 2) {
      print STDERR wrap('Either your ' . $machine . ' is not connected to an '
                        . 'IP network, or its network configuration does not '
                        . 'specify a default IP route.  Consequently, the '
                        . 'subnet ' . $subnet . '/' . $netmask . ' appears to '
                        . 'be unused.' . "\n\n", 0);
      return (1, $subnet, $netmask);
    }

    if ($status == 1) {
      print wrap('The subnet ' . $subnet . '/' . $netmask . ' appears to be '
                 . 'unused.' . "\n\n", 0);
      return (1, $subnet, $netmask);
    }

    $pings++;
    if (($pings == $maxPings) || ($tries == $maxTries)) {
      print STDERR wrap('We were unable to locate an unused Class C subnet in '
                        . 'the range of private network numbers.  For each '
                        . 'subnet that we tried we received a response to our '
                        . 'ICMP ping packets from a ' . $machine . ' at the '
                        . 'network address intended for assignment to this '
                        . 'machine.  Because no private subnet appears to be '
                        . 'unused you will need to explicitly specify a '
                        . 'network number by hand.' . "\n\n", 0);
      return (0, undef, undef);
    }
  }
}

# Display the DHCP copyright information
sub show_ISC {
  if (not defined($gDBAnswer{'ISC_COPYRIGHT_SEEN'})) {
    query('The version of DHCP used in this version of '
          . vmware_product_name() . ' is licensed as described in the "'
          . db_get_answer('DOCDIR') . '/DHCP-COPYRIGHT" file.' . "\n\n"
          . 'Hit enter to continue.', '', 0);

    db_add_answer('ISC_COPYRIGHT_SEEN', 'yes');
  }
}

# Converts an quad-dotted IPv4 address into a integer
sub quaddot_to_int {
  my $quaddot = shift;
  my @quaddot_a;
  my $int;
  my $i;

  @quaddot_a = split(/\./, $quaddot);
  $int = 0;
  for ($i = 0; $i < 4; $i++) {
    $int <<= 8;
    $int |= $quaddot_a[$i];
  }

  return $int;
}

# Converts an integer into a quad-dotted IPv4 address
sub int_to_quaddot {
  my $int = shift;
  my @quaddot_a;
  my $i;

  for ($i = 3; $i >= 0; $i--) {
    $quaddot_a[$i] = $int & 0xFF;
    $int >>= 8;
  }

  return join('.', @quaddot_a);
}

# Compute the subnet address associated to a couple IP/netmask
sub compute_subnet {
  my $ip = shift;
  my $netmask = shift;

  return int_to_quaddot(quaddot_to_int($ip) & quaddot_to_int($netmask));
}

# Compute the broadcast address associated to a couple IP/netmask
sub compute_broadcast {
  my $ip = shift;
  my $netmask = shift;

  return   int_to_quaddot(quaddot_to_int($ip)
         | (0xFFFFFFFF - quaddot_to_int($netmask)));
}

# Makes the patch hash that is used to replace the options in the dhcpd config
# file.
# These DHCP options are needed for the hostonly network.
sub make_dhcpd_patch {
  my $vHubNr = shift;
  my $vHostIf = shift;
  my %patch;

  undef %patch;
  $patch{'%vmnet%'} = $vHostIf;
  $patch{'%hostaddr%'} = db_get_answer('VNET_' . $vHubNr
                                       . '_HOSTONLY_HOSTADDR');
  $patch{'%netmask%'} = db_get_answer('VNET_' . $vHubNr . '_HOSTONLY_NETMASK');
  $patch{'%network%'} = compute_subnet($patch{'%hostaddr%'},
                                       $patch{'%netmask%'});
  $patch{'%broadcast%'} = compute_broadcast($patch{'%hostaddr%'},
                                            $patch{'%netmask%'});
  # Median address in this subnet
  $patch{'%range_low%'} = int_to_quaddot(
    (quaddot_to_int($patch{'%network%'})
     + quaddot_to_int($patch{'%broadcast%'}) + 1) / 2);
  # Last normal address in this subnet
  $patch{'%range_high%'} = int_to_quaddot(
    quaddot_to_int($patch{'%broadcast%'}) - 1);
  $patch{'%router_option%'} = "";
  return %patch;
}

# Write VMware's DHCPd configuration files
sub write_dhcpd_config {
  my $vHubNr = shift;
  my $vHostIf = shift;
  # Function that makes the patch needed for the DHCP config file
  my $make_patch_func = shift;
  my $dhcpd_dir;
  my %patch;

  %patch = &$make_patch_func($vHubNr, $vHostIf);

  # Create the dhcpd config directory (one per virtual interface)
  $dhcpd_dir = $gRegistryDir . '/' . $vHostIf . '/dhcpd';
  create_dir($dhcpd_dir, 0x1);

  install_file(db_get_answer('LIBDIR') . '/configurator/vmnet-dhcpd.conf',
               $dhcpd_dir . '/dhcpd.conf', \%patch, 0x1);

  # Create empty files that will be created by the daemon
  # They will be modified by the daemon, don't timestamp them
  undef %patch;
  install_file('/dev/null', $dhcpd_dir . '/dhcpd.leases', \%patch, 0);
  safe_chmod(0644, $dhcpd_dir . '/dhcpd.leases');
  undef %patch;
  install_file('/dev/null', $dhcpd_dir . '/dhcpd.leases~', \%patch, 0);
  safe_chmod(0644, $dhcpd_dir . '/dhcpd.leases~');
}

# Check the normal dhcp configuration and give advises
sub dhcpd_consultant {
  my $vHubNr = shift;
  my $vHostIf = shift;
  my $conf;
  my $network;
  my $netmask;

  if (-r '/etc/dhcpd.conf') {
    $conf = '/etc/dhcpd.conf';
  } else {
    return;
  }

  $netmask = db_get_answer('VNET_' . $vHubNr . '_HOSTONLY_NETMASK');
  $network = compute_subnet(db_get_answer('VNET_' . $vHubNr
                                          . '_HOSTONLY_HOSTADDR'), $netmask);

  # The host has a normal dhcpd setup
  if (direct_command(
    shell_string($gHelper{'grep'}) . ' '
    . shell_string('^[ ' . "\t" . ']*subnet[ ' . "\t" . ']*' . $network) . ' '
    . shell_string($conf)) eq '') {
    query('This system appears to have a DHCP server configured for normal '
          . 'use.  Beware that you should teach it how not to interfere with '
          . vmware_product_name() . '\'s DHCP server.  There are two ways to '
          . 'do this:' . "\n\n" . '1) Modify the file ' . $conf . ' to add '
          . 'something like:' . "\n\n" . 'subnet ' . $network . ' netmask '
          . $netmask . ' {' . "\n" . '    # Note: No range is given, '
          . 'vmnet-dhcpd will deal with this subnet.' . "\n" . '}' . "\n\n"
          . '2) Start your DHCP server with an explicit list of network '
          . 'interfaces to deal with (leaving out ' . $vHostIf . '). e.g.:'
          . "\n\n" . 'dhcpd eth0' . "\n\n" . 'Consult the dhcpd(8) and '
          . 'dhcpd.conf(5) manual pages for details.' . "\n\n"
          . 'Hit enter to continue.', '', 0);
  }
}

# Write the VMware samba host-wide configuration file
sub write_smb_config {
  my $vHubNr = shift;
  my $vHostIf = shift;
  my $smb_dir;
  my %patch;
  my $smb_file;
  my @smb_files = ('var/locks/STATUS..LCK',
                   'var/locks/browse.dat');

  if (!is_samba_running($vHubNr)) {
    return;
  }

  # Create the smb config directories (one per virtual interface)
  $smb_dir = $gRegistryDir . '/' . $vHostIf . '/smb';
  create_dir($smb_dir . '/private', 0x1);
  create_dir($smb_dir . '/var/locks', 0x1);

  undef %patch;
  $patch{'%vmnet%'} = $vHostIf;
  $patch{'%hostaddr%'} = db_get_answer('VNET_' . $vHubNr
                                       . '_HOSTONLY_HOSTADDR');
  $patch{'%netmask%'} = db_get_answer('VNET_' . $vHubNr . '_HOSTONLY_NETMASK');
  $patch{'%network%'} = compute_subnet($patch{'%hostaddr%'},
                                       $patch{'%netmask%'});
  $patch{'%vardir%'} = $smb_dir . '/var';
  $patch{'%privatedir%'} = $smb_dir . '/private';
  $patch{'%libdir%'} = db_get_answer('LIBDIR') . '/smb';
  install_file(db_get_answer('LIBDIR') . '/configurator/vmnet-smb.conf',
               $smb_dir . '/smb.conf', \%patch, 0x1);

  # Create empty files that will be created by the daemon
  # They will be modified by the daemon, don't timestamp them
  foreach $smb_file (@smb_files) {
    undef %patch;
    install_file('/dev/null', $smb_dir . '/' . $smb_file, \%patch, 0);
    safe_chmod(0644, $smb_dir . '/' . $smb_file);
  }

  my $samba_sid = $gDBAnswer{'VNET_' . $vHubNr . '_SAMBA_MACHINESID'};
  my $samba_passwd = $gDBAnswer{'VNET_' . $vHubNr . '_SAMBA_SMBPASSWD'};

  if (   defined($samba_sid) && (-e $samba_sid)
      && defined($samba_passwd) && (-e $samba_passwd)) {
    # The previous installer saved a valid SMB state.  Restore it.
    undef %patch;
    install_file($samba_sid, $smb_dir . '/private/MACHINE.SID', \%patch, 0);
    db_remove_answer('VNET_' . $vHubNr . '_SAMBA_MACHINESID');
    undef %patch;
    install_file($samba_passwd, $smb_dir . '/private/smbpasswd', \%patch, 0);
    db_remove_answer('VNET_' . $vHubNr . '_SAMBA_SMBPASSWD');
  }

  if (not (   (-e $smb_dir . '/private/MACHINE.SID')
           && (-e $smb_dir . '/private/smbpasswd'))) {
    # There is no valid SMB state.  Create a new valid one.
    undef %patch;
    install_file('/dev/null', $smb_dir . '/private/MACHINE.SID', \%patch, 0);
    undef %patch;
    install_file('/dev/null', $smb_dir . '/private/smbpasswd', \%patch, 0);
  }

  # Set the permissions of the SMB state
  safe_chmod(0644, $smb_dir . '/private/MACHINE.SID');
  safe_chmod(0600, $smb_dir . '/private/smbpasswd');
}

# Generate an interfaces specification for a samba configuration file
sub samba_make_interfaces {
  my $if;
  my $result;
  my $sep;

  # We assume that ifconfig without any command option only display interfaces
  # that are up.
  open(IFCONFIG, shell_string($gHelper{'ifconfig'}) . ' |');
  # XXX I did my best, but this is probably still locale-dependant --hpreg
  $result = '';
  $sep = '';
  while (<IFCONFIG>) {
    if (/^[a-zA-Z]/) {
      my @fields;

      @fields = split(/[ ]+/);
      $if = $fields[0];
    } elsif (/[iI]net/) {
      if (/^[ ]+.*:(\S+)[ ]+.*:(\S+)[ ]+.*:(\S+)/) {
        if (not ($if eq 'lo')) {
          $result .= $sep . $1 . '/' . $3;
          $sep = ' ';
        }
      }
    }
  }

  return $result;
}

# Check the samba configuration and give advises
sub samba_consultant {
  my $vHubNr = shift;
  my $vHostIf = shift;
  my $conf;
  my $prefix;
  my $netmask;
  my $hostaddr;
  my $samba_uid;
  my $samba_ifaddr;

  if (-r '/etc/smb.conf') {
    $conf = '/etc/smb.conf';
  } elsif (-r '/etc/samba/smb.conf') {
    $conf = '/etc/samba/smb.conf';
  } else {
    return;
  }

  $hostaddr = db_get_answer('VNET_' . $vHubNr . '_HOSTONLY_HOSTADDR');
  $netmask = db_get_answer('VNET_' . $vHubNr . '_HOSTONLY_NETMASK');
  # XXX This should be computed based on the netmask instead of assuming a
  # class C in case the user has submitted these values
  ($prefix = $hostaddr) =~ s/\.[0-9]+$//;

  # The host has a samba setup
  # XXX $prefix should be grep-escaped (it contains dots...)
  $samba_ifaddr = direct_command(
    shell_string($gHelper{'grep'}) . ' '
    . shell_string('^[ ' . "\t" . ']*interfaces[ ' . "\t" . ']*=.*' . $prefix)
    . ' ' . shell_string($conf));

  if (count_samba_networks() > 0) {
    query('This system appears to have a CIFS/SMB server (Samba) configured '
          . 'for normal use.  If this server is intended to run, you need to '
          . 'make sure that it will not conflict with the Samba server setup '
          . 'on the private network (the one that we use to share the ' . $os
          . '\'s filesystem).  Please check your ' . $conf . ' file so that:'
          . "\n\n" . '.  The "interfaces" line does not contain "' . $hostaddr
          . '/' . $netmask . '"' . "\n" . '.  There is a "socket address" '
          . 'line that contains only your real host IP address' . "\n\n"
          . 'Hit enter to continue.', '', 0);
  } else {
    if ($samba_ifaddr eq '') {
      query('This system appears to have a CIFS/SMB server (Samba) configured '
            . 'for normal use.  Note that if you want to offer service to '
            . 'virtual machines running on the host-only network, you must '
            . 'modify your ' . $conf . ' file to list the networks Samba '
            . 'should deal with.  You can do this by adding a line looking '
            . 'like this one:' . "\n\n" . 'interfaces = '
            . samba_make_interfaces() . ' ' . $hostaddr . '/' . $netmask
            . "\n\n" . 'You may also need to update any related security '
            . 'controls you might have setup such as the "hosts allow" '
            . 'specification.' . "\n\n" . 'Consult the smb.conf(5) manual '
            . 'page for more details.' . "\n\n"
            . 'Hit enter to continue.', '', 0);
    }
  }
}

# Configuration of hostonly networking
sub configure_hostonly_net {
  my $vHubNr = shift;
  my $vHostIf = shift;
  my $run_dhcpd = shift;
  my $run_samba = shift;
  my $hostaddr;
  my $subnet;
  my $netmask;
  my $status;

  if ($vHubNr < $gMinVmnet || $vHubNr > $gMaxVmnet) {
    print wrap('Number of virtual networks exceeded.  Not creating virtual '
               . 'network.' . "\n\n", 0);
    return;
  }

  # If this wasn't a hostonly network before, wipe out the old configuration
  # info as it may confuse us later.
  if (!is_hostonly_network($vHubNr)) {
    remove_net($vHubNr, $vHostIf);
  }

  print wrap('Configuring a host-only network for vmnet' . $vHubNr . '.'
             . "\n\n", 0);

  my $keep_settings;

  $keep_settings = 'no';
  $hostaddr = $gDBAnswer{'VNET_' . $vHubNr . '_HOSTONLY_HOSTADDR'};
  $netmask = $gDBAnswer{'VNET_' . $vHubNr . '_HOSTONLY_NETMASK'};

  if (defined($hostaddr) && defined($netmask)) {
    $subnet = compute_subnet($hostaddr, $netmask);
    $keep_settings = get_answer('The host-only network is currently '
                                . 'configured to use the private subnet '
                                . $subnet . '/' . $netmask . '.  Do you want '
                                . 'to keep these settings?', 'yesno', 'yes');
  }

  if ($keep_settings eq 'no') {
    # Get the new settings
    for (;;) {
      my $answer;

      $answer = get_answer('Do you want this program to probe for an unused '
                           . 'private subnet? (yes/no/help)',
                           'yesnohelp', 'yes');

      if ($answer eq 'yes') {
        my @usedSubnets = get_used_subnets();
        ($status, $subnet, $netmask) = subnet_probe($vHubNr, $vHostIf,
                                                    \@usedSubnets);
        if ($status) {
          last;
        }
        # Fallback
        $answer = 'no';
      }

      if ($answer eq 'no') {
        $hostaddr = get_persistent_answer('What will be the IP address of '
                                          . 'your ' . $machine . ' on the '
                                          . 'private network?',
                                          'VNET_' . $vHubNr
                                          . '_HOSTONLY_HOSTADDR', 'ip', '');
        $netmask = get_persistent_answer('What will be the netmask of your '
                                         . 'private network?',
                                         'VNET_' . $vHubNr
                                         . '_HOSTONLY_NETMASK', 'ip', '');
        $subnet = compute_subnet($hostaddr, $netmask);
        last;
      }

      print wrap('Virtual machines configured to use host-only networking are '
                 . 'placed on a virtual network that is confined to this '
                 . $machine . '.  Virtual machines on this network can '
                 . 'communicate with each other and the ' . $os . ', but no '
                 . 'one else.' . "\n\n" . 'To setup this host-only networking '
                 . 'you need to select a network number that is normally '
                 . 'unreachable from the ' . $machine . '.  We can '
                 . 'automatically select this number for you, or you can '
                 . 'specify a network number that you want.' . "\n\n" . 'The '
                 . 'automatic selection process works by testing a series of '
                 . 'Class C subnet numbers to see if they are reachable from '
                 . 'the ' . $machine . '.  The first one that is unreachable '
                 . 'is used.  The subnet numbers are chosen from the private '
                 . 'network numbers specified by the Internet Engineering '
                 . 'Task Force (IETF) in RFC 1918 (http://www.isi.edu/in-notes'
                 . '/rfc1918.txt).' . "\n\n" . 'Remember that the host-only '
                 . 'network that virtual machines reside on will not be '
                 . 'accessible outside the host machine.  This means that it '
                 . 'is OK to use the same number on different systems so long '
                 . 'as you do not enable communication between these networks.'
                 . "\n\n", 0);
    }
  }

  make_hostonly_net($vHubNr, $vHostIf, $subnet, $netmask, $run_dhcpd,
                    $run_samba);

  if ($run_dhcpd) {
    show_ISC();
    dhcpd_consultant($vHubNr, $vHostIf);
  }
}

# Creates a hostonly network
sub make_hostonly_net {
  my $vHubNr = shift;
  my $vHostIf = shift;
  my $subnet = shift;
  my $netmask = shift;
  my $run_dhcpd = shift;
  my $run_samba = shift;

  my $hostaddr = int_to_quaddot(quaddot_to_int($subnet) + 1);

  configure_dev('/dev/' . $vHostIf, 119, $vHubNr, 1);

  db_add_answer('VNET_' . $vHubNr . '_HOSTONLY_HOSTADDR', $hostaddr);
  db_add_answer('VNET_' . $vHubNr . '_HOSTONLY_NETMASK', $netmask);

  if ($run_dhcpd) {
    write_dhcpd_config($vHubNr, $vHostIf, \&make_dhcpd_patch);
  } else {
    # XXX NOT IMPLEMENTED
  }

  if ($run_samba) {
    make_samba_net($vHubNr, $vHostIf);
  } else {
    unmake_samba_net($vHubNr, $vHostIf);
  }
}

# Get the list of subnets used by all the hostonly networks
sub get_hostonly_subnets {
  my $vHubNr;
  my @subnets = ();
  for ($vHubNr = $gMinVmnet; $vHubNr <= $gMaxVmnet; $vHubNr++) {
    if (is_hostonly_network($vHubNr)) {
      my $hostaddr = db_get_answer('VNET_' . $vHubNr  . '_HOSTONLY_HOSTADDR');
      my $netmask = db_get_answer('VNET_' . $vHubNr  . '_HOSTONLY_NETMASK');
      push(@subnets, compute_subnet($hostaddr, $netmask));
    }
  }
  return @subnets;
}

# Setup samba on a hostonly network
sub make_samba_net {
  my $vHubNr = shift;
  my $vHostIf = shift;
  db_add_answer('VNET_' . $vHubNr . '_SAMBA', "yes");
  write_smb_config($vHubNr, $vHostIf);
}

# Unconfigures Samba from the hostonly network
sub unmake_samba_net {
  my $vHubNr = shift;
  my $vHostIf = shift;
  my $smb_dir = $gRegistryDir . '/' . $vHostIf . '/smb';
  if (is_samba_running($vHubNr)) {
    db_remove_answer('VNET_' . $vHubNr . '_SAMBA');
    db_remove_answer('VNET_' . $vHubNr . '_SAMBA_MACHINESID');
    db_remove_answer('VNET_' . $vHubNr . '_SAMBA_SMBPASSWD');
    uninstall_prefix($smb_dir);
  }
  db_add_answer('VNET_' . $vHubNr . '_SAMBA', 'no');
}

# Gets the virtual network number where Samba is located.
sub get_samba_net {
  my $vHubNr;

  for ($vHubNr = $gMinVmnet; $vHubNr <= $gMaxVmnet; $vHubNr++) {
    if (is_samba_running($vHubNr)) {
      return $vHubNr;
    }
  }

  return -1;
}

# Check to see if the Samba question was ever asked and answered.
# Returns 1 if it has. 0 otherwise.
sub was_samba_answered {
  my $vHubNr;

  for ($vHubNr = $gMinVmnet; $vHubNr <= $gMaxVmnet; $vHubNr++) {
    if (defined($gDBAnswer{'VNET_' . $vHubNr . '_SAMBA'})) {
      return 1;
    }
  }
  return 0;
}

# Add samba usernames and passwords
sub configure_samba_users {
  my $vHubNr = shift;
  my $vHostIf = shift;
  my $passfile;

  if (!is_samba_running($vHubNr)) {
    return;
  }

  $passfile = $gRegistryDir . '/' . $vHostIf . '/smb/private/smbpasswd';

  for (;;) {
    my $answer;

    if ((-s $passfile) > 0) {
      $answer = get_answer('You have successfully configured '
                           . vmware_product_name() . ' to allow your virtual '
                           . 'machines to access the ' . $os
                           . '\'s filesystem.  Your system appears to already '
                           . 'be set up with usernames and passwords for '
                           . 'accessing the ' . $os . '\'s filesystem.  Would '
                           . 'you like to add another username and password '
                           . 'at this time? (yes/no/help)', 'yesnohelp', 'no');
    } else {
      $answer = get_answer('You have successfully configured '
                           . vmware_product_name() . ' to allow your virtual '
                           . 'machines to access the ' . $os
                           . '\'s filesystem.  Would you like to add a '
                           . 'username and password for accessing your ' . $os
                           . '\'s filesystem at this time? (yes/no/help)',
                           'yesnohelp', 'yes');
    }

    if ($answer eq 'yes') {
      my $samba_uid;

      $samba_uid = query('Please specify a username that is known to your '
                         . $os . ':', '', 0);
      if ($samba_uid eq '') {
        last;
      }

      system(shell_string(db_get_answer('BINDIR') . '/vmware-smbpasswd') . ' '
             . shell_string($vHostIf) . ' -a ' . shell_string($samba_uid));
      print wrap("\n", 0);
      next;
    }

    if ($answer eq 'no') {
      last;
    }

    print wrap('To export your ' . $os . '\'s filesystem to a virtual '
               . 'machine, you need to specify usernames and passwords that '
               . 'are used by a private Samba server for determining access '
               . 'rights to your ' . $os . '\'s filesystem.  You should '
               . 'specify a username and password that is known to your '
               . $os . '.  If you then use the same username and password to '
               . 'log on to a guest Microsoft Windows operating system with '
               . 'Microsoft Networking enabled, your ' . $os . '\'s '
               . 'filesystem will appear as a network drive in the guest '
               . 'operating system.' . "\n\n" . 'You can also add more '
               . 'usernames at a later time by invoking the following command '
               . 'as root: "' . db_get_answer('BINDIR') . '/vmware-smbpasswd '
               . $vHostIf . ' -a <username>"' . "\n\n", 0);
  }

  print wrap('You can add more usernames at any time by invoking the '
             . 'following command as root: "' . db_get_answer('BINDIR')
             . '/vmware-smbpasswd ' . $vHostIf . ' -a <username>"' . "\n\n",
             0);
}

# Configuration of NAT networking
sub configure_nat_net {
  my $vHubNr = shift;
  my $vHostIf = shift;
  my $hostaddr;
  my $subnet;
  my $netmask;
  my $status;

  if ($vHubNr < $gMinVmnet || $vHubNr > $gMaxVmnet) {
    print wrap('Number of virtual networks exceeded.  Not creating virtual '
               . 'network.' . "\n\n", 0);
    return;
  }

  # If this wasn't a NAT network before, wipe out the old configuration info
  # as it may confuse us later.
  if (!is_nat_network($vHubNr)) {
    remove_net($vHubNr, $vHostIf);
  }

  print wrap('Configuring a NAT network for vmnet' . "$vHubNr." . "\n\n", 0);

  my $keep_settings;

  $keep_settings = 'no';
  $hostaddr = $gDBAnswer{'VNET_' . $vHubNr . '_HOSTONLY_HOSTADDR'};
  $netmask = $gDBAnswer{'VNET_' . $vHubNr . '_HOSTONLY_NETMASK'};

  if (defined($hostaddr) && defined($netmask)) {
    $subnet = compute_subnet($hostaddr, $netmask);
    $keep_settings = get_answer('The NAT network is currently configured to '
                                . 'use the private subnet ' . $subnet . '/'
                                . $netmask . '.  Do you want to keep these '
                                . 'settings?', 'yesno', 'yes');
  }

  if ($keep_settings eq 'no') {
    # Get the new settings
    for (;;) {
      my $answer;

      $answer = get_answer('Do you want this program to probe for an unused '
                           . 'private subnet? (yes/no/help)',
                           'yesnohelp', 'yes');

      if ($answer eq 'yes') {
        my @usedSubnets = get_used_subnets();
        ($status, $subnet, $netmask) = subnet_probe($vHubNr, $vHostIf,
                                                    \@usedSubnets);
        if ($status) {
          last;
        }
        # Fallback
        $answer = 'no';
      }

      if ($answer eq 'no') {
        $hostaddr = get_persistent_answer('What will be the IP address of '
                                          . 'your ' . $machine . ' on the '
                                          . 'private network?',
                                          'VNET_' . $vHubNr
                                          . '_HOSTONLY_HOSTADDR', 'ip', '');
        $netmask = get_persistent_answer('What will be the netmask of your '
                                         . 'private network?',
                                         'VNET_' . $vHubNr
                                         . '_HOSTONLY_NETMASK', 'ip', '');
        $subnet = compute_subnet($hostaddr, $netmask);
        last;
      }

      print wrap('Virtual machines configured to use NAT networking are '
                 . 'placed on a virtual network that is confined to this '
                 . $machine . '.  Virtual machines on this network can '
                 . 'communicate with the network through the NAT process, '
                 . 'with each other, and with the ' . $os . '.' . "\n\n"
                 . 'To setup NAT networking you need to select a network '
                 . 'number that is normally unreachable from the ' . $machine
                 . '.  We can automatically select this number for you, or '
                 . 'you can specify a network number that you want.' . "\n\n"
                 . 'The automatic selection process works by testing a series '
                 . 'of Class C subnet numbers to see if they are reachable '
                 . 'from the ' . $machine . '.  The first one that is '
                 . 'unreachable is used.  The subnet numbers are chosen from '
                 . 'the private network numbers specified by the Internet '
                 . 'Engineering Task Force (IETF) in RFC 1918 (http://www.isi'
                 . '.edu/in-notes/rfc1918.txt).' . "\n\n" . 'Virtual machines '
                 . 'residing on the NAT network will appear as the host when '
                 . 'accessing the network.  These virtual machines on the NAT '
                 . 'network will not be accessible from outside the host '
                 . 'machine.  This means that it is OK to use the same number '
                 . 'on different systems so long as you do not enable IP '
                 . 'forwarding on the ' . $machine . '.' . "\n\n", 0);
    }
  }

  make_nat_net($vHubNr, $vHostIf, $subnet, $netmask);
  show_ISC();
  dhcpd_consultant($vHubNr, $vHostIf);
}

# Creates a NAT network
sub make_nat_net {
  my $vHubNr = shift;
  my $vHostIf = shift;
  my $subnet = shift;
  my $netmask = shift;

  my $hostaddr = int_to_quaddot(quaddot_to_int($subnet) + 1);
  my $nataddr = int_to_quaddot(quaddot_to_int($subnet) + 2);

  configure_dev('/dev/' . $vHostIf, 119, $vHubNr, 1);

  db_add_answer('VNET_' . $vHubNr . '_NAT', 'yes');
  db_add_answer('VNET_' . $vHubNr . '_HOSTONLY_HOSTADDR', $hostaddr);
  db_add_answer('VNET_' . $vHubNr . '_HOSTONLY_NETMASK', $netmask);

  write_dhcpd_config($vHubNr, $vHostIf, \&make_nat_patch);
  write_nat_config($vHubNr, $vHostIf);
}

# Write NAT configuration files
sub write_nat_config {
  my $vHubNr = shift;
  my $vHostIf = shift;
  my $nat_dir;
  my %patch;

  # Create the nat config directory (one per virtual interface)
  $nat_dir = $gRegistryDir . '/' . $vHostIf . '/nat';
  create_dir($nat_dir, 0x1);

  undef %patch;

  my $hostaddr = db_get_answer('VNET_' . $vHubNr . '_HOSTONLY_HOSTADDR');
  my $netmask = db_get_answer('VNET_' . $vHubNr . '_HOSTONLY_NETMASK');
  my $network = compute_subnet($hostaddr, $netmask);
  my $broadcast = compute_broadcast($hostaddr, $netmask);
  my $nataddr = int_to_quaddot(quaddot_to_int(compute_subnet($hostaddr,
                                                             $netmask)) + 2);

  $patch{'%nataddr%'} = $nataddr;
  $patch{'%netmask%'} = $netmask;
  $patch{'%sample%'} = int_to_quaddot(
    (quaddot_to_int($network) + quaddot_to_int($broadcast) + 1) / 2);
  $patch{'%vmnet%'} = "/dev/" . $vHostIf;
  install_file(db_get_answer('LIBDIR') . '/configurator/vmnet-nat.conf',
               $nat_dir . '/nat.conf', \%patch, 0x1);
}

# Makes the patch hash that is used to replace the options in the dhcpd config
# file.
# These DHCP options are needed for the NAT network.
sub make_nat_patch {
  my $vHubNr = shift;
  my $vHostIf = shift;
  my %patch;

  my $hostaddr = db_get_answer('VNET_' . $vHubNr . '_HOSTONLY_HOSTADDR');
  my $netmask = db_get_answer('VNET_' . $vHubNr . '_HOSTONLY_NETMASK');
  my $nataddr = int_to_quaddot(quaddot_to_int(compute_subnet($hostaddr,
                                                             $netmask)) + 2);

  undef %patch;
  $patch{'%vmnet%'} = $vHostIf;
  $patch{'%hostaddr%'} = $nataddr;
  $patch{'%netmask%'} = $netmask;
  $patch{'%network%'} = compute_subnet($nataddr, $netmask);
  $patch{'%broadcast%'} = compute_broadcast($nataddr, $netmask);
  # Median address in this subnet
  $patch{'%range_low%'} = int_to_quaddot(
    (quaddot_to_int($patch{'%network%'})
     + quaddot_to_int($patch{'%broadcast%'}) + 1) / 2);
  # Last normal address in this subnet
  $patch{'%range_high%'} = int_to_quaddot(quaddot_to_int($patch{'%broadcast%'})
                                          - 1);
  $patch{'%router_option%'} = "option routers $nataddr;";
  return %patch;
}

# Get the list of subnets used by all the nat networks
sub get_nat_subnets {
  my $vHubNr;
  my @subnets = ();
  for ($vHubNr = $gMinVmnet; $vHubNr <= $gMaxVmnet; $vHubNr++) {
    if (is_nat_network($vHubNr)) {
      my $hostaddr = db_get_answer('VNET_' . $vHubNr  . '_HOSTONLY_HOSTADDR');
      my $netmask = db_get_answer('VNET_' . $vHubNr  . '_HOSTONLY_NETMASK');
      push(@subnets, compute_subnet($hostaddr, $netmask));
    }
  }
  return @subnets;
}

# Get the list of subnets that are already used by virtual networks
sub get_used_subnets {
  return (&get_hostonly_subnets(), &get_nat_subnets());
}

# Return the specific VMware product
sub vmware_product {
  return 'ws';
}

# This is a function in case a future product name contains language-specific
# escape characters.
sub vmware_product_name {
  return 'VMware Workstation';
}

sub vmware_tools_app_name {
  return db_get_answer('BINDIR') . '/vmware-toolbox';
}

# Security configuration:  add security files to locations data base so
# they get properly backed up.
# XXX this files will be created later, but need to be mentioned here
# so they get properly removed on unistall.
sub configure_security() {
   db_add_dir($gRegistryDir . '/ssl', 0);
   db_add_file($gRegistryDir . '/ssl/rui.crt', 0);
   db_add_file($gRegistryDir . '/ssl/rui.key', 0);
}

# Configuration related to the specific features of the Workgroup Server (GSX)
# product
sub configure_wgs {
  my $program;

  foreach $program ('killall', 'tar', 'perl', 'make', 'rm', 'cp', 'mv',
                    'touch') {
    if (not defined($gHelper{$program})) {
      $gHelper{$program} = DoesBinaryExist_Prompt($program);
      if ($gHelper{$program} eq '') {
        error('Unable to continue.' . "\n\n");
      }
    }
  }


  # Create the /var/log/vmware directory for event logs
  create_dir('/var/log/vmware', 0x1);

  # Kill any running vmware-serverd process.
  system(shell_string($gHelper{'killall'}) . ' -TERM vmware-serverd '
         . '>/dev/null 2>&1');

  configure_wgs_superserver();
  configure_wgs_perl();
  if (not (vmware_product() eq 'server')) {
    # authd pam file is automatically installed in ESX Server
    configure_wgs_pam_d();
  }
  fix_vmlist_permissions();
}

# Try to find a free port for authd use starting from default passed in
# If none are available, return default passed in
sub get_port_for_authd {
  my $base_port = shift;
  my $port = $base_port;
  my $max_range = 65536;
  while (check_answer_authdport($port, "default") ne $port) {
    $port = ($port + 1) % $max_range;
    if ($base_port == $port) {
      last;
    }
  }
  return $port;
}

# Try and figure out which "superserver" is installed and update to correct
# one.
sub configure_wgs_superserver {
  my $inetd_conf  = "/etc/inetd.conf";
  my $xinetd_conf = "/etc/xinetd.conf";
  my $xinetd_dir  = "/etc/xinetd.d";
  my $success     = 0;
  my $port;

  if (defined(db_get_answer_if_exists("AUTHDPORT"))) {
    $port = db_get_answer_if_exists("AUTHDPORT");
  } else {
    # We'll try to find a good default port that is free
    $port = get_port_for_authd($gDefaultAuthdPort);
    if ($port != $gDefaultAuthdPort) {
      print wrap('The default port : '. $gDefaultAuthdPort. ' is not free.'
                 . ' We have selected a suitable alternative port for '
                 . vmware_product_name()
                 . ' use. You may override this value now.' . "\n", 0);
      print wrap(' Remember to use this port when installing'
                 . ' remote clients on other machines.' . "\n", 0);
    }
  }
  $port = get_persistent_answer('Please specify a port for remote console'
                                . ' connections to use',
                                'AUTHDPORT',
                                'authdport',
                                $port);

  if ($gDefaultAuthdPort != $port) {
    print wrap('WARNING: ' . vmware_product_name(). ' has been configured to '
               . 'run on a port different from the default port. '
               . 'Please make sure to use this port when installing remote'
               . ' clients on other machines.' . "\n", 0);
  }
  # check for xinetd
  # XXX Could be a problem, as they could start xinetd with '-f config_file'.
  #     We could do a ps -ax, look for xinetd, parse the line, find the config
  #     file, parse the config file to find the xinet.d directory.  Bah.  Or
  #     parse if from the init.d script somewhere.  If they use init.d.
  if (-e $xinetd_conf) {
    if (open(CONF, $xinetd_conf)) {
        # Let's try to find it here
        while (<CONF>) {
          if (/^\s*includedir\s*(\S+)\s*$/) {
            $xinetd_dir = $1;
            last;
          }
        }
        close(CONF);
      }
      if (-d $xinetd_dir) {
        configure_wgs_xinetd($xinetd_conf, $xinetd_dir, $port);
        $success = 1;
      } else {
        print wrap('WARNING: An xinetd.conf exists but we couldnt find the '
                   . 'directory xinetd uses to store config files. '
                   . 'Please reinstall or reconfigure the xinetd package'
                   . ' and re-run this configuration program'
                   . "\n", 0);
      }
  }

  # check for inetd
  if (-e $inetd_conf) {
      configure_wgs_inetd($inetd_conf, $port);
      $success = 1;
  }

  if ($success) {
    return;
  }

  query('Unable to find any instance of the super-server "inetd" or '
        . '"xinetd".  It is possible that you do not have one of these '
        . 'packages installed on this machine.  Please install "inetd" or '
        . '"xinetd".' . "\n\n" . 'If you do have "inetd" or "xinetd" '
        . 'installed, make sure that ' . $inetd_conf . ' or ' . $xinetd_dir
        . ' exists.' . "\n" . 'The configuration will continue, but you '
        . 'should re-run ' . $0 . ' after you fix the super-server.' . "\n\n"
        . 'Hit enter to continue.', '', 0);
  exit 1;
}


# Restart the inetd service
sub restart_inetd {
  my $inetd_restart = db_get_answer('INITSCRIPTSDIR') . '/inetd';
  if (-e $inetd_restart) {
    if (!system(shell_string($inetd_restart) . ' restart')) {
      return;
    }
  }

  if (system(shell_string($gHelper{'killall'}) . ' -HUP inetd')) {
    query('Unable to make the Internet super-server (inetd) re-read its '
          . 'configuration file.  Please restart inetd by hand:' . "\n" 
          . '    killall -v -HUP inetd' . "\n\n" 
          . 'Hit enter to continue.', '', 0);
  }
}

# Cleanup the inetd.conf file.
sub uninstall_inetd {
  my $inetd = shift;
  my %patch = ('^# VMware auth.*$' => '',
          '^.*stream\s+tcp\s+nowait.*vmauthd.*$' => '',
          '^.*stream\s+tcp\s+nowait.*vmware-authd.*$' => '');
  my $tmp_dir = make_tmp_dir('vmware-installer');
  # Build the temp file's path
  my $tmp = $tmp_dir . '/inetd.' . $$;

  internal_sed($inetd, $tmp, 0, \%patch);
  undef %patch;

  if (not internal_sed($tmp, $inetd, 0, \%patch)) {
    query('Unable to copy file ' . $tmp . ' back to ' . $inetd 
          . '.' . "\n" . 'The authentication daemon was not '
          . 'removed from ' . $inetd . "\n\n" 
          . 'Hit enter to continue', 0);
  }
  remove_tmp_dir($tmp_dir);

}

# Update the Internet super-server's configuration file, and make the
# super-server read it
sub configure_wgs_inetd {
  # XXX We should use 2 delimiters to mark the beginning and the end of
  #     VMware's block in the config file.  We should unconditionally remove
  #     the previous block at uninstall time (unless it has changed, in which
  #     case we want to comment it), and we should unconditionally add it at
  #     install time --hpreg
  my $conf_file = shift;
  my $port      = shift;
  my $authd;
  my $services_file = "/etc/services";

  $authd = db_get_answer('SBINDIR') . "/vmware-authd";

  # First check if our port number is in use in /etc/services
  if (not open(CONF, $services_file)) {
    query('Unable to read the "' . $services_file . '" file.  Consequently, '
          . 'this program cannot check for the presence of "' . $authd
          . '" in the file.  You will have to do it by hand before running '
          . vmware_product_name() . '.' . "\n\n" . 'Hit enter to continue.',
          '', 0);
    return;
  }

  while (<CONF>) {
    if (/\b$port\/(tcp|udp)\b/i) {
      query('You already have a service running on port "' . $port
            . '" in the "' . $services_file . '" file.  No change will be '
            . 'made to it.' . "\n\n" . ' You will have to pick a new port, '
            . 'less than 1024, for vmware-authd to use.' . "\n\n"
            . 'Hit enter to continue.', '', 0);
      close(CONF);
      return;
    }
  }
  close(CONF);

  # Open the inetd.conf file and check if our entry is already there.
  if (not open(CONF, $conf_file)) {
    query('Unable to read the "' . $conf_file . '" file.  Consequently, this '
          . 'program cannot check for the presence of "' . $authd . '" in the '
          . 'file.  You will have to do it by hand before running '
          . vmware_product_name() . '.' . "\n\n" . 'Hit enter to continue.',
          '', 0);
    return;
  }

  while (<CONF>) {
    if (/^$port.*stream.*tcp.*nowait.*vmware-authd$/i) {
      query('You already have an entry for "' . $authd . '" in the "'
            . $conf_file . '" file.  No change will be made to it.' . "\n\n"
            . 'Hit enter to continue.', '', 0);
      close(CONF);
      return;
    }
  }
  close(CONF);
  uninstall_inetd($conf_file);

  if (not open(CONF, '>>' . $conf_file)) {
    query('Unable to append to the "' . $conf_file . '"file.  Consequently, '
          . 'this program cannot add a "' . $authd . '" entry in the file.  '
          . 'You will have to do it by hand before running '
          . vmware_product_name() . '.' . "\n\n" . 'Hit enter to continue.',
          '', 0);
    return;
  }

  print CONF '# VMware authentification daemon' . "\n" . $port
             . ' stream tcp nowait root ' . $authd . ' vmware-authd' . "\n";
  close(CONF);
  restart_inetd();
}

#Restart xinetd
sub restart_xinetd {
  my $xinetd_restart = db_get_answer('INITSCRIPTSDIR') . '/xinetd';
  if (-e $xinetd_restart) {
    if (!system(shell_string($xinetd_restart) . ' restart')) {
      return;
    }
  }
  if (system(shell_string($gHelper{'killall'}) . ' -USR2 xinetd')) {
    query('Unable to make the Internet super-server (xinetd) re-read its '
          . 'configuration file.  Please restart xinetd by hand:' . "\n" 
          . '    killall -v -USR2 xinetd' . "\n\n" 
          . 'Hit enter to continue.', '', 0);
  }
}

# Update the Internet super-server's configuration file, and make the
# super-server read it
sub configure_wgs_xinetd {
  my $conf_file = shift;
  my $conf_dir  = shift;
  my $port      = shift;

  my $authd_conf_file = "$conf_dir/vmware-authd";
  my $authd = db_get_answer('SBINDIR') . "/vmware-authd";

  # Create the new vmware-authd file
  if (not open(CONF, '>' . $authd_conf_file)) {
    query('Unable to create the "' . $authd_conf_file . '"file.  '
          . 'Consequently, this program cannot add a "' . $authd . '" entry '
          . 'in the file.  You will have to do it by hand before running '
          . vmware_product_name() . '.' .  "\n\n" . 'Hit enter to continue.',
          '', 0);
    return;
  }
  print CONF <<END;
# default: on
# description: The VMware remote access authentification daemon
service vmware-authd
{
    disable         = no
    port            = $port
    socket_type     = stream
    protocol        = tcp
    wait            = no
    user            = root
    server          = $authd
}
END
  close CONF;
  restart_xinetd();
}


# Handle the installation and configuration of vmware's perl module
# WARNING: This code is highly duplicated from build_perl_api in pkg_mgr.pl
sub configure_wgs_perl {
  my $control;
  my $build_dir;

  print wrap('Configuring the VMware VmPerl Scripting API.' . "\n", 0);

  $control = db_get_answer('LIBDIR') . '/perl/control.tar';
  if (not (-e $control)) {
    error('Unable to find the VMware VmPerl Scripting API.  You may want to '
          . 're-install ' . vmware_product_name() . '.' .  "\n\n");
  }

  $build_dir = make_tmp_dir($cTmpDirPrefix);

  if (system(shell_string($gHelper{'tar'}) . ' -C ' . shell_string($build_dir)
             . ' -xopf ' . shell_string($control))) {
    error('Unable to untar the "' . $control . '" file in the "'
          . $build_dir . '" directory.' . "\n\n");
  }

  if (system('cd ' . shell_string($build_dir . '/control-only') . ' && '
             . shell_string($gHelper{'perl'})
             . ' Makefile.PL > make.log 2>&1')) {
    print wrap('Unable to create the VMware VmPerl Scripting API makefile.'
               . "\n\n", 0);

    # Look for the header files needed to build the Perl module.  If we don't
    # find them, suggest to the user how they can install the files. -jhu
    if (open(PERLINC, shell_string($gHelper{'perl'}) . ' -MExtUtils::Embed ' . 
             '-e perl_inc |')) {
      my $inc = <PERLINC>;
      close(PERLINC);
      $inc =~ s/\s*-I//;
      if (! -e $inc . '/perl.h') {
        print wrap('Could not find necessary components to build the '
                   . 'VMware VmPerl Scripting API.  Look in your Linux '
                   . 'distribution to see if there is a perl-devel package.  '
                   . 'Install that package if it exists and then re-run this '
                   . 'installation program.' . "\n\n", 0);
      }
    }
    return perl_config_fail($build_dir);
  }
  print "\n";

  print wrap('Building the VMware VmPerl Scripting API.' . "\n\n", 0);

  # Make sure we have a compiler available
  if (get_cc() eq '') {
    print wrap('Unable to install the VMware VmPerl Scripting API.', 0);
    print wrap('A C compiler is required to install the API.' . "\n\n",  0);
    if ($gSystem{'distribution'} eq 'suse') {
      # SUSE SLES 8.0 doesnt install the gcc rpm by default 
      print wrap('Please make sure to install the gcc rpm from your SUSE installation CD' .
                 ' and rerun this program.' .
                 "\n\n", 0);
    }
    remove_tmp_dir($build_dir);
    return;
  }

  # We touch all our files in case the system clock is set to the past.  Make will get confused and
  # delete our shipped .o file(s).
  system(shell_string($gHelper{'touch'}) . ' ' 
         . shell_string($build_dir . '/control-only') . '/* >>' 
         . shell_string($build_dir . '/control-only') . '/make.log 2>&1');

  if (system(shell_string($gHelper{'make'}) . ' -C ' 
             . shell_string($build_dir . '/control-only') . ' '
             . shell_string('CC=' . $gHelper{'gcc'}) . ' '
             . ' >>' . shell_string($build_dir . '/control-only') . '/make.log 2>&1')) {
    print wrap('Unable to compile the VMware VmPerl Scripting API.' . "\n\n", 0);
    return(perl_config_fail($build_dir));
  }

  print wrap("Installing the VMware VmPerl Scripting API.\n\n", 0);


  # XXX This is deeply broken: we let a third party tool install a file without
  #     adding it to our installer database.  This file will never get
  #     uninstalled by our uninstaller --hpreg
  if (system(shell_string($gHelper{'make'}) . ' -C ' 
             . shell_string($build_dir . '/control-only') . ' '
             . shell_string('CC=' . $gHelper{'gcc'}) . ' '
             . ' install >>' . shell_string($build_dir . '/control-only') 
             . '/make.log 2>&1')) {
    print wrap('Unable to install the VMware VmPerl Scripting API.' . "\n\n", 0);
    return(perl_config_fail($build_dir));
  }

  print wrap('The installation of the VMware VmPerl Scripting API succeeded.' . "\n\n", 0);
  remove_tmp_dir($build_dir);
}

#  Setup the init.pl file that serverd uses
sub configure_serverd {
  my %patch;

  $patch{'%libdir%'} = db_get_answer('LIBDIR');
  install_file(db_get_answer('LIBDIR') . '/serverd/init.pl.default',
               db_get_answer('LIBDIR') . '/serverd/init.pl', \%patch, 0x1);
}

#  Move the /etc/vmware/pam.d information to its real home in /etc/pam.d
sub configure_wgs_pam_d {
  my $dir = '/etc/pam.d';
  my $o_file = $gRegistryDir . '/pam.d/vmware-authd';

  if (system(shell_string($gHelper{'cp'}) . ' -p ' . $o_file . ' ' . $dir)) {
    error('Unable to copy the VMware vmware-authd PAM file to ' . $dir
          . "\n\n");
  }
}

# both configuration.
sub show_net_config {
  my $bridge_flag = shift;
  my $hostonly_flag = shift;
  my $nat_flag = shift;

  # Don't show anything
  if (!$hostonly_flag && !$bridge_flag && !$nat_flag) {
    return;
  }

  # Print a message describing what we are showing
  my $nettype = 'virtual';
  if (!$bridge_flag && !$nat_flag && $hostonly_flag) {
    $nettype = 'hostonly';
  } elsif (!$hostonly_flag && !$nat_flag && $bridge_flag) {
    $nettype = 'bridged';
  } elsif (!$bridge_flag && !$hostonly_flag && $nat_flag) {
    $nettype = 'NAT';
  }
  print wrap('The following ' . $nettype . ' networks have been defined:'
             . "\n\n", 0);

  # Number of networks configured
  my $count = 0;

  local(*WFD);
  if (not open(WFD, '| ' . $gHelper{'more'})) {
    error("Could not print networking configuration.\n");
  }

  my $i;
  for ($i = $gMinVmnet; $i <= $gMaxVmnet; $i++) {
    if ($bridge_flag && is_bridged_network($i)) {
    my $bridge = $gDBAnswer{'VNET_' . $i . '_INTERFACE'};
      print WFD wrap(". vmnet" . $i . ' is bridged to ' . $bridge . "\n", 0);
      $count++;
    } elsif ($hostonly_flag && is_hostonly_network($i)) {
      my $hostonly_addr = $gDBAnswer{'VNET_' . $i . '_HOSTONLY_HOSTADDR'};
      my $hostonly_mask = $gDBAnswer{'VNET_' . $i . '_HOSTONLY_NETMASK'};
      my $sambaInfo = '';
      if (is_samba_running($i)) {
        $sambaInfo = '  This network has a Samba server running to allow '
                     . 'virtual machines to share the ' . $os . '\'s '
                     . 'filesystem.';
      }

      print WFD wrap(". vmnet" . $i . ' is a host-only network on private '
                     . 'subnet '
                     . compute_subnet($hostonly_addr, $hostonly_mask) . '.'
                     . $sambaInfo . "\n", 0);
      $count++;
    } elsif ($nat_flag && is_nat_network($i)) {
      my $hostonly_addr = $gDBAnswer{'VNET_' . $i . '_HOSTONLY_HOSTADDR'};
      my $hostonly_mask = $gDBAnswer{'VNET_' . $i . '_HOSTONLY_NETMASK'};
      print WFD wrap(". vmnet" . $i . ' is a NAT network on private subnet '
                     . compute_subnet($hostonly_addr, $hostonly_mask) . '.'
                     . "\n", 0);
      $count++;
    }
  }

  if ($count == 0) {
    print WFD wrap(". No virtual networks configured.\n", 0);
  }

  print WFD wrap("\n", 0);

  close(WFD);
}

# Configuration of samba
sub configure_samba {
  my $samba = 'no';
  if (count_samba_networks() > 0) {
    $samba = 'yes';
  } elsif (not was_samba_answered()) {
    $samba = '';
  }
  for (;;) {
    $samba = get_answer('Do you want this program to automatically configure '
                        . 'your system to allow your virtual machines to '
                        . 'access the ' . $os . '\'s filesystem? '
                        . '(yes/no/help)', 'yesnohelp', $samba);

    if ($samba eq 'no') {
      unmake_samba_net($gDefHostOnly, 'vmnet' . $gDefHostOnly);
      return;
    }
    if ($samba eq 'yes') {
      last;
    }

    print wrap('To configure your system for ' . $os . ' filesystem access, '
               . 'the program will install VMware\'s networking software to '
               . 'allow your virtual machines to use the network.  It will '
               . 'also install a private Samba server to export your ' . $os
               . '\'s filesystem on a virtual network that is private to the '
               . 'physical machine and your virtual machines.  When you '
               . 'configure a virtual machine with the VMware Configuration '
               . 'Wizard, you will be given the option of allowing the '
               . 'virtual machine to access the ' . $os . '\'s filesystem in '
               . 'the Network Settings configuration panel.  Choose an option '
               . 'that includes host-only networking to enable this feature.  '
               . 'If you already have a Samba server running on your ' . $os
               . ', it is highly recommended to answer "no" to this option.'
               . "\n\n", 0);
  }

  query('The version of Samba used in this version of '
        . vmware_product_name() . ' is licensed as described in the "'
        . db_get_answer('DOCDIR') . '/SAMBA-LICENSE" file.' . "\n\n"
        . 'Hit enter to continue.', '', 0);

  if (db_get_answer('NETWORKING') eq 'no') {
    print wrap('Enabling networking (this is required to share the ' . $os
               . '\'s filesystem).' . "\n\n" , 0);
    configure_bridged_net($gDefBridged, 'vmnet' . $gDefBridged);
    db_add_answer('NETWORKING', 'yes');

    # NAT networking
    if (!is_nat_network($gDefNat)) {
      configure_nat_net($gDefNat, 'vmnet' . $gDefNat);
    }
  }

  if (!is_hostonly_network($gDefHostOnly)) {
    print wrap('Creating a host-only network on vmnet' . $gDefHostOnly
               . '. (this is required to share the ' . $os . '\'s filesystem).'
               . "\n\n" , 0);
    configure_hostonly_net($gDefHostOnly, 'vmnet' . $gDefHostOnly, 1, 0);
  }

  make_samba_net($gDefHostOnly, 'vmnet' . $gDefHostOnly);

  samba_consultant($gDefHostOnly, 'vmnet' . $gDefHostOnly);
}

# Go through the /etc/vmware/vm-list file and set permissions correctly
#  also, upgrade vmkernel device names on ESX Server
sub fix_vmlist_permissions {
  my $file = '/etc/vmware/vm-list';
  my $cf;

  if (not -e $file) {
    return;
  }

  if (vmware_product() eq 'wgs') {
    if (get_answer('Do you want this program to set up permissions for your '
                   . 'registered virtual machines?  This will be done by '
                   . 'setting new permissions on all files found in the "'
                   . $file . '" file.', 'yesno', 'yes') eq 'no') {
      return;
    }
  }

  if (not open(F, "$file")) {
    print wrap('Aborting attempt to change permissions on config files found '
               . 'in "' . $file . '": Cannot read the file.' . "\n\n", 0);
    return;
  }
  while (<F>) {
    s/"//g;
    # This comment fixes emacs's broken syntax highlighting"
    ($cf) = m/^config (.*)$/;
    if (!defined($cf) || (not -e $cf) || (not -f $cf)) {
      next;
    }
    if (chmod(0754, $cf) != 1) {
      print wrap('Cannot change permissions on file "' . $cf . '".' . "\n\n",
                 0);
    }
  }
  close(F);
}

# Check the system requirements to install this product
sub check_wgs_memory {
  my $availableRAMInMB;
  my $minRAMinMB = 256;

  $availableRAMInMB = memory_get_total_ram();
  if (not defined($availableRAMInMB)) {
    if (get_persistent_answer('Unable to determine the total amount of memory '
                              . 'on this system.  You need at least '
                              . $minRAMinMB . ' MB.  Do you really want to '
                              . 'continue?',
                              'PASS_RAM_CHECK', 'yesno', 'no') eq 'no') {
      exit(0);
    }
  } elsif ($availableRAMInMB < $minRAMinMB) {
    if (get_persistent_answer('There are only ' . $availableRAMInMB . ' MB '
                              . 'of memory on this system.  You need at least '
                              . $minRAMinMB . ' MB.  Do you really want to '
                              . 'continue?',
                              'PASS_RAM_CHECK', 'yesno', 'no') eq 'no') {
      exit(0);
    }
  }
}


# Retrieve the amount of RAM (in MB)
# Return undef if unable to determine
sub memory_get_total_ram {
  my $line;
  my $availableRAMInMB = undef;

  if (not open(MEMINFO, '</proc/meminfo')) {
    error('Unable to read the "/proc/meminfo" file.' . "\n\n");
  }
  while (defined($line = <MEMINFO>)) {
    chomp($line);
    
    if ($line =~ /^Mem:\s*(\d+)/) {
      $availableRAMInMB = $1 / (1024 * 1024);
      last;
    }
    if ($line =~ /^MemTotal:\s*(\d+)\s*kB/) {
      $availableRAMInMB = $1 / 1024;
      last;
    }
  }
  if (defined($availableRAMInMB)) {
    #
    # Round up total memory to the nearest multiple of 8 or 32 MB, since the
    # "total" amount of memory reported by Linux is the total physical memory
    # minus the amount used by the kernel
    #

    if ($availableRAMInMB < 128) {
      $availableRAMInMB = CEILDIV($availableRAMInMB, 8) * 8;
    } else {
      $availableRAMInMB = CEILDIV($availableRAMInMB, 32) * 32;
    }
  }
  close(MEMINFO);

  return $availableRAMInMB;
}

sub CEILDIV {
  my $left = shift;
  my $right = shift;

  return int(($left + $right - 1) / $right);
}


# Common error message when we can't compile or install our perl modules
sub perl_config_fail {
  my $dir = shift;

  print wrap('********' . "\n". 'The VMware VmPerl Scripting API was not '
             . 'installed.  Errors encountered during compilation and '
             . 'installation of the module can be found here: ' . $dir
             . "\n\n" . 'You will not be able to use the "vmware-cmd" '
             . 'program.' . "\n\n" . 'Errors can be found in the log file: '
             . shell_string($dir . '/control-only/make.log')
             . "\n" . '********' . "\n\n", 0);
  query('Hit enter to continue.', '', 0);
}

# Configuration related to networking
sub configure_net {
  my $i;

  # XXX ESX doesn't use vmnet.  Can we put this step elsewhere, say after the
  #     NETWORKING question? -jhu
  # Get this set up even if the user doesn't want networking.  The
  # reason is that samba may turn on networking and it needs this
  # module to use networking.
  configure_module('vmnet');

  # Fix for bug 15842.  Always regenerate the network settings because an
  # upgrade leaves us in an inconsistent state.  The database will have
  # the network settings, but the necessary configuration files such as
  # dhcpd.conf will not exist until we run make_all_net(). -jhu
  make_all_net();

  if (defined($gDBAnswer{'NETWORKING'}) && count_all_networks() > 0) {
    print wrap('You have already setup networking.' . "\n\n", 0);
    if (get_answer('Would you like to skip networking setup and keep your old '
                   . 'settings as they are? (yes/no)',
                   'yesno', 'yes') eq 'yes') {
      return;
    }
  }

  for (;;) {
    my $answer;
    my $helpString;
    my $prompt;
    my $default;
    if (vmware_product() eq 'server') {
       $prompt = 'Do you want to configure legacy Console OS based '
                 . 'networking? (yes/no/help)';
       $default = 'no';
       $helpString = 'This will allow you to configure bridged and host-only '
                     . 'networking. These are not recommended for use with '
                     . vmware_longname() . ".\n\n";
    } else {
       $prompt = 'Do you want networking for your virtual machines? '
                 . '(yes/no/help)';
       $default = 'yes';
       $helpString = 'Networking will allow your virtual machines to use a '
                     . 'virtual network. There are primarily two types of '
                     . 'networking available: bridged and host-only.  A '
                     . 'bridged network is a virtual network that is '
                     . 'connected to an existing ethernet device.  With a '
                     . 'bridged network, your virtual machines will be able '
                     . 'to communicate with other machines on the network to '
                     . 'which the ethernet card is attached.  A host-only '
                     . 'network is a private network between your virtual '
                     . 'machines and ' . $os . '.  Virtual machines connected '
                     . 'to a host-only network may only communicate directly '
                     . 'with other virtual machines or the ' . $os
                     . '.  A virtual machine may be '
                     . 'configured with more than one bridged or host-only '
                     . 'network.' . "\n\n" . 'If you want your virtual '
                     . 'machines to be connected to a network, say "yes" '
                     . 'here.' . "\n\n";
    }

    $answer = get_persistent_answer($prompt, 'NETWORKING', 'yesnohelp',
                                    $default);
    if (($answer eq 'no') || ($answer eq 'yes')) {
      last;
    }

    print wrap($helpString, 0);
  }

  if (db_get_answer('NETWORKING') eq 'no') {
    # Turning off networking turns off hostonly and samba.
    remove_all_networks(1, 1, 1);
    return;
  }

  # At this point, networking is on.
  for ($i = 0; $i < $gNumVmnet; $i++) {
    configure_dev('/dev/vmnet' . $i, 119, $i, 1);
  }

  # If there is a previous network configuration, prompt the user to
  # see if the user would like to modify the existing configuration.
  # If the user chooses to modify the settings, give the choice of
  # either the wizard or the editor.
  #
  # If there is no previous network configuration, use the wizard.
  if (count_all_networks() > 0) {
    for (;;) {
      my $answer;
      $answer = get_persistent_answer('Would you prefer to modify your '
                                      . 'existing networking configuration '
                                      . 'using the wizard or the editor? '
                                      . '(wizard/editor/help)',
                                      'NETWORKING_EDITOR', 'editorwizardhelp',
                                      'wizard');
      if (($answer eq 'editor') || ($answer eq 'wizard')) {
        last;
      }

      print wrap('The wizard will present a series of questions that will '
                 . 'help you quickly add new virtual networks.  However, you '
                 . 'cannot remove networks or edit existing networks with the '
                 . 'wizard.  To remove or edit existing networks, you should '
                 . 'use the editor.' . "\n\n", 0);
    }

    if (db_get_answer('NETWORKING_EDITOR') eq 'editor') {
      configure_net_editor();
      return;
    }
  }
  configure_net_wizard();
}

# Network configuration wizard
sub configure_net_wizard() {
  # Bridged Networking
  if (db_get_answer('NETWORKING') eq 'yes' && count_bridged_networks() == 0) {
    # Make a default one unless it exists already
    my $free = $gDefBridged;
    configure_bridged_net($free, 'vmnet' . $free);
  }

  while ($#gAvailEthIf > -1) {
    show_net_config(1, 0, 0);
    if (get_answer('Do you wish to configure another bridged network? '
                   . '(yes/no)', 'yesno', 'no') eq 'no') {
      last;
    }
    my $free = get_free_network();
    configure_bridged_net($free, 'vmnet' . $free);
  }

  # NAT networking
  configure_nat_net($gDefNat, 'vmnet' . $gDefNat);

  # Host only networking
  my $hostonly = (count_hostonly_networks() > 0 ? 'yes' : 'no');
  $hostonly = get_answer('Do you want to be able to use host-only networking '
                         . 'in your virtual machines?', 'yesno', $hostonly);

  if ($hostonly eq 'yes' && count_hostonly_networks() == 0) {
    my $free = $gDefHostOnly;
    configure_hostonly_net($free, 'vmnet' . $free, 1, 0);
  } elsif ($hostonly  eq 'no') {
    remove_all_networks(0, 1, 0);
  }

  if ($hostonly eq 'yes') {
    while (1) {
      show_net_config(0, 1, 0);
      if (get_answer('Do you wish to configure another host-only network? '
                     . '(yes/no)', 'yesno', 'no') eq 'no') {
        last;
      }
      my $free = get_free_network();
      configure_hostonly_net($free, 'vmnet' . $free, 1, 0);
    }
  }
}

# Network configuration editor
sub configure_net_editor() {
  my $answer = 'yes';
  my $first_time = 1;
  while ($answer ne 'no') {
    show_net_config(1, 1, 1);

    if (!$first_time) {
      $answer = get_answer('Do you wish to make additional changes to the '
                           . 'current virtual networks settings? (yes/no)',
                           'yesno', 'no');
    } else {
      $answer = get_answer('Do you wish to make any changes to the current '
                           . 'virtual networks settings? (yes/no)',
                           'yesno', 'no');
      $first_time = 0;
    }
    if ($answer eq 'no') {
      last;
    }

    my $vHubNr = get_answer('Which virtual network do you wish to configure? '
                            . '(' . $gMinVmnet . '-' . $gMaxVmnet . ')',
                            'vmnet', '');

    if ($vHubNr == $gDefBridged) {
      if (get_answer('The network vmnet' . $vHubNr . ' has been reserved for '
                     . 'a bridged network.  You may change it, but it is '
                     . 'highly recommended that you use it as a bridged '
                     . 'network.  Are you sure you want to modify it? '
                     . '(yes/no)', 'yesno', 'no') eq 'no') {
        next;
      }
    }

    if ($vHubNr == $gDefHostOnly) {
      if (get_answer('The network vmnet' . $vHubNr . ' has been reserved for '
                     . 'a host-only network.  You may change it, but it is '
                     . 'highly recommended that you use it as a host-only '
                     . 'network.  Are you sure you want to modify it? '
                     . '(yes/no)', 'yesno', 'no') eq 'no') {
        next;
      }
    }

    if ($vHubNr == $gDefNat) {
      if (get_answer('The network vmnet' . $vHubNr . ' has been reserved for '
                     . 'a NAT network.  You may change it, but it is highly '
                     . 'recommended that you use it as a NAT network.  Are '
                     . 'you sure you want to modify it? (yes/no)',
                     'yesno', 'no') eq 'no') {
        next;
      }
    }

    my $nettype = 'none';
    if (is_bridged_network($vHubNr)) {
      $nettype = 'bridged';
    } elsif (is_hostonly_network($vHubNr)) {
      $nettype = 'hostonly';
    } elsif (is_nat_network($vHubNr)) {
      $nettype = 'nat';
    }
    $answer = get_answer('What type of virtual network do you wish to set '
                         . 'vmnet' . $vHubNr . '? (bridged,hostonly,nat,none)',
                         'nettype', $nettype);

    if ((not ($answer eq 'hostonly')) && is_samba_running($vHubNr)) {
      if (get_answer('Samba is being run on this virtual network.  Changing '
                     . 'the settings of this network may prevent you from '
                     . 'sharing the ' . $os . '\'s filesystem. Are you sure '
                     . 'you want to change this network? (yes/no)',
                     'yesno', 'no') eq 'no') {
        next;
      }
    }

    if ($answer eq 'bridged') {
      # Special case: if we are changing a bridge network to another
      # bridge network, we need to make the interface that it used to
      # be defined as the correct one again.
      if (is_bridged_network($vHubNr)) {
        add_ethif_info(db_get_answer('VNET_' . $vHubNr . '_INTERFACE'));
      }
      configure_bridged_net($vHubNr, 'vmnet' . $vHubNr);
      # Reload available ethernet info in case user does make a change
      load_ethif_info();
    } elsif ($answer eq 'hostonly') {
      my $samba = is_samba_running($vHubNr);
      configure_hostonly_net($vHubNr, 'vmnet' . $vHubNr, 1, $samba);
    } elsif ($answer eq 'nat') {
      configure_nat_net($vHubNr, 'vmnet' . $vHubNr);
    } elsif ($answer eq 'none') {
      remove_net($vHubNr, 'vmnet' . $vHubNr);
    }
  }
}

# Configure networking automatically with no input from the user, keeping the
# existing settings.
sub make_all_net() {
  my $vHubNr;
  for ($vHubNr = $gMinVmnet; $vHubNr <= $gMaxVmnet; $vHubNr++) {
    if (is_bridged_network($vHubNr)) {
      my $ethIf = db_get_answer('VNET_' . $vHubNr . '_INTERFACE');
      make_bridged_net($vHubNr, 'vmnet' . $vHubNr, $ethIf);
    } elsif (is_hostonly_network($vHubNr)) {
      my $hostaddr = db_get_answer('VNET_' . $vHubNr . '_HOSTONLY_HOSTADDR');
      my $netmask = db_get_answer('VNET_' . $vHubNr . '_HOSTONLY_NETMASK');
      my $subnet = compute_subnet($hostaddr, $netmask);
      my $samba = is_samba_running($vHubNr);
      make_hostonly_net($vHubNr, 'vmnet' . $vHubNr, $subnet, $netmask, 1,
                        $samba);
    } elsif (is_nat_network($vHubNr)) {
      my $hostaddr = db_get_answer('VNET_' . $vHubNr . '_HOSTONLY_HOSTADDR');
      my $netmask = db_get_answer('VNET_' . $vHubNr . '_HOSTONLY_NETMASK');
      my $subnet = compute_subnet($hostaddr, $netmask);
      make_nat_net($vHubNr, 'vmnet' . $vHubNr, $subnet, $netmask);
    }
  }
}

# Counts the number of bridged networks
sub count_bridged_networks {
  return count_networks(1, 0, 0, 0);
}

# Counts the number of hostonly networks
sub count_hostonly_networks {
  return count_networks(0, 1, 0, 0);
}

# Counts the number of hostonly networks running samba
sub count_samba_networks {
  return count_networks(0, 1, 0, 1);
}

# Counts the number of hostonly networks running NAT
sub count_nat_networks {
  return count_networks(0, 0, 1, 0);
}

# Counts the number of configured virtual networks
sub count_all_networks {
  return count_networks(1, 1, 1, 0);
}

# Counts the number of virtual networks that have been setup.
# bridged: Set to indicate a desire to count the number of bridged networks
# hostonly: Set to indicate a desire to count the number of hostonly networks
# nat: Set to indicate a desire to count the number of nat networks
# samba: Set to indicate a desire to count the number of hostonly networks
#        running Samba.
sub count_networks {
  my $bridged = shift;
  my $hostonly = shift;
  my $nat = shift;
  my $samba = shift;

  my $i;
  my $count = 0;
  for ($i = $gMinVmnet; $i <= $gMaxVmnet; $i++) {
    if (is_bridged_network($i) && $bridged) {
      $count++;
    } elsif (is_hostonly_network($i) && $hostonly) {
      if ($samba && is_samba_running($i)) {
        $count++;
      } elsif (!$samba) {
        $count++;
      }
    } elsif (is_nat_network($i) && $nat) {
      $count++;
    }
  }

  return $count;
}

# Indicates if a virtual network has been defined on this virtual net
sub is_network {
  my $vHubNr = shift;

  return    is_bridged_network($vHubNr)
         || is_hostonly_network($vHubNr)
         || is_nat_network($vHubNr);
}

# Indicates if a bridged virtual network is defined for a particular vnet
sub is_bridged_network {
  my $vHubNr = shift;
  my $bridged_ethIf = $gDBAnswer{'VNET_' . $vHubNr . '_INTERFACE'};

  return defined($bridged_ethIf);
}

# Indicates if a hostonly virtual network is defined for a particular vnet
sub is_hostonly_network {
  my $vHubNr = shift;
  my $hostonly_hostaddr = $gDBAnswer{'VNET_' . $vHubNr . '_HOSTONLY_HOSTADDR'};
  my $hostonly_netmask = $gDBAnswer{'VNET_' . $vHubNr . '_HOSTONLY_NETMASK'};
  my $nat_network = $gDBAnswer{'VNET_' . $vHubNr . '_NAT'};

  return    defined($hostonly_hostaddr)
         && defined($hostonly_netmask)
         && not (defined($nat_network) && $nat_network eq 'yes');
}

# Indicates if a NAT virtual network is defined for a particular vnet
sub is_nat_network {
  my $vHubNr = shift;
  my $nat_hostaddr = $gDBAnswer{'VNET_' . $vHubNr . '_HOSTONLY_HOSTADDR'};
  my $nat_netmask = $gDBAnswer{'VNET_' . $vHubNr . '_HOSTONLY_NETMASK'};
  my $nat_network = $gDBAnswer{'VNET_' . $vHubNr . '_NAT'};

  return    defined($nat_hostaddr)
         && defined($nat_netmask)
         && defined($nat_network) && $nat_network eq 'yes';
}

# Indicates if samba is running on a virtual network
sub is_samba_running {
  my $vHubNr = shift;
  my $hostonly = is_hostonly_network($vHubNr);
  my $samba = $gDBAnswer{'VNET_' . $vHubNr . '_SAMBA'};

  return    $hostonly
         && defined($samba) && $samba eq 'yes';
}

# Gets a free virtual network number.  Gets the lowest number available.
# Returns -1 on failure.
sub get_free_network {
  my $i;
  for ($i = $gMinVmnet; $i <= $gMaxVmnet; $i++) {
    if (grep($i == $_, @gReservedVmnet)) {
      next;
    }
    if (!is_network($i)) {
      return $i;
    }
  }

  return -1;
}

# Removes a bridged network
sub remove_bridged_network {
  my $vHubNr = shift;
  my $vHostIf = shift;

  if ($vHubNr < $gMinVmnet || $vHubNr > $gMaxVmnet) {
    return;
  }

  print wrap('Removing a bridged network for vmnet' . $vHubNr . '.' . "\n\n",
             0);
  db_remove_answer('VNET_' . $vHubNr . '_INTERFACE');
  if ($vHubNr >= $gNumVmnet) {
    uninstall_file('/dev/' . $vHostIf);
  }

  # Reload the list of available ethernet adapters
  load_ethif_info();
}

# Removes a hostonly network
sub remove_hostonly_network {
  my $vHubNr = shift;
  my $vHostIf = shift;
  my $vmnet_dir = $gRegistryDir . '/' . $vHostIf;

  if ($vHubNr < $gMinVmnet || $vHubNr > $gMaxVmnet) {
    return;
  }

  print wrap('Removing a host-only network for vmnet' . $vHubNr . '.' . "\n\n",
             0);
  # Remove the samba things
  unmake_samba_net($vHubNr, $vHostIf);

  db_remove_answer('VNET_' . $vHubNr . '_HOSTONLY_HOSTADDR');
  db_remove_answer('VNET_' . $vHubNr . '_HOSTONLY_NETMASK');
  uninstall_prefix($vmnet_dir);

  if ($vHubNr >= $gNumVmnet) {
    uninstall_file('/dev/' . $vHostIf);
  }
}

# Removes a NAT network
sub remove_nat_network {
  my $vHubNr = shift;
  my $vHostIf = shift;
  my $vmnet_dir = $gRegistryDir . '/' . $vHostIf;

  if ($vHubNr < $gMinVmnet || $vHubNr > $gMaxVmnet) {
    return;
  }

  print wrap('Removing a NAT network for vmnet' . $vHubNr . '.' . "\n\n", 0);

  db_remove_answer('VNET_' . $vHubNr . '_NAT');
  db_remove_answer('VNET_' . $vHubNr . '_HOSTONLY_HOSTADDR');
  db_remove_answer('VNET_' . $vHubNr . '_HOSTONLY_NETMASK');
  uninstall_prefix($vmnet_dir);

  if ($vHubNr >= $gNumVmnet) {
    uninstall_file('/dev/' . $vHostIf);
  }
}

# Removes a network
sub remove_net {
  my $vHubNr = shift;
  my $vHostIf = shift;
  if (is_bridged_network($vHubNr)) {
    remove_bridged_network($vHubNr, $vHostIf);
  } elsif (is_hostonly_network($vHubNr)) {
    remove_hostonly_network($vHubNr, $vHostIf);
  } elsif (is_nat_network($vHubNr)) {
    remove_nat_network($vHubNr, $vHostIf);
  }
}

# Removes all networks on the system subject to the following
# types
sub remove_all_networks {
  my $bridged = shift;
  my $hostonly = shift;
  my $nat = shift;
  my $i;

  for ($i = $gMinVmnet; $i <= $gMaxVmnet; $i++) {
    if (is_network($i)) {
      if ($bridged && is_bridged_network($i)) {
        remove_bridged_network($i, 'vmnet' . $i);
      }
      if ($hostonly && is_hostonly_network($i)) {
        remove_hostonly_network($i, 'vmnet' . $i);
      }
      if ($nat && is_nat_network($i)) {
        remove_nat_network($i, 'vmnet' . $i);
      }
    }
  }
}

# Loads ethernet interface info into global variable
sub load_all_ethif_info() {
  # Get the list of available ethernet interfaces
  # The -a is important because it lists all interfaces (not only those
  # which are up).  The vmnet driver knows how to deal with down interfaces.
  open(IFCONFIG, shell_string($gHelper{'ifconfig'}) . ' -a |');
  @gAllEthIf = ();
  while (<IFCONFIG>) {
    if (/^eth\d+\s+[^:]/) {
      my @fields;

      @fields = split(/[ ]+/);
      push(@gAllEthIf, $fields[0]);
    }
  }
  close(IFCONFIG);
}

# Determines the available ethernet interfaces
sub load_ethif_info() {
  # Get the list of available ethernet interfaces by checking the all
  # list and removing the ones that have already been allocated.
  @gAvailEthIf = ();

  my @usedEthIf = grep(/^VNET_\d+_INTERFACE$/, keys(%gDBAnswer));
  @usedEthIf = map($gDBAnswer{$_}, @usedEthIf);

  my $eth;
  foreach $eth (@gAllEthIf) {
    if (!grep($_ eq $eth, @usedEthIf)) {
      push(@gAvailEthIf, $eth);
    }
  }
}

# Adds an ethernet interface to the working list of ethernet interfaces
sub add_ethif_info {
  my $eth = shift;
  push(@gAvailEthIf, $eth);
}

# Install a pair of S/K startup scripts for a given runlevel
sub link_runlevel {
   my $level = shift;
   my $service = shift;
   my $S_level = shift;
   my $K_level = shift;

   #
   # Create the S symlink
   #

   install_symlink(db_get_answer('INITSCRIPTSDIR') . '/' . $service,
                   db_get_answer('INITDIR') . '/rc' . $level . '.d/S'
                   . $S_level . $service);

   #
   # Create the K symlink
   #

   # Note: SuSE 6.0 handles startup scripts differently (I actually like it).
   # When entering a new runlevel, K* programs of the _old_ runlevel are
   # executed instead of those of the new runlevel
   if (not ($gSystem{'distribution'} eq 'suse')) {
      # Kill the services in the reboot runlevel
      $level = 6;
   }
   install_symlink(db_get_answer('INITSCRIPTSDIR') . '/' . $service,
                   db_get_answer('INITDIR') . '/rc' . $level . '.d/K'
                   . $K_level . $service);
}

# Create the links for VMware's services taking the service name and the
# requested levels
sub link_services {
  my @fields;
  my $service = shift;
  my $S_level = shift;
  my $K_level = shift;

  # Create the links the LSB way when possible
  if (not ($gHelper{'insserv'} eq '')) {
    if (system(shell_string($gHelper{'insserv'}) . ' '
               . shell_string(db_get_answer('INITSCRIPTSDIR') 
                              . '/' . $service))
          == 0) {
      return;
    }
  }

  # If it is not possible, do it by hand
  @fields = split(/:/, direct_command(
    shell_string($gHelper{'grep'}) . ' '
    . shell_string('^[ ' . "\t" . ']*[^#]*:initdefault') . ' /etc/inittab'));
  if (defined($fields[1]) && ($fields[1] =~ /[0123456Ss]/)) {
    link_runlevel($fields[1], $service, $S_level, $K_level);
  } else {
    # Unable to determine the default runlevel
    link_runlevel(2, $service, $S_level, $K_level);
    link_runlevel(3, $service, $S_level, $K_level);
    link_runlevel(5, $service, $S_level, $K_level);
  }
}

# Write the VMware host-wide configuration file
sub write_vmware_config {
  my $name;
  my $promoconfig;

  $name = $gRegistryDir . '/config';

  my $config = new VMware::Config;
  if (file_name_exist($name)) {
    if (!$config->readin($name)) {
      error('Unable to read configuration file "' . $name . '".' . "\n\n");
    }
    db_remove_file($name);
  }

  my $bindir = db_get_answer('BINDIR');
  my $libdir = db_get_answer('LIBDIR');

  $config->set('vmware.fullpath', $bindir . '/vmware');
  $config->set('wizard.fullpath', $bindir . '/vmware-wizard');
  $config->set('dhcpd.fullpath', $bindir . '/vmnet-dhcpd');
  $config->set('loop.fullpath', $bindir . '/vmware-loop');
  $config->set('control.fullpath', $bindir . '/vmware-cmd');
  $config->set('libdir', $libdir);
  if ((vmware_product() eq 'wgs') || (vmware_product() eq 'server')) {
    $config->set('authd.client.port', db_get_answer('AUTHDPORT'));
  }
  my $vHubNr;
  for ($vHubNr = $gMinVmnet; $vHubNr <= $gMaxVmnet; $vHubNr++) {
    if (is_hostonly_network($vHubNr)) {
      my $hostaddr = db_get_answer('VNET_' . $vHubNr  . '_HOSTONLY_HOSTADDR');
      my $netmask = db_get_answer('VNET_' . $vHubNr  . '_HOSTONLY_NETMASK');
      # Used by the Linux wizard to determine if a hostonly network is
      # configured.
      # XXX It's misleading to put this information into the config file since
      #     modifying this config option won't actually change the subnet that
      #     the hostonly network is using -jhu
      #     I'm not so sure anymore. I have seen it used --hpreg
      $config->set('vmnet' . $vHubNr . '.HostOnlyAddress', $hostaddr);
      $config->set('vmnet' . $vHubNr . '.HostOnlyNetMask', $netmask);
    } else {
      $config->remove('vmnet' . $vHubNr . '.HostOnlyAddress');
      $config->remove('vmnet' . $vHubNr . '.HostOnlyNetMask');
    }
  }
  # Used by the Linux wizard to determine if Samba is configured on the
  # hostonly network.
  if (defined($gDBAnswer{'NETWORKING'}) && get_samba_net() != -1) {
    $config->set('smbpasswd.fullpath', $bindir . '/vmware-smbpasswd');
  } else {
    $config->remove('smbpasswd.fullpath');
  }
  if ((vmware_product() eq 'wgs') || (vmware_product() eq 'server')) {
    my $sbindir = db_get_answer('SBINDIR');
    $config->set('authd.fullpath', $sbindir . '/vmware-authd');
    $config->set('serverd.fullpath', $sbindir . '/vmware-serverd');
    $config->set('serverd.init.fullpath', $libdir . '/serverd/init.pl');
  } else {
    $config->remove('authd.fullpath');
    $config->remove('serverd.fullpath');
    $config->remove('serverd.init.fullpath');
  }

  if (!$config->writeout($name)) {
    error('Unable to write configuration file "' . $name . '".' . "\n\n");
  }
  db_add_file($name, 0x1);
  safe_chmod(0644, $name);

  # Append the promotional configuration if it exists
  $promoconfig = $libdir . '/configurator/PROMOCONFIG';
  if (-e $promoconfig) {
    my %patch;

    undef %patch;
    internal_sed($promoconfig, $name, 1, \%patch);
  }
}

# Display the PROMOCODE information
sub show_PROMOCODE {
  my $promocode;

  $promocode = db_get_answer('DOCDIR') . '/PROMOCODE';
  if (-e $promocode) {
    # $gHelper{'more'} is already a shell string
    system($gHelper{'more'} . ' ' . shell_string($promocode));
    print "\n";
  }
}

# If needed, allow the sysadmin to unlock a site wide license. This must be
# called _after_ VMware's config file has been written
sub check_license {
  my $want_sn;

  if (system(shell_string(vmware_vmx_app_name())
             . ' --can-run')) {
    $want_sn = 'yes';
  } else {
    for (;;) {
      $want_sn = get_answer('Do you want to enter a serial number now? '
                            . '(yes/no/help)', 'yesnohelp', 'no');
      if (not ($want_sn eq 'help')) {
        last;
      }

      print wrap('Answer "yes" if you have received a new serial number. '
                 . 'Otherwise answer "no", and ' . vmware_product_name()
                 . ' will continue to run just fine.' . "\n\n", 0);
    }
  }

  if ($want_sn eq 'yes') {
    if (system(shell_string(vmware_vmx_app_name())
               . ' --new-sn')) {
      error(vmware_product_name() . ' cannot be used unless a valid serial '
            . 'number is provided. To provide a serial number to '
            . vmware_product_name() . ', please re-run this program.'
            . "\n\n");
    }
  }
}

# Display a usage error message for the configuration program and exit
sub config_usage {
  if ((vmware_product() eq 'mui') || (vmware_product eq 'console')) {
    print STDERR wrap(vmware_longname() . 'configurator' . "\n" .
                      'Usage: ' . $0 . ' [[-][-]d[default]]' . "\n" .
                      'default: Automatically answer questions with the ' .
                      'proposed answer.' . "\n\n", 0);
  } else {
    print STDERR wrap(vmware_longname() . ' configurator' . "\n" . 'Usage: '
                      . $0 . ' [[-][-]d[efault]] [[-][-]c[ompile]] '
                      . '[[-][-]p[rebuilt]]' . ' [[-][-]t[ry-modules]]'
                      . "\n" . '. default: Automatically '
                      . 'answer questions with the proposed answer.' . "\n"
                      . '. compile: Force the compilation of kernel modules.'
                      . "\n" . '. prebuilt: Force the use of pre-built kernel '
                      . 'modules.' . "\n"
                      . '. try-modules: Try to load all the compatible modules '
                      . 'from the ' . vmware_product_name() . ' package.'
                      . "\n\n", 0);
  }
  exit 1;
}

# Stop the old run of the mui during uninstall
sub stop_mui {
  my $installDir = db_get_answer('INSTALLDIR');
  if (-e "$installDir/apache/bin") {
    system(shell_string($installDir) . '/apache/bin/apachectl stop '
           . '> /dev/null 2>&1');
  }
}

# Check for existence of httpd dependencies
# XXX: Basically a hack for RH 8.0 since it doesnt have a package that
# is needed for httpd (libdb.so.3) installed by default.
sub check_depends {
  my $executable = shift;
  # If it doesnt work, we will ignore the error and hope for the best 
  # since we dont want to muck any working system with ldd not available
  if (open(LDDIN, "ldd $executable |")) {
    while (<LDDIN>) {
      if (/libdb\.so\.3\s*=>\s*not found/) {
        # Uhoh
        print wrap('Couldn\'t find necessary components on your system. '
                   . 'It appears that you are missing the following library:'
                   . ' libdb.so.3' . "\n\n", 0);
        print wrap('New versions of Red Hat Linux (8.0+) are known to ship'
                   . ' without these libraries. If you are running Red Hat 8.0'
                   . ' or greater, please install this rpm:'
                   . ' compat-db-3.3-<###>  rpm (where <###> is a version'
                   . ' number particular to your version of the distribution)'
                   . ' from your installation CDs'. "\n\n", 0);
        print wrap('If you are running a distribution other than Red Hat,'
                   . ' please contact your vendor for a suitable library.'
                   . "\n", 0);
        return 0;
      }
    }
    close(LDDIN);
  }
  return 1;
}

# Start the http process up
sub start_mui {
  my $installDir = db_get_answer('INSTALLDIR');
  if (-e "$installDir/apache/bin") {
    if (check_depends("$installDir/apache/bin/httpd")) {
      system(shell_string("$installDir") . '/apache/bin/apachectl start');
      return 1;
    } else {
      print wrap('Once the package has been installed, you may start the '
                 . vmware_product_name() . ' with the following command:'
                 . "\n", 0);
      print wrap("$installDir" . '/apache/bin/apachectl start' . "\n\n", 0);

    }
  } else {
    error('Cannot find the Apache instance for this install in : "' 
          . shell_string($installDir) . '/apache/bin/apachectl' . "\n"
         . 'Failed to start' .  "\n");
  }
  return 0;
}

# Configure the mui
sub configure_mui {
  my $program;
  my @modFiles       = (
                        "apache/conf/httpd.conf",
                        "apache/conf/access.conf",
                        "apache/conf/setup.pl",
                        "apache/bin/apachectl",
                        "apache/bin/apxs",
                        "lib/perl5/site_perl/5.005/VMware/Management/Overview.pm",
                        "lib/perl5/site_perl/5.005/VMware/HConfig/Constant.pm",
                        "lib/httpd.vmware"
                       );
  stop_mui();

  # Find the programs we need to go ahead with the install
  foreach $program ('rm', 'vmware', 'hostname', 'cp', 'mkdir') {
    if (not defined($gHelper{$program})) {
      $gHelper{$program} = DoesBinaryExist_Prompt($program);
      if ($gHelper{$program} eq '') {
        error('Unable to continue.' . "\n\n");
      }
    }
  }
  # We have to modify the files in the install package to replace place-holders
  # with real values
  updateMuiFiles(\@modFiles);
  # Set the correct user for apache to run as
  findNobody();
  # Create the service links
  updateInitdir();
  # set timeout for httpd
  setTimeout();
  # Start your engines
  if (start_mui()) {
    print wrap("\n" . 'Installation of ' . vmware_product_name()
               . ' was successful' . "\n\n", 0);
  }
}

# set the timeout for session expiry in our httpd (PR 8636)
sub setTimeout {
  my $installDir = db_get_answer('INSTALLDIR');
  my $accessConf = $installDir . "/apache/conf/access.conf";
  my $accessConfSrc = $installDir . "/src/apache/conf/access.conf";
  my $currentTimeout;
  my $defaultTimeout = 60;
  my $refPatch;

  if (not open(CONF, '<' . $accessConf)) {
    print wrap('Couldnt open "' . $accessConf . '" for reading.'
               . ' Not modifying the default timeout value.' . "\n\n",0);
    return;
  }
  while (<CONF>) {
    if (/^\s*PerlSetEnv\s*vmware_SESSION_LENGTH\s*(\d+)\s*$/) {
      $currentTimeout = $1;
    }
  }
  close(CONF);
  my $newTimeout = 
    get_persistent_answer('Set the number of minutes before a http session'
                          . ' times out. (This is the '
                          . 'length of time before someone connecting to '
                          . vmware_product_name() . ' will be logged out)'
                          , 'TIMEOUT', 'timeout'
                          , $defaultTimeout);

  $refPatch = updateMuiFiles();
  $$refPatch{"PerlSetEnv vmware_SESSION_LENGTH $currentTimeout"} =
    "PerlSetEnv vmware_SESSION_LENGTH $newTimeout";
  # install the modified file
  install_file($accessConfSrc, $accessConf, $refPatch, 0x1);
}

#Update the place-holders in the MUI files with installation values
sub updateMuiFiles {
  my $refModFiles = shift;
  my $vmware_version;
  my $inst_dir       = db_get_answer('INSTALLDIR');
   my $iter;
  my $srcFile;
  my $destFile;
  my $dir;
  my %patch;

  # Find whether this is an install of gsx or esx
  $vmware_version = 
    direct_command(shell_string($gHelper{"vmware"}) . ' -v 2>&1 < /dev/null');
  if ($vmware_version =~ /.*VMware\s*(\S+)\s*Server.*/) {
    $vmware_version = $1;
  }
  if ($vmware_version ne "GSX" && $vmware_version ne "ESX") {
    error('The server product must be installed on this machine for the '
          . vmware_product_name() . ' to work' . "\n\n");
  }

  my $hostname = direct_command(shell_string($gHelper{"hostname"}));
  chomp($hostname);
  my $portOption = ($vmware_version eq "GSX") ? "-DGSX"
    : "-DSTANDARD_PORTS -DESX";
  my $sslByDefault =  ($vmware_version eq "GSX") ? ""
    : "-DSSL_ONLY";
  my $initDir = db_get_answer('INITSCRIPTSDIR');
  undef %patch;
  $patch{"\@\@PREFIX\@\@"} = $inst_dir;
  $patch{"\@\@HOSTNAME\@\@"} = $hostname;
  $patch{"\@\@PORT_OPTION\@\@"} = $portOption;
  $patch{"\@\@DEFAULT_SSL\@\@"} = $sslByDefault;
  $patch{"\@\@INITDIR\@\@"} = $initDir;
  if (defined($refModFiles)) {
    foreach $iter (@$refModFiles) {
      $srcFile = "$inst_dir/src/$iter";
      $destFile = "$inst_dir/$iter";
      # install the modified file
      install_file($srcFile, $destFile, \%patch, 0x1); 
    }
  }
  return \%patch;
}

# Find an init dir update with our apache startup info.
sub updateInitdir {
  my $dir;
  my $initDir = "";
  my $initDirRoot = "";
  my $temp_dir;
  my $instDir = db_get_answer('INSTALLDIR');
  my %patch;

  $initDir = db_get_answer('INITDIR');
  $initDirRoot = db_get_answer('INITSCRIPTSDIR');
  undef %patch;
  install_file("$instDir/lib/httpd.vmware", "$initDirRoot/httpd.vmware"
               , \%patch, 0x1);

  link_services("httpd.vmware", "91", "08");

  if (system("chmod 755 $initDirRoot/httpd.vmware")) {
    error(" chmod fails:\n  chmod 755 $initDirRoot/httpd.vmware\n\n");
  }
}

# Find the www/apache/web user & group
sub findNobody {
  my $pw    = "/etc/passwd";
  my $gf    = "/etc/group";
  my @ulist = ("nobody", "wwwrun", "nouser", "www-data", "www");
  my @glist = ("nobody", "nogroup", "www");
  my $user  = undef;
  my $group = undef;
  my $i;
  my $instDir = db_get_answer('INSTALLDIR');

  # Deal with USER
  $user = db_get_answer_if_exists('USER');
  if (not defined $user) {
    foreach $i (@ulist) {
      $user = $i if (not system(shell_string($gHelper{'grep'})
                                . " ^$i"
                                . ": $pw > /dev/null 2>&1"));
    }
  }


  if (not defined $user) {
    print wrap('The installer cant find a username that will run the web server'
               . '. Please enter one now.  Make sure to add this user to '
               . "'$pw'." . ' Be aware the the ' . vmware_product_name() 
               . ' web server wont start correctly until you add this user'
               . "\n", 0);
    $user = get_persistent_answer('What is the user under whom you would like'
                                  . ' Apache to run?', 'USER', 'usergp'
                                  , 'nobody');
  } else {
    db_add_answer('USER', $user);
  }

  # Deal with GROUP
  $group = db_get_answer_if_exists('GROUP');
  if (not defined $group) {
    foreach $i (@glist) {
      $group = $i if (not system(shell_string($gHelper{'grep'})
                                 . " ^$i: $gf > /dev/null 2>&1"));
    }
  }

  if (not defined $group) {
    print wrap('The installer cant find a group that will run the web'
               . ' server. Please enter one now.  Make sure to add this'
               . ' group to ' . "$gf" . '. Be aware that the '
               . vmware_product_name() . ' web server wont start correctly'
               . ' until you add this group to ' . "$gf" . "\n", 0);
    $group = get_persistent_answer('What is the group under whom you would like'
                                   . ' Apache ro run?', 'GROUP', 'usergp',
                                   'nobody');
  } else {
    db_add_answer('GROUP', $group);
  }

  print wrap('Configuring httpd.conf to run Apache as: ' . "\n" 
           . 'User: ' . "$user" . ' and Group: ' . "$group" . "\n\n", 0);

  #
  #  Section to update our httpd.conf file
  #
  my $srcConf  = "$instDir/src/apache/conf/httpd.conf";
  my $destConf = "$instDir/apache/conf/httpd.conf";

  my $refPatch;
  $refPatch = updateMuiFiles();
  $$refPatch{"^User.*\$"} = "User $user";
  $$refPatch{"^Group.*\$"} = "Group $group";
  install_file($srcConf, $destConf, $refPatch, 0x1);
}

# Configure remote console: Right now, that means configure the port number for authd
sub configure_console {
  my $answer;
  my $name;
  my @lines;

  $name = $gRegistryDir . '/config';

  $answer = get_persistent_answer('What port do you want the remote console '
                                  . 'to use to connect to the server (Only '
                                  . 'change this if you have not used the '
                                  . 'default value during server installation)?',
                                  'AUTHDPORT', 'authdport', $gDefaultAuthdPort);

  # Read the current config file;
  open(CONFIGFILE, $name)
    or error('Unable to open the configuration file ' . $name . ' in read-mode'
             . "\n\n");
  @lines = <CONFIGFILE>;
  close(CONFIGFILE);

  open(WRITECONFIG, '>' . $name)
    or error('Unable to open the configuration file ' . $name . ' in write-mode'
             . "\n\n");
  db_remove_file($name);
  my $line;
  my $fOnce = 0;
  while (@lines) {
    $line = shift @lines;
    if (!($line =~ /^\s*authd\.client\.port\s*=\s*/)) {
      print WRITECONFIG $line;
    } else {
      if (!$fOnce) {
        print WRITECONFIG 'authd.client.port = ' . db_get_answer('AUTHDPORT') 
          . "\n";
        $fOnce = 1;
      }
    }
  }
  close (WRITECONFIG);
  db_add_file($name, 0x1);
  safe_chmod(044, $name);
}

# switch_to_guest
# Sets links on configuration files we changed during configuration.
# If switch_to_host was never called, do nothing.
sub switch_to_guest {
  my %filesBackedUp;
  my $file;

  if (!defined(db_get_answer_if_exists($cSwitchedToHost))) {
    return;
  }

  %filesBackedUp = db_get_files_to_restore();

  foreach $file (keys %filesBackedUp) {
    if (-l $file) {
      if (check_link($file, $file . db_get_answer($cSwitchedToHost)) eq 'yes') {
        return;
      }
      unlink $file;
      symlink $file . db_get_answer($cSwitchedToHost), $file;
    }
  }
}

# switch_to_host
# Saves configuration files we changed during configuration.
# Sets links on configuration files we backed up during configuration.
sub switch_to_host {
  my $configuredExtension = '.AfterVMwareToolsInstall';
  my %filesBackedUp;
  my $file;

  if (!defined(db_get_answer_if_exists($cSwitchedToHost))) {
    db_add_answer($cSwitchedToHost, $configuredExtension);
  }

  %filesBackedUp = db_get_files_to_restore();

  foreach $file (keys %filesBackedUp) {
    if (-l $file) {
      if (check_link($file, $filesBackedUp{$file}) eq 'yes') {
        return;
      }
      unlink $file;
    } else {
      my %patch;
      undef %patch;
      install_file($file, $file . $configuredExtension, \%patch, 0x1);
      unlink $file;
      # The link might change, do not keep the timestamp.
      db_add_file($file, 0);
    }
    symlink $filesBackedUp{$file}, $file;
  }
}

# Tools configurator
sub configure_tools {
  if ($gSystem{'invm'} eq 'no') {
    error('This configuration program is to be executed in a '
               . 'virtual machine.' . "\n\n");
  }
  if (defined $ENV{'DISPLAY'} &&
      $ENV{'DISPLAY'} =~ /^:\d+\.\d+$/) {
    error('This configuration program is to be executed out of an XFree86 '
          . 'session. Please shut down all instances of XFree86.' . "\n\n");
  }
  #
  # Stop VMware's services
  #
  print "\n";
  print wrap('Making sure ' . vmware_product_name() . '\'s services are '
             . 'stopped.' . "\n\n", 0);
  if (!$gOption{'skipstopstart'} &&
      system(shell_string(db_get_answer('INITSCRIPTSDIR') . '/vmware-tools')
             . ' stop')) {
    error('Unable to stop ' . vmware_product_name() . '\'s services.'
          . "\n\n");
  }

  link_services("vmware-tools", "06", "08");

  configure_vmmemctl();
  
  configure_vmhgfs();

  write_module_config();

  configure_X();

  uninstall_file($gConfFlag);

  db_save();
  #
  # Then start VMware's services.
  #
  if (!$gOption{'skipstopstart'} &&
    system(shell_string(db_get_answer('INITSCRIPTSDIR') . '/vmware-tools')
           . ' start')) {
    error('Unable to stop ' . vmware_product_name() . '\'s services.'
          . "\n\n");
  } else {
    print "\n";
  }

  print wrap('The configuration of ' . vmware_longname() . ' for this running '
             . 'kernel completed successfully.' . "\n\n", 0);
  print wrap('You can now run ' . vmware_product_name() . ' by invoking the '
             . 'following command: "' . vmware_tools_app_name() . '" during an '
             . 'XFree86 session.' . "\n\n",
             0);
  print wrap('Enjoy,' . "\n\n" . '    --the VMware team' . "\n\n", 0);
}

# switch_tools_config
# Called by the services.sh startup script.
# This allows a switch of configuration depending if the system is
# booted in a VM or natively.
sub switch_tools_config {
  if ($gSystem{'invm'} eq 'yes') {
    switch_to_guest();
  } else {
    switch_to_host();
  }
  db_save();
}

# Program entry point
sub main {
  my (@setOption, $opt);

  if (not is_root()) {
    error('Please re-run this program as the super user.' . "\n\n");
  }

  # Force the path to reduce the risk of using "modified" external helpers
  # If the user has a special system setup, he will will prompted for the
  # proper location anyway
  $ENV{'PATH'} = '/bin:/usr/bin:/sbin:/usr/sbin';

  initialize_globals();
  if (not (-e $gInstallerMainDB)) {
    error('Unable to find the database file (' . $gInstallerMainDB . ')'
          . "\n\n");
  }
  db_load();
  db_append();
  initialize_external_helpers();

  $gOption{'default'} = 0;
  $gOption{'compile'} = 0;
  $gOption{'prebuilt'} = 0;
  $gOption{'skipstopstart'} = 0;

  # List of questions answered with command-line arguments
  @setOption = ();
  # Command line analysis
  while ($#ARGV != -1) {
     my $arg;

     $arg = shift(@ARGV);
     if (lc($arg) =~ /^(-)?(-)?d(efault)?$/) {
       $gOption{'default'} = 1;
     } elsif (lc($arg) =~ /^(-)?(-)?c(ompile)?$/) {
       $gOption{'compile'} = 1;
     } elsif (lc($arg) =~ /^(-)?(-)?p(rebuilt)?$/) {
       $gOption{'prebuilt'} = 1;
     } elsif (lc($arg) =~ /^(-)?(-)?t(ry-modules)?$/) {
       $gOption{'try-modules'} = 1;
     } elsif (lc($arg) =~ /^(-)?(-)?s(witch)?$/) {
       $gOption{'tools-switch'} = 1;
     } elsif (lc($arg) =~ /^-skipstopstart/) {
       $gOption{'skipstopstart'} = 1;
     } elsif ($arg =~ /=yes/ || $arg =~ /=no/) {
       push(@setOption, $arg);
     } else {
       config_usage();
     }
  }

  if (vmware_product() eq 'mui') {
    $gSystem{'distribution'} = distribution_info();
    configure_mui();
    uninstall_file($gConfFlag);
    db_save();
    exit 0;
  }

  if (vmware_product() eq 'console') {
    configure_console();
    uninstall_file($gConfFlag);
    db_save();
    exit 0;
  }

  if (($gOption{'compile'} == 1) && ($gOption{'prebuilt'} == 1)) {
    print wrap('The "--compile" and "--prebuilt" command line options are '
               . 'mutually exclusive.' . "\n\n", 0);
    config_usage();
  }

  $gFirstModuleBuild = 1;

  # Tools configurator entry point
  if (vmware_product() eq 'tools-for-linux') {
    system_info();
    if ($gOption{'tools-switch'} == 1) {
      switch_tools_config();
    } else {
      configure_tools();
    }
    exit 0;
  }

  # Build the list of all and available ethernet adapters
  # The first list is all the adapters that we have.  The
  # second are ones that we can still be bridged.
  load_all_ethif_info();
  load_ethif_info();

  # Stop VMware's services
  print wrap('Making sure ' . vmware_product_name() . '\'s services are '
             . 'stopped.' . "\n\n", 0);
  if (   (vmware_product() eq 'server')
      && defined($ENV{'PWD'}) && $ENV{'PWD'} =~ "/proc/vmware*") {
    error('Unable to stop ' . vmware_product_name() . '\'s services while in '
          . 'a /proc/vmware directory.' . "\n\n");
  }
  if (!$gOption{'skipstopstart'} &&
      system(shell_string(db_get_answer('INITSCRIPTSDIR') . '/vmware')
             . ' stop')) {
    error('Unable to stop ' . vmware_product_name() . '\'s services.'
          . "\n\n");
  }
  print "\n";

  if (@setOption > 0) {
    $gOption{'default'} = 1;
    # User must specify 'EULA_AGREED=yes' on the command line
    db_add_answer('EULA_AGREED', 'no');
  }
  # Install answers specified on the command line
  foreach $opt (@setOption) {
      my ($key, $val);
      ($key, $val) = ($opt =~ /^([^=]*)=([^=]*)/);
      print $key, ' = ', $val, "\n";
      db_add_answer($key, $val);
  }

  show_EULA();
  system_info();
  if (vmware_product() eq 'wgs') {
    # Check memory requirements for GSX/WGS
    check_wgs_memory();
  }
  if (vmware_product() eq 'server') {
    configure_vmkernel();
  } else {
    configure_mon();
    configure_pp();
  }
  configure_net();
  # Create the directory for the UNIX domain sockets
  create_dir($cConnectSocketDir, 0x1);
  safe_chmod(01777, $cConnectSocketDir);

  if ((vmware_product() ne 'wgs') && (vmware_product() ne 'server')) {
    configure_samba();
  }
  if ((vmware_product() eq 'wgs') || (vmware_product() eq 'server')) {
    configure_wgs();
    configure_security();
  }
  if (vmware_product() eq 'wgs') {
    configure_serverd();
  }

  # We want VMware to start before samba.  If this becomes messy in the future
  # we will probably have to dynamically determine the right priority to use
  # based on dependancies on other services as we do in the tools install
  my $S_priority;
  if ($gSystem{'distribution'} eq 'suse') {
      # samba is 20 SuSE
    $S_priority = '19';
  } else {
    # samba is 91 on RedHat
    $S_priority = '90';
  }
  link_services("vmware", $S_priority, "08");
  write_vmware_config();
  if ((vmware_product() eq 'wgs') || (vmware_product() eq 'server')) {
    # This must come after write_vmware_config()
    check_license();
  }
  # Remove the flag _before_
  uninstall_file($gConfFlag);
  db_save();
  # Then start VMware's services
  if (!$gOption{'skipstopstart'}) {
    system(shell_string(db_get_answer('INITSCRIPTSDIR') . '/vmware') . ' start');
    print "\n";
  }

  my $vHubNr;
  for ($vHubNr = $gMinVmnet; $vHubNr <= $gMaxVmnet; $vHubNr++) {
    if (is_samba_running($vHubNr)) {
      configure_samba_users($vHubNr, 'vmnet' . $vHubNr);
    }
  }

  show_PROMOCODE();

  print wrap('The configuration of ' . vmware_longname() . ' for this running '
             . 'kernel completed successfully.' . "\n\n", 0);
  if ((vmware_product() ne 'wgs') && (vmware_product() ne 'server')) {
    print wrap('You can now run ' . vmware_product_name() . ' by invoking the '
               . 'following command: "' . db_get_answer('BINDIR') . '/vmware".'
               . "\n\n", 0);
    print wrap('Enjoy,' . "\n\n" . '    --the VMware team' . "\n\n", 0);
  }
  exit(0);
}

main();
