#!/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.
#
# Tar package manager for VMware

use strict;

# Needed to access $Config{...}, the Perl system configuration information.
use Config;

# Constants
my $cInstallerFileName = 'vmware-install.pl';
my $cModuleUpdaterFileName = 'install.pl';
my $cInstallerDir = './installer';
my $cStartupFileName = $cInstallerDir . '/services.sh';
my $cRegistryDir = '/etc/vmware';
my $cInstallerMainDB = $cRegistryDir . '/locations';
my $cInstallerObject = $cRegistryDir . '/installer.sh';
my $cConfFlag = $cRegistryDir . '/not_configured';
my $gDefaultAuthdPort = 902;
my $cServices = '/etc/services';
my $cMarkerBegin = "# Beginning of the block added by the VMware software\n";
my $cMarkerEnd = "# End of the block added by the VMware software\n";

# External helper programs
my %gHelper;

# Has the uninstaller been installed?
my $gIsUninstallerInstalled;

# BEGINNING OF THE SECOND LIBRARY FUNCTIONS
# Global variables
my $gRegistryDir;
my $gStateDir;
my $gInstallerMainDB;
my $gInstallerObject;
my $gConfFlag;
my $gUninstallerFileName;
my $gConfigurator;

my %gDBAnswer;
my %gDBFile;
my %gDBDir;
my %gDBLink;
my %gDBMove;

# Load the installer database
sub db_load {
  undef %gDBAnswer;
  undef %gDBFile;
  undef %gDBDir;
  undef %gDBLink;
  undef %gDBMove;

  open(INSTALLDB, '<' . $gInstallerMainDB)
    or error('Unable to open the installer database '
             . $gInstallerMainDB . ' in read-mode.' . "\n\n");
  while (<INSTALLDB>) {
    chomp;
    if (/^answer (\S+) (.+)$/) {
      $gDBAnswer{$1} = $2;
    } elsif (/^answer (\S+)/) {
      $gDBAnswer{$1} = '';
    } elsif (/^remove_answer (\S+)/) {
      delete $gDBAnswer{$1};
    } elsif (/^file (.+) (\d+)$/) {
      $gDBFile{$1} = $2;
    } elsif (/^file (.+)$/) {
      $gDBFile{$1} = 0;
    } elsif (/^remove_file (.+)$/) {
      delete $gDBFile{$1};
    } elsif (/^directory (.+)$/) {
      $gDBDir{$1} = '';
    } elsif (/^remove_directory (.+)$/) {
      delete $gDBDir{$1};
    } elsif (/^link (\S+) (\S+)/) {
      $gDBLink{$2} = $1;
    } elsif (/^move (\S+) (\S+)/) {
      $gDBMove{$2} = $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 can not 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 {
      chop($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;

  $answer = check_answer_binpath($bin, 'default');
  if (not ($answer eq '')) {
    return $answer;
  }

  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 '';
  }

  return get_answer('What is the location of the "' . $bin . '" program on your machine?', 'binpath', '');
}

# 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;
          }
        }
      }
      next if ($del);
      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 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;
    }
    if ($gOption{'default'} == 1) {
      error('Invalid default answer!' . "\n");
    }
  }
}

# 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);
}

# 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)) {
      error('Unable to remove the file "' . $file . '".' . "\n");
    } else {
      db_remove_file($file);
    }

  } 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);
}

# Return the version of VMware
sub vmware_version {
  my $buildNr;

  $buildNr = 'e.x.p build-20925';
  return remove_whitespaces($buildNr);
}

# 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);
}

sub is64BitUserland {
  if ($Config{archname} =~ /^(x86_64|amd64)-/) {
    return 1;
  } else {
    return 0;
  }
}

# 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


# Append a clearly delimited block to an unstructured text file --hpreg
# Result:
#  1 on success
#  -1 on failure
sub block_append {
   my $file = shift;
   my $begin = shift;
   my $block = shift;
   my $end = shift;

   if (not open(BLOCK, '>>' . $file)) {
      return -1;
   }

   print BLOCK $begin . $block . $end;

   if (not close(BLOCK)) {
      return -1;
   }

   return 1;
}


# Remove all clearly delimited blocks from an unstructured text file --hpreg
# Result:
#  >= 0 number of blocks removed on success
#  -1 on failure
sub block_remove {
   my $src = shift;
   my $dst = shift;
   my $begin = shift;
   my $end = shift;
   my $count;
   my $state;

   if (not open(SRC, '<' . $src)) {
      return -1;
   }

   if (not open(DST, '>' . $dst)) {
      close(SRC);
      return -1;
   }

   $count = 0;
   $state = 'outside';
   while (<SRC>) {
      if      ($state eq 'outside') {
         if ($_ eq $begin) {
            $state = 'inside';
            $count++;
         } else {
            print DST $_;
         }
      } elsif ($state eq 'inside') {
         if ($_ eq $end) {
            $state = 'outside';
         }
      }
   }

   if (not close(DST)) {
      close(SRC);
      return -1;
   }

   if (not close(SRC)) {
      return -1;
   }

   return $count;
}


# Emulate a simplified basename program
sub internal_basename {
  return substr($_[0], rindex($_[0], '/') + 1);
}

# Set the name of the main /etc/vmware* directory.
sub initialize_globals {
  if (vmware_product() eq 'console') {
    $gRegistryDir = '/etc/vmware-console';
    $gUninstallerFileName = 'vmware-uninstall-console.pl';
    $gConfigurator = 'vmware-config-console.pl';
  } elsif (vmware_product() eq 'api') {
    $gRegistryDir = '/etc/vmware-api';
    $gUninstallerFileName = 'vmware-uninstall-api.pl';
    $gConfigurator = 'vmware-config-api.pl';
  } elsif (vmware_product() eq 'mui') {
    $gRegistryDir = '/etc/vmware-mui';
    $gUninstallerFileName = 'vmware-uninstall-mui.pl';
    $gConfigurator = 'vmware-config-mui.pl';
  } elsif (vmware_product() eq 'tools-for-linux' ||
           vmware_product() eq 'tools-for-freebsd') {
    $gRegistryDir = '/etc/vmware-tools';
    $gUninstallerFileName = 'vmware-uninstall-tools.pl';
    $gConfigurator = 'vmware-config-tools.pl';
  } else {
    $gRegistryDir = '/etc/vmware';
    $gUninstallerFileName = 'vmware-uninstall.pl';
    $gConfigurator = 'vmware-config.pl';
  }
  $gStateDir = $gRegistryDir . '/state';
  $gInstallerMainDB = $gRegistryDir . '/locations';
  $gInstallerObject = $gRegistryDir . '/installer.sh';
  $gConfFlag = $gRegistryDir . '/not_configured';

  $gOption{'default'} = 0;
  $gOption{'eula_agreed'} = 0;
}

# Set up the location of external helpers
sub initialize_external_helpers {
  my $program;
  my @programList;

  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 '')) {
        $gHelper{'more'} = join(' ', @tokens); # This is _already_ a shell string
      }
    }
    if ($gHelper{'more'} eq '') {
      $gHelper{'more'} = DoesBinaryExist_Prompt('more');
      if ($gHelper{'more'} eq '') {
        error('Unable to continue.' . "\n\n");
      }
      $gHelper{'more'} = shell_string($gHelper{'more'}); # Save it as a shell string
    }
  }

  if (vmware_product() eq 'tools-for-freebsd') {
    @programList = ('tar', 'sed', 'rm', 'killall', 'kldstat', 'umount', 'mv', 'uname', 'mount');
  } else {
    @programList = ('tar', 'sed', 'rm', 'killall', 'lsmod', 'umount', 'mv', 'uname', 'mount');
  }

  foreach $program (@programList) {
    if (not defined($gHelper{$program})) {
      $gHelper{$program} = DoesBinaryExist_Prompt($program);
      if ($gHelper{$program} eq '') {
        error('Unable to continue.' . "\n\n");
      }
    }
  }

  # Used for removing links that were not added as files to the database.
  $gHelper{'insserv'} = internal_which('insserv');
  $gHelper{'chkconfig'} = internal_which('chkconfig');
}

