#!/usr/bin/tcl
#
# hlds_ld
#
# Half-Life dedicated server (hlds_l) administration/monitoring daemon
# Copyright (C) 2000 Rob Abbott
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# Comments, bug reports, etc to linuxhlds@halflife.org
#
# Rob Abbott    <linuxhlds@halflife.org>            rabbott 
# Frank Odignal <odignal@stud.fbi.fh-darmstadt.de>  odignal
# Alec Shaner   <ashaner@stumpland.org>             ashaner
#
#   rabbott 2001-03-15   - Added 'teammap' function
#                          Force "mp_logmessages 1" (for counter-strike)
#
#   rabbott 2001-03-15   - Beta release 1.50b1
#                          Chatmode now actually sends chat messages to clients :)
#                          SG-TK announces the fact that a SG-TK occurred
#                          Failure to open "hlds_ld.admin" file no longer results in
#                          a crash
#
#   rabbott 2001-03-15   - Alpha release 1.50a4
#                          Fix chatmode 
#                          Fix SG-TK
#                          Fix badwords "."
#
#   rabbott 2001-03-14   - Alpha release 1.50a3
#                          Fix problem with updateTeams
#
#   rabbott 2001-03-14   - Alpha release 1.50a2
#                          Fix 'sgtkcheck' logic
#
#   rabbott 2001-03-14   - Alpha release 1.50a
#                          Many changes to support new logging standard
#
#   rabbott 2001-03-12   - Added 'modmax', 'modprimary', 'modswitch' logic
#
#   rabbott 2001-03-06   - Players with WONid of 0 no longer show a local IP
#
#   rabbott 2001-03-04   - Allow badwords to end with a period ".", indicating
#                          that matching should not include non-whitespace
#
#   rabbott 2001-03-02   - Added 'bindip' support
#                          Added 'deletecust' support
#                          Fixed 'rotatetype=1' logic
#
#   rabbott 2001-02-25   - Release 1.40
#
#   rabbott 2001-02-20   - Added MOD-voting (experimental)
#
#   rabbott 2001-02-12   - Add weapon-limit support
#
#   rabbott 2001-02-11   - Fix problem with 'voteignoretag' if it's empty
#
#   rabbott 2001-02-09   - Attempt to work-around vehicle-tk bug in CS: 
#                          'vehiclehack' logic
#
#   rabbott 2001-02-08   - Fix 'forgive-tk' bug introduced in beta3
#                        - Add 'rotatetype' support
#
#   rabbott 2001-02-03   - Change maxextend logic to during vote rather than end
#
#   rabbott 2001-01-30   - Added 'novotemaps' support
#                        - Added 'maxextend' support
#
#   rabbott 2001-01-23   - Add 'voteignoretag' support
#
#   rabbott 2001-01-18   - Support for DoD team-determination (getmodel=1 required)
#
#   rabbott 2001-01-17   - Support for HPB bots:
#                        - Bots don't have an IP address
#                        - Bots don't show up in 'users'
#
#   rabbott 2001-01-11   - Add 'adminlog' code
#
#   rabbott 2001-01-09   - Use military time for logging rather than AM/PM
#
#   rabbott 2001-01-08   - More fixes to name-matching code
#
#   rabbott 2000-12-20   - Add 'foulprefix' code
#
#   rabbott 2000-12-18   - Fix name-matching code
#
#   rabbott 2000-12-14   - Add FOULON/FOULOFF commands
#
#   rabbott 2000-12-04   - Release 1.31
#                        - Plug hole that allowed execution of server commands
#                          by clients :-(
#                          Many thanks to Nour Sharabash and his buddy Paige for
#                          finding this!!!
#                        - Added 'fortunepath' option
#
#   rabbott 2000-11-28   - TKON/TKOFF now say the right thing (thanks Topper)
#
#   rabbott 2000-11-20   - FLF: Figure out team based on model :-(
#                        - More clean-up on model-determination code
#
#   rabbott 2000-11-15   - Add support for Firearms and it's funky logging ;-)
#
#   rabbott 2000-11-13   - Release 1.30
#
#   rabbott 2000-11-12   - If 'nextmap' is 0, don't ever try to figure
#                          out what the next map is.
#                        - Added 'alwaysrunstats' logic
#
#   rabbott 2000-11-07   - Ignore M$-style tags in hlds_ld.cfg
#
#   rabbott 2000-11-01   - Fix 'sgtkcheck' logic.
#                          Thanks to Colin Corbett for all the testing!
#
#   rabbott 2000-10-31   - Happy halloween.
#                        - Fix getMapTime crash
#                        - Set "mp_timelimit 1" before changing map on vote
#
#   rabbott 2000-10-30   - Added 'getteam' - team parsing and reporting
#                        - Added 'sgtkcheck' logic
#                        - Further cleanup of processLogLine
#                        - Fixed getServerVariable procedure
#
#   rabbott 2000-10-29   - Release 1.28b2
#                        - Added processLogLine; ALL lines should be worked now 
#                        - Added 'exclude' logic
#                        - Ignore comments and "minplayers" directives in 
#                          mapcycle.txt
#                        - Added 'getServerVariable' procedure
#
#   rabbott 2000-10-28   - Speed up model detection logic
#
#   rabbott 2000-10-26   - Addded 'checkpass' logic 
#
#   rabbott 2000-10-26   - Release 1.27b
#                        - Fix problem with 'maxconns'
#
#   rabbott 2000-10-25   - Argh.  No IP addresses returned from 'status'
#                          in 3.0.1.4
#
#   ashaner 2000-10-21   - Add player's model in the player status message.
#
#   rabbott 2000-10-17   - Don't open tcldebugfd twice :)
#
#   rabbott 2000-10-06   - Don't show active connections to USERs that ask
#                          for STATS
#
#   rabbott 2000-10-05   - Added 'maxconns' and 'localconns' logic
#                        - Added 'tcldebug' logic
#                        - Release 1.25b
#
#   rabbott 2000-09-18   - Determine IP address at server start-time
#                          if 'nic' option is enabled
#
#   rabbott 2000-09-06   - Don't puke if no logfile on getMapTime
#                        - Added TKON/TKOFF commands
#
#   rabbott 2000-09-05   - Debugging of 'exec' added
#                        - For TFC, figure out timeleft based on mp_timeleft 
#                          at startup
#
#   rabbott 2000-08-30   - Release 1.23
#
#   rabbott 2000-08-29   - Fixed TK-checking for TFC
#                        - TK and foul will still decay if server is stopped
#
#   rabbott 2000-08-29   - Release 1.22
#
#   rabbott 2000-08-27   - If no maps/ dir, don't generate an error
#                        - Fix error if TKs > greatest tkcount (Thanks TnT)
#
#   rabbott 2000-08-26   - Release 1.21
#                        - Fix error in forgive code (Thanks Cory V.A.!)
#
#   rabbott 2000-08-26   - Release 1.20
#
#   rabbott 2000-08-25   - Check for level-1 before level-2 swear words
#
#   rabbott 2000-08-14   - Don't broadcast maplist patterns (used to cheat!)
#
#   rabbott 2000-08-14   - Release 1.20b2
#                        - Fix 'warnleft not set' error in TK-checking
#                        - Index TKs by userid not name
#                        - Add 'fortune' function :-)
#
#   rabbott 2000-08-11   - Add 'votefreq' functionality
#
#   rabbott 2000-08-08   - Remove name tags before checking forgive
#
#   rabbott 2000-08-05   - Release 1.20b1
#                        - Fixed many TK kick/ban bugs 
#                        - Major thanks to hlmonitor for code/ideas!
#
#   rabbott 2000-08-02   - Added TK kick/ban functionality
#
#   rabbott 2000-07-31   - hostnames with ":" are now parsed correctly
#
#   rabbott 2000-07-29   - Filter sensitive ADMIN-mod messages to USERs
#                        - Correctly parse players with " : " in their names
#
#   rabbott 2000-07-26   - Moved hlds_ld.badwords to $HLDIR/<mod>
#                        - Fixed error message if foul-lang regexp fails
#
#   rabbott 2000-07-25   - Release 1.11b2
#                        - Fixed a problem with Level 1 kick/ban
#                        - Users with "<" in their name can now vote
#
#   rabbott 2000-07-24   - Release 1.11b1
#                        - Foul-language now based on "hlds_ld.badwords"
#                        - Level 1 and Level 2 foul-language offenses
#                        - Configurable amount of warnings for level 2
#                        - Added client 'size mapname' command
#
#   rabbott 2000-07-18   - Debugging option in .cfg file
#
#   rabbott 2000-07-16   - Added foul-language checking feature
#                        - Remove duplicates from maplist
#                        - More performance enhancements
#
#   rabbott 2000-07-10   - If mp_timelimit's value is a string, make it 0
#
#   rabbott 2000-06-29   - Release 1.10
#                        - Fix bug in 'users' parsing (Thanks Ken Kirchner)
#                        - Added 'autorotate' (Suggestion from Ken)
#                        - Don't allow votes to carry over from a previous
#                          match
#                        - Read env(HLDIR) once at startup (Thanks philstr)
#
#   rabbott 2000-06-28   - Works with 3.1.0.1 
#                        - Use editable configuration file
#
#   rabbott 2000-06-23   - Make maptime an integer - Firearms gives float...
#
#   rabbott 2000-06-23   - Release 1.09b4
#                        - Works with 3.1.0.0
#                        - No longer need to cache IP addy's
#                        - All 'say' regexps: look for ^0x02, not just 0x02
#   
#   rabbott 2000-06-09   - Major performance improvements in getServerStatus
#                          and processLogFile
#                        - Version-check on hlds_ld.txt
#
#   rabbott 2000-06-08   - Release 1.09b3
#                        - Fix bugs associated with multiple players and
#                          the 3.1.0.0 patch:
#                          * two-digit userids no longer throw off columns
#                          * concurrent disconnects no longer cause tcl error
#                        - Improve performance by only executing 'users' when
#                          necessary
#
#   rabbott 2000-06-08   - Release 1.09b2
#                          Jump through lots of hoops to get it to work with
#                          latest patch :)
#
#   rabbott 2000-06-03   - Merge in Frank's changes
#                        - Make 'maplist' do pattern-matching
#                        - Make download message part of 'server message',
#                          allow server message to be displayed at configurable
#                          intervals
#                        - Added CYCLE command
#                        - Compress logs that go in crashes/ directory
#
#   odignal 2000-05-12   - Logging of hlds_ld msgs to gui even in NOTEXT mode
#   odignal 2000-05-10   - Display 15 and 30 sec after mapchange a download message
#   odignal 2000-05-05   - Filtering of 0x02 in front of chat msgs
#   odignal 2000-04-20   - Added maplist support
#   odignal 2000-04-20   - Starting hlds_l with nice -15 (seems not to function properly ;()
#
#
# TODO
#	configurable vote example messages -not all mods have nml ;)
#	configurable votekick functionality
#	make hlclustermon look for hlgui.tcl and hlgui
#
#
#######################################################################
# tkerror - supress any gui error msgs; server *may* continue to run...?
#
#proc tkerror {errmsg} {
#     puts stderr "an error has occurred.  if you can reliably reproduce it,"
#     puts stderr "please contact the author!   see help->about."
#     puts stderr $errmsg
#}

# output 
#	global keys
#		up = is hlds_l up
#		time = time left in map - in seconds (if up)
#		data = if type has any sub-keys associated
#
#	type ERR = error occurred, data contains err msg
#
#	type STATUS = global keys only
#
#	type SB = statusbar, keys:
#		keys log = log to view area y/n
#		     sb = log to statusbar y/n
#		     text = text of the msg
#

proc sendClient { type { data "" } {fd ""} } {
	global exprs serverUp svrInfo conns protected

	calcMapTimeRem

	set kl ""
	keylset kl type $type
	keylset kl up   $serverUp
	keylset kl time $svrInfo(maprem)

	# Filter out 0x02 in data
	regsub -- "^[format %c 0x02]" $data "" filtereddata

	if ![cequal $type STATUS] {
		keylset kl data $filtereddata
	}

	# Figure out what clients get this
	if [cequal $fd ""] {
		set fds $conns(fds)
	} else {
		set fds $fd
	}

	foreach fd $fds {
		if [catch { set connAttr $conns($fd) } err] continue

		foreach var "auth text" {
			keylget connAttr $var $var
		}

		# Make sure they've authenticated
		if !$auth continue

		if [cequal $type TEXT] {
			# If they didn't ask for text, don't send any
			if !$text continue

			# If they're not admin, don't send team, rcon, etc
			if { $auth < 2 } {
				if [regexp $exprs(txtfilter) $data] { continue }

				# If they're not admin, and server is passworded, don't
				# send ANY text messages.
				if $protected continue
			}

			if [cequal $text 2] {
				# Chat mode
				if ![regexp $exprs(chatmode) $data] { continue }
			}
		}

		writeSock $fd $kl
	}
}

######################################################################
# start of net code
proc doListen {} {
	global config fds conns text after
	global errorCode errorInfo

	set conns(fds) ""

	set rc 0
	if ![cequal $config(bindip) ""] {
		myEcho INFO "Binding hlds_ld to IP address $config(bindip)"
		set rc [catch {socket -server acceptConn -myaddr $config(bindip) $config(dport)} fd]
	} else {
		myEcho DBUG "hlds_ld not bound to a specific IP address"
		set rc [catch {socket -server acceptConn $config(dport)} fd]
	}

	if $rc {
		set err $errorCode

		if [regexp EADDRINUSE $err] {
			myEcho WARN [format $text(10) $err]
			set after(listen) [after 10000 doListen]
		} else {
			myEcho ERR  [format $text(11) $fd]
			myExit 0
		}
	} else {
		myEcho INFO [format $text(89) $config(dport)]
		set fds(listen) $fd
		fcntl $fd CLOEXEC
	}
}

proc writeSock { fd data } {
	global stats conns text

	if [catch {
		flush $fd
		puts $fd $data
		flush $fd
	} err] {
		keylget conns($fd) addr addr
		keylget conns($fd) port port

		if [regexp "broken pipe" $err] {
			myEcho DBUG [format $text(12) $addr $port $err]
		} else {
			myEcho ERR [format $text(12) $addr $port $err]
		}
		closeSock $fd
	}

	incr stats(out) [expr [clength $data] + 1] ;# Add 1 for nl
}

