#!/usr/bin/perl -w
# WAB - the Wolfenstein Admin Bot
# An administration assistant for Return to Castle Wolfenstein Multiplayer
# server admins.  See http://www.castlewolfenstein.com/ for more infor
# on this excellent game.
#
# Copyright (C) 2001 Brett A. Thomas <quark@baz.com>.  All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
# 
# Email quark@baz.com with questions, comments and patches, and
# especially see the WAB homepage at http://www.baz.com/quark/software/wab/

use strict;
use Carp;
use Wab;
use IO::Socket;
use Symbol;

my $IO_Socket = "http://www.cpan.org/modules/by-module/IO/IO-1.20.tar.gz";

my %Args = ("expert" => 0,
	    "config_file" => "wab.cfg");

my %Switches = ("x,expert" => {"type" => "binary",
			       "action" => "expert=1"});

my $Platform = "Linux";
my $CopyCommand = undef;

my %PlatformConfiguration = ("Linux" => 
			     {"game_dir" => "/usr/local/games/wolfenstein",
			      "main" => "main",
			      "dirsep" => "/",
			      "copy" => "cp -a"},
			     "Windows" =>
			     {"game_dir" => "c:\\Program Files\\Return To Castle Wolfenstein",
			      "main" => "Main",
			      "dirsep" => "\\",
			      "copy" => "copy"});

my $Wab = Wab->new();

my ($Result, $Args) = $Wab->ParseArgs(\%Args, \%Switches, @ARGV);

if(defined($Result))
{
    print "$Result\n";
    $Args->{"help"} = 1;
}

if($Args->{"help"})
{
    ShowHelp();
    exit 0;
}

$Wab->MergeArgs($Args);

#my @TestCLI = ("wolfded",
#	       "+set",
#	       "dedicated",
#	       "2");

my @TestCLI;

#We should be pretty well set, now.
#First question - how to do the prereqs look?

my $Err = CheckPrereqs($Args);
die "Prerequisites Check Failed:\n$Err\n" if($Err && !$Args->{expert});

#OK, we've got new enough IO::Sockets.  Let's see if we can find
#a version of Wolfenstein running on this machine...
my $ServerInfo = FindWolfensteinProcs();

if(!defined($ServerInfo) &&
   !$Args->{expert})
{
    print "Unable to determine your running server configuration.\n";
    print "This may be because your server isn't running, or it may be\n";
    print "because this script isn't smart enough.\n\n";
    print "You may either quit this installation and run your server to see if this\n";
    print "script can determine your server configuration, OR, if your server is\n";
    print "already running (or you don't want to bother), you may continue this\n";
    print "installation in \"expert\" mode, which requires you to input all values\n";
    print "yourself.\n";
    my $Answer = Question("Continue or Quit",
			  ["Quit", "q"],
			  ["Continue", "c", "cont"]);
    if($Answer eq "Quit")
    {
	exit 1;
    }
    else
    {
	$Args->{expert} = 1;
    }
}
else
{
    print "You appear to already have a dedicated Wolfenstein server running.\n";
    print "This installation will now use its guessed defaults as the answers to the\n";
    print "following configuration questions.  If any of the guessed answeres are\n";
    print "incorrect, simply input the correct information.\n\n";
}

my $TmpDir;
my $DefaultGameDir = GetDefaultGameDir($ServerInfo->{"dir"});

do
{
    $TmpDir = 
	FreeFormQuestion("What directory is Wolfenstein run from", $DefaultGameDir);
    if(! -d $TmpDir)
    {
	print "\n$TmpDir doesn't seem to exist, or it's unreadable as this user!\n";
	$TmpDir = undef;
    }
    elsif(! -w $TmpDir)
    {
	if($Args->{expert})
	{
	    print "\nWARNING:  Unable to write to $TmpDir.  As this is not necessarily essential\n";
	    print "for installation, this script will continue.  Be aware that, if you intend\n";
	    print "to install WAB under this directory (which is recommended) that you will need\n";
	    print "to restart this installation.\n";
	}
	else
	{
	    print "ERROR:  Unable to write to $TmpDir.  Depending on how you wish to install,\n";
	    print "this may not be a problem.  However, you will need to continue in expert\n";
	    print "mode.  Do this by rerunning the install script with the -x argument.\n";
	    exit 1;
	}
    }
}while(!$TmpDir);