# Check the validity of an answer whose type is dirpath
# Return a clean answer if valid, or ''
sub check_answer_dirpath {
  my $answer = shift;
  my $source = shift;

  $answer = dir_remove_trailing_slashes($answer);

  if (substr($answer, 0, 1) ne '/') {
      print wrap('The path "' . $answer . '" is a relative path. Please enter '
		 . 'an absolute path.' . "\n\n", 0);
      return '';
  }

  if (-d $answer) {
    # The path is an existing directory
    return $answer;
  }

  # The path is not a directory
  if (file_name_exist($answer)) {
    if ($source eq 'user') {
      print wrap('The path "' . $answer . '" exists, but is not a directory.'
                 . "\n\n", 0);
    }
    return '';
  }

  # The path does not exist
  if ($source eq 'user') {
    return (get_answer('The path "' . $answer . '" does not exist currently. '
                       . 'This program is going to create it, including needed '
                       . 'parent directories. Is this what you want?',
                       'yesno', 'yes') eq 'yes') ? $answer : '';
  } else {
    return $answer;
  }
}
$gAnswerSize{'dirpath'} = 20;
$gCheckAnswerFct{'dirpath'} = \&check_answer_dirpath;

# Check the validity of an answer whose type is initdirpath
# Return a clean answer if valid, or ''
sub check_answer_initdirpath {
  my $answer = shift;
  my $source = shift;
  my $testdir;

  $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 '';
  }

  foreach $testdir ('rc0.d', 'rc1.d', 'rc2.d', 'rc3.d', 'rc4.d', 'rc5.d', 'rc6.d') {
    if (not (-d $answer . '/' . $testdir)) {
      if ($source eq 'user') {
         print wrap('The path "' . $answer . '" is a directory which does not contain a ' .
         $testdir . ' directory.' . "\n\n", 0);
      }
      return '';
    }
  }

  return $answer;
}
$gAnswerSize{'initdirpath'} = 15;
$gCheckAnswerFct{'initdirpath'} = \&check_answer_initdirpath;

# Check the validity of an answer whose type is initscriptsdirpath
# Return a clean answer if valid, or ''
sub check_answer_initscriptsdirpath {
  my $answer = shift;
  my $source = shift;

  $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 '';
  }

  return $answer;
}
$gAnswerSize{'initscriptsdirpath'} = 15;
$gCheckAnswerFct{'initscriptsdirpath'} = \&check_answer_initscriptsdirpath;

# 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 (($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;

# Install one directory (recursively)
sub install_dir {
  my $src_dir = shift;
  my $dst_dir = shift;
  my $patchRef = shift;
  my $file;

  if (create_dir($dst_dir, 0x1)) {
    my @statbuf;

    @statbuf = stat($dst_dir);
    if (not (defined($statbuf[2]))) {
      error('Unable to get the access rights of destination directory "' . $dst_dir . '".' . "\n\n");
    }

    # Was bug 15880 --hpreg
    if (   ($statbuf[2] & 0555) != 0555
        && get_answer('Current access permissions on directory "' . $dst_dir
                      . '" will prevent some users from using '
                      . vmware_product_name()
                      . '. Do you want to set those permissions properly?',
                      'yesno', 'yes') eq 'yes') {
      safe_chmod(($statbuf[2] & 07777) | 0555, $dst_dir);
    }
  } else {
    install_permission($src_dir, $dst_dir);
  }
  foreach $file (internal_ls($src_dir)) {
    if (-d $src_dir . '/' . $file) {
      install_dir($src_dir . '/' . $file, $dst_dir . '/' . $file, $patchRef);
    } else {
      install_file($src_dir . '/' . $file, $dst_dir . '/' . $file, $patchRef, 0x1);
    }
  }
}

# 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'} . ' ./doc/EULA');
    print "\n";

    # Make sure there is no default answer here
    if (get_answer('Do you accept? (yes/no)', 'yesno', '') eq 'no') {
      print wrap('Please try again when you are ready to accept.' . "\n\n", 0);
      uninstall_file($gInstallerMainDB);
      exit 0;
    }
    print wrap('Thank you.' . "\n\n", 0);
  }
}

# XXX This code is mostly duplicated from the main server installer. -jhu
sub build_perl_api {
  my $control;
  my $build_dir;
  my $program;
  my $cTmpDirPrefix = 'api-config';

  foreach $program ('tar', 'perl', 'make', 'touch') {
    if (not defined($gHelper{$program})) {
      $gHelper{$program} = DoesBinaryExist_Prompt($program);
      if ($gHelper{$program} eq '') {
        error('Unable to continue.' . "\n\n");
      }
    }
  }

  print wrap('Installing the VMware VmPerl Scripting API.' . "\n", 0);

  $control = './control.tar';
  if (not (file_name_exist($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))) {
    print wrap('Unable to untar the "' . $control . '" file in the "' . $build_dir .
               '" directory.' . "\n\n", 0);
    error('');
  }

  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 (not file_name_exist($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 wrap("\n", 0);
  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);
    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).
  # More code duplication from pkg_mgr.pl (really, really bad)
  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);
}

# XXX Mostly duplicated from the main server installer. -jhu
# 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);
  error('');
}

# Handle the installation and configuration of vmware's perl module
sub install_perl_api {
  my $rootdir;
  my $answer;
  my $mandir;
  my $docdir;
  my %patch;

  undef %patch;
  install_dir('./etc', $gRegistryDir, \%patch);

  $rootdir = '/usr';

  $answer = get_persistent_answer('In which directory do you want to install the executable files?',
                                  'BINDIR', 'dirpath', $rootdir . '/bin');
  undef %patch;
  install_dir('./bin', $answer, \%patch);
  $gIsUninstallerInstalled = 1;

  $rootdir = internal_dirname($answer);
  # Don't display a double slash (was bug 14109) --hpreg
  if ($rootdir eq '/') {
    $rootdir = '';
  }

  # We don't use get_persistent_answer() here because once the user has
  # selected the root directory, we can give him better default answers than
  # his/her previous answers.

  $answer = get_answer('In which directory do you want to install the library files?',
                       'dirpath', $rootdir . '/lib/vmware-api');
  db_add_answer('LIBDIR', $answer);
  undef %patch;
  install_dir('./lib', $answer, \%patch);

  $docdir = $rootdir . '/share/doc';
  if (not (-d $docdir)) {
    $docdir = $rootdir . '/doc';
  }
  $answer = get_answer('In which directory do you want to install the documentation files?'
                       , 'dirpath', $docdir . '/vmware-api');
  db_add_answer('DOCDIR', $answer);
  undef %patch;
  install_dir('./doc', $answer, \%patch);

  build_perl_api();
}

sub vmware_guestd_app_name {
  if (is64BitUserland()) {
    return db_get_answer('LIBDIR') . '/sbin64/vmware-guestd';
  } else {
    return db_get_answer('LIBDIR') . '/sbin32/vmware-guestd';
  }
}

