home *** CD-ROM | disk | FTP | other *** search
/ The UNIX CD Bookshelf / OREILLY_TUCB_UNIX_CD.iso / upt / examples / COMMON / INSTALL. < prev    next >
Encoding:
Text File  |  1998-07-24  |  41.1 KB  |  1,342 lines
  1. #!/usr/local/bin/perl
  2. #
  3. #       Copyright (C) Ready-to-Run Software, Inc. 1991-1997.
  4. #       4 Pleasant Street
  5. #       Forge Village, MA 01886.
  6. #
  7. #       All Rights Reserved.
  8. #
  9. #    This Module contains Proprietary Information of 
  10. #       Ready-to-Run Software, Inc. 
  11. #
  12. #       Ready-to-Run Software, Inc. is a software service company.  Most
  13. #       of the software provided to our customers is "publically
  14. #       available"; we provide the service of locating and building
  15. #       the software for you.  In general, you may make as many copies
  16. #       as you want of the software that we deliver to you (individual
  17. #       package license information is provided during the installation
  18. #       process). The major exception to that is Ready-to-Run Software's 
  19. #       "Smart Installation System".  We view the installation system
  20. #       and the proprietary techniques used in it, as the vehicle that
  21. #       allows us to effectively deliver our services to you.  Accordingly:
  22. #
  23. #              Use of this "Smart Installation System" is limited as follows:
  24. #
  25. #       1) by anyone, to install a SAMPLE ReadyPak(tm) from 
  26. #          Ready-to-Run Software, Inc.
  27. #       2) by a ReadyPak Purchaser to install a ReadyPak obtained from
  28. #          Ready-to-Run Software, Inc. on any machine within your
  29. #          organization.  
  30. #       3) It may not be copied or otherwise distributed without written
  31. #          permission from Ready-to-Run Software, Inc.
  32. #
  33. # $Id: powertools,v 1.7 1997/06/20 17:20:32 mike Exp jeff $
  34. #
  35. # Based on ReadyPak - Revision 1.9  1992/12/06  21:18:36  jeff
  36. #
  37. # $Log: powertools,v $
  38. # Revision 1.7  1997/06/20 17:20:32  mike
  39. # fix for linux tar
  40. #
  41. # Revision 1.6  1997/06/18 17:39:54  mike
  42. # fix for perl5 (for linux)
  43. #
  44. # Revision 1.5  1997/06/18 17:38:51  jeff
  45. # work with symbolic links...
  46. #
  47. # Revision 1.4  1997/05/16 17:33:34  jeff
  48. # work with symbolic links
  49. # use our zcat for gzipped archives
  50. # workaround for alpha perl bug
  51. #
  52. # Revision 1.3  1993/01/16  14:04:54  jeff
  53. # Actual release version
  54. #
  55. # Revision 1.2  1992/12/18  02:33:17  jeff
  56. # Changes for ISO naming conventions.
  57. #
  58. # Revision 1.1  1992/12/14  21:56:08  jeff
  59. # Initial revision
  60. #
  61. #
  62. $0 =~ m|(.*/)(.*)|, $PROG = $2; $EXECDIR = $1; # find program name
  63.  
  64. # set up some necessary constants and defaults
  65. $TRUE  = 1;
  66. $FALSE = 0;
  67. $SYMLINK_EXISTS = (eval 'symlink("","");', $@ eq '' );
  68.  
  69. $MACHINE = shift @ARGV;
  70. $CDROM = shift @ARGV;
  71. $SourcePak = $FALSE;
  72.  
  73. $[ = 0;            # set array base to 0
  74. $, = ' ';        # set output field separator
  75. $\ = "\n";        # set output record separator
  76. chop($cwd = `pwd`);
  77. $workdir = ($ENV{'TMPDIR'} || '/tmp'); # find a place to work
  78. chdir($workdir);
  79.  
  80. $TESTING = $FALSE;      # Should be FALSE when we ship
  81.  
  82. $INFO = 1;
  83. $START = 1;
  84. $PROCESS = 2;
  85. $END = 3;
  86.  
  87. $DEFAULT  = 1;
  88. $REQUIRED = 2;
  89. $OPTIONAL = 3;
  90.  
  91. $TarCmd= '/usr/bin/tar';
  92. $TarCmd='/bin/tar'                   if ($MACHINE =~ /linux/i);
  93. $TarCmd='/bin/tar'                   if ($MACHINE =~ /RISC/i);
  94. $TarCmd='/bin/tar'                 if ($MACHINE =~ /hp700/i);
  95. $TarCmd='/bin/tar'                   if ($MACHINE =~ /xenix/i);
  96.  
  97. @PiecesPerPak = ( '$deco_name', '$cont_name', '$arch_name' );
  98.  
  99.  
  100. $SUID = 04000;
  101. $SGID = 02000;
  102.  
  103. $BlockSize        = 4096;
  104. $PathPrefix       = '/' x 50;
  105. $STAGEPath        = 'usr/STAGE';
  106. $InstallPath      = '/usr/local';
  107. $InstallSharePath = '/usr/local/share';
  108. $ShareDirs        = '(sbin|slib|sspool|sinclude|man|texinfo|doc|hardcopy)';
  109. $ConvertDirs      = '(sbin|slib|sspool|sinclude)';
  110. $AbsDir           = 'ABS';
  111. $RelativePathPrefix  = '../';
  112.  
  113. # this tells us how to process each section of the description file
  114. %SECTION = (    
  115.    '*PREREQS*',                 'Processing(*prereq, *prereq_cnt)',
  116.    '*DESCRIPTION*',             'Processing(*desc, *desc_cnt)',
  117.    '*APPNOTES*',                'Processing(*appnote, *appnote_cnt)',
  118.    '*FILEGROUP*',               'Processing(*filelist, *file_cnt)',
  119.    '*MESSAGE*',                 'Processing(*message, *msg_cnt)',
  120.    '*OPTIONS*',                 'Processing(*decoopt, *deco_opt_cnt)',
  121.    '*INFO*',                    'Processing(*info, *info_cnt)',
  122.    '*LICENSE*',                 'Processing(*license, *license_cnt)',
  123.    '*PRE_PROCESSING*',          'Processing(*preprocessing,*pre_cnt)',
  124.    '*POST_PROCESSING*',         'Processing(*postprocessing,*post_cnt)'
  125.            );
  126.  
  127. $STAGEset = $FALSE;
  128.  
  129. BEGINNING:
  130. # options
  131. $Remote = '';
  132. $Verbose = $TRUE;
  133. $Install = $TRUE;
  134. $Operation = 'Install';
  135. $OpDest = 'at';
  136. $DeleteToo = $TRUE;
  137.  
  138. # check for options
  139. while ($ARGV[0] =~ /^-/) {
  140.    $_ = shift @ARGV;
  141.    $Verbose = !$Verbose                       ,next if (/^-v/);
  142.    $UseDefaultAnswers = $TRUE                 ,next if (/^-D/);
  143.    $Operation = 'Remove',$OpDest='from',
  144.         $Install=$FALSE                       ,next if (/^-R/);
  145.    # we only get here for -h or unknown options
  146.    print STDERR "\nUnknown option: $_" if (!/^-h/i);
  147.    print STDERR <<"ENDOFHELP";
  148.  
  149.         Usage:  $PROG [-DRLdhi] [-d device] package...;
  150.               -D   use default answers
  151.               -R   remove instead of installing
  152.               -h   this message
  153. ENDOFHELP
  154.   exit;
  155. }
  156.  
  157. $SIG{'INT'} = $SIG{'TERM'} = 'abort';
  158.  
  159. &SetupHelp;
  160.  
  161. print STDERR <<"EndOfIntro";
  162.  
  163.                       Welcome to Ready-to-Run Software's
  164.                          * Smart Installation System *
  165.  
  166. This installation system requires write permission in /tmp (or \$TMPDIR if
  167. it's set) directory (for staging the install) and write permission in the
  168. installation directory for the actual install (these may be the same).
  169.  
  170. You may typically answer all questions with the default answer and end up with
  171. a working system (provided that the install device is correct).  You may
  172. override the default answers to tailor what gets installed (e.g.  you may leave
  173. out optional pieces) and where it gets installed.
  174.  
  175.  * If you answer any question with a '++' which tells the installation system
  176.    to assume default answers for all remaining questions (you may also specify
  177.    this with the -D flag on the command line).  
  178.  
  179.  * If you want your answer to this question to be used for all remaining 
  180.    packages, respond with a completely uppercase answer (a '+' uses the 
  181.    default answer for all remaining packages).  If the question refers to a 
  182.    path name, the path will be converted to lower case for you.
  183.  
  184.  * To see additional information, answer any question with a '?'.
  185. EndOfIntro
  186.  
  187. die( "You don't have write permission in: $workdir\n" ) if ! -w $workdir;
  188.  
  189. $umask = umask;
  190. umask 022 
  191.    if $Install && $umask != 022 && 
  192.         &YesNo(sprintf("Use umask of 022 instead of %03o for install", umask ), 'umask');
  193.  
  194.  
  195. $taroptions = 'x';
  196. $taroptions .= 'oh' if $MACHINE =~ /(sun|RISC)/;
  197.  
  198. # figure out the naming conventions on the CDROM
  199. $UPPER = 1;
  200. $REVISION = 2;
  201. $DOT = 4;
  202. $UPPERZ = 8;
  203. $NAMEFAULT = 16;
  204. for ($NAMING = 0 ; $NAMING < 16 ; $NAMING++) {
  205.    last if -f &iso9660("config1") &&
  206.            -f &iso9660("config2.rev") &&
  207.            -f &iso9660("config3.Z");
  208. }
  209. die "Can't determine CDROM naming conventions\n" if $NAMING >= $NAMEFAULT;
  210.  
  211. # start processing
  212. open(PAKS, &iso9660("COMMON/PACKAGES"));
  213.  
  214. local($PAKname);
  215. while (<PAKS>) {
  216.    undef @packages; $pak_cnt = 0;
  217.    chop;
  218.    $PAKname = $_;
  219.    while (<PAKS>) {
  220.       chop;
  221.       last if $_ eq '';
  222.       @field = split;
  223.       next if $field[1] eq 'S' && !$SourcePak;
  224.       next if $field[1] eq 'R' &&  $SourcePak;
  225.       $packages[$pak_cnt++] = $field[0];
  226.       $packages{$field[0]} = $TRUE;
  227.       if ($field[1] ne 'T') { $rpackages{$field[0]} = $TRUE; }
  228.       else                  { $opackages{$field[0]} = $TRUE; }
  229.       $fullname{&standard($field[0])} = $field[0];
  230.    } 
  231.    next if defined(%pak) && !defined($pak{$PAKname});
  232. }
  233.  
  234.  
  235. while (1) {
  236.    &ListPackages( %opackages, "scripts" );
  237.    &GetReturn( '' );
  238.    &ListPackages( %rpackages, "packages" );
  239.    printf( STDERR "Enter the name of a package to install or choose Search, Quit or All\n");
  240.    printf( STDERR "<package>, S(earch), A(ll), Q(uit) [Search]? " );
  241.    $option = <STDIN>;
  242.    chop $option;
  243.    &Help('<package>'), next             if $option eq '?';
  244.    &search, next                        if $option =~ /^($|S(|(E(|A(|R(C(|H)))))))$/i;
  245.    &InstallAll, next                    if $option =~ /^A(|(L(|L)))$/;
  246.    last                                 if $option =~ /^Q(|(U(|I(|T))))$/i;
  247.    &ProcessInstall($option),next        if defined $packages{$option};
  248.    printf STDERR "$option is not an option or package\n";
  249. }
  250.  
  251. &PathMsg();
  252. exit 0;
  253.  
  254. # we never get here because of the exit!
  255.  
  256. sub search {
  257.   local( $desire, $des2 );
  258.   local( $UseDefaultAnswers )= ( $FALSE );
  259.   local( %DefaultAnswer );
  260.   local( @dolist, @desc, $desc, $cnt, $choice );
  261.   while (1) {
  262.      $desire = &GetAnswer( "Search package descriptions for (? for help)", '', 'SEARCH', '' );
  263.      &Help('SEARCH'), redo if $desire eq '?';
  264.      return if $desire eq '';
  265.      last;
  266.   }
  267.   ($des2 = $desire) =~ s/(\s)+/\\;/g;
  268.   open( DESCRIPTIONS, &iso9660s("$MACHINE/BIN/AGREP")." -l -i -d '^\\*' \\\\\\*DESC\\;$des2 ".&iso9660s("INSTINFO/*")."|" );
  269.   $cnt = 0;
  270.   while (<DESCRIPTIONS>) {
  271.      chop;
  272.      $_ =~ s:.*/([^\.;]*).*:$1:;
  273.      $desc[ $cnt++ ] = $fullname{&standard($_)};
  274.   }
  275.   printf( STDERR "\nNo descriptions mention \"$desire\".\n\n"), return if !$cnt;
  276.   @dolist = ($desc[0]);
  277.   pickone: while ($#desc > 0)
  278.   {
  279.      printf STDERR
  280.      "\nThe descriptions for the following packages mention \"$desire\":\n";
  281.      $cnt = 0;
  282.      foreach $desc (@desc)
  283.      {
  284.         printf( STDERR "  %2d.  %s\n", ++$cnt, $desc) ;
  285.      }
  286.      printf STDERR "\n   A.  ALL";
  287.      printf STDERR "\n   N.  NONE\n";
  288.      printf STDERR "\nChoose one please: ";
  289.      $choice = <>;
  290.      return                    if $choice =~ /^n/i;
  291.      @dolist = @desc, last     if $choice =~ /^a/i;
  292.      $choice--;
  293.   
  294.      if ($choice >= 0 && $choice <= $#desc)
  295.      {
  296.         @dolist = ($desc[$choice]);
  297.         last pickone;
  298.      }
  299.   }
  300.   for $p (@dolist) { &ProcessInstall($p); };
  301. }
  302.  
  303. sub InstallAll {
  304.   local( $pak_index );
  305.   for $pak_index (0..$pak_cnt) { &ProcessInstall($packages[$pak_index]); }
  306. }
  307.  
  308. sub ListPackages {
  309.    local(%paks, $title) = @_;
  310.    local($line,$cnt,$p);
  311.    printf "\nThe $PAKname package contains the following $title:\n\n";
  312.    for $p (sort keys %paks) {
  313.        $line = sprintf( "$line%-13s", $p );
  314.        printf("$line\n"), $line='', $cnt=0 if (++$cnt == 6);
  315.    }
  316.    printf "$line\n" if $cnt;
  317.    printf "\n";
  318. }
  319.  
  320. sub iso9660 {
  321.    local( $path ) = @_;
  322.    $path =~ s:($CDROM/|;1$)::g;
  323.    if ($NAMING & $UPPER) {
  324.        $path =~ tr/a-z+!\-/A-Z_/;
  325.    }
  326.    else {
  327.        $path =~ tr/A-Z+!\-/a-z_/;
  328.    }
  329.    if ($path !~ /\*$/) {
  330.       if ($NAMING & $DOT) {
  331.          $path .= '.' if $path !~ /(.*\/)?.*\./;
  332.       }
  333.       $path .= ';1' if $NAMING & $REVISION;
  334.    }
  335.    $path =~ s/\.z/\.Z/ if $NAMING & $UPPERZ;
  336.  
  337.    return "$CDROM/$path";
  338. }
  339.  
  340. sub iso9660s {
  341.    local( $path ) = @_;
  342.    ($path = &iso9660($path)) =~ s/;/\\;/g;
  343.    return $path;
  344. }
  345.  
  346. sub CDROMNames {
  347.    local($package,$machine) = @_;
  348.    $pn=substr($package,0,8);   
  349.    return (&iso9660("$machine/ARCHIVE/$pn.Z"), 
  350.            &iso9660("$machine/PACKLIST/$pn."),
  351.            &iso9660("INSTINFO/$pn.") );
  352. }
  353.  
  354. sub ProcessInstall {
  355.    # find out what we want to process
  356.    ($package) = @_;
  357.    local($p,$firstTry);
  358.    $firstTry = $TRUE;
  359.    do {
  360.       undef %sizes; undef %owners; undef %names; undef %perms; undef %groups;
  361.       undef %justcopy; undef @rmlist; undef $rm_cnt;
  362.       ($arch_name,$cont_name,$deco_name) = &CDROMNames($package,$MACHINE);
  363.       printf( "\a\n$package is not available for this platform.\n" ), return
  364.          if ! -f &iso9660($arch_name) && ! -e &iso9660($arch_name);
  365.       &ReadContents($cont_name);
  366.       &ReadDecorations($deco_name,$INFO);
  367.       &TellAboutPak($package) if $firstTry;
  368.       &RemoveSTAGE, return if !&YesNo( "\n$Operation $package", $Operation );
  369.       &License if $firstTry;
  370.       &SetOrigin("$workdir/STAGE.$$");
  371.       &AskUser;
  372.       &ReadDecorations($deco_name, $PROCESS); 
  373.       (&GetPak($package) || (&RemoveSTAGE, return)) if ($Install && $firstTry);
  374.       $firstTry = $FALSE;
  375.    } until &Install;
  376.    &RemoveSTAGE;
  377. }
  378.  
  379. #
  380. # Subroutines
  381. #
  382.  
  383. sub PathMsg {
  384.    printf STDERR 
  385.    "\nSee /tmp/RTRinstall.log for a list of the packages and files processed.\n";
  386.    return if !$Install;
  387.    local($p,$pnew,$msg,$i);
  388.    $p = $ENV{'PATH'};
  389.    $msg = "\nYou may want to change your path to include:\n   ";
  390.  
  391.    foreach $i (sort keys %execpath) { 
  392.       next if $p =~ /(^|:)$i(:|$)/;
  393.       $pnew .= "$i:";
  394.       printf STDERR "$msg$i\n";
  395.       $msg = "   ";
  396.    }
  397.  
  398.    if ($pnew ne '') {
  399.       $pnew = ".:$pnew" if $p =~ s/^\.://;
  400.       printf STDERR
  401.           "\nSuggested new path: $pnew$p\n"
  402.           if $pnew ne '';
  403.    }
  404. }
  405.  
  406. sub GetPak {
  407.    local($package) = @_;
  408.    local($name,$i);
  409.    print STDERR "Please wait....";
  410.    $name = &iso9660s(eval($PiecesPerPak[$#PiecesPerPak]));
  411.    mkdir ("/$STAGEOrigin", 0775 );
  412.    $STAGEset = $TRUE;
  413.    warn( "Failure untarring archive!\n$package install aborted.\n") , return 0
  414.     if (system( "cat $name | ".&iso9660s("$MACHINE/BIN/ZCAT")." -d | (cd /$STAGEOrigin ; $TarCmd xf - 2>/dev/null)"));
  415.    return 1;
  416. }
  417.  
  418. sub TellAboutPak {
  419.    local($package) = @_;
  420.    local($i,$n);
  421.    &Show( '', *desc, *desc_cnt );
  422.    printf (STDERR 
  423.       "\nThe $package package is approximately %s\n", &FmtSize($total_size) );
  424.    foreach $i (sort keys %gs) { 
  425.       next if !$gc{$i};
  426.       $n = ($i ne ': ' ? $i : 'Required');
  427.       printf(STDERR "%9s - $n\n",&FmtSize($gs{$i}));
  428.    }
  429. }
  430.  
  431. sub AskUser {
  432.    $ConvertShareables = $FALSE;
  433.    local($tmp);
  434.    $tmp = &FileName(&GetAnswer("$Operation package $OpDest dir", $InstallPath,
  435.           'DIR', '^[~/.]' ));
  436.    if ($tmp ne $InstallPath) {
  437.       $InstallPath = $tmp;
  438.       $InstallSharePath = $InstallPath . '/share';
  439.    }
  440.    $InstallPathOld = -d $InstallPath;
  441.    $InstallSharePath = &FileName( &GetAnswer("$Operation shared files $OpDest",
  442.                                         $InstallSharePath,'SDIR', '^[~/.]'  ));
  443.    $ConvertShareables = $TRUE
  444.       if &YesNo(
  445.         'Convert slib->lib, sbin->bin, sspool->spool, sinclude->include', 
  446.         'CONVERT');
  447. }
  448.  
  449. sub ReadContents {
  450.    local($ContentsFile) = @_;
  451.    local($size, $owner, $group, $perms, $sum, $name, $dash, $linkto);
  452.  
  453.    open( CONTENTS, $ContentsFile);
  454.    while (<CONTENTS>) {
  455.       next if /^\s*#/; chop;
  456.       ($size, $owner, $group, $perms, $sum, $name, $dash, $linkto) = 
  457.          split(' ', $_, 8);
  458.       $perms {$name} = $perms;
  459.       $sizes {$name} = $size;
  460.       $owners{$name} = $owner;
  461.       $groups{$name} = $group;
  462.       $links {$name} = $linkto;
  463.       $names {$name} = $DEFAULT;
  464.    }
  465.    close(CONTENTS);
  466. }
  467.  
  468. sub FixWithEval {
  469.    local($string) = @_;
  470.    eval("\$string = $string" ) if $Pass == $PROCESS && $string =~ /^['&\$]/;
  471.    return $string;
  472. }
  473.  
  474. sub CheckQuery {
  475.    local($one);
  476.    if ($_ =~ /(.)user:([^:]*):/i) {
  477.       $one = $1;
  478.       return $FALSE if ($one eq '~' && $user =~ $2) ||
  479.                        ($one ne '~' && $user !~ $2);
  480.    }
  481.    if ($_ =~ /(.)machine:([^:]*):/i) {
  482.       $one = $1;
  483.       return $FALSE if ($one eq '~' && $MACHINE =~ $2) ||
  484.                        ($one ne '~' && $MACHINE !~ $2);
  485.    }
  486.    return $TRUE       if ($Pass != $PROCESS) || ($_ !~ /(.)query:([^:]*):/i);
  487.    return &YesNo(&FixWithEval($2),'',$1 eq '~' ? 'n' : 'y');
  488. }
  489.  
  490. sub FileHelp {
  491.    local($help,$n) = @_;
  492.    if ($lasthelp eq $help) {
  493.       undef $lasthelp;
  494.       foreach $i ($start..$file_cnt-1) {
  495. #         ($n = $filelist[$i]) =~ s:^.+/::g;
  496.          $n = &TranslateName("/$STAGEOrigin/$filelist[$i]");
  497.          printf( STDERR "    $n\n" );
  498.       }
  499.       return;
  500.    }
  501.    printf( STDERR "\n$HELP{$help}" );
  502.    printf( STDERR "Enter '?' again for a list of the $help\n\n" );
  503.    $lasthelp = $help;
  504. }
  505.  
  506. sub filelist {
  507.    local($option) = @_;
  508.  
  509.    undef $lasthelp, $grouping = $heading = '', $start = $file_cnt, return   
  510.       if $option==$START;
  511.  
  512.    return if ($option == $PROCESS) || ($start == $file_cnt);
  513.  
  514.    local($i,$s,$n,$rm_tmp_cnt,$dflt,$skipit);   
  515.    $rm_tmp_cnt = $rm_cnt;
  516.    foreach $i ($start..$file_cnt-1) {
  517.       $n = $filelist[$i];
  518.       $rmlist[$rm_tmp_cnt++] = $n;
  519.       if ($n =~ /\*(.*)/) {
  520.          $justcopy{$n} = $1;
  521.          $n = $1;
  522.       }
  523.       $s += $sizes{$n} if $links{$n} eq '';
  524.       delete $names{$n};
  525.    }
  526.    $gc{"$grouping: $heading"} = $TRUE if $start < $file_cnt;
  527.  
  528.    # Handle the info only pass
  529.    $gs{"$grouping: $heading"}+=$s, $total_size+=$s, return    if $Pass==$INFO;
  530.  
  531.    return if $heading eq '';
  532.    if (!defined $grouping{$grouping}) {
  533.        $grouping{$grouping} = 
  534.           &GetAnswer("$Operation $grouping files (All, Some, None)", 's', 
  535.                      $grouping, '[aAnNsS]' );
  536.    }
  537.    if ($grouping{$grouping} !~ /^a/i) {
  538.       $helpindx = $heading if $helpindx eq '';
  539.       $skipit = ($grouping{$grouping} =~ /^n/i);
  540.       if (!$skipit) {
  541.          $dflt = $grpdflt;
  542.          $dflt = $headingdflt{$heading} if defined $headingdflt{$heading}; 
  543.          $headingdflt{$heading} = 
  544.             &GetAnswer(
  545.                sprintf("$Operation $heading (Approx %s)",&FmtSize($s)),
  546.                $dflt, 
  547.                "&FileHelp(\"$helpindx\")", 
  548.                '^[YyNn]' );
  549.          $skipit = $TRUE if $headingdflt{$heading} =~ /^(n|\s*)$/i;
  550.       }
  551.       $file_cnt = $start, $rm_cnt = $rm_tmp_cnt if $skipit;
  552.    }
  553.    undef $helpindx; undef $heading; undef $grouping;
  554. }
  555.  
  556. sub decoopt {
  557.    local($state) = @_;
  558.    return if ($Pass != $PROCESS) || ($state != $PROCESS);
  559.    local ($i,@f);
  560.    foreach ($i = 0; $i < $deco_opt_cnt; $i++) {
  561.       @f = split( /\s+/, $decoopt[$i] );
  562.       $decoopt{$f[0]} .= "|" if defined $decoopt{$f[0]};
  563.       $decoopt{$f[0]} .= $f[1];
  564.    }
  565.    $deco_opt_cnt = 0;
  566. }
  567.  
  568. sub appnote {
  569.    local($state) = @_;
  570.    return if ($Pass != $PROCESS) || ($state != $START);
  571.    $appnote[$appnote_cnt++] = '^';
  572. }
  573.  
  574. sub message {
  575.    local($state) = @_;
  576.    return if ($Pass != $PROCESS) || ($state != $PROCESS);
  577.    local ($i);
  578.    foreach $i (0..$msg_cnt-1) {
  579.       print $message[$i];
  580.    }
  581.    $msg_cnt = 0;
  582. }
  583.  
  584. sub Processing {
  585.    local(*type,*cnt) = @_;
  586.    local($message) = $1 if $_ =~ /message:([^:]*):/i;
  587.  
  588.    &type($START) if defined &type;
  589.  
  590.    $heading =  $1 if $_ =~     /heading:([^:]*):/i;
  591.    $helpindx = $1 if $_ =~        /help:([^:]*):/i;
  592.    $grouping = $2 if $_ =~ /(.)grouping:([^:]*):/i;
  593.    $grpdflt = ($1 eq '~' ? 'n' : 'y' );
  594.    local($keep) = &CheckQuery;
  595.  
  596.    $type[$cnt++] = "echo $message" if ($keep && defined $message);
  597.    while (<DECORATION>) {
  598.       next if /^\s*#/; chop;
  599.       last if '.' eq $_;
  600.       next if !$keep;
  601.       $type[$cnt++] = &FixWithEval($_);
  602.       &type($PROCESS) if defined &type;
  603.    }
  604.    &type($END) if defined &type;
  605. }
  606.  
  607. sub ReadDecorations {
  608.    local($File,$pass) = @_;
  609.  
  610.    $Pass = $pass;
  611.  
  612.    undef %grouping; undef $heading; undef $grouping;
  613.    undef %gs ; undef %gc; undef $total_size;
  614.    undef @prereq; undef $prereq_cnt;
  615.    undef @message; undef $msg_cnt;
  616.    undef @filelist; undef $file_cnt;
  617.    undef @desc; undef $desc_cnt;
  618.    undef @info; undef $info_cnt;
  619.    undef @decoopt; undef %decoopt; undef $deco_opt_cnt;
  620.    undef @appnote; undef $appnote_cnt;
  621.    undef @license; undef $license_cnt;
  622.    undef @preprocessing; undef $pre_cnt;
  623.    undef @postprocessing; undef $post_cnt;
  624.  
  625.    open( DECORATION, "$File") || 
  626.         warn "No decoration file for $File\n";
  627.    while (<DECORATION>) {
  628.       next if /^\s#/; chop;
  629.       @field = split;
  630.       if (defined $SECTION{$field[0]}) {
  631.          eval "&$SECTION{$field[0]}";
  632.       }
  633.       elsif ($field[0] =~ /\*\w+\*/) { 
  634.          print STDERR "Unknown section type $field[0]"; 
  635.       }
  636.    }
  637.    close(DECORATION);
  638.  
  639.    # Add any missing filenames to the file list (e.g. in TOC, not in deco).
  640.    foreach $i (sort keys %names) { 
  641.       $filelist[$file_cnt++] = $i;
  642.       print STDERR "$i in TOC, not in decoration file\n" if $DEBUG;
  643.    }
  644.    foreach $i (0..$file_cnt-1) { 
  645.       $n = $filelist[$i];
  646.       while ($n =~ m|[\*]?(.+)/([^/]*)|) {
  647.          $dirs{$1} = 1;
  648.          $n = $1;
  649.       }
  650.    }
  651. }
  652.  
  653. sub RemoveSTAGE {
  654.    system( "rm -rf /$STAGEOrigin" ) if $STAGEset;
  655. }
  656.  
  657. sub abort {
  658.    local($reason) = @_;
  659.    warn("$reason\n");
  660.    &RemoveSTAGE; 
  661.    exit 1;
  662. }
  663.  
  664. sub Show {
  665.    local($title,*type,*cnt,$first) = @_;
  666.  
  667.    local( $lines );
  668.    print STDERR "$title" if $title ne '' && $cnt != 0;
  669.    foreach $i ($first..$cnt-1) {
  670.      if ($type[$i] eq '^') {
  671.          next if ($type[$i-1] eq '^');
  672.          print STDERR while ($lines++ < 23);
  673.          $lines = 0;
  674.          &GetReturn( '' );
  675.          next;
  676.       }
  677.      if ($lines++ == 23) {
  678.          $lines = 1;
  679.          &GetReturn( '' );
  680.       }
  681.       print STDERR $type[$i];
  682.   }
  683. }
  684.  
  685. sub check_prereqs {
  686.    local(@field,$file,$here,$i,$plist,$ipath,%ipaths,$package);
  687.    foreach $i (0..$prereq_cnt-1) {
  688.       @field = split( /\s+/, $prereq[$i], 2 );
  689.       $here = $file = &TranslateName("/$STAGEOrigin/$field[1]");
  690.       next if (-e $here);
  691.       # first check the paths that we already know
  692.       foreach $ipath (values %ipaths) {
  693.          $file = &TranslateName("$ipath/$field[1]");
  694.          last if -e $file;
  695.       }
  696.       while (! -e $file) {
  697.          $ipath = &FileName( &GetAnswer(
  698.                    "Can't find package $field[0], where was it installed",
  699.                    "/usr/local", 'Prereq', '^[~/.]' 
  700.                             ));
  701.          $file = &TranslateName("$ipath/$field[1]");
  702.       } 
  703.       $ipaths{$field[0]} = $ipath;
  704.       $plist .= " -p $here $file";
  705.    }
  706.    return $plist;
  707. }
  708.  
  709. sub License {
  710.    &Show( 
  711.         "$package was compiled and made \"Ready-to-Run\" by \
  712.         Ready-to-Run Software, Inc.\n",
  713.         *license, *license_cnt );
  714.    print STDERR "                               ************************\n\n" ;
  715. }
  716.  
  717. sub Appnotes {
  718.    local($package) = @_;
  719.    local($cmd,$file,$dflt);
  720.    $dflt = 'view';
  721.    for (;;) {
  722.       $cmd = &GetAnswer( 'Notes (file, print, view, done)', 
  723.                          $dflt,
  724.                          'APPNOTES',
  725.                          '^[dfpv]' );
  726.       return if $cmd =~ /^d/;
  727.       $dflt = 'done';
  728.       if ($cmd =~ /^v/) {
  729.          &Show('Notes', *appnote, *appnote_cnt, 1);
  730.          next;
  731.       }
  732.       elsif ($cmd =~ /^p/) {
  733.          $cmd = &GetAnswer( 'Print command', '| lpr', 'PRINT' );
  734.       }
  735.       else {
  736.          $file = &FileName( &GetAnswer( 'File to save appnote in', 
  737.                             "$InstallPath/doc/$package.note", 'FILE' ));
  738.          local($path);
  739.          ($path = $file) =~ s:/[^/]+$::;
  740.          mkdir($path,0775);
  741.          $cmd = ">$file"; $file = " $file";
  742.       }
  743.       if (open( PIPE, $cmd )) {
  744.          foreach $i (1..$appnote_cnt-1) {
  745.             print (PIPE "\n\n\n******\n\n\n"),next if $appnote[$i] eq '^';
  746.             print (PIPE $appnote[$i]);
  747.          }
  748.          close( PIPE );
  749.       } 
  750.       else {
  751.          warn "Couldn't open$file: $!\n";
  752.       }
  753.    }
  754. }
  755.  
  756. sub Install {
  757.  
  758.    local($options) = " -N \"$package\" -o $STAGEOrigin -L /tmp/RTRinstall.log";
  759.  
  760.    $options .= ' -i ' . $InstallPath;
  761.    $options .= ' -s '. $InstallSharePath;
  762.    $options .= ' -c' if $ConvertShareables;
  763.    $options .= ' -t' ; # if &YesNo("show totals");
  764.    $options .= ' -r' if !$Install;
  765.    $options .= ' -v' if $LocalInstall; # || &YesNo("verbose output");
  766.    $options .= ' -d' if $DeleteToo; 
  767.  
  768.    # We don't care where/if the prerequisites exist if we're removing...
  769.    $options .= &check_prereqs() if $Install;
  770.  
  771.    # Verify that we are about to install what they want.
  772.    printf STDERR <<"EndOfVerifyMsg";
  773.  
  774.     About To $Operation: $package
  775.  
  776.         $OpDest $InstallPath 
  777.         with shareable files $OpDest $InstallSharePath
  778. EndOfVerifyMsg
  779.    print STDERR '        slib->lib, sbin->bin, sspool->spool, sinclude->include'
  780.         if $ConvertShareables;
  781.  
  782.    return $FALSE if !&YesNo( "\nAre these correct", CORRECT );
  783.  
  784.    $execpath{"$InstallPath/bin"} = 1;
  785.    $execpath{"$InstallSharePath/bin"} = 1;
  786.  
  787.    print STDERR "Proceeding with install...";
  788.  
  789.    # first delete any files that we won't be installing
  790.    while ($rm_cnt) {
  791.       unlink("/$STAGEOrigin/$rmlist[--$rm_cnt]");
  792.       print STDERR "unlink(/$STAGEOrigin/$rmlist[$rm_cnt])" if $TESTING;
  793.    }
  794.  
  795.    local($cmd,$name,$dest);
  796.    # process any requests which must be done prior to "rtrinstall"
  797.    print "Pre Processing" if $Debug;
  798.    foreach $i (0..$pre_cnt-1) { 
  799.       if ($preprocessing[$i] =~ /^[\&']/) {
  800.          eval("\$cmd = $preprocessing[$i]" );
  801.       }
  802.       else {
  803.          eval("\$cmd = \"$preprocessing[$i]\""); 
  804.       }
  805.       print STDERR $@ if $@ ne '';  
  806.       print STDERR $cmd if $debug;
  807.       system ($cmd) if $Install;
  808.    } 
  809.  
  810.    $RTRPID = open( RTRINSTALL, 
  811.     '|'.&iso9660s("$MACHINE/BIN/PERL").' '.&iso9660s("COMMON/INSTALL.RTR").
  812.         $options) ||
  813.           &abort;
  814.  
  815.    foreach $i (sort keys %dirs) { 
  816.       print RTRINSTALL $i;
  817.    }
  818.    $s = 0;
  819.    foreach $i (0..$file_cnt-1) { 
  820.       $n = $filelist[$i];
  821.       print RTRINSTALL $n; 
  822.       $n = $justcopy{$n} if defined $justcopy{$n};
  823.       $s += $sizes{$n} if $links{$n} eq '';
  824.    }
  825.    close(RTRINSTALL);
  826.    waitpid($RTRPID,0);
  827.  
  828.    return $TRUE if !$Install; #we're done if we're just removing
  829.    $now = time; 
  830.    # ranlib, set owners, set modes if necessary
  831.    # change times on man/cat files to be later than man/man files
  832.    foreach $i (0..$file_cnt-1) {
  833.       $n = $filelist[$i];
  834.       $n = $justcopy{$n} if defined $justcopy{$n};
  835.       system( "/usr/bin/ranlib -t " . &TranslateName("/$STAGEOrigin/$n") )
  836.          if ($n =~ /\.(a|sa\.\d+\.d+)$/ && $MACHINE =~ /sun/);
  837.       utime $now, $now, &TranslateName("/$STAGEOrigin/$n") 
  838.          if ($n =~ m|^man/cat|);
  839.       next if ($n eq $InstallPath && $InstallPathOld);
  840.       &FixOwnersAndModes($n,$owners{$n},$groups{$n},$perms{$n},
  841.                          $decoopt{'KeepOwner'});
  842.    }
  843.  
  844.    print "Post Processing" if $Debug;
  845.    foreach $i (0..$post_cnt-1) { 
  846.       if ($postprocessing[$i] =~ /^[\&']/) {
  847.          eval("\$cmd = $postprocessing[$i]" );
  848.       }
  849.       else {
  850.          eval("\$cmd = \"$postprocessing[$i]\""); 
  851.       }
  852.       print STDERR $@ if $@ ne '';  
  853.       print STDERR $cmd if $debug;
  854.       system ($cmd) if $Install;
  855.    }
  856.    &Appnotes($package) if defined @appnote;
  857.    return $TRUE;
  858. }
  859.  
  860. sub SetupHelp {
  861.    $HELP{ '' } = 'There is no help available for this question\n\n';
  862.  
  863.    $HELP{ 'Device' } = <<"EndOfMessage";
  864.    This is the device from which the install package reads all of the
  865. packages and files to be installed.  It should be the same device that
  866. was used to load the install package.  Remember to use the "non-rewinding" 
  867. device (starts with an "n") if you are using some sort of a tape device.
  868.  
  869. EndOfMessage
  870.  
  871.    $HELP{ 'Device' } .= <<"EndOfMessage" if $MACHINE eq 'i386';
  872.    On SCO machines, the file /etc/default/tar describes a number of
  873. archive devices, including:
  874.  
  875.         2       5.25" High Density Drive A (or 0)
  876.         3       5.25" High Density Drive B (or 1)
  877.         6       3.5"  High Density Drive A (or 0)
  878.         7       3.5"  High Density Drive B (or 1)
  879.  
  880. EndOfMessage
  881.  
  882.    $HELP{ 'Device' } .= <<"EndOfMessage" if $MACHINE eq 'RS6000';
  883.    On AIX machines, the non-rewinding device is usually designated by
  884. added a '.1' to the device name (e.g. /dev/rmt0.1).
  885. EndOfMessage
  886.  
  887.    $HELP{ 'DIR' } = <<"EndOfMessage";
  888.    This is the root of the install tree for the package.  Most files
  889. will be installed relative to this directory in the appropriate
  890. subdirectories (e.g.  bin, lib, include, man, spool, ...).  Files
  891. which must be stored in an absolute position (e.g. /bin or /etc) are
  892. not stored relative to this path.  Also, the "shareable" files (see
  893. the next installation question) are not necessarily stored in the
  894. "install tree".
  895.    
  896.    You may enter:                                 EXAMPLE
  897.         1) a fully qualified pathname            /packages/rtr
  898.         2) a pathname beginning with ~           ~fred/bambam
  899.         3) a pathname beginning with .           ./apps
  900.  
  901. EndOfMessage
  902.  
  903.    $HELP{ 'Shared' } = <<"EndOfMessage";
  904.    Shared files are files which are machine/architecture independent.
  905. You need to have only one copy of each file for an entire network (you
  906. may want more copies because of performance or other configuration
  907. considerations).
  908.    If this package is already installed on another machine, and you
  909. will be sharing files, then there is no reason to install the shared
  910. files again.
  911.  
  912. EndOfMessage
  913.  
  914.    $HELP{ 'SDIR' } = <<"EndOfMessage";
  915.    This is the root of the shared portion of the install tree for the
  916. package.  By default it is set to <INSTALLDIR>/share.  You have many
  917. options on what to do with shared files.  Your "shared" directory can be:
  918.  
  919.     * symbolically linked to a common shared file tree (except System V)
  920.     * a file system which is mounted as the shared tree
  921.     * set to <INSTALLDIR> so that shared files will not be in a separate
  922.       subtree
  923.     * set to some directory completely separate from the <INSTALLDIR>
  924.  
  925. $HELP{ 'Shared' }   You may enter:                                 EXAMPLE
  926.         1) a fully qualified pathname            /packages/rtr
  927.         2) a pathname beginning with ~           ~fred/bambam
  928.         3) a pathname beginning with .           ./apps
  929.  
  930. EndOfMessage
  931.  
  932.    $HELP{ 'CONVERT' } = <<"EndOfMessage";
  933.    By default, the shared files are put in the directories lib, bin,
  934. include and spool (typically in a separate subtree, e.g. share/lib),
  935. but they can be kept in the uniquely named directories slib, sbin,
  936. sinclude and sspool; you might want to do this if you install your
  937. "shareable" files in the same place as your "non-shareable" files.
  938.  
  939. EndOfMessage
  940.  
  941.    $HELP{ 'APPNOTES' } = <<"EndOfMessage";
  942.    These are generally brief notes/hints to help when you first use
  943. this package.  They are combined into a single "document" which you
  944. may View, Print, or File (you are in the "App Note" loop until you
  945. enter "D", so you may View the notes before deciding to Print or File
  946. them.
  947.  
  948. EndOfMessage
  949.  
  950.    $HELP{ 'FILE' } = <<"EndOfMessage";
  951.    The installation system will redirect the text to any file you 
  952. request.
  953.  
  954. EndOfMessage
  955.  
  956.    $HELP{ 'PRINT' } = <<"EndOfMessage";
  957.    The installation system will pipe the text to any program/filter.
  958. Generally this is simply "lpr".
  959.  
  960. EndOfMessage
  961.  
  962.    $HELP{ 'umask' } = <<"EndOfMessage";
  963.    Your umask helps determine which file permissions are assigned when
  964. you create/install files.  A umask of 022 is "safe": it will allow
  965. others to see/execute the installed files, but not modify them.
  966.  
  967. EndOfMessage
  968.  
  969.    $HELP{ 'Install' } = <<"EndOfMessage";
  970.    You can choose to install this package, or you can skip this package
  971. and proceed to the next one.
  972.  
  973. EndOfMessage
  974.  
  975.    $HELP{ 'Remove' } = <<"EndOfMessage";
  976.    You can choose to remove this package, or you can skip this package
  977. and proceed to the next one.  If you elect to remove the package, you
  978. will be prompted with variations of the "install" questions (this
  979. allows you to remove a package with shared files from a single
  980. machine).
  981.  
  982. EndOfMessage
  983.  
  984.    $HELP{ 'Prereq' } = <<"EndOfMessage";
  985.    Some packages depend on other packages already being installed in
  986. order to work.  When this is the case, the installation system will
  987. verify the existence of the prerequisite package and ensure that the
  988. references to that package are mapped appropriately.
  989.  
  990. EndOfMessage
  991.  
  992.    $HELP{ 'Unformatted Man pages' } = <<"EndOfMessage"; 
  993.    Unformatted versions of the manual pages are generally smaller than
  994. the formatted versions (and can be typeset for many different output
  995. devices), but will be slower to access and require nroff or groff to
  996. be installed in order for "man" to work.
  997.  
  998. EndOfMessage
  999.  
  1000.    $HELP{ 'Formatted Man pages' } = <<"EndOfMessage"; 
  1001.    Formatted versions of the manual pages are generally larger than
  1002. the formatted versions (and cannot be typeset for different output
  1003. devices), but they are faster to access and do not require nroff or
  1004. groff to be installed in order for "man" to work.
  1005.  
  1006. EndOfMessage
  1007.  
  1008.    $HELP{ 'Texinfo files' } = <<"EndOfMessage"; 
  1009.    These files are part of the texinfo documentation for this package.
  1010. Ready-to-Run Software supplies texinfo documentation in four formats:
  1011.  
  1012.    .texinfo     - unified documentation source
  1013.    .info        - for on-line use (via info or emacs)
  1014.    .dvi         - formatted by TeX
  1015.    .ps          - PostScript format
  1016.  
  1017. You can choose to install as many or as few formats as you need.
  1018.  
  1019. EndOfMessage
  1020.  
  1021.    $HELP{ 'Info files' } = $HELP{ 'Texinfo files' };
  1022.  
  1023.    $HELP{ 'PostScript Format Documentation' } = <<"EndOfMessage";
  1024.    These PostScript format documentation files are included for your
  1025. convenience.  You may want to install them if you have a PostScript
  1026. printer or previewer.
  1027.  
  1028. EndOfMessage
  1029.  
  1030.    $HELP{ 'DVI Format Documentation' } = <<"EndOfMessage";
  1031.    These TeX formatted documentation files are included for your
  1032. convenience.  You may want to install them if you have a .dvi
  1033. previewer or a way to print .dvi files.
  1034.  
  1035. EndOfMessage
  1036.  
  1037.    $HELP{ 'Other Documentation' } = <<"EndOfMessage";
  1038.    These files are documentation of some sort which has been included
  1039. for your information.
  1040.  
  1041. EndOfMessage
  1042.  
  1043.    $HELP{ 'Required Compiled Emacs Lisp Files' } = <<"EndOfMessage";
  1044.    These files are the byte-compiled versions of some emacs commands
  1045. that you should include when you install this package.
  1046.  
  1047. EndOfMessage
  1048.  
  1049.    $HELP{ 'Required Emacs Lisp Source Files' } = <<"EndOfMessage";
  1050.    These files are the elisp source versions of some emacs commands
  1051. that you should include when you install this package.
  1052.  
  1053. EndOfMessage
  1054.  
  1055.  
  1056.    $HELP{ 'Optional Emacs Lisp Source Files' } = <<"EndOfMessage";
  1057.    These files are the elisp source versions of some emacs commands
  1058. that you may want to include when you install this package.  They are
  1059. marked "optional" because the corresponding .elc files are supplied.
  1060.  
  1061. EndOfMessage
  1062.  
  1063.  
  1064.    $HELP{ 'examples/templates/extra info' } 
  1065.       = <<"EndOfMessage"; 
  1066.    These files are provided by Ready-to-Run Software as a way to help
  1067. you get started using a package.  Generally they are example,
  1068. initialization, or demo files that make it easier to about learn a
  1069. package.
  1070.  
  1071. EndOfMessage
  1072.  
  1073.    $HELP{ 'Other Shareable files' } = <<"EndOfMessage";
  1074.    These shared files probably need to be installed unless you have
  1075. already installed them in your "shared" directory tree when doing a
  1076. previous installation.
  1077.  
  1078. EndOfMessage
  1079.  
  1080.    $HELP{ 'Library' } = <<"EndOfMessage";
  1081.    Libraries are "ar" archives of object (.o) files which are used when
  1082. linking programs.
  1083.  
  1084. EndOfMessage
  1085.  
  1086.    $HELP{ 'Optional Libraries' } = <<"EndOfMessage";
  1087.    These libraries are not required to run this package.  However, you
  1088. might want them installed if you plan on rebuilding this package or
  1089. building other packages that require the libraries from this package.
  1090.  
  1091. EndOfMessage
  1092.  
  1093.    $HELP{ 'Optional Include Files' } = <<"EndOfMessage";
  1094.    These include files are not required to run this package.  However,
  1095. you might want them installed if you plan on rebuilding this package or
  1096. building other packages that require the include files from this
  1097. package.
  1098.  
  1099. EndOfMessage
  1100.  
  1101.    $HELP{ 'Binary' } = <<"EndOfMessage";
  1102.    These binary files are not required to run this package.  Binary files
  1103. are typically programs that you can run.
  1104.  
  1105. EndOfMessage
  1106.  
  1107.    $HELP{ 'Required' } = <<"EndOfMessage";
  1108.    These files are required to run this package.  They are optionally 
  1109. installed because you may already have them installed.
  1110.  
  1111. EndOfMessage
  1112.  
  1113.    $HELP{ 'Suggested' } = <<"EndOfMessage";
  1114.    These files are not necessary, but are recommended.  They are optionally
  1115. installed because in some cases you may already have them installed.
  1116.  
  1117. EndOfMessage
  1118.  
  1119.    $HELP{ 'CORRECT' } = <<"EndOfMessage";
  1120.    If you are satisfied with the values you supplied, then you may allow the
  1121. install to proceed.  Otherwise, you may respecify any of the installation
  1122. parameters for this package.
  1123.  
  1124. EndOfMessage
  1125.  
  1126.    $HELP{ 'SOURCEDIR' } = <<"EndOfMessage";
  1127.    This is the root of the source tree. The sources for each package is 
  1128. installed in a subdirectory with the package name (e.g. <sourcedir>/calc).
  1129.  
  1130. EndOfMessage
  1131.  
  1132.    $HELP{ 'SEARCH' } = <<"EndOfMessage";
  1133.    You may enter any string and the Smart Installation System will
  1134. search the package descriptions for any mention of this string (case
  1135. independent) and then give you the chance to review/install any
  1136. matching packages.  If you enter multiple strings (e.g. "shell
  1137. interactive"), the SIS will search for descriptions which contain all
  1138. of the strings listed (each string can appear anywhere in the
  1139. description). There is a limit of approximately 20 characters of
  1140. search string(s).
  1141.  
  1142.    Try: "terminal"
  1143.  
  1144. EndOfMessage
  1145.  
  1146.    $HELP{ '<package>' } = <<"EndOfMessage";
  1147.    You may enter the name of any package listed below, you may search through
  1148. the package descriptions for a particular package, or you may quit out of the
  1149. Smart Installation System.
  1150.  
  1151. EndOfMessage
  1152.  
  1153. }
  1154.  
  1155. #
  1156. # Useful subroutines
  1157. #
  1158.  
  1159. sub key_ready {
  1160.    return 0 if $SVR3 || $MACHINE =~ /xenix/i;
  1161.    local($rin, $nfd);
  1162.    vec($rin, fileno(STDIN), 1) = 1;
  1163.    return $nfd = select($rin,undef,undef,0);
  1164. }
  1165.  
  1166. sub RemoveLS
  1167. {
  1168.    local( $name ) = @_;
  1169.    $name =~ s:^//+:/:;
  1170.    return $name;
  1171. }
  1172.  
  1173. # both SetOrigin and TranslateName strip leading /'s so they are mutually
  1174. # consistent
  1175. # remember to update RWSubst if changing translation rules.
  1176. sub TranslateName
  1177. {
  1178.     local($out, $in) = @_;
  1179.     local($ip, $isp);
  1180.     ($ip = $InstallPath) =~ s|^/+||;
  1181.     ($isp = $InstallSharePath) =~ s|^/+||;
  1182.     if ($out =~ /$SharePattern/o) {
  1183.         # currently, all convertable shareables start with $STAGEOrigin."/s"
  1184.         # so we simply remove the "s"
  1185.         $out =~ s/$ConvertFrom/$ConvertTo/o if ($ConvertShareables);
  1186.         $out =~ s/$STAGEOrigin/$isp/o;
  1187.         return &RemoveLS($out);
  1188.     }
  1189.     return &RemoveLS($out) if ($out =~ s/$AbsPath//o);
  1190.     return &RemoveLS($out) if ($out=~ s/$STAGEOrigin/$ip/o);
  1191.     # Problems exist if we have a relative path referencing a
  1192.     # shareable file and we convert or relocate shareable entries
  1193.     warn "Relative Path Problem: $out\n" 
  1194.                 if $out =~ m|\.\./|  &&
  1195.                   ($out =~ m:/$ShareDirs(\W|$):o || 
  1196.                    $in  =~ m:/$ShareDirs(\W|$):o)
  1197.                 &&($ConvertShareables  ||  
  1198.                    $ip ne $isp)
  1199.                 && $INTERNAL_RELATIVE_CHECK;
  1200.     return &RemoveLS($out);
  1201. }
  1202.  
  1203. sub FmtSize {
  1204.    local($size) = @_;
  1205.  
  1206.    return sprintf( "%.1fMb", $size/1048576.0 ) if $size > 1000000.0;#1048576.0;
  1207.    return sprintf( "%3dKb", int($size/1024) )   if $size > 1024;
  1208.    return sprintf( "%d bytes", $size );
  1209. }
  1210.  
  1211. # both SetOrigin and TranslateName strip leading /'s so they are mutually
  1212. # consistent
  1213. sub SetOrigin {
  1214.    ($STAGEOrigin) = @_;
  1215.    $STAGEOrigin   =~ s|^/+||;
  1216.    $SharePattern  = $STAGEOrigin . '/' . $ShareDirs;
  1217.    $ConvertFrom   = $STAGEOrigin . '/s';
  1218.    $ConvertTo     = $STAGEOrigin . '/';
  1219.    $AbsPath       = "$STAGEOrigin/ABS"; # staged component - absolute path
  1220. }
  1221.  
  1222. sub EmptySTDIN {
  1223.    while (&key_ready) { getc; }
  1224. }
  1225.  
  1226. sub Help {
  1227.     local($help) = @_;
  1228.     if (substr($help,0,1) eq '&') {
  1229.         eval($help);
  1230.         return;
  1231.     }
  1232.     printf( STDERR "\n$HELP{$help}" );
  1233. }
  1234.  
  1235. sub FileName {
  1236.    local($in,$out,$d) = @_;
  1237.    {
  1238.        $out = $in, last if $in !~ m:^~([^/]*):;
  1239.        if ($1 eq '') {
  1240.           $out = ($ENV{'HOME'} || $ENV{'LOGDIR'} || 
  1241.                   (getpwuid($<))[7]) . substr($in,1);
  1242.        }
  1243.        else
  1244.        {
  1245.           $out = (getpwnam($1))[7] . $' ;
  1246.        }
  1247.    } 
  1248.    return $out if substr($out,0,1) eq '/';
  1249.    $d = $cwd;
  1250.    while ($out =~ m:(\.{1,2}/)(.*$):) {
  1251.        $out = $2;
  1252.        next if ($1 eq './');
  1253.        $d =~ s:(.*)/[^/]+$:$1:;
  1254.    }
  1255.    return "$d/$out";
  1256. } 
  1257.  
  1258. sub GetAnswer {
  1259.    local($msg,$default,$help,$validate) = @_;
  1260.    local($answer,$msgidx);
  1261.    ($msgidx = $msg) =~ s/\(Approx.*\)//;
  1262.    &EmptySTDIN;
  1263.    return $DefaultAnswer{$msgidx} if defined $DefaultAnswer{$msgidx};
  1264.    if (!$UseDefaultAnswers) {
  1265.       substr( $default, -1 ) = '' if substr($default,-1) eq "\n";
  1266.       for (;;) {
  1267.          printf( STDERR "$msg [$default]? " );
  1268.          $answer = <STDIN>;
  1269.          chop $answer;
  1270.          $UseDefaultAnswers = $TRUE, last if $answer =~ /\+\+/;
  1271.          $DefaultAnswer{$msgidx} = $answer = $default, last if $answer =~ /\+/;
  1272.          &Help($help), redo if $answer eq '?';
  1273.          last if $validate eq '' || $answer =~ /$validate|^$/;
  1274.          printf( STDERR "'$answer' is not a valid response (enter ? for help)\n" );
  1275.       } 
  1276.    }
  1277.    return $default if ($UseDefaultAnswers || $answer eq '');
  1278.    if ($answer =~ /^[^a-z]+$/ && $answer =~ /[A-Z]/) {
  1279.       $answer =~ tr/A-Z/a-z/;
  1280.       $DefaultAnswer{$msgidx} = $answer ;
  1281.    }
  1282.    return ($answer);
  1283. }
  1284.  
  1285. sub GetReturn {
  1286.    local($msg) = @_;
  1287.    return if $UseDefaultAnswers;
  1288.    printf STDERR "$msg ... hit RETURN to continue ...";
  1289.    &EmptySTDIN;
  1290.    <STDIN>;
  1291. }
  1292.  
  1293. sub YesNo {
  1294.    local($msg,$help,$deflt) = @_;
  1295.    $deflt = 'y' if $deflt eq '';
  1296.    return $TRUE 
  1297.       if &GetAnswer( $msg, $deflt, $help, '^[YyNn]' ) =~ /^(y|\s*)$/i;
  1298.    return $FALSE;
  1299. }
  1300.  
  1301. sub Name {
  1302.    local($name,$ext,$limit) = @_;
  1303.    $name = substr( $name, 0, $limit - (length($ext)+1) );
  1304.    return "$name.$ext";
  1305. }
  1306.  
  1307. sub FixOwnersAndModes {
  1308.    local($in,$owner,$group,$perms,$force_owner) = @_;
  1309.    $force_owner = '\|' if $force_owner eq '';
  1310.    local($mode,$file,$grp);
  1311.    $file = &TranslateName("/$STAGEOrigin/$in");
  1312.    $mode = (umask ^ 077777777777) & 0777;
  1313.    $mode &= 0666 if $perms !~ /[sgx]/  && !-d $file;
  1314.    $grp = $(;
  1315.    if (substr($perms, $[+6, 1) eq 's') { # it's sgid!!
  1316.       if (!defined $gid{$group}) {
  1317.          local($n, $p, $g, $m) = getgrnam($group);
  1318.          $gid{$group} = $g;
  1319.       }
  1320.       chown($<, $grp = $gid{$group}, $file)
  1321.          || warn ("Can't change group of $file to $group: $!\n");
  1322.       $mode |= $SGID;
  1323.    }
  1324.    if (substr($perms, $[+3, 1) eq 's' || $owner =~ $force_owner) {
  1325.       if (!defined $uid{$owner}) {
  1326.          local($n, $p, $u, $g) = getpwnam($owner);
  1327.          $uid{$owner} = $u;
  1328.       }
  1329.       chown($uid{$owner}, $grp, $file)
  1330.          || warn ("Can't change owner of $file to $owner: $!\n");
  1331.       $mode |= $SUID if (substr($perms, $[+3, 1) eq 's');  # it's suid!!
  1332.    }
  1333.    chmod $mode, $file
  1334.       || ($mode = sprintf("o", $mode), warn("Can't chmod $out to $mode: $!\n"));
  1335. }
  1336.  
  1337. sub standard {
  1338.    local($name) = @_;
  1339.    ($name = substr($name,0,8)) =~ tr/A-Z/a-z/;
  1340.    return $name;
  1341. }
  1342.