$TmpDir =~ s/^(.*)\/\s*$/$1/;

$ServerInfo->{"dir"} = $TmpDir;

#TODO:  Look for previous installs and upgrade
$ServerInfo->{"wab_dir"} = $ServerInfo->{dir} . 
    "$PlatformConfiguration{$Platform}{dirsep}" .
    "wab-" . $Wab->Version();
$TmpDir = undef;
do
{
    $TmpDir = 
	FreeFormQuestion("What directory should WAB be installed in", 
			 $ServerInfo->{"wab_dir"});

    if(! -d $TmpDir)
    {
	if(!mkdir($TmpDir, 0777))
	{
	    print "\n$TmpDir doesn't exist, and attempting to create it returns the error $!\n\n";
	    $TmpDir = undef;
	}
    }

    if(defined($TmpDir))
    {
	$TmpDir =~ s/^(.*)\/\s*$/$1/;
	my $TmpFH = gensym();
	if(open($TmpFH, ">$TmpDir/test_file"))
	{
	    close($TmpFH);
	    unlink("$TmpDir/test_file");
	}
	else
	{
	    print "Unable to create a test file $TmpDir/test_file:  $!\n";
	    print "The install directory must be writable for WAB to be installed!\n\n";
	    $TmpDir = undef;
	}
    }
}while(!$TmpDir);


if(!$Args->{expert} && !defined($ServerInfo->{config_file}))
{
    print "It may be necessary to modify your server configuration file.\n";
    print "Unfortunately, automatic setup without a server configuration file\n";
    print "is not supported at this time; if you do not have a configuration file\n";
    print "for your Wolfenstein server, you will need to rerun this script in\n";
    print "expert mode with the -x argument.\n";
    exit 1;
}

my $YorN = "No";
my $ModifyConfig = 1;

if(!$Args->{expert})
{
    if(defined($ServerInfo->{config_file}))
    {
	print "It appears that your running server is using the config file\n";
	print "$ServerInfo->{config_file}\n";
	$YorN = Question("Is this correct",
			 ["Yes", "y", "1"],
			 ["No", "n", "0"]);
	
	if($YorN eq "No")
	{
	    print "Unfortunately, this script cannot handle guessing wrong on a config file in\n";
	    print "non-expert mode.  Please rerun this script with the -x (expert) option.\n";
	    exit 1;
	}
    }
}

print "\n";

#TODO:  If a person doesn't have an RCON, we should offer to generate one
#and add it to the server config file, if we have one.
my $TmpRCON = FreeFormQuestion("RCON Password to connect to your server",
			       $ServerInfo->{rcon});

print "\n";

if(defined($ServerInfo->{rcon}) &&
   $TmpRCON ne $ServerInfo->{rcon})
{
    print "It is important that the RCON password WAB is configured to use be the same\n";
    print "as the version on your server.  This script guessed your RCON password\n";
    print "from $ServerInfo->{config_file};\nif this guess is wrong, entering a new one\n";
    print "may be fine.  Simply be aware that, if your server config file and WAB config\n";
    print "file disagree on the RCON password, one of them will have to be changed\n";
    print "(by you).\n";
}
elsif(!defined($ServerInfo->{rcon}))
{
    $ServerInfo->{rcon} = $TmpRCON;
    if($Args->{expert})
    {
	print "This script was unable to guess at an RCON password, which indicates that\n";
	print "it is unsure of your server configuration.  Be sure to add an rconPassword\n";
	print "line to your server configuration prior to running WAB.\n";
    }
    else
    {
	print "This script can add the RCON password to your server configuration file.\n";
	$YorN = Question("Add rconPassword=" .
			 $ServerInfo->{rcon} .
			 "to $ServerInfo->{config_file}",
			 ["Yes", "y", "1"],
			 ["No", "n", "0"]);
	if($YorN eq "Yes")
	{
	    my $TmpFH = gensym();
	    open($TmpFH, ">>$ServerInfo->{config_file}") || 
		die "Unable to append to $ServerInfo->{config_file}:  $!\n";

	    print {$TmpFH} "rconPassword=$ServerInfo->{rcon}\n";

	    close($TmpFH);
	}
    }
}

