#!./perl

# This script upgrades a 1.1 Commerce or Communications server to 2.0
# It copies the configuration information from a 1.1 server to the 2.0
# server's area.
#
# It must be run from the install subdirectory of the 2.0 installation
#
# Usage: $0 [-s 1.1Root] [-p list of 1.1 servers space separated]
#    [-n list 2.0 servers space separated.  1.1 will become corresponding 2.0]
#    [-w passwds for 1.1 servers that had key files in the magnus.conf] [-o]
#
# -o tells the script that a partial install has already happened, and an
#    obj.conf already exists in the 2.0 tree
#
# $Id: upgrade,v 1.7.2.14.2.22 1996/07/13 00:37:00 flc Exp $
#
# Copyright 1996, Netscape Communications Corporation

use Magnus;
use ObjConf;

$isNT = -d '\\';	# This will work unless someone created a directory
			# call \ in the install directory.  Very unlikely
$slash = $isNT ? '\\' : '/';
$slashPattern = $isNT ? '[\\\\/]' : '/';
$pathCS = $isNT ? '(?i)' : '';	# if NT, make substitution case insensitive

$| = 1;

&parseParams;

umask( 022 );

until ( -d $srcDir ) {
    if ( ! $srcDir ) {
	if ( $isNT ) {
	    $srcDir = 'C:\Netscape\Server';
	} else {
	    $srcDir = '/usr/ns-home';
	}
    }
    print "Please enter the root path of the old server installation: [$srcDir] ";
    $srcDir = $newDir if ( $newDir = <> ) !~ /^\s*$/;
    chomp( $srcDir );
}
chop( $srcDir ) if $srcDir =~ /${slashPattern}$/;

if ( $isNT ) {
    $ENV{'PROMPT'} = '$P$G';
    chdir( '..' ) || die "Can't cd ..: $!\n";
    $destDir = `cd`;
    ( $disk ) = $destDir =~ /^(\w+:)/;
    chdir( 'install' ) || die "Can't cd install: $!\n";
} else {
    $destDir = `cd .. ; pwd`;
    $disk = '';
}
chomp( $destDir );
until ( -d $destDir ) {
    $destDir = '/usr/ns-home' unless $destDir;
    print "Please enter the root path of the new server installation: [$destDir] ";
    $destDir = $newDir if ( $newDir = <> ) !~ /^\s*$/;
    chomp( $destDir );
}
chop( $destDir ) if $destDir =~ /${slashPattern}$/;
$destDir =~ s@$slashPattern@/@g if $isNT;	# standardize on /

# Figure out what kind of server we're installing
if ( -d "$destDir/bin/https" ) {	# Enterprise
    $serverType = 'https';
    $serverDesc = "Netscape Enterprise Server";
} elsif ( -d "$destDir/bin/httpd" ) {	# Fast Track
    $serverType = 'httpd';
    $serverDesc = "Netscape FastTrack Server";
} else {
    die "Can't figure out what kind of server to which you're upgrading";
}

$oldServer = 0;

# Get the server list.  Do some checking if it's Unix
if ( $isNT ) {
    @servers = &serverList( $srcDir );
} else {
    if ( -d "$srcDir/admserv" ) {
	$adminConf = new Magnus( "$srcDir/admserv/ns-admin.conf" );
	die "Couldn't read $srcDir/admserv/ns-admin.conf: $@\n" unless $adminConf;
	if ( $adminConf->value( 'NetsiteRoot' ) ne $srcDir ) {
	    my	$dev1;
	    my	$dev2;
	    my	$inode1;
	    my	$inode2;

	    ( $dev1, $inode1 ) = stat( $srcDir );
	    ( $dev2, $inode2 ) = stat( $adminConf->value( 'NetsiteRoot' ) );
	    if ( $dev1 != $dev2 or $inode1 != $inode2 ) {
		die "Confused because $srcDir has a $srcDir/admserver/ns-admin.conf
whose NetsiteRoot points to a different directory than $srcDir.\n";
	    }
	    $srcDir = $adminConf->value( 'NetsiteRoot' );
	}
	( $login, $pass, $uid, $gid ) = getpwnam( $adminConf->value( 'User' ) ) or
	    die $adminConf->value( 'User' ) . " not in passwd file\n";
	die 'Not running as ' . $adminConf->value( 'User' ) . "\n"
	    unless $> == $uid;
	@servers = &serverList( $srcDir );
	die "No servers to upgrade\n" unless scalar( @servers );
    } elsif ( -x "$srcDir/ns-httpd" ) {	# ancient system
	@servers = &oldServerList( $srcDir );
	$oldServer = 1;
    } else {
	die "$srcDir doesn't look like any Netscape installation I know about\n";
    }
}
open( SERVERS, "$destDir/admserv/servers.lst" );    # just in case it exists
while ( <SERVERS> ) {
    push( @serverList, $_ );
    ( $type, $desc ) = split( /:/, $_ );
    last if $type eq $serverType;
}
close( SERVERS );
if ( $type ne $serverType ) {	# didn't find our type
    open( SERVERS, ">>$destDir/admserv/servers.lst" ) ||
	die "Can't create $destDir/admserv/servers.lst: $!\n";
    print SERVERS "$serverType:$serverDesc\n";
    close( SERVERS );
}