# Install the content of the tools tar package
sub install_content_tools {
  my $rootdir;
  my $answer;
  my %patch;
  my $mandir;
  my $docdir;

  undef %patch;
  install_dir('./etc', $gRegistryDir, \%patch);

  if(vmware_product() eq 'tools-for-freebsd') {
    $rootdir = '/usr/local';
  } else {
    $rootdir = '/usr';
  }
  $answer = get_persistent_answer('In which directory do you want to '
                                  . 'install the binary files?', 'BINDIR',
                                  'dirpath', $rootdir . '/bin');
  undef %patch;
  install_dir('./bin', $answer, \%patch);

  $rootdir = internal_dirname($answer);
  # Don't display a double slash (was bug 14109) --hpreg
  if ($rootdir eq '/') {
    $rootdir = '';
  }

  # Finds the location of the initscripts dir
  $answer = get_initscriptsdir();

  # install the service script.
  if (vmware_product() eq 'tools-for-freebsd') {
    $answer = get_answer('In which directory do you want to install the '
                         . 'startup script?', 'dirpath', $answer);
    create_dir($answer,0);
  }
  undef %patch;
  install_file($cStartupFileName,
               $answer . (vmware_product() eq 'tools-for-freebsd' ?
                          '/vmware-tools.sh' : '/vmware-tools'), \%patch, 0x1);

  $gIsUninstallerInstalled = 1;

  # We don't use get_persistent_answer() here because once the user has
  # selected the root directory, we can give him better default answers than
  # his/her previous answers.

  $answer = get_answer('In which directory do you want to install '
                       . 'the daemon files?', 'dirpath', $rootdir . '/sbin');
  db_add_answer('SBINDIR', $answer);
  undef %patch;
  create_dir($answer, 0x1);

  $answer = get_answer('In which directory do you want to install '
                       . 'the library files?', 'dirpath', $rootdir
                       . '/lib/vmware-tools');
  db_add_answer('LIBDIR', $answer);
  undef %patch;
  if (file_name_exist('./lib/bin32')) {
     install_dir('./lib/bin32', "$answer/bin32", \%patch);
  }
  if (file_name_exist('./lib/bin64')) {
     install_dir('./lib/bin64', "$answer/bin64", \%patch);
  }
  if (file_name_exist('./lib/sbin32')) {
     install_dir('./lib/sbin32', "$answer/sbin32", \%patch);
  }
  if (file_name_exist('./lib/sbin64')) {
     install_dir('./lib/sbin64', "$answer/sbin64", \%patch);
  }
  if (file_name_exist('./lib/lib32')) {
     install_dir('./lib/lib32', "$answer/lib32", \%patch);
  }
  if (file_name_exist('./lib/lib64')) {
     install_dir('./lib/lib64', "$answer/lib64", \%patch);
  }
  if (file_name_exist('./lib/configurator')) {
     install_dir('./lib/configurator', "$answer/configurator", \%patch);
  }
  if (file_name_exist('./lib/hlp')) {
     install_dir('./lib/hlp', "$answer/hlp", \%patch);
  }
  if (file_name_exist('./lib/modules')) {
     install_dir('./lib/modules', "$answer/modules", \%patch);
  }
  if (file_name_exist('./lib/gnome_session_manual.pl')) {
     install_file('./lib/gnome_session_manual.pl', "$answer/gnome_session_manual.pl",
		  \%patch, 0x1);
  }
  $docdir = $rootdir . '/share/doc';
  if (not (-d $docdir)) {
    $docdir = $rootdir . '/doc';
  }
  $answer = get_answer('In which directory do you want to install the '
                       . 'documentation files?', 'dirpath', $docdir
                       . '/vmware-tools');
  db_add_answer('DOCDIR', $answer);
  undef %patch;
  install_dir('./doc', $answer, \%patch);

  #
  # Now that everything is correctly setup, tell VMware that it can remove the
  # tool installation CD image
  #

  # Note: The trailing space is for backward compatibility with VMware
  # pre-wgs-beta2
  system(shell_string(vmware_guestd_app_name())
	 . ' --cmd ' . shell_string('toolinstall.end ')
	 . ' 2>&1 > /dev/null');
}

sub uninstall_content_legacy_tools {
  my $OldInstallerDB = '/etc/vmware-tools/tools_log';
  my $OldInstallerDBOld = '/etc/vmware/tools_log';
  my $TmpMainDB = $gInstallerMainDB;
  my $File;
  my @Files;
  my $MovedFile;
  my $LinkedFile;
  my $answer;
  my $runlevel;

  # This is necessary for old installations of the tools
  # when /etc/vmware was one and unique dump for all the products
  if (-e $OldInstallerDBOld) {
    $OldInstallerDB = $OldInstallerDBOld;
  }
  if (!-e $OldInstallerDB) {
    # Old tools database not found, assume that the system is clean.
    return;
  }
  # Swap the db with the old one temporarely.
  $gInstallerMainDB = $OldInstallerDB;

  db_load();
  if (not open(INSTALLDB, '>>' . $gInstallerMainDB)) {
    error('Unable to open the tar installer database ' . $gInstallerMainDB
          . ' in write-mode.' . "\n\n");
  }

  $answer = get_answer('An old installation of the tools is detected. '
                       . 'Should this installation be removed ?',
                       'yesno', 'yes');
  if ($answer eq 'no') {
    error('');
  }

  # Stop the services
  foreach $File (keys %gDBFile) {
    if ($File =~ /\S+\/dualconf(\.sh)?$/) {
      system(shell_string($File) . ' stop');
      print "\n";
      last;
    }
  }
  # Remove the files
  foreach $File (keys %gDBFile) {
    if ($File !~ /\/tmp\S+/) {
      uninstall_file($File);
    }
  }
  # Remove the links
  foreach $LinkedFile (keys %gDBLink) {
    unlink $LinkedFile;
  }
  # At last, replace the original files.
  foreach $MovedFile (keys %gDBMove) {
    # XXX we do not have a timestamp for those files so we can't
    # know if the user changed it, so I back it up.
    if (-e $gDBMove{$MovedFile}) {
      backup_file($gDBMove{$MovedFile});
      unlink $gDBMove{$MovedFile};
    }
    if (-e $MovedFile) {
      if ($MovedFile =~ /\S+\.org/) {
        rename $MovedFile, $gDBMove{$MovedFile};
      } elsif ($gDBMove{$MovedFile} =~ /\.new$/) {
        # Nothing to do for /etc/rc and /etc/rc.shutdown
      } else {
        backup_file($MovedFile);
        unlink $MovedFile;
      }
    }
  }

  # Clean up the broken links.
  foreach $File (qw(/etc/modules.conf /etc/conf.modules /etc/XF86Config
                    /etc/X11/XF86Config /etc/X11/XF86Config-4)) {
    if ((-l $File) && (-e ($File . '.org'))) {
      unlink $File;
      rename $File . '.org', $File;
    }
  }

  get_initscriptsdir();
  $Files[0] = db_get_answer('INITSCRIPTSDIR') . '/vmmemctl';
  foreach $runlevel ('0', '1', '2', '3', '4', '5', '6', 'S', 's') {
    push @Files, db_get_answer('INITDIR') . '/rc' . $runlevel
                 . '.d/S99vmmemctl';
  }
  # Cleanup the files that aren't mentionned in the install database.
  foreach $File (@Files) {
    if (file_name_exist($File)) {
      unlink $File;
    }
  }

  db_save();
  unlink $gInstallerMainDB;

  if (direct_command('LANG=C ' .
                     shell_string(vmware_product() eq 'tools-for-freebsd' ?
                                  $gHelper{'kldstat'} : $gHelper{'lsmod'})) =~
                     /vmmemctl/) {
    print wrap('The uninstallation of legacy tools completed. '
             . 'Please restart this virtual machine to ensure that '
             . 'all the loaded components are removed from the memory and '
             . 'run this installer again to continue with the upgrade.'
             . "\n\n", 0);
    exit 0;
  }
  # Restore the original database file name in case we don't have
  # to reboot because of the loaded vmmemctl.
  $gInstallerMainDB = $TmpMainDB;
}

# Install the content of the WGS/VMware Server client tar package
sub install_content_console {
  my $rootdir;
  my $answer;
  my %patch;
  my $mandir;
  my $docdir;

  undef %patch;
  install_dir('./etc', $gRegistryDir, \%patch);

  $rootdir = '/usr';

  $answer = get_persistent_answer('In which directory do you want to install the binary files?', 'BINDIR', 'dirpath', $rootdir . '/bin');
  undef %patch;
  install_dir('./bin', $answer, \%patch);
  $gIsUninstallerInstalled = 1;

  $rootdir = internal_dirname($answer);
  # Don't display a double slash (was bug 14109) --hpreg
  if ($rootdir eq '/') {
    $rootdir = '';
  }

  # We don't use get_persistent_answer() here because once the user has
  # selected the root directory, we can give him better default answers than
  # his/her previous answers.

  $answer = get_answer('In which directory do you want to install the library files?', 'dirpath', $rootdir . '/lib/vmware-console');
  db_add_answer('LIBDIR', $answer);
  undef %patch;
  install_dir('./lib', $answer, \%patch);

  $mandir = $rootdir . '/share/man';
  if (not (-d $mandir)) {
    $mandir = $rootdir . '/man';
  }
  $answer = get_answer('In which directory do you want to install the manual files?', 'dirpath', $mandir);
  db_add_answer('MANDIR', $answer);
  undef %patch;
  install_dir('./man', $answer, \%patch);

  $docdir = $rootdir . '/share/doc';
  if (not (-d $docdir)) {
    $docdir = $rootdir . '/doc';
  }
  $answer = get_answer('In which directory do you want to install the documentation files?', 'dirpath', $docdir . '/vmware-console');
  db_add_answer('DOCDIR', $answer);
  undef %patch;
  install_dir('./doc', $answer, \%patch);
}

# Return GSX or ESX for server products, Workstation for ws
sub installed_vmware_version {
  my $vmware_version;
  my $vmware_version_string;

  if (not defined($gHelper{"vmware"})) {
    $gHelper{"vmware"} = DoesBinaryExist_Prompt("vmware");
    if ($gHelper{"vmware"} eq '') {
      error('Unable to continue.' . "\n\n");
    }
  }

  $vmware_version_string = direct_command(shell_string($gHelper{"vmware"})
                                          . ' -v 2>&1 < /dev/null');
  if ($vmware_version_string =~ /.*VMware GSX Server.*/) {
    $vmware_version = 'GSX';
  } elsif ($vmware_version_string =~ /.*VMware ESX Server.*/) {
    $vmware_version = 'ESX';
  } elsif ($vmware_version_string =~ /.*VMware Server.*/) {
    $vmware_version = 'vserver';
  } else {
    $vmware_version = "Workstation";
  }
  return $vmware_version;
}

