#!/usr/bin/tcl
#
# hlcmd - A command-line interface to hlds_l
#
# NOTE: hlds_l must be started by hlds_ld for this tool to function correctly.
#
# See LICENSE for license details.
#
# Run with no arguments for usage details
# Non-interactive mode useful for cron jobs, rc startup, etc.
#

######################################################################
# Standard procedures
#
proc checkForServer {} {
	global gameId fds svrInfo

	if [file exists $fds(pid)] {
		set fd [open $fds(pid) r]
		set pid [gets $fd]
		close $fd

		catch {wait -nohang}

		if ![catch {kill 0 $pid} err] {
			# Somebody's running on that process!
			if { ![file exists $fds(cmd)] || ![file exists $fds(log)] } {
				puts stderr "pid $pid exists, but cmd pipe/log file are missing."
				puts stderr "Please make sure hlds_l is not running!"
				exit 1
			}
		} else {
			# hlcmd may be run as another user, so check for "not owner"
			if ![regexp -nocase "not owner" $err] {
				serverDown
				return
			}
		}

		statusBar "Found a running server, connecting..."
		update idletasks

		set fds(pidnum) $pid
		set fds(cmdfd) [open $fds(cmd) w]
		set fds(logfd) [open $fds(log) r]
		seek $fds(logfd) 0 end
		fcntl $fds(cmdfd) CLOEXEC
		fcntl $fds(cmdfd) NOBUF
		fcntl $fds(logfd) CLOEXEC

		set svrInfo(reconnect) 1
		#getServerStatus 1 1
		serverUp
	} else {
		set svrInfo(reconnect) 0
		serverDown
	}
}
			

proc stopServer { {running 1} {wait 29} } {
        global fds vote

	catch {wait -nohang}
        if $running {
	catch {
		puts $fds(cmdfd) quit
		flush $fds(cmdfd)
	}
        }

        # Wait for it to die
        set i 0
        while { $i < $wait } {
                catch {wait -nohang}
                if [catch {kill 0 $fds(pidnum)} err] break
                incr i
                update idletasks
                sleep 1
        }

        if [cequal $i [expr $wait + 1]] {
                # Kill it
                catch {kill 2 $fds(pidnum)}
                sleep 1
                catch {kill 9 $fds(pidnum)}
                catch {wait -nohang}
                .alert.text configure -text \
                        "Unclean shutdown at [clock format [clock clicks]]"
        }
        serverDown

        statusBar "Server stopped : [now]"
}

proc say { text } {
	global fds
	puts $fds(cmdfd) "say $text"
	flush $fds(cmdfd)

	statusBar "Said: $text"
}

proc execCmd {{cmd ""}} {
	global fds 

	if [cequal $cmd ""] return

	puts $fds(cmdfd) $cmd
	flush $fds(cmdfd)

	statusBar "Sent '$cmd' to server"

	if {[cequal $cmd quit] || [cequal $cmd exit]} {
		stopServer 0
	}
}