proc acceptConn { fd addr port } {
	global stats conns config text

	myEcho INFO [format $text(13) $addr $port $fd]

	incr stats(conns)
	if [cequal [lsearch -exact $stats(ips) $addr] -1] {
		lappend stats(ips) $addr
	}

	if { $config(localmode) && ![cequal $addr "127.0.0.1"] } {
		myEcho WARN [format $text(14) $addr $port]
		close $fd
		return
	}

	# Make sure we haven't maxed-out the number of connections
	if $config(maxconns) {
		if { [llength $conns(fds)] >= $config(maxconns) } {
			if { $config(localconns) && ![cequal $addr "127.0.0.1"] } {
				myEcho WARN [format $text(133) $addr $port [llength $conns(fds)]]
				close $fd
				return
			}
		}
	}

	lappend conns(fds) $fd

	set kl ""
	keylset kl addr $addr
	keylset kl port $port

	keylset kl auth 0
	keylset kl text 0

	set conns($fd) $kl

	fcntl $fd CLOEXEC
	fcntl $fd NOBUF

	fileevent $fd readable { readSock }
}

proc closeSock { fd } {
	global conns text

	keylget conns($fd) addr addr
	keylget conns($fd) port port

	myEcho INFO [format $text(15) $addr $port]

	close $fd

	unset conns($fd)

	set newconns [lindex [intersect3 $conns(fds) $fd] 0]
	set conns(fds) $newconns
}

proc readSock {} {
	global stats conns text

	# Can't pass an arg for which fd is readable.  Bleh.  Figure it out.
	set fds [lindex [select $conns(fds) {} {} 0] 0]

	foreach fd $fds {
		if [catch {eof $fd} eof] {
			keylget conns($fd) addr addr
			keylget conns($fd) port port
			if [regexp "broken pipe" $eof] {
				myEcho DBUG [format $text(16) $addr $port $eof]
			} else {
				myEcho ERR [format $text(16) $addr $port $eof]
			}
			closeSock $fd
		}

		if $eof {
			closeSock $fd 
		} else {
			if [catch {gets $fd} data] {
				keylget conns($fd) addr addr
				keylget conns($fd) port port
				if [regexp "broken pipe" $data] {
					myEcho DBUG [format $text(17) $addr $port $data]
				} else {
					myEcho ERR [format $text(17) $addr $port $data]
				}
				closeSock $fd
			} else {
				incr stats(in) [expr [clength $data] + 1] ;# add 1 for NL
				processClientReq $data $fd
			}
		}
	}
}

# end of net code
######################################################################

proc processClientReq { data fd {init 0}} {
	global stats conns config svrInfo serverUp text fds wlimit

	keylget conns($fd) addr addr
	keylget conns($fd) port port
	# keylget conns($fd) text text
	keylget conns($fd) auth auth

	if !$serverUp { checkForServer }

	if { !$auth || $init } {
		if !$init {
			# Switch doesn't evaluate patterns.  Bleh
			if [cequal $data $config(usrauth)] {
				set auth 1
				myEcho AUTH [format $text(18) $addr $port]
				incr stats(user)
			} elseif [cequal $data $config(admauth)] {
				if $config(localadmin) {
					if ![cequal $addr "127.0.0.1"] {
					myEcho AUTH [format $text(19) $addr $port]
					myEcho WARN [format $text(19) $addr $port]
					closeSock $fd
					return
					}
				}
				set auth 2
				myEcho AUTH [format $text(20) $addr $port]
				incr stats(admin)
			} else {
				# See Ya
				myEcho AUTH [format $text(21) $addr $port]
				myEcho WARN [format $text(21) $addr $port]
				closeSock $fd
				return
			}

			keylset conns($fd) auth $auth
		}

		# Auth OK, send initialization msg
		set kl ""
		keylset kl type INIT
		keylset kl up $serverUp
		keylset kl auth $auth

		if { $serverUp && [info exists svrInfo(ip)] } {
			foreach id "name ip max" {
				keylset kl $id $svrInfo($id)
			}
		}

		keylset kl port $config(port)

		writeSock $fd $kl

		# getServerStatus 1 1
		sendClient UPDATE [buildClientUpdate] $fd
	} else {
		# Client is authorized, process their request
		# The first set of commands are allowed by anyone
		if [cequal $data ""] return

		myEcho INFO [format $text(22) $addr $port $data]

		switch -exact -- $data {

			CHAT { 
				keylset conns($fd) text 2
				checkProtected $fd $auth
			}

			TEXT { 
				keylset conns($fd) text 1
				checkProtected $fd $auth
			}

			STATS { dumpStats 1 $fd $auth }

			NOTEXT { keylset conns($fd) text 0 }
			BYE { closeSock $fd }
			MAPLIST {
				set kl ""
				keylset kl type MAPLIST
				keylset kl up   $serverUp
				keylset kl data [getMaps]
				writeSock $fd $kl
			}

			default {
				# Any other commands require authorization
				if { $auth < 2 } {
					myEcho WARN [format $text(23) $addr $port $data]
					closeSock $fd
					return
				}

				# Log the admin action if we've been told to do so.
				if $config(adminlog) {
					while 1 {
						if { [cequal $config(adminlog) 1] && \
							 [cequal [string tolower [csubstr $data 0 3]] say] } {
								myEcho DBUG $text(154)
							 	break
							}
							
						if [catch { open $fds(adminlog) a+ } adminfd] {
							myEcho ERR [format $text(30) $adminfd]
						} else {
							puts $adminfd "\[[now]\] [format $text(22) $addr $port $data]"
							close $adminfd 
						}
						break
					}
				}

				switch -exact -- $data {
					REFRESH { getServerStatus 1 1 }

					CYCLE { cycleLogFile }

					STARTVOTE { beginVoting 1 }
					STOPVOTE  { tallyVotes }

					VOTEON  { 
						myEcho INFO $text(24)
						set config(vote) 1
						sendClient UPDATE [buildClientUpdate] $fd
					}

					VOTEOFF {
						myEcho INFO $text(25)
						set config(vote) 0
						sendClient UPDATE [buildClientUpdate] $fd
					}

					FOULON  { 
						myEcho INFO $text(150)
						say $text(150)
						set config(foulcheck) 1
					}

					FOULOFF { 
						myEcho INFO $text(151)
						say $text(151)
						set config(foulcheck) 0
					}

					TKON  { 
						myEcho INFO $text(128)
						say $text(128)
						set config(tkcheck) 1
					}

					TKOFF  { 
						myEcho INFO $text(129)
						say $text(129)
						set config(tkcheck) 0
					}

					WEAPON  { 
						myEcho INFO $text(166)
						say $text(166)
						set config(weaponlimit) 1
					}

					WEAPOFF  { 
						myEcho INFO $text(167)
						say $text(167)
						set config(weaponlimit) 0
					}

					MAXOFF {
						myEcho INFO [format $text(186) modmax]
						set config(modmax) 0
					}

					MODELON  { set config(getmodels) 1 }
					MODELOFF { set config(getmodels) 0 }

					start -
					START {
						if !$serverUp { launchServer }
					}

					STOPALL {
						stopServer
						myExit 0
					}

					STOPD { myExit 0 }

					DECAY {
						offenseTable decay 
						tableTK decay 
					}

					FORTUNE { sayFortune }

					default {
						if [cequal [csubstr $data 0 3] ZAP] {
							# Handle 'ZAP'
							if ![catch {lindex $data 1} zapme] {
								if [cequal [string tolower $zapme] all] {
									foreach id $conns(fds) { closeSock $fd }
								} else {
									# check for sock
									if ![cequal [lsearch -exact $conns(fds) $zapme] -1] {
										closeSock $zapme
								} else {
										sendClient TEXT "Unknown connection: $zapme" $fd
									}
								}
							}
						} elseif [cequal [csubstr [string tolower $data] 0 [clength changelevel]] changelevel] {
							# Handle 'changelevel'
							set data [string trim $data]
							if [catch {lindex $data 1} map] {
								myEcho DBUG "Err on 'changelevel' is '$map'"
								execCmd $data
							} else {
								myEcho DBUG "Found 'changelevel', changing to '$map'"
								changeLevel $map
							}
						} elseif [cequal [csubstr $data 0 4] WEAP] {
							# Handle WEAP, WEAPDEF
							set idx 4
							if [cequal [csubstr $data 0 7] WEAPDEF] {
								set idx 7
								set config(weapondefault) [string trim [csubstr $data $idx end]]
							}

							# Change wlimit to whatever they sent
							set wlimit [string trim [csubstr $data $idx end]]

							set msg "Banned weapons set to:"
							say $msg
							say '$wlimit'
							myEcho INFO "$msg '$wlimit'"
						} else {
							# Anything else goes directly to the server
							execCmd $data
						}
					}
				}
			}
		}
	}
}

proc checkProtected { fd auth } {
	global config protected text

	if !$config(checkpass) return

	if { $protected && [expr $auth < 2] } {
		sendClient ERR $text(139) $fd
	}
}

proc signalHandler {} {
	signal ignore SIGHUP
	signal trap   SIGINT { gotSignal SIGINT }
}

proc gotSignal { signal } {
	global text

	catch { myEcho WARN [format $text(26) $signal] }
	myExit 1
}

proc myExit { {status 0} } {
	global fds text

	if ![cequal $status 2] dumpStats

	catch { myEcho INFO $text(27) }
	if ![cequal $status 2] {
		catch { unlink $fds(myPid) }
	}
	exit $status
}

proc bgerror { error } {
	global errorCode errorInfo text

	# Get the calling procedure
	set lvl  [expr [info level] - 1]
	set proc [lindex [info level $lvl] 0]

	myEcho ERR $text(28)
	myEcho ERR $text(29)
	myEcho ERR "($errorCode) : $errorInfo"
}

proc statusBar { text {log 1} } {
	set kl ""

	keylset kl sb 0
	if { $log < 2 } {
		keylset kl sb 1
	}

	if !$log {
		# probably don't want to waste bandwidth...
		myEcho INFO $text
		return
		keylset kl LOG 1
	}

	keylset kl text $text

	sendClient SB $kl

}

proc changeLevel { map } {
	global fds text ignoretime

	execCmd "mp_timelimit 1"

	sleep 2

	execCmd "changelevel $map"

	set ignoretime 1

	getServerStatus

	statusBar [format $text(90) $map]
}


proc serverUp {} {
	global serverUp conns text
	set serverUp 1

	# Send an INIT & UPDATE msg to all
	foreach fd $conns(fds) {
		processClientReq "" $fd 1
	}

	sendClient UPDATE [buildClientUpdate]
}

proc serverDown {} {
	global fds serverUp after svrInfo initializing text uidip
	set serverUp 0

	set nocancel [list tk offenses listen]
	foreach id [after info] { 
		set cancel 1
		foreach event [array names after] {
			if ![cequal [lsearch -exact $nocancel $event] -1] {
				if [cequal $id $after($event)] { 
					set cancel 0
					continue
				}
			}

			if [cequal $id $after($event)] { myEcho DBUG "Cancelling event: $event" }
		}

		if $cancel { after cancel $id }
	}

	set uidip(refresh) 0
	cleanWonip

	set vote(insession) 0

	set svrInfo(maprem) 0
	set svrInfo(map)    ""
	set svrInfo(player) 0
	set initializing 1

	catch { unset fds(pidnum) }

	catch { unlink $fds(pid)  }
	catch { close $fds(cmdfd) }
	catch { close $fds(logfd) }

	set after(serverChk) [after 10000 checkForServer]

	clearUserInfo
	sendClient UPDATE [buildClientUpdate]
}

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(modmax)       0
	set config(modswitch)    1
	set config(modprimary)   ""

	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) 0
	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

	# 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 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
	lappend bools modswitch
	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
	lappend ints debug
	lappend ints modmax
	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 $config(modmax) {
		if [cequal $config(modprimary) ""] {
			myEcho ERR $text(185)
			set validated 0
		}

		set idx [lsearch -exact $config(votemodnames) $config(modprimary)]
		if [cequal $idx -1] {
			myEcho ERR [format $text(184) modprimary votemodnames]
			set config(modmax) 0
			set validated 0
		}
	}

	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 checkForServer {} {
	global gameId fds svrInfo text

	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 [format $text(82) $pid]
				puts stderr $text(83)
				catch {unlink $fds(pid)}
				exit 1
			}
		} else {
			catch {unlink $fds(pid)}
			serverDown
			return
		}

		# Found a running server!
		myEcho INFO [format $text(31) $pid]

		initModMax

		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

		serverUp
		getServerStatus 1 1
	} else {
		serverDown
	}
}

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 gameId

	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 $gameId/custom.hpk } err] {
			myEcho INFO [format $text(178) $err]
			if [catch { unlink $gameId/custom.hpk } err] {
				myEcho WARN [format $text(179) $err]
			}
		} else {
			myEcho INFO "Couldn't read custom.hpk: $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
	statusBar "The server is starting.  Waiting for it to come all the way up..."
	sleep 10

	myEcho INFO [format $text(35) $pid $gameId]

	initModMax
	
	set fds(pidnum) $pid
	set fds(logfd) [open $fds(log) {RDONLY NONBLOCK}]

if 0 {
	if [info exists fds(rma)] {
		catch [close $fds(rma)]
	}
	set fds(rma) [open $myhldir/$gameId/hlds_l.log.rma w]
}

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

	serverUp
	processLogFile 1 1
	getServerStatus 1
}

proc initModMax {} {
	global svrInfo after text config

	set svrInfo(starttime) [clock seconds]
	set svrInfo(expired) 0

	if $config(modmax) {
		set msg [format $text(182) $config(modprimary) $config(modmax)]
		myEcho INFO $msg
		sendClient TEXT $msg
		
		# In 10 minutes, tell the users about the impending switch
		set after(modmax) [after [expr 10 * 60 * 1000] { say [format $text(182) $config(modprimary) $config(modmax)] } ]
	}
}

proc say { { text "" } } {
	global fds

	execCmd "say $text"
}