# Install the mui package
sub install_content_mui {
  my $rootdir;
  my $answer;
  my %patch;
  my $program;
  my $vmware_version;
  my $mui_dir = "./mui";
  my $docdir;

  # Find the programs we need to go ahead with the install
  foreach $program ('vmware', 'hostname', 'tar', 'rm', 'cp', 'rmdir') {
    if (not defined($gHelper{$program})) {
      $gHelper{$program} = DoesBinaryExist_Prompt($program);
      if ($gHelper{$program} eq '') {
	uninstall_file($gInstallerMainDB);
        error('Unable to continue.' . "\n\n");
      }
    }
  }

  $vmware_version = installed_vmware_version();

  # Force use of the RPM if this is ESX
  if ($vmware_version eq "ESX") {
    error('VMware ESX Server requires that the ' . vmware_product_name() .
     ' be installed via RPM' . "\n\n");
  }

  # Make sure VMware Server is installed
  if ($vmware_version ne "vserver") {
    error('VMware Server must be installed on this machine for the ' .
     vmware_product_name() . ' to work'
    . "\n\n");
  }

  # remove install made by old installer
  removeExistingInstall();

  # Install the uninstaller
  undef %patch;
  install_dir('./etc', $gRegistryDir, \%patch);

  $rootdir = '/usr';
  $answer = get_persistent_answer('In which directory do you want to install '
                                  . 'the binary files?', 'BINDIR', 'dirpath',
                                  $rootdir . '/bin');
  undef %patch;

  install_dir( './bin' , $answer, \%patch);

  # Finds the location of the initscripts dir
  get_initscriptsdir();

  $rootdir = internal_dirname($answer) . '/lib/vmware-mui';
  db_add_answer('INSTALLDIR', $rootdir);

  $gIsUninstallerInstalled = 1;

  # Find whether this is an install of gsx or esx
  $vmware_version = installed_vmware_version();

  $rootdir = '/home/vmware/mui';
  $answer = get_persistent_answer('In which directory do you want to install '
                                  . 'the ' . vmware_product_name(). ' files?',
                                  'INSTALLDIR', 'dirpath', $rootdir);
  $rootdir = $answer;

  # Install the mui package to the right place
  undef %patch;
  install_dir($mui_dir, $rootdir, \%patch);

  # Install the console distrib package
  undef %patch;
  install_dir('./console-distrib', $rootdir . '/apache/htdocs/vmware/bin'
              , \%patch);

  # Install the documentation
  $docdir = $rootdir . '/share/doc';
  if (not (-d $docdir)) {
    $docdir = $rootdir . '/doc';
  }
  $answer = get_answer('In which directory would you like to install the '
                       . 'documentation files?', 'dirpath', $docdir);
  db_add_answer('DOCDIR', $answer);
  undef %patch;
  install_dir('./doc', $answer, \%patch);
}

#BEGIN UNINSTALLER SECTION
# Uninstaller section for old style MUI installer: Most of this code is
# directly copied over from the old installer
my %gConfData;

# Read the config vars to our internal array
sub readConfig {
  my $registryFile = shift;
  if (open(OLDCONFIG, $registryFile)) {
    # Populate our array with everthing from the conf file.
    while (<OLDCONFIG>) {
      m/^\s*(\S*)\s*=\s*(\S*)/;
      $gConfData{$1} = $2;
    }
    close(OLDCONFIG);
    return(1);
  }
  return(0);
}

# Remove our files at a very high level
sub uninstallAllFiles {
  my $key;
  my @killFiles = (
                    "EULA.txt",
                    "VMware",
                    "apache",
                    "bin",
                    "include",
                    "lib",
                    "man",
                    "ssl",
                   );
  my %rCLinks = (
                  "rc3.d/S91httpd.vmware", "httpd.vmware",
                  "rc4.d/S91httpd.vmware", "httpd.vmware",
                  "rc5.d/S91httpd.vmware", "httpd.vmware",
                  "rc3.d/K07httpd.vmware", "httpd.vmware",
                  "rc4.d/K07httpd.vmware", "httpd.vmware",
                  "rc5.d/K07httpd.vmware", "httpd.vmware",
                 );

  print wrap('Removing the old installation....' . "\n" , 0);
  # Remove our init.d symlinks and files
  foreach $key (keys %rCLinks ) {
    system(shell_string($gHelper{'rm'}). ' -f '
           . shell_string("$gConfData{'mui.initd.fullpath'}/../$key"));
    system(shell_string($gHelper{'rm'}). ' -f '
           . shell_string("$gConfData{'mui.initd.fullpath'}/$key"));
    system(shell_string($gHelper{'rm'}). ' -f '
           . shell_string("$gConfData{'mui.initd.fullpath'}/$rCLinks{$key}"));
  }

  # Remove our MUI directories and files
  foreach $key (@killFiles) {
    system(shell_string($gHelper{'rm'}) . ' -rf '
           . shell_string("$gConfData{'mui.fullpath'}/$key"));
  }

  system(shell_string($gHelper{'rmdir'}) . ' '
         . shell_string("$gConfData{'mui.fullpath'}") .' > /dev/null 2>&1');

  # Remove secuity-config.pl
  system(shell_string($gHelper{'rm'}) . ' -f '
         . shell_string("$gConfData{'security.fullpath'}"));

  return(1);
}

#
# check to see if this is a certificate that was generated
# by this program (or the mui).  If so, then it is safe to delete
# it. (don't want to accidently blow away an expensive certificate).
#
sub certSafeToDelete {
  my $instDir = shift;
  my $certLoc = "/etc/vmware-mui/ssl";
  my $certUniqIdent = "(564d7761726520496e632e)";
  local *F;
  if (not open(F, "$instDir/bin/openssl x509 -in $certLoc/mui.crt " .
               " -noout -subject" . '|')) {
    return 1;
  }

  while (<F>) {
    if (m/$certUniqIdent/) {
      return 1;
    }
  }
  close (F);

  #Certificate didn't have our uniq identifier, so don't delete it.
  return 0;
}

# See if we've installed already and nuke it if found.
sub removeExistingInstall {
  my $instDir;
  my $key;
  my $registryDir  = "/etc/vmware-mui";
  my $registryFile = "$registryDir/config";
  my $readSuccess;
  if (-e "$registryDir") {
    # Populate our array with the data from the conf file.
    $readSuccess = readConfig($registryFile);
    if ($readSuccess) {
      $instDir = $gConfData{'mui.fullpath'};
      # Warn them if we can't figure out where thier old install is.
      if (not -e $instDir) {
        print wrap('You seem to have a previous installation of '
                   . vmware_product_name() . ' but the installer '
                   . 'cant find where it is. You might want to '
                   . 'remove your old installation by hand.' . "\n", 0);
        return;
      }
      stop_mui($instDir);
      if (!certSafeToDelete($instDir)) {
        print wrap('The SSL certificate in ' . "$registryDir " . 'doesn\'t appear'
                   . ' to have been generated by ' . vmware_product_name()
                   . '. Not deleting files in ' . "$registryDir"
                   . ' as a precaution.' . "\n" , 0);
      } else {
        # We cant just delete the entire $registryDir directory since it
        # will now contain our locations file that we created to hold the
        # new install database
        system(shell_string($gHelper{'rm'}) . ' -rf '
               . shell_string($registryDir . '/ssl'));
        system(shell_string($gHelper{'rm'}) . ' -rf '
               . shell_string($registryDir . '/config'));
        # Since this directory existed due to the old install, we need
        # to add it to our database to make it be deleted properly on
        # uninstall
        db_add_dir($registryDir, 0x1);
      }
      uninstallAllFiles();
      return(1);
    }
  }
  return(0);
}