print "\n";

if(defined($ServerInfo->{g_logSync}) &&
   $ServerInfo->{g_logSync} eq "1")
{
    print "It appears you already have a \"set g_logSync 1\" statement in the file\n";
    print "$ServerInfo->{config_file}, which appears to be\n";
    print "part of your running server configuration.  If all of this is correct,\n";
    print "no further action is needed.  If this is not correct, please ensure that the\n";
    print "line \"set g_logSync 1\" is included somewhere in your server startup.\n";
}
elsif($Args->{expert})
{
    print "Unable to detect that the server variable g_logSync has a value of 1.\n";
    print "Please ensure that this is set to one somewhere in your server setup, for\n";
    print "smooth operation of WAB.\n";
}
elsif(defined($ServerInfo->{g_logSync}))
{
    print "You appear to have a value set for g_logSync somewhere in your server startup\n";
    print "and that value also appears to not be 1.  It needs to be 1 to ensure smooth\n";
    print "operation of WAB.  Please ensure that this change is made prior to running\nWAB.\n";
}
else
{
    print "In order for WAB to run properly, the command \"set g_logSync 1\"\n";
    print "must be placed in the file $ServerInfo->{config_file}.\n";

    $YorN = Question("Add \"set g_logSync 1\"" .
		     " to $ServerInfo->{config_file}",
		     ["Yes", "y", "1"],
		     ["No", "n", "0"]);
    if($YorN eq "Yes")
    {
	my $TmpFH = gensym();
	open($TmpFH, ">>$ServerInfo->{config_file}") || 
	    die "Unable to append to $ServerInfo->{config_file}:  $!\n";
	
	print {$TmpFH} "g_logSync=1\n";
	
	close($TmpFH);
    }
}

print "\n";

$ServerInfo->{ip} = FreeFormQuestion("IP of your Wolfenstein server",
				     $ServerInfo->{ip} || "127.0.0.1");

$ServerInfo->{port} = FreeFormQuestion("Port of your Wolfenstein server",
				     $ServerInfo->{port} || 27960);


print "\nConfiguration complete.\n";

my $WriteConfig = 1;
my $ConfigFile = $ServerInfo->{wab_dir} . 
    $PlatformConfiguration{$Platform}{dirsep} .
    "wab.cfg";
print "Writing new WAB config file...\n";

if(-e $ConfigFile)
{
    print "File $ConfigFile already exists.\n";
    
    $YorN = Question("Overwrite",
		     ["Yes", "y", "1"],
		     ["No", "n", "0"]);
    if($YorN eq "No")
    {
	print "\nYou will need to update the WAB configuration file by hand, then.\n";
	$WriteConfig = 0;
    }
}

if($WriteConfig)
{
    my $ConfigFH = gensym();
    if(open($ConfigFH, ">$ConfigFile"))
    {
	#Load the defaults...
	$Wab->LoadConfigFile();

	$Wab->{Config}{server}{ip} = $ServerInfo->{ip};
	$Wab->{Config}{server}{oob_port} = $ServerInfo->{port};
	$Wab->{Config}{server}{rcon} = $ServerInfo->{rcon};
	$Wab->{Config}{server}{logfile} = $ServerInfo->{"wab_dir"} .
	    $PlatformConfiguration{$Platform}{dirsep} .
		"wab.log";
	$Wab->{Config}{server}{game_logfile} = $ServerInfo->{"dir"} .
	    $PlatformConfiguration{$Platform}{dirsep} .
		$PlatformConfiguration{$Platform}{main} .
		    $PlatformConfiguration{$Platform}{dirsep} .
			"games.log";
	$Wab->SaveConfigFile($ConfigFH, "server", "anti_tk", "weapon_tk_points");
    }
    else
    {
	print "Unable to write $ConfigFile:  $!\n";
    }
}

print "Copying files...";

my %Files = Wab::Files();