proc tallyVotes {{winner ""}} {
	global vote votes userInfo config svrInfo after text last gameId

	set last(vote) [clock seconds]

	if [cequal $winner ""] {
		if !$config(vote) {
			# Voting was canceled
			return
		}

		if !$vote(insession) {
			myEcho WARN $text(36)
			return
		}

		set vote(insession) 0

		say $text(50)

		# Get the latest list of users; anyone that voted and is not
		# logged on will be ignored.
		getServerStatus 1 1

		set numBots 0
		foreach name $userInfo(users) {
			if [ignoreUser $name] { 
				myEcho DBUG "Not counting '$name' in votes..."
				incr numBots
			}
		}

		set oneVote 0
		foreach uid [array names votes] {
			if [catch {lsearch -exact $userInfo(userid) $uid} idx] {
				myEcho ERR "Error searching users: '$idx'"
				myEcho ERR "Name search was: '$uid' on '$userInfo(userid)'"
				set idx -1
			}

			if { ![cequal $config(voteignoretag) ""] && ![cequal $idx -1] } {
				set name [lindex [getUserInfo userid $uid] 0]
				if [ignoreUser $name] {
					incr numBots -1
					myEcho DBUG "A bot ($name) voted(!)...decrementing numBots"
				}
			}

			if ![cequal $idx -1] {
				set map $votes($uid)
				if ![info exists goodVotes($map)] {
					set oneVote 1
					set goodVotes($map) 1
				} else {
					incr goodVotes($map)
				}
			} else {
				# Discard the vote
#				set name [preprocessName $name]
#				say [format $text(51) $name $votes($name)]
			}

			# Clear out the vote, it's been counted or discarded
			catch {unset votes($uid)}
		}
	} else {
		set oneVote 1
	}

	# Now find the map with the highest # of votes
	if $oneVote {
		set highVoteCnt 0
		set highVoteMap ""

		if [cequal $winner ""] {
			foreach map [array names goodVotes] {
				say [format $text(52) $map $goodVotes($map)]
				if { $goodVotes($map) > $highVoteCnt } {
					set highVoteCnt $goodVotes($map)
					set highVoteMap $map
				}
			}

			set map $highVoteMap
			set cnt $highVoteCnt

			# Check to see if we have a majority
			# Don't count clients that are connecting
			set numConn  [llength [lmatch $userInfo(ips) CONNECTING]]
			set numUsers [expr [llength $userInfo(users)] - $numConn]

			# Don't count bots
			set numUsers [expr $numUsers - $numBots]

			myEcho DBUG "Total: [llength $userInfo(users)], Conn: $numConn, Bots: $numBots, Real: $numUsers"

			set majority [expr [expr $numUsers / 2] + 1]

			if { $majority <= $config(minvotes) } {
				set max $majority
			} else {
				set max $config(minvotes)
			}
		} else {
			myEcho INFO "Forcing $winner to win the vote..."
			set map $winner
			set max 0
			set cnt 0
			set vote(insession) 0
		}

		if { $cnt >= $max } {
			# We got enough votes!
			catch { after cancel $after(vote) }
			set vote(insession) 0

			# Check to see if a MOD won...
			if ![cequal $config(votemodnames) ""] {
				set idx [lsearch -exact $config(votemodnames) $map]
				if ![cequal $idx -1] {
					set dir [lindex $config(votemoddirs) $idx]
					if [cequal $dir $gameId] {
						# They voted for the current mod... do nothing
						myEcho [format $text(177) $gameId]
						return
					}

					say [format $text(172) $map $cnt]
					myEcho INFO [format $text(172) $map $cnt]
					say [format $text(173) $map]
					if [catch { exec hlcmd $dir start } err] {
						say $text(175)
						myEcho ERR "Error changing mod: $err"
						myEcho ERR "Command was: 'hlcmd $dir start'"
						return
					} else {
						myEcho DBUG "Success, hlcmd returned: '$err'"
						say $text(174)
						say [format $text(177) $svrInfo(ip)]
						select {} {} {} 0.5
						stopServer
						return
					}
				}
			}

			say [format $text(53) $map $cnt]

			# Check to see if map exists and changelevel to it
			if { [lsearch -exact [getMaps] $map] != -1 } {
				if ![cequal $map $svrInfo(map)] {
					say [format $text(54) $map]
					sleep 10
					changeLevel $map
				} else {
					# The current map won
					set svrInfo(maptime) [expr $svrInfo(orglimit) + $svrInfo(maptime)]
					say [format $text(55) $map $svrInfo(orglimit) $svrInfo(maptime)]
					execCmd "mp_timelimit $svrInfo(maptime)"
				
					# Reschedule voting
					set sched [scheduleVoting] 
					if ![cequal $sched ""] {
						set after(vote) $sched
					}
				}

			}
		} else {
			# We didn't get enough votes
			say [format $text(56) $max $numUsers]
		}
	} else {
		say $text(57)
	}
}

proc ignoreUser { name } {
	global config

	# Don't ignore anybody if tag is blank
	if [cequal $config(voteignoretag) ""] { return 0 }

	# Look for just the tag
	set ignoreexpr "$config(voteignoretag).*"
	if [regexp $ignoreexpr $name] { return 1 }

	# Look for stuff like (1)tag and (2)tag
	set ignoreexpr "\\(\[0-9]*\\)$config(voteignoretag).*"
	if [regexp $ignoreexpr $name] { return 1 }

	return 0
}


# NB: you *must* run this proc against a player's name before
#     it is used in in a 'say' command!  Otherwise, malicious
#     players may be able to run commands on the server!
proc preprocessName { name } {
	regsub -all ";" $name "," myName
	#set myName [lindex [split $name ";"] 0]
	return $myName
}
	

proc checkForVote { name uid datavar } {
	global votes svrInfo userInfo exprs config text

	upvar $datavar data

	set gotVote 0

	# Look for 'say' keyword, pull out user name and what they said
	set rc [regexp -nocase -- $exprs(vote) $data foo map]

	myEcho DBUG "vote rc = $rc on '$data'"

	if $rc {
		myEcho DBUG "*** name = '$name'"
		myEcho DBUG "*** map  = '$map'"

		set map [string tolower $map]

		if [cequal [crange $map end-3 end] .bsp] {
			set map [crange $map 0 end-4]
		}

		# Check for valid uid
		if { [lsearch -exact $userInfo(userid) $uid] == -1 } {
			myEcho DBUG "*** didn't find '$uid' in '$userInfo(userid)'"
			return $gotVote
		}

		# Check this map against the "novotemaps" list
		if ![cequal [lsearch -exact $config(novotemaps) $map] -1] {
			say [format $text(158) $map]
			myEcho DBUG "$name voted for banned map $map, discarding vote..."
			return $gotVote
		}

		# If they said 'extend', they really meant the current map
		if [cequal $map extend] { set map $svrInfo(map) }

		if [cequal $svrInfo(map) $map] {
			# They voted for the current map
			# Check to see if extension limit has been reached
			if { $svrInfo(maptime) >= $config(maxextend) && \
				![cequal $config(maxextend) 0] } {
myEcho DBUG "Refusing to extend $map, maptime=$svrInfo(maptime), max=$config(maxextend)"
				say [format $text(159) $config(maxextend)]
				return $gotVote
			}
		}

		set name [preprocessName $name]
		# Check for valid map
		if { [lsearch -exact $config(votemodnames) $map] != -1 } {
			say [format $text(171) $name $map]
			myEcho DBUG [format $text(171) $name $map]
			set votes($uid) $map
			set gotVote 1
		} elseif { [lsearch -exact [getMaps] $map] != -1 } {
			say [format $text(58) $name $map]
			myEcho DBUG [format $text(58) $name $map]
			set votes($uid) $map
			set gotVote 1
		} else {
			say [format $text(59) $name]
			myEcho DBUG [format $text(59) $name]
		}
	}

	return $gotVote
}

proc scheduleVoting {} {
	global svrInfo config vote after text
	if !$config(vote) return

	catch { after cancel $after(vote) }
	set vote(insession) 0

	set mapsecs [expr $svrInfo(orglimit) * 60]

	# Voting should start 'votetime' + 60 seconds before
	# the map ends
	set pollstart [expr [clock seconds] + $mapsecs -\
		$config(votetime) - 60]
	set pollstart [expr $pollstart - [clock seconds]]
	statusBar [format $text(91) $pollstart]
	if { $pollstart > 0 } {
		return [after [expr $pollstart * 1000] { beginVoting }]
	}

	return ""
}

proc readMapCycle {} {
	global cycletime mapCycleList text gameId myhldir

	if ![info exists cycletime] { set cycletime 0 }

	set cycleFile $myhldir/$gameId/mapcycle.txt
	set mtime [file mtime $cycleFile]

	if ![cequal $mtime $cycletime] {
		if [catch {open $cycleFile r} fd] {
			myEcho ERR [format $text(37) $fd]
			return ""
		}

		set mapCycleList ""

		while 1 {
			set data [string trim [gets $fd]]
			if [eof $fd] break

			# Ignore comments and blank lines
			if [cequal $data ""] continue
			if [cequal [csubstr $data 0 2] "//"] continue

			# Strip off the maxplayers/n/minplayers/n crap
			if [catch { lindex $data 0 } map] { 
				set map [lindex [split $data " "] 0]
			}

			lappend mapCycleList $map
		}

		close $fd
	}
}

proc getNextMap { curMap } {
	global gameId myhldir cycletime mapCycleList text

	readMapCycle

	set idx [lsearch -exact $mapCycleList $curMap]
	incr idx
	if [cequal $idx [llength $mapCycleList]] { set idx 0 }
	set nextMap [lindex $mapCycleList $idx]

	return $nextMap
}

proc beginVoting {{forced 0}} {
	global vote svrInfo config after vnum text

	# Check to see if we're in a voting session already
	if $vote(insession) {
		statusBar $text(92)
		return
	}

	# Open the polls
	statusBar [format $text(93) [now]]

	if $svrInfo(player) {
	say [format $text(60) $vnum]
	say $text(61)
	sleep 1
	say $config(votetext)
	sleep 1
	if !$forced {
		say [format $text(63) $svrInfo(map) [expr $config(votetime) + 60]]
		sleep 1
		if { $config(nextmap) > 0 } {
			say [format $text(64) [getNextMap $svrInfo(map)]]
		}
	}
	say [format $text(65) $config(votetime)]
	}

	set after(tally) [after [expr $config(votetime) * 1000] tallyVotes]

	set vote(insession) 1
}

proc printMapList { pattern { cycle 0 } } {
	global text last mapCycleList

	# print out a map list, 5 maps per line
	if $cycle {
		say $text(138)
		readMapCycle; # Populate mapCycleList
		set maplist $mapCycleList
	} elseif ![cequal $pattern ""] {
		say $text(104)
		if [catch {lmatch [getMaps] $pattern} maplist] {
			say $text(105)
			set maplist ""
		}
	} else {
		say $text(101)
		set maplist [getMaps]
	}

	sleep 1

	if [cequal $maplist ""] {
		say $text(106)
	} elseif { [llength $maplist] > 20 } {
		say [format $text(107) [llength $maplist]]
	} else {
		set q 0

		while { [llength $maplist] > $q } {
			say [format $text(102) [lrange $maplist $q [expr $q+4]]]
			sleep 1
			incr q 5
		}
		# say $text(103)
		set last(maplist) [clock seconds]
	}
}

# This function should be called *before* any execCmd if you're going
# to eat data afterward.
#
proc slurpLogFile {} {
	global fds

	set needRefresh 0

	while 1 {
		set data [string trim [gets $fds(logfd)]]
		if [eof $fds(logfd)] break
		if [cequal $data ""] continue

		processLogLine data 1
	}
}

proc processLogLine { datavar { fromstatus 0 } { sendupdate 1 } } {
	global myhldir fds svrInfo config notIdle vote after exprs text
	global prevMap gameId stats last uidip tkcache killcache
	global szcnt team ignoretime vehiclekill wlimit

	set needRefresh 0

	upvar $datavar data

	if [cequal $data ""] { return $needRefresh }

if 0 {
	if ![info exists fds(rma)] {
		set fds(rma) [open $myhldir/$gameId/hlds_l.log.rma w]
	}
	puts $fds(rma) $data
	flush $fds(rma)
}

	# FILTERS
	if [regexp -- $exprs(usercnt)  $data] { return $needRefresh }
	if [regexp -- $exprs(ignore) $data] { return $needRefresh }

	# Log to the gui any other (significant) messages
	if { [clength $data] > 5 } { 
		if $sendupdate { sendClient TEXT $data }
	}


	# Chat messages
	if [regexp -- $exprs(chat) $data foo playerinfo chattype said] {
		processChatMessage $playerinfo $chattype $said
		return $needRefresh
	}

	# Look for connect, disconnect, and Dropped
	# messages.  We should refresh immediately upon these
	# conditions...
	if [regexp -- $exprs(refresh) $data] {

		if !$config(ipfromstats) {
			# Look for "connected" explicitly, so we can store their
			# IP addy
			if [regexp -- $exprs(connected) $data foo pinfo ip] {
				lassign [parsePlayerInfo $pinfo] name uid wonid team
				set uidip($uid) $ip
				myEcho DBUG "Cached IP: uidip($uid) = $ip"
				set uidip(refresh) 1
			}

			# Look for "Dropped", we need to remove their IP if they
			# are gone
			if [regexp -- $exprs(dropped) $data] { 
				if ![info exists after(cleanuidip)] {
					# Housekeeping 30 minutes after drop
					set after(cleanuidip) [after 300000 cleanWonip]
				}
			}
		}

		set needRefresh 1
		return $needRefresh
	}

	# Deal with kills
	if [regexp -- $exprs(killed) $data foo attacker attackee weapon properties] {
		incr svrInfo(kills)

		processKill $attacker $attackee $weapon $properties
		return $needRefresh
	}

	if { $config(tkcheck) && $config(sgtkcheck) } {
		if [regexp -- $exprs(sgkill) $data foo attacker attackee] {
			myEcho DBUG "Found sentry-gun kill: '$data' ($attacker => $attackee)"
			processKill $attacker $attackee SGKILL ""
			return $needRefresh
		}
	}

	# Team join or change
	if { [regexp -- $exprs(team) $data foo pinfo myteam] } {
		lassign [parsePlayerInfo $pinfo] name uid wonid foo
		assignTeam $uid $myteam
myEcho DBUG "$name<$uid> is on team $myteam"
		updateTeams
		return $needRefresh
	}

	# mp_timelimit variable change
	if [regexp $exprs(timechange) $data] {
		if !$ignoretime {
			# Somebody mucked with the timelimit.  Get the new one.
			getMapTime
		} else {
			set ignoretime 0
		}
		return $needRefresh
	}

	# Look for 20 or more SZ_GetSpace: errors. in a row, fast.
	# This is usually fatal, and requires us to kill the
	# server process. Ouch.
	if [regexp -- $exprs(szget) $data] { incr szcnt }
	if { $szcnt > 20 } {
		myEcho ERR [format $text(41) [now]]
		sendClient ERR [format $text(41) [now]]

		stopServer 1 2
		if $config(rs) {
			statusBar [format $text(34) $config(rsDelay)]
			myEcho INFO  [format $text(34) $config(rsDelay)]
			sleep $config(rsDelay)
			launchServer
		}
		return $needRefresh
	}

	# Look for logfile name -- this tells us we're on a new map
	if [regexp -- $exprs(log) $data foo logFile] {
		myEcho DBUG "Found start-of-map line: '$data' LOG:'$logFile'"

		# Check to see if 'modmax' expired...
		if $config(modmax) {
			if $svrInfo(expired) {
				myEcho DBUG "On a new map and modmax has expired.  Switching server."
				tallyVotes $config(modprimary)
				return $needRefresh
			}
		}

		# Do all this stuff here instead of newMap, bots connect too damn fast :)
		# We're on a new map now, so blow away caches
		# Clear the TK-forgive cache
		catch {
			foreach id [array names tkcache] { catch { unset tkcache($id) } }
		}

		# Clear the team array
		catch {
			foreach id [array names team] { catch { unset team($id) } }
		}

		# Blow away any leftover votes
		catch {
			foreach id [array names votes] { catch { unset votes($id) } }
		}

		set svrInfo(map) ""
		
		if !$fromstatus { getServerStatus 1 1 }

		set myKills $config(deleteLogs)

		# Run stats if so specified
		if { $config(stats) && ![cequal $svrInfo(logFile) ""]} {
			# Only run tfstats if there were kills during the match
			if { $svrInfo(kills) >= $myKills || $config(alwaysrunstats) } {
			regsub -all -- "%L" $config(statsargs) $svrInfo(logFile) args
			set cmd "$config(statspath) $args"
			catch {system $cmd >> $myhldir/$gameId/stats.out 2>&1} err
			myEcho INFO [format $text(42) $cmd $err]
			statusBar [format $text(43) $svrInfo(logFile)]
			myEcho INFO [format $text(43) $svrInfo(logFile)]

			# TFstats has a tendency to barf occasionally...
			# catch { unlink core }
			} else {
				statusBar [format $text(94) $svrInfo(logFile)]
			}
		}

		# Delete log file if so specified
		if { $myKills && [expr $svrInfo(kills) < $myKills] } {
			catch { unlink $svrInfo(logFile) }
			statusBar [format $text(95) $myKills $svrInfo(logFile)]
			myEcho INFO [format $text(95) $myKills $svrInfo(logFile)]
		}

		set svrInfo(kills) 0
		set svrInfo(logFile) $logFile

		# display download message
		set i 0
		foreach time $config(serverMsgTimes) {
			# after uses milliseconds
			set time [expr $time * 1000]
			set after(svrtime$i) [after $time { sayServerMsg }] 
		}

		return $needRefresh
	}

	return $needRefresh
}