# END UNINSTALLER SECTION
# Install the content of the tar package
sub install_content {
  my $rootdir;
  my $answer;
  my %patch;
  my $mandir;
  my $docdir;
  my $initdir;
  my $initscriptsdir;

  undef %patch;
  install_dir('./etc', $gRegistryDir, \%patch);

  $rootdir = '/usr';

  $answer = get_persistent_answer('In which directory do you want to install the binary files?',
                                  'BINDIR', 'dirpath', $rootdir . '/bin');
  undef %patch;
  install_dir('./bin', $answer, \%patch);

  #
  # Install the startup script (and make the old installer aware of this one)
  #
  undef %patch;
  install_file($cStartupFileName,
               get_initscriptsdir() . '/vmware', \%patch, 0x1);

  $gIsUninstallerInstalled = 1;

  # Setuid root
  safe_chmod(04555, $answer . '/vmware-ping');

  $rootdir = internal_dirname($answer);
  # Don't display a double slash (was bug 14109) --hpreg
  if ($rootdir eq '/') {
    $rootdir = '';
  }

  # We don't use get_persistent_answer() here because once the user has
  # selected the root directory, we can give him better default answers than
  # his/her previous answers.

  if (vmware_product() eq 'wgs' ||
      vmware_product() eq 'vserver') {
    $answer = get_answer('In which directory do you want to install '
                         . 'the daemon files?', 'dirpath', $rootdir . '/sbin');
    db_add_answer('SBINDIR', $answer);
    undef %patch;
    install_dir('./sbin', $answer, \%patch);
    # Setuid root
    safe_chmod(04555, $answer . '/vmware-authd');
  }

  $answer = get_answer('In which directory do you want to install the library files?',
                       'dirpath', $rootdir . '/lib/vmware');
  db_add_answer('LIBDIR', $answer);
  undef %patch;
  install_dir('./lib', $answer, \%patch);
  # Setuid root
  safe_chmod(04555, $answer . '/bin/vmware-vmx');
  safe_chmod(04555, $answer . '/bin-debug/vmware-vmx');

  # If the product has man pages ask for the man pages location. */
  if (-d './man') {
    $mandir = $rootdir . '/share/man';
    if (not (-d $mandir)) {
      $mandir = $rootdir . '/man';
    }
    $answer = get_answer('In which directory do you want to install the manual files?',
                         'dirpath', $mandir);
    db_add_answer('MANDIR', $answer);
    undef %patch;
    install_dir('./man', $answer, \%patch);
  }

  $docdir = $rootdir . '/share/doc';
  if (not (-d $docdir)) {
    $docdir = $rootdir . '/doc';
  }
  $answer = get_answer('In which directory do you want to install the documentation files?',
                       'dirpath', $docdir . '/vmware');
  db_add_answer('DOCDIR', $answer);
  undef %patch;
  install_dir('./doc', $answer, \%patch);

}

sub get_initscriptsdir {
  my $initdir;
  my $initscriptsdir;
  my $answer;

  if (vmware_product() eq 'tools-for-freebsd') {
    $initdir = '/usr/local/etc/rc.d';
    $initscriptsdir = '/usr/local/etc/rc.d';
    db_add_answer('INITDIR', $initdir);
    db_add_answer('INITSCRIPTSDIR', $initscriptsdir);
    return $initscriptsdir;
  }

  # The "SuSE version >= 7.1" way
  $initdir = '/etc/init.d';
  if (check_answer_initdirpath($initdir, 'default') eq '') {
    # The "SuSE version < 7.1" way
    $initdir = '/sbin/init.d';
    if (check_answer_initdirpath($initdir, 'default') eq '') {
      # The "RedHat" way
      $initdir = '/etc/rc.d';
      if (check_answer_initdirpath($initdir, 'default') eq '') {
        # The "Debian" way
        $initdir = '/etc';
        if (check_answer_initdirpath($initdir, 'default') eq '') {
          $initdir = '';
        }
      }
    }
  }
  $answer = get_persistent_answer('What is the directory that contains the init'
                                  .' directories (rc0.d/ to rc6.d/)?'
                                  , 'INITDIR', 'initdirpath', $initdir);

  # The usual way
  $initscriptsdir = $answer . '/init.d';
  if (check_answer_initscriptsdirpath($initscriptsdir, 'default') eq '') {
    # The "SuSE version >= 7.1" way
    $initscriptsdir = $answer;
    if (check_answer_initscriptsdirpath($initscriptsdir, 'default') eq '') {
      $initscriptsdir = '';
    }
  }
  $answer = get_persistent_answer('What is the directory that contains the init'
                                  .' scripts?', 'INITSCRIPTSDIR'
                                  , 'initscriptsdirpath', $initscriptsdir);
  return $answer;
}

# Install a tar package or upgrade an already installed tar package
sub install_or_upgrade {
  print wrap('Installing the content of the package.' . "\n\n", 0);

  if (vmware_product() eq 'console') {
    install_content_console();
  } elsif (vmware_product() eq 'api') {
    install_perl_api();
  } elsif (vmware_product() eq 'mui') {
    install_content_mui();
  } elsif (vmware_product() eq 'tools-for-linux' ||
           vmware_product() eq 'tools-for-freebsd') {
    install_content_tools();
  } else {
    install_content();
  }

  print wrap('The installation of ' . vmware_longname()
             . ' completed successfully. '
             . 'You can decide to remove this software from your system at any '
             . 'time by invoking the following command: "'
             . db_get_answer('BINDIR') . '/' . $gUninstallerFileName . '".'
             . "\n\n", 0);
}

# 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);
    }
  }
}

# Uninstall a tar package
sub uninstall {
  my $service_name = shift;
  if (defined($gDBAnswer{'INITSCRIPTSDIR'})
      && db_file_in(db_get_answer('INITSCRIPTSDIR') . $service_name)) {
    # The installation process ran far enough to create the startup script
    my $status;

    # In case service links were created the LSB way, remove them
    if ($gHelper{'insserv'} ne '') {
      system(shell_string($gHelper{'insserv'}) . ' -r '
             . shell_string(db_get_answer('INITSCRIPTSDIR') . $service_name));
    } elsif ($gHelper{'chkconfig'} ne '') {

      # We need to trim the leading '/' off of the service name.
      my $trim_service_name = (substr($service_name, 0, 1) eq '/')
	? substr($service_name, 1) : $service_name;
      system(shell_string($gHelper{'chkconfig'}) . ' --del ' . $trim_service_name);
    }

    # Stop the services
    $status = system(shell_string(db_get_answer('INITSCRIPTSDIR')
                                  . $service_name) . ' stop') >> 8;
    if ($status) {
      if ($status == 2) {
        # At least one instance of VMware is still running. We must refuse to
        # uninstall
        error('Unable to stop ' . vmware_product_name()
              . '\'s services. Aborting the uninstallation.' . "\n\n");
      }

      # Oh well, at worst the user will have to reboot the machine... The
      # uninstallation process should go as far as possible
      print STDERR wrap('Unable to stop ' . vmware_product_name()
                        . '\'s services.' . "\n\n", 0);
    } else {
      print "\n";
    }
  }

  uninstall_prefix('');
}

# Return the specific VMware product
sub vmware_product {
  return 'console';
}

# this is a function instead of a macro in the off chance that product_name
# will one day contain a language-specific escape character. (ask hpreg)
sub vmware_product_name {
  return 'VMware Remote Console';
}

# Stop any currently running instance of the mui
sub stop_mui {
  my $installDir = shift;
  if (-e "$installDir/apache/bin") {
    system(shell_string($installDir) . '/apache/bin/apachectl stop > /dev/null 2>&1');
  } else {
    # Maybe the install didnt get this far! We will ignore it
    print wrap('Couldnt find a running instance of Apache.' . "\n\n", 0);
  }
}

# Delete the mui log files that were created once the mui started running
sub clear_mui_logs {
  my $installDir = db_get_answer('INSTALLDIR');
  if (-e "$installDir/apache/logs") {
    system(shell_string($gHelper{'rm'}) . ' -f ' . "$installDir/apache/logs/*");
  }
}

# Return product name and version
sub vmware_longname {
   my $name = vmware_product_name() . ' ' . vmware_version();

   if (not (vmware_product() eq 'server')) {
      $name .= (vmware_product() eq 'tools-for-freebsd') ?
              ' for Free BSD' : ' for Linux';
   }

   return $name;
}

# If this was a WGS/VMware Server build, remove our inetd.conf entry for
# auth daemon and stop the vmware-serverd
sub wgs_uninstall {

  system(shell_string($gHelper{'killall'}) . ' -TERM vmware-serverd  >/dev/null 2>&1');
  uninstall_superserver();
}

# Try and figure out which "superserver" is installed and unconfigure correct
# one.
sub uninstall_superserver {
  my $inetd_conf  = "/etc/inetd.conf";
  my $xinetd_dir  = "/etc/xinetd.d";

  # 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.  Or parse if
  #     from the init.d script somewhere.  If they use init.d.
  if ( -d $xinetd_dir ) {
    uninstall_xinetd($xinetd_dir);
  }

  # check for inetd
  if ( -e $inetd_conf ) {
    uninstall_inetd($inetd_conf);
  }
}

