home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1999 March B / SCO_CASTOR4RRT.iso / nsfast / root.9 / usr / ns-home / install / upgrade / upgrade~
Text File  |  1998-08-19  |  33KB  |  1,058 lines
  1. #!./perl
  2.  
  3. # This script upgrades a 1.1 Commerce or Communications server to 2.0
  4. # It copies the configuration information from a 1.1 server to the 2.0
  5. # server's area.
  6. #
  7. # It must be run from the install subdirectory of the 2.0 installation
  8. #
  9. # Usage: $0 [-s 1.1Root] [-p list of 1.1 servers space separated]
  10. #    [-n list 2.0 servers space separated.  1.1 will become corresponding 2.0]
  11. #    [-w passwds for 1.1 servers that had key files in the magnus.conf] [-o]
  12. #
  13. # -o tells the script that a partial install has already happened, and an
  14. #    obj.conf already exists in the 2.0 tree
  15. #
  16. # $Id: upgrade,v 1.7.2.14.2.22 1996/07/13 00:37:00 flc Exp $
  17. #
  18. # Copyright 1996, Netscape Communications Corporation
  19.  
  20. use Magnus;
  21. use ObjConf;
  22.  
  23. $isNT = -d '\\';    # This will work unless someone created a directory
  24.             # call \ in the install directory.  Very unlikely
  25. $slash = $isNT ? '\\' : '/';
  26. $slashPattern = $isNT ? '[\\\\/]' : '/';
  27. $pathCS = $isNT ? '(?i)' : '';    # if NT, make substitution case insensitive
  28.  
  29. $| = 1;
  30.  
  31. &parseParams;
  32.  
  33. umask( 022 );
  34.  
  35. until ( -d $srcDir ) {
  36.     if ( ! $srcDir ) {
  37.     if ( $isNT ) {
  38.         $srcDir = 'C:\Netscape\Server';
  39.     } else {
  40.         $srcDir = '/usr/ns-home';
  41.     }
  42.     }
  43.     print "Please enter the root path of the old server installation: [$srcDir] ";
  44.     $srcDir = $newDir if ( $newDir = <> ) !~ /^\s*$/;
  45.     chomp( $srcDir );
  46. }
  47. chop( $srcDir ) if $srcDir =~ /${slashPattern}$/;
  48.  
  49. if ( $isNT ) {
  50.     $ENV{'PROMPT'} = '$P$G';
  51.     chdir( '..' ) || die "Can't cd ..: $!\n";
  52.     $destDir = `cd`;
  53.     ( $disk ) = $destDir =~ /^(\w+:)/;
  54.     chdir( 'install' ) || die "Can't cd install: $!\n";
  55. } else {
  56.     $destDir = `cd .. ; pwd`;
  57.     $disk = '';
  58. }
  59. chomp( $destDir );
  60. until ( -d $destDir ) {
  61.     $destDir = '/usr/ns-home' unless $destDir;
  62.     print "Please enter the root path of the new server installation: [$destDir] ";
  63.     $destDir = $newDir if ( $newDir = <> ) !~ /^\s*$/;
  64.     chomp( $destDir );
  65. }
  66. chop( $destDir ) if $destDir =~ /${slashPattern}$/;
  67. $destDir =~ s@$slashPattern@/@g if $isNT;    # standardize on /
  68.  
  69. # Figure out what kind of server we're installing
  70. if ( -d "$destDir/bin/https" ) {    # Enterprise
  71.     $serverType = 'https';
  72.     $serverDesc = "Netscape Enterprise Server";
  73. } elsif ( -d "$destDir/bin/httpd" ) {    # Fast Track
  74.     $serverType = 'httpd';
  75.     $serverDesc = "Netscape FastTrack Server";
  76. } else {
  77.     die "Can't figure out what kind of server to which you're upgrading";
  78. }
  79.  
  80. $oldServer = 0;
  81.  
  82. # Get the server list.  Do some checking if it's Unix
  83. if ( $isNT ) {
  84.     @servers = &serverList( $srcDir );
  85. } else {
  86.     if ( -d "$srcDir/admserv" ) {
  87.     $adminConf = new Magnus( "$srcDir/admserv/ns-admin.conf" );
  88.     die "Couldn't read $srcDir/admserv/ns-admin.conf: $@\n" unless $adminConf;
  89.     if ( $adminConf->value( 'NetsiteRoot' ) ne $srcDir ) {
  90.         my    $dev1;
  91.         my    $dev2;
  92.         my    $inode1;
  93.         my    $inode2;
  94.  
  95.         ( $dev1, $inode1 ) = stat( $srcDir );
  96.         ( $dev2, $inode2 ) = stat( $adminConf->value( 'NetsiteRoot' ) );
  97.         if ( $dev1 != $dev2 or $inode1 != $inode2 ) {
  98.         die "Confused because $srcDir has a $srcDir/admserver/ns-admin.conf
  99. whose NetsiteRoot points to a different directory than $srcDir.\n";
  100.         }
  101.         $srcDir = $adminConf->value( 'NetsiteRoot' );
  102.     }
  103.     ( $login, $pass, $uid, $gid ) = getpwnam( $adminConf->value( 'User' ) ) or
  104.         die $adminConf->value( 'User' ) . " not in passwd file\n";
  105.     die 'Not running as ' . $adminConf->value( 'User' ) . "\n"
  106.         unless $> == $uid;
  107.     @servers = &serverList( $srcDir );
  108.     die "No servers to upgrade\n" unless scalar( @servers );
  109.     } elsif ( -x "$srcDir/ns-httpd" ) {    # ancient system
  110.     @servers = &oldServerList( $srcDir );
  111.     $oldServer = 1;
  112.     } else {
  113.     die "$srcDir doesn't look like any Netscape installation I know about\n";
  114.     }
  115. }
  116. open( SERVERS, "$destDir/admserv/servers.lst" );    # just in case it exists
  117. while ( <SERVERS> ) {
  118.     push( @serverList, $_ );
  119.     ( $type, $desc ) = split( /:/, $_ );
  120.     last if $type eq $serverType;
  121. }
  122. close( SERVERS );
  123. if ( $type ne $serverType ) {    # didn't find our type
  124.     open( SERVERS, ">>$destDir/admserv/servers.lst" ) ||
  125.     die "Can't create $destDir/admserv/servers.lst: $!\n";
  126.     print SERVERS "$serverType:$serverDesc\n";
  127.     close( SERVERS );
  128. }
  129.  
  130. $minThreads = 4;
  131. $maxThreads = 32;
  132. $maxProcs = 4;
  133. require 'threads.pl' if -f 'threads.pl';
  134.  
  135. unless ( -d "$destDir/authdb" ) {
  136.     mkdir( "$destDir/authdb", 0777 ) ||
  137.     die "Couldn't create $destDir/authdb: $!\n";
  138. }
  139. unless ( -d "$destDir/httpacl" ) {
  140.     mkdir( "$destDir/httpacl", 0777 ) ||
  141.     die "Couldn't create $destDir/httpacl: $!\n";
  142. }
  143.  
  144. @complaints = ();
  145. %dbs = ();
  146. foreach $server ( @servers ) {
  147.     $nickname = shift @nicknames;
  148.     while ( ! $nickname ) {
  149.     print "Instead of being known by port number, your servers will be known\n";
  150.     print "by nickname.  The nickname may only have letters, digits, '-'s and '_'s.\n";
  151.     print "I will add the $serverType-, so you don't have to.\n";
  152.     print "Choose a nickname for the $server server: ";
  153.     chomp( $nickname = <STDIN> );
  154.     if ( $nickname !~ /^[\w\-.]+$/ or $nickname =~ /^http[sd]-/ ) {
  155.         print "\nThat name has unwanted characters in it.\n";
  156.         redo;
  157.     }
  158.     $nickname = $serverType . '-' . $nickname;
  159.     }
  160.     print "Upgrading $server to $nickname...\n";
  161.     unless ( $partialUpgrade ) {
  162.     mkdir( "$destDir/$nickname", 0777 ) ||
  163.         die "Can't mkdir $destDir/$nickname: $!\n";
  164.     mkdir( "$destDir/$nickname/config", 0777 ) ||
  165.         die "Can't mkdir $destDir/$nickname/config: $!\n";
  166.     mkdir( "$destDir/$nickname/logs", 0777 ) ||
  167.         die "Can't mkdir $destDir/$nickname/config: $!\n";
  168.     }
  169.     if ( $isNT ) {
  170.     $configDir = "$destDir/$nickname/config";
  171.     } else {
  172.     $configDir = &findConfig( $srcDir, $server, $oldServer );
  173.     }
  174.     die "Couldn't find a config directory for $srcDir/$server\n"
  175.     unless $configDir;
  176.     $magnus = new Magnus( "$configDir/magnus.conf" );
  177.     die "Couldn't find magnus.conf in $configDir" unless $magnus;
  178.     if ( $magnus->{'source'}->[0] =~ /^#ServerRoot/i ) {
  179.     $magnus->{'source'}->[0] = "#ServerRoot $destDir/$nickname\n";
  180.     }
  181.     if ( $partialUpgrade ) {    # obj.conf in 2.0 tree
  182.     ©File( "$destDir/$nickname/config/obj.conf",
  183.            "$destDir/$nickname/config/chris.conf" );
  184.     $objSrc = "$destDir/$nickname/config/chris.conf";
  185.     } else {
  186.     ( $login, $pass, $uid, $gid ) = getpwnam( $magnus->value( 'User' ) ) or
  187.         die "$user not in passwd file";
  188.     chown( $uid, $gid, "$destDir/$nickname/logs" ) ||
  189.         warn "Couldn't make $destDir/$nickname/logs owned by " .
  190.         $magnus->value( 'User' ) . "\n";
  191.     $objSrc = $configDir . '/' . $magnus->value( 'LoadObjects' );
  192.     die "Misleading $configDir/magnus.conf, couldn't find obj.conf\n"
  193.         unless -f $objSrc;
  194.     # trick the magnus object into writing the results out to the new dir
  195.     $magnus->{'file'} = "$destDir/$nickname/config/magnus.conf";
  196.     }
  197.     # Standardize
  198.     $magnus->set( 'ErrorLog', "$destDir/$nickname/logs/errors" );
  199.     $magnus->set( 'PidLog', "$destDir/$nickname/logs/pid" );
  200.     @complaints = ( @complaints, 
  201.             &xlatePath( $objSrc,
  202.                     "$destDir/$nickname/config/obj.conf",
  203.                     2,
  204.                     "$srcDir/$server", "$srcDir",
  205.                     "$destDir/$nickname", "$destDir",
  206.                     '/logs/' ) );
  207.     unless ( $isNT ) {
  208.     foreach $utility ( 'stop', 'start', 'restart',
  209.                "../bin/$serverType/install/misc/rotate" ) {
  210.         open( SRC, $utility ) || die "Can't open prototype $utility: $!\n";
  211.         $utility =~ s@.*/@@;    # trim path info
  212.         open( DEST, ">$destDir/$nickname/$utility" ) ||
  213.         die "Can't create $destDir/$nickname/$utility: $!\n";
  214.         while ( <SRC> ) {
  215.         if ( /%(ROOT|SERVER|STYPE)%/ ) {
  216.             print DEST $`;
  217.             if ( $1 eq 'ROOT' ) {
  218.             print DEST $destDir;
  219.             } elsif ( $1 eq 'SERVER' ) {
  220.             print DEST "$destDir/$nickname";
  221.             } elsif ( $1 eq 'STYPE' ) {
  222.             print DEST $serverType;
  223.             }
  224.             $_ = $';
  225.             redo;    # see if there are more %%s in the file
  226.         } else {
  227.             print DEST;
  228.         }
  229.         }
  230.         close( SRC );
  231.         close( DEST );
  232.         chmod( 0755, "$destDir/$nickname/$utility" ) ||
  233.         die "Couldn't make $destDir/$nickname/$utility executable: $!\n";
  234.     }
  235.     }
  236.     ©File( "$configDir/mime.types",
  237.            "$destDir/$nickname/config/mime.types" ) unless $partialUpgrade;
  238.     &keyToDB( $magnus,
  239.           $partialUpgrade ? "$srcDir/$server/config" : $configDir,
  240.           "$destDir/$nickname/config" );
  241.     &moveInits( $magnus, "$destDir/$nickname/config/obj.conf", undef, 2,
  242.             "$srcDir/$server", "$srcDir",
  243.             "$destDir/$nickname", "$destDir",
  244.             '/logs/' );
  245.     if ( $partialUpgrade ) {
  246.     foreach $line ( @{$magnus->{'source'}} ) {
  247.         if ( $line =~ /^#Security was\s+(\w+)/i ) {
  248.         $magnus->set( 'Security', $1 );
  249.         last;
  250.         }
  251.     }
  252.     }
  253.     $magnus->set( 'Security', 'off' ) unless $magnus->value( 'Security' );
  254.     $magnus->set( 'SSL2', 'on' );
  255.     $magnus->set( 'SSL3', 'on' );
  256.     $magnus->set( 'Ciphers', '+rc4,+rc4export,+rc2,+rc2export,+des,+desede3' );
  257.     $magnus->set( 'SSL3Ciphers',
  258.           '+rsa_rc4_128_md5,+rsa_3des_sha,+rsa_des_sha,' .
  259.           '+rsa_rc4_40_md5,+rsa_rc2_40_md5,-rsa_null_md5' );
  260.     $magnus->set( 'MinThreads', $minThreads );
  261.     $magnus->set( 'MaxThreads', $maxThreads );
  262.     $magnus->set( 'MaxProcs', $maxProcs );
  263.     $magnus->set( 'ACLFile', "$destDir/httpacl/generated.$nickname.acl" );
  264.     $magnus->flush();
  265.     &updateACL( "$destDir/$nickname/config/obj.conf", $nickname );
  266.     &updateLogsAndIcons( "$destDir/$nickname/config/obj.conf",
  267.              "$destDir/ns-icons",
  268.              "$srcDir/$server", "$destDir/$nickname" );
  269. # Since the livewire configuration is changing, it will now be configured
  270. # after the installation/upgrade
  271. #    &addLiveWire( "$destDir/$nickname/config/obj.conf" );
  272. #
  273.     mkdir( "$destDir/admserv/$nickname", 0777 ) unless $partialUpgrade;
  274.     ©Config( "$destDir/$nickname/config", "$destDir/admserv/$nickname" );
  275.     print "\nUpgraded $server to $nickname\n\n";
  276. }
  277.  
  278. print "Copying user databases.  This could take a while if you have a big DB.\n";
  279. &updateDBs( "$destDir/authdb", "$disk.${slash}ndbmdump ", '|', keys( %dbs ) );
  280. &updateDBs( "$destDir/authdb", '', '', keys( %userFiles ) );
  281.  
  282. if ( scalar( @complaints ) ) {
  283.     open( LOG, '>upgrade.log' );
  284.     print "\nBe sure to read upgrade.log, which has suggestions about\n",
  285.     "how to get your new system to do the same things the old one did.\n";
  286.     print LOG "Some of these might have been fixed in later passes.\n\n";
  287.     print LOG @complaints;
  288.     close( LOG );
  289. }
  290.  
  291. END {
  292.     if ( $isNT ) {    # in a DOS box, so don't go away, yet
  293.     print "Press Enter ";
  294.     $junk = <STDIN>;
  295.     }
  296. }
  297.  
  298. # &moveInits( $magnus, 'to', 'bak', parameters for xlatePaths )
  299. # This function moves the init directives from the magnus object to the
  300. # head of the second file.  Make a backup with extension '.bak'
  301. sub moveInits {
  302.     my    $magnus = shift;
  303.     my    $dest = shift;
  304.     my    $destBackup = shift;
  305.     my    @newDest;
  306.  
  307.     open( DEST, $dest ) || die "Can't open $dest";
  308.  
  309.     #If the dest starts with a comment, keep it at the beginning
  310.     while ( <DEST> ) {
  311.     if ( m'^#' ) {
  312.         push( @newDest, $_ );
  313.     } else {
  314.         $savedDestLine = $_;
  315.         last;
  316.     }
  317.     }
  318.     push( @newDest, "\n" );
  319.     for ( $i = 0 ; $i < $magnus->numInits() ; ++$i ) {
  320.     push( @newDest, xlatePaths( 'Init ' . $magnus->getInit( $i ) . "\n",
  321.                     @_ ) );
  322.     }
  323.     push( @newDest, "\n" );
  324.     for ( $i = $magnus->numInits() ; $i-- ; ) {
  325.     $magnus->deleteInit( $i );
  326.     }
  327.     push( @newDest, $savedDestLine );
  328.     while ( <DEST> ) {
  329.     push( @newDest, $_ );
  330.     }
  331.     close( DEST ) ||
  332.     die "Couldn't close $dest";
  333.     &makeBackup( $dest, $destBackup ) || die "Can't backup $dest";
  334.     open( DEST, ">$dest" ) || die "Can't rewrite $dest";
  335.     foreach $line ( @newDest ) {
  336.     print DEST $line;
  337.     }
  338.     close( DEST );
  339. }
  340.  
  341. # &makeBackup( $file, 5 );
  342. # depending on the parameter, do one of three things: nothing( undef ),
  343. # make a rolling backup with a maximum of $flag backups( digit ),
  344. # or make a backup with .$flag as the suffix
  345. # NOTE: the original file gets renamed, so it's not there anymore.
  346. # returns the name of the backed up file if good,
  347. # otherwise undef and $@ has the error
  348. sub makeBackup
  349. {
  350.     my    $file = shift;
  351.     my    $flag = shift;
  352.     my    $previous;
  353.  
  354.     return $file unless $flag;
  355.     if ( $flag =~ /^\d+$/ ) {    # roll it
  356.     while ( $flag ) {
  357.         $previous = $flag - 1;
  358.         if ( $previous ) {
  359.         $previous = '.' . $previous;
  360.         } else {
  361.         $previous = '';
  362.         }
  363.         if ( -r "$file$previous" ) {
  364.         rename( "$file$previous", "$file.$flag" ) || return undef;
  365.         }
  366.         --$flag;
  367.     }
  368.     return "$file.1";
  369.     } else {            # extension
  370.     return "$file.$flag" if rename( $file, "$file.$flag" );
  371.     }
  372.     return undef;        # something wrong
  373. }
  374.  
  375. sub serverList {
  376.     my    $dir = shift;
  377.     my    @result;
  378.  
  379.     opendir( SERVERS, $dir ) || die "Can't open $dir";
  380.     @result = grep( /^http[sd]-[\d.]+$/, readdir( SERVERS ) );
  381.     closedir( SERVERS );
  382.     if ( scalar( @servers ) ) {
  383.     my    @serverList = @servers;
  384.  
  385.     @result = sort( @result );
  386.     @serverList = sort( @serverList );
  387.     if ( @result == @serverList ) {
  388.         my    $i;
  389.  
  390.         for ( $i = 0 ; $i <= $#result ; ++$i ) {
  391.         if ( $result[$i] !~ /$pathCS$serverList[$i]$/ ) {
  392.             warn "Passed server list does not match servers in $dir\n";
  393.             return ();
  394.         }
  395.         }
  396.         @result = @servers;
  397.     } else {
  398.         warn "Different number of servers in $dir than were passed in\n";
  399.         return ();
  400.     }
  401.     }
  402.     return @result;
  403. }
  404.  
  405. sub oldServerList {
  406.     my    $dir = shift;
  407.     my    @result;
  408.  
  409.     opendir( SERVERS, $dir ) || die "Can't open $dir";
  410.     @result = grep( /^start-http[sd]/, readdir( SERVERS ) );
  411.     @result = map { s/^start-//; $_; } @result;
  412.     closedir( SERVERS );
  413.     if ( scalar( @servers ) ) {
  414.     my    @serverList = @servers;
  415.  
  416.     @result = sort( @result );
  417.     @serverList = sort( @serverList );
  418.     if ( @result == @serverList ) {
  419.         my    $i;
  420.  
  421.         for ( $i = 0 ; $i <= $#result ; ++$i ) {
  422.         if ( $result[$i] ne $serverList[$i] ) {
  423.             warn "Passed server list does not match servers in $dir\n";
  424.             return ();
  425.         }
  426.         }
  427.         @result = @servers;
  428.     } else {
  429.         warn "Different number of servers in $dir than were passed in\n";
  430.         return ();
  431.     }
  432.     }
  433.     return @result;
  434. }
  435.  
  436. sub keyToDB {
  437.     my    $magnus = shift;
  438.     my    $srcPath = shift;
  439.     my    $destPath = shift;
  440.     my    $backupPolicy = shift;
  441.     my    $keyFile = $magnus->value( 'KeyFile' );
  442.     my    $certFile = $magnus->value( 'CertFile' );
  443.     my    $warnFailures = 0;
  444.  
  445.     if ( $keyFile ) {
  446.     my    $dbKey = $keyFile;
  447.  
  448.     $dbKey =~ s/\.der/.db/;
  449.     $magnus->set( 'KeyFile', $dbKey );
  450.     if ( scalar( @passwds ) ) {    # got me a password to feed in
  451.         open( KEY, "| .${slash}rkey11 $srcPath/$keyFile $destPath/$dbKey" ) ||
  452.         die "Can't run key conversion program: $!\n";
  453.         print KEY shift( @passwds ), "\n";    # pass it in
  454.         if ( ! close( KEY ) ) {    # probably wrong passwd
  455.         do {
  456.             die "Too many failures\n" if ++$warnFailures > 10;
  457.             warn "Key conversion failed: $!\n";
  458.             print "Please enter Key File password: " if $isNT;
  459.         } while ( system( "$disk.${slash}rkey11 $srcPath/$keyFile $destPath/$dbKey" ) );
  460.         }
  461.     } else {    # get the passwd from the user
  462.         print "Converting $srcPath/$keyFile\n";
  463.         print "Please enter Key File password: " if $isNT;
  464.         while ( system( "$disk.${slash}rkey11 $srcPath/$keyFile $destPath/$dbKey" ) ) {
  465.         die "Too many failures\n" if ++$warnFailures > 10;
  466.         warn "Key conversion failed: $!\n";
  467.         print "Please enter Key File password: " if $isNT;
  468.         }
  469.     }
  470.     }
  471.     if ( $certFile ) {
  472.     my    $choppedCert = $certFile;
  473.  
  474.     $choppedCert =~ s/\.der$//;
  475.     system( "$disk.${slash}rcert11 $srcPath/$certFile $destPath/$choppedCert" ) &&
  476.         die "Couldn't convert ServerCert $srcPath/$certFile\n";
  477.     $magnus->set( 'CertFile', $choppedCert );
  478.     }
  479. }
  480.  
  481. sub quote {
  482.     my    $name = shift;
  483.  
  484.     if ( $name =~ /[\s\"\'\.\\,]/ ) {    # needs quoting
  485.     $name =~ s/[\"\\]/\\$&/g;
  486.     $name = '"' . $name . '"';
  487.     }
  488.     return $name;
  489. }
  490.  
  491. # Assumptions: only one AuthTrans/object
  492. sub updateACL {
  493.     my    $obj = new ObjConf( shift );
  494.     my    $serverName = shift;
  495.     my    $backupPolicy = shift;
  496.     my    $objCount = 0;
  497.     my    $authDirective;
  498.     my    @pathChecks;
  499.     my    $requireAuth;
  500.     my    @denies;
  501.     my    @users;
  502.  
  503.     die $@ unless $obj;
  504.     open( NEWACL, ">$destDir/httpacl/generated.$serverName.acl" ) ||
  505.     die "Couldn't create $destDir/authdb/acl: $!\n";
  506.     foreach $type ( 'names', 'ppaths' ) {
  507.     foreach $object ( values( %{$obj->{$type}} ) ) {
  508.         undef( $authDirective );
  509.         undef( @pathChecks );
  510.         undef( @denies );
  511.         undef( @users );
  512.  
  513.         ++$objCount;
  514.         # collect relevant pathchecks and denies
  515.         foreach $directive ( @{$object->{'directives'}} ) {
  516.         if ( $directive->{'type'} =~ /^pathcheck$/i ) {
  517.             if ( $directive->{'name'} eq 'require-auth' ) {
  518.             if ( $directive->{'params'}->{'auth-type'} eq 'basic' ) {
  519.                 push( @pathChecks, $directive );
  520.             }
  521.             } elsif ( $directive->{'name'} eq 'deny-existence' ) {
  522.             push( @denies, $directive );
  523.             }
  524.         } elsif ( $directive->{'type'} =~ /^AuthTrans$/i ) {
  525.             $authDirective = $directive;
  526.         }
  527.         }
  528.         next unless ( scalar( @denies ) || scalar( @pathChecks ) );
  529.         # process them
  530.         print NEWACL "ACL ${serverName}_formgen-READ-ACL_deny-$objCount ",
  531.                " (GET, HEAD, POST, INDEX) {\n",
  532.         "\tDefault deny anyone;\n";
  533.         if ( $authDirective && scalar( @pathChecks ) ) {
  534.         # the server will be taking names
  535.         my    @pathElements;
  536.         my    $users;
  537.         my    @users;
  538.         my    $dbm;
  539.         my    $closedAuth = 0;
  540.  
  541.         # get database name
  542.         if ( defined( $authDirective->{'params'}->{'dbm'} ) ) {
  543.             $dbm = $authDirective->{'params'}->{'dbm'};
  544.             $dbs{$dbm} = 1;
  545.         } elsif ( defined( $authDirective->{'params'}->{'userfile'} ) ) {
  546.             $dbm = $authDirective->{'params'}->{'userfile'};
  547.             $userFiles{$dbm} = 1;
  548.         } else {
  549.             die "Can't understand why there's no dbm or userfile\n";
  550.         }
  551.         @pathElements = split( m'/', $dbm );
  552.         $dbm = "$destDir/authdb/" . pop( @pathElements );
  553.         $dbm =~ s/\.pwf$//;    # trim .pwf extension
  554.         if ( scalar( @denies ) ) {
  555.             $obj->removeDirective( $object, $authDirective );
  556.         } else {
  557.             $obj->{'source'}->[$authDirective->{'sourceIndex'}] =
  558.             'PathCheck fn="check-acl" acl="' .
  559.                 "${serverName}_formgen-READ-ACL_deny-$objCount\"\n" .
  560.                 'PathCheck fn="check-acl" acl="' .
  561.                     "${serverName}_formgen-WRITE-ACL_deny-$objCount\"\n";
  562.         }
  563.         print NEWACL "\tDefault authenticate in {\n";
  564.         print NEWACL "\t\tDatabase \"$dbm\";\n";
  565.         print NEWACL "\t\tMethod basic;\n";
  566.         foreach $requireAuth ( @pathChecks ) {
  567.             unless ( $closedAuth ) {
  568.             if ( $requireAuth->{'params'}->{'realm'} ) {
  569.                 print NEWACL "\t\tPrompt \"$requireAuth->{'params'}->{'realm'}\";\n";
  570.             }
  571.             print NEWACL "\t};\n";
  572.             $closedAuth = 1;
  573.             }
  574.             $users = $requireAuth->{'params'}->{'auth-user'};
  575.             $users = 'all' unless $users;
  576.             if ( $users =~ /^\(/ ) {    # multiple
  577.             my    $user;
  578.  
  579.             chop( $users = $' );
  580.             foreach $user ( split( /\|/, $users ) ) {
  581.                 push( @users, "e( $user ) );
  582.             }
  583.             } else {
  584.             @users[0] = "e( $users );
  585.             }
  586.             $obj->removeDirective( $object, $requireAuth );
  587.         }
  588.         # the ACL
  589.         print NEWACL &doACL( $serverName, $objCount, $obj,
  590.                      \@denies, @users );
  591.         } else {    # just checking hosts
  592.         print NEWACL &doACL( $serverName, $objCount, $obj,
  593.                      \@denies, 'anyone' );
  594.         }
  595.         print NEWACL "}\n\n";
  596.         print NEWACL "ACL ${serverName}_formgen-WRITE-ACL_deny-$objCount ",
  597.                " (PUT, DELETE, MKDIR, RMDIR, MOVE) {\n",
  598.         "\tDefault deny anyone;\n",
  599.             "}\n\n";
  600.     }
  601.     }
  602.     close( NEWACL );
  603.     $obj->write( $backupPolicy );
  604.     return ( %dbs );
  605. }
  606.  
  607. # do a phrase or phrases depending on the deny-existence list
  608. sub doACL {
  609.     my    $serverName = shift;
  610.     my    $objCount = shift;
  611.     my    $obj = shift;
  612.     my    $denies = shift;    # reference to list
  613.     my    @users = @_;
  614.     my    $users;
  615.     my    @denyHosts = ();
  616.     my    @allowHosts = ();
  617.     my    $deny;
  618.     my    $client;
  619.     my    $param;
  620.     my    $otherParams = undef;
  621.  
  622.     if ( scalar( @users ) > 1 ) {
  623.     $users = '(' . join( ', ', @users ) . ')';
  624.     } else {
  625.     if ( scalar( @users ) == 0 || $users[0] eq '*' ) {
  626.         $users = 'all';
  627.     } else {
  628.         $users = $users[0];
  629.     }
  630.     }
  631.     foreach $deny ( @$denies ) {
  632.     $client = $deny->{'client'};
  633.     $client = '*' unless $client;
  634.     foreach $client ( split( /\s+/, $client ) ) {
  635.         $client =~ s/^(dns|ip)\s*=\s*"?//i;    # kill type info and quote
  636.         $client =~ s/"$//;            # kill quote
  637.         if ( $client =~ /^\*~/ ) {
  638.         $client = &expandRE( $' );
  639.         $client =~ s/^\(//;
  640.         $client =~ s/\)$//;
  641.         push( @allowHosts, split( /\|/, $client ) );
  642.         } else {
  643.         push( @denyHosts, split( /\|/, &expandRE( $client ) ) );
  644.         }
  645.     }
  646.     # rewrite directive
  647.     if ( ! defined( $otherParams ) ) {    # first deny
  648.         $otherParams = '';
  649.         foreach $param ( keys %{$deny->{'params'}} ) {
  650.         $otherParams .= ' ' . $param . '="' .
  651.             $deny->{'params'}->{$param} . '"';
  652.         }
  653.         $obj->{'source'}->[$deny->{'sourceIndex'}] =
  654.         'PathCheck fn="check-acl" acl="' .
  655.             "${serverName}_formgen-READ-ACL_deny-$objCount\"$otherParams\n" .
  656.             'PathCheck fn="check-acl" acl="' .
  657.                 "${serverName}_formgen-WRITE-ACL_deny-$objCount\"\n";
  658.     } else {
  659.         # delete the deny
  660.         $obj->{'deletedSource'}->{$deny->{'sourceIndex'}} = 1;
  661.         # QQQQ look into verifying otherParams
  662.     }
  663.     next unless $deny->{'client'};
  664.     # look for surrounding client and remove
  665.     for ( $i = $deny->{'sourceIndex'} ; $i > -1 ; --$i ) {
  666.         if ( $obj->{'source'}->[$i] =~ /^<\s*client/i ) {
  667.         $obj->{'deletedSource'}->{$i} = 1;
  668.         last;
  669.         }
  670.     }
  671.     for ( $i = $deny->{'sourceIndex'} ;
  672.           $i < scalar( @{$obj->{'source'}} ) ; ++$i ) {
  673.         if ( $obj->{'source'}->[$i] =~ /^<\s*\/client/i ) {
  674.         $obj->{'deletedSource'}->{$i} = 1;
  675.         last;
  676.         }
  677.     }
  678.     }
  679.     # return the acl for these denies
  680.     $result = '';
  681.     $result .= "\tDefault allow $users at (" .
  682.     join( ',', @allowHosts ) . ");\n" if scalar( @allowHosts );
  683.     $result .= "\tDefault deny $users at (" .
  684.     join( ',', @denyHosts ) . ");\n" if scalar( @denyHosts );
  685.     $result = "\tDefault allow $users;\n" unless scalar( @allowHosts ) ||
  686.                         scalar( @denyHosts );
  687.     return $result;
  688. }
  689.  
  690. sub expandRE {
  691.     my    $in = shift;
  692.  
  693.     if ( $in =~ m'\(([^)]+)\)(.)' ) {    # expand RE
  694.     my    $pre = $`;
  695.     my    $post = $2 . $';
  696.     my    $expand = $1;
  697.  
  698.     $expand =~ s/(\||$)/$post$1/g;
  699.     $in = "($expand)";
  700.     }
  701.     return $in;
  702. }
  703.  
  704. sub updateLogsAndIcons {
  705.     my    $obj = new ObjConf( shift );
  706.     my    $iconDir = shift;
  707.     my    $srcPath = shift;
  708.     my    $destPath = shift;
  709.     my    $backupPolicy = shift;
  710.     my    $directive;
  711.     my    $object;
  712.     my    $log;
  713.     my    %logs;
  714.     my    @newInits;
  715.  
  716.     foreach $object ( @{$obj->{'objects'}} ) {
  717.     foreach $directive ( @{$object->{'directives'}} ) {
  718.         if ( $object->{'type'} eq 'name' &&
  719.          $directive->{'type'} =~ /^NameTrans$/i &&
  720.          $directive->{'name'} eq 'pfx2dir' &&
  721.          $directive->{'params'}->{'from'} eq '/mc-icons' ) {
  722.         # found the mc-icons translation
  723.         $obj->{'source'}->[$directive->{'sourceIndex'}] =
  724.             'NameTrans fn="pfx2dir" from="/mc-icons" dir="' .
  725.             $iconDir . "\"\n" .
  726.                 'NameTrans fn="pfx2dir" from="/ns-icons" dir="' .
  727.                 $iconDir . "\"\n";
  728.         # Kludge alert.  The data structure no longer matches the
  729.         # source, but since the rest of this function doesn't care
  730.         # about NameTrans, that's OK.
  731.         }
  732.         if ( $object->{'type'} eq 'name' &&
  733.          $directive->{'type'} =~ /^NameTrans$/i &&
  734.          $directive->{'name'} eq 'pfx2dir' &&
  735.          $directive->{'params'}->{'from'} eq '/ns-icons' ) {
  736.         # found chris's ns-icons translation, so I'll delete it,
  737.         # since the above kludge should be doing it
  738.         $obj->removeDirective( $object, $directive );
  739.         next;    # directive is gone, stop looking at it
  740.         }
  741.         if ( $directive->{'type'} =~ /^addlog$/i &&
  742.          $directive->{'name'} eq 'common-log' ) {
  743.         $obj->{'source'}->[$directive->{'sourceIndex'}] =~
  744.             s/\bcommon-log\b/flex-log/i;
  745.         if ( $directive->{'params'}->{'name'} ) {
  746.             $logs{$directive->{'params'}->{'name'}} = $directive;
  747.         } else {
  748.             $logs{'global'} = $directive;
  749.         }
  750.         }
  751.         if ( $directive->{'type'} =~ /^addlog$/i &&
  752.          $directive->{'name'} eq 'record-keysize' ) {
  753.         # obsolete directive
  754.         $obj->removeDirective( $object, $directive );
  755.         next;    # directive is gone, stop looking at it
  756.         }
  757.     }
  758.     }
  759.     foreach $directive ( @{$obj->{'directives'}} ) {
  760.     if ( $directive->{'type'} =~ /^init$/i &&
  761.          $directive->{'name'} eq 'init-clf' ) {    # Log
  762.         foreach $log ( keys( %{$directive->{'params'}} ) ) {
  763.         # translate the paths to the new directory
  764.         $directive->{'params'}->{$log} =~ s/$pathCS$srcPath/$destPath/;
  765.         }
  766.         foreach $log ( keys( %logs ) ) {
  767.         if ( $directive->{'params'}->{$log} ) {
  768.  
  769.             push( @newInits, 'Init fn="flex-init" ' . $log . '="' .
  770.               $directive->{'params'}->{$log} . '" format.' .
  771.               $log . '="' .
  772.               '%Ses->client.ip% - %Req->vars.auth-user% ' .
  773.               '[%SYSDATE%] \"%Req->reqpb.clf-request%\" ' .
  774.               '%Req->srvhdrs.clf-status% ' .
  775.               '%Req->srvhdrs.content-length%"' );
  776.             delete $directive->{'params'}->{$log};
  777.         } else {
  778.             die "Mention of $log in the AddLogs, but not init-clf\n";
  779.         }
  780.         }
  781.         # remove logs that are now flex-logs
  782.         if ( scalar( %{$directive->{'params'}} ) ) {
  783.         $obj->{'source'}->[$directive->{'sourceIndex'}] =
  784.             'Init fn="init-clf"';
  785.         foreach $log ( keys( %{$directive->{'params'}} ) ) {
  786.             $obj->{'source'}->[$directive->{'sourceIndex'}] .=
  787.             ' ' . $log . '="' . $directive->{'params'}->{$log} .
  788.                 '"';
  789.         }
  790.         $obj->{'source'}->[$directive->{'sourceIndex'}] .= "\n";
  791.         } else {    # no logs left
  792.         $obj->{'source'}->[$directive->{'sourceIndex'}] = '';
  793.         }
  794.         # put new flex-inits in, tagged onto the init-clf.
  795.         # This messes up the structure, so just write the obj.conf out
  796.         foreach $log ( @newInits ) {
  797.         $obj->{'source'}->[$directive->{'sourceIndex'}] .= $log . "\n";
  798.         }
  799.         last;
  800.     }
  801.     }
  802.     $obj->write();
  803. }
  804.  
  805. # comment out home page specifier, and warn, if one was specified
  806. sub hideHomePage {
  807.     my    $obj = new ObjConf( shift );
  808.     my    $default = $obj->{'names'}->{'default'};
  809.     my    $directive;
  810.     my    $foundOne = 0;
  811.  
  812.     foreach $directive ( @{$default->{'directives'}} ) {
  813.     if ( $directive->{'type'} =~ /^NameTrans$/i &&
  814.          $directive->{'name'} eq 'home-page' ) {    # found a home page
  815.         warn "Commenting out home page specification, look in $obj->{'file'}\n";
  816.         $obj->{'source'}->[$directive->{'sourceIndex'}] = '# ' .
  817.         $obj->{'source'}->[$directive->{'sourceIndex'}];
  818.         $foundOne = 1;
  819.         last;
  820.     }
  821.     }
  822.     $obj->write() if $foundOne;
  823. }
  824.  
  825. # Add the necessary directives to enable LiveWire
  826. sub addLiveWire {
  827.     my    $obj = new ObjConf( shift );
  828.     my    $default = $obj->{'names'}->{'default'};
  829.     my    $directive;
  830.     my    $foundIt = 0;
  831.  
  832.     # Not quite the right way to go about this, but until ObjConf.pm gets
  833.     # better, the way I will do it.
  834.     foreach $directive ( @{$default->{'directives'}} ) {
  835.     if ( $directive->{'type'} =~ /^nametrans$/i && 
  836.          $directive->{'name'} eq 'livewireNameTrans' ) {
  837.         $foundIt = 1;
  838.         last;
  839.     }
  840.     }
  841.     if ( ! $foundIt ) {    # piggyback the directive onto the last directive
  842.     $obj->{'source'}->[$default->{'sourceIndex'}] .=
  843.         "NameTrans fn=livewireNameTrans name=LiveWire\n";
  844.     push( @{$obj->{'source'}},
  845.           "\n<Object name=LiveWire>\nService fn=livewireService\n</Object>\n" );
  846.     }
  847.     $obj->write();
  848. }
  849.  
  850. sub updateDBs {
  851.     my    $destDir = shift;
  852.     my    $commandPrefix = shift;
  853.     my    $commandSuffix = shift;
  854.     my    @dbs = @_;
  855.     my    $dbName;
  856.     my    @elements;
  857.  
  858.     foreach $db ( @dbs ) {
  859.     @elements = split( m@/@, $db );
  860.     $dbName = pop( @elements );
  861.     $dbName =~ s/\.pwf$//;    # trim .pwf extension
  862.     &toDB( $destDir, $dbName, "$commandPrefix$db$commandSuffix" );
  863.     }
  864. }
  865.  
  866. # read the passwd db or file and make a user from it
  867. sub toDB {
  868.     my    $dir = shift;
  869.     my    $name = shift;
  870.     my    $openString = shift;
  871.     my    $command;
  872.  
  873.     open( PW, $openString ) || die "Couldn't read $openString: $!\n";
  874.     while ( <PW> ) {
  875.     chomp;
  876.     ( $user, $pw ) = split( /:/, $_ );
  877.     $user =~ s/([\s\(\)\?\*&'"])/\\$1/g;    # ']);
  878.     $pw =~ s/([\s\(\)\?\*&'"])/\\$1/g;    # ']);
  879.     $command = $isNT ? ".\\mkuser -p $pw $user $dir/$name |" :
  880.         "./mkuser -p $pw $user $dir/$name 2>&1 |";
  881.     open( MKUSER, $command ) ||
  882.         die "Couldn't start ./mkuser: $!\n";
  883.     while ( <MKUSER> ) {
  884.         if ( $_ !~ /success/i ) {
  885.         print;
  886.         }
  887.     }
  888.     close( MKUSER );
  889.     }
  890.     close( PW );
  891. }
  892.  
  893. sub copyFile {
  894.     my    $src = shift;
  895.     my    $dest = shift;
  896.  
  897.     open( SOURCE, $src ) || die "Can't read $src: $!\n";
  898.     open( DEST, ">$dest" ) || die "Can't write to $dest: $!\n";
  899.     while ( <SOURCE> ) {
  900.     print DEST;
  901.     }
  902.     close( SOURCE );
  903.     close( DEST );
  904. }
  905.  
  906. sub copyConfig {
  907.     my    $srcDir = shift;
  908.     my    $destDir = shift;
  909.     my    $file;
  910.  
  911.     opendir( SRCDIR, $srcDir ) || die "Can't read $srcDir: $!\n";
  912.     while ( $file = readdir( SRCDIR ) ) {
  913.     next if $file =~ /^\.\.?$/;    # skip . and ..
  914.     next if -d "$srcDir/$file";    # Don't recurse
  915.     ©File( "$srcDir/$file", "$destDir/$file" );
  916.     }
  917. }
  918.     
  919. # Do a file copy, but convert path names as the file gets copied
  920. # Don't convert paths that don't point anywere, except for log files
  921. # push non-converted paths to the results list
  922. # If you are xlating paths that contain one another, the long paths must cone
  923. # first
  924. sub xlatePath {
  925.     my    $src = shift;
  926.     $dest = shift;
  927.  
  928.     open( SRC, $src ) || die "Can't open $src: $!\n";
  929.     open( DEST, ">$dest" ) || die "Can't open $dest: $!\n";
  930.     while ( <SRC> ) {
  931.     print DEST &xlatePaths( $_, @_ );
  932.     }
  933.     close( SRC );
  934.     close( DEST );
  935.  
  936.     return @results;
  937. }
  938.  
  939. # translate paths in the string
  940. sub xlatePaths {
  941.     my    $line = shift;
  942.     my    @otherParams = @_;
  943.     my    $numXs = shift;
  944.     my    @srcPaths = splice( @_, 0, $numXs );
  945.     my    @destPaths = splice( @_, 0, $numXs );
  946.     my    @allowedEmpty = @_;
  947.     my    @pathLengths = map { length( $_ ) } @srcPaths;
  948.     my    $i;
  949.     my    $pre;
  950.     my    $post;
  951.     my    $allowed;
  952.     my    $path;
  953.     my    $destPath;
  954.  
  955.     grep { s/$slashPattern/$slashPattern/g } @srcPaths if $isNT;
  956.     for ( $i = 0 ; $i < $numXs ; ++$i ) {
  957.     if ( $line =~ /$pathCS$srcPaths[$i]/ ) {
  958.         $pre = $`;
  959.         $post = $';
  960.         foreach $allowed ( @allowedEmpty ) {
  961.         if ( substr( $post, 0, length( $allowed ) ) eq $allowed ) {
  962.             return &xlatePaths( $pre, @otherParams ) .
  963.                 $destPaths[$i] . $allowed .
  964.                 &xlatePaths( substr( $post, length($allowed) ),
  965.                          @otherParams );
  966.         }
  967.         }
  968.         $path = $& . $post;
  969.         $path =~ s/["'`\s>\*].*//s;    # to " or space ]
  970.         ( $destPath = $path ) =~ s/$pathCS$srcPaths[$i]/$destPaths[$i]/;
  971.         if ( -e $destPath ) {
  972.         return &xlatePaths( $pre, @otherParams ) .
  973.             $destPaths[$i] . substr( $post, 0, length( $path ) -
  974.                          $pathLengths[$i] ) .
  975.                 &xlatePaths( substr( $post, length( $path ) -
  976.                          $pathLengths[$i] ),
  977.                      @otherParams );
  978.         } else {
  979.         $complaint = "Not rewriting $path, which is in your old server.\nI suggest you look into copying it over, and fixing $dest.\n\n";
  980.         push( @results, $complaint ) unless $results[$#results] eq
  981.                             $complaint;
  982.         }
  983.     }
  984.     }
  985.     return $line;
  986. }
  987.  
  988. sub parseParams {
  989.     $param = shift( @ARGV );
  990.     $partialUpgrade = 0;
  991.     while ( defined( $param ) ) {
  992.     if ( $param eq '-s' ) {        # old directory
  993.         $srcDir = shift( @ARGV );
  994.     } elsif ( $param eq '-n' ) {    # names of new servers
  995.         @nicknames = &getArgList();
  996.     } elsif ( $param eq '-p' ) {    # ports of old servers
  997.         @servers = &getArgList();
  998.     } elsif ( $param eq '-w' ) {    # passwds for ServerKeys
  999.         @passwds = &getArgList();
  1000.     } elsif ( $param eq '-o' ) {
  1001.         $partialUpgrade = 1;
  1002.     }
  1003.     $param = shift( @ARGV );
  1004.     }
  1005. }
  1006.  
  1007. sub getArgList {
  1008.     my    @result = ();
  1009.  
  1010.     while ( defined( $ARGV[0] ) && $ARGV[0] !~ /^-/ ) {
  1011.     push( @result, shift( @ARGV ) );
  1012.     }
  1013.     return @result;
  1014. }
  1015.  
  1016. sub findConfig {
  1017.     my    $dir = shift;
  1018.     my    $server = shift;
  1019.     my    $oldServer = shift;
  1020.     my    $start;
  1021.     my    $configDir;
  1022.  
  1023.     if ( $oldServer ) {
  1024.     if ( -f "$dir/start-$server" ) {
  1025.         $start = "start-$server";
  1026.     } else {
  1027.         die "Can't comprehend configuration for $dir/$server\n";
  1028.     }
  1029.     } else {    # 1.12 server
  1030.     if ( -f "$dir/$server/start" ) {
  1031.         $start = "$server/start";
  1032.     } elsif ( -f "$dir/$server/start-httpd" ) {
  1033.         $start = "$server/start-httpd";
  1034.     } else {    # not sure
  1035.         opendir( DIR, "$dir/$server" ) ||
  1036.         die "Can't read $dir/$server: $!\n";
  1037.         while ( $start = readdir( DIR ) ) {
  1038.         last if $start =~ /start/;    # start somewhere in the name
  1039.         }
  1040.         closedir( DIR );
  1041.         if ( $start ) {
  1042.         $start = "$server/$start";
  1043.         } else {
  1044.         die "Couldn't find a startup script for $dir/$server\n";
  1045.         }
  1046.     }
  1047.     }
  1048.     open( START, "$dir/$start" ) || die "Can't read $dir/$start: $!\n";
  1049.     while ( <START> ) {
  1050.     if ( /-d\s*([^\s]*)/ ) {
  1051.         $configDir = $1;
  1052.         last;
  1053.     }
  1054.     }
  1055.     close( START );
  1056.     return $configDir;
  1057. }
  1058.