#
# Copyright (c) 1995 Sun Microsystems, Inc.
# All rights reserved.
# 
# Permission is hereby granted, without written agreement and without
# license or royalty fees, to use, copy, modify, and distribute this
# software and its documentation for any purpose, provided that the
# above copyright notice and the following two paragraphs appear in
# all copies of this software.
# 
# IN NO EVENT SHALL SUN MICROSYSTEMS, INC. BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING
# OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF SUN
# MICROSYSTEMS, INC. HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
# 
# SUN MICROSYSTEMS, INC. SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING,
# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS
# FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THE SOFTWARE PROVIDED
# HEREUNDER IS ON AN "AS IS" BASIS, AND SUN MICROSYSTEMS, INC. HAS NO
# OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#

#
# DOOM Arena Server
#
# booga@eng.sun.com
# 

load libtclutil.so
load libdoomarena.so

### Load tcl scripts ###

source bin/doomarena_util.tcl

### Set up the untrusted interpretor

interp create untrusted -safe
foreach cmd $SafeCmd {
    untrusted alias $cmd $cmd
}

if {[catch "exec ndd -set /dev/tcp tcp_conn_req_max 25"]} {
    set failed [catch {exec ndd /dev/tcp tcp_conn_req_max} max]
    if {$failed || $max < 25}  {
	puts "****************************************************************"
	puts "Could not increase tcp_conn_req_max to 25"
	puts "Run the following command as root to improve restart performance"
	puts "ndd -set /dev/tcp tcp_conn_req_max 25"
	puts "****************************************************************"
    }
}

setrlimit nofile [lindex [getrlimit nofile] 1]

set das_port $serverPort
set admin_port [expr $serverPort + 1]

set das_socket [tcp_server_start $das_port]
set admin_socket [tcp_server_start $admin_port]

proc fileevent {file {mode {}} {script {}}} {
    global _fileevents_read _fileevents_write
    if {$mode == {}}  {
	catch {unset _fileevents_read($file)}
	catch {unset _fileevents_write($file)}
	return
    }
    if {$mode == "readable"} {
	set _fileevents_read($file) $script
    }
    if {$mode == "writable"} {
	set _fileevents_write($file) $script
    }
}

fileevent $das_socket readable "new_connection $das_socket"
fileevent $admin_socket readable "admin_connection $admin_socket"

if [DEBUG] {puts "Port $das_port initialized"}

#
# Initialize the messages array
#

if [catch {set msglog [open $env(DAHOME)/server/msglog a+]} msglog] {
    puts "Couldn't open message log: $msglog"
    set msglog ""
}

if [catch {set gamelog [open $env(DAHOME)/server/gamelog a]} gamelog] {
    puts "Couldn't open game log: $gamelog"
    set gamelog ""
}

set msgline(0) 0
unset msgline(0)

set msgCounter 0
set msgSaveLines 50

if {$msglog != ""} {
    seek $msglog 0 start

    set line [gets $msglog]
    while {$line != ""} {
	set msgline($msgCounter) $line
	set msgCounter [expr ($msgCounter+1) % $msgSaveLines]
	set line [gets $msglog]
    }
}

proc InitMessagesCommand {} {
    global msgline msgCounter msgSaveLines

    set cmd ""
    set size [array size msgline]

    if {$size == 0} {
	return "AppendMessage {Messages Window} 0"
    }

    set start [expr $msgCounter % $size]
    set end [expr ($msgCounter+1) % $size]
    set i $start
    while {1} {
	set cmd "${cmd}AppendMessage [list $msgline($i)] 0"
	set i [expr ($i+1) % $size]
	if {$i == $start} {
	    break
	}
	set cmd "${cmd}\n"
    }

    return $cmd
}

proc AppendMessage {msg {audio 0} {appendtime 0}} {
    global msglog msgline msgCounter msgSaveLines

    if {$msglog == ""} {return}
    set msg "[fmtclock [getclock] %R] $msg"
    puts $msglog $msg
    flush $msglog
    set msgline($msgCounter) $msg
    set msgCounter [expr ($msgCounter+1) % $msgSaveLines]
}

proc LogGame {game info} {
    global gamelog active_games

    set index [lsearch -exact $active_games $game]
    if {$gamelog == "" || $index != -1} {return}
    if [DEBUG] {puts "LogGame: $game"}
    regsub -all "\r" $info "\n" info
    puts $gamelog $info
    flush $gamelog
}