# 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;
    }
  }
  system(shell_string($gHelper{'killall'}) . ' -HUP inetd');
}

# 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 . '/tmp';

  # XXX Use the block_*() API instead, like we do for $cServices. --hpreg
  internal_sed($inetd, $tmp, 0, \%patch);
  undef %patch;

  if (not internal_sed($tmp, $inetd, 0, \%patch)) {
    print STDERR wrap('Unable to copy file ' . $tmp . ' back to ' . $inetd
                      . '.' . "\n" . 'The authentication daemon was not removed from '
                      . $inetd . "\n\n", 0);
  }
  remove_tmp_dir($tmp_dir);
  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;
    }
  }
  system(shell_string($gHelper{'killall'}) . ' -USR2 xinetd');
}


# Cleanup the xinetd.d directory.
sub uninstall_xinetd {
  my $conf_dir = shift;
  my $tmp_dir;
  my $tmp;

  # XXX What the heck is that? Why isn't this file registered with the
  #     installer's database, and automatically removed? --hpreg
  unlink($conf_dir . '/vmware-authd');

  # Unregister the IP service. --hpreg
  $tmp_dir = make_tmp_dir('vmware-installer');
  $tmp = $tmp_dir . '/tmp';
  if (block_remove($cServices, $tmp, $cMarkerBegin, $cMarkerEnd) >= 0) {
    system(shell_string($gHelper{'mv'}) . ' -f ' . shell_string($tmp) . ' '
           . shell_string($cServices));
  }
  remove_tmp_dir($tmp_dir);

  restart_xinetd();
}


# Display a usage error message for the install program and exit
sub install_usage {
  print STDERR wrap(vmware_longname() . ' installer' . "\n" . 'Usage: ' . $0
                    . ' [[-][-]d[efault]]' . "\n"
                    . '    default: Automatically answer questions with the '
                    . 'proposed answer.' . "\n\n", 0);
  exit 1;
}

# Remove a temporary directory
sub remove_tmp_dir {
  my $dir = shift;

  if (system(shell_string($gHelper{'rm'}) . ' -rf ' . shell_string($dir))) {
    error('Unable to remove the temporary directory ' . $dir . '.' . "\n\n");
  };
}

# ARGH! More code duplication from pkg_mgr.pl
# We really need to have some kind of include system
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");
    }
  }
  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'};
}

# Make sure we have an initial database suitable for this installer. The goal
# is to encapsulates all the compatibilty issues in this (consequently ugly)
# function
sub get_initial_database {
  my $made_dir1;
  my $made_dir2;
  my $bkp_dir;
  my $bkp;
  my $kind;
  my $version;
  my $intermediate_format;
  my $status;
  my $state_file;
  my $state_files;

  if (not (-e $gInstallerMainDB)) {
    # This is the first installation. Create the installer database from
    # scratch
    print wrap('Creating a new installer database using the tar3 format.' . "\n\n", 0);

    $made_dir1 = 0;
    if (not (-d $gRegistryDir)) {
      safe_mkdir($gRegistryDir);
      $made_dir1 = 1;
    }
    safe_chmod(0755, $gRegistryDir);

    if (not open(INSTALLDB, '>' . $gInstallerMainDB)) {
      if ($made_dir1) {
        rmdir($gRegistryDir);
      }
      error('Unable to open the tar installer database ' . $gInstallerMainDB
            . ' in write-mode.' . "\n\n");
    }
    # Force a flush after every write operation.
    # See 'Programming Perl', p. 110
    select((select(INSTALLDB), $| = 1)[0]);

    if ($made_dir1) {
      db_add_dir($gRegistryDir);
    }
    # This file is going to be modified after its creation by this program.
    # Do not timestamp it
    db_add_file($gInstallerMainDB, 0);

    return;
  }

  print wrap('A previous installation of VMware software has been detected.' . "\n\n", 0);

  #
  # Convert the previous installer database to our format and backup it
  # Uninstall the previous installation
  #

  $bkp_dir = make_tmp_dir('vmware-installer');
  $bkp = $bkp_dir . '/prev_db.tar.gz';

  if (-x $gInstallerObject) {
    $kind = direct_command(shell_string($gInstallerObject) . ' kind');
    chop($kind);
    if (system(shell_string($gInstallerObject) . ' version >/dev/null 2>&1')) {
      # No version method -> this is version 1
      $version = '1';
    } else {
      $version = direct_command(shell_string($gInstallerObject) . ' version');
      chop($version);
    }
    print wrap('The previous installation was made by the ' . $kind
               . ' installer (version ' . $version . ').' . "\n\n", 0);

    if ($version < 2) {
      # The best database format those installers know is tar. We will have to
      # upgrade the format
      $intermediate_format = 'tar';
    } elsif ($version == 2) {
      # Those installers at least know about the tar2 database format. We won't
      # have to do much
      $intermediate_format='tar2'
    } else {
      # Those installers at least know about the tar3 database format. We won't
      # have to do anything
      $intermediate_format = 'tar3';
    }
    system(shell_string($gInstallerObject) . ' convertdb '
           . shell_string($intermediate_format) . ' ' . shell_string($bkp));

    # Uninstall the previous installation
    $status = system(shell_string($gInstallerObject) . ' uninstall');
    # Beware, beyond this point, $gInstallerObject does not exist
    # anymore.
  } else {
    # No installer object -> this is the old installer, which we don't support
    # anymore.
    $status = 1;
  }
  if ($status) {
    remove_tmp_dir($bkp_dir);
    error('Failure' . "\n\n");
  }

  # Create the directory structure to welcome the restored database
  $made_dir1 = 0;
  if (not (-d $gRegistryDir)) {
    safe_mkdir($gRegistryDir);
    $made_dir1 = 1;
  }
  safe_chmod(0755, $gRegistryDir);
  $made_dir2 = 0;
  if ($version >= 2) {
    if (not (-d $gStateDir)) {
      safe_mkdir($gStateDir);
      $made_dir2 = 1;
    }
    safe_chmod(0755, $gStateDir);
  }

  # Some versions of tar (1.13.17+ are ok) do not untar directory permissions
  # as described in their documentation (they overwrite permissions of
  # existing, non-empty directories with permissions stored in the archive)
  #
  # Because we didn't know about that at the beginning, the previous
  # uninstallation may have included the directory structure in their database
  # backup.
  #
  # To avoid that, we must re-package the database backup
  system(shell_string($gHelper{'tar'}) . ' -C ' . shell_string($bkp_dir)
         . ' -xzopf ' . shell_string($bkp));
  $state_files = '';
  if (-d $bkp_dir . $gStateDir) {
    foreach $state_file (internal_ls($bkp_dir . $gStateDir)) {
      $state_files .= ' ' . shell_string('.' . $gStateDir . '/'. $state_file);
    }
  }
  $bkp = $bkp_dir . '/prev_db2.tar.gz';
  system(shell_string($gHelper{'tar'}) . ' -C ' . shell_string($bkp_dir)
         . ' -czopf ' . shell_string($bkp) . ' '
         . shell_string('.' . $gInstallerMainDB) . $state_files);

  # Restore the database ready to be used by our installer
  system(shell_string($gHelper{'tar'}) . ' -C / -xzopf ' . shell_string($bkp));
  remove_tmp_dir($bkp_dir);

  if ($version < 2) {
    print wrap('Converting the ' . $intermediate_format
               . ' installer database format to the tar3 installer database format.'
               . "\n\n", 0);
    # Upgrade the database format: keep only the 'answer' statements, and add a
    # 'file' statement for the main database file
    my $id;

    db_load();
    if (not open(INSTALLDB, '>' . $gInstallerMainDB)) {
      error('Unable to open the tar installer database ' . $gInstallerMainDB
            . ' in write-mode.' . "\n\n");
    }
    db_add_file($gInstallerMainDB, 0);
    foreach $id (keys %gDBAnswer) {
      print INSTALLDB 'answer ' . $id . ' ' . $gDBAnswer{$id} . "\n";
    }
    db_save();
  } elsif( $version == 2 ) {
    print wrap('Converting the ' . $intermediate_format
               . ' installer database format to the tar3 installer database format.'
               . "\n\n", 0);
    # Upgrade the database format: keep only the 'answer' statements, and add a
    # 'file' statement for the main database file
    my $id;

    db_load();
    if (not open(INSTALLDB, '>' . $gInstallerMainDB)) {
      error('Unable to open the tar installer database ' . $gInstallerMainDB
            . ' in write-mode.' . "\n\n");
    }
    db_add_file($gInstallerMainDB, 0);
    foreach $id (keys %gDBAnswer) {
      # For the rpm3|tar3 format, a number of keywords were removed.  In their
      # place a more flexible scheme was implemented for which each has a semantic
      # equivalent:
      #
      #   VNET_HOSTONLY          -> VNET_1_HOSTONLY
      #   VNET_HOSTONLY_HOSTADDR -> VNET_1_HOSTONLY_HOSTADDR
      #   VNET_HOSTONLY_NETMASK  -> VNET_1_HOSTONLY_NETMASK
      #   VNET_INTERFACE         -> VNET_0_INTERFACE
      #
      # Note that we no longer use the samba variables, so these entries are
      # removed (and not converted):
      #   VNET_SAMBA             -> VNET_1_SAMBA
      #   VNET_SAMBA_MACHINESID  -> VNET_1_SAMBA_MACHINESID
      #   VNET_SAMBA_SMBPASSWD   -> VNET_1_SAMBA_SMBPASSWD
      my $newid = $id;
      if ($id eq 'VNET_SAMBA') {
         next;
      } elsif ($id eq 'VNET_SAMBA_MACHINESID') {
         next;
      } elsif ($id eq 'VNET_SAMBA_SMBPASSWD') {
         next;
      } elsif ("$id" eq 'VNET_HOSTONLY') {
        $newid='VNET_1_HOSTONLY';
      } elsif ("$id" eq 'VNET_HOSTONLY_HOSTADDR') {
        $newid='VNET_1_HOSTONLY_HOSTADDR';
      } elsif ("$id" eq 'VNET_HOSTONLY_NETMASK') {
        $newid='VNET_1_HOSTONLY_NETMASK';
      } elsif ("$id" eq 'VNET_INTERFACE') {
        $newid='VNET_0_INTERFACE';
      }

      print INSTALLDB 'answer ' . $newid . ' ' . $gDBAnswer{$id} . "\n";
    }
    db_save();
  }

  db_load();
  db_append();
  if ($made_dir1) {
    db_add_dir($gRegistryDir);
  }
  if ($made_dir2) {
    db_add_dir($gStateDir);
  }
}

