home *** CD-ROM | disk | FTP | other *** search
/ Chip: Linux Special / CorelLinux_CHIP.iso / VMware / bin / vmware-config.pl < prev    next >
Encoding:
Perl Script  |  1999-11-10  |  57.9 KB  |  1,779 lines
  1. #!/usr/bin/perl -w
  2. # If your copy of perl is not in /usr/bin, please adjust the line above.
  3. #
  4. # Copyright (C) 1998, 1999 VMware, Inc.  All Rights Reserved.
  5. #
  6. # Host configurator for VMware
  7.  
  8. use strict;
  9.  
  10. # Constants
  11. my $cEtcDir = '/etc';
  12. my $cInstallDBDir = $cEtcDir . '/vmware';
  13. my $cInstallDBFileName = $cInstallDBDir . '/locations';
  14. my $cConfFlag = $cInstallDBDir . '/not_configured';
  15. my $cKernelModuleDir = '/lib/modules';
  16.  
  17. # Global variables
  18. my %gSystem;
  19. my %gHelper;
  20. my @gAvailEthIf;
  21. # By convention, vmnet1 is the virtual ethernet interface connected to the
  22. # private virtual network
  23. my $gHostOnlyEthIf = 'vmnet1';
  24.  
  25. # BEGINNING OF THE SECOND LIBRARY FUNCTIONS
  26. # Global variables
  27. my %gDBAnswer;
  28. my %gDBFile;
  29. my %gDBDir;
  30.  
  31. # Load the installer database
  32. sub db_load { 
  33.   open(INSTALLDB, '<' . $cInstallDBFileName) or error('Unable to open the installer database ' . $cInstallDBFileName . ' in read-mode.' . "\n\n");
  34.   while (<INSTALLDB>) {
  35.     if (/^answer (\S+) (\S+)/) {
  36.       $gDBAnswer{$1} = $2;
  37.     } elsif (/^answer (\S+)/) {
  38.       $gDBAnswer{$1} = '';
  39.     } elsif (/^remove_answer (\S+)/) {
  40.       delete $gDBAnswer{$1};
  41.     } elsif (/^file (\S+) (\S+)/) {
  42.       $gDBFile{$1} = $2;
  43.     } elsif (/^file (\S+)/) {
  44.       $gDBFile{$1} = 0;
  45.     } elsif (/^remove_file (\S+)/) {
  46.       delete $gDBFile{$1};
  47.     } elsif (/^directory (\S+)/) {
  48.       $gDBDir{$1} = '';
  49.     }
  50.   }
  51.   close(INSTALLDB);
  52. }
  53.  
  54. # Open the database on disk in append mode
  55. sub db_append {
  56.   if (not open(INSTALLDB, '>>' . $cInstallDBFileName)) {
  57.     error('Unable to open the installer database ' . $cInstallDBFileName . ' in append-mode.' . "\n\n");
  58.   }
  59.   # Force a flush after every write operation.
  60.   # See 'Programming Perl', p. 110
  61.   select((select(INSTALLDB), $| = 1)[0]);
  62. }
  63.  
  64. # Add a file to the tar installer database
  65. sub db_add_file {
  66.   my $file = shift;
  67.   my $flags = shift;
  68.  
  69.   if ($flags & 0x1) {
  70.     my @statbuf;
  71.  
  72.     @statbuf = stat($file);
  73.     if (not (defined($statbuf[9]))) {
  74.       error('Unable to get the last modification timestamp of the destination file ' . $file . '.' . "\n\n");
  75.     }
  76.  
  77.     $gDBFile{$file} = $statbuf[9];
  78.     print INSTALLDB 'file ' . $file . ' ' . $statbuf[9] . "\n";
  79.   } else {
  80.     $gDBFile{$file} = 0;
  81.     print INSTALLDB 'file ' . $file . "\n";
  82.   }
  83. }
  84.  
  85. # Remove a file from the tar installer database
  86. sub db_remove_file {
  87.   my $file = shift;
  88.  
  89.   print INSTALLDB 'remove_file ' . $file . "\n";
  90.   delete $gDBFile{$file};
  91. }
  92.  
  93. # Determine if a file belongs to the tar installer database
  94. sub db_file_in {
  95.   my $file = shift;
  96.  
  97.   return defined($gDBFile{$file});
  98. }
  99.  
  100. # Return the timestamp of an installed file
  101. sub db_file_ts {
  102.   my $file = shift;
  103.  
  104.   return $gDBFile{$file};
  105. }
  106.  
  107. # Add a directory to the tar installer database
  108. sub db_add_dir {
  109.   my $dir = shift;
  110.  
  111.   $gDBDir{$dir} = '';
  112.   print INSTALLDB 'directory ' . $dir . "\n";
  113. }
  114.  
  115. # Remove an answer from the tar installer database
  116. sub db_remove_answer {
  117.   my $id = shift;
  118.  
  119.   if (defined($gDBAnswer{$id})) {
  120.     print INSTALLDB 'remove_answer ' . $id . "\n";
  121.     delete $gDBAnswer{$id};
  122.   }
  123. }
  124.  
  125. # Add an answer to the tar installer database
  126. sub db_add_answer {
  127.   my $id = shift;
  128.   my $value = shift;
  129.  
  130.   db_remove_answer($id);
  131.   $gDBAnswer{$id} = $value;
  132.   print INSTALLDB 'answer ' . $id . ' ' . $value . "\n";
  133. }
  134.  
  135. # Retrieve an answer that must be present in the database
  136. sub db_get_answer {
  137.   my $id = shift;
  138.  
  139.   if (not defined($gDBAnswer{$id})) {
  140.     error('Unable to find the answer ' . $id . ' in the installer database (' . $cInstallDBFileName . '). You may want to re-install VMware.' . "\n\n");
  141.   }
  142.  
  143.   return $gDBAnswer{$id};
  144. }
  145.  
  146. # Save the tar installer database
  147. sub db_save {
  148.   close(INSTALLDB);
  149. }
  150. # END OF THE SECOND LIBRARY FUNCTIONS
  151.  
  152. # BEGINNING OF THE LIBRARY FUNCTIONS
  153. # Constants
  154. my $cTerminalLineSize = 80;
  155.  
  156. # Global variables
  157. my %gOption;
  158. my %gAnswerSize;
  159. my %gCheckAnswerFct;
  160.  
  161. # Tell if the user is the super user
  162. sub is_root {
  163.   return $> == 0;
  164. }
  165.  
  166. # Wordwrap system: append some content to the output
  167. sub append_output {
  168.   my $output = shift;
  169.   my $pos = shift;
  170.   my $append = shift;
  171.  
  172.   $output .= $append;
  173.   $pos = ($pos + length($append)) % $cTerminalLineSize;
  174.  
  175.   return ($output, $pos);
  176. }
  177.  
  178. # Wordwrap system: deal with the next character
  179. sub wrap_one_char {
  180.   my $output = shift;
  181.   my $pos = shift;
  182.   my $word = shift;
  183.   my $char = shift;
  184.   my $reserved = shift;
  185.   my $length;
  186.  
  187.   if (not (($char eq "\n") || ($char eq ' ') || ($char eq ''))) {
  188.     $word .= $char;
  189.  
  190.     return ($output, $pos, $word);
  191.   }
  192.  
  193.   # We found a separator. Process the last word
  194.  
  195.   $length = length($word) + $reserved;
  196.   if ((($pos + $length) > $cTerminalLineSize) && ($length <= $cTerminalLineSize)) {
  197.     # The word is too large to fit in the end of line, but can fit in a new
  198.     # empty line, let's create one for it
  199.     $output .= "\n";
  200.     $pos = 0;
  201.   }
  202.  
  203.   ($output, $pos) = append_output($output, $pos, $word);
  204.   $word = '';
  205.  
  206.   if ($char eq "\n") {
  207.     $output .= "\n";
  208.     $pos = 0;
  209.   } elsif ($char eq ' ') {
  210.     if ($pos) {
  211.       ($output, $pos) = append_output($output, $pos, ' ');
  212.     }
  213.   }
  214.  
  215.   return ($output, $pos, $word);
  216. }
  217.  
  218. # Wordwrap system: word-wrap a string plus some reserved trailing space
  219. sub wrap {
  220.   my $input = shift;
  221.   my $reserved = shift;
  222.   my $output;
  223.   my $pos;
  224.   my $word;
  225.   my $i;
  226.  
  227.   $output = '';
  228.   $pos = 0;
  229.   $word = '';
  230.   for ($i = 0; $i < length($input); $i++) {
  231.     ($output, $pos, $word) = wrap_one_char($output, $pos, $word, substr($input, $i, 1), 0);
  232.   }
  233.   # Use an artifical last '' separator to process the last word
  234.   ($output, $pos, $word) = wrap_one_char($output, $pos, $word, '', $reserved);
  235.  
  236.   return $output;
  237. }
  238.  
  239. # Print an error message and exit
  240. sub error {
  241.   my $msg = shift;
  242.  
  243.   print STDERR wrap($msg . 'Execution aborted.' . "\n\n", 0);
  244.   exit 1;
  245. }
  246.  
  247. # Convert a string to its equivalent shell representation
  248. sub shell_string {
  249.   my $single_quoted = shift;
  250.  
  251.   $single_quoted =~ s/'/'"'"'/g;
  252.   # This comment is a fix for emacs's broken syntax-highlighting code --hpreg
  253.   return '\'' . $single_quoted . '\'';
  254. }
  255.  
  256. # Contrary to a popular belief, 'which' is not always a shell builtin command.
  257. # So we can not trust it to determine the location of other binaries.
  258. # Moreover, SuSE 6.1's 'which' is unable to handle program names beginning with
  259. # a '/'...
  260. #
  261. # Return value is the complete path if found, or '' if not found
  262. sub internal_which {
  263.   my $bin = shift;
  264.  
  265.   if (substr($bin, 0, 1) eq '/') {
  266.     # Absolute name
  267.     if ((-f $bin) && (-x $bin)) {
  268.       return $bin;
  269.     }
  270.   } else {
  271.     # Relative name
  272.     my @paths;
  273.     my $path;
  274.  
  275.     if (index($bin, '/') == -1) {
  276.       # There is no other '/' in the name
  277.       @paths = split(':', $ENV{'PATH'});
  278.       foreach $path (@paths) {
  279.     my $fullbin;
  280.  
  281.     $fullbin = $path . '/' . $bin;
  282.     if ((-f $fullbin) && (-x $fullbin)) {
  283.       return $fullbin;
  284.     }
  285.       }
  286.     }
  287.   }
  288.  
  289.   return '';
  290. }
  291.  
  292. # Remove leading and trailing whitespaces
  293. sub remove_whitespaces {
  294.   my $string = shift;
  295.  
  296.   $string =~ s/^\s*//;
  297.   $string =~ s/\s*$//;
  298.   return $string;
  299. }
  300.  
  301. # Ask a question to the user and propose an optional default value
  302. # Use this when you don't care about the validity of the answer
  303. sub query {
  304.     my $message = shift;
  305.     my $defaultreply = shift;
  306.     my $reserved = shift;
  307.     my $reply;
  308.  
  309.     # Reserve some room for the reply
  310.     print wrap($message . (($defaultreply eq '') ? '' : (' [' . $defaultreply . ']')), 1 + $reserved);
  311.     # This is what the 1 is for
  312.     print ' ';
  313.        
  314.     if ($gOption{'default'} == 1) {
  315.       # Simulate the enter key
  316.       print "\n";
  317.       $reply = '';
  318.     } else {
  319.       chop($reply = <STDIN>);
  320.     }
  321.  
  322.     print "\n";
  323.     $reply = remove_whitespaces($reply);
  324.     if ($reply eq '') {
  325.       $reply = $defaultreply;
  326.     }
  327.     return $reply;
  328. }
  329.  
  330. # Check the validity of an answer whose type is yesno
  331. # Return a clean answer if valid, or ''
  332. sub check_answer_binpath {
  333.   my $answer = shift;
  334.   my $source = shift;
  335.  
  336.   if (not (internal_which($answer) eq '')) {
  337.     return $answer;
  338.   }
  339.  
  340.   if ($source eq 'user') {
  341.     print wrap('The answer "' . $answer . '" is invalid. It must be the complete name of a binary file.' . "\n\n", 0);
  342.   }
  343.   return '';
  344. }
  345. $gAnswerSize{'binpath'} = 20;
  346. $gCheckAnswerFct{'binpath'} = \&check_answer_binpath;
  347.  
  348. # Prompts the user if a binary is not found
  349. # Return value is:
  350. #  '': the binary has not been found
  351. #  the binary name if it has been found
  352. sub DoesBinaryExist_Prompt {
  353.   my $bin = shift;
  354.   my $answer;
  355.  
  356.   $answer = check_answer_binpath($bin, 'default');
  357.   if (not ($answer eq '')) {
  358.     return $answer;
  359.   }
  360.  
  361.   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') {
  362.     return '';
  363.   }
  364.  
  365.   return get_answer('What is the location of the "' . $bin . '" program on your machine?', 'binpath', '');
  366. }
  367.  
  368. # Execute the command passed as an argument
  369. # _without_ interpolating variables (Perl does it by default)
  370. sub direct_command {
  371.   return `$_[0]`;
  372. }
  373.  
  374. # chmod() that reports errors
  375. sub safe_chmod {
  376.   my $mode = shift;
  377.   my $file = shift;
  378.  
  379.   if (chmod($mode, $file) != 1) {
  380.     error('Unable to change the access rights of the file ' . $file . '.' . "\n\n");
  381.   }
  382. }
  383.  
  384. # Emulate a simplified ls program for directories
  385. sub internal_ls {
  386.   my $dir = shift;
  387.   my @fn;
  388.  
  389.   opendir(LS, $dir);
  390.   @fn = grep(!/^\.\.?$/, readdir(LS));
  391.   closedir(LS);
  392.  
  393.   return @fn;
  394. }
  395.  
  396. # Install a file permission
  397. sub install_permission {
  398.   my $src = shift;
  399.   my $dst = shift;
  400.   my @statbuf;
  401.  
  402.   @statbuf = stat($src);
  403.   if (not (defined($statbuf[2]))) {
  404.     error('Unable to get the access rights of the source file ' . $src . '.' . "\n\n");
  405.   }
  406.   safe_chmod($statbuf[2] & 0xFFF, $dst);
  407. }
  408.  
  409. # Emulate a simplified sed program
  410. # Return 1 if success, 0 if failure
  411. sub internal_sed {
  412.   my $src = shift;
  413.   my $dst = shift;
  414.   my $append = shift;
  415.   my $patchRef = shift;
  416.   my @patchKeys;
  417.  
  418.   if (not open(SRC, '<' . $src)) {
  419.     return 0;
  420.   }
  421.   if (not open(DST, (($append == 1) ? '>>' : '>') . $dst)) {
  422.     return 0;
  423.   }
  424.  
  425.   @patchKeys = keys(%$patchRef);
  426.   if ($#patchKeys == -1) {
  427.     while(defined($_ = <SRC>)) {
  428.       print DST $_;
  429.     }
  430.   } else {
  431.     while(defined($_ = <SRC>)) {
  432.       my $patchKey;
  433.  
  434.       foreach $patchKey (@patchKeys) {
  435.     s/$patchKey/$$patchRef{$patchKey}/g;
  436.       }
  437.  
  438.       print DST $_;
  439.     }
  440.   }
  441.  
  442.   close(SRC);
  443.   close(DST);
  444.   return 1;
  445. }
  446.  
  447. # Check if a file name exists
  448. sub file_name_exist {
  449.   my $file = shift;
  450.  
  451.   # Note: We must test for -l before, because if an existing symlink points to
  452.   #       a non-existing file, -e will be false
  453.   return ((-l $file) || (-e $file))
  454. }
  455.  
  456. # Check if a file already exists and prompt the user
  457. # Return 0 if the file can be written safely, 1 otherwise
  458. sub file_check_exist {
  459.   my $file = shift;
  460.  
  461.   if (not file_name_exist($file)) {
  462.     return 0;
  463.   }
  464.  
  465.   # The default must make sure that the product will be correctly installed
  466.   # We give the user the choice so that a sysadmin can perform a normal
  467.   # install on a NFS server and then answer 'no' NFS clients
  468.   return (get_answer('The file ' . $file . ' that this script was about to install already exists. Overwrite?', 'yesno', 'yes') eq 'yes') ? 0 : 1;
  469. }
  470.  
  471. # Install one file
  472. sub install_file {
  473.   my $src = shift;
  474.   my $dst = shift;
  475.   my $patchRef = shift;
  476.   my $ts = shift;
  477.  
  478.   uninstall_file($dst);
  479.   if (file_check_exist($dst)) {
  480.     return;
  481.   }
  482.   # The file could be a symlink to another location. Remove it
  483.   unlink($dst);
  484.   if (not internal_sed($src, $dst, 0, $patchRef)) {
  485.     error('Unable to copy the source file ' . $src . ' to the destination file ' . $dst . '.' . "\n\n");
  486.   }
  487.   db_add_file($dst, $ts);
  488.   install_permission($src, $dst);
  489. }
  490.  
  491. # mkdir() that reports errors
  492. sub safe_mkdir {
  493.   my $file = shift;
  494.  
  495.   if (mkdir($file, 0000) == 0) {
  496.     error('Unable to create the directory ' . $file . '.' . "\n\n");
  497.   }
  498. }
  499.  
  500. # Remove trailing slashes in a dir path
  501. sub dir_remove_trailing_slashes {
  502.   my $path = shift;
  503.  
  504.   for(;;) {
  505.     my $len;
  506.     my $pos;
  507.  
  508.     $len = length($path);
  509.     if ($len < 2) {
  510.       # Could be '/' or any other character. Ok.
  511.       return $path;
  512.     }
  513.  
  514.     $pos = rindex($path, '/');
  515.     if ($pos != $len - 1) {
  516.       # No trailing slash
  517.       return $path;
  518.     }
  519.  
  520.     # Remove the trailing slash
  521.     $path = substr($path, 0, $len - 1)
  522.   }
  523. }
  524.  
  525. # Emulate a simplified dirname program
  526. sub internal_dirname {
  527.   my $path = shift;
  528.   my $pos;
  529.  
  530.   $path = dir_remove_trailing_slashes($path);
  531.  
  532.   $pos = rindex($path, '/');
  533.   if ($pos == -1) {
  534.     # No slash
  535.     return '.';
  536.   }
  537.  
  538.   if ($pos == 0) {
  539.     # The only slash is at the beginning
  540.     return '/';
  541.   }
  542.  
  543.   return substr($path, 0, $pos);
  544. }
  545.  
  546. # Create a hierarchy of directories with permission 0755
  547. # Return 1 if the directory existed before
  548. sub create_dir {
  549.   my $dir = shift;
  550.   my $use_db = shift;
  551.  
  552.   if (-d $dir) {
  553.     return 1;
  554.   }
  555.  
  556.   if (index($dir, '/') != -1) {
  557.     create_dir(internal_dirname($dir), $use_db);
  558.   }
  559.   safe_mkdir($dir);
  560.   if ($use_db) {
  561.     db_add_dir($dir);
  562.   }
  563.   safe_chmod(0755, $dir);
  564.   return 0;
  565. }
  566.  
  567. # Get a valid non-persistent answer to a question
  568. # Use this when the answer shouldn't be stored in the database
  569. sub get_answer {
  570.   my $msg = shift;
  571.   my $type = shift;
  572.   my $default = shift;
  573.   my $answer;
  574.  
  575.   if (not defined($gAnswerSize{$type})) {
  576.     die 'get_answer(): type ' . $type . ' not implemented :(' . "\n\n";
  577.   }
  578.   for (;;) {
  579.     $answer = check_answer(query($msg, $default, $gAnswerSize{$type}), $type, 'user');
  580.     if (not ($answer eq '')) {
  581.       return $answer;
  582.     }
  583.   }
  584. }
  585.  
  586. # Get a valid persistent answer to a question
  587. # Use this when you want an answer to be stored in the database
  588. sub get_persistent_answer {
  589.   my $msg = shift;
  590.   my $id = shift;
  591.   my $type = shift;
  592.   my $default = shift;
  593.   my $answer;
  594.  
  595.   if (defined($gDBAnswer{$id})) {
  596.     # There is a previous answer in the database
  597.     $answer = check_answer($gDBAnswer{$id}, $type, 'db');
  598.     if (not ($answer eq '')) {
  599.       # The previous answer is valid. Make it the default value
  600.       $default = $answer;
  601.     }
  602.   }
  603.  
  604.   $answer = get_answer($msg, $type, $default);
  605.   db_add_answer($id, $answer);
  606.   return $answer;
  607. }
  608.  
  609. # Find a suitable backup name and backup a file
  610. sub backup_file {
  611.   my $file = shift;
  612.   my $i;
  613.  
  614.   for ($i = 0; $i < 100; $i++) {
  615.     if (! -e $file . '.old.' . $i) {
  616.       my %patch;
  617.  
  618.       undef %patch;
  619.       if (internal_sed($file, $file . '.old.' . $i, 0, \%patch)) {
  620.     print wrap('File ' . $file . ' is backed up to ' . $file . '.old.' . $i . '.' . "\n\n", 0);
  621.       } else {
  622.     print STDERR wrap('Unable to backup the file ' . $file . ' to ' . $file . '.old.' . $i .'.' . "\n\n", 0);
  623.       }
  624.       return;
  625.     }
  626.   }
  627.  
  628.   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);
  629. }
  630.  
  631. # Uninstall a file previously installed by us
  632. sub uninstall_file {
  633.   my $file = shift;
  634.  
  635.   if (not db_file_in($file)) {
  636.     # Not installed by this script
  637.     return;
  638.   }
  639.  
  640.   if (file_name_exist($file)) {
  641.     if (db_file_ts($file)) {
  642.       my @statbuf;
  643.  
  644.       @statbuf = stat($file);
  645.       if (defined($statbuf[9])) {
  646.     if (db_file_ts($file) != $statbuf[9]) {
  647.       # Modified since this script installed it
  648.       backup_file($file);
  649.     }
  650.       } else {
  651.     print STDERR wrap('Unable to get the last modification timestamp of the file ' . $file . '.' . "\n\n", 0);
  652.       }
  653.     }
  654.   } else {
  655.     print wrap('This script previously created the file ' . $file . ', and was about to remove it. Somebody else apparently did it already.' . "\n\n", 0);
  656.   }
  657.  
  658.   if (not unlink($file)) {
  659.     print STDERR wrap('Unable to remove the file ' . $file . '.' . "\n\n", 0);
  660.   }
  661.   db_remove_file($file);
  662. }
  663.  
  664. # Return the version of VMware
  665. sub vmware_version {
  666.   my $buildNr;
  667.  
  668.   $buildNr = '1.1.2 ' . q$Name: build-364 $;
  669.   $buildNr =~ s/Name: //;
  670.   return remove_whitespaces($buildNr);
  671. }
  672.  
  673. # Check the validity of an answer whose type is yesno
  674. # Return a clean answer if valid, or ''
  675. sub check_answer_yesno {
  676.   my $answer = shift;
  677.   my $source = shift;
  678.  
  679.   if (lc($answer) =~ /^y(es)?$/) {
  680.     return 'yes';
  681.   }
  682.  
  683.   if (lc($answer) =~ /^n(o)?$/) {
  684.     return 'no';
  685.   }
  686.  
  687.   if ($source eq 'user') {
  688.     print wrap('The answer "' . $answer . '" is invalid. It must be one of "y" or "n".' . "\n\n", 0);
  689.   }
  690.   return '';
  691. }
  692. $gAnswerSize{'yesno'} = 3;
  693. $gCheckAnswerFct{'yesno'} = \&check_answer_yesno;
  694.  
  695. # Check the validity of an answer based on its type
  696. # Return a clean answer if valid, or ''
  697. sub check_answer {
  698.   my $answer = shift;
  699.   my $type = shift;
  700.   my $source = shift;
  701.  
  702.   if (not defined($gCheckAnswerFct{$type})) {
  703.     die 'check_answer(): type ' . $type . ' not implemented :(' . "\n\n";
  704.   }
  705.   return &{$gCheckAnswerFct{$type}}($answer, $source);
  706. }
  707. # END OF THE LIBRARY FUNCTIONS
  708.  
  709. # Set up the location of external helpers
  710. sub initialize_external_helpers {
  711.   my $program;
  712.  
  713.   $gHelper{'more'} = '';
  714.   if (defined($ENV{'PAGER'})) {
  715.     my @tokens;
  716.  
  717.     # The environment variable sometimes contains the pager name _followed by
  718.     # a few command line options_.
  719.     #
  720.     # Isolate the program name (we are certain it does not contain a
  721.     # whitespace) before dealing with it.
  722.     @tokens = split(' ', $ENV{'PAGER'});
  723.     $tokens[0] = DoesBinaryExist_Prompt($tokens[0]);
  724.     if (not ($tokens[0] eq '')) {
  725.       $gHelper{'more'} = join(' ', @tokens); # This is _already_ a shell string
  726.     }
  727.   }
  728.   if ($gHelper{'more'} eq '') {
  729.     $gHelper{'more'} = DoesBinaryExist_Prompt('more');
  730.     if ($gHelper{'more'} eq '') {
  731.       error('Unable to continue.' . "\n\n");
  732.     }
  733.     $gHelper{'more'} = shell_string($gHelper{'more'}); # Save it as a shell string
  734.   }
  735.  
  736.   foreach $program ('uname', 'grep', 'ldd', 'mknod', 'insmod', 'modprobe', 'ifconfig') {
  737.     $gHelper{$program} = DoesBinaryExist_Prompt($program);
  738.     if ($gHelper{$program} eq '') {
  739.       error('Unable to continue.' . "\n\n");
  740.     }
  741.   }
  742. }
  743.  
  744. # Check the validity of an answer whose type is headerdir
  745. # Return a clean answer if valid, or ''
  746. sub check_answer_headerdir {
  747.   my $answer = shift;
  748.   my $source = shift;
  749.   my $pattern = '@@VMWARE@@';
  750.   my $header_version_uts;
  751.   my $header_smp;
  752.   my $header_page_offset;
  753.  
  754.   $answer = dir_remove_trailing_slashes($answer);
  755.  
  756.   if (not (-d $answer)) {
  757.     if ($source eq 'user') {
  758.       print wrap('The path "' . $answer . '" is not an existing directory.' . "\n\n", 0);
  759.     }
  760.     return '';
  761.   }
  762.  
  763.   if (   (not (-d $answer . '/linux'))
  764.       || (not (-d $answer . '/asm'))
  765.       || (not (-d $answer . '/net'))) {
  766.     if ($source eq 'user') {
  767.       print wrap('The path "' . $answer . '" is an existing directory, but it does not contain at least one of these directories "linux", "asm", "net" as expected.' . "\n\n", 0);
  768.     }
  769.     return '';
  770.   }
  771.  
  772.   #
  773.   # Check that the running kernel matches the set of header files
  774.   #
  775.  
  776.   if (not (-r $answer . '/linux/version.h')) {
  777.     if ($source eq 'user') {
  778.       print wrap('The path "' . $answer . '" is a kernel header file directory, but it does not contain the file "linux/version.h" as expected. This can happen if the kernel has never been built, or if you have invoked the "make mrproper" command in your kernel directory. In any case, you may want to rebuild your kernel.' . "\n\n", 0);
  779.     }
  780.     return '';
  781.   }
  782.   $header_version_uts = direct_command(shell_string($gHelper{'echo'}) . ' ' . shell_string('#include <linux/version.h>' . "\n" . $pattern . ' UTS_RELEASE') . ' | ' . shell_string($gHelper{'gcc'}) . ' ' . shell_string('-I' . $answer) . ' -E - | ' . shell_string($gHelper{'grep'}) . ' ' . shell_string($pattern));
  783.   chop($header_version_uts);
  784.   $header_version_uts =~ s/^$pattern \"([^\"]*)\".*$/$1/;
  785.   if (not ($header_version_uts eq $gSystem{'version_uts'})) {
  786.     if ($source eq 'user') {
  787.       print wrap('The directory of kernel headers (version ' . $header_version_uts . ') does not match your running kernel (version ' . $gSystem{'version_uts'} . '). Consequently, even if the compilation of the module was successful, the module would not load into the running kernel.' . "\n\n", 0);
  788.     }
  789.     return '';
  790.   }
  791.  
  792.   if (not (-r $answer . '/linux/autoconf.h')) {
  793.     if ($source eq 'user') {
  794.       print wrap('The path "' . $answer . '" is a kernel header file directory, but it does not contain the file "linux/autoconf.h" as expected. This can happen if the kernel has never been built, or if you have invoked the "make mrproper" command in your kernel directory. In any case, you may want to rebuild your kernel.' . "\n\n", 0);
  795.     }
  796.     return '';
  797.   }
  798.   $header_smp = direct_command(shell_string($gHelper{'grep'}) . ' CONFIG_SMP ' . shell_string($answer . '/linux/autoconf.h'));
  799.   if (not ($header_smp eq '')) {
  800.     # We found a valid up/smp information
  801.     $header_smp = ($header_smp =~ /^\#define CONFIG_SMP/) ? 'yes' : 'no';
  802.     if (not (lc($header_smp) eq lc($gSystem{'smp'}))) {
  803.       if ($source eq 'user') {
  804.     print wrap('The kernel defined by this directory of header files is ' . (($header_smp eq 'yes') ? 'multiprocessor' : 'uniprocessor') . ', while your running kernel is ' . (($gSystem{'version_uts'} eq 'yes') ? 'multiprocessor' : 'uniprocessor') . '.' . "\n\n", 0);
  805.       }
  806.       return '';
  807.     }
  808.   }
  809.  
  810.   if (not (-r $answer . '/asm/page.h')) {
  811.     if ($source eq 'user') {
  812.       print wrap('The path "' . $answer . '" is a kernel header file directory, but it does not contain the file "asm/page.h" as expected.' . "\n\n", 0);
  813.     }
  814.     return '';
  815.   }
  816.   $header_page_offset = direct_command(shell_string($gHelper{'echo'}) . ' ' . shell_string('#define __KERNEL__' . "\n" . '#include <asm/page.h>' . "\n" . $pattern . ' __PAGE_OFFSET') . ' | ' . shell_string($gHelper{'gcc'}) . ' ' . shell_string('-I' . $answer) . ' -E - | ' . shell_string($gHelper{'grep'}) . ' ' . shell_string($pattern));
  817.   chop($header_page_offset);
  818.   $header_page_offset =~ s/^$pattern \(0x([0-9a-fA-F]{8}).*$/$1/;
  819.   if ($header_page_offset =~ /[0-9a-fA-F]{8}/) {
  820.     # We found a valid page offset
  821.     if (not (lc($header_page_offset) eq lc($gSystem{'page_offset'}))) {
  822.       if ($source eq 'user') {
  823.     print wrap('The kernel defined by this directory of header files does not have the same address space size as your running kernel.' . "\n\n", 0);
  824.       }
  825.       return '';
  826.     }
  827.   }
  828.  
  829.   return $answer;
  830. }
  831. $gAnswerSize{'headerdir'} = 20;
  832. $gCheckAnswerFct{'headerdir'} = \&check_answer_headerdir;
  833.  
  834. # Check the validity of an answer whose type is ip
  835. # Return a clean answer if valid, or ''
  836. sub check_answer_ip {
  837.   my $answer = shift;
  838.   my $source = shift;
  839.  
  840.   # I'm in love with regular expressions --hpreg
  841.   if ($answer =~ /^([0-9]|[1-9][0-9]|1[0-9][0-9]|2([0-4][0-9]|5[0-5]))(\.([0-9]|[1-9][0-9]|1[0-9][0-9]|2([0-4][0-9]|5[0-5]))){3}$/) {
  842.     return $answer;
  843.   }
  844.  
  845.   if ($source eq 'user') {
  846.     print wrap('The answer "' . $answer . '" is invalid. It must be of the form a.b.c.d where a, b, c and d are decimal numbers between 0 and 255.' . "\n\n", 0);
  847.   }
  848.   return '';
  849. }
  850. $gAnswerSize{'ip'} = 15;
  851. $gCheckAnswerFct{'ip'} = \&check_answer_ip;
  852.  
  853. # Check the validity of an answer whose type is yesnohelp
  854. # Return a clean answer if valid, or ''
  855. sub check_answer_yesnohelp {
  856.   my $answer = shift;
  857.   my $source = shift;
  858.  
  859.   if (lc($answer) =~ /^y(es)?$/) {
  860.     return 'yes';
  861.   }
  862.  
  863.   if (lc($answer) =~ /^n(o)?$/) {
  864.     return 'no';
  865.   }
  866.  
  867.   if (lc($answer) =~ /^h(elp)?$/) {
  868.     return 'help';
  869.   }
  870.  
  871.   if ($source eq 'user') {
  872.     print wrap('The answer "' . $answer . '" is invalid. It must be one of "y", "n" or "h".' . "\n\n", 0);
  873.   }
  874.   return '';
  875. }
  876. $gAnswerSize{'yesnohelp'} = 4;
  877. $gCheckAnswerFct{'yesnohelp'} = \&check_answer_yesnohelp;
  878.  
  879. # Check the validity of an answer whose type is availethif
  880. # Return a clean answer if valid, or ''
  881. sub check_answer_availethif {
  882.   my $answer = shift;
  883.   my $source = shift;
  884.  
  885.   if (grep(/$answer/, @gAvailEthIf)) {
  886.     return $answer;
  887.   }
  888.  
  889.   if ($source eq 'user') {
  890.     print wrap('The answer "' . $answer . '" is invalid. It must be one of ' . join(', ', @gAvailEthIf) . '.' . "\n\n", 0);
  891.   }
  892.   return '';
  893. }
  894. $gAnswerSize{'availethif'} = 4;
  895. $gCheckAnswerFct{'availethif'} = \&check_answer_availethif;
  896.  
  897. # Display the end-user license agreement
  898. sub show_EULA {
  899.   if (   (not defined($gDBAnswer{'EULA_AGREED'}))
  900.       || (db_get_answer('EULA_AGREED') eq 'no')) {
  901.     query('You must read and accept the End User License Agreement to continue.' . "\n" . 'Press enter to display it.', '', 0);
  902.  
  903.     # $gHelper{'more'} is already a shell string
  904.     system($gHelper{'more'} . ' ' . shell_string(db_get_answer('DOCDIR') . '/EULA'));
  905.     print "\n";
  906.  
  907.     # Make sure there is no default answer here
  908.     if (get_persistent_answer('Do you accept? (yes/no)', 'EULA_AGREED', 'yesno', '') eq 'no') {
  909.       print wrap('Please try again when you are ready to accept.' . "\n\n", 0);
  910.       exit 0;
  911.     }
  912.  
  913.     print wrap('Thank you.' . "\n\n", 0);
  914.   }
  915. }
  916.  
  917. # Build a Linux kernel integer version
  918. sub kernel_version_integer {
  919.   my $version = shift;
  920.   my $patchLevel = shift;
  921.   my $subLevel = shift;
  922.  
  923.   return $version * 65536 + $patchLevel * 256 + $subLevel;
  924. }
  925.  
  926. # Retrieve distribution information
  927. sub distribution_info {
  928.   my $issue = '/etc/issue';
  929.   my $system;
  930.  
  931.   # First use the accurate method that are intended to work reliably on recent
  932.   # distributions (if an FHS guy is listening, we really need a generic way to
  933.   # do this)
  934.   if (-e '/etc/debian_version') {
  935.     return 'debian';
  936.   }
  937.   if (-e '/etc/redhat-release') {
  938.     return 'redhat';
  939.   }
  940.   if (-e '/etc/SuSE-release') {
  941.     return 'suse';
  942.   }
  943.   if (-e '/etc/turbolinux-release') {
  944.     return 'turbolinux';
  945.   }
  946.  
  947.   # Then use less accurate methods that should work even on old distributions,
  948.   # if people haven't customized their system too much
  949.   if (-e $issue) {
  950.     if (not (direct_command(shell_string($gHelper{'grep'}) . ' -i ' . shell_string('debian') . ' ' . shell_string($issue)) eq '')) {
  951.       return 'debian';
  952.     }
  953.     if (not (direct_command(shell_string($gHelper{'grep'}) . ' -i ' . shell_string('red *hat') . ' ' . shell_string($issue)) eq '')) {
  954.       return 'redhat';
  955.     }
  956.     if (not (direct_command(shell_string($gHelper{'grep'}) . ' -i ' . shell_string('suse\|s\.u\.s\.e') . ' ' . shell_string($issue)) eq '')) {
  957.       return 'suse';
  958.     }
  959.     if (not (direct_command(shell_string($gHelper{'grep'}) . ' -i ' . shell_string('caldera') . ' ' . shell_string($issue)) eq '')) {
  960.       return 'caldera';
  961.     }
  962.   }
  963.  
  964.   return 'unknown';
  965. }
  966.  
  967. # Retrieve and check system information
  968. sub system_info {
  969.   my $fullVersion;
  970.   my $version;
  971.   my $patchLevel;
  972.   my $subLevel;
  973.   my @fields;
  974.  
  975.   $gSystem{'system'} = direct_command(shell_string($gHelper{'uname'}) . ' -s');
  976.   chop($gSystem{'system'});
  977.   if (not ($gSystem{'system'} eq 'Linux')) {
  978.     error('You are not running Linux. This version of the product only runs on Linux.' . "\n\n");
  979.   }
  980.  
  981.   $gSystem{'version_uts'} = direct_command(shell_string($gHelper{'uname'}) . ' -r');
  982.   chop($gSystem{'version_uts'});
  983.  
  984.   ($version, $patchLevel, $subLevel) = split(/\./, $gSystem{'version_uts'});
  985.   # Clean the subLevel in case there is an extraversion
  986.   ($subLevel) = split(/[^0-9]/, $subLevel);
  987.   $gSystem{'version_utsclean'} = $version . '.' . $patchLevel . '.' . $subLevel;
  988.  
  989.   $gSystem{'version_integer'} = kernel_version_integer($version, $patchLevel, $subLevel);
  990.   if ($gSystem{'version_integer'} < kernel_version_integer(2, 0, 0)) {
  991.     error('You are running Linux version ' . $gSystem{'version_utsclean'} . '. This product only runs on 2.0.0 and later kernels.' . "\n\n");
  992.   }
  993.  
  994.   # CONFIG_UMISC on 2.0 kernels
  995.   if ($gSystem{'version_integer'} < kernel_version_integer(2, 1, 0)) {
  996.     if ((direct_command(shell_string($gHelper{'grep'}) . ' ' . shell_string('^[0-9a-f]* misc_register') . ' /proc/ksyms') eq '') || (direct_command(shell_string($gHelper{'grep'}) . ' ' . shell_string('^[0-9a-fA-F]\{8\} misc_deregister') . ' /proc/ksyms') eq '')) {
  997.       error('You are running a Linux kernel version ' . $gSystem{'version_utsclean'} . ' that was not built with the CONFIG_UMISC configuration parameter set. VMware will not run on this system.' . "\n\n");
  998.     }
  999.   }
  1000.  
  1001.   $gSystem{'smp'} = (direct_command(shell_string($gHelper{'uname'}) . ' -v') =~ / SMP /) ? 'yes' : 'no';
  1002.  
  1003.   $gSystem{'distribution'} = distribution_info();
  1004.  
  1005.   $gSystem{'page_offset'} = 'C0000000';
  1006.   @fields = split(' ', direct_command(shell_string($gHelper{'grep'}) . ' ' . shell_string('^[0-9a-fA-F]\{8\} printk') . ' /proc/ksyms'));
  1007.   if (defined($fields[0])) {
  1008.     my $first;
  1009.  
  1010.     $first = lc(substr($fields[0], 0, 1));
  1011.     if ($first =~ /^[01234567]$/) {
  1012.       # old kernels without the hardware verify_area() support, but that's ok
  1013.       # because those kernel didn't have big memory support either.
  1014.       $first = 'C';
  1015.     } elsif ($first =~ /^[89ab]$/) {
  1016.       $first = '8';
  1017.     } elsif ($first =~ /^[cdef]$/) {
  1018.       $first = 'C';
  1019.     }
  1020.     $gSystem{'page_offset'} = $first . '0000000';
  1021.   }
  1022.  
  1023.   # 3Com bug on 2.0.3[45] kernels
  1024.   if (   ($gSystem{'version_integer'} >= kernel_version_integer(2, 0, 34))
  1025.       && ($gSystem{'version_integer'} <= kernel_version_integer(2, 0, 35))) {
  1026.     if (   (not (-r '/proc/ioports'))
  1027.     || (not (direct_command(shell_string($gHelper{'grep'}) . ' -i ' . shell_string('3c90\|3c59') . ' /proc/ioports') eq ''))) {
  1028.       if (get_answer('You are running Linux version ' . $gSystem{'version_utsclean'} . ' possibly with a 3Com networking card. Linux kernel versions 2.0.34 and 2.0.35 have a bug in the 3Com driver that interacts badly with this product. Specifically, your physical machine will occasionally hang and will require a hard reset. This bug has been fixed in 2.0.36 and later kernels. Do you want to continue the configuration anyway?', 'yesno', 'no') eq 'no') {
  1029.     exit 1;
  1030.       }
  1031.     }
  1032.   }
  1033.  
  1034.   # C library
  1035.   # XXX This relies on the locale
  1036.   if (system(shell_string($gHelper{'ldd'}) . ' ' . shell_string(db_get_answer('BINDIR') . '/vmware') . ' | ' . shell_string($gHelper{'grep'}) . ' -q -i ' . shell_string('not found')) == 0) {
  1037.     print wrap('The correct version of one or more libraries needed to run vmware may be missing. This is the output of ' . $gHelper{'ldd'} . ' ' . db_get_answer('BINDIR') . '/vmware:' . "\n", 0);
  1038.     system(shell_string($gHelper{'ldd'}) . ' ' . shell_string(db_get_answer('BINDIR') . '/vmware'));
  1039.     print "\n";
  1040.     query('This script cannot tell for sure, but you may need to upgrade libc5 to glibc before you can run vmware.' . "\n\n" . 'Hit enter to continue.', '', 0);
  1041.   }
  1042.  
  1043.   # Processor
  1044.   if (direct_command(shell_string($gHelper{'grep'}) . ' ' . shell_string('^cpuid') . ' /proc/cpuinfo') eq '') {
  1045.     error('Your ' . (($gSystem{'smp'} eq 'yes') ? 'processors do' : 'processor does') . ' not support the cpuid instruction. VMware will not run on this system.' . "\n\n");
  1046.   }
  1047.   if (direct_command(shell_string($gHelper{'grep'}) . ' ' . shell_string('^flags.* tsc') . ' /proc/cpuinfo') eq '') {
  1048.     error('Your ' . (($gSystem{'smp'} eq 'yes') ? 'processors do' : 'processor does') . ' not have a Time Stamp Counter. VMware will not run on this system.' . "\n\n");
  1049.   }
  1050. }
  1051.  
  1052. # Install a module if it suitable
  1053. # Return 1 if success, 0 if failure
  1054. sub try_module {
  1055.   my $name = shift;
  1056.   my $mod = shift;
  1057.   my $force = shift;
  1058.   my $dst_dir;
  1059.   my %patch;
  1060.  
  1061.   if (not (-e $mod)) {
  1062.     # The module does not exist
  1063.     return 0;
  1064.   }
  1065.  
  1066.   # Probe the module without loading it or executing its code. It is cool
  1067.   # because it avoids problems like 'Device or resource busy'
  1068.   # Note: -f bypasses only the kernel version check, not the symbol resolution
  1069.   if (system(shell_string($gHelper{'insmod'}) . ' -p ' . ($force ? '-f ' : '') . shell_string($mod) . ' >/dev/null 2>&1')) {
  1070.     return 0;
  1071.   }
  1072.   
  1073.   if (-d $cKernelModuleDir . '/preferred') {
  1074.     $dst_dir = $cKernelModuleDir . '/preferred';
  1075.   } elsif (-d $cKernelModuleDir . '/'. $gSystem{'version_uts'}) {
  1076.     $dst_dir = $cKernelModuleDir . '/' . $gSystem{'version_uts'};
  1077.   } else {
  1078.     error('Unable to find the directory containing the modules for the running kernel.' . "\n\n");
  1079.   }
  1080.   create_dir($dst_dir . '/misc', 1);
  1081.   undef %patch;
  1082.   # Install the module with a .o extension, as the Linux kernel does
  1083.   install_file($mod, $dst_dir . '/misc/' . $name . '.o', \%patch, 1);
  1084.   # The old installer allowed people to manually build modules without .o
  1085.   # extension. Such modules were not removed by the old uninstaller, and
  1086.   # unfortunately, insmod tries them first. Let's move them.
  1087.   if (file_name_exist($dst_dir . '/misc/' . $name)) {
  1088.     backup_file($dst_dir . '/misc/' . $name);
  1089.     if (not unlink($dst_dir . '/misc/' . $name)) {
  1090.       print STDERR wrap('Unable to remove the file ' . $dst_dir . '/misc/' . $name . '.' . "\n\n", 0);
  1091.     }
  1092.   }
  1093.  
  1094.   return 1;
  1095. }
  1096.  
  1097. # Remove the build directory
  1098. sub remove_build_dir {
  1099.   my $dir = shift;
  1100.  
  1101.   if (system(shell_string($gHelper{'rm'}) . ' -rf ' . shell_string($dir))) {
  1102.     error('Unable to remove the temporary build directory ' . $dir . '.' . "\n\n");
  1103.   };
  1104. }
  1105.  
  1106. # Build a module
  1107. sub build_module {
  1108.   my $name = shift;
  1109.   my $dir = shift;
  1110.   my $ideal = shift;
  1111.   my $build_dir;
  1112.  
  1113.   # Lazy initialization
  1114.   if (not defined($gHelper{'make'})) {
  1115.     my $program;
  1116.  
  1117.     foreach $program ('make', 'gcc', 'echo', 'tar', 'rm') {
  1118.       $gHelper{$program} = DoesBinaryExist_Prompt($program);
  1119.       if ($gHelper{$program} eq '') {
  1120.     error('Unable to continue.' . "\n\n");
  1121.       }
  1122.     }
  1123.  
  1124.     get_persistent_answer('What is the location of the directory of C header files that match your running kernel?', 'HEADER_DIR', 'headerdir', '/usr/src/linux/include');
  1125.   }
  1126.  
  1127.   print wrap('Extracting the sources of the ' . $name . ' module.' . "\n\n", 0);
  1128.   # Do the work on a local filsystem to avoid NFS vs. root permission problems.
  1129.   $build_dir = defined($ENV{TMPDIR}) ? $ENV{TMPDIR} : '/tmp';
  1130.   $build_dir .= '/vmware/config/' . $$;
  1131.   remove_build_dir($build_dir);
  1132.   create_dir($build_dir, 0);
  1133.  
  1134.   if (system(shell_string($gHelper{'tar'}) . ' -C ' . shell_string($build_dir) . ' -xopf ' . shell_string($dir . '/' . $name . '.tar'))) {
  1135.     error('Unable to untar the file ' . $dir . '/' . $name . '.tar' . ' in the ' . $build_dir . 'directory.' . "\n\n");
  1136.   }
  1137.  
  1138.   print wrap('Building the ' . $name . ' module.' . "\n\n", 0);
  1139.   if (system(shell_string($gHelper{'make'}) . ' -C ' . shell_string($build_dir . '/' . $name . '-only') . ' auto-build ' . (($gSystem{'smp'} eq 'yes') ? 'SUPPORT_SMP=1 ' : ' ') . shell_string('HEADER_DIR=' . db_get_answer('HEADER_DIR')))) {
  1140.     error('Unable to build the ' . $name . ' module.' . "\n\n");
  1141.   }
  1142.  
  1143.   # Don't use the force flag: the module is supposed to perfectly load
  1144.   if (try_module($name, $build_dir . '/' . $name . '.o', 0)) {
  1145.     print wrap('The module has perfectly been loaded in the running kernel.' . "\n\n", 0);
  1146.     remove_build_dir($build_dir);
  1147.     return;
  1148.   }
  1149.  
  1150.   # Don't remove the build dir so that the user can investiguate
  1151.   error('Unable to make a ' . $name . ' module that can be loaded in the running kernel. There is probably a light difference of kernel configuration between the set of C header files you specified and your running kernel. You may want to rebuild a kernel based on that directory, or specify another directory.' . "\n\n");
  1152. }
  1153.  
  1154. # Create a list of modules suitable for the running kernel
  1155. # The kernel module loader does quite a good job when modules are versioned.
  1156. # But in the other case, we must be _very_ careful
  1157. sub get_suitable_modules {
  1158.   my $dir = shift;
  1159.   my @list;
  1160.   my $candidate;
  1161.  
  1162.   @list = ();
  1163.   foreach $candidate (internal_ls($dir)) {
  1164.     my %prop;
  1165.  
  1166.     # Read the properties file
  1167.     if (not open(PROP, '<' . $dir . '/' . $candidate . '/properties')) {
  1168.       print STDERR wrap('Unable to open the property file "' . $dir . '/' . $candidate . '/properties". Skipping this kernel.' . "\n\n");
  1169.       next;
  1170.     }
  1171.     undef %prop;
  1172.     while (<PROP>) {
  1173.       if (/^(\S+) (\S+)/) {
  1174.     $prop{$1} = $2;
  1175.       }
  1176.     }
  1177.     close(PROP);
  1178.  
  1179.     if (not (lc($gSystem{'smp'}) eq lc($prop{'SMP'}))) {
  1180.       # SMP does not match
  1181.       next;
  1182.     }
  1183.     if (not (lc($gSystem{'page_offset'}) eq lc($prop{'PageOffset'}))) {
  1184.       # Page offset does not match
  1185.       next;
  1186.     }
  1187.  
  1188.     if ($gSystem{'version_uts'} eq $prop{'UtsRelease'}) {
  1189.       # Perfect match. Try this module first
  1190.       unshift(@list, ($candidate, $prop{'ModVersion'}));
  1191.     } else {
  1192.       push(@list, ($candidate, $prop{'ModVersion'}));
  1193.     }
  1194.   }
  1195.  
  1196.   return @list;
  1197. }
  1198.  
  1199. # Configure a module
  1200. sub configure_module {
  1201.   my $name = shift;
  1202.   my $mod_dir;
  1203.   my @mod_list;
  1204.  
  1205.   $mod_dir = db_get_answer('LIBDIR') . '/modules';
  1206.   @mod_list = get_suitable_modules($mod_dir . '/binary');
  1207.   while ($#mod_list > -1) {
  1208.     my $candidate = shift(@mod_list);
  1209.     my $modversion = shift(@mod_list);
  1210.  
  1211.     if (try_module($name, $mod_dir . '/binary/' . $candidate . '/objects/' . $name . '.o', $modversion eq 'yes')) {
  1212.       return;
  1213.     }
  1214.   }
  1215.  
  1216.   if (get_persistent_answer('None of VMware' . "'" . 's pre-built ' . $name . ' modules is suitable for your running kernel. Do you want this script to try to build the ' . $name . ' module for your system (you need to have a C compiler installed on your system)?', 'BUILDR_' . $name, 'yesno', 'yes') eq 'no') {
  1217.     error('Unable to continue.' . "\n\n");
  1218.   }
  1219.   build_module($name, $mod_dir . '/source');
  1220. }
  1221.  
  1222. # Create a character device
  1223. sub configure_chrdev {
  1224.   my $name = shift;
  1225.   my $major = shift;
  1226.   my $minor = shift;
  1227.  
  1228.   uninstall_file($name);
  1229.   if (-e $name) {
  1230.     if (-c $name) {
  1231.       my @statbuf;
  1232.  
  1233.       @statbuf = stat($name);
  1234.       if (   defined($statbuf[6])
  1235.           && (($statbuf[6] >> 8) == $major)
  1236.           && (($statbuf[6] & 0xFF) == $minor)) {
  1237.     # The character device is already correctly configured
  1238.     return;
  1239.       }
  1240.     }
  1241.  
  1242.     if (get_answer('This script wanted to create the character device ' . $name . ' with major number ' . $major . ' and minor number ' . $minor . ', but there is already a different kind of file at this location. Overwrite?', 'yesno', 'yes') eq 'no') {
  1243.       error('Unable to continue.' . "\n\n");
  1244.     }
  1245.  
  1246.     # mknod doesn't like when the file already exists
  1247.     unlink($name);
  1248.   }
  1249.   if (system(shell_string($gHelper{'mknod'}) . ' ' . shell_string($name) . ' c ' . shell_string($major) . ' ' . shell_string($minor))) {
  1250.     error('Unable to create the character device ' . $name . ' with major number ' . $major . ' and minor number ' . $minor . '.' . "\n\n");
  1251.   }
  1252.   safe_chmod(0600, $name);
  1253.   # These file don't have a content, don't timestamp them
  1254.   db_add_file($name, 0);
  1255. }
  1256.  
  1257. # Configuration related to the monitor
  1258. sub configure_mon {
  1259.   configure_module('vmmon');
  1260.   configure_chrdev('/dev/vmmon', 10, 165);
  1261. }
  1262.  
  1263. # Configuration related to parallel ports
  1264. sub configure_pp {
  1265.   my $i;
  1266.  
  1267.   if ($gSystem{'version_integer'} < kernel_version_integer(2, 1, 127)) {
  1268.     query('You are running Linux version ' . $gSystem{'version_utsclean'} . ', and this kernel can not provide VMware with Bidirectional Parallel Port support. A fully-featured VMware requires Linux version 2.1.127 or higher.' . "\n\n" . 'Without this support, VMware will run flawlessly, but will lack the ability to use parallel ports in a bidirectional way. This means that it is possible that some parallel port devices (scanners, dongles, ...) will not work inside a Virtual Machine.' . "\n\n" . 'Hit enter to continue.', '', 0);
  1269.     return;
  1270.   }
  1271.  
  1272.   if ($gSystem{'version_integer'} > kernel_version_integer(2, 3, 9)) {
  1273.     query('You are running Linux version ' . $gSystem{'version_utsclean'} . ', and VMware does not provide support for Bidirectional Parallel Ports for Linux version 2.3.10 or higher yet.' . "\n\n" . 'Without this support, VMware will run flawlessly, but will lack the ability to use parallel ports in a bidirectional way. This means that it is possible that some parallel port devices (scanners, dongles, ...) will not work inside a Virtual Machine.' . "\n\n" . 'Hit enter to continue.', '', 0);
  1274.     return;
  1275.   }
  1276.  
  1277.   # The vmppuser module relies on the parport modules. Let's
  1278.   # make sure it is loaded before beginning our tests
  1279.   if (direct_command(shell_string($gHelper{'grep'}) . '  ' . shell_string(' parport_release[^' . "\t" . ']*$') . ' /proc/ksyms') eq '') { 
  1280.     # This comment fixes emacs's broken syntax highlighting
  1281.     # parport support is not built in the kernel
  1282.     if (system(shell_string($gHelper{'modprobe'}) . ' parport')) {
  1283.       query('Unable to load the parport module that is required by the vmppuser module. You may want to load it manually before re-running this script.' . "\n\n" . 'Without this support, VMware will run flawlessly, but will lack the ability to use parallel ports in a bidirectional way. This means that it is possible that some parallel port devices (scanners, dongles, ...) will not work inside a Virtual Machine.' . "\n\n" . 'Hit enter to continue.', '', 0);
  1284.       return;
  1285.     }
  1286.   }
  1287.  
  1288.   # The vmppuser module relies on the parport_pc modules. Let's
  1289.   # make sure it is loaded before beginning our tests
  1290.   if (direct_command(shell_string($gHelper{'grep'}) . '  ' . shell_string(' parport_pc_[^' . "\t" . ']*$') . ' /proc/ksyms') eq '') { 
  1291.     # This comment fixes emacs's broken syntax highlighting
  1292.     # parport_pc support is not built in the kernel
  1293.     if (system(shell_string($gHelper{'modprobe'}) . ' parport_pc')) {
  1294.       query('Unable to load the parport_pc module that is required by the vmppuser module. You may want to load it manually before re-running this script.' . "\n\n" . 'Without this support, VMware will run flawlessly, but will lack the ability to use parallel ports in a bidirectional way. This means that it is possible that some parallel port devices (scanners, dongles, ...) will not work inside a Virtual Machine.' . "\n\n" . 'Hit enter to continue.', '', 0);
  1295.       return;
  1296.     }
  1297.   }
  1298.  
  1299.   configure_module('vmppuser');
  1300.  
  1301.   # Try to unload the modules. Failure is allowed because some other
  1302.   # process could be using them.
  1303.   system(shell_string($gHelper{'modprobe'}) . ' -r parport_pc >/dev/null 2>&1');
  1304.   system(shell_string($gHelper{'modprobe'}) . ' -r parport >/dev/null 2>&1');
  1305.  
  1306.   for ($i = 0; $i < 4; $i++) {
  1307.     configure_chrdev('/dev/parport' . $i, 99, $i);
  1308.   }
  1309. }
  1310.  
  1311. # Configuration of bridged networking
  1312. sub configure_bridged_net {
  1313.   # Get the list of available ethernet interfaces
  1314.   # The -a is important because it lists all interfaces (not only those
  1315.   # which are up). The vmnet driver knows how to deal with down interfaces.
  1316.   open(IFCONFIG, shell_string($gHelper{'ifconfig'}) . ' -a |');
  1317.   @gAvailEthIf = ();
  1318.   while (<IFCONFIG>) {
  1319.     if (/^eth/) {
  1320.       my @fields;
  1321.  
  1322.       @fields = split(/[ ]+/);
  1323.       push(@gAvailEthIf, $fields[0]);
  1324.     }
  1325.   }
  1326.  
  1327.   if ($#gAvailEthIf == -1) {
  1328.     # No interface. We provide a valid default so that everything works.
  1329.     db_add_answer('VNET_INTERFACE', 'eth0');
  1330.     return;
  1331.   }
  1332.  
  1333.   if ($#gAvailEthIf == 0) {
  1334.     # Only one interface. Use it.
  1335.     db_add_answer('VNET_INTERFACE', $gAvailEthIf[0]);
  1336.     return;
  1337.   }
  1338.  
  1339.   # Several interfaces
  1340.   get_persistent_answer('Your computer has multiple ethernet network interfaces: ' . join(', ', @gAvailEthIf) . '. Which one do you want the Virtual Machines to use?', 'VNET_INTERFACE', 'availethif', 'eth0');
  1341. }
  1342.  
  1343. # Probe for an unused private subnet
  1344. # Return value is 1 if success, 0 if failure
  1345. sub hostonly_probe {
  1346.   my $i;
  1347.   my @subnets;
  1348.   my $tries;
  1349.   my $maxTries = 100;
  1350.   my $pings;
  1351.   my $maxPings = 10;
  1352.   # XXX We only consider class C subnets for the moment
  1353.   my $netmask = '255.255.255.0';
  1354.  
  1355.   # Generate the table of private class C subnets
  1356.   @subnets = ();
  1357.   for ($i = 0; $i < 255; $i++) {
  1358.     $subnets[2 * $i    ] = '192.168.' . $i;
  1359.     $subnets[2 * $i + 1] = '172.16.'  . $i;
  1360.   }
  1361.  
  1362.   print wrap('Probing for an unused private subnet (this can take some time).' . "\n\n", 0);
  1363.   $tries = 0;
  1364.   $pings = 0;
  1365.   srand(time);
  1366.   # Beware, 'last' doesn't seem to work in 'do'-'while' loops
  1367.   for (;;) {
  1368.     my $r;
  1369.     my $subnet;
  1370.     my $status;
  1371.  
  1372.     $tries++;
  1373.  
  1374.     $r = int(rand(2 * 256));
  1375.     if ($subnets[$r] eq '') {
  1376.       # Already tried
  1377.       next;
  1378.     }
  1379.     $subnet = $subnets[$r];
  1380.     $subnets[$r] = '';
  1381.  
  1382.     # Our convention is that the host OS IP address is <subnet>.1
  1383.     $status = system(shell_string(db_get_answer('BINDIR') . '/vmware-ping') . ' -q ' . shell_string($subnet . '.1')) >> 8;
  1384.     if ($status == 1) {
  1385.       print wrap('The subnet ' . $subnet . '.0/' . $netmask . ' appears to be unused.' . "\n\n", 0);
  1386.       db_add_answer('VNET_HOSTONLY_HOSTADDR', $subnet . '.1');
  1387.       db_add_answer('VNET_HOSTONLY_NETMASK', $netmask);
  1388.       return 1;
  1389.     }
  1390.  
  1391.     if ($status == 2) {
  1392.       last;
  1393.     }
  1394.  
  1395.     $pings++;
  1396.     if (($pings == $maxPings) || ($tries == $maxTries)) {
  1397.       last;
  1398.     }
  1399.   }
  1400.  
  1401.   print STDERR wrap('We were unable to locate an unused Class C subnet in the range of private network numbers. For each subnet that we tried we received a response to our ICMP ping packets from a host at the network address intended for assignment to this host machine. Because no private subnet appears to be unused you will need to explicitly specify a network number.' . "\n\n", 0);
  1402.   return 0;
  1403. }
  1404.  
  1405. # Display the DHCP copyright information
  1406. sub show_ISC {
  1407.   if (not defined($gDBAnswer{'ISC_COPYRIGHT_SEEN'})) {
  1408.     query('Press enter to display the DHCP server copyright information.', '', 0);
  1409.  
  1410.     # $gHelper{'more'} is already a shell string
  1411.     system($gHelper{'more'} . ' ' . shell_string(db_get_answer('DOCDIR') . '/DHCP-COPYRIGHT'));
  1412.     print "\n";
  1413.  
  1414.     db_add_answer('ISC_COPYRIGHT_SEEN', 'yes');
  1415.   }
  1416. }
  1417.  
  1418. # Compute the subnet associated to a couple IP/netmask
  1419. sub compute_subnet {
  1420.   my $ip = shift;
  1421.   my $netmask = shift;
  1422.   my $prefix;
  1423.  
  1424.   # XXX This should be computed based on the netmask instead of assuming a
  1425.   # class C in case the user has submitted these values
  1426.   ($prefix = $ip) =~ s/\.[0-9]+$//;
  1427.   return $prefix . '.0';
  1428. }
  1429.  
  1430. # Compute the broadcast address associated to a couple IP/netmask
  1431. sub compute_broadcast {
  1432.   my $ip = shift;
  1433.   my $netmask = shift;
  1434.   my $prefix;
  1435.  
  1436.   # XXX This should be computed based on the netmask instead of assuming a
  1437.   # class C in case the user has submitted these values
  1438.   ($prefix = $ip) =~ s/\.[0-9]+$//;
  1439.   return $prefix . '.255';
  1440. }
  1441.  
  1442. # Write VMware's DHCPd configuration files
  1443. sub write_dhcpd_config {
  1444.   my %patch;
  1445.   my $prefix;
  1446.  
  1447.   undef %patch;
  1448.   $patch{'%vmnet%'} = $gHostOnlyEthIf;
  1449.   $patch{'%hostaddr%'} = db_get_answer('VNET_HOSTONLY_HOSTADDR');
  1450.   $patch{'%netmask%'} = db_get_answer('VNET_HOSTONLY_NETMASK');
  1451.   $patch{'%network%'} = compute_subnet($patch{'%hostaddr%'}, $patch{'%netmask%'});
  1452.   $patch{'%broadcast%'} = compute_broadcast($patch{'%hostaddr%'}, $patch{'%netmask%'});
  1453.   # XXX This should be computed based on the netmask instead of assuming a
  1454.   # class C in case the user has submitted these values
  1455.   ($prefix = $patch{'%hostaddr%'}) =~ s/\.[0-9]+$//;
  1456.   $patch{'%range_low%'} = $prefix . '.128';
  1457.   $patch{'%range_high%'} = $prefix . '.254';
  1458.   install_file(db_get_answer('LIBDIR') . '/configurator/vmnet-dhcpd.conf',  $cInstallDBDir . '/' . $gHostOnlyEthIf . '.conf', \%patch, 1);
  1459.  
  1460.   # Create empty lease files
  1461.   # They will be modified by vmnet-dhcpd, don't timestamp them
  1462.   undef %patch;
  1463.   install_file('/dev/null', $cInstallDBDir . '/' . $gHostOnlyEthIf . '.leases', \%patch, 0);
  1464.   safe_chmod(0644, $cInstallDBDir . '/' . $gHostOnlyEthIf . '.leases');
  1465.   undef %patch;
  1466.   install_file('/dev/null', $cInstallDBDir . '/' . $gHostOnlyEthIf . '.leases~', \%patch, 0);
  1467.   safe_chmod(0644, $cInstallDBDir . '/' . $gHostOnlyEthIf . '.leases~');
  1468. }
  1469.  
  1470. # Check the normal dhcp configuration and give advises
  1471. sub dhcpd_consultant {
  1472.   my $conf;
  1473.   my $network;
  1474.   my $netmask;
  1475.  
  1476.   if (-r '/etc/dhcpd.conf') {
  1477.     $conf = '/etc/dhcpd.conf';
  1478.   } else {
  1479.     return;
  1480.   }
  1481.  
  1482.   $netmask = db_get_answer('VNET_HOSTONLY_NETMASK');
  1483.   $network = compute_subnet(db_get_answer('VNET_HOSTONLY_HOSTADDR'), $netmask);
  1484.  
  1485.   # The host has a normal dhcpd setup
  1486.   if (direct_command(shell_string($gHelper{'grep'}) . ' ' . shell_string('^[ ' . "\t" . ']*subnet[ ' . "\t" . ']*' . $network) . ' ' . shell_string($conf)) eq '') {
  1487.     query('This system appears to have a DHCP server configured for normal use. Beware that you should teach it how not to interfere with VMware' . "'" . 's DHCP server. There are two ways to do this:' . "\n\n" . '1) Modify the file ' . $conf . ' to add something like:' . "\n\n" . 'subnet ' . $network . ' netmask ' . $netmask . ' {' . "\n" . '    # Note: No range is given, vmnet-dhcpd will deal with this subnet.' . "\n" . '}' . "\n\n" . '2) Start your DHCP server with an explicit list of network interfaces to deal with (leaving out ' . $gHostOnlyEthIf . '). e.g.:' . "\n\n" . 'dhcpd eth0' . "\n\n" . 'Consult the dhcpd(8) and dhcpd.conf(5) manual pages for details.' . "\n\n" . 'Hit enter to continue.', '', 0);
  1488.   }
  1489. }
  1490.  
  1491. # Generate an interfaces specification for a samba configuration file
  1492. sub samba_make_interfaces {
  1493.   my $if;
  1494.   my $result;
  1495.   my $sep;
  1496.   
  1497.   # We assume that ifconfig without any command option only display interfaces
  1498.   # that are up.
  1499.   open(IFCONFIG, shell_string($gHelper{'ifconfig'}) . ' |');
  1500.   # XXX I did my best, but this is probably still locale-dependant --hpreg
  1501.   $result = '';
  1502.   $sep = '';
  1503.   while (<IFCONFIG>) {
  1504.     if (/^[a-zA-Z]/) {
  1505.       my @fields;
  1506.  
  1507.       @fields = split(/[ ]+/);
  1508.       $if = $fields[0];
  1509.     } elsif (/[iI]net/) {
  1510.       if (/^[ ]+.*:(\S+)[ ]+.*:(\S+)[ ]+.*:(\S+)/) {
  1511.         if (not ($if eq 'lo')) {
  1512.           $result .= $sep . $1 . '/' . $3;
  1513.       $sep = ' ';
  1514.     }
  1515.       }
  1516.     }
  1517.   }
  1518.  
  1519.   return $result;
  1520. }
  1521.  
  1522. # Check the samba configuration and give advises
  1523. sub samba_consultant {
  1524.   my $conf;
  1525.   my $prefix;
  1526.   my $netmask;
  1527.   my $hostaddr;
  1528.  
  1529.   if (-r '/etc/smb.conf') {
  1530.     $conf = '/etc/smb.conf';
  1531.   } elsif (-r '/etc/samba/smb.conf') {
  1532.     $conf = '/etc/samba/smb.conf';
  1533.   } else {
  1534.     return;
  1535.   }
  1536.  
  1537.   $hostaddr = db_get_answer('VNET_HOSTONLY_HOSTADDR');
  1538.   $netmask = db_get_answer('VNET_HOSTONLY_NETMASK');
  1539.   # XXX This should be computed based on the netmask instead of assuming a
  1540.   # class C in case the user has submitted these values
  1541.   ($prefix = $hostaddr) =~ s/\.[0-9]+$//;
  1542.  
  1543.   # The host has a samba setup
  1544.   # XXX $prefix should be grep-escaped (it contains dots...)
  1545.   if (direct_command(shell_string($gHelper{'grep'}) . ' ' . shell_string('^[ ' . "\t" . ']*interfaces[ ' . "\t" . ']*=.*' . $prefix) . ' ' . shell_string($conf)) eq '') {
  1546.     query('This system appears to have a CIFS/SMB server (Samba) configured for normal use. Note that if you want to offer service to Virtual Machines running on the host-only network, you must modify your ' . $conf . ' file to list the networks Samba should deal with. You can do this by adding a line looking like this one:' . "\n\n" . 'interfaces = ' . samba_make_interfaces() . ' ' . $hostaddr . '/' . $netmask . "\n\n" . 'You may also need to update any related security controls you might have setup such as the "hosts allow" specification.' . "\n\n" . 'Consult the smb.conf(5) manual page for more details.' . "\n\n" . 'Hit enter to continue.', '', 0);
  1547.   }
  1548. }
  1549.  
  1550. # Configuration of hostonly networking
  1551. sub configure_hostonly_net {
  1552.   my $keep_settings;
  1553.  
  1554.   if (get_persistent_answer('Do you want to be able to use host-only networking in your Virtual Machines?', 'VNET_HOSTONLY', 'yesno', 'yes') eq 'no') {
  1555.     return;
  1556.   }
  1557.  
  1558.   $keep_settings = 'no';
  1559.   if (   defined($gDBAnswer{'VNET_HOSTONLY_HOSTADDR'})
  1560.       && defined($gDBAnswer{'VNET_HOSTONLY_NETMASK'})) {
  1561.     $keep_settings = get_answer('Host-only networking is currently configured to use the private subnet ' . compute_subnet($gDBAnswer{'VNET_HOSTONLY_HOSTADDR'}, $gDBAnswer{'VNET_HOSTONLY_NETMASK'}) . '/' . $gDBAnswer{'VNET_HOSTONLY_NETMASK'} . '. Do you want to keep these settings?', 'yesno', 'yes');
  1562.   }
  1563.  
  1564.   if ($keep_settings eq 'no') {
  1565.     for (;;) {
  1566.       my $answer;
  1567.  
  1568.       $answer = get_answer('Do you want this script to probe for an unused private subnet? (yes/no/help)', 'yesnohelp', 'yes');
  1569.  
  1570.       if ($answer eq 'yes') {
  1571.     if (hostonly_probe()) {
  1572.       last;
  1573.     }
  1574.     # Fallback
  1575.     $answer = 'no';
  1576.       }
  1577.  
  1578.       if ($answer eq 'no') {
  1579.     get_persistent_answer('What will be the IP address of your host on the private network?', 'VNET_HOSTONLY_HOSTADDR', 'ip', '');
  1580.     get_persistent_answer('What will be the netmask of your private network?', 'VNET_HOSTONLY_NETMASK', 'ip', '');
  1581.     last;
  1582.       }
  1583.  
  1584.       print wrap('Virtual machines configured to use host-only networking are placed on a virtual network that is confined to this host. Virtual machines on this network can communicate with each other and the host, but no one else.' . "\n\n" . 'To setup this host-only networking you need to select a network number that is normally unreachable from the host. We can automatically select this number for you, or you can specify a network number that you want.' . "\n\n" . 'The automatic selection process works by testing a series of Class C subnet numbers to see if they are reachable from the host. The first one that is unreachable is used. The subnet numbers are chosen from the private network numbers specified by the Internet Engineering Task Force (IETF) in RFC 1918 (http://www.isi.edu/in-notes/rfc1918.txt).' . "\n\n" . 'Remember that the host-only network that virtual machines reside on will not be accessible outside the host. This means that it is ok to use the same number on different systems so long as you do not enable communication between these networks.' . "\n\n", 0);
  1585.     }
  1586.   }
  1587.  
  1588.   show_ISC();
  1589.   write_dhcpd_config();
  1590.   dhcpd_consultant();
  1591.   samba_consultant();
  1592. }
  1593.  
  1594. # Configuration related to networking
  1595. sub configure_net {
  1596.   my $i;
  1597.  
  1598.   if (get_persistent_answer('Do you want to be able to use the network in your Virtual Machines?', 'NETWORKING', 'yesno', 'yes') eq 'no') {
  1599.     return;
  1600.   }
  1601.  
  1602.   configure_module('vmnet');
  1603.   for ($i = 0; $i < 4; $i++) {
  1604.     configure_chrdev('/dev/vmnet' . $i, 119, $i);
  1605.   }
  1606.  
  1607.   configure_bridged_net();
  1608.   configure_hostonly_net();
  1609. }
  1610.  
  1611. # Install one symbolic link
  1612. sub install_symlink {
  1613.   my $to = shift;
  1614.   my $name = shift;
  1615.  
  1616.   uninstall_file($name);
  1617.   if (file_check_exist($name)) {
  1618.     return;
  1619.   }
  1620.   # The file could be a symlink to another location. Remove it
  1621.   unlink($name);
  1622.   if (not symlink($to, $name)) {
  1623.     error('Unable to create the symbolic link ' . $name . ' pointing to the file ' . $to . '.' . "\n\n");
  1624.   }
  1625.   db_add_file($name, 0);
  1626. }
  1627.  
  1628. # Install a pair of S/K startup scripts for a given runlevel
  1629. sub link_runlevel {
  1630.    my $level = shift;
  1631.  
  1632.    # Create the S symlink
  1633.    # We use 90 because samba is at 91 and it didn't like it when we used 99.
  1634.    install_symlink(db_get_answer('INITDIR') . '/init.d/vmware', db_get_answer('INITDIR') . '/rc' . $level . '.d/S90vmware');
  1635.  
  1636.    # Create the K symlink
  1637.    # Note: SuSE 6.0 handles startup scripts differently (I actually like it).
  1638.    # When entering a new runlevel, K* scripts of the _old_ runlevel are
  1639.    # executed instead of those of the new runlevel
  1640.    if (not ($gSystem{'distribution'} eq 'suse')) {
  1641.       # Kill the services in the reboot runlevel
  1642.       $level = 6;
  1643.    }
  1644.    install_symlink(db_get_answer('INITDIR') . '/init.d/vmware', db_get_answer('INITDIR') . '/rc' . $level . '.d/K08vmware');
  1645. }
  1646.  
  1647. # Create the links for VMware's services
  1648. sub link_services {
  1649.   my @fields;
  1650.  
  1651.   @fields = split(/:/, direct_command(shell_string($gHelper{'grep'}) . ' ' . shell_string('^[ ' . "\t" . ']*[^#]*:initdefault') . ' /etc/inittab'));
  1652.   if (defined($fields[1]) && ($fields[1] =~ /[0123456Ss]/)) {
  1653.     link_runlevel($fields[1]);
  1654.   } else {
  1655.     # Unable to determine the default runlevel
  1656.     link_runlevel(2);
  1657.     link_runlevel(3);
  1658.     link_runlevel(5);
  1659.   }
  1660. }
  1661.  
  1662. # Write the VMware host-wide configuration file
  1663. sub write_vmware_config {
  1664.   my $name;
  1665.   my $promoconfig;
  1666.  
  1667.   $name = $cInstallDBDir . '/config';
  1668.  
  1669.   uninstall_file($name);
  1670.   if (file_check_exist($name)) {
  1671.     return;
  1672.   }
  1673.   # The file could be a symlink to another location. Remove it
  1674.   unlink($name);
  1675.  
  1676.   open(CONFIGFILE, '>' . $name) or error('Unable to open the configuration file ' . $name . ' in write-mode.' . "\n\n");
  1677.   db_add_file($name, 1);
  1678.   safe_chmod(0444, $name);
  1679.   print CONFIGFILE 'vmware.fullpath = "' . db_get_answer('BINDIR') . '/vmware"' . "\n";
  1680.   print CONFIGFILE 'wizard.fullpath = "' . db_get_answer('BINDIR') . '/vmware-wizard"' . "\n";
  1681.   print CONFIGFILE 'dhcpd.fullpath = "' . db_get_answer('BINDIR') . '/vmnet-dhcpd"' . "\n";
  1682.   print CONFIGFILE 'loop.fullpath = "' . db_get_answer('BINDIR') . '/vmware-loop"' . "\n";
  1683.   print CONFIGFILE 'libdir = "' . db_get_answer('LIBDIR') . '"' . "\n";
  1684.   if (defined($gDBAnswer{'NETWORKING'}) && defined($gDBAnswer{'VNET_HOSTONLY_HOSTADDR'})) {
  1685.     print CONFIGFILE $gHostOnlyEthIf . '.HostOnlyAddress = "' . db_get_answer('VNET_HOSTONLY_HOSTADDR') . '"' . "\n";
  1686.   }
  1687.   if (defined($gDBAnswer{'NETWORKING'}) && defined($gDBAnswer{'VNET_HOSTONLY_NETMASK'})) {
  1688.     print CONFIGFILE $gHostOnlyEthIf . '.HostOnlyNetMask = "' . db_get_answer('VNET_HOSTONLY_NETMASK') . '"' . "\n";
  1689.   }
  1690.   close(CONFIGFILE);
  1691.  
  1692.   # Append the promotional configuration if it exists
  1693.   $promoconfig = db_get_answer('LIBDIR') . '/configurator/PROMOCONFIG';
  1694.   if (-e $promoconfig) {
  1695.     my %patch;
  1696.  
  1697.     undef %patch;
  1698.     internal_sed($promoconfig, $name, 1, \%patch);
  1699.   }
  1700. }
  1701.  
  1702. # Display the PROMOCODE information
  1703. sub show_PROMOCODE {
  1704.   my $promocode;
  1705.  
  1706.   $promocode = db_get_answer('DOCDIR') . '/PROMOCODE';
  1707.   if (-e $promocode) {
  1708.     # $gHelper{'more'} is already a shell string
  1709.     system($gHelper{'more'} . ' ' . shell_string($promocode));
  1710.     print "\n";
  1711.   }
  1712. }
  1713.  
  1714. # Display a usage error message for the configuration program and exit
  1715. sub config_usage {
  1716.   print STDERR wrap('VMware ' . vmware_version() . ' for Linux configurator' . "\n" . 'Usage: ' . $0 . ' [[-][-]d[efault]]' . "\n" . '    default: Automatically answer questions with the proposed answer.' . "\n\n", 0);
  1717.   exit 1;
  1718. }
  1719.  
  1720. # Program entry point
  1721. sub main {
  1722.   if (not is_root()) {
  1723.     error('Please re-run this script as the super user.' . "\n\n");
  1724.   }
  1725.  
  1726.   # Force the path to reduce the risk of using "modified" external helpers
  1727.   # If the user has a special system setup, he will will prompted for the
  1728.   # proper location anyway
  1729.   $ENV{'PATH'} = '/bin:/usr/bin:/sbin:/usr/sbin';
  1730.  
  1731.   $gOption{'default'} = 0;
  1732.   initialize_external_helpers();
  1733.  
  1734.   if ($#ARGV > -1) {
  1735.     if ($#ARGV > 0) {
  1736.       config_usage();
  1737.     }
  1738.  
  1739.     # There is only one argument
  1740.     if (lc($ARGV[0]) !~ /^(-)?(-)?d(efault)?/) {
  1741.       install_usage();
  1742.     }
  1743.  
  1744.     $gOption{'default'} = 1;
  1745.   }
  1746.  
  1747.   if (not (-e $cInstallDBFileName)) {
  1748.     error('Unable to find the database file (' . $cInstallDBFileName . ')' . "\n\n");
  1749.   }
  1750.   db_load();
  1751.  
  1752.   # Stop VMware's services
  1753.   print wrap('Making sure VMware' . "'" . 's services are stopped.' . "\n\n", 0);
  1754.   if (system(shell_string(db_get_answer('INITDIR') . '/init.d/vmware') . ' stop')) {
  1755.     error('Unable to stop VMware' . "'" . 's services.' . "\n\n");
  1756.   }
  1757.   print "\n";
  1758.   db_append();
  1759.   show_EULA();
  1760.   system_info();
  1761.   configure_mon();
  1762.   configure_pp();
  1763.   configure_net();
  1764.   link_services();
  1765.   write_vmware_config();
  1766.   # Remove the flag _before_
  1767.   uninstall_file($cConfFlag);
  1768.   db_save();
  1769.   # Then start VMware's services
  1770.   system(shell_string(db_get_answer('INITDIR') . '/init.d/vmware') . ' start');
  1771.   print "\n";
  1772.  
  1773.   show_PROMOCODE();
  1774.   print wrap('The configuration of VMware ' . vmware_version() . ' for Linux for this running kernel completed successfully.' . "\n\n" . 'You can now run VMware by invoking the following command: "' . db_get_answer('BINDIR') . '/vmware".' . "\n\n" . 'Enjoy,' . "\n\n" . '    --the VMware team' . "\n\n", 0);
  1775.   exit(0);
  1776. }
  1777.  
  1778. main();
  1779.