Chip: Linux Special/CorelLinux_CHIP.iso/VMware/bin/vmware-uninstall.pl

Perl Script | 1999-11-10 | 28.2 KB | 1,064 lines

#!/usr/bin/perl -w
# If your copy of perl is not in /usr/bin, please adjust the line above.
#
# Copyright (C) 1998, 1999 VMware, Inc.  All Rights Reserved.
#
# Tar package manager for VMware

use strict;

# Constants
my $cInstallerFileName = 'vmware-install.pl';
my $cUninstallerFileName = 'vmware-uninstall.pl';
my $cInstallerDir = './installer';
my $cOldInstaller = $cInstallerDir . '/old-install.pl';
my $cStartupFileName = $cInstallerDir . '/services.sh';
my $cEtcDir = '/etc';
my $cInstallDBDir = $cEtcDir . '/vmware';
my $cInstallDBFileName = $cInstallDBDir . '/locations';
my $cInstallDBBackupFileName = $cInstallDBDir . '/db.tar.gz';
my $cInstallerObjectFileName = $cInstallDBDir . '/installer.sh';
my $cConfFlag = $cInstallDBDir . '/not_configured';

# External helper programs
my %gHelper;

# BEGINNING OF THE SECOND LIBRARY FUNCTIONS
# Global variables
my %gDBAnswer;
my %gDBFile;
my %gDBDir;

# Load the installer database
sub db_load {
  open(INSTALLDB, '<' . $cInstallDBFileName) or error('Unable to open the installer database ' . $cInstallDBFileName . ' 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} = '';
    }
  }
  close(INSTALLDB);
}

# Open the database on disk in append mode
sub db_append {
  if (not open(INSTALLDB, '>>' . $cInstallDBFileName)) {
    error('Unable to open the installer database ' . $cInstallDBFileName . ' 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
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};
}

# Determine if a file belongs to the tar installer database
sub db_file_in {
  my $file = shift;

  return defined($gDBFile{$file});
}

# 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 (' . $cInstallDBFileName . '). You may want to re-install VMware.' . "\n\n");
  }

  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 = ($pos + length($append)) % $cTerminalLineSize;

  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) && ($length <= $cTerminalLineSize)) {
    # The word is too large to fit in the end of line, but can fit in a new
    # empty line, let's create one for 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 the source file ' . $src . '.' . "\n\n");
  }
  safe_chmod($statbuf[2] & 0xFFF, $dst);
}

# Emulate a simplified sed program
# Return 1 if success, 0 if failure
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;

      foreach $patchKey (@patchKeys) {
    s/$patchKey/$$patchRef{$patchKey}/g;
      }

      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 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 script was about to install already exists. Overwrite?', 'yesno', 'yes') eq 'yes') ? 0 : 1;
}

# Install one file
sub install_file {
  my $src = shift;
  my $dst = shift;
  my $patchRef = shift;
  my $ts = 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, $ts);
  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
# Return 1 if the directory existed before
sub create_dir {
  my $dir = shift;
  my $use_db = shift;

  if (-d $dir) {
    return 1;
  }

  if (index($dir, '/') != -1) {
    create_dir(internal_dirname($dir), $use_db);
  }
  safe_mkdir($dir);
  if ($use_db) {
    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 (! -e $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 script
    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 script 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 script previously created the file ' . $file . ', and was about to remove it. Somebody else apparently did it already.' . "\n\n", 0);
  }

  db_remove_file($file);
}

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

  $buildNr = '1.1.2 ' . q$Name:  $;
  $buildNr =~ s/Name: //;
  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);
}
# END OF THE LIBRARY FUNCTIONS

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

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

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

# Reset the database
sub db_reset {
  my $made_dir;
  my $id;

  undef %gDBFile;
  undef %gDBDir;
  $made_dir = 0;
  if (not (-d $cInstallDBDir)) {
    safe_mkdir($cInstallDBDir);
    $gDBDir{$cInstallDBDir} = '';
    $made_dir = 1;
  }
  safe_chmod(0755, $cInstallDBDir);

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

  if ($made_dir) {
    db_add_dir($cInstallDBDir);
  }
  # This file is going to be modified after its creation by this script.
  # Consequently, if we timestamp it, it will be backed up, which is silly.
  # Since the user has really no reason to modify it by hand, it is ok not
  # to time stamp it
  db_add_file($cInstallDBFileName, 0);

  # Rewrite all answers
  foreach $id (keys %gDBAnswer) {
    print INSTALLDB 'answer ' . $id . ' ' . $gDBAnswer{$id} . "\n";
  }
}

# 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 (-d $answer) {
    # The path is an existing directory
    return $answer;
  }

  # The path is not a directory
  if (-e $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 script 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 ('init.d', '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;

# 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, 1) == 0) {
    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, 1);
    }
  }
}