# SIGINT handler
sub sigint_handler {
  my $signame = shift;

  if ($gIsUninstallerInstalled == 0) {
    print STDERR wrap("\n\n" . 'Ignoring attempt to kill the installer with Control-C, because the uninstaller has not been installed yet. Please use the Control-Z / fg combination instead.' . "\n\n", 0);

    return;
  }

  # If we are installing the VMware Tools and the user cancelled the
  # installation, remember to tell the VMX to unmount the Tools image.
  if (vmware_product() eq 'tools-for-linux' ||
      vmware_product() eq 'tools-for-freebsd') {

      my $guestdBinary;

      # Unfortunately we can't use vmware_guestd_app_name() since we don't
      # yet know if vmware-guestd was copied into place. So let's use
      # the one found in the tarball.
      if (is64BitUserland()) {
	  $guestdBinary = "./lib/sbin64/vmware-guestd";
      } else {
	  $guestdBinary = "./lib/sbin32/vmware-guestd";
      }
      system(shell_string($guestdBinary)
	     . ' --cmd ' . shell_string('toolinstall.end ')
	     . ' 2>&1 > /dev/null');
  }
  error('');
}

#  Write the VMware host-wide configuration file - only if console
sub write_vmware_config {
  my $name;

  $name = $gRegistryDir . '/config';

  uninstall_file($name);
  if (file_check_exist($name)) {
    return;
  }
  # The file could be a symlink to another location. Remove it
  unlink($name);

  open(CONFIGFILE, '>' . $name) or error('Unable to open the configuration file '
                                         . $name . ' in write-mode.' . "\n\n");
  db_add_file($name, 0x1);
  safe_chmod(0444, $name);
  print CONFIGFILE 'libdir = "' . db_get_answer('LIBDIR') . '"' . "\n";
  close(CONFIGFILE);
}

# Get the installed version of VMware
# Return the version if found, or ''
sub get_installed_version() {
  my $backslash;
  my $dollar;
  my $pattern;
  my $version;
  my $nameTag;

  # XXX In the future, we should use a method of the installer object to
  #     retrieve the installed version --hpreg

  #
  # Try to retrieve the installed version from the configurator program. This
  # works for both the tar and the rpm installers --hpreg
  #

  if (not defined($gDBAnswer{'BINDIR'})) {
    return '';
  }

  if (not open(FILE, '<' . db_get_answer('BINDIR') . $gConfigurator)) {
    return '';
  }

  # Build the pattern without using the dollar character, so that CVS doesn't
  # modify the pattern in tagged builds (bug 9303) --hpreg
  $backslash = chr(92);
  $dollar = chr(36);
  $pattern = '^  ' . $backslash . $dollar . 'buildNr = ' .
      "'" . '(\S+) ' . "'" . ' ' . $backslash . '. q' .
      $backslash . $dollar . 'Name: (\S+)? ' . $backslash . $dollar . ';' . $dollar;

  $version = '';
  $nameTag = '';
  while (<FILE>) {
    if (/$pattern/) {
      $version = $1;
      $nameTag = defined($2) ? $2 : '';
    }
  }
  close(FILE);

  return $version;
}

# Get the installed kind of VMware
# Return the kind if found, or ''
sub get_installed_kind() {
  my $kind;

  if (not (-x $cInstallerObject)) {
    return '';
  }

  $kind = direct_command(shell_string($cInstallerObject) . ' kind');
  chop($kind);

  return $kind;
}

# Install the content of the module package
sub install_module {
  my %patch;

  print wrap('Installing the kernel modules contained in this package.' . "\n\n", 0);

  undef %patch;
  install_dir('./lib', db_get_answer('LIBDIR'), \%patch);
}

# Uninstall modules
sub uninstall_module {
  print wrap('Uninstalling currently installed kernel modules.' . "\n\n", 0);

  uninstall_prefix(db_get_answer('LIBDIR') . '/modules');
}

# XXX Duplicated in config.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;
  my $restorePrefix = 'RESTORE_';
  my $restoreBackupSuffix = '_BAK';
  my $restoreBackList = 'RESTORE_BACK_LIST';

  if (defined db_get_answer_if_exists($restoreBackList)) {
    my $restoreStr;
    foreach $restoreStr (split(/:/, db_get_answer($restoreBackList))) {
      if (defined db_get_answer_if_exists($restorePrefix . $restoreStr)) {
        $fileToRestore{db_get_answer($restorePrefix . $restoreStr)} =
          db_get_answer($restorePrefix . $restoreStr
                        . $restoreBackupSuffix);
      }
    }
  }
  return %fileToRestore;
}

# Returns an array with the list of files that changed since we installed
# them.
sub db_is_file_changed {

  my $file = shift;
  my @statbuf;

  @statbuf = stat($file);
  if (defined $gDBFile{$file} && $gDBFile{$file} ne '0' &&
      $gDBFile{$file} ne $statbuf[9]) {
    return 'yes';
  } else {
    return 'no';
  }
}

sub filter_out_bkp_changed_files {

  my $filesToRestoreRef = shift;
  my $origFile;

  foreach $origFile (keys %$filesToRestoreRef) {
    if (db_file_in($origFile) && !-l $origFile &&
        db_is_file_changed($origFile) eq 'yes') {
      # We are in the case of bug 25444 where we are restoring a file
      # that we backed up and was changed in the mean time by someone else
      db_remove_file($origFile);
      backup_file($$filesToRestoreRef{$origFile});
      unlink $$filesToRestoreRef{$origFile};
      print wrap("\n" . 'File ' . $$filesToRestoreRef{$origFile}
                 . ' was not restored from backup because our file '
                 . $origFile
                 . ' got changed or overwritten between the time '
                 . vmware_product_name()
                 . ' installed the file and now.' . "\n\n"
                 ,0);
      delete $$filesToRestoreRef{$origFile};
    }
  }
}

sub restore_backedup_files {
  my $fileToRestore = shift;
  my $origFile;

  foreach $origFile (keys %$fileToRestore) {
    if (file_name_exist($origFile) &&
        file_name_exist($$fileToRestore{$origFile})) {
      backup_file($origFile);
      unlink $origFile;
    }
    if ((not file_name_exist($origFile)) &&
        file_name_exist($$fileToRestore{$origFile})) {
      rename $$fileToRestore{$origFile}, $origFile;
    }
  }
}