proc assignTeam { uid myteam } {
	global team teammap

	set myteaml [string tolower $myteam]
	if ![catch { set teammap($myteaml) } err] {
		set myteam $teammap($myteaml)
	} else {
		myEcho DBUG "Error on teammap: $err"
	}

	set team($uid) $myteam

	updateTeams 0
}

proc processKill { attacker attackee weapon properties } {
	global config exprs wlimit tkcache text

	lassign [parsePlayerInfo $attacker] rname ruid rwonid rteam
	lassign [parsePlayerInfo $attackee] ename euid rwonid eteam

	assignTeam $ruid $rteam
	assignTeam $euid $eteam

	# Sentry-gun TK
	if [cequal $weapon SGKILL] {
		if [cequal $rteam $eteam] {
			# Found a SG-TK, enforce it
			myEcho DBUG "Found SG-TK against '$attacker'"
			myEcho DBUG "Assigned $ename ($euid) KILLED BY $rname ($ruid) to tk-forgive-cache"
			say $text(145)
			set tkcache($euid) $ruid

			foundTK $ruid
			return
		}
	}

	# WEAPON-LIMIT
	if { $config(weaponlimit) && ![cequal $wlimit ""] } {
		if ![catch { lsearch -exact $wlimit $weapon } rc] {
			if ![cequal $rc -1] {
				foundWeapon $rname $ruid $weapon
			}
		} else {
			myEcho ERR "Error on lsearch for weapon: $rc"
			myEcho ERR "weapon='$weapon', wlimit='$wlimit'"
		}
	}

	# TK
	if { $config(tkcheck) } {
		if [cequal $rteam $eteam] {
			# Teams are equal, found a TK
			myEcho DBUG "Assigned $ename ($euid) KILLED BY $rname ($ruid) to tk-forgive-cache"
			set tkcache($euid) $ruid

			foundTK $ruid
		}
	}
}


proc parsePlayerInfo { pinfo } {
	global exprs

	if ![regexp -- $exprs(player) $pinfo foo name uid wonid team] {
		myEcho WARN "parsePlayerInfo failed on: '$pinfo'"
		return [list "" "" "" ""]
	}

	return [list $name $uid $wonid $team]
}

proc processChatMessage { pinfo chattype said } {
	global config text last svrInfo vote exprs

	# Get the player's details
	lassign [parsePlayerInfo $pinfo] name uid wonid team
	assignTeam $uid $team

	set said [string tolower [string trim $said]]

	if [cequal $uid ""] return

	# Look for 'timeleft'
	if { $config(timeleft) > 0 } {
	if [cequal $said timeleft] {
		# Only allow this command once a minute, max
		if { [clock seconds] >= [expr $last(timeleft) + $config(timeleft)] } {
			say [format $text(66) $svrInfo(map) [fmtTimer]]
			set last(timeleft) [clock seconds]
		}
		return
	}
	}

	# Look for 'nextmap'
	if { $config(nextmap) > 0 } {
	if [cequal $said nextmap] {
		# Only allow this command once a minute, max
		if { [clock seconds] >= [expr $last(nextmap) + $config(nextmap)] } {
			say [format $text(100) [getNextMap $svrInfo(map)]]
			set last(nextmap) [clock seconds]
		}
		return
	}
	}

	# Look for 'maplist' if so configured
	if { $config(maplist) > 0 } {
	if [regexp -- $exprs(maplist) $said foo pattern] {
		if { [clock seconds] >= [expr $last(maplist) + $config(maplist)] } {
			set pattern [string trim $pattern]
			printMapList $pattern
		}
		return
	}
	}

	# Look for 'mapcycle' if so configured
	if { $config(mapcycle) > 0 } {
	if [cequal $said mapcycle] {
		if { [clock seconds] >= [expr $last(maplist) + $config(maplist)] } {
			printMapList "" 1
		}
		return
	}
	}

	# Look for 'size'
	if { $config(size) > 0 } {
	if [regexp -- $exprs(size) $said foo map] {
		if { [clock seconds] >= [expr $last(size) + $config(size)] } {
			set map [string trim $map]
			regsub -nocase "\.bsp" $map "" szmap
			set fname $myhldir/$gameId/maps/${szmap}.bsp
			if [catch {file size $fname} size] {
				say $text(121)
			} else {
				say [format $text(122) $szmap $size]
				set last(size) [clock seconds]
			}
		}
		return
	}
	}


	# Look for switch to turn on voting
	if $config(vote) {
	if !$vote(insession) {
		if ![cequal $config(votekw) ""] {
			if { [clock seconds] >= [expr $last(vote) + $config(votefreq)] } {
			if [cequal $said $config(votekw)] {
				# Somebody said the keyword
				beginVoting 1
				return
			}
			}
		}
	} else {
		if [checkForVote $name $uid said] { return }
	}
	}

	# Foul language
	if $config(foulcheck) {
		if [catch {regexp -nocase $exprs(foul) $said} rc] {
			myEcho ERR [format $text(116) $rc]
		} else {
			if $rc { 
				foundFoulLang $name $uid $wonid said
				return
			}
		}
	}

	# TK-forgive
	if { $config(tkcheck) && $config(tkforgive) } {
		if [cequal $said "forgive tk"] {
			foundTKForgive $name $uid
			return
		}
	}

	return
}

proc processLogFile { {reschedule 0} {startup 0}} {
	global myhldir fds svrInfo config notIdle vote after exprs text
	global prevMap gameId stats last uidip tkcache killcache
	global szcnt


	if ![info exists notIdle] {set notIdle 0}

	# Make sure it's still running...
	catch {wait -nohang}
	if [catch {kill 0 $fds(pidnum)} err] {
		myEcho ERR [format $text(38) [now]]
		sendClient ERR  [format $text(38) [now]]
		incr stats(crash)

		set now [clock seconds]

		# Create crashes/ dir if it isn't there
		if ![file exists crashes] { 
			catch {file mkdir crashes}
			chmod 0777 crashes
		}

		# Move the current log file to the crashes/ directory
		# and try to compress it
		catch {file copy -force $fds(log) crashes/$now.log}
		catch {exec gzip -v crashes/$now.log} err
		myEcho DBUG "gzip crash log returned: '$err'"

		# If they exist, move qconsole.log and overflow.dat to crashes
		# and compress them
		if [file exists qconsole.log] {
			catch { file copy -force qconsole.log crashes/$now.qconsole.log }
			catch { exec gzip -v crashes/$now.qconsole.log }
		}

		if [file exists $gameId/overflow.dat] {
			catch { file copy -force $gameId/overflow.dat crashes/$now.overflow.dat }
			catch { exec gzip -v crashes/$now.overflow.dat }
		}


		# 
		if [file exists core] {
			myEcho ERR $text(39)

			catch {
			exec echo "bt" | gdb hlds_run core > crashes/$now.backtrace
			}
			catch {file copy -force $fds(log) crashes/$now.log}

			sleep 10
			# catch {unlink core}

			myEcho ERR $text(40)
		}

		serverDown

		if $config(rs) {
			statusBar [format $text(34) $config(rsDelay)]
			myEcho INFO  [format $text(34) $config(rsDelay)]
			sleep $config(rsDelay)
			launchServer
		}
		return
	}

	set i 0
	set szcnt 0
	set needRefresh 0

	if ![cequal $svrInfo(map) $prevMap] {
		set prevMap $svrInfo(map)
		newMap
	}

	#if [cequal [csubstr $svrInfo(maprem) 0 1] "+"] {
	#	set mysecs [csubstr $svrInfo(maprem) 1 end]
	#}

	while 1 {
		set data [string trim [gets $fds(logfd)]]
		if [eof $fds(logfd)] break
		if [cequal $data ""] continue
		incr i

		set nr [processLogLine data 0]
		if $nr { set needRefresh 1 }
	}


	if $reschedule { set after(pl) [after 2500 {processLogFile 1}] }

	if { [cequal $svrInfo(name) ""] || [cequal $svrInfo(map) ""] } {
		sleep 1
		set needRefresh 1
	}

	if { $needRefresh && !$startup } {getServerStatus 1 1}

	if !$notIdle { set notIdle $i }

	return $i 
}

proc ifCstrike {} {
	global gameId

	return [regexp cstrike $gameId]
}

proc ifFA {} {
	global gameId

	return [regexp firearms $gameId]
}

proc ifDoD {} {
	global gameId

	return [regexp ^dod $gameId]
}

proc ifFLF {} {
	global gameId

	return [regexp frontline $gameId]
}

# Due to different regexp's per MOD, the name returned by the TK-checking
# regexp is different.  This proc will strip off the crap and return
# just the name.
#
proc fixTKName { name } {
	global gameId

	# In case of failure, we'll just return what they passed in...
	set newname $name

	if [ifCstrike] {
		# Counter-Strike style:
		# Name will look like "L MM/DD/YYY - HH:MM:SS: Player"
		# This is kind of dangerous, but what the hell...
		set len [clength "L MM/DD/YYYY - HH:MM:SS: "]

		if { [clength $name] > $len } {
			set newname [csubstr $name $len end]
		}
	} else {
		# TFC-style.
		# Name will look like "Player<100>"
		set idx [string last "<" $name]

		if { $idx > 0 } {
			set newname [csubstr $name 0 $idx]
		}
	}

	return $newname
}

proc readExclude {} {
	global myhldir gameId config exprs text exclude

	if !$config(exclude) return

	set fname $myhldir/$gameId/hlds_ld.exclude

	foreach id [array names exclude] { unset exclude($id) }

	if [catch { open $fname r} fd] {
		myEcho ERR [format $text(30) $fd]
		set config(exclude) 0
		return
	}

	set exCnt 0
	while 1 {
		set data [string trim [gets $fd]]
		if [eof $fd] break

		if [cequal $data ""] continue
		if [cequal [csubstr $data 0 1] "#"] continue

		set exclude($data) 1
		incr exCnt

		myEcho DBUG [format $text(142) $data]
	}

	myEcho INFO [format $text(157) $exCnt]
}

proc readBadwords {} {
	global myhldir gameId config exprs text

	set fname $myhldir/$gameId/hlds_ld.badwords

	set exprs(foul)  ""
	set exprs(foul1) ""
	set exprs(foul2) ""

	if [catch { open $fname r } fd] {
		if $config(foulcheck) {
			myEcho ERR [format $text(30) $fd]
		} else {
			myEcho DBUG [format $text(30) $fd]
		}
		set config(foulcheck) 0
		return
	}

	set i  0
	set l1 0
	set l2 0
	set lvl 1
	myEcho DBUG [replicate - 45]
	while 1 {
		set word [string trim [gets $fd]]
		if [eof $fd] break

		if [cequal $word ""] {
			set lvl 2
			set exprs(foul1) $exprs(foul)
			continue
		}

		if [cequal [csubstr $word end end] .] {
			# Found a period at the end.  Strip off the period and Just match 'word'
			set word [crange $word 0 end-1]
			myEcho DBUG "Only matching the exact word '$word'"
			set myword "$word "
		} else {
			# Match all text after "word" up to whitespace or EOL
			set myword "$word.*"
		}

		myEcho DBUG "Read level $lvl word: '$word'"

		if $i {
			append exprs(foul) "|$config(foulprefix)$myword"
		} else  {
			set exprs(foul) "$config(foulprefix)$myword"
		}

		incr i
		incr l$lvl
	}

	close $fd

	if $l2 {
		set idx [expr [clength $exprs(foul1)] + 1]
		if [cequal $idx 1] { set idx 0 }
		if { $idx < [clength $exprs(foul)] } {
			set exprs(foul2) [csubstr $exprs(foul) $idx end]
		}
	} else {
		set exprs(foul1) $exprs(foul)
	}

	myEcho INFO [format $text(117) $i hlds_ld.badwords]
	myEcho INFO [format $text(118) $l1 $l2]
	myEcho DBUG "expr0 is '$exprs(foul)'"
	myEcho DBUG "expr1 is '$exprs(foul1)'"
	myEcho DBUG "expr2 is '$exprs(foul2)'"
	myEcho DBUG [replicate - 45]

	# Check to make sure regexps "compile"
	if [catch {regexp -nocase $exprs(foul) ""} rc] {
		myEcho ERR $text(140)
		myEcho ERR $rc
		set config(foulcheck) 0
	}

	return
}