foreach my $File (keys(%Files))
{
    if($Files{$File}{overwrite})
    {
	my $Dest = $ServerInfo->{wab_dir};
	if($Platform =~ /windows/i &&
	   defined($Files{$File}{dos_extension}))
	{
	    $Dest =~ s/$PlatformConfiguration{$Platform}{"dirsep"}\s*$//;
	    $Dest .= $PlatformConfiguration{$Platform}{"dirsep"};
	    $Dest .= $Files{$File}{name};
	    $Dest .= ".";
	    $Dest .= $Files{$File}{dos_extension};
	}
	Copy($Files{$File}{name}, $Dest);
    }
}

print "\n\nInstallation complete!\n";
print "To run, go to $ServerInfo->{wab_dir} and execute ." .
    $PlatformConfiguration{$Platform}{dirsep} .
    "wab\n";
print "Happy Wolfensteining!\n";

sub CheckPrereqs
{
    my $Args = shift;
    my $Err = undef;

    if(defined(my $TmpSocket = IO::Socket::INET->new()))
    {
	#Ok, is the version new enough to have blocking IO?
	eval{$TmpSocket->blocking(0)};
	if($@ =~ /Can\'t locate object method/)
	{
	    $Err = "IO::Socket too old to support blocking() call.\n" .
		"Get a new IO::Socket from $IO_Socket";
	    print "$Err\n" if($Args->{expert});
	}
    }
    else
    {
	if($Args->{expert})
	{
	    print STDERR "IO::Socket::INET->new() failed.\n";
	    print STDERR "This probably indicates you do not have IO::Socket installed.\n";
	    print STDERR "You may get it from $IO_Socket\n";
	}
	$Err = "IO::Socket not installed; get it from $IO_Socket\n";
    }

    return($Err);
}

#This is extremely Linux-only.  Sorry, NT...
sub FindWolfensteinProcs
{
    my $Proc = gensym();
    my @WolfPIDs;
    my $ServerInfo = undef;

    if(opendir($Proc, "/proc"))
    {
	if(my @Dirs = readdir($Proc))
	{
	    foreach my $Dir (@Dirs)
	    {
		if($Dir =~ /^\d+$/)
		{
		    my $Exe = readlink("/proc/$Dir/exe");
		    if(defined($Exe) && ($Exe =~ /wolfded/))
		    {
			my $CWD = readlink("/proc/$Dir/cwd");
			my $FH = gensym();
			if(open($FH, "/proc/$Dir/cmdline"))
			{
			    my $CMDLine = readline($FH);
			    my @ProgArgs = split("\000", $CMDLine);
			    
			    if($#TestCLI >= 1)
			    {
				(@ProgArgs) = (@TestCLI);
			    }
			    
			    push(@WolfPIDs, {"pid" => $Dir,
					     "exe" => $Exe,
					     "cwd" => $CWD,
					     "args" => \@ProgArgs});
			    
			    close($FH);
			}
		    }
		}
	    }
	}
	
	closedir($Proc);
	
	if($#WolfPIDs == 0)
	{
	    #Ok, just one server running.
	    
	    #Let's parse the server switches...
	    my $CLISwitches = ParseServerCLISwitches($WolfPIDs[0]);
	    my $CombinedSwitches = ParseExecs($WolfPIDs[0]{"cwd"}, $CLISwitches);
	    
	    $CombinedSwitches = ParseSets($CombinedSwitches);
	    
	    #We should have everything we need, now.
	    $ServerInfo->{"dir"} = $WolfPIDs[0]{"cwd"};
	    if(defined($CombinedSwitches->{'exec'}))
	    {
		$ServerInfo->{"config_file"} = $ServerInfo->{dir} . 
		    $PlatformConfiguration{$Platform}{dirsep} .
			$PlatformConfiguration{$Platform}{main} .
			    $PlatformConfiguration{$Platform}{dirsep} .
				$Wab->StripLeadingAndTrailingWhiteSpace($CombinedSwitches->{'exec'});
	    }
	    $ServerInfo->{"rcon"} = $CombinedSwitches->{'rconPassword'} || undef;
	    $ServerInfo->{"g_logSync"} = $CombinedSwitches->{set}{'g_logSync'} || undef;
	    $ServerInfo->{"port"} = $CombinedSwitches->{set}{net_port} || 27960;
	    $ServerInfo->{"ip"} = $CombinedSwitches->{set}{net_ip} || "127.0.0.1";
	}
	elsif($#WolfPIDs > 0)
	{
	    if(!$Args->{expert})
	    {
		die "Running multiple servers is not supported by the automatic version\n" .
		    "of this install script, yet.  Try using the -x (expert) flag.\n";
	    }
	    else
	    {
		print "Detected multiple running servers.  This is not yet supported for automatic\n";
		print "configuration; you'll need to run this script manually once for each server\n";
		print "you wish to set up, with the -x flag, or modify the config files manually.\n\n";
	    }
	}
    }
    else
    {
	print STDERR "Unable to read /proc.  I assume you're running under Windows, then.\n";
	$Platform = "Windows";
    }

    return($ServerInfo);
}

sub ParseServerCLISwitches
{
    my $ProcInfo = shift;
    my $LValue = undef;
    my $RValue = undef;
    my $Keys;

    #All we care about here is the command line.  0 should be the command
    #executed.  It looks like commands are of the form "+cmd arg1..argN":
    my @TmpArgs = @{$ProcInfo->{"args"}};
    for(my $x = 1; $x <= @TmpArgs; ++$x)
    {
	if(defined($TmpArgs[$x]) && 
	   $TmpArgs[$x] =~ /^\+(.*)$/)
	{
	    #New lvalue
	    if(defined($LValue))
	    {
		$Keys = MergeValue($Keys, $LValue, $RValue);
	    }
	    $LValue = $1;
	    $RValue = undef;
	}
	else
	{
	    $RValue .= " " if(defined($RValue));
	    $RValue .= $TmpArgs[$x] || "";
	}
    }
    if(defined($LValue))
    {
	$Keys = MergeValue($Keys, $LValue, $RValue);
    }

    return($Keys);
}

sub MergeValue
{
    my $Keys = shift;
    my $LValue = shift;
    my $RValue = shift || undef;

    if(defined($Keys->{$LValue}))
    {
	if(!ref($Keys->{$LValue}))
	{
	    my $TmpRValue = $Keys->{$LValue};
	    delete($Keys->{$LValue});
	    push(@{$Keys->{$LValue}}, $TmpRValue);
	}
	push(@{$Keys->{$LValue}}, $RValue);
    }
    else
    {
	$Keys->{$LValue} = $RValue || undef;
    }

    return($Keys);
}

sub ParseExecs
{
    my $CWD = shift;
    my $CLISwitches = shift;
    my $ExecFile = shift || undef;
    my $CombinedVals = shift || undef;
    
    if(!defined($CombinedVals))
    {
	$CombinedVals = $Wab->CopyHashRef($CLISwitches);
    }

    if(!defined($ExecFile))
    {
	#First run
	if(defined($CLISwitches->{'exec'}))
	{
	    if(ref($CLISwitches->{'exec'}))
	    {
		#Multiple execs...
		foreach my $File (@{$CLISwitches->{'exec'}})
		{
		    $CombinedVals = 
			ParseExecs($CWD, $CombinedVals, $File, $CombinedVals);
		}
	    }
	    else
	    {
		#Just one exec, no need to recurse
		$ExecFile = $CLISwitches->{'exec'};
	    }
	}
	else
	{
	    #No exec.  Nothing to see here; move along...
	}
    }

    if(defined($ExecFile))
    {
	my $Filename = $CWD .
	    $PlatformConfiguration{$Platform}{dirsep} .
		$PlatformConfiguration{$Platform}{main} .
		    $PlatformConfiguration{$Platform}{dirsep} .
			$ExecFile;
	$Filename = $Wab->StripLeadingAndTrailingWhiteSpace($Filename);

	my $INF = gensym();

	if(open($INF, "$Filename"))
	{
	    my $Line;
	    while($Line = readline($INF))
	    {
		chomp($Line);

		#Ignore comments
		$Line =~ s/^([^\#]+)\#.*$/$1/g;

		if($Line =~ /^(\S+)\s+(\S.*)$/)
		{
		    $CombinedVals = MergeValue($CombinedVals, $1, $2);
		}
	    }

	    close($INF);
	}
	else
	{
	    if(!$Args->{expert})
	    {
		die ("Unable to determine your configuration; try again with the -x (expert) flag.\n" .
		     "Specifically, it appeared that the file $Filename was given\n" .
		     "to your wolfded server, but attempts to read that file resulted in the error\n" .
		     "$!\n");
	    }
	    else
	    {
		print "Wanring - unable to read the file $Filename:  $!\n";
		print "Which appears to be a config file used by your wolf server.\n";
		print "If there is any important information in that file, be warned that this\n";
		print "script is (cheerfully!) ignoring it.\n\n";
	    }
	}
    }

    return($CombinedVals);
}

sub ParseSets
{
    my $Switches = shift;
    my $NewSwitches = $Wab->CopyHashRef($Switches);

    if(ref($NewSwitches->{"set"}))
    {
	if(my @Sets = @{$NewSwitches->{"set"}})
	{
	    delete($NewSwitches->{"set"});
	    
	    #This causes later sets to overwrite newer sets, which I'm *guessing*
	    #is how wolfded parses it...
	    for(my $x = 0; $x <= $#Sets; ++$x)
	    {
		if($Sets[$x] =~ /^(\S+)\s+(\S.*)$/)
		{
		    $NewSwitches->{"set"}{$1} = $2;
		}
	    }
	}
    }
    else
    {
	#Only has one set :)
	my $TmpSet = $NewSwitches->{"set"};
	delete($NewSwitches->{"set"});
	if($TmpSet =~ /^(\S+)\s+(\S.*)$/)
	{
	    $NewSwitches->{"set"}{$1} = $2;
	}
    }

    return($NewSwitches);
}

sub Question
{
    my $Question = shift;
    my @Vals = @_;
    my $Response;
    my $Translation;
    my $ValidResponses = undef;

    do
    {
	print "${Question}? [" . $Vals[0][0] . "]:  ";

	$Response = <STDIN>;
	chomp($Response);
	
	if($Response =~ /^\s*$/)
	{
	    $Translation = $Vals[0][0];
	}
	else
	{
	    $ValidResponses = undef;
	    
	    for(my $x = 0; $x <= $#Vals; ++$x)
	    {
		$ValidResponses .= ", " if(defined($ValidResponses));
		$ValidResponses .= "$Vals[$x][0]";
		for(my $y = 0; $y <= $#{$Vals[$x]}; ++$y)
		{
		    if($Response =~ /^$Vals[$x][$y]$/i)
		    {
			$Translation = $Vals[$x][0];
		    }
		}
	    }
	}

	if(!defined($Translation))
	{
	    $ValidResponses =~ s/^(.*), (?!, )(.*)$/$1 or $2/;
	    print "Unrecognized response.  Please answer $ValidResponses.\n";
	}
    }while(!defined($Translation));

    return($Translation);
}

sub FreeFormQuestion
{
    my $Question = shift;
    my $Default = shift || undef;
    my $Response;

    do
    {
	print "${Question}?";
	
	if(defined($Default))
	{
	    if((length($Question) + (length($Default) * 1) + 4) > 79)
	    {
		print "\n";
	    }
	    else
	    {
		print " ";
	    }
	    print "[" . $Default . "]\n";
	}
	else
	{
	    print " ";
	}
    
	$Response = <STDIN>;
	chomp($Response);

	if($Response =~ /^\s*$/)
	{
	    if(defined($Default))
	    {
		$Response = $Default;
	    }
	    else
	    {
		$Response = undef;
	    }
	}
    }while(!defined($Response));

    return($Response);
}

sub GetDefaultGameDir
{
    my $RunningDir = shift || undef;

    if(!$RunningDir)
    {
	return($PlatformConfiguration{$Platform}{"game_dir"});
    }

    return($RunningDir);
}

sub Copy
{
    my $Src = shift;
    my $Dest = shift;

    if(!defined($CopyCommand))
    {
	$CopyCommand = $PlatformConfiguration{$Platform}{"copy"};
	if($Platform =~ /windows/i)
	{
	    #If we're running under some Windows environments, we might
	    #actually have a cp...
	    `cp > /dev/null 2>&1`;
	    if($! eq "cp: missing file arguments")
	    {
		$CopyCommand = "cp -a";
	    }
	}
    }

    Exec("$CopyCommand \"$Src\" \"$Dest\"");
}

sub Exec
{
    my $cmd = join(" ", @_);

    print "$cmd\n";

    system($cmd);
}