#
# Initialize the wad file list
#

InitWadList $env(DAHOME)

proc UpdateWadList {} {
    global env gWadFileList

    InitWadList $env(DAHOME)
    forward_message "SafeSet gWadFileList [list $gWadFileList]" everyone
}


#
# Contribute a wad file
#

proc ContributeWad {file} {
    if {[llength [glob wads/contrib/*.wad]] > 36} {return}

    if {[regexp {[;|[`<>]} $file]} {return}
    if {![info complete $file]} {return}
    set file [lindex $file 0]

    set cmd "/bin/cp incoming/$file wads/contrib/$file ; \
    	  /bin/rm -f incoming/$file ; \
    	  bin/wadinfo wads/contrib/$file ; \
    	  server/dasadmin UpdateWadList"
    exec /bin/sh -c $cmd &
}

#
# Get frag information about some other game
#

set frag_requests(0) 0
unset frag_requests(0)

proc GetFrags {client_socket game {rank 0}} {
    global client_id game_players frag_requests

    if {$game == ""} {
	global active_games
	set game [lindex $active_games $rank]
	if {$game == ""} {return}
    }

    # Figure out who to request the info from
    set game_id [lindex $game_players($game) 0]
    set game_socket [GetSocketById $game_id]
    
    if [DEBUG] {puts "SEND \"RequestFragInfo\" to $game_socket"}
    if {[catch {puts_retry $game_socket RequestFragInfo}]}  {
	client_eof $game_socket
	return
    }

    # Set up the game frags array so that we know who to send the
    # frag info to when we get it
    if {![info exists frag_requests($game)]} {
	set frag_requests($game) ""
    }
    if {[lsearch -exact $frag_requests($game) $client_socket] == -1} {
    	lappend frag_requests($game) $client_socket
    }
}

proc FragInfo {client_socket game info} {
    global client_id frag_requests

    if {![info exists frag_requests($game)]} {
	set frag_requests($game) ""
    }
    if {$frag_requests($game) != ""} {
	foreach socket $frag_requests($game) {
	    if [DEBUG] {puts "SEND \"SetFragInfo [list $info]\" to $socket"}
	    if {[catch {puts_retry $socket "SetFragInfo [list $info]"}]} {
		client_eof $socket
	    }
	}
	set frag_requests($game) ""
    }
}

#
# Rerun the clients - used by dasadmin
#

proc RerunClients {} {
    forward_message RerunClients
}

#
# Keep the variables in sync
#

trace variable altdeath w DeathTrace
trace variable deathmatch w DeathTrace
trace variable nomonsters w MonsterTrace
trace variable respawn w MonsterTrace

proc DeathTrace {name1 name2 mode} {
    global $name1
    if {![set $name1]} {
	return
    }

    if {$name1 == "deathmatch"} {
	global altdeath
	if {$altdeath != 0} {
	    set altdeath 0
	}
    } else {
	global deathmatch
	if {$deathmatch != 0} {
	    set deathmatch 0
	}
    }
}

proc MonsterTrace {name1 name2 mode} {
    global $name1
    if {![set $name1]} {
	return
    }

    if {$name1 == "nomonsters"} {
	global respawn
	if {$respawn != 0} {
	    set respawn 0
	}
    } else {
	global nomonsters
	if {$nomonsters != 0} {
	    set nomonsters 0
	}
    }
}

#
# Game start functions
#

set active_games {}

proc tkerror {err} {
    global errorInfo
    puts "ERROR: $errorInfo"
}

proc audio {args}	{}
proc audio_real {args}	{}
proc playsound {args}	{}
proc Wakeup {args}	{}
proc PlayerSleeping {args} {}
proc PlayerAwake {args}    {}

set wadType doom1
set menuLevels {}
set menuSublevels {}

proc Doom1Wad_Update {name newSubdir newLevel newSublevel} {
    global wadType gWadFile gSubdir menuLevels menuSublevels

    set wadType doom1
    set gWadFile $name
    set gSubdir $newSubdir
    set menuLevels $newLevel
    set menuSublevels $newSublevel
}

proc Doom2Wad_Update {name newSubdir newLevel} {
    global wadType gWadFile gSubdir menuLevels menuSublevels

    set wadType doom2
    set gWadFile $name
    set gSubdir $newSubdir
    set menuLevels $newLevel
    set menuSublevels {}
}

proc ReInit {client_socket} {
    puts_retry $client_socket [InitVarsCommand]
    puts_retry $client_socket [InitMenuCommand]
}

proc JoinServer {client_socket username hostaddr fullname machinetype} {
    global client_sockets client_id
    set new_id "$username@$hostaddr"
    set suffix {}
    set prev_suffix 1
    set number 1
    while {$prev_suffix != $suffix}  {
	set prev_suffix $suffix
	foreach id [array names client_id] {
	    if {"$client_id($id)" == "$username$suffix@$hostaddr"}  {
		incr number
		set suffix "#$number"
	    }
	}
    }
    if {$suffix != {}} { set new_id "$username$suffix@$hostaddr" }
    if {[catch {ReInit $client_socket
	    	puts_retry $client_socket [WRInitCommand]
		puts_retry $client_socket [InitMessagesCommand]
		puts_retry $client_socket "SetUserID $new_id"} errmsg]} {
        if [DEBUG] {puts "ERROR in JoinServer: $errmsg"}
	client_eof $client_socket
    }
    set client_sockets($client_socket) $client_socket
    set client_id($client_socket) $new_id
    if [DEBUG] {puts "JOIN $client_socket $new_id"}
}

proc StartDoomSelected {id}  {
    global Top4 client_id client_sockets active_games game_players gWadFile
    if {[lsearch -exact $Top4 $id] == -1} {
	if [DEBUG] {puts "simultaneous start doom!"}
	return
    }

    set new_game 1
    for {} {[lsearch -exact $active_games $new_game] != -1} {incr new_game} {}
    lappend active_games $new_game
    set game_players($new_game) {}

    set current_4 $Top4

    set rank 0
    foreach player_id $current_4  {
	set player_socket [GetSocketById $player_id]
        set cmd [list [DoomCommand $player_id $current_4]]
	if {[catch {puts_retry $player_socket \
    	    	"StartDoom $new_game [list $current_4] $gWadFile $cmd"}]}  {
	    client_eof $player_socket
	} else {
	    lappend game_players($new_game) $player_id
	    WRPlay $player_id $new_game $rank $gWadFile
	    forward_message \
	    	"WRPlay $player_id $new_game $rank $gWadFile" everyone
	}
	incr rank
    }

    set cmd "SafeSet gTurbo 100 ; SafeSet respawn 0 ; SafeSet altdeath 1"
    uplevel #0 $cmd
    forward_message $cmd everyone
}

proc PlayerExit {player_id game}  {
    RemoveFromGame $player_id $game
    WRSuspend $player_id
    forward_message "WRSuspend $player_id" everyone
}

proc RemoveFromGame {player_id {game {}}}  {
    global active_games game_players
    if {$game == {}}  {
	foreach g [array names game_players]  {
	    if {[lsearch -exact $game_players($g) $player_id] != -1}  {
		set game $g ; break
	    }
	}
	if {$game == {}} { return }
    } else {
	if {[catch {set game_players($game)}]} { return }
	if {[lsearch -exact $game_players($game) $player_id] == -1}  {
	    return
	}
    }

    set index [lsearch -exact $game_players($game) $player_id]
    set game_players($game) [lreplace $game_players($game) $index $index]

    if {[llength $game_players($game)] == 0}  {
	set index [lsearch -exact $active_games $game]
	if {$index != -1} {
	    set active_games [lreplace $active_games $index $index]
	}
	unset game_players($game)
    }
}

proc GetSocketById {id}  {
    global client_id
    foreach client_socket [array names client_id]  {
	if {$id == $client_id($client_socket)} {
	    return $client_socket
	}
    }
    return {}
}

#
# Server junk
#

proc new_connection {das_socket}  {
    set client_socket [tcp_server_accept $das_socket]
    fcntl $client_socket NONBLOCK 1
    fileevent $client_socket readable "client_message $client_socket"
    if [DEBUG] {puts "client_socket = $client_socket"}
}

proc admin_connection {admin_socket}  {
    set admin_socket [tcp_server_accept $admin_socket]
    fcntl $admin_socket NONBLOCK 1
    fileevent $admin_socket readable "admin_message $admin_socket"
    if [DEBUG] {puts "admin_socket = $admin_socket"}
}

proc client_eof {client_socket}  {
    global client_sockets client_buffer client_id
    if [DEBUG] {puts "EOF $client_socket"}
    catch {close $client_socket}
    fileevent $client_socket

    if {[info exists client_id($client_socket)]} {
	RemoveFromGame $client_id($client_socket)

	if {! [catch {set client_id($client_socket)}]}  {
	    WRLeave $client_id($client_socket)
	    forward_message "WRLeave $client_id($client_socket)" $client_socket
	}

	catch {unset client_sockets($client_socket)}
	catch {unset client_id($client_socket)}
	catch {set client_buffer($client_socket) {}}
    }
}

proc client_message {client_socket} {
    if {[catch {ArenaGetCommands $client_socket} commands]} {
	global errorCode
	if {[lindex $errorCode 1] == "EAGAIN"} {
	    if [DEBUG] {puts "EAGAIN: ReadFromServer"}
	} else {
	    client_eof $client_socket
	}
	return
    }

    foreach cmd $commands {
	if [DEBUG] {puts "RECEIVE $client_socket: $cmd"}
	if {[forward $cmd]}  {
	    forward_message $cmd $client_socket
	}
	if {[catch {uplevel #0 untrusted eval \
	    	[rewrite_command $cmd $client_socket]} result]} {
	    global errorInfo
	    puts "client_message error: $errorInfo"
	}

    }
}

proc admin_message {admin_socket} {
    global admin_sockets

    if {[catch {ArenaGetCommands $admin_socket} commands]} {
	global errorCode
	if {[lindex $errorCode 1] == "EAGAIN"} {
	    if [DEBUG] {puts "EAGAIN: ReadFromServer"}
	} else {
	    if [DEBUG] {puts "admin EOF: $admin_socket"}
	    fileevent $admin_socket
	    catch {close $admin_socket}
	}
	return
    }

    foreach cmd $commands {
	if [DEBUG] {puts "admin RECEIVE $admin_socket: $cmd"}
	if {[catch {uplevel #0 untrusted eval $cmd}]} {
	    global errorInfo
	    puts "admin_message error: $errorInfo"
	}
    }
}

proc rewrite_command {cmd client_socket}  {
    global game_players
    set name [lindex $cmd 0]

    if {$name == "JoinServer" || \
	$name == "ReInit" || \
	$name == "GetFrags" || \
	$name == "FragInfo"} {
	set cmd [linsert $cmd 1 $client_socket]
    } elseif {$name == "WRSuspend"} {
	foreach game [array names game_players]  {
	    if {[lsearch -exact [lindex $cmd 1] $game_players($game)] != -1}  {
		return ""
	    }
	}
    }
    return $cmd
}

proc forward {cmd}  {
    set name [lindex $cmd 0]
    if {$name == "JoinServer" || \
	$name == "ReInit" || \
	$name == "GetFrags" || \
	$name == "FragInfo" || \
	$name == "ContributeWad" || \
	$name == "LogGame"} {
	return 0
    }
    return 1
}

proc forward_message {msg {from_client {}}}  {
    global client_sockets

    foreach client_socket [array names client_sockets]  {
	if {$from_client != $client_socket}  {
	    if [DEBUG] {puts "SEND \"$msg\" to $client_socket"}
	    if {[catch {puts_retry $client_socket $msg}]}  {
		client_eof $client_socket
	    }
	}
    }
}

### Main poll loop ###

while {1}  {
    set events [eval "poll -read [array names _fileevents_read] -write [array names _fileevents_write]"]
    foreach e $events {
	set client_socket [lindex $e 0]
	set event [lindex $e 1]
	if {$event == "read" &&
			[catch {set _fileevents_read($client_socket)}] == 0} {
	    if [catch {uplevel #0 $_fileevents_read($client_socket)} result] {
		puts "$client_socket handler error; $result"
		puts "EVENTS $events"
	    }
	} elseif {$event == "write"} {
	    if [catch {uplevel #0 $_fileevents_write($client_socket)} result] {
		puts "$client_socket handler error; $result"
	    }
	} elseif {$event == "error" || $event == "hup" || $event == "invalid"} {
	    if [DEBUG] {puts "$e"}
	    if {[catch {set admin_socket}] == 0 && \
				$client_socket != $admin_socket}  {
		catch {client_eof $client_socket}
	    } else {
		catch {fileevent $client_socket}
	    }
	}
    }
}