proc foundWeapon { killer kilid weapon } {
	global wwarn stats svrInfo text config

	myEcho DBUG [format $text(162) $killer $kilid $weapon $svrInfo(map)]

	incr stats(wwarn)

	set killer [preprocessName $killer]

	set uinfo  [getUserInfo userid $kilid]
	if [cequal $uinfo -1] return

	if $config(banip) {
		set id [lindex $uinfo 4]
	} else {
		set id [lindex $uinfo 2]
	}

	if [info exists wwarn($id)] {
		incr wwarn($id)
	} else {
		set wwarn($id) 1
	}

	say [format $text(163) $weapon $svrInfo(map)]
	if { $wwarn($id) > $config(weaponwarn) } {
		set msg [format $text(165) $killer]
		say $msg
		myEcho WEAP "$msg \[WON:$id\]"

		execCmd "kick # $kilid"
		incr stats(wact)
	} else {
		set warnleft [expr $config(weaponwarn) - $wwarn($id)]
		set msg  [format $text(164) $killer $warnleft]
		myEcho DBUG $msg
		say $msg
	}
}

# tkcache(killeeid) = killerid
proc foundTKForgive { killee uid } {
	global tkcache tkcount text config
				
	set forgave 0

	foreach id [array names tkcache] {
myEcho DBUG "checking $id against $uid"
		if [cequal $id $uid] {
			set kilid $tkcache($uid)
			set uinfo  [getUserInfo userid $kilid]
			if [cequal $uinfo -1] return

			if $config(banip) {
				set wonid  [lindex $uinfo 3]
			} else {
				set wonid  [lindex $uinfo 2]
			}

			if [info exists tkcount($wonid)] {
				incr tkcount($wonid) -1
				if [cequal $tkcount($wonid) 0] { unset tkcount($wonid) }
				tableTK write
			}

			catch { unset tkcache($uid) }

			set uinfo [getUserInfo userid $kilid]
			set name [preprocessName [lindex $uinfo 0]]
			set mykillee [preprocessName $killee]
			say [format $text(156) $mykillee $name]
			set forgave 1
			break
		}
	}

	if !$forgave { 
		set mykillee [preprocessName $killee]
		say $text(155)
		#say [format $text(155) $mykillee]
	}
}

#TODO: add 'banip' functionality
proc foundTK { userid } {
	global config tkcount stats gameId exclude text

	proc msgTK { name wonid warnleft { action 0 } } {
		global config

		if $warnleft {
			regsub -all "\%P" $config(tkwarnmsg) $name mymsg
			regsub -all "\%C" $mymsg $warnleft mymsg
			say $mymsg
			myEcho TK "\[WONID: $wonid\] $mymsg"
		} else {
			if [cequal $action 0] {
				set mymsg "$name has been BANNED FOREVER for TKing!"
			} elseif { $action < 0 } {
				set mymsg "$name has been KICKED for KILLING TEAMMATES!"
			} else {
				set mymsg "$name has been BANNED for $action mins for TKing!"
			}
			say $mymsg
			myEcho TK "\[WONID: $wonid\] $mymsg"
		}
	}

	# The name will be a little different depending on the MOD.
	#if [ifCstrike] { set name [fixTKName $name] }

myEcho DBUG "Teamkiller userid: '$userid'"
	set uinfo [getUserInfo userid $userid]
	if [cequal $uinfo -1] return
	lassign $uinfo name foo wonid ip
myEcho DBUG "Teamkiller name  : '$name'"
myEcho DBUG "Teamkiller wonid : '$wonid'"
	set name [preprocessName $name]
myEcho DBUG "Teamkiller name  : '$name'"

	# Check to see if we should exclude them
	if $config(exclude) {
		if ![catch { set exclude($wonid) } err] {
			# They're excluded
			myEcho DBUG [format $text(143) "$name:$wonid"]
			return
		}
	}

	# Add them to the array or increment their counter
	if ![info exists tkcount($wonid)] {
		set tkcount($wonid) 1
	} else {
		incr tkcount($wonid)
	}

	tableTK write

	# Find out if they hit an actionable TK or if they should
	# just be warned
	set idx 0
	set warnleft 0
	set action ""
	foreach cnt $config(tkcounts) {
		if { $tkcount($wonid) <= $cnt } {
			if [cequal $tkcount($wonid) $cnt] {
				set action [lindex $config(tkactions) $idx]
				if [cequal $action ""] { set action -1 }
				set warnleft 0
			} else {
				set warnleft [expr $cnt - $tkcount($wonid)]
				set action -1
			}
			break
		}

		incr idx
	}

	if [cequal $action ""] {
		# Somehow they are > than the last action...so use the last action
		set action \
			[lindex $config(tkactions) [expr [llength $config(tkactions)] -1]]
		set warnleft 0
	}

	if $warnleft {
		# Warn them
		msgTK $name $wonid $warnleft
		incr stats(tkwarn)
	} else {
		# Broadcast kick/ban msg, then kick/ban them
		incr stats(tkact)
		msgTK $name $wonid $warnleft $action
		sleep 3

		switch -exact -- $action {
			-1 { 
					execCmd "kick # $userid"
					myEcho DBUG "executed 'kick # $userid'"
			   }

			 0 {
					execCmd "exec banned.cfg"
					myEcho DBUG "executed 'exec banned.cfg'"
					execCmd "banid 0 $wonid kick"
					myEcho DBUG "executed 'banid 0 $wonid kick'"
					execCmd writeid
					myEcho DBUG "executed 'writeid'"
			   }

			 default {
					execCmd "banid $action $wonid kick"
					myEcho DBUG "executed 'banid $action $wonid kick'"
			 }
		}
	}
}

proc foundFoulLang { name uid wonid datavar } {
	global config exprs offenses stats exclude text
	upvar $datavar data

	proc foulMsg { name wonid datavar { type "" } { warn 0 }} {
		global config
		upvar $datavar data

		if ![cequal $config(foul${type}msg) ""] {
			regsub -all -- "%P" $config(foul${type}msg) $name mymsg
			regsub -all -- "%C" $mymsg $warn mymsg
			say $mymsg
			myEcho FOUL "$data"
			myEcho FOUL "\[WONID: $wonid\] $mymsg"
		}
	}

	if [cequal $exprs(foul) ""] return


	set name [preprocessName $name]

	# Get the IP
	if $config(banip) {
		lassign [getUserInfo userid $uid] x x x ip
		if [cequal $ip ""] {
			myEcho WARN "Couldn't process foul-language on '$name', no IP!"
			return
		}
		set wonid $ip
	}

	# Check to see if we should exclude them
	if $config(exclude) {
		if ![catch { set exclude($wonid) } err] {
			# They're excluded
			myEcho DBUG [format $text(144) "$name:$wonid"]
			return
		}
		myEcho DBUG "err on foul-lang exclude: $err"
	}

	# Check to see what 'level' this is -- need to check Level 1 first!
	if { ![cequal $exprs(foul1) ""] && [regexp -nocase -- $exprs(foul1) $data] } {
		# It's a level 1. handle it below.
	} elseif { ![cequal $exprs(foul2) ""] } {
		if [regexp -nocase -- $exprs(foul2) $data] {
			# It's a Level 2. See if they have any chances left
			if ![info exists offenses($wonid)] {
				# Their first offense.  Create the array entry.
				set offenses($wonid) $config(foulwarns)
			}

			incr offenses($wonid) -1

			if { $offenses($wonid) > 0 } {
				# They have chances left.  Warn them.
				foulMsg $name $wonid data warn $offenses($wonid)

				offenseTable write
				return
			}
		}
	}

	# If we got here, they ran out of chances or it's a level 1 offense.
	if ![catch { unset offenses($wonid) } err] { offenseTable write }
	incr stats(foul)

	foulMsg $name $wonid data
	sleep 3

	switch -exact -- $config(foulaction) {
		-1 { 
				execCmd "kick # $uid"
				myEcho DBUG "executed 'kick # $uid'"
		   }

		 0 {
		 		if $config(banip) {
					execCmd "exec listip.cfg"
					myEcho DBUG "executed 'exec listip.cfg'"
					execCmd "addip 0 $wonid"
					myEcho DBUG "executed 'addip 0 $wonid'"
					execCmd "kick # $uid"
					myEcho DBUG "executed 'kick # $uid'"
					execCmd "writeip"
					myEcho DBUG "executed 'writeip"
				} else {
					execCmd "exec banned.cfg"
					myEcho DBUG "executed 'exec banned.cfg'"
					execCmd "banid 0 $wonid kick"
					myEcho DBUG "executed 'banid 0 $wonid kick'"
					execCmd writeid
					myEcho DBUG "executed 'writeid'"
				}
		   }

		 default {
		 		if $config(banip) {
					execCmd "addip $config(foulaction) $wonid"
					myEcho DBUG "executed 'addip $config(foulaction) $wonid'"
					execCmd "kick # $uid"
					myEcho DBUG "executed 'kick # $uid'"
				} else {
					execCmd "banid $config(foulaction) $wonid kick"
					myEcho DBUG "executed 'banid $config(foulaction) $wonid kick'"
				}
		 }
	}
}

proc tableTK { op } {
	global tkcount config myhldir gameId after

	set fname $myhldir/$gameId/hlds_ld.tks

	switch -exact $op  {
		sched {
			# Only schedule if we have a decay configured
			if [cequal $config(tkdecay) 0] return
			catch { after cancel $after(tk) }
			if [catch {
					after [expr $config(tkdecay) * 1000] { tableTK decay }
				} rc] {
					myEcho ERR [format $text(119) $rc]
			} else {
				set after(tk) $rc
			}
		}

		decay {
			foreach id [array names tkcount] {
myEcho DBUG "decayed tkcount for $id"
				incr tkcount($id) -1
				if [cequal $tkcount($id) 0] {
					unset tkcount($id)
				}
			}

			tableTK write
			catch { after cancel $after(tk) }
			tableTK sched
		}

		write {
			if [catch {open $fname w} fd] return 

			foreach id [array names tkcount] { puts $fd "$id $tkcount($id)" }

			close $fd
		}

		read {
			if [catch {open $fname r} fd] { myEcho DBUG "err: $fd" ; return }

			while 1 {
				set data [string trim [gets $fd]]
				if [eof $fd] break

				lassign $data id cnt
				set tkcount($id) $cnt
myEcho DBUG "assigned tkcount($id) to $cnt"
			}

			close $fd
		}
	}

	return
}

proc offenseTable { op } {
	global offenses config myhldir gameId after

	set fname $myhldir/$gameId/hlds_ld.offenses

	switch -exact $op  {
		sched {
			# Only schedule if we have a decay configured
			if [cequal $config(fouldecay) 0] return
			catch { after cancel $after(offenses) }
			if [catch {
					after [expr $config(fouldecay) * 1000] offenseTable decay
				} rc] {
					myEcho ERR [format $text(119) $rc]
			} else {
				set after(offenses) $rc
			}
		}

		decay {
			foreach id [array names offenses] {
myEcho DBUG "decayed offenses for $id"
				incr offenses($id)
				if [cequal $offenses($id) $config(foulwarns)] {
					unset offenses($id)
				}
			}

			offenseTable write
			catch { after cancel $after(offenses) }
			offenseTable sched
		}

		write {
			if [catch {open $fname w} fd] return

			foreach id [array names offenses] { puts $fd "$id $offenses($id)" }

			close $fd
		}

		read {
			if [catch {open $fname r} fd] { myEcho DBUG "err: $fd" ; return }

			while 1 {
				set data [string trim [gets $fd]]
				if [eof $fd] break

				lassign $data id cnt
				set offenses($id) $cnt
myEcho DBUG "assigned offenses($id) to $cnt"
			}

			close $fd
		}
	}
}


proc cleanWonip {} {
	global uidip userInfo after

	catch { after cancel $after(cleanuidip) }
	catch { unset after(cleanuidip) }

	if $uidip(refresh) { 
		myEcho DBUG "### skipping clean, we need a refresh..."
		set after(cleanuidip) [after 10000 cleanWonip]
		return
	}

	set uidips [array names uidip]
	set uids   $userInfo(userid)

	set gone [lindex [intersect3 $uidips $uids] 0]

	foreach id $gone {
		if [cequal $id refresh] continue
		myEcho DBUG "### cleaning id: $id"
		unset uidip($id)
	}
}

proc calcMapTimeRem {} {
	global svrInfo config text

	set maprem 0

	if $svrInfo(mapstart) {
		set maprem ""

		set secs [expr [expr $svrInfo(maptime) + $config(minhack)] * 60]

		set mapsec [expr [expr $svrInfo(mapstart) + $secs] - [clock seconds]]

		set mapsec [expr int($mapsec)]

		incr mapsec -5

		if { $mapsec > 0 } {
			set maprem $mapsec
		} else {
			set maprem "+[expr abs($mapsec)]"
		}
	}

	set svrInfo(maprem) $maprem
}

proc fmtTimer {} {
	global svrInfo text
	if [cequal $svrInfo(maprem) 0] {
		set maprem ??:??
	} elseif ![ctype digit $svrInfo(maprem)] {
		set maprem $svrInfo(maprem)
	} else {
		set maprem ""
		set mapsec $svrInfo(maprem)
		set maphr  [expr $mapsec / 3600]
		if $maphr { set maprem "$maphr:" }

		set mapmin [expr [expr $mapsec / 60] % 60]
		set mapsec [format %02d [expr $mapsec % 60]]

		append maprem $mapmin:$mapsec
	}

	return $maprem
}

