home *** CD-ROM | disk | FTP | other *** search
/ The UNIX CD Bookshelf / OREILLY_TUCB_UNIX_CD.iso / upt / examples / COMMON / INSTALL.RTR < prev    next >
Encoding:
Text File  |  1998-07-24  |  22.2 KB  |  763 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. #
  34. # $Id: install.rtr,v 1.3 1997/06/18 18:45:26 mike Exp $
  35. #
  36. # $Log: install.rtr,v $
  37. # Revision 1.3  1997/06/18 18:45:26  mike
  38. # fis for perl5
  39. #
  40. # Revision 1.2  1997/06/18 18:44:21  jeff
  41. # updated copyright/address info
  42. #
  43. # Revision 1.1  1992/12/14  21:56:45  jeff
  44. # Initial revision
  45. #
  46. # Revision 1.13  1992/12/06  21:16:58  jeff
  47. # Another RS6000 patch change shared library patch change.
  48. # Symbolic Links fix.
  49. #
  50. # Revision 1.12  1992/09/11  14:50:14  jeff
  51. # Added installation logging.
  52. #
  53. # Revision 1.11  1992/07/13  12:30:42  jeff
  54. # Handle dynamic load library paths on RS6000.
  55. #
  56. # Revision 1.10  1992/07/13  11:38:45  jeff
  57. # Make sure that we only issue / warnings in Verbose mode.
  58. #
  59. # Revision 1.9  1992/03/13  11:04:20  jeff
  60. # Fix symbolic link testing for SCO.
  61. #
  62. # Revision 1.8  1992/02/14  19:39:55  jeff
  63. # Fix intermittent problem with bad format on SCO machines.
  64. #
  65. # Revision 1.7  1992/01/22  14:38:42  jeff
  66. # Full release version
  67. #
  68. # Revision 1.6  1992/01/06  19:42:06  jeff
  69. # General cleanup, new options to support "readypak", copying files
  70. # a few bug fixes (primarily with text files).
  71. #
  72. # Revision 1.5  1991/12/04  22:30:52  jeff
  73. # Fixed some small problems (including modes on install directories).
  74. # Added support for hard and symbolic links (if a hard link can't be
  75. # created, typically due to partition destinations, a copy will be
  76. # made instead).
  77. # Added checks for relative path problems (now that we're allowing
  78. # shareable files to move and shareable directories to be renamed,
  79. # a potential problem exists with relative path names).
  80. #
  81. # Revision 1.4  1991/12/04  19:45:10  jeff
  82. # Fix references to ABS and/or shareable files.
  83. # Handle paths with leading /'s better (-i and -s options)
  84. #
  85. # Revision 1.3  1991/12/04  14:49:58  jeff
  86. # Many changes:
  87. #      -s option (size) is now -t (totals)
  88. #      added -h for help (and usage message)
  89. #      -i to override default install path
  90. #      -s to override default shareables install path
  91. #      -c to convert slib->lib, sbin->bin, sspool->spool
  92. #
  93. # Revision 1.2  1991/12/04  11:29:35  jeff
  94. # Cleaned up the -r option (in particular, we now wait until all
  95. # files are removed before attempting to remove the directories,
  96. # and the directories are removed in the correct order to guarantee
  97. # that they can all be removed in a single pass if they're empty).
  98. #
  99. # Added -v option to turn on verbose messages.
  100. # Added -s option to display size of installed or removed files.
  101. #
  102. # Revision 1.1  1991/12/03  18:18:38  jeff
  103. # Initial revision
  104. #
  105.  
  106. $0 =~ m|(.*/)(.*)|, $PROG = $2; $EXECDIR = $1; # find program name
  107.  
  108. $TRUE = 1;
  109. $FALSE = 0;
  110. $DO_INFO = $FALSE;      # don't add info files to "dir"
  111. $TESTING = $FALSE;      # Should be FALSE when we ship
  112.  
  113. $INFO = 1;
  114. $START = 1;
  115. $PROCESS = 2;
  116. $END = 3;
  117.  
  118. $DEFAULT  = 1;
  119. $REQUIRED = 2;
  120. $OPTIONAL = 3;
  121.  
  122.  
  123. $SUID = 04000;
  124. $SGID = 02000;
  125.  
  126. $BlockSize        = 4096;
  127. $PathPrefix       = '/' x 50;
  128. $STAGEPath        = 'usr/STAGE';
  129. $InstallPath      = '/usr/local';
  130. $InstallSharePath = '/usr/local/share';
  131. $ShareDirs        = '(sbin|slib|sspool|sinclude|man|texinfo|doc|hardcopy)';
  132. $ConvertDirs      = '(sbin|slib|sspool|sinclude)';
  133. $AbsDir           = 'ABS';
  134. $RelativePathPrefix  = '../';
  135.  
  136.  
  137. $SYMLINK_EXISTS = (eval 'symlink("","");', $@ eq '' );
  138.  
  139. $TotalFiles = 0;
  140. $TotalLinks = 0;
  141. $TotalDirs = 0;
  142. $TotalFailFiles = 0;
  143. $TotalFailLinks = 0;
  144. $TotalFailDirs = 0;
  145. $TotalFailSize = 0;
  146. $ShowTotals = $FALSE;
  147. $Verbose = $FALSE;
  148. $ConvertShareables = $FALSE;
  149. $DeleteWhileInstalling = $FALSE;
  150. $Log = 'RTRinstall.log';
  151.  
  152. $stat = 'lstat';
  153. $stat = 'stat' if !$SYMLINK_EXISTS;
  154. $routine = Xfer;
  155. $FileMessage = "installed";
  156. $LinkMessage = "created";
  157. $DirMessage = "added";
  158.  
  159. &GetOptions();
  160.  
  161. if (defined $PakName) {
  162.    open( LOG, ">>$Log" );
  163.    printf LOG "\n\nPackage: $PakName -- installed " . `date` . "\n";
  164.    close LOG;
  165. }
  166.  
  167. open( LOG, "| sort >>$Log" );
  168.  
  169. &EnsureInstallDirs;
  170.  
  171.     while (<>) {
  172.         chop;
  173.         $copy = $FALSE;
  174.         $name = "/$STAGEOrigin/$_";
  175.         if ($name =~ /(.*)\*(.*)$/) {
  176.            $copy = $TRUE;
  177.            $name = $1 . $2;
  178.         }
  179.         &wanted();
  180.     }
  181.  
  182. &FinishRemove if ($routine eq Remove);
  183.  
  184. if ($ShowTotals)
  185. {
  186.     $TotalLinks -= $TotalFailLinks;
  187.     $TotalFiles -= $TotalFailFiles;
  188.     $TotalSize -= $TotalFailSize;
  189.     printf("\n");
  190.     printf("$TotalDirs director%s $DirMessage, ",($TotalDirs==1) ? 'y':'ies');
  191.     printf("$TotalFiles file%s $FileMessage, ", ($TotalFiles == 1) ? '':'s' );
  192.     printf("$TotalLinks symbolic link%s $LinkMessage.\n",($TotalLinks==1) ? '':'s');
  193.     printf( "Approximately %s $FileMessage.\n", &FmtSize($TotalSize) );
  194.  
  195.     # only print failure stats if something failed
  196.     printf("$TotalFailDirs director%s not $DirMessage",
  197.         ($TotalFailDirs==1) ? 'y':'ies') if $TotalFailDirs;
  198.     print ", " if $TotalFailDirs && $TotalFailFiles;
  199.     printf("$TotalFailFiles file%s not $FileMessage", 
  200.         ($TotalFailFiles == 1) ? '':'s' ) if $TotalFailFiles;
  201.     print ", " if $TotalFailDirs || $TotalFailFiles;
  202.     printf("$TotalFailLinks link%s not $LinkMessage", 
  203.         ($TotalFailLinks == 1) ? '':'s' ) if $TotalFailLinks;
  204.     print ".\n" if $TotalFailDirs || $TotalFailFiles || $TotalFailLinks;
  205.     printf( "Approximately %s not $FileMessage.\n", 
  206.         &FmtSize($TotalFailSize) ) if $TotalFailFiles;
  207. }
  208.  
  209. {
  210.     close LOG;
  211.     open( LOG, ">>$Log" );
  212.     printf( LOG "\n");
  213.     printf( LOG "$TotalDirs director%s $DirMessage, ",($TotalDirs==1) ? 'y':'ies');
  214.     printf( LOG "$TotalFiles file%s $FileMessage.\n", ($TotalFiles == 1) ? '':'s' );
  215.     printf( LOG "Approximately %s $FileMessage.\n", &FmtSize($TotalSize) );
  216.  
  217.     # only print failure stats if something failed
  218.     printf( LOG "$TotalFailDirs director%s not $DirMessage",
  219.         ($TotalFailDirs==1) ? 'y':'ies') if $TotalFailDirs;
  220.     print LOG ", " if $TotalFailDirs && $TotalFailFiles;
  221.     printf( LOG "$TotalFailFiles file%s not $FileMessage", 
  222.         ($TotalFailFiles == 1) ? '':'s' ) if $TotalFailFiles;
  223.     print LOG ".\n" if $TotalFailDirs || $TotalFailFiles;
  224.     printf( LOG "Approximately %s not $FileMessage.\n", 
  225.         &FmtSize($TotalFailSize) ) if $TotalFailFiles;
  226.     printf( LOG "\n\n         ********************************\n" );
  227. }
  228.  
  229. close LOG;
  230.  
  231. exit;
  232.  
  233. sub GetOptions 
  234. {
  235.     while ($ARGV[0] =~ /^-/) {
  236.         $_ = shift @ARGV;
  237.         $ShowTotals = !$ShowTotals                        ,next if (/^-t/i);
  238.         $Verbose = !$Verbose                              ,next if (/^-v/i);
  239.         $Log = shift @ARGV                                ,next if (/^-L/);
  240.         $PakName = shift @ARGV                            ,next if (/^-N/);
  241.         $ConvertShareables = !$ConvertShareables          ,next if (/^-c/i);
  242.         $DeleteWhileInstalling = !$DeleteWhileInstalling  ,next if (/^-d/i);
  243.         $PrereqTrans{shift @ARGV} = shift @ARGV           ,next if (/^-p/i);
  244.         if (/^-i/i)
  245.         {
  246.             $InstallPath = shift @ARGV;
  247.             $InstallPath =~ s|^/+||;
  248.             next;
  249.         }
  250.         if (/^-r/i)
  251.         {
  252.             $routine = Remove ;
  253.             $DirMessage = "removed";
  254.             $FileMessage = "removed";
  255.             next;
  256.         }
  257.         if (/^-s/i)
  258.         {
  259.             $InstallSharePath = shift @ARGV;
  260.             $InstallSharePath =~ s|^/+||;
  261.             next;
  262.         }
  263.         if (/^-o/i)
  264.         {
  265.             $STAGEOrigin = shift @ARGV;
  266.             $STAGEOrigin =~ s|^/+||;
  267.             &SetOrigin( $STAGEOrigin );
  268.             next;
  269.         }
  270.  
  271.         # we only get here for -h or unknown options
  272.         print "\nUnknown option: $_" if (!/^-h/i);
  273.  
  274.         print "\nUsage:  $PROG [-cdfhrsv] [-ios dir] [-p name1 name2]\n";
  275.         print "         -c       convert slib->lib, sbin->bin, sspool->spool\n";
  276.         print "         -d       delete from STAGE while installing\n";
  277.         print "         -f       find files to install\n";
  278.         print "         -h       this help message\n";
  279.         print "         -i dir   install package at dir (default /usr/local)\n";
  280.         print "         -o dir   origin (STAGE)\n";
  281.         print "         -p n1 n2 prequisite translation\n";
  282.         print "         -r       remove package\n";
  283.         print "         -s dir   install shareable portion of package at dir\n";
  284.         print "         -t       show totals\n";
  285.         print "         -v       verbose output\n";
  286.         print "         -L file  create install log (file)\n";
  287.         print "         -N name  indicate package name in log\n\n";
  288.         exit;
  289.     }
  290. }
  291.  
  292. sub wanted {
  293.     (($dev,$ino,$mode,$nlink,$uid,$gid) = eval "$stat(\"$name\")") &&
  294.     eval '&$routine';
  295.     if ($@ && -e $name) {
  296.         print "   ERROR: $@";
  297.         $TotalFailFiles++, $TotalFailSize += (-s _) if -f _;
  298.         $TotalFailDirs++ if -d _;
  299.     }
  300.     &Extras;
  301.     return (1);
  302. }
  303.  
  304. sub Extras
  305. {
  306. # do any applicable extra processing after the file has been processed
  307. }
  308.  
  309. sub Xfer
  310. {
  311.     local($in) = $name;
  312.     local($out) = &TranslateName($name);
  313.  
  314.     if ($SYMLINK_EXISTS && -l $name)    # symbolic link?
  315.     {
  316.         local($inl) = readlink $in;
  317.         $inl =~ s:/usr/STAGE:$STAGEOrigin:;
  318.         unlink($out);
  319.         (symlink( &TranslateName($inl), $out ) && ++$TotalLinks) ||
  320.                 $TotalFailLinks++;
  321.     }
  322.     elsif (-f $name)
  323.     {
  324.         $TotalFiles++;
  325.         $TotalSize += -s _;
  326.         print "$out" if $Verbose;
  327.         printf LOG "   $out\n";
  328.  
  329.         # if we want to copy this file without reformating...
  330.         # try to "link the file", otherwise just "rewrite"
  331.         ($copy && unlink( $out ) && link( $in, $out )) || &ReWrite;
  332.         unlink($in) if $DeleteWhileInstalling;
  333.         print "\n" if $Verbose;
  334.     }
  335.     elsif (! -e $out)
  336.     {
  337.         return if $out eq "/$InstallPath/$AbsDir"; # Don't create the ABS dir
  338.         print "$out: Making directory\n" if $Verbose;
  339.         printf LOG "   $out: Making directory\n";
  340.         mkdir($out, $mode)
  341.            || die("Can't mkdir $out: $!\n");
  342.         $TotalDirs++;
  343.         if ($SYMLINK_EXISTS) { lstat($_); }
  344.         else                 {  stat($_); }
  345.     }
  346.     else { return; } # return if we didn't do anything.
  347. }
  348.  
  349. sub ReWrite
  350. {
  351.     local(*IH, *OH, $buf, $pos, $outPos, $subs, $isTxt, $target);
  352.  
  353.     open(IH, $in)
  354.         || die("Can't open $in for reading: $!\n");
  355.  
  356.     unlink( $out );
  357.  
  358.  
  359.     # check for links before copying file
  360.     # hard link?
  361.     if ($nlink > 1) {
  362.         # have we already copied this file ?
  363.         $target = $LinkMap[ $dev, $ino ];
  364.         if (($target ne "") && link( $target, $out )) {
  365.             # don't count the space when we're only linking
  366.             $TotalSize -= -s _;
  367.             return (undef);
  368.         }
  369.         # if we can't link to the target, copy this one over and make it the 
  370.         # new target.
  371.         $LinkMap[ $dev, $ino ] = $out;        
  372.     }
  373.  
  374.     open(OH, ">$out") || die("Can't open $out for writing: $!\n");
  375.  
  376.     warn("Warning: $in is empty!\n")
  377.         if (!&RWBlockRead && $Verbose);
  378.     do
  379.     {
  380.         &RWBlockRead;
  381.         if (!$copy) {
  382.            $pos = index($buf, $PathPrefix, 0);
  383.            while ($pos != -1 && $pos <= $BlockSize)
  384.            {
  385.               $pos = &RWSubst;
  386.               $pos = index($buf, $PathPrefix, $pos);
  387.            }
  388.            $pos = index($buf, $RelativePathPrefix, 0);
  389.            while ($pos != -1 && $pos <= $BlockSize)
  390.            {
  391.               $pos = &RelativePathCheck($in);
  392.               $pos = index($buf, $RelativePathPrefix, $pos);
  393.            }
  394.         }
  395.     }
  396.     while (&RWBlockWrite);
  397.  
  398.     print ": $subs Substitutions."
  399.         if ($subs && $Verbose);
  400.  
  401.     close(IH);
  402.     close(OH);
  403.  
  404.     return (undef);
  405. }
  406.  
  407.  
  408. sub RelativePathCheck
  409. {
  410.     local($in) = @_;
  411.     local($curPos, $path) = $outPos + $pos;
  412.  
  413.     # let's be paranoid and look for relative path problems
  414.     # after this regex, $1 = entire path
  415.     #                   $2 = leading ../
  416.     #                   $3 = rest of path
  417.     return $pos+1 if (!(substr($buf, $pos) =~ m|((../+)([\!-\~]+))|o));
  418.     $path = $1;
  419.     warn "Warning: Relative Path Problem: $path in $in\n" 
  420.              if ($path =~ m:/$ShareDirs(\W|$):o || 
  421.                  $in   =~ m:/$ShareDirs(\W|$):o) &&
  422.                 ($ConvertShareables  ||  
  423.                  $InstallPath ne $InstallSharePath)
  424.              && $INTERNAL_RELATIVE_CHECK;
  425.     return ($pos + length($path));
  426. }
  427.  
  428. sub RWSubst
  429. {
  430.     local($curPos, $new) = $outPos + $pos;
  431.     local($length1, $path);
  432.  
  433.     # after this regex, $1 = entire path
  434.     #                   $2 = leading ///'s
  435.     #                   $3 = "$STAGEPath"
  436.     #                   $4 = after "$STAGEPath"
  437.     if (!(substr($buf, $pos) =~ m:((/+)($STAGEPath)(\W[\!-\~]*|$)):o))
  438.     {
  439.         warn("Warning at offset $curPos: lots of '/'s, but bad path\n")
  440.            if $Verbose;
  441.         substr($buf, $pos) =~ m|(/+)|;
  442.         return ($pos + length($1));
  443.     }
  444.  
  445.     $length1 = length($1);
  446.  
  447.     warn("Warning at offset $curPos: The chain of '/'s is less than 75\n")
  448.         if (length($2) < 75) && $Verbose;
  449.     warn("Warning at offset $curPos: The chain of '/'s is more than 75\n")
  450.         if (length($2) > 75) && $Verbose;
  451.  
  452.     $path = $4;
  453.  
  454.     if ($path =~ m:^/$ShareDirs(\W|$):o) {
  455.         $path =~ s|^/s|/| if ($ConvertShareables); # remove leading "s"?
  456.         $new = "/$InstallSharePath$path";
  457.     }
  458.     elsif ($path =~ m|^$AbsDir(/)([\!-\~]+)|o) {
  459.         $new = "/$2";
  460.     }
  461.     else {
  462.         $new = "/$InstallPath$path";
  463.     }
  464.  
  465.     # in case a prerequisite package was installed somewhere else
  466.     $new = $PrereqTrans{$new} if defined($PrereqTrans{$new});
  467.  
  468.     if ($new =~ /:((\/usr)?\/lib)$/) { $new .= ':' x ($length1 - length($new)); }
  469.     else              { $new .= "\000" x ($length1 - length($new)); }
  470.     substr($buf, $pos, $length1) = $new;
  471.     $subs++;
  472.  
  473.     return ($pos);
  474. }
  475.  
  476.  
  477. sub RWBlockRead
  478. {
  479.     local($lbuf, $len);
  480.  
  481.     $len = sysread(IH, $lbuf, $BlockSize);
  482.     $buf = $buf . $lbuf;
  483.  
  484.     return ($len > 0);
  485. }
  486.  
  487.  
  488. sub RWBlockWrite
  489. {
  490.     local($pos, $wlen, $len, $wbuf);
  491.  
  492.     return ($FALSE)
  493.         if (length($buf) == 0);
  494.  
  495.     $isTxt = !($buf =~ /[\001-\010\013\015-\037]/) if (!$outPos);
  496.  
  497.     $wlen = length($buf);
  498.     $wlen = $BlockSize
  499.         if ($wlen > $BlockSize);
  500.     $wbuf = substr($buf, 0, $wlen);
  501.  
  502.     if ($isTxt && $subs)
  503.     {
  504.         $wbuf =~ s/\000//g;
  505.         $wlen = length($wbuf);
  506.     }
  507.  
  508.     $len = syswrite(OH, $wbuf, $wlen);
  509.     die("Error writing to $out: $!\n")
  510.         if ($len != $wlen);
  511.  
  512.     $outPos += $len;
  513.  
  514.     $buf = substr($buf, $BlockSize);
  515.  
  516.     return ($TRUE);
  517. }
  518.  
  519.  
  520. sub Remove
  521. {
  522.     local($in) = $name;
  523.     local($out) = &TranslateName($name);
  524.  
  525.     if (-f _)
  526.     {
  527.         if (unlink($out)) {
  528.            $TotalFiles++;
  529.            $TotalSize += -s _;
  530.            print "$out...removed\n" if $Verbose;
  531.            printf LOG "   $out...removed\n";
  532.         }
  533.         elsif (-f $out) {
  534.            print "$out...can`t remove\n" if $Verbose;
  535.            printf LOG "   $out...can`t remove\n";
  536.         }
  537.         else {
  538.            print "$out...already removed\n" if $Verbose;
  539.            printf LOG "   $out...already removed\n";
  540.         }
  541.     }
  542.     elsif (-d $out)
  543.     {
  544.         $dirlist{ $out } = $TRUE;
  545.     }
  546.     return ($TRUE);
  547. }
  548.  
  549. sub ReverseLength
  550. {
  551.    return (length($b) <=> length($a));
  552. }
  553.  
  554. sub FinishRemove
  555. {
  556.     foreach (sort ReverseLength keys %dirlist)
  557.     {
  558.         if (rmdir $_)
  559.         {
  560.             $TotalDirs++;
  561.             print "$_...removed\n" if $Verbose;
  562.             printf LOG "   $_...removed\n";
  563.         }
  564.     }
  565.     return ($TRUE);
  566. }
  567.  
  568. sub EnsureInstallDirs {
  569.     local($out);
  570.  
  571.     $mode = 0755; # create these directories rwxr-xr-x
  572.     $out = '/' . $InstallPath;
  573.     if (! -e $out) {
  574.         print "$out: Making directory\n" if $Verbose;
  575.         printf LOG "   $out: Making directory\n" ;
  576.         mkdir($out, $mode)
  577.            || die("Can't mkdir $out: $!\n");
  578.         $TotalDirs++;
  579.         chmod($mode, $out) || die("Can't chmod $out to $mode: $!\n");
  580.     }
  581.  
  582.     $out = '/' . $InstallSharePath;
  583.     if (! -e $out) {
  584.         print "$out: Making directory\n" if $Verbose;
  585.         printf LOG "   $out: Making directory\n" ;
  586.         mkdir($out, $mode)
  587.            || die("Can't mkdir $out: $!\n");
  588.         $TotalDirs++;
  589.         chmod($mode, $out) || die("Can't chmod $out to $mode: $!\n");
  590.     }
  591. }
  592.  
  593. sub RemoveLS
  594. {
  595.    local( $name ) = @_;
  596.    $name =~ s:^//+:/:;
  597.    return $name;
  598. }
  599.  
  600. # both SetOrigin and TranslateName strip leading /'s so they are mutually
  601. # consistent
  602. # remember to update RWSubst if changing translation rules.
  603. sub TranslateName
  604. {
  605.     local($out, $in) = @_;
  606.     local($ip, $isp);
  607.     ($ip = $InstallPath) =~ s|^/+||;
  608.     ($isp = $InstallSharePath) =~ s|^/+||;
  609.     if ($out =~ /$SharePattern/o) {
  610.         # currently, all convertable shareables start with $STAGEOrigin."/s"
  611.         # so we simply remove the "s"
  612.         $out =~ s/$ConvertFrom/$ConvertTo/o if ($ConvertShareables);
  613.         $out =~ s/$STAGEOrigin/$isp/o;
  614.         return &RemoveLS($out);
  615.     }
  616.     return &RemoveLS($out) if ($out =~ s/$AbsPath//o);
  617.     return &RemoveLS($out) if ($out=~ s/$STAGEOrigin/$ip/o);
  618.     # Problems exist if we have a relative path referencing a
  619.     # shareable file and we convert or relocate shareable entries
  620.     warn "Relative Path Problem: $out\n" 
  621.                 if $out =~ m|\.\./|  &&
  622.                   ($out =~ m:/$ShareDirs(\W|$):o || 
  623.                    $in  =~ m:/$ShareDirs(\W|$):o)
  624.                 &&($ConvertShareables  ||  
  625.                    $ip ne $isp)
  626.                 && $INTERNAL_RELATIVE_CHECK;
  627.     return &RemoveLS($out);
  628. }
  629.  
  630. sub FmtSize {
  631.    local($size) = @_;
  632.  
  633.    return sprintf( "%.1fMb", $size/1048576.0 ) if $size > 1000000.0;#1048576.0;
  634.    return sprintf( "%3dKb", int($size/1024) )   if $size > 1024;
  635.    return sprintf( "%d bytes", $size );
  636. }
  637.  
  638. # both SetOrigin and TranslateName strip leading /'s so they are mutually
  639. # consistent
  640. sub SetOrigin {
  641.    ($STAGEOrigin) = @_;
  642.    $STAGEOrigin   =~ s|^/+||;
  643.    $SharePattern  = $STAGEOrigin . '/' . $ShareDirs;
  644.    $ConvertFrom   = $STAGEOrigin . '/s';
  645.    $ConvertTo     = $STAGEOrigin . '/';
  646.    $AbsPath       = "$STAGEOrigin/ABS"; # staged component - absolute path
  647. }
  648.  
  649. sub EmptySTDIN {
  650.    while (&key_ready) { getc; }
  651. }
  652.  
  653. sub Help {
  654.     local($help) = @_;
  655.     if (substr($help,0,1) eq '&') {
  656.         eval($help);
  657.         return;
  658.     }
  659.     printf( STDERR "\n$HELP{$help}" );
  660. }
  661.  
  662. sub FileName {
  663.    local($in,$out,$d) = @_;
  664.    {
  665.        $out = $in, last if $in !~ m:^~([^/]*):;
  666.        if ($1 eq '') {
  667.           $out = ($ENV{'HOME'} || $ENV{'LOGDIR'} || 
  668.                   (getpwuid($<))[7]) . substr($in,1);
  669.        }
  670.        else
  671.        {
  672.           $out = (getpwnam($1))[7] . $' ;
  673.        }
  674.    } 
  675.    return $out if substr($out,0,1) eq '/';
  676.    $d = $cwd;
  677.    while ($out =~ m:(\.{1,2}/)(.*$):) {
  678.        $out = $2;
  679.        next if ($1 eq './');
  680.        $d =~ s:(.*)/[^/]+$:$1:;
  681.    }
  682.    return "$d/$out";
  683. } 
  684.  
  685. sub GetAnswer {
  686.    local($msg,$default,$help,$validate) = @_;
  687.    local($answer,$msgidx);
  688.    ($msgidx = $msg) =~ s/\(Approx.*\)//;
  689.    &EmptySTDIN;
  690.    return $DefaultAnswer{$msgidx} if defined $DefaultAnswer{$msgidx};
  691.    if (!$UseDefaultAnswers) {
  692.       substr( $default, -1 ) = '' if substr($default,-1) eq "\n";
  693.       for (;;) {
  694.          printf( STDERR "$msg [$default]? " );
  695.          $answer = <STDIN>;
  696.          chop $answer;
  697.          $UseDefaultAnswers = $TRUE, last if $answer =~ /\+\+/;
  698.          $DefaultAnswer{$msgidx} = $answer = $default, last if $answer =~ /\+/;
  699.          &Help($help), redo if $answer eq '?';
  700.          last if $validate eq '' || $answer =~ /$validate|^$/;
  701.          printf( STDERR "'$answer' is not a valid response (enter ? for help)\n" );
  702.       } 
  703.    }
  704.    return $default if ($UseDefaultAnswers || $answer eq '');
  705.    if ($answer =~ /^[^a-z]+$/) {
  706.       $answer =~ tr/A-Z/a-z/;
  707.       $DefaultAnswer{$msgidx} = $answer ;
  708.    }
  709.    return ($answer);
  710. }
  711.  
  712. sub GetReturn {
  713.    local($msg) = @_;
  714.    return if $UseDefaultAnswers;
  715.    printf STDERR "$msg ... hit RETURN to continue ...";
  716.    &EmptySTDIN;
  717.    <STDIN>;
  718. }
  719.  
  720. sub YesNo {
  721.    local($msg,$help,$deflt) = @_;
  722.    $deflt = 'y' if $deflt eq '';
  723.    return $TRUE 
  724.       if &GetAnswer( $msg, $deflt, $help, '^[YyNn]' ) =~ /^(y|\s*)$/i;
  725.    return $FALSE;
  726. }
  727.  
  728. sub Name {
  729.    local($name,$ext,$limit) = @_;
  730.    $name = substr( $name, 0, $limit - (length($ext)+1) );
  731.    return "$name.$ext";
  732. }
  733.  
  734. sub FixOwnersAndModes {
  735.    local($in,$owner,$group,$perms,$force_owner) = @_;
  736.    $force_owner = '\|' if $force_owner eq '';
  737.    local($mode,$file,$grp);
  738.    $file = &TranslateName("/$STAGEOrigin/$in");
  739.    $mode = (~ umask) & 0777;
  740.    $mode &= 0666 if $perms !~ /[sgx]/  && !-d $file;
  741.    $grp = $(;
  742.    if (substr($perms, $[+6, 1) eq 's') { # it's sgid!!
  743.       if (!defined $gid{$group}) {
  744.          local($n, $p, $g, $m) = getgrnam($group);
  745.          $gid{$group} = $g;
  746.       }
  747.       chown($<, $grp = $gid{$group}, $file)
  748.          || warn ("Can't change group of $file to $group: $!\n");
  749.       $mode |= $SGID;
  750.    }
  751.    if (substr($perms, $[+3, 1) eq 's' || $owner =~ $force_owner) {
  752.       if (!defined $uid{$owner}) {
  753.          local($n, $p, $u, $g) = getpwnam($owner);
  754.          $uid{$owner} = $u;
  755.       }
  756.       chown($uid{$owner}, $grp, $file)
  757.          || warn ("Can't change owner of $file to $owner: $!\n");
  758.       $mode |= $SUID if (substr($perms, $[+3, 1) eq 's');  # it's suid!!
  759.    }
  760.    chmod $mode, $file
  761.       || ($mode = sprintf("o", $mode), warn("Can't chmod $out to $mode: $!\n"));
  762. }
  763.