# Install the content of the tar package
sub install_content {
  my $rootdir;
  my $answer;
  my %patch;
  my $initdir;

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

  $rootdir = '/usr';

  # Install the uninstaller ASAP, otherwise other installers will not be able
  # remove this installation cleanly
  $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);
  # Make vmware and vmware-ping suid root
  safe_chmod(04555, $answer . '/vmware');
  safe_chmod(04555, $answer . '/vmware-ping');

  $rootdir = internal_dirname($answer);

  # 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');
  db_add_answer('LIBDIR', $answer);
  undef %patch;
  install_dir('./lib', $answer, \%patch);

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

  $answer = get_persistent_answer('In which directory do you want to install the documentation files?', 'DOCDIR', 'dirpath', '/usr/doc/vmware');
  undef %patch;
  install_dir('./doc', $answer, \%patch);

  # Install the startup script (and make the old installer aware of this one)
  $initdir = '/sbin/init.d';
  if (check_answer_initdirpath($initdir, 'default') eq '') {
    $initdir = '/etc/rc.d';
    if (check_answer_initdirpath($initdir, 'default') eq '') {
      $initdir = '/etc';
      if (check_answer_initdirpath($initdir, 'default') eq '') {
    $initdir = '';
      }
    }
  }
  $answer = get_persistent_answer('What is the directory under which the init scripts reside (it should contain init.d/, and from rc0.d/ to rc6.d/)?', 'INITDIR', 'initdirpath', $initdir);
  undef %patch;
  install_file($cStartupFileName, $answer . '/init.d/vmware', \%patch, 1);
}

# 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);
  install_content();
  print wrap('The installation of VMware ' . vmware_version() . ' for Linux completed successfully. You can decide to remove this software from your system at any time by invoking the following command: "' . db_get_answer('BINDIR') . '/' . $cUninstallerFileName . '".' . "\n\n", 0);
}

# Uninstall a tar package
sub uninstall {
  my $startup;
  my $file;
  my $dir;

  if (system(shell_string(db_get_answer('INITDIR') . '/init.d/vmware') . ' stop')) {
    error('Unable to stop VMware' . "'" . 's services.' . "\n\n");
  }
  print "\n";

  # Remove all files
  foreach $file (keys %gDBFile) {
    uninstall_file($file);
  }

  # Remove all directories
  # 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) {
    rmdir($dir) or warn 'Refused to remove ' . $dir . ': the directory is not empty.' . "\n\n";
  }
}

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

# Program entry point
sub main {
  my $kind;

  if (not is_root()) {
    error('Please re-run this script 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';

  $gOption{'default'} = 0;
  initialize_external_helpers();

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

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

      # There is only one argument
      if (lc($ARGV[0]) !~ /^(-)?(-)?d(efault)?/) {
    install_usage();
      }

      $gOption{'default'} = 1;
    }

    if (-e $cInstallDBFileName) {
      print wrap('A previous installation of VMware has been detected.' . "\n\n", 0);

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

      if (-x $cInstallerObjectFileName) {
    $kind = direct_command(shell_string($cInstallerObjectFileName) . ' kind');
    chop($kind);

    print wrap('The previous installation was made by the ' . $kind . ' installer.' . "\n\n", 0);

    # Here, you typically put cases for older installer where
    # a database format upgrade is needed. For the moment, the
    # only older installer that we know is the old installer, which
    # is special cased.

    # Here go cases for newer installers we know nothing about.
    # Consequently, they know about our format. Make them
    # downgrade their installation database to our format
    system(shell_string($cInstallerObjectFileName) . ' convertdb tar ' . shell_string($cInstallDBBackupFileName));

        # Uninstall the previous installation
        system(shell_string($cInstallerObjectFileName) . ' uninstall');
        # Beware, beyond this point, $cInstallerObjectFileName does not exist
        # anymore.
      } else {

        #
        # Special case the old installer, because it didn't know about
        # the installer.sh mechanism
        #

        print wrap('The previous installation was made by the old installer.' . "\n\n", 0);
        print wrap('Converting the old installer database format to the tar installer database format.' . "\n\n", 0);
        system(shell_string($gHelper{'sed'}) . ' -e ' . shell_string('/^answer SHARED_.* /d') . ' -e ' . shell_string('s/^answer BUILDR_driver /answer BUILDR_vmmon /') . ' ' . shell_string($cInstallDBFileName) . ' > ' . shell_string($cInstallDBFileName . 'tmp'));
        rename($cInstallDBFileName . 'tmp', $cInstallDBFileName);
    system(shell_string($gHelper{'tar'}) . ' -czopf ' . shell_string($cInstallDBBackupFileName) . ' ' . shell_string($cInstallDBFileName) . ' 2> /dev/null');

    print wrap('Uninstalling the old installation of VMware.' . "\n\n", 0);
    if (system(shell_string($cOldInstaller) . ' uninstall')) {
      unlink($cInstallDBBackupFileName);
      error('Failure' . "\n\n");
    }
      }

      # Restore the database suitable for our installer
      system(shell_string($gHelper{'tar'}) . ' -C / -xzopf ' . shell_string($cInstallDBBackupFileName));
      unlink($cInstallDBBackupFileName);

      db_load();
    }
    db_reset();
    install_or_upgrade();

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

    $answer = get_persistent_answer('Before running VMware for the first time, you need to configure it for your running kernel by invoking the following command: "' . db_get_answer('BINDIR') . '/vmware-config.pl". Do you want this script to invoke the command for you now?', 'RUN_CONFIGURATOR', 'yesno', 'yes');
    db_save();
    if ($answer eq 'yes') {
      system(shell_string(db_get_answer('BINDIR') . '/vmware-config.pl'));
    } else {
      print wrap('Enjoy,' . "\n\n" . '    --the VMware team' . "\n\n", 0);
    }

    exit 0;
  }
  if (internal_basename($0) eq $cUninstallerFileName) {
    if (not (-e $cInstallDBFileName)) {
      error('Unable to find the tar installer database file (' . $cInstallDBFileName . ')' . "\n\n");
    }
    db_load();

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

    exit 0;
  }
  error('This script must be named ' . $cInstallerFileName . ' or ' . $cUninstallerFileName . '.' . "\n\n");
}

main();