proc getMapTimeRem {} {
	global fds svrInfo exprs text gameId config

	# Only works for TFC, FLF and DoD
	if { [regexp tfc $gameId] || [regexp frontline $gameId] || \
		 [regexp dod $gameId] } {
		# Make sure timelimit != 0
		if [cequal $svrInfo(maptime) 0] return

		set timeleft [getServerVariable mp_timeleft]

		# Convert to integer so things don't blow up.
		# If this fails, assume time is unlimited.
		if [catch {expr int($timeleft)} time] {
			myEcho ERR "Couldn't convert mp_timeleft '$timeleft' to integer: $time"
		} else {
			if { $config(debug) > 1 } {
				myEcho DBUG "timeleft calc: "
				myEcho DBUG "   now     = [clock seconds]"
				myEcho DBUG "   maptime = $svrInfo(maptime)"
				myEcho DBUG "   mapsecs = [expr $svrInfo(maptime) * 60]"
				myEcho DBUG "   timelef = $timeleft"
				myEcho DBUG "   start   = $start"
			}

			set start [expr [clock seconds] - (($svrInfo(maptime) * 60) - $timeleft)]
			set svrInfo(mapstart) $start
			calcMapTimeRem

			#if [ctype digit $svrInfo(maprem)] { scheduleVoting }
		}
	}
}

# Get the value of a server variable (e.g. mp_timelimit)
#
proc getServerVariable { var } {
	global fds exprs

	# Set up the command and expression to parse the return
	set cmd $var
	regsub -all -- "%V" $exprs(varquery) $var expr

	# Sometimes we miss it...
	loop j 0 3 {
		slurpLogFile
		execCmd $cmd

		select {} {} {} 0.5

		set rc NULL
		set cnt 0
		while 1 {
			set data [gets $fds(logfd)]
			if [regexp $expr $data foo rc] { break }
			processLogLine data 1
			if { $cnt > 10 } { break }
			sleep 1
			incr cnt
		}

		if ![cequal $rc NULL] {
			set len [clength $rc]
			set rc [csubstr $rc 0 [expr $len-1]]
			break
		}
	}

	if [cequal $rc NULL] { set rc "" }

	return $rc
}

proc checkForPassword {} {
	global config protected exprs

	if !$config(checkpass) return

	set svrPass [getServerVariable sv_password]
	if [cequal $svrPass "\""] { set svrPass "" }

	if [cequal $svrPass ""] {
		myEcho DBUG "Server is NOT password protected."
		set protected 0
	} else {
		myEcho DBUG "Server IS password protected."
		set protected 1
	}
}
		

proc getMapTime {} {
	global fds svrInfo exprs text

	set svrInfo(maptime) [getServerVariable mp_timelimit]
	if [cequal $svrInfo(maptime) ""] { set svrInfo(maptime) 0 }

	# Convert to integer so things don't blow up.
	# If this fails, assume time is unlimited.
	if [catch {expr int($svrInfo(maptime))} time] {
		myEcho ERR "Couldn't convert mp_timelimit '$svrInfo(maptime)' to integer: $time"
		set time 0
	}

	set svrInfo(maptime) $time

	calcMapTimeRem
}

# this gets executed when the map has changed
proc newMap {} {
	global svrInfo config myhldir fds gameId after vote after initializing
	global text votes tkcache team wlimit wwarn

	if [cequal $svrInfo(map) ""] {
		return
	}

	# Should we run custom config file?
	if $config(cm) {
		# Run custom config file if it's there...
		set cfgfile $myhldir/$gameId/$svrInfo(map).cfg
		if [file exists $cfgfile] {
			execCmd "exec $svrInfo(map).cfg"
			myEcho INFO [format $text(44) $svrInfo(map)]
		}
	}

	getMapTime
	checkForPassword

	set svrInfo(orglimit) $svrInfo(maptime)

	if !$initializing { set svrInfo(mapstart) [clock seconds] }
	set initializing 0

	# Set up our weapon-limits if so configured
	if $config(weaponlimit) {
		# Zero out anything left-over from last map
		set wlimit ""
		foreach warn [array names wwarn] { catch { unset wwarn($warn) }}

		# Look for map-specific weapon.cfg
		set fname "$myhldir/$gameId/maps/$svrInfo(map)_weapon.cfg"
		if [catch { open $fname r } weaponfd] {
			myEcho DBUG "$weaponfd"
			myEcho DBUG "Default weapons will be used."
			set wlimit $config(weapondefault)
		} else {
			myEcho INFO "Limiting weapons as specified in $fname"
			while 1 {
				set weapon [string trim [gets $weaponfd]]
				if [eof $weaponfd] break
				if ![cequal $weapon ""] {
					lappend wlimit $weapon
				}
			}
		}

		myEcho DBUG "Weapon limits for $svrInfo(map) are '$wlimit'"

		# Schedule our broadcast message
		catch { after cancel $after(weapon) }
		set after(weapon) [after 60000 {
			# Only broadcast if ppl are connected and there is a limit on weapons
			if { [llength $userInfo(users)] && ![cequal $wlimit ""] } {
				regsub -all -- "%M" $config(weaponmsg) $svrInfo(map) myMsg
				say $myMsg
				say $wlimit
			}
		}]
	}


	# Send messages to all customers after 3 minutes
	catch { after cancel $after(map) }
	set after(map) [after 180000 { 
		# Only broadcast msgs if ppl are conneted
		if [llength $userInfo(users)] {
			say [format $text(67) $svrInfo(map) $svrInfo(maptime)]
			say [format $text(68) [getNextMap $svrInfo(map)]]
			if ![cequal $config(serverMsg) ""] {
				if $config(fortune) {
					sayFortune
				} else {
					sayServerMsg
				}
			}
		}
	}]

	# Reset any active voting, map has changed
	catch { after cancel $after(tally) }
	catch { after cancel $after(vote)  }
	set vote(insession) 0

	statusBar "<[replicate - 20] $svrInfo(map) [replicate - 20]>"

	# Schedule a new voting session
	set after(vote) [scheduleVoting] 

	# This is required for Cstrike, maybe others...won't hurt I suppose
	myEcho DBUG "Setting mp_logmessages 1..."
	execCmd "mp_logmessages 1"
}

proc sayServerMsg {} {
	global config

	say $config(serverMsg)
}

proc sayFortune {} {
	global svrInfo config

	if [catch { exec $config(fortunepath) -s } fortune] {
		myEcho ERR "Error getting fortune: $fortune"
		sayServerMsg
	} else {
		set svrLen [clength $svrInfo(name)]
		set max 85 ;# Max # of chars that HL will display to client

		foreach line [string trim [split $fortune "\n"]] {
			if { [expr [clength $line] + $svrLen] > $max } {
				# bust the last three words off
				set words [split $line " "]
				set last [expr [llength $words] - 3]
				set line2 [join [lrange $words $last end]]
				incr last -1
				set line1 [join [lrange $words 0 $last]]
				say $line1
				say $line2
			} else {
				say $line
			}
		}
	}
}

proc getLog { id { update 1 } { model 0 } } {
	global fds text exprs

	while 1 {
		set data [string trim [gets $fds(logfd)]]
		if [eof $fds(logfd)] return ""

		if $model {
			# We're looking for a model or team.  Bots don't return this info.
			if [regexp $exprs(bot) $data] { return "-" }
		}

		if [cequal [csubstr $data 0 [clength $id]] $id] { return $data }
		processLogLine data 1 $update
	}
}