# 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();
  initialize_external_helpers();

  # List of questions answered with command-line arguments
  @setOption = ();

  if (internal_basename($0) eq $cInstallerFileName) {
    my $answer;

    if ($#ARGV > -1) {
      if ($#ARGV > 1) {
        install_usage();
      }

      # There are only two possible arguments
      while ($#ARGV != -1) {
        my $arg;
        $arg = shift(@ARGV);

        if (lc($arg) =~ /^(-)?(-)?d(efault)?/) {
          $gOption{'default'} = 1;
        } elsif ($arg =~ /=yes/ || $arg =~ /=no/) {
          push(@setOption, $arg);
        } else {
          install_usage();
        }
      }
    }

    # Other installers will be able to remove this installation cleanly only if
    # they find the uninstaller. That's why we:
    # . Install the uninstaller ASAP
    # . Prevent dumb users from playing with Control-C while doing so

    $gIsUninstallerInstalled = 0;

    # Install the SIGINT handler
    $SIG{INT} = \&sigint_handler;

    # The uninstall of legacy tools must come before get_initial_database()
    if (vmware_product() eq 'tools-for-linux' ||
        vmware_product() eq 'tools-for-freebsd') {
      uninstall_content_legacy_tools();
    }
    get_initial_database();
    # Binary wrappers can be run by any user and need to read the
    # database. --hpreg
    safe_chmod(0644, $gInstallerMainDB);

    if (@setOption > 0) {
      $gOption{'default'} = 1;
    }

    foreach $opt (@setOption) {
      my ($key, $val);
      ($key, $val) = ($opt =~ /^([^=]*)=([^=]*)/);
      db_add_answer($key, $val);
    }

    if (vmware_product() eq 'console' || vmware_product() eq 'api'
        || vmware_product() eq 'mui') {
      show_EULA();
    }
    install_or_upgrade();

    # Reset the handler
    $SIG{INT} = 'DEFAULT';

    # Reset these answers in case we have installed new versions of these
    # documents
    db_remove_answer('EULA_AGREED');
    db_remove_answer('ISC_COPYRIGHT_SEEN');

    # We need to write the config file for the remote console
    if (vmware_product() eq 'console') {
      write_vmware_config();
    }

    if (!(vmware_product() eq 'api')) {
      if (file_name_exist($gConfFlag)) {
        $answer = get_persistent_answer('Before running '
                                        . vmware_product_name()
                                        . ' for the first time, you need to '
                                        . 'configure it by invoking the '
                                        . 'following command: "'
                                        . db_get_answer('BINDIR')
                                        . '/' . "$gConfigurator" . '". Do you '
                                        . 'want this program to invoke the '
                                        . 'command for you now?'
                                        , 'RUN_CONFIGURATOR', 'yesno', 'yes');
      } else {
        print wrap('Before running ' . vmware_product_name() . ' for the first'
                   . ' time, you need to configure it by invoking the'
                   . ' following command: "' . db_get_answer('BINDIR')
                   . '/' . "$gConfigurator" . '"' . "\n\n", 0);
        $answer = 'no';
      }
    }

    db_save();

    if (!(vmware_product() eq 'api') && ($answer eq 'yes')) {
	# Only pass "--default" to config.pl if this is the the tools installer
	# because it doesn't have a EULA which we requires an answer.
	my $defaultOpt = ($gOption{'default'} == 1 &&
			  (vmware_product() eq 'tools-for-linux' ||
			   vmware_product() eq 'tools-for-freebsd'))
			  ? ' --default' : '';
      system(shell_string(db_get_answer('BINDIR') . '/' . $gConfigurator) .
	     $defaultOpt);
    } else {
      print wrap('Enjoy,' . "\n\n" . '    --the VMware team' . "\n\n", 0);
    }
    exit 0;
  }

  #
  # Module updater.
  #
  # XXX This is not clean. We really need separate packages, managed
  #     by the VMware package manager --hpreg
  #

  if (internal_basename($0) eq $cModuleUpdaterFileName) {
    my $installed_version;
    my $installed_kind;
    my $answer;

    print wrap('Looking for a currently installed '
               . vmware_longname() . ' tar package.' . "\n\n", 0);

    if (not (-e $cInstallerMainDB)) {
      error('Unable to find the ' . vmware_product_name() .
      ' installer database file (' . $cInstallerMainDB . ').' .
      "\n\n" . 'You may want to re-install the ' .
      vmware_longname() . ' package, then re-run this program.' . "\n\n");
    }
    db_load();

    $installed_version = get_installed_version();
    $installed_kind = get_installed_kind();

    if (not (($installed_version eq 'e.x.p') and
             ($installed_kind eq 'tar'))) {
      error('This ' . vmware_product_name()
            . ' Kernel Modules package is intended to be used in conjunction '
            . 'with the ' . vmware_longname() . ' tar package only.' . "\n\n");
    }

    # All module files are under LIBDIR --hpreg
    if (not defined($gDBAnswer{'LIBDIR'})) {
       error('Unable to determine where the ' . vmware_longname()
       . ' package installed the library files.' . "\n\n"
       . 'You may want to re-install the ' . vmware_product_name() . ' '
       . vmware_version() . ' package, then re-run this program.' . "\n\n");
    }

    db_append();
    uninstall_module();
    install_module();

    print wrap('The installation of ' . vmware_product_name()
               . ' Kernel Modules '
               . vmware_version() . ' completed successfully.' . "\n\n", 0);

    if (-e $cConfFlag) {
       $answer = get_persistent_answer('Before running the VMware software for '
                                       . 'the first time after this update, you'
                                       . ' need to configure it for your '
                                       . 'running kernel by invoking the '
                                       . 'following command: "'
                                       . db_get_answer('BINDIR')
                                       . '/' . $gConfigurator . '". Do you want this '
                                       . 'program to invoke the command for you now?',
                                       'RUN_CONFIGURATOR', 'yesno', 'yes');
    } else {
      $answer = 'no';
    }

    db_save();

    if ($answer eq 'yes') {
       system(shell_string(db_get_answer('BINDIR') . '/' . $gConfigurator));
    } else {
       print wrap('Enjoy,' . "\n\n" . '    --the VMware team' . "\n\n", 0);
    }
    exit 0;
  }

  if (internal_basename($0) eq $gUninstallerFileName) {
    print wrap('Uninstalling the tar installation of ' .
    vmware_product_name() . '.' . "\n\n", 0);

    if (not (-e $gInstallerMainDB)) {
      error('Unable to find the tar installer database file (' .
      $gInstallerMainDB . ')' . "\n\n");
    }
    db_load();

    db_append();

    if (vmware_product() eq 'wgs' ||
        vmware_product() eq 'vserver') {
      wgs_uninstall();
    }
    if (vmware_product() eq 'mui') {
      stop_mui(db_get_answer('INSTALLDIR'));
      clear_mui_logs();
      uninstall('/httpd.vmware');
    } elsif (vmware_product() eq 'tools-for-linux' ||
             vmware_product() eq 'tools-for-freebsd') {
      my %fileToRestore;

      # Clean up the module loader config file from vmxnet.
      if (vmware_product() eq 'tools-for-freebsd' &&
          defined db_get_answer_if_exists('VMXNET_CONFED') &&
          db_get_answer('VMXNET_CONFED') eq 'yes') {
        my $loader_conf = '/boot/loader.conf';
        my $tmp_dir;
        my $tmp;
        $tmp_dir = make_tmp_dir('vmware-installer');
        $tmp = $tmp_dir . '/loader.conf';
        if (block_remove($loader_conf, $tmp, $cMarkerBegin, $cMarkerEnd) >= 0) {
          system(shell_string($gHelper{'mv'}) . ' -f ' . shell_string($tmp)
                 . ' '
                 . shell_string($loader_conf));
        }
        remove_tmp_dir($tmp_dir);
      }

      # Get the file names before they disappear from the database.
      %fileToRestore = db_get_files_to_restore();

      filter_out_bkp_changed_files(\%fileToRestore);

      uninstall('/vmware-tools');

      restore_backedup_files(\%fileToRestore);
    } else {
      uninstall('/vmware');
    }

    db_save();
    print wrap('The removal of ' . vmware_longname() . ' completed '
               . 'successfully. Thank you for having tried this software.'
               . "\n\n", 0);

    exit 0;
  }

  error('This program must be named ' . $cInstallerFileName . ' or '
        . $gUninstallerFileName . '.' . "\n\n");
}

main();