proc readConfig {} {
	global config text gameId myhldir fds

	if [catch { open $myhldir/$gameId/hlds_ld.cfg r } fd] {
		if [info exists fds(logfd)] {
			myEcho ERR [format $text(30) $fd]
			myExit 1
		} else {
			puts stderr [format $text(81) $fd]
			exit 1
		}
	}

	# Set up the defaults
	set config(rs)         1	;# Restart y/n
	set config(rsDelay)    10	;# Restart Delay
	set config(cm)         1	;# Execute custom map.cfg y/n
	set config(refresh)    60	;# Refresh timeout

	set config(vote)       1	;# Voting enabled y/n
	set config(votetime)   180	;# Number of seconds in a voting session
	set config(minvotes)   4	;# Min # of votes to win (unless majority)
	set config(votekw)     ""	;# Voting keyword
	set config(votefreq)   90	;# Frequency of voting keyword
	set config(voteignoretag) "";# Tag to ignore when counting votes
	set config(novotemaps) ""	;# Maps that can't be voted on
	set config(maxextend)  0	;# Maximum amount of time a map can be extended

	set config(votetext)   {EXAMPLE: "vote nml" would vote for No Man's Land}

	set config(votemodnames) ""
	set config(votemoddirs)  ""

	set config(autostart)  1	;# Autostart hlds_run y/n
	set config(localmode)  0	;# Only accept connections from localhost
	set config(localadmin) 0	;# Only accept ADMINISTRATORs from localhost

	set config(port) 27015		;# Port hlds_run will listen on
	set config(dport) 3000		;# Port hlds_ld will listen on
	set config(bindip) ""		;# IP address hlds_ld will bind to

	set config(stats)     0	;# Execute stats after each match?
	set config(statspath) "./tfc/tfstats/tfstats_l";# Path to stats pgm
	set config(statsargs) "%L outputDir=/home/httpd/html/tfstats";# Stats args

	set config(serverMsg)      ""	;# Server Message
	set config(serverMsgTimes) ""	;# Times to display server msg
	set config(usrauth)        ""	;# USER password
	set config(admauth)        ""	;# ADMINISTRATOR password
	set config(minhack)        0	;# Map time hack in in minutes
	set config(maplist)        30	;# Prevent 'maplist' spamming (seconds)
	set config(mapcycle)        30	;# Prevent 'mapcycle' spamming (seconds)
	set config(timeleft)       30	;# Prevent 'timeleft' spamming (seconds)
	set config(nextmap)        30	;# Prevent 'nextmap' spamming (seconds)
	set config(size)           30	;# Prevent 'size' spamming (seconds)
	set config(deleteLogs)     1	;# Delete empty log files (# kills)
	set config(deletecust)     0	;# Delete custom.hpk before launching server?

	set config(args) "+exec autoexec.cfg"	;# Args to pass to hlds_run
	set config(maps) ""						;# Builtin maps

	set config(autorotate) 0		;# Auto-rotate hlds_ld.log?
	set config(rotatetype) 0		;# Rotate to .old or to .yymmddhhmm ?

	set config(tkcheck)   0
	set config(sgtkcheck) 1
	set config(tkcounts)  "3 5 10"
	set config(tkdecay)   3600
	set config(tkwarnmsg) "%P has %C TK-warnings left before action is taken."
	set config(tkactions) "0 30 -1"
	set config(tkforgive) 1

	set config(foulcheck)  0
	set config(foulwarns)  3
	set config(fouldecay)  3600
	set config(foulwarnmsg) "%P will be kicked if that language continues."
	set config(foulmsg)    "%P is being kicked for using inappropriate language."
	set config(foulaction) -1
	set config(foulprefix) "\'\"\_"

	set config(debug) 0
	set config(tcldebug) 0

	set config(fortune) 0
	set config(fortunepath) "/usr/games/fortune"

	set config(nic) ""

	set config(maxconns)   0
	set config(localconns) 1

	set config(getmodels) 0
	set config(modesleep) 1

	set config(checkpass)  1	;# should we check to see if the server is pwd'd

	set config(exclude)    0	;# should we look for hlds_ld.exclude?

	set config(getteam)    0	;# should we get and report on teams?

	set config(alwaysrunstats) 0;# Should stats always run even if no kills on a map?

	set config(adminlog) 0		;# Should we log administrator activity?

	# Status hacks :(
	set config(ipfromstats)  1	;# should we determine IP from 'status'?
	set config(statusfields) 9	;# how many fields does 'status' return
	set config(statuscmd)    "status";# what's the 'status' command to run?
	set config(vehiclehack)  0	;# Ignore vehicle-tk's in cs?

	# Weapon limits
	set config(weaponlimit) 0	;# Should we limit usage of weapons?
	set config(weapondefault) "";# What are default weapons if map-specific not there?
	set config(weaponwarn) 1	;# How many warnings before kick?
	set config(weaponmsg) "WEAPONS BANNED on %M are:"

	set config(banip) 0

	# Name Tags
	set config(tags) \
	[list "\\(TEAM\\)" "\\(Terrorist\\)" "\\(Counter-Terrorist\\)" "\\(DEAD\\)"]

	# Read the file..
	while 1 {
		set line [string trim [gets $fd]]
		if [eof $fd] break
		if [cequal $line EOF] break

		if [cequal [csubstr $line 0 1] "#"] continue
		if [cequal [csubstr $line 0 1] "\["] continue
		if [cequal $line ""] continue

		parseConfigFile $line
	}

	if [info exists fds(mylogfd)] { validateConfig }

	# Fix foul-prefix
	if ![cequal $config(foulprefix) ""] {
		set pfx " $config(foulprefix)"
		regsub -all ""  $pfx "\\" pfx
		regsub -all " " $pfx " \*" pfx
		set config(foulprefix) "\[$pfx\]"
	}
}

proc validateConfig {} {
	global config text

	proc tf { num } {
		if { [cequal $num 1] || [cequal $num 0] } {
			return 1
		} else {
			return 0
		}
	}

	set validated 1

	# Set up a list of booleans
	lappend bools autostart
	lappend bools rs
	lappend bools localmode
	lappend bools localadmin
	lappend bools cm
	lappend bools deleteLogs
	lappend bools tkcheck
	lappend bools tkforgive
	lappend bools foulcheck
	lappend bools vote
	lappend bools stats
	lappend bools debug
	lappend bools localconns
	lappend bools ipfromstats
	lappend bools checkpass
	lappend bools exclude
	lappend bools sgtkcheck
	lappend bools alwaysrunstats
	lappend bools autorotate
	lappend bools rotatetype
	lappend bools weaponlimit
	lappend bools deletecust
	foreach bool $bools {
		if ![tf $config($bool)] {
			myEcho ERR [format $text(126) $bool $config($bool)]
			set config($bool) 0
			set validated 0
		}
	}

	# Set up a list of digits
	lappend ints dport
	lappend ints port
	lappend ints rsDelay
	lappend ints refresh
	lappend ints tkdecay
	lappend ints foulwarns
	lappend ints fouldecay
	lappend ints votetime
	lappend ints maplist
	lappend ints mapcycle
	lappend ints timeleft
	lappend ints nextmap
	lappend ints minhack
	lappend ints votefreq
	lappend ints maxconns
	lappend ints statusfields
	lappend ints tcldebug
	lappend ints adminlog
	lappend ints maxextend
	lappend ints weaponwarn
	foreach int $ints {
		if ![ctype digit $config($int)] {
			myEcho ERR [format $text(127) $int $config($int)]
			set config($int) 0
			set validated 0
		}
	}

	# Set up a list-of-list-of-digits :)
	lappend listints serverMsgTimes
	lappend listints tkcounts
	lappend listints tkactions
	foreach listint $listints {
		foreach int $config($listint) {
			if ![ctype digit $int] {
				if { ![cequal [csubstr $int 0 1] -] || ![ctype digit [csubstr $int 1 end]] } {
					myEcho ERR [format $text(146) $listint $config($listint)]
					myEcho ERR $text(147)
					set config($listint) ""
					set validated 0
				}
			}
		}
	}


	if $config(tkcheck) {
		if ![cequal [llength $config(tkactions)] [llength $config(tkcounts)]] {
			myEcho ERR $text(125) 
			set validated 0
		}
	}

	if ![cequal $config(votemodnames) ""] {
		if [catch {
			if ![cequal [llength $config(votemodnames)] [llength $config(votemoddirs)]] {
				myEcho ERR [format $text(169) votemodnames votemoddirs]
				set validated 0
				set config(votemodnames) ""
			}
		} err] {
			myEcho ERR "Error validating votemod: $err"
			set validated 0
			set config(votemodnames) ""
		}
	}

	if !$validated { 
		myEcho ERR $text(148)
	} else {
		myEcho INFO $text(149)
	}
}

proc parseConfigFile { data } {
	global text config

	# Look for "key=value" pairs
	set list [split $data =]
	set len [llength $list]
	if { $len < 2 } {
		myEcho WARN $text(114)
		myEcho WARN '$data'
		return
	} elseif { $len > 2 } {
		# We have an "=" in the value...
		set key [lvarpop list]
		set val [join $list =]
	} else {
		lassign $list key val
	}

	set key [string trim $key]
	set val [string trim $val]

	set config($key) $val
}

proc myEcho { type data } {
	echo "hlcmd: $type $data"
}


proc now {} {
	return [clock format [clock seconds]]
}

proc readText {} {
	global text myhldir vnum

	set file $myhldir/hlds_ld.txt

	if [catch {open $file r} fd] {
		puts stderr "FATAL: can't open 'hlds_ld.txt': $fd"
		exit 1
	}

	# Initialize the array; just in case someone doesn't copy the
	# file to the right place
	loop i 0 1000 { set text($i) "" }

	set i 0
	while 1 {
		if [eof $fd] break
		set text($i) [gets $fd]
		incr i
	}

	close $fd
}

######################################################################
# Procedures modified
#
proc determineIP {} {
	global text config

	if [cequal $config(nic) ""] {
		myEcho INFO $text(130)
		return ""
	}

	# Thanks to Eric Hameleers for this code / idea!
	if [catch {exec ifconfig $config(nic) | grep inet} ipdata] {
		myEcho INFO [format $text(131) $config(nic) $ipdata]
		return ""
	}

	set tagaddr [lindex $ipdata 1]
	set addr    [lindex [split $tagaddr :] 1]

	myEcho INFO [format $text(132) $config(nic) $addr]

	return $addr
}
			
proc launchServer {} {
	global gameId fds config vote after text myhldir

	foreach id [after info] { 
		set a1 ""
		set a2 ""
		catch { set a1 $after(tk) }
		catch { set a2 $after(offenses) }
		if { [cequal $id $a1] || [cequal $id $a2] } continue
		after cancel $id
	}
	set vote(insession) 0

	if ![file exists $fds(cmd)] {
	if [catch {exec mkfifo $fds(cmd)} err] {
		set msg "FATAL Error creating command pipe: '$err'"
		myEcho ERR $msg
		sendClient ERR  $msg
		myExit
	}
	catch { chmod 0664 $fds(cmd) }
	}

	# Copy existing log file to .old
	if $config(rotatetype) {
		set yymmddhhmm [clock format [clock seconds] -format %Y%m%d%H%M]
		set mylogtail [file tail $fds(log)]
		if [catch {file rename -force $fds(log) $myhldir/$gameId/oldlogs/$mylogtail.$yymmddhhmm} err] {
			myEcho WARN "Error renaming log file: $err"
		}
	} else {
		catch {file rename -force $fds(log) $fds(log).old}
	}

	set fds(cmdfd) [open $fds(cmd) {RDWR NONBLOCK}]
	fcntl $fds(cmdfd) CLOEXEC
	fcntl $fds(cmdfd) NOBUF

	# Delete custom.hpk if so configured
	if $config(deletecust) {
		if ![catch { file size custom.hpk } err] {
			myEcho INFO [format $text(178) $err]
			if [catch { unlink custom.hpk } err] {
				myEcho WARN [format $text(179) $err]
			}
		}
	}
		

	set myArgs $config(args)
	set ip [determineIP]
	if ![cequal $ip ""] { append myArgs " +ip $ip" }

	# START THE SERVER
	# Removed 'nohup' 9 May 2000 - nohup runs at nice 10(!)
	myEcho INFO $text(32)
	myEcho INFO "./hlds_run -game $gameId -port $config(port) $myArgs"

	if [catch {exec \
		./hlds_run -game $gameId -port $config(port) \
		$myArgs >& $fds(log) < $fds(cmd) &} \
	    pid] {
		sendClient ERR [format $text(33) $pid]
		myEcho     ERR [format $text(33) $pid]
		serverDown

		if $config(rs) {
			set msg  [format $text(34) $config(rsDelay)]
			statusBar $msg
			myEcho INFO $msg
			set after(launch) [after [expr $config(rsDelay) * 1000] launchServer]
		}
		return
	}

	set fd [open $fds(pid) w]
	puts $fd $pid
	close $fd

	sleep 5

	myEcho INFO [format $text(35) $pid $gameId]
	
	set fds(pidnum) $pid
	set fds(logfd) [open $fds(log) {RDONLY NONBLOCK}]

	fcntl $fds(logfd) CLOEXEC
	fcntl $fds(logfd) NOBUF

	serverUp
	#processLogFile 1 1
	#getServerStatus 1
}

proc oldlaunchServer {} {
	global gameId fds config vote

	foreach id [after info] { after cancel $id }
	set vote(insession) 0

	if ![file exists $fds(cmd)] {
	if [catch {exec mkfifo $fds(cmd)} err] {
		puts stderr "Error creating command pipe: '$err'"
		exit 1
	}
	}

	if ![file exists $fds(cmd)] {
		exec mkfifo $fds(cmd)
	}

	popupNotify .notify "Starting Server..."

	# Copy existing log file to .old
	catch {file rename -force $fds(log) $fds(log).old}

	set fds(cmdfd) [open $fds(cmd) r+]
	fcntl $fds(cmdfd) CLOEXEC
	fcntl $fds(cmdfd) NOBUF
	if [catch {exec \
		./hlds_run -game $gameId -port $config(port) \
		$config(args) >& $fds(log) < $fds(cmd) &} \
	    pid] {
		puts stderr "Error starting hlds_l: '$pid'"
		exit 1
	}

	set fd [open $fds(pid) w]
	puts $fd $pid
	close $fd

	sleep 2
	
	set fds(pidnum) $pid
	set fds(logfd) [open $fds(log) r]
	fcntl $fds(logfd) CLOEXEC
	fcntl $fds(logfd) NOBUF

#	processLogFile 1 1
#	getServerStatus 1
	serverUp
}

######################################################################
# Procedures redefined
#
proc serverUp {} {
	global fds pid

	set fd [open $fds(pid) r]
	set pid [gets $fd]
	close $fd

	global serverUp
	set serverUp 1
}

proc serverDown {} {
	global serverUp
	set serverUp 0
}

proc statusBar { msg } {
	echo $msg
}

proc popupNotify { w msg } {
	echo $msg
}

proc destroy { bleh } {}

proc showHelp {} {
	puts stdout "
Usage: hlcmd \<game\> \[command\]

Where: game    = a game to manage (e.g. \"valve\", \"tfc\")

       command = Optional.  A command to send to the server.
                  If not specified, hlcmd will run interactively.


Special commands interpreted by hlcmd are as follows:

stop  = stops a running server
start = starts a server
watch = watch the output from a running server (interactive mode only)

q, quit, exit = exits hlcmd

Any other commands are sent directly to the server.

"
}

proc usage {} {
	showHelp
	exit 1
}

######################################################################
# Main
#
proc main { argc argv } {
	global env fds gameId serverUp vers pid myhldir

	set serverUp 0
	set gameId valve

	if [cequal $argc 0] usage
	set gameId [lindex $argv 0]

	set myhldir $env(HLDIR)

	cd $myhldir

	set fds(pid) $myhldir/$gameId/hlds_l.pid
	set fds(cmd) $myhldir/$gameId/hlds_l.cmd
	set fds(log) $myhldir/$gameId/hlds_l.log

	readText
	readConfig

	checkForServer

	set cmd ""

	if { $argc > 1 } {
		# Non-interactive mode
		set cmd [lrange $argv 1 end]

		# Check for 'start'; special
		if [cequal $cmd start] {
			if $serverUp {
				echo "Server for '$gameId' is already running!" 
				exit 1
			}

			launchServer 
			echo "Server for game '$gameId' started successfully." 
			exit 0
		}

		if !$serverUp {
			echo "Can't find a server for game '$gameId'.  Aborting command."
			exit 1
		}

		if { [cequal $cmd quit] || [cequal $cmd exit] } { exit 0 }
		if [cequal $cmd stop] { set cmd quit }

		if [cequal $cmd watch] {
			# We will go into interactive mode if the server's up
			if !$serverUp {
				echo "Server is down.  Please start before attempting"
				echo "to watch it!"
				exit 0
			}
		} else {
			# We will execute the cmd and quit
			foreach el $cmd {
				if [cequal $el ""] { set el \"\" }
				append myCmd "$el "
			}

			execCmd $myCmd
			select {} {} {} 0.5
			while 1 {
				echo [gets $fds(logfd)]
				if [eof $fds(logfd)] break
			}
			exit 0
		}
	} 

	echo "hlcmd $vers\n"

	while 1 {
		if $serverUp {
			puts -nonewline "SERVER UP hlcmd> "
			flush stdout
		} else {
			puts -nonewline "SERVER DOWN hlcmd> "
			flush stdout
		}

		if [cequal $cmd ""] {
			set cmd [gets stdin]
		}

		if { $serverUp && [catch {kill 0 $pid} err] } {
			echo "Server died!"
			serverDown
			continue
		}

		if { [cequal $cmd ""] && $serverUp } continue

		if $serverUp {
			switch -exact -- [string tolower $cmd] {
				q -
				quit -
				exit { exit 0 }

				help {
					showHelp
				}

				stop {
					puts -nonewline "Stop Server \[y/N\]: "
					flush stdout
					set yn [gets stdin]
					if [cequal [string tolower $yn] y] {
						stopServer
					}
				}

				watch {
					seek $fds(logfd) 0 end
					echo "Watching server...hit <ctrl-c> to exit..."
					signal error 2
					catch {
					while 1 {
						set data [gets $fds(logfd)]
						if [eof $fds(logfd)] {
							sleep 1
							continue
						}
						if [cequal $data ""] continue
						if [regexp "^name" $data] continue
						if [catch {llength $data} len] { set len 0 }
						if [cequal $len 2] continue
						if [regexp "^\[^ \]|map" $data] {
							echo $data
						}
					}
					} err
					signal default 2
					echo "Done watching: $err"
				}

				default {
					seek $fds(logfd) 0 end
					execCmd $cmd
					select {} {} {} 0.5
					while 1 {
						echo [gets $fds(logfd)]
						if [eof $fds(logfd)] break
					}
				}
			}
		} else {
			checkForServer
			switch -exact -- [string tolower $cmd] {
				q -
				exit -
				quit {
					exit 0
				}

				help {
					showHelp
				}
	
				start {
					if !$serverUp { launchServer }
				}


				default {
					if !$serverUp {
					echo "Server is down.  Valid commands are 'start, quit, help'"
					}
				}
			}
		}

		set cmd ""
	}
}


#set fd [open hlcmd.dbg w]
#cmdtrace on $fd

set vers v1.50b2

main [llength $argv] $argv