$minThreads = 4;
$maxThreads = 32;
$maxProcs = 4;
require 'threads.pl' if -f 'threads.pl';

unless ( -d "$destDir/authdb" ) {
    mkdir( "$destDir/authdb", 0777 ) ||
	die "Couldn't create $destDir/authdb: $!\n";
}
unless ( -d "$destDir/httpacl" ) {
    mkdir( "$destDir/httpacl", 0777 ) ||
	die "Couldn't create $destDir/httpacl: $!\n";
}

@complaints = ();
%dbs = ();
foreach $server ( @servers ) {
    $nickname = shift @nicknames;
    while ( ! $nickname ) {
	print "Instead of being known by port number, your servers will be known\n";
	print "by nickname.  The nickname may only have letters, digits, '-'s and '_'s.\n";
	print "I will add the $serverType-, so you don't have to.\n";
	print "Choose a nickname for the $server server: ";
	chomp( $nickname = <STDIN> );
	if ( $nickname !~ /^[\w\-.]+$/ or $nickname =~ /^http[sd]-/ ) {
	    print "\nThat name has unwanted characters in it.\n";
	    redo;
	}
	$nickname = $serverType . '-' . $nickname;
    }
    print "Upgrading $server to $nickname...\n";
    unless ( $partialUpgrade ) {
	mkdir( "$destDir/$nickname", 0777 ) ||
	    die "Can't mkdir $destDir/$nickname: $!\n";
	mkdir( "$destDir/$nickname/config", 0777 ) ||
	    die "Can't mkdir $destDir/$nickname/config: $!\n";
	mkdir( "$destDir/$nickname/logs", 0777 ) ||
	    die "Can't mkdir $destDir/$nickname/config: $!\n";
    }
    if ( $isNT ) {
	$configDir = "$destDir/$nickname/config";
    } else {
	$configDir = &findConfig( $srcDir, $server, $oldServer );
    }
    die "Couldn't find a config directory for $srcDir/$server\n"
	unless $configDir;
    $magnus = new Magnus( "$configDir/magnus.conf" );
    die "Couldn't find magnus.conf in $configDir" unless $magnus;
    if ( $magnus->{'source'}->[0] =~ /^#ServerRoot/i ) {
	$magnus->{'source'}->[0] = "#ServerRoot $destDir/$nickname\n";
    }
    if ( $partialUpgrade ) {	# obj.conf in 2.0 tree
	&copyFile( "$destDir/$nickname/config/obj.conf",
		   "$destDir/$nickname/config/chris.conf" );
	$objSrc = "$destDir/$nickname/config/chris.conf";
    } else {
	( $login, $pass, $uid, $gid ) = getpwnam( $magnus->value( 'User' ) ) or
	    die "$user not in passwd file";
	chown( $uid, $gid, "$destDir/$nickname/logs" ) ||
	    warn "Couldn't make $destDir/$nickname/logs owned by " .
		$magnus->value( 'User' ) . "\n";
	$objSrc = $configDir . '/' . $magnus->value( 'LoadObjects' );
	die "Misleading $configDir/magnus.conf, couldn't find obj.conf\n"
	    unless -f $objSrc;
	# trick the magnus object into writing the results out to the new dir
	$magnus->{'file'} = "$destDir/$nickname/config/magnus.conf";
    }
    # Standardize
    $magnus->set( 'ErrorLog', "$destDir/$nickname/logs/errors" );
    $magnus->set( 'PidLog', "$destDir/$nickname/logs/pid" );
    @complaints = ( @complaints, 
		    &xlatePath( $objSrc,
			        "$destDir/$nickname/config/obj.conf",
			        2,
			        "$srcDir/$server", "$srcDir",
			        "$destDir/$nickname", "$destDir",
			        '/logs/' ) );
    unless ( $isNT ) {
	foreach $utility ( 'stop', 'start', 'restart',
			   "../bin/$serverType/install/misc/rotate" ) {
	    open( SRC, $utility ) || die "Can't open prototype $utility: $!\n";
	    $utility =~ s@.*/@@;	# trim path info
	    open( DEST, ">$destDir/$nickname/$utility" ) ||
		die "Can't create $destDir/$nickname/$utility: $!\n";
	    while ( <SRC> ) {
		if ( /%(ROOT|SERVER|STYPE)%/ ) {
		    print DEST $`;
		    if ( $1 eq 'ROOT' ) {
			print DEST $destDir;
		    } elsif ( $1 eq 'SERVER' ) {
			print DEST "$destDir/$nickname";
		    } elsif ( $1 eq 'STYPE' ) {
			print DEST $serverType;
		    }
		    $_ = $';
		    redo;	# see if there are more %%s in the file
		} else {
		    print DEST;
		}
	    }
	    close( SRC );
	    close( DEST );
	    chmod( 0755, "$destDir/$nickname/$utility" ) ||
		die "Couldn't make $destDir/$nickname/$utility executable: $!\n";
	}
    }
    &copyFile( "$configDir/mime.types",
	       "$destDir/$nickname/config/mime.types" ) unless $partialUpgrade;
    &keyToDB( $magnus,
	      $partialUpgrade ? "$srcDir/$server/config" : $configDir,
	      "$destDir/$nickname/config" );
    &moveInits( $magnus, "$destDir/$nickname/config/obj.conf", undef, 2,
	        "$srcDir/$server", "$srcDir",
	        "$destDir/$nickname", "$destDir",
	        '/logs/' );
    if ( $partialUpgrade ) {
	foreach $line ( @{$magnus->{'source'}} ) {
	    if ( $line =~ /^#Security was\s+(\w+)/i ) {
		$magnus->set( 'Security', $1 );
		last;
	    }
	}
    }
    $magnus->set( 'Security', 'off' ) unless $magnus->value( 'Security' );
    $magnus->set( 'SSL2', 'on' );
    $magnus->set( 'SSL3', 'on' );
    $magnus->set( 'Ciphers', '+rc4,+rc4export,+rc2,+rc2export,+des,+desede3' );
    $magnus->set( 'SSL3Ciphers',
		  '+rsa_rc4_128_md5,+rsa_3des_sha,+rsa_des_sha,' .
		  '+rsa_rc4_40_md5,+rsa_rc2_40_md5,-rsa_null_md5' );
    $magnus->set( 'MinThreads', $minThreads );
    $magnus->set( 'MaxThreads', $maxThreads );
    $magnus->set( 'MaxProcs', $maxProcs );
    $magnus->set( 'ACLFile', "$destDir/httpacl/generated.$nickname.acl" );
    $magnus->flush();
    &updateACL( "$destDir/$nickname/config/obj.conf", $nickname );
    &updateLogsAndIcons( "$destDir/$nickname/config/obj.conf",
			 "$destDir/ns-icons",
			 "$srcDir/$server", "$destDir/$nickname" );
# Since the livewire configuration is changing, it will now be configured
# after the installation/upgrade
#    &addLiveWire( "$destDir/$nickname/config/obj.conf" );
#
    mkdir( "$destDir/admserv/$nickname", 0777 ) unless $partialUpgrade;
    &copyConfig( "$destDir/$nickname/config", "$destDir/admserv/$nickname" );
    print "\nUpgraded $server to $nickname\n\n";
}

print "Copying user databases.  This could take a while if you have a big DB.\n";
&updateDBs( "$destDir/authdb", "$disk.${slash}ndbmdump ", '|', keys( %dbs ) );
&updateDBs( "$destDir/authdb", '', '', keys( %userFiles ) );

if ( scalar( @complaints ) ) {
    open( LOG, '>upgrade.log' );
    print "\nBe sure to read upgrade.log, which has suggestions about\n",
    "how to get your new system to do the same things the old one did.\n";
    print LOG "Some of these might have been fixed in later passes.\n\n";
    print LOG @complaints;
    close( LOG );
}

END {
    if ( $isNT ) {	# in a DOS box, so don't go away, yet
	print "Press Enter ";
	$junk = <STDIN>;
    }
}

# &moveInits( $magnus, 'to', 'bak', parameters for xlatePaths )
# This function moves the init directives from the magnus object to the
# head of the second file.  Make a backup with extension '.bak'
sub moveInits {
    my	$magnus = shift;
    my	$dest = shift;
    my	$destBackup = shift;
    my	@newDest;

    open( DEST, $dest ) || die "Can't open $dest";

    #If the dest starts with a comment, keep it at the beginning
    while ( <DEST> ) {
	if ( m'^#' ) {
	    push( @newDest, $_ );
	} else {
	    $savedDestLine = $_;
	    last;
	}
    }
    push( @newDest, "\n" );
    for ( $i = 0 ; $i < $magnus->numInits() ; ++$i ) {
	push( @newDest, xlatePaths( 'Init ' . $magnus->getInit( $i ) . "\n",
				    @_ ) );
    }
    push( @newDest, "\n" );
    for ( $i = $magnus->numInits() ; $i-- ; ) {
	$magnus->deleteInit( $i );
    }
    push( @newDest, $savedDestLine );
    while ( <DEST> ) {
	push( @newDest, $_ );
    }
    close( DEST ) ||
	die "Couldn't close $dest";
    &makeBackup( $dest, $destBackup ) || die "Can't backup $dest";
    open( DEST, ">$dest" ) || die "Can't rewrite $dest";
    foreach $line ( @newDest ) {
	print DEST $line;
    }
    close( DEST );
}

# &makeBackup( $file, 5 );
# depending on the parameter, do one of three things: nothing( undef ),
# make a rolling backup with a maximum of $flag backups( digit ),
# or make a backup with .$flag as the suffix
# NOTE: the original file gets renamed, so it's not there anymore.
# returns the name of the backed up file if good,
# otherwise undef and $@ has the error
sub makeBackup
{
    my	$file = shift;
    my	$flag = shift;
    my	$previous;

    return $file unless $flag;
    if ( $flag =~ /^\d+$/ ) {	# roll it
	while ( $flag ) {
	    $previous = $flag - 1;
	    if ( $previous ) {
		$previous = '.' . $previous;
	    } else {
		$previous = '';
	    }
	    if ( -r "$file$previous" ) {
		rename( "$file$previous", "$file.$flag" ) || return undef;
	    }
	    --$flag;
	}
	return "$file.1";
    } else {			# extension
	return "$file.$flag" if rename( $file, "$file.$flag" );
    }
    return undef;		# something wrong
}

sub serverList {
    my	$dir = shift;
    my	@result;

    opendir( SERVERS, $dir ) || die "Can't open $dir";
    @result = grep( /^http[sd]-[\d.]+$/, readdir( SERVERS ) );
    closedir( SERVERS );
    if ( scalar( @servers ) ) {
	my	@serverList = @servers;

	@result = sort( @result );
	@serverList = sort( @serverList );
	if ( @result == @serverList ) {
	    my	$i;

	    for ( $i = 0 ; $i <= $#result ; ++$i ) {
		if ( $result[$i] !~ /$pathCS$serverList[$i]$/ ) {
		    warn "Passed server list does not match servers in $dir\n";
		    return ();
		}
	    }
	    @result = @servers;
	} else {
	    warn "Different number of servers in $dir than were passed in\n";
	    return ();
	}
    }
    return @result;
}

sub oldServerList {
    my	$dir = shift;
    my	@result;

    opendir( SERVERS, $dir ) || die "Can't open $dir";
    @result = grep( /^start-http[sd]/, readdir( SERVERS ) );
    @result = map { s/^start-//; $_; } @result;
    closedir( SERVERS );
    if ( scalar( @servers ) ) {
	my	@serverList = @servers;

	@result = sort( @result );
	@serverList = sort( @serverList );
	if ( @result == @serverList ) {
	    my	$i;

	    for ( $i = 0 ; $i <= $#result ; ++$i ) {
		if ( $result[$i] ne $serverList[$i] ) {
		    warn "Passed server list does not match servers in $dir\n";
		    return ();
		}
	    }
	    @result = @servers;
	} else {
	    warn "Different number of servers in $dir than were passed in\n";
	    return ();
	}
    }
    return @result;
}

sub keyToDB {
    my	$magnus = shift;
    my	$srcPath = shift;
    my	$destPath = shift;
    my	$backupPolicy = shift;
    my	$keyFile = $magnus->value( 'KeyFile' );
    my	$certFile = $magnus->value( 'CertFile' );
    my	$warnFailures = 0;

    if ( $keyFile ) {
	my	$dbKey = $keyFile;

	$dbKey =~ s/\.der/.db/;
	$magnus->set( 'KeyFile', $dbKey );
	if ( scalar( @passwds ) ) {	# got me a password to feed in
	    open( KEY, "| .${slash}rkey11 $srcPath/$keyFile $destPath/$dbKey" ) ||
		die "Can't run key conversion program: $!\n";
	    print KEY shift( @passwds ), "\n";	# pass it in
	    if ( ! close( KEY ) ) {	# probably wrong passwd
		do {
		    die "Too many failures\n" if ++$warnFailures > 10;
		    warn "Key conversion failed: $!\n";
		    print "Please enter Key File password: " if $isNT;
		} while ( system( "$disk.${slash}rkey11 $srcPath/$keyFile $destPath/$dbKey" ) );
	    }
	} else {	# get the passwd from the user
	    print "Converting $srcPath/$keyFile\n";
	    print "Please enter Key File password: " if $isNT;
	    while ( system( "$disk.${slash}rkey11 $srcPath/$keyFile $destPath/$dbKey" ) ) {
		die "Too many failures\n" if ++$warnFailures > 10;
		warn "Key conversion failed: $!\n";
		print "Please enter Key File password: " if $isNT;
	    }
	}
    }
    if ( $certFile ) {
	my	$choppedCert = $certFile;

	$choppedCert =~ s/\.der$//;
	system( "$disk.${slash}rcert11 $srcPath/$certFile $destPath/$choppedCert" ) &&
	    die "Couldn't convert ServerCert $srcPath/$certFile\n";
	$magnus->set( 'CertFile', $choppedCert );
    }
}

sub quote {
    my	$name = shift;

    if ( $name =~ /[\s\"\'\.\\,]/ ) {	# needs quoting
	$name =~ s/[\"\\]/\\$&/g;
	$name = '"' . $name . '"';
    }
    return $name;
}

# Assumptions: only one AuthTrans/object
sub updateACL {
    my	$obj = new ObjConf( shift );
    my	$serverName = shift;
    my	$backupPolicy = shift;
    my	$objCount = 0;
    my	$authDirective;
    my	@pathChecks;
    my	$requireAuth;
    my	@denies;
    my	@users;

    die $@ unless $obj;
    open( NEWACL, ">$destDir/httpacl/generated.$serverName.acl" ) ||
	die "Couldn't create $destDir/authdb/acl: $!\n";
    foreach $type ( 'names', 'ppaths' ) {
	foreach $object ( values( %{$obj->{$type}} ) ) {
	    undef( $authDirective );
	    undef( @pathChecks );
	    undef( @denies );
	    undef( @users );

	    ++$objCount;
	    # collect relevant pathchecks and denies
	    foreach $directive ( @{$object->{'directives'}} ) {
		if ( $directive->{'type'} =~ /^pathcheck$/i ) {
		    if ( $directive->{'name'} eq 'require-auth' ) {
			if ( $directive->{'params'}->{'auth-type'} eq 'basic' ) {
			    push( @pathChecks, $directive );
			}
		    } elsif ( $directive->{'name'} eq 'deny-existence' ) {
			push( @denies, $directive );
		    }
		} elsif ( $directive->{'type'} =~ /^AuthTrans$/i ) {
		    $authDirective = $directive;
		}
	    }
	    next unless ( scalar( @denies ) || scalar( @pathChecks ) );
	    # process them
	    print NEWACL "ACL ${serverName}_formgen-READ-ACL_deny-$objCount ",
       		" (GET, HEAD, POST, INDEX) {\n",
		"\tDefault deny anyone;\n";
	    if ( $authDirective && scalar( @pathChecks ) ) {
		# the server will be taking names
		my	@pathElements;
		my	$users;
		my	@users;
		my	$dbm;
		my	$closedAuth = 0;

		# get database name
		if ( defined( $authDirective->{'params'}->{'dbm'} ) ) {
		    $dbm = $authDirective->{'params'}->{'dbm'};
		    $dbs{$dbm} = 1;
		} elsif ( defined( $authDirective->{'params'}->{'userfile'} ) ) {
		    $dbm = $authDirective->{'params'}->{'userfile'};
		    $userFiles{$dbm} = 1;
		} else {
		    die "Can't understand why there's no dbm or userfile\n";
		}
		@pathElements = split( m'/', $dbm );
		$dbm = "$destDir/authdb/" . pop( @pathElements );
		$dbm =~ s/\.pwf$//;	# trim .pwf extension
		if ( scalar( @denies ) ) {
		    $obj->removeDirective( $object, $authDirective );
		} else {
		    $obj->{'source'}->[$authDirective->{'sourceIndex'}] =
			'PathCheck fn="check-acl" acl="' .
			    "${serverName}_formgen-READ-ACL_deny-$objCount\"\n" .
				'PathCheck fn="check-acl" acl="' .
				    "${serverName}_formgen-WRITE-ACL_deny-$objCount\"\n";
		}
		print NEWACL "\tDefault authenticate in {\n";
		print NEWACL "\t\tDatabase \"$dbm\";\n";
		print NEWACL "\t\tMethod basic;\n";
		foreach $requireAuth ( @pathChecks ) {
		    unless ( $closedAuth ) {
			if ( $requireAuth->{'params'}->{'realm'} ) {
			    print NEWACL "\t\tPrompt \"$requireAuth->{'params'}->{'realm'}\";\n";
			}
			print NEWACL "\t};\n";
			$closedAuth = 1;
		    }
		    $users = $requireAuth->{'params'}->{'auth-user'};
		    $users = 'all' unless $users;
		    if ( $users =~ /^\(/ ) {	# multiple
			my	$user;

			chop( $users = $' );
			foreach $user ( split( /\|/, $users ) ) {
			    push( @users, &quote( $user ) );
			}
		    } else {
			@users[0] = &quote( $users );
		    }
		    $obj->removeDirective( $object, $requireAuth );
		}
		# the ACL
		print NEWACL &doACL( $serverName, $objCount, $obj,
				     \@denies, @users );
	    } else {	# just checking hosts
		print NEWACL &doACL( $serverName, $objCount, $obj,
				     \@denies, 'anyone' );
	    }
	    print NEWACL "}\n\n";
	    print NEWACL "ACL ${serverName}_formgen-WRITE-ACL_deny-$objCount ",
       		" (PUT, DELETE, MKDIR, RMDIR, MOVE) {\n",
		"\tDefault deny anyone;\n",
	        "}\n\n";
	}
    }
    close( NEWACL );
    $obj->write( $backupPolicy );
    return ( %dbs );
}

# do a phrase or phrases depending on the deny-existence list
sub doACL {
    my	$serverName = shift;
    my	$objCount = shift;
    my	$obj = shift;
    my	$denies = shift;	# reference to list
    my	@users = @_;
    my	$users;
    my	@denyHosts = ();
    my	@allowHosts = ();
    my	$deny;
    my	$client;
    my	$param;
    my	$otherParams = undef;

    if ( scalar( @users ) > 1 ) {
	$users = '(' . join( ', ', @users ) . ')';
    } else {
	if ( scalar( @users ) == 0 || $users[0] eq '*' ) {
	    $users = 'all';
	} else {
	    $users = $users[0];
	}
    }
    foreach $deny ( @$denies ) {
	$client = $deny->{'client'};
	$client = '*' unless $client;
	foreach $client ( split( /\s+/, $client ) ) {
	    $client =~ s/^(dns|ip)\s*=\s*"?//i;	# kill type info and quote
	    $client =~ s/"$//;			# kill quote
	    if ( $client =~ /^\*~/ ) {
		$client = &expandRE( $' );
		$client =~ s/^\(//;
		$client =~ s/\)$//;
		push( @allowHosts, split( /\|/, $client ) );
	    } else {
		push( @denyHosts, split( /\|/, &expandRE( $client ) ) );
	    }
	}
	# rewrite directive
	if ( ! defined( $otherParams ) ) {	# first deny
	    $otherParams = '';
	    foreach $param ( keys %{$deny->{'params'}} ) {
		$otherParams .= ' ' . $param . '="' .
		    $deny->{'params'}->{$param} . '"';
	    }
	    $obj->{'source'}->[$deny->{'sourceIndex'}] =
		'PathCheck fn="check-acl" acl="' .
		    "${serverName}_formgen-READ-ACL_deny-$objCount\"$otherParams\n" .
			'PathCheck fn="check-acl" acl="' .
			    "${serverName}_formgen-WRITE-ACL_deny-$objCount\"\n";
	} else {
	    # delete the deny
	    $obj->{'deletedSource'}->{$deny->{'sourceIndex'}} = 1;
	    # QQQQ look into verifying otherParams
	}
	next unless $deny->{'client'};
	# look for surrounding client and remove
	for ( $i = $deny->{'sourceIndex'} ; $i > -1 ; --$i ) {
	    if ( $obj->{'source'}->[$i] =~ /^<\s*client/i ) {
		$obj->{'deletedSource'}->{$i} = 1;
		last;
	    }
	}
	for ( $i = $deny->{'sourceIndex'} ;
	      $i < scalar( @{$obj->{'source'}} ) ; ++$i ) {
	    if ( $obj->{'source'}->[$i] =~ /^<\s*\/client/i ) {
		$obj->{'deletedSource'}->{$i} = 1;
		last;
	    }
	}
    }
    # return the acl for these denies
    $result = '';
    $result .= "\tDefault allow $users at (" .
	join( ',', @allowHosts ) . ");\n" if scalar( @allowHosts );
    $result .= "\tDefault deny $users at (" .
	join( ',', @denyHosts ) . ");\n" if scalar( @denyHosts );
    $result = "\tDefault allow $users;\n" unless scalar( @allowHosts ) ||
						scalar( @denyHosts );
    return $result;
}

sub expandRE {
    my	$in = shift;

    if ( $in =~ m'\(([^)]+)\)(.)' ) {	# expand RE
	my	$pre = $`;
	my	$post = $2 . $';
	my	$expand = $1;

	$expand =~ s/(\||$)/$post$1/g;
	$in = "($expand)";
    }
    return $in;
}

sub updateLogsAndIcons {
    my	$obj = new ObjConf( shift );
    my	$iconDir = shift;
    my	$srcPath = shift;
    my	$destPath = shift;
    my	$backupPolicy = shift;
    my	$directive;
    my	$object;
    my	$log;
    my	%logs;
    my	@newInits;

    foreach $object ( @{$obj->{'objects'}} ) {
	foreach $directive ( @{$object->{'directives'}} ) {
	    if ( $object->{'type'} eq 'name' &&
		 $directive->{'type'} =~ /^NameTrans$/i &&
		 $directive->{'name'} eq 'pfx2dir' &&
		 $directive->{'params'}->{'from'} eq '/mc-icons' ) {
		# found the mc-icons translation
		$obj->{'source'}->[$directive->{'sourceIndex'}] =
		    'NameTrans fn="pfx2dir" from="/mc-icons" dir="' .
			$iconDir . "\"\n" .
			    'NameTrans fn="pfx2dir" from="/ns-icons" dir="' .
				$iconDir . "\"\n";
		# Kludge alert.  The data structure no longer matches the
		# source, but since the rest of this function doesn't care
		# about NameTrans, that's OK.
	    }
	    if ( $object->{'type'} eq 'name' &&
		 $directive->{'type'} =~ /^NameTrans$/i &&
		 $directive->{'name'} eq 'pfx2dir' &&
		 $directive->{'params'}->{'from'} eq '/ns-icons' ) {
		# found chris's ns-icons translation, so I'll delete it,
		# since the above kludge should be doing it
		$obj->removeDirective( $object, $directive );
		next;	# directive is gone, stop looking at it
	    }
	    if ( $directive->{'type'} =~ /^addlog$/i &&
		 $directive->{'name'} eq 'common-log' ) {
		$obj->{'source'}->[$directive->{'sourceIndex'}] =~
		    s/\bcommon-log\b/flex-log/i;
		if ( $directive->{'params'}->{'name'} ) {
		    $logs{$directive->{'params'}->{'name'}} = $directive;
		} else {
		    $logs{'global'} = $directive;
		}
	    }
	    if ( $directive->{'type'} =~ /^addlog$/i &&
		 $directive->{'name'} eq 'record-keysize' ) {
		# obsolete directive
		$obj->removeDirective( $object, $directive );
		next;	# directive is gone, stop looking at it
	    }
	}
    }
    foreach $directive ( @{$obj->{'directives'}} ) {
	if ( $directive->{'type'} =~ /^init$/i &&
	     $directive->{'name'} eq 'init-clf' ) {	# Log
	    foreach $log ( keys( %{$directive->{'params'}} ) ) {
		# translate the paths to the new directory
		$directive->{'params'}->{$log} =~ s/$pathCS$srcPath/$destPath/;
	    }
	    foreach $log ( keys( %logs ) ) {
		if ( $directive->{'params'}->{$log} ) {

		    push( @newInits, 'Init fn="flex-init" ' . $log . '="' .
			  $directive->{'params'}->{$log} . '" format.' .
			  $log . '="' .
			  '%Ses->client.ip% - %Req->vars.auth-user% ' .
			  '[%SYSDATE%] \"%Req->reqpb.clf-request%\" ' .
			  '%Req->srvhdrs.clf-status% ' .
			  '%Req->srvhdrs.content-length%"' );
		    delete $directive->{'params'}->{$log};
		} else {
		    die "Mention of $log in the AddLogs, but not init-clf\n";
		}
	    }
	    # remove logs that are now flex-logs
	    if ( scalar( %{$directive->{'params'}} ) ) {
		$obj->{'source'}->[$directive->{'sourceIndex'}] =
		    'Init fn="init-clf"';
		foreach $log ( keys( %{$directive->{'params'}} ) ) {
		    $obj->{'source'}->[$directive->{'sourceIndex'}] .=
			' ' . $log . '="' . $directive->{'params'}->{$log} .
			    '"';
		}
		$obj->{'source'}->[$directive->{'sourceIndex'}] .= "\n";
	    } else {	# no logs left
		$obj->{'source'}->[$directive->{'sourceIndex'}] = '';
	    }
	    # put new flex-inits in, tagged onto the init-clf.
	    # This messes up the structure, so just write the obj.conf out
	    foreach $log ( @newInits ) {
		$obj->{'source'}->[$directive->{'sourceIndex'}] .= $log . "\n";
	    }
	    last;
	}
    }
    $obj->write();
}

# comment out home page specifier, and warn, if one was specified
sub hideHomePage {
    my	$obj = new ObjConf( shift );
    my	$default = $obj->{'names'}->{'default'};
    my	$directive;
    my	$foundOne = 0;

    foreach $directive ( @{$default->{'directives'}} ) {
	if ( $directive->{'type'} =~ /^NameTrans$/i &&
	     $directive->{'name'} eq 'home-page' ) {	# found a home page
	    warn "Commenting out home page specification, look in $obj->{'file'}\n";
	    $obj->{'source'}->[$directive->{'sourceIndex'}] = '# ' .
		$obj->{'source'}->[$directive->{'sourceIndex'}];
	    $foundOne = 1;
	    last;
	}
    }
    $obj->write() if $foundOne;
}

# Add the necessary directives to enable LiveWire
sub addLiveWire {
    my	$obj = new ObjConf( shift );
    my	$default = $obj->{'names'}->{'default'};
    my	$directive;
    my	$foundIt = 0;

    # Not quite the right way to go about this, but until ObjConf.pm gets
    # better, the way I will do it.
    foreach $directive ( @{$default->{'directives'}} ) {
	if ( $directive->{'type'} =~ /^nametrans$/i && 
	     $directive->{'name'} eq 'livewireNameTrans' ) {
	    $foundIt = 1;
	    last;
	}
    }
    if ( ! $foundIt ) {	# piggyback the directive onto the last directive
	$obj->{'source'}->[$default->{'sourceIndex'}] .=
	    "NameTrans fn=livewireNameTrans name=LiveWire\n";
	push( @{$obj->{'source'}},
	      "\n<Object name=LiveWire>\nService fn=livewireService\n</Object>\n" );
    }
    $obj->write();
}

sub updateDBs {
    my	$destDir = shift;
    my	$commandPrefix = shift;
    my	$commandSuffix = shift;
    my	@dbs = @_;
    my	$dbName;
    my	@elements;

    foreach $db ( @dbs ) {
	@elements = split( m@/@, $db );
	$dbName = pop( @elements );
	$dbName =~ s/\.pwf$//;	# trim .pwf extension
	&toDB( $destDir, $dbName, "$commandPrefix$db$commandSuffix" );
    }
}

# read the passwd db or file and make a user from it
sub toDB {
    my	$dir = shift;
    my	$name = shift;
    my	$openString = shift;
    my	$command;

    open( PW, $openString ) || die "Couldn't read $openString: $!\n";
    while ( <PW> ) {
	chomp;
	( $user, $pw ) = split( /:/, $_ );
	$user =~ s/([\s\(\)\?\*&'"])/\\$1/g;	# ']);
	$pw =~ s/([\s\(\)\?\*&'"])/\\$1/g;	# ']);
	$command = $isNT ? ".\\mkuser -p $pw $user $dir/$name |" :
	    "./mkuser -p $pw $user $dir/$name 2>&1 |";
	open( MKUSER, $command ) ||
	    die "Couldn't start ./mkuser: $!\n";
	while ( <MKUSER> ) {
	    if ( $_ !~ /success/i ) {
		print;
	    }
	}
	close( MKUSER );
    }
    close( PW );
}

sub copyFile {
    my	$src = shift;
    my	$dest = shift;

    open( SOURCE, $src ) || die "Can't read $src: $!\n";
    open( DEST, ">$dest" ) || die "Can't write to $dest: $!\n";
    while ( <SOURCE> ) {
	print DEST;
    }
    close( SOURCE );
    close( DEST );
}

sub copyConfig {
    my	$srcDir = shift;
    my	$destDir = shift;
    my	$file;

    opendir( SRCDIR, $srcDir ) || die "Can't read $srcDir: $!\n";
    while ( $file = readdir( SRCDIR ) ) {
	next if $file =~ /^\.\.?$/;	# skip . and ..
	next if -d "$srcDir/$file";	# Don't recurse
	&copyFile( "$srcDir/$file", "$destDir/$file" );
    }
}
	
# Do a file copy, but convert path names as the file gets copied
# Don't convert paths that don't point anywere, except for log files
# push non-converted paths to the results list
# If you are xlating paths that contain one another, the long paths must cone
# first
sub xlatePath {
    my	$src = shift;
    $dest = shift;

    open( SRC, $src ) || die "Can't open $src: $!\n";
    open( DEST, ">$dest" ) || die "Can't open $dest: $!\n";
    while ( <SRC> ) {
	print DEST &xlatePaths( $_, @_ );
    }
    close( SRC );
    close( DEST );

    return @results;
}

# translate paths in the string
sub xlatePaths {
    my	$line = shift;
    my	@otherParams = @_;
    my	$numXs = shift;
    my	@srcPaths = splice( @_, 0, $numXs );
    my	@destPaths = splice( @_, 0, $numXs );
    my	@allowedEmpty = @_;
    my	@pathLengths = map { length( $_ ) } @srcPaths;
    my	$i;
    my	$pre;
    my	$post;
    my	$allowed;
    my	$path;
    my	$destPath;

    grep { s/$slashPattern/$slashPattern/g } @srcPaths if $isNT;
    for ( $i = 0 ; $i < $numXs ; ++$i ) {
	if ( $line =~ /$pathCS$srcPaths[$i]/ ) {
	    $pre = $`;
	    $post = $';
	    foreach $allowed ( @allowedEmpty ) {
		if ( substr( $post, 0, length( $allowed ) ) eq $allowed ) {
		    return &xlatePaths( $pre, @otherParams ) .
			    $destPaths[$i] . $allowed .
				&xlatePaths( substr( $post, length($allowed) ),
					     @otherParams );
		}
	    }
	    $path = $& . $post;
	    $path =~ s/["'`\s>\*].*//s;	# to " or space ]
	    ( $destPath = $path ) =~ s/$pathCS$srcPaths[$i]/$destPaths[$i]/;
	    if ( -e $destPath ) {
		return &xlatePaths( $pre, @otherParams ) .
			$destPaths[$i] . substr( $post, 0, length( $path ) -
						 $pathLengths[$i] ) .
			    &xlatePaths( substr( $post, length( $path ) -
						 $pathLengths[$i] ),
					 @otherParams );
	    } else {
		$complaint = "Not rewriting $path, which is in your old server.\nI suggest you look into copying it over, and fixing $dest.\n\n";
		push( @results, $complaint ) unless $results[$#results] eq
							$complaint;
	    }
	}
    }
    return $line;
}

sub parseParams {
    $param = shift( @ARGV );
    $partialUpgrade = 0;
    while ( defined( $param ) ) {
	if ( $param eq '-s' ) {		# old directory
	    $srcDir = shift( @ARGV );
	} elsif ( $param eq '-n' ) {	# names of new servers
	    @nicknames = &getArgList();
	} elsif ( $param eq '-p' ) {	# ports of old servers
	    @servers = &getArgList();
	} elsif ( $param eq '-w' ) {	# passwds for ServerKeys
	    @passwds = &getArgList();
	} elsif ( $param eq '-o' ) {
	    $partialUpgrade = 1;
	}
	$param = shift( @ARGV );
    }
}

sub getArgList {
    my	@result = ();

    while ( defined( $ARGV[0] ) && $ARGV[0] !~ /^-/ ) {
	push( @result, shift( @ARGV ) );
    }
    return @result;
}

sub findConfig {
    my	$dir = shift;
    my	$server = shift;
    my	$oldServer = shift;
    my	$start;
    my	$configDir;

    if ( $oldServer ) {
	if ( -f "$dir/start-$server" ) {
	    $start = "start-$server";
	} else {
	    die "Can't comprehend configuration for $dir/$server\n";
	}
    } else {	# 1.12 server
	if ( -f "$dir/$server/start" ) {
	    $start = "$server/start";
	} elsif ( -f "$dir/$server/start-httpd" ) {
	    $start = "$server/start-httpd";
	} else {	# not sure
	    opendir( DIR, "$dir/$server" ) ||
		die "Can't read $dir/$server: $!\n";
	    while ( $start = readdir( DIR ) ) {
		last if $start =~ /start/;	# start somewhere in the name
	    }
	    closedir( DIR );
	    if ( $start ) {
		$start = "$server/$start";
	    } else {
		die "Couldn't find a startup script for $dir/$server\n";
	    }
	}
    }
    open( START, "$dir/$start" ) || die "Can't read $dir/$start: $!\n";
    while ( <START> ) {
	if ( /-d\s*([^\s]*)/ ) {
	    $configDir = $1;
	    last;
	}
    }
    close( START );
    return $configDir;
}