proc execCmd {{cmd ""}} {
	global fds serverUp text config

	if !$serverUp return

	if [cequal $cmd ""] return

	if { $config(debug) > 1 } {
		myEcho DBUG "Executing '$cmd'"
	}

	puts $fds(cmdfd) $cmd
	catch { flush $fds(cmdfd) }

	set mycmd [string tolower $cmd]
	if {[cequal $mycmd quit] || [cequal $mycmd exit]} {
		stopServer 0
	}
}

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

	myEcho INFO $text(45)

	set svrInfo(starttime) 0
	set svrInfo(expired) 0

	catch {wait -nohang}
        if $running {
			catch {
				myEcho DBUG "STOPPING THE SERVER WITH 'quit' COMMAND"
				puts $fds(cmdfd) quit
				catch { 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
                sleep 1
        }

        if { $i >= $wait } {
                # Kill it
                catch {kill 2 $fds(pidnum)}
                sleep 1
                catch {kill 9 $fds(pidnum)}
                catch {wait -nohang}
				statusBar [format $text(99) [now]]
        }

        serverDown

        statusBar [format $text(97) [now]]
}

proc now { { clock "" } } {
	set fmt "%a %b %d - %T"

	if [cequal $clock ""] {
		set time [clock format [clock seconds] -format $fmt]
	} else {
		set time [clock format $clock -format $fmt]
	}

	return $time
}

proc checkForHungServer {} {
	global fds config text

	execCmd port

	sleep 5

	set data [gets $fds(logfd)]

	# If some other log entry snuck in then process it...
	if ![cequal [csubstr $data 1 4] port] {
		processLogLine data 1
	}

	# Ouch.  No data there!
	if [eof $fds(logfd)] {
		sendClient ERR [format $text(46) [now]]
		myEcho     ERR [format $text(46) [now]]

		stopServer 1 2
		if $config(rs)  {
			sleep $config(rsDelay)
			launchServer
		}

		return 1
	}

	return 0
}

# Check to see if we need to reload anything
proc checkReload {} {
	global modified myhldir gameId text

	set files [list cfg txt badwords exclude teammap] 

	if ![info exists modified(cfg)] {
		# First time here, initialize the array
		foreach type $files {
			if [cequal $type txt] {
				set fname hlds_ld.$type
			} else {
				set fname $myhldir/$gameId/hlds_ld.$type
			}
			if [catch {file mtime $fname} modified($type)] {
				set modified($type) 0
			}
		}
	} else {
		foreach type $files {
			if [cequal $type txt] {
				set fname hlds_ld.$type
			} else {
				set fname $myhldir/$gameId/hlds_ld.$type
			}

			if [catch {file mtime $fname} mtime] {
				set modified($type) 0
			} else {
				if { $mtime != $modified($type) } {
					myEcho INFO [format $text(48) $type]
					switch -exact -- $type {
						cfg      { readConfig   }
						txt      { readText     }
						badwords { readBadwords }
						exclude  { readExclude  }
						teammap  { readTeammap  }
					}
					set modified($type) $mtime
				}
			}
		}
	}
}

proc tcldebugOn {} {
	global fds text gameId

	if ![info exists fds(tcldebug)] {
		# Set everything up if this is our first time here
		set fds(tcldebug) "$gameId/hlds_ld.debug"
		myEcho INFO [format $text(134) $fds(tcldebug)]
		if [catch { open $fds(tcldebug) w } fds(tcldebugfd)]  {
			myEcho ERR [format $text(135) $fds(tcldebug)] 
			myEcho ERR $fds(tcldebugfd)
			set config(tcldebug) 0
		} else {
			puts $fds(tcldebugfd) [format $text(136) [now]]
			cmdtrace on $fds(tcldebugfd)
		}
	} else {
		catch { close $fds(tcldebugfd) }
		catch { file rename -force $fds(tcldebug) $fds(tcldebug).old }

		if [catch { open $fds(tcldebug) w } fds(tcldebugfd)]  {
			myEcho ERR [format $text(135) $fds(tcldebug)] 
			myEcho ERR $fds(tcldebugfd)
			set config(tcldebug) 0
		} else {
			puts $fds(tcldebugfd) [format $text(136) [now]]
			cmdtrace on $fds(tcldebugfd)
		}
	}
}

proc tcldebugOff {} {
	global fds text

	# Disable tracing
	cmdtrace off

	catch { puts  $fds(tcldebugfd) [format $text(137) [now]] }
	catch { close $fds(tcldebugfd) }
}
	

proc getServerStatus {{reschedule 1} {force 0}} {
	global fds svrInfo userInfo config serverUp notIdle exprs text
	global gameId myhldir vote after uidip lastrotate

	checkReload

	# Check to see if we should rotate the log file
	if $config(autorotate) {
		set today [clock format [clock seconds] -format %a]
		if ![cequal $today $lastrotate] {
			cycleLogFile
			set lastrotate $today
		}
	}

	# If tcl-debugging is on, cycle the log file
	if $config(tcldebug) {
		# Cycle log file if we're at level 1
		if [cequal $config(tcldebug) 1] {
			tcldebugOff
			tcldebugOn
		}
	} else {
		tcldebugOff
	}


	if !$serverUp { return }

	# Check to see if 'modmax' is expired
	if { $config(modmax) && $svrInfo(starttime) && !$svrInfo(expired) } {
		set runtime [expr [clock seconds] - $svrInfo(starttime)]
		set maxsecs [expr $config(modmax) * 60]
		myEcho DBUG "Server has been running for $runtime seconds. Max=$maxsecs"
		if { $runtime > $maxsecs } {
			set msg [format $text(180) $gameId $config(modmax)]
			myEcho INFO $msg
			say $msg

			if $config(modswitch) {
				set msg [format $text(181) $config(modprimary)]
				myEcho INFO $msg
				say $msg
				set svrInfo(expired) 1
			} else {
				set msg [format $text(183) $config(modprimary)]
				myEcho INFO $msg
				say $msg
				tallyVotes $config(modprimary)
				return
			}
		}
	}

	catch { after cancel $after(gs) }
	catch { after cancel $after(pl) }

	set uidip(refresh) 0

	# Slurp any data we might've missed
	slurpLogFile

	if { !$force && !$notIdle } {
		if [checkForHungServer] return

		#statusBar [format $text(98) [now]]
		sendClient STATUS
		if $reschedule {
			set after(gs) [after [expr $config(refresh) * 1000] getServerStatus]
		}
		processLogFile 1
		return
	}

	set notIdle 0

	set svrInfo(name) ""
	set svrInfo(ip) ""
	set svrInfo(map) ""
	set svrInfo(player) 0
	set svrInfo(max) 0

	slurpLogFile
	execCmd $config(statuscmd)

	select {} {} {} 0.5

	# Process output from 'status' command
	# Get hostname
	set data [getLog hostname]
	set svrInfo(name) [string trim [csubstr $data 10 end]]

	if { ![cequal $svrInfo(name) ""] && !$serverUp } { serverUp }

	set data [getLog tcp/ip 0]
	getDataSep $data tcp/ip : svrInfo(ip)

	set data [getLog map 0]
	getDataSep $data map : map

	set data [getLog players 0]
	getDataSep $data players : players

	if [info exists map] {
		set svrInfo(map) [lindex $map 0]
	}

	if [info exists players] {
		set svrInfo(player) [lindex $players 0]
		regsub -all -- "\\(" [lindex $players 2] \
			"" svrInfo(max)
	}


	clearUserInfo

	# For each player, get their data
	set data [getLog "#"]
	set myPlayerCnt 0
	while 1 {
		set playerList ""
#      name id wonid adr frag time ping drop address
		set data [gets $fds(logfd)]
		if ![regexp "^#" $data] { break }
		incr myPlayerCnt

		set data [csubstr $data 3 end]

		set list [split $data " "]
		foreach el $list {
			if ![cequal $el ""] { lappend playerList $el }
		}

		# playerList should be 10 entries UNLESS	
		#	- they have spaces in their name
		set len [llength $playerList]
		set idx 1
		set myLen [expr $config(statusfields) - 2]

		if { $config(debug) > 1 } {
			myEcho DBUG "### data  = $data"
			myEcho DBUG "### len   = $len"
			myEcho DBUG "### mYlen = $myLen"
		}

		if { $len > $myLen } {
			# skip idx ahead to userid
			set idx [expr $len - [expr $myLen - 1]]
			incr idx -1

			# Get the name
			set name [join [lrange $playerList 0 $idx] " "]

			incr idx
		} else {
			set name [lindex $playerList 0]
		}

		set userid [lindex $playerList $idx]
		set wonid  [lindex $playerList [incr idx]]
		# TODO: what the hell is 'adr'?
		set frags  [lindex $playerList [incr idx]]
		set time   [lindex $playerList [incr idx]]
		set ping   [lindex $playerList [incr idx]]

		# skip 'drop'
		incr idx

		# Get IP and remove port #
		set ip [lindex $playerList [incr idx]]
		set ip [lindex [split $ip :] 0]

		if [ctype digit $ping] {
			if { $ping > 9999 } { set ping 9999 }
		}

		if { $config(debug) > 1 } {
			foreach x "name userid wonid ip frags time ping" {
				myEcho DBUG "$x: [set $x]"
			}
			myEcho DBUG "--------------------------------"
		}

		if !$config(ipfromstats) {
			set ip ""
			# Figure out their IP from the array we built from 'connected' msgs
			if [catch { set ip $uidip($userid) } err] { 
				global debugip
				if ![info exists debugip($userid)] {
					myEcho DBUG "$name: ip unknown:"
					myEcho DBUG "ip determine err is $err"
					set debugip($userid) 1
				}
				if ![cequal $name ""] { set ip unknown }
			}
		}

		# Bots have wonid=0 and don't have IP addressess...
		#if { [cequal $wonid 0] && [cequal $ip ""] } { set ip "127.0.0.1" }
		if [cequal $ip ""] { set ip "127.0.0.1" }

		lappend userInfo(users)  $name
		lappend userInfo(userid) $userid
		lappend userInfo(wonid)  $wonid
		lappend userInfo(frags)  $frags
		lappend userInfo(times)  $time
		lappend userInfo(pings)  $ping
		lappend userInfo(ips)    $ip
		lappend userInfo(team)   [getPlayerTeam $userid]
	}

	# Process the line that we broke out of the loop on...
	if ![cequal $data ""] {
		processLogLine data 1
	}

	# How annoying.  'status' doesn't show players that are connecting.
	# parse 'user' as well.  Sigh.
	if ![cequal $myPlayerCnt $svrInfo(player)] {
		slurpLogFile
		execCmd users

		select {} {} {} 0.5

		getLog userid
		gets $fds(logfd)

		loop i 0 $svrInfo(player) {
			set data [string trim [gets $fds(logfd)]]
			if [regexp $exprs(endusers) $data] {
				# Reached end of user list.  Probably have bots - bail. 
				break
			}

			if [regexp $exprs(users) $data foo myUid myWonid myName] {

				# USERS: Account for users with " : " in their names (sigh)
				set l [split $data :]
				if { [llength $l] > 3 } {
					set myUid   [string trim [lvarpop l]]
					set myWonid [string trim [lvarpop l]]
					set myName  [string trim [join $l :]]
				}

				# Only append if they already haven't been...
				if [cequal [lsearch -exact $userInfo(userid) $myUid] -1] {
					# This user is connecting
					lappend userInfo(users)  $myName
					lappend userInfo(userid) $myUid
					lappend userInfo(wonid)  $myWonid
					lappend userInfo(frags)  0
					lappend userInfo(times)  00:00
					lappend userInfo(pings)  0
					lappend userInfo(ips)    CONNECTING
					lappend userInfo(team)   "-"
				}
			} else {
				processLogLine data 1
			}
		}

		# Pop off the "N users" line
		set data [gets $fds(logfd)]
		processLogLine data 1 0
	}

	getPlayerModels

	if $reschedule {
		set after(gs) [after [expr $config(refresh) * 1000] getServerStatus]
	}

	# Sometimes we get here without a map name, usually on a map change...
	if ![cequal $svrInfo(map) ""] {
		sendClient UPDATE [buildClientUpdate]
	} else {
		after cancel $after(gs)
		set after(gs) [after 2000 getServerStatus 1 1]
	}


	processLogFile 1
}

proc updateTeams {{update 1}} {
	global userInfo config

	set userInfo(team) ""
	foreach id $userInfo(userid) {
		if $config(getteam) {
			lappend userInfo(team) [getPlayerTeam $id]
		} else {
			lappend userInfo(team) "-"
		}
	}

	if $update { sendClient UPDATE [buildClientUpdate] }
}

proc getPlayerTeam { userid } {
	global team

	if [info exists team($userid)] {
		set myTeam $team($userid)
	} else {
		set myTeam "-"
	}

	return $myTeam
}

proc getPlayerModels {} {
	global userInfo svrInfo config exprs

	# If they don't want us looking for models, just initialize to "-"
	loop i 0 $svrInfo(player) { lappend userInfo(model) "-" }

	if !$config(getmodels) { return }

	# Get the model if possible.  We have to run the User command for each user.
	slurpLogFile
	set myPlayerCnt 0
	loop i 0 $svrInfo(player) {
		set myUserid [lindex $userInfo(userid) $i]
		set myAddr   [lindex $userInfo(ips) $i]

		# We only want models for players that are connected :)
		if [cequal $myAddr CONNECTING] continue

		execCmd "user $myUserid"

		set idx($myPlayerCnt) $i
		incr myPlayerCnt
	}

	select {} {} {} 1

	set i 0
	set j 0
	while { $i < $myPlayerCnt } {
		# Just in case...
		if { $j > 2 } break

		# Valve team halflife will return a team tag from the user command.
		# TFC, and CS do not, so just use the model tag.
		# I don't know if model and team are always the same...
		set data [getLog model 0 1]
		if [cequal $data ""] {
			# If we got no data then the server is still spewing output,
			# so wait for it to finish...
			myEcho DBUG "Waiting for server to finish output on getmodel, i = $i, j = $j"
			sleep 1
			incr j
			continue
		} else {
			set j 0
		}

		if [regexp $exprs(parsemodel) $data foo myModel] {
			set myModel [string trim $myModel]
		} else {
			set myModel "-"
		}

		# If we should ever use the team tag set the "if 0" to "if 1"
		if 0 {
			set data [getLog team 0 1]
			if [cequal $data ""] {
				# If we got no data then the server is still spewing output,
				# so wait for it to finish...
				myEcho DBUG "Waiting for server to finish output on getmodel, i = $i, j = $j"
				sleep 1
				incr j
				continue
			} else {
				set j 0
			}

			if [regexp $exprs(parseteam) $data foo myTeam] {
				set myModel [string trim $myTeam]
			} else {
				set myModel "-"
			}
		}

		# Replace the "-" for this player with the real model
		set userInfo(model) \
			[lreplace $userInfo(model) $idx($i) $idx($i) $myModel]

		if [ifFLF] {
			# Set the team for this player based on the model
			set first4 [csubstr $myModel 0 4] 
			if [cequal $first4 nato] {
				set myTeam R
			} elseif [cequal $first4 axis] {
				set myTeam C
			} else {
				set myTeam -
			}
			set userInfo(team) \
			[lreplace $userInfo(team) $idx($i) $idx($i) $myTeam]
		}

		if [ifDoD] {
			# Set the team for this player based on the model
			set first4 [csubstr $myModel 0 4] 
			if [cequal $first4 alli] {
				set myTeam AL
			} elseif [cequal $first4 axis] {
				set myTeam AX
			} else {
				set myTeam -
			}
			set userInfo(team) \
			[lreplace $userInfo(team) $idx($i) $idx($i) $myTeam]
		}

		incr i
		set j 0
	}

	# Clean out extra lines so they don't clutter tool output.
	# Last tag in valve is team.
	# This will get EOF in TFC, no problem :-)
	getLog team 0
}

proc clearUserInfo {} {
	global userInfo

	set userInfo(users)  ""
	set userInfo(pings)  ""
	set userInfo(frags)  ""
	set userInfo(times)  ""
	set userInfo(ips)    ""
	set userInfo(wonid)  ""
	set userInfo(userid) ""
	set userInfo(model)  ""
	set userInfo(team)   ""
}

proc getUserInfo { intype inval } {
	global userInfo

	set idx -1

	# Should fall out of this switch with idx set
	switch -exact -- $intype {
		name {
			set name $inval
			if [catch { lsearch -exact $userInfo(users) $name } idx] {
				myEcho ERR "Error searching users: '$userInfo(users)'"
				myEcho ERR "Name search was: '$name'"
				set idx -1
			}
			if [cequal $idx -1] {
				# Do some funky things to really find the name
				set myname $name
				regsub -all ""  $name "\\" name
				regsub -all " " $name " \*" name
				if [catch {lsearch -regexp $userInfo(users) $name} idx] {
					myEcho ERR "Error searching users: '$userInfo(users)'"
					myEcho ERR "Name search was: '$name'"
					set idx -1
				}

				if ![cequal $idx -1] {
					myEcho WARN "Found index for '$myname'/'$name' using regexp"
					myEcho WARN "Names  : '$userInfo(users)'"
					myEcho WARN "USERids: '$userInfo(userid)'"
				} else {
					myEcho ERR "Unable to get index for '$myname'/'$name'"
					myEcho ERR "Names  : '$userInfo(users)'"
					myEcho ERR "USERids: '$userInfo(userid)'"
					return -1
				}
			}
		}

		userid {
			set idx [lsearch -exact $userInfo(userid) $inval]
			if [cequal $idx -1] {
				myEcho ERR "Unable to get index for '$intype'/'$inval'"
				myEcho ERR "$intype  : '$userInfo($intype)'"
				return -1
			}
		}

		wonid {
			set idx [lsearch -exact $userInfo(wonid) $inval]
			if [cequal $idx -1] {
				myEcho ERR "Unable to get index for '$intype'/'$inval'"
				myEcho ERR "$intype  : '$userInfo($intype)'"
				return -1
			}
		}

		default {
			error "Unsupported type in getUserInfo: $intype"
		}
	}

	set outval ""
	if [catch {
		lappend outval [lindex $userInfo(users) $idx]
		lappend outval [lindex $userInfo(userid) $idx]
		lappend outval [lindex $userInfo(wonid) $idx]
		lappend outval [lindex $userInfo(ips) $idx]
		} ] {
			myEcho ERR "Error getting user info based on $intype: $outval"
			myEcho ERR "Input value was $inval"
			myEcho ERR "Input : $userInfo($intype)"
			return -1
		}

	# This function returns a 4-element list:
	# 0 = name
	# 1 = userid
	# 2 = wonid
	# 3 = ip

	return $outval
}

proc buildClientUpdate {} {
	global svrInfo userInfo config vote  text

	set kl ""

	foreach id "users pings frags times ips userid wonid model team" {
		keylset kl $id $userInfo($id)
	}

	keylset kl map  $svrInfo(map)
	keylset kl cnt  $svrInfo(player)

	if $vote(insession) {
		keylset kl vote 2
	} else {
		keylset kl vote $config(vote)
	}

	return $kl
}


proc getDataSep { data key sep var } {
	upvar $var myvar

	set foo [split $data $sep]
	set theirkey [string trim [lindex $foo 0]]
	set theirdat [string trim [lindex $foo 1]]

	if [cequal $theirkey $key] { 
		set myvar $theirdat
	}

}
	
proc getMaps {} {
	global myhldir gameId config mapList mapMtime text
	set builtins $config(maps)

	if ![info exists mapMtime] {
		set mapMtime 0
	}


	set mapdir $myhldir/$gameId/maps

	# If no map-dir, then just return builtins
	if ![file exists $mapdir] {
		return $builtins
	}

	set mtime [file mtime $mapdir]

	# If mapdir has changed, re-read into cache
	if ![cequal $mtime $mapMtime] {
		if [catch {glob $mapdir/*.{bsp,BSP}} mapList] { set mapList "" }

		foreach map $mapList {
			set map [crange $map 0 end-4]; # Strip off '.bsp'
			lappend builtins [file tail $map]
		}

		# Update cache
		set mapList [lsort -decreasing -ascii [lrmdups $builtins]]
		set mapMtime $mtime
	}

	return $mapList
}

proc startupMessages { vnum gameId } {
	global config fds text tcl_version myhldir

	if ![cequal $text(0) $vnum] {
		myEcho ERR $text(1)
	}

	myEcho INFO [format $text(2) $vnum [pid]]
	myEcho INFO $text(3)
	myEcho INFO $text(4)
	myEcho INFO $text(5)
	myEcho INFO [format $text(152) $tcl_version]
	myEcho INFO [format $text(153) $myhldir]
	myEcho INFO $text(108)
	myEcho INFO $text(141)
	myEcho INFO $text(168)
	myEcho INFO [format $text(6) $gameId $myhldir/$gameId]

	myEcho INFO [replicate - 45]
	myEcho INFO $text(113)
	foreach key [lsort [array names config]] {
		set cfg $config($key)
		if [cequal $key usrauth]      { set cfg "***PROTECTED***" }
		if [cequal $key admauth]      { set cfg "***PROTECTED***" }

		myEcho INFO [format "% 14s = '%s'" $key $cfg]
	}
	validateConfig
	myEcho INFO [replicate - 45]

	if [cequal $config(admauth) ""] {
		myEcho INFO $text(111)
		myEcho INFO $text(112)
	} else {
	if $config(localmode) {
		myEcho INFO $text(7)
	} elseif $config(localadmin) {
		myEcho INFO $text(8)
	} elseif ![cequal $config(admauth) ""] {
		myEcho INFO $text(9)
	}
	}
}

proc usage {} {
	puts stderr "
Usage: hlds_ld \[game\]

Where game = a MOD name.  (e.g. tfc or cstrike)
             If blank, manage standard (valve) half-life server.
"
	exit 1
}

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
}

proc readTeammap {} {
	global text myhldir vnum fds teammap

	if [catch {open $fds(teammap) r} fd] {
		myEcho INFO "Couldn't open teammap file: '$fd'"
		return
	}

	myEcho DBUG "Successfully opened teammap file."
	while 1 {
		if [eof $fd] break
		set data [string trim [gets $fd]]
		if [cequal $data ""] continue

		set list [split $data "="]
		if { [llength $list] != 2 } continue

		lassign $list left right
		set left [string tolower $left]

		set teammap($left) $right
		myEcho DBUG "Will display team '$left' as '$right'"
	}

	close $fd
}

proc daemonize {} {
	if [catch {fork} pid] {
		puts stderr [format $text(84) $pid]
		exit 1
	}

	if $pid {
		# Parent
		echo [format $text(85) $pid]
		exit 0
	}

	return
}

#######################################################################
# MAIN
#
proc main { argc argv } {
   global lbxs vnum config gameId myhldir fds serverUp text env

	if ![info exists env(HLDIR)] {
		puts stderr "Environment variable HLDIR doesn't exist!"
		puts stderr "Please set HLDIR to your half-life directory."
		usage
	}
	set myhldir $env(HLDIR)

	if ![file isdir $myhldir] {
		puts stderr "Couldn't find HLDIR directory '$myhldir'"
		usage
	}

	cd $myhldir

	# Stop maplist code from blowing up
	if ![file exists maps] { 
		catch {file mkdir maps}
		chmod 0777 maps
	}


	initStats

	readText

   	if $argc {
		if { $argc > 1 } usage
		set gameId $argv
		if ![file isdir $myhldir/$gameId] {
			puts stderr [format $text(86) $gameId $myhldir]
			usage
		}
	} else {
		set gameId valve
	}


	if ![file exists $myhldir/$gameId/oldlogs] {
		catch {file mkdir $myhldir/$gameId/oldlogs}
		chmod 0777 oldlogs
	}

	# Check to see if hlds_ld is already out there
	set fds(myPid) $myhldir/$gameId/hlds_ld.pid
	if [file exists $fds(myPid)] {
	set pid [read_file $fds(myPid)]
	if ![catch {kill 0 $pid} err] {
		# Probably already running!
		puts stderr [format $text(87) $gameId $pid]
		puts stderr [format $text(88) $fds(myPid)]
		myExit 2
	}
	}

	readConfig
	if $config(tcldebug) tcldebugOn

	#daemonize

	write_file $fds(myPid) [pid]

	set fds(pid)   $myhldir/$gameId/hlds_l.pid
	set fds(cmd)   $myhldir/$gameId/hlds_l.cmd
	set fds(log)   $myhldir/$gameId/hlds_l.log
	set fds(mylog) $myhldir/$gameId/hlds_ld.log
	set fds(adminlog) $myhldir/$gameId/hlds_ld.admin
	set fds(teammap)  $myhldir/$gameId/hlds_ld.teammap

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

	set fds(mylogfd) [open $fds(mylog) w]

	setExprsNew
	startupMessages $vnum $gameId

	clearUserInfo
	readBadwords
	readExclude
	readTeammap
	offenseTable read
	offenseTable sched
	tableTK read
	tableTK sched

	checkForServer

	doListen

	signalHandler
	if { !$serverUp && $config(autostart) } launchServer

	if $serverUp { 
		getMapTime
		getMapTimeRem
	}

	mainloop
}

# Set up all regular expressions in one place so that I can keep myself
# sane ;)
proc setExprsNew {} {
	global exprs

	# (1) Connection
	# returns playerinfo and ip address (port is trimmed off)
	set exprs(connected) "^L.*\"(.+)\" *connected, address *\"(.+):.+\""

	# (2) Enter game

	# (3) Disconnection
	set exprs(disconnected) "^L.*\"(.+)\" *disconnected"

	# (4) Suicide

	# (5) Team selection
	#
	# returns the following:
	#	1 = player info
	#	2 = team name
	set exprs(team) "^L.*\"(.+)\" *joined team *\"(.+)\""

	# (6) Role selection
	#
	# returns the following:
	#	1 = player info
	#	2 = role
	set exprs(role) "^L.*\"(.+)\" *changed role to *\"(.+)\""

	# (7) Change Name
	# returns the following:
	#	1 = player info (old name?)
	#	2 = new name
	set exprs(name) "^L.*\"(.+)\" *changed name to *\"(.+)\"$"

	# Events (8) killed, (9) attacked
	#
	# returns the following:
	#	1 = attacker info
	#	2 = attackee info
	#	3 = weapon name
	#	4 = properties (headshot, damage)
	set exprs(killed)   "^L.*\"(.+)\" *killed *\"(.+)\" *with *\"(\[^\"\]+)\"(.*)$"
	set exprs(attacked) "^L.*\"(.+)\" *attacked *\"(.+)\" *with *\"(\[^\"\]+)\"(.*)$"

	# (10) Player-to-Player action triggers
	#
	# returns the following:
	#	1 = trigger-er info
	#	2 = action
	#	3 = trigger-ee info
	#	4 = properties
	set exprs(ptopaction) "^L.*\"(.+)\" *triggered *\"(.+)\" *against *\"(.+)\"(.*)"
	set exprs(sgkill) "^L.*\"(.+)\" *triggered *\"Sentry_Destroyed\" *against *\"(\[^\"\]+)\"(.*)"

	# (11) Player-independent actions
	#
	# returns the following:
	#	1 = trigger-er info
	#	2 = action
	#	3 = properties
	set exprs(paction) "^L.*\"(.+)\" *triggered *\"(.+)\"(.*)"

	# (12) Team actions
	# returns the following:
	#	1 = team name
	#	2 = action
	#	3 = properties
	set exprs(taction) "^L.*Team \"(.+)\" *triggered *\"(.+)\"(.*)"

	# (13) World actions
	# returns the following:
	#	1 = action
	#	2 = properties
	set exprs(waction) "^L.*World *triggered *\"(.+)\"(.*)"

	# (14) Chat
	# returns the following:
	#	1 = player info
	#	2 = "say", "say_team"
	#	3 = what they said
	set exprs(chat) "^L.*\"(.+)\" *(say|say_team) *\"(.*)\"$"

	# (15) Team alliances

	# (16) Round-end team score

	# (17) Cvars
	# returns variable name and value
	set exprs(cvar) "^L.*Server cvar *\"(.+)\" *= *\"(.+)\""

	# (18) Start-of-map
	# Returns log file name.	
	set exprs(log) "^L.*Log file started.*file *\"(\[^\"\]+)\".*"

	# (19) Map change
	# Returns map name.
	set exprs(mapload)  "^L.*Loading *map *\"(\[^\"\]+)\""
	set exprs(mapstart) "^L.*Started *map *\"(\[^\"\]+)\""

	# (20) Rcon

	# (21) Server Name
	# Returns host name.
	set exprs(svrname) "^L.*Server name is *\"(.+)\""

	# MISCELLANEOUS

	# Player Info - use this on expressions above that return player information
	#
	# returns the following:
	#	1 = player name
	#	2 = uid
	#	3 = wonid
	#	4 = team
	set exprs(player) "(.+)<(\[0-9\]+)><(\[0-9\]+)><(.*)>"

	# Filters
	set exprs(ignore) "^PackFile|^NET_"
	set exprs(usercnt) "^\[0-9\]* users"

	# Refresh conditions
	set exprs(refresh) "entered the game$|onnected,|^Dropped|changed name|Creating bot"

	# Look for SZ_GetSpace, if it repeats then kill the server
	set exprs(szget) "^SZ_GetSpace"

	# Server messages
	set exprs(srvmsg) "^\<"

	set exprs(parsemodel) "^model (.+)"
	set exprs(parseteam)  "^team (.+)"
	set exprs(bot) "User not in server"

	set exprs(maplist) "^maplist *(.*)"
	set exprs(size)    "^size *(.+)$"
	set exprs(vote)    "^vote *(.+)$"

	set exprs(foul) "";# This is built by readBadwords
	set exprs(dropped) "^Dropped"
	set exprs(timechange) "^L.*\"mp_timelimit\" = .*|Rcon.*mp_timelimit.*"
	set exprs(varquery)  "\"%V\" is \"(.+)"

	set exprs(users) "(.+) : (.+) : (.+)"
	set exprs(endusers) "\[0-9\]* users"

	# Filter out team-based and rcon messages for non-admins that are
	# receiving text
	set exprs(txtfilter) "^[format %c 0x02]\\(TEAM\\)|^\[Rr\]con|Rcon:| say_team |sv_password|\\\[ADMIN\\\] User|\\\[ADMIN\\\] DEBUG|tfc_adminpwd"

	# Server messages
	set exprs(srvmsg) "^\<"
	set exprs(chatmode) "^[format %c 0x02]|^\<"
}


proc myEcho { type text } {
	global fds config

	if [cequal $text ""] {
		set text "You probably don't have the most recent hlds_ld.txt!"
		set type WARN
	}

	if [info exists config(debug)] {
		if { !$config(debug) && [cequal $type DBUG] } return
	}

	if ![info exists fds(mylogfd)] {
		echo $text
		return
	}

	puts $fds(mylogfd) "\[[now]\] ([format "%-4s" $type]) $text"
	catch { flush $fds(mylogfd) }
}

proc cycleLogFile {} {
	global fds text vnum gameId stats config myhldir

	if ![info exists fds(mylogfd)] return

	dumpStats
	myEcho INFO $text(109)

	close $fds(mylogfd)
	unset fds(mylogfd)

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

	set fds(mylogfd) [open $fds(mylog) w]

	myEcho INFO $text(110)
	myEcho INFO [format $text(115) $stats(start)]

	startupMessages $vnum $gameId
}

proc dumpStats { {bcast 0 } { fd "" } { auth 2 } } {
	global fds stats conns text config

	set txt [list [format $text(69) [now]]]
	lappend txt [format $text(70) $stats(start)]
	lappend txt [format $text(71) $stats(out)]
	lappend txt [format $text(72) $stats(in)]
	lappend txt [format $text(73) [expr $stats(in) + $stats(out)]]
	lappend txt [format $text(74) $stats(conns)]
	lappend txt [format $text(75) $stats(user)]
	lappend txt [format $text(76) $stats(admin)]

	set failed [expr $stats(conns) - [expr $stats(user) + $stats(admin)]]

	lappend txt [format $text(77) $failed]
	lappend txt [format $text(78) $stats(ips)]

	if $config(foulcheck) {
		lappend txt [format $text(120) $stats(foul)]
	}

	if $config(tkcheck) {
		lappend txt [format $text(123) $stats(tkwarn)]
		lappend txt [format $text(124) $stats(tkact)]
	}

	if $config(weaponlimit) {
		lappend txt [format $text(160) $stats(wwarn)]
		lappend txt [format $text(161) $stats(wact)]
	}

	lappend txt [format $text(79) $stats(crash)]

	# Non-admins shouldn't see active connections
	if { $auth > 1 } {
		lappend txt $text(80)

		set i 0
		foreach sock [array names conns] {
			if [cequal $sock fds] continue

			keylget conns($sock) addr addr
			keylget conns($sock) port port
			keylget conns($sock) auth auth

			lappend txt "### \[$sock\] - $addr:$port (auth=$auth)"
		}
	}

	foreach line $txt {
		if !$bcast { myEcho INFO $line }

		if $bcast { sendClient TEXT "[format %c 0x02]$line" $fd }
	}
}

proc initStats {} {
	global stats text

	set stats(start) [now] ;# When did daemon start

	set stats(out)   0     ;# How many bytes out
	set stats(in)    0     ;# How many bytes in

	set stats(conns) 0     ;# How many total connections (from hlds_ld clients)
	set stats(user)  0     ;# How many auth'ed as USER
	set stats(admin) 0     ;# How many auth'ed as ADMINISTRATOR
	set stats(ips)   ""    ;# What IPs did hlds_ld clients come from

	set stats(crash) 0     ;# How many times we crashed

	set stats(foul)  0     ;# How many users banned/kicked for foul language
	set stats(tkact) 0     ;# How many users banned/kicked for TKing
	set stats(tkwarn) 0    ;# How many warnings issued for TKing

	set stats(wwarn) 0    ;# How many warnings issued for weapon violation
	set stats(wact) 0     ;# How many users kicked for weapon violations
}

proc checkForExtendedTcl {} {
	if { [string length [info commands cequal]] > 0 } { return }

	puts stderr "The Tcl interpeter you are running is NOT an Extended Tcl"
	puts stderr "(TclX) interpreter."
	puts stderr "hlds_ld requires TclX.  Please install TclX and try again."
	puts stderr "BTW - The 'X' is for eXtended.  It has nothing to do with X-Windows."

	exit 1
}

proc initVars {} {
	global vote serverUp svrInfo conns lastrotate prevMap protected
	global last szcnt initializing notIdle killcache ignoretime wlimit

	clearUserInfo

	set vote(insession) 0

	set serverUp 0

	foreach id "name map logFile" { set svrInfo($id) "" }
	foreach id "mapstart kills player"  { set svrInfo($id) 0 }

	set conns(fds) ""

	set lastrotate [clock format [clock seconds] -format %a]

	set svrInfo(starttime) 0
	set svrInfo(expired) 0

	set prevMap ""
	set protected 0
	set last(timeleft) 0
	set last(nextmap) 0
	set last(maplist) 0
	set last(size) 0
	set last(vote) 0
	set szcnt 0

	set initializing 1

	set notIdle 1
	set killcache ""

	set ignoretime 0
	set wlimit ""
}

#######################################################################
# set some variables for use in the procs and call MAIN
#
checkForExtendedTcl
initVars

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

set vnum 1.50b2

main [llength $argv] $argv
