#!perl
# Upgrade an existing S1WS6.1 installation to this service pack
# Called by httpconf.cpp:installCleanup
#


BEGIN
{
    $| = 1;
    $isNT = -d '\\';

    # global variables
    $useHTML = 0;
    $rootDir = 0;


    sub printUsage
    {

        print "Usage:  perl $ARGV[0] -r <rootDir>\n\n";
        print "        -r = root directory\n";
        print "\n";
        exit(0);
    }


    # parse arguments
    if ($#ARGV < 0)
    {
        printUsage();
    }

    my $argc = 0;
    while ($argc <= $#ARGV)
    {
        if ($ARGV[$argc] eq "-r")
        {
            $argc++;
            if ($argc > $#ARGV)
            {
                printUsage();
            }
            $rootDir = $ARGV[$argc++];
            $rootDir =~ s/\\/\//g if $isNT;
            if (substr($rootDir, length($rootDir)-1, length($rootDir)) eq "/")
            {
                chop($rootDir);
            }
            die("No such directory: $rootDir\n") if (!(-d $rootDir));
        }
        elsif ($ARGV[$argc] eq "-w")
        {
            $useHTML = 1;
            $argc++;
        }
        else
        {
            printUsage();
        }
    }

    # set include line
    @INC = ( "$rootDir/bin/https/perl" );
}

use BinUtil;
use Magnus;


# defines
$JAVA_SEP = ":";
if ($isNT)
{
    $JAVA_SEP = ";";
}

# environment
$ENV{LD_LIBRARY_PATH} = "$rootDir/bin/https/lib";
$ENV{SHLIB_PATH} = "$rootDir/bin/https/lib";
$ENV{LIBPATH} = "$rootDir/bin/https/lib";

$LOG_FILENAME = "$rootDir/setup/upgrade.log";
open(LOG_FILE, ">>$LOG_FILENAME") ||
    die "Could not open $LOG_FILENAME in append mode\n";

my %pkgList = BinUtil::getPkgList($rootDir);
my $WS_Version = BinUtil::getVersion($rootDir);

fixAdminPathCheck();
fixObjConf();

logInfo("Sun One Web Server $WS_Version upgrade completed");

close(LOG_FILE);
exit(0);

#
# Strip whitespaces
#
sub strip
{
    my $str = shift;

    $str =~ s/\s+//g;

    return $str;
}

#
# Escape special characters such as $, { etc that are used in
# regular expressions.
#
sub escapeRegex
{
    my $expr = shift;

    $expr =~ s/\$/\\\$/g;
    $expr =~ s/\{/\\\{/g;
    $expr =~ s/\}/\\\}/g;
    $expr =~ s/\(/\\\(/g;
    $expr =~ s/\)/\\\)/g;

    return $expr;
}

sub logInfo
{
    my $msg = shift;
    my @now = localtime;
    my $month = $now[4] + 1;
    my $year = $now[5] + 1900;
    print LOG_FILE "[$year/$month/$now[3]:$now[2]:$now[1]:$now[0]] - ";
    print LOG_FILE "[upgrade60] $msg\n";
}

sub logError
{
    my $msg = shift;
    logInfo($msg);
    exit(1);
}

#
# Return the contents of the specified file as a single string
# (Used on NT)
#
sub readFile
{
    my $fname = shift;
    my $data = "";
    open(TMPFILE, "<$fname") || logError("Could not open $fname");
    while (<TMPFILE>)
    {
        $data .= $_;
    }
    close(TMPFILE);
    return strip($data);
}

sub fixAdminPathCheck
{
    $objconf = "$rootDir/https-admserv/config/obj.conf";
    $token = "XXUPGRADEXX";
    $data = "";

    if (-f $objconf)
    {
	open(CONF_FILE,$objconf) || die("cannot open file");

	# Insert a Token immediately after AuthTrans fn="match-browser"
	# If PathCheck followed with admin-check-admpw is found then replace
	# the token substituting PathCheck with AuthTrans.

	while (<CONF_FILE>) {
	    if (/AuthTrans/ && /match-browser/) {
		$data .=$_;
		$data .=$token;

	    } elsif (/PathCheck/ && /admin-check-admpw/) {
		$_ =~ s/PathCheck/AuthTrans/;
		$data =~ s/$token/$_/;
	    } else {
		$data .= $_;
	    }
	}
	close (CONF_FILE);

	# Remove the token if PathCheck admin-check-admpw pattern was not 
	# present.

	$data =~ s/$token//g;
	open(CONF_FILE,">$objconf") || die("cannot open file");
	print CONF_FILE $data;
	close (CONF_FILE);
    }
}

# fix obj.conf for all the instances. Ensure that it is modified in both the
# config and conf_bk directories
sub fixObjConf
{
    # Get the names of all the instance directories in the install root
    opendir(DIR, $rootDir) || die "can't opendir $rootDir: $!";
    @instances = grep { /^https-/ && -d "$rootDir/$_" } readdir(DIR);
    closedir DIR;

    foreach $instance (@instances)
    {
        # fix obj.conf both in the config and conf_bk directories
        $objconf_bk = "$rootDir/$instance/conf_bk/obj.conf";
        removeForceType($objconf_bk);

        $objconf = "$rootDir/$instance/config/obj.conf";
        removeForceType($objconf);
    }
}

#
# Remove the following line from the "j2ee" object only
# ObjectType fn=force-type type=text/html
# Bug# 6173293
#
sub removeForceType
{
    my $objconf = shift;
    if (-f $objconf) {
        $data = "";
        $j2eeObject = 0;
        $forceTypeFound = 0;
        open(CONF_FILE, $objconf) || die "cannot open $objconf: $!";

        while (<CONF_FILE>) {
            if ($j2eeObject == 1 && /force-type/ && /text\/html/) {
                # Ignore the force-type line within the j2ee object
                $forceTypeFound = 1;
            } else {
                if (/^<Object/ && /name=\"j2ee\"/) {
                    $j2eeObject = 1;
                } elsif (/^<\/Object/) {
                    $j2eeObject = 0;
                }
                # Accumulate the rest of the lines in $data
                $data .= $_;
            }
        }
        close (CONF_FILE);

        if ($forceTypeFound == 1) {
            # Write back the obj.conf sans the force-type line
            open(CONF_FILE,">$objconf") || die("cannot open $objconf: $!");
            print CONF_FILE $data;
            close (CONF_FILE);
        }
    }
}
