#!/usr/bin/tcl
#
# halfd.cgi - CGI script designed to communicate with halfd.
#
# Copyright (C) 2000 Rob Abbott
#
# Visit http://www.halfd.org for details on halfd
#
#
#   rabbott 2000-11-15   - Add optional 'model' and 'team' columns

######################################################################
# CHANGE THESE PARAMETERS TO REFLECT YOUR CONFIGURATION

# ssdir = directory where your screenshots are loaded
set ssdir  "/home/web/spielviel.de/halflife"

# ssurl = URL pointing to your screenshot directory
set ssurl  "/halflife"

# authstr = your USER authentication string
set authstr ""

# address = default address of the server running halfd
#           (may be overriden by CGI arguments)
set address "212.19.37.246:3001"


# The next three options are for the security-conscious.  Please set these
# appropriately!

# allow args
# determines whether the CGI header will be parsed for host:port
# 0 = args not allowed.  Probably the most secure way to do things.
# 1 = args ARE allowed.  Set allowed ports & hosts below.
set allow_args 0

# allowed ports (ignored if allow_args = 0)
# list all ports that you have halfd running on
# port numbers must be separated with spaces
set privports "3000 3001 3002 3003"

# allowed hosts (ignored if allow_args = 0)
# list all hosts that you have halfd running on.
# ip addresses must be separated with spaces
set privhosts "212.19.37.246"
######################################################################


######################################################################
# Colors, etc.
set bodyArgs "bgcolor=\"#3F3F3F\" text=\"#FFB43F\" link=\"#999999\" vlink=\"#C0C0C0\" alink=\"#E40000\""
set tableArgs "border=\"1\" cellspacing=\"0\" cellpadding=\"10\" width=\"92%\" bgcolor=\"black\" align=center"
######################################################################


######################################################################
# start of net code
proc connectToServer {} {
	global after sockFd gotInit connected clientOpts gotData tcl_platform

	set gotInit 0

	catch { after cancel $after(connect) }

	set plat $tcl_platform(platform)

	set needResched 0

	if !$connected {
		set addr $clientOpts(addr)
		set port $clientOpts(port)

		update idletasks

		if [cequal $plat unix] {

		# Use asynchronous connections.  Very cool.
		if [ catch {socket -async $addr $port} sockFd] {
			set connected 0
			set gotData 0
			return "Error connecting to $addr:$port : $sockFd"
		} else {
			# We need to be non-blocking until we're connected.
			fconfigure $sockFd -blocking 0

			# Now wait for it to connect
			fileevent $sockFd writable sockConnected
		}

		} else {

		# We're on windoze.  Use a blocking connection.  Gross.
		if [ catch { socket $addr $port} sockFd] {
			set connected 0
			set gotData 0
			return "Error connecting to $addr:$port : $sockFd"
		} else {
			# We're connected.
			set connected 1
			gotConnection
		}
		}
	}

	return ""
}

proc sockConnected {} {
	global sockFd clientOpts connected gotData

	set addr $clientOpts(addr)
	set port $clientOpts(port)

	# Delete the event
	fileevent $sockFd writable {}
	
	# Make sure we *really* connected
	if [catch { gets $sockFd } err] {
		set connected 0
			set gotData 0
		echo "Error connecting to $addr:$port : $err"
	} else {
		# Now we want to block
		fconfigure $sockFd -blocking 1
		set connected 1
		gotConnection
	}

	return ""
}

proc writeClientSock { data } {
	global sockFd clientOpts connected
	if !$connected return

	if [catch {
		flush $sockFd
		puts $sockFd $data
		flush $sockFd
	} err ] {
		echo "Error writing to socket: '$err'.\nDisconnecting."
		closeClientSock
	}
}

proc closeClientSock {} {
	global sockFd connected

	set connected 0

	catch { close $sockFd }

	echo "Closed connection to halfd"
	lostConnection
}

proc readClientSock {} {
	global sockFd

	if [catch { eof $sockFd } eof] {
		echo "Error reading from socket: $err"
		closeClientSock
		return
	}

	if $eof {
		echo "halfd dropped the connection!"
		closeClientSock
	} else {
		if [catch {gets $sockFd} data] {
			echo "Error reading from socket: $err"
			closeClientSock
		} else {
			# statusBar "Received [clength $data] bytes" 0
			processServerData $data $sockFd
		}
	}
}

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

proc gotConnection {} {
	global connected

	set connected 1
}

proc processServerData { data sockFd } {
	global gotData kl

	# Look for INIT, then UPDATE, then we're done
	append kl "$data "

	if [cequal [keylget data type] UPDATE] {
		set gotData 1
	}
}

proc fmtTimer { time } {
    if [cequal $time 0] {
        set maprem ??:??
    } elseif ![ctype digit $time] {
        set maprem $time
    } else {
        set maprem ""
        set mapsec $time
        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 http_time { seconds } {
	# Format time as:
	# Fri, 27 Nov 1998 13:50:41 GMT

	set fmt "%a, %d %B %Y %H:%M%S %Z"

	return [clock format $seconds -format $fmt]
}

###############################################################################
# HTML code is output from this procedure.  Muck with it all you want :)
###############################################################################
#
proc putServerInfo { kl } {
	global bodyArgs tableArgs ssdir ssurl

	foreach var "up name ip port max time data" {
		set $var ""
		keylget kl $var $var
	}

	foreach var "users pings frags times ips userid wonid model team map cnt vote" {
		set $var ""
		keylget data $var $var
	}

	set ifModel 0
	foreach mdl $model { if $ifModel { if ![cequal $mdl "-"] { set ifModel 1 } } }

	set ifTeam  0
	foreach tm  $team  { if $ifTeam { if ![cequal $tm  "-"] { set ifTeam  1 } } }

	echo "<html><head><title>SpielViel Counter-Strike Server Status</title></head>"
	echo "<body $bodyArgs>"

	# Check to see if the server is up or not...
	if !$up {
		puts "
	<table $tableArgs>
		<tr align=\"center\">
		<th><tt>Half-Life Server is Down!</tt></th>
		</tr>

		<tr align=\"center\">
		<td>The server is currently down.  Please try again later.</td>
		</tr>
	</table>"

	} else {

	# The server is up

	# Check to see if we have a screenshot
	if [file readable "$ssdir/${map}.jpg"] {
		set image    ${ssurl}/${map}.jpg
		set imagealt "\[$map Screenshot\]"
	} else {
		set image    "${ssurl}/tfc_default.jpg"
		set imagealt "\[No Screenshot Available\]"
	}

	# Expire the page after 20 mins
	set expire [http_time [clock seconds]]

	puts "
	<!-- Hmm.  You're viewing the html source.  This script is designed for
		  servers running halfd, a server management daemon for Linux
		  Half-Life servers.  More information available here:
		  http://www.halfd.org

		  Portions of this script based on hlmon.pl, available from
		  http://www.linuxquake.com/qsmon

		  Enjoy!
	-->

	<META NAME=\"expires\" CONTENT=\"$expire\">
	<META HTTP-EQUIV=\"expires\" CONTENT=\"$expire\"> "

	puts "
	<body $bodyArgs>
	<br>
	<center><font size=\"+1\"><b>$name</b></font></center>
	<br><br>
	<table $tableArgs>
	<tr>
	<td valign=\"top\"><p>
		<center><font size=\"+1\"><b>Server</b></font></center>
		<br>

		<table $tableArgs>"

	set descs [list "IP-Addresse" "Spieler / Max" Voting Map\
		"Verblei-<br>bende Zeit" Screenshot]

	switch -exact $vote {
		0 { set votestat "Ausgeschaltet" }
		1 { set votestat "Eingeschaltet" }
		2 { set votestat "Grade dabei..." }
	}
	
	set data  [list "$ip:$port" "$cnt / $max" $votestat $map [fmtTimer $time]\
		"<img src=\"$image\" width=150 height=113 alt=\"$imagealt\">"]

	# Dump the left side of the table
	set i 0
	foreach desc $descs {
		echo "		<tr>"
		echo "		<td><b>$desc</b></td>"
		echo "		<td>[lindex $data $i]<br></td>"
		echo "		</tr>"
		incr i
	}

	puts "
		</tr>
		</table>
	</td>

	<td valign=\"top\">
	<center><font size=\"+1\"><b>Spieler</b></font></center>
	<br>

	<table $tableArgs width=\"100%\">"

	# Check to see if there's more than 0 players and dump the right side of
	# the table
	if [cequal $cnt 0] {
		echo "<tr align=\"center\"><td colspan=6>Keiner da... :-(</td></tr>"
		echo "</table></table>"
	} else {
		puts "
		<tr>
		<td width=\"70%\" align=\"center\">
		<b>Name</b>
		</td>

		<td width=\"10%\">
		<b>Zeit</b></td>

		<td width=\"10%\">
		<b>Frags</b></td>
		
		<td width=\"10%\">
		<b>Ping</b></td>
		"

		if $ifModel {
			echo "<td width=\"10%\">"
			echo "<b>Model</b></td>"
		}

		if $ifTeam {
			echo "<td width=\"10%\">"
			echo "<b>Team</b></td>"
		}

		echo "<td width=\"10%\">"
		echo "<b>Status</b></td>"
		echo "</tr>"

		# Output the players
		set i 0
		foreach user $users {

			# Convert <> to &lt; &gt; in playername...
			regsub -all "\<" $user "\\&lt;" user
			regsub -all "\>" $user "\\&gt;" user

			echo "		<tr>"
			echo "		<td>$user</td>"
			echo "		<td>[lindex $times $i]</td>"
			echo "		<td>[lindex $frags $i]</td>"
			echo "		<td>[lindex $pings $i]</td>"
			if $ifModel { echo "		<td>[lindex $model $i]</td>" }
			if $ifTeam  { echo "		<td>[lindex $team  $i]</td>" }

			set ip [lindex $ips $i]
			if [cequal $ip CONNECTING] {
				set status Verbindet...
			} else {
				set status Aktiv
			}

			echo "		<td>$status</td>"
			echo "		</tr>"
			incr i
		}


		echo "</table>"
		#echo "*note - pings displayed may be higher than actual due to web traffic"
		echo "</table>"

	}

	echo "   <br><center>Statistics and CGI provided by"
	echo "   <a href=\"http://linuxhlds.halflife.org\">halfd</a></center>"
	echo "   <br><center>&Uuml;bersetzung by"
	echo "   <a href=\"mailto:uli@spielviel.de\">Uli</a></center>"
	}

}

proc textError { err } {
	puts "Content-type: text/plain\n\n"
	puts "An error occurred!\n\n'$err'"
	puts "\nPlease notify the administrator of this server and have them"
	puts "check the configuration of this script."
	puts "\nHit your 'reload' button to try this request again."
}

proc main { argc argv } {
	global address authstr clientOpts connected sockFd gotData kl
	global ssdir env privports privhosts allow_args

	set connected 0

	if $allow_args {
		# Check for CGI arguments
		if [info exists env(QUERY_STRING)] {
			if ![cequal $env(QUERY_STRING) ""] {
				set address $env(QUERY_STRING)
			}
		}

		lassign [split $address :] addr port

		# Check security
		if { [cequal [lsearch -exact $privports $port] -1] || \
			 [cequal [lsearch -exact $privhosts $addr] -1] } {

			 # Security violation!
			 textError "Sorry, I'm not allowed to check status on $addr:$port!"

			 # Log this so the admin knows...
			 set raddr $env(REMOTE_ADDR)
			 set rhost $env(REMOTE_HOST)
			 puts stderr "halfd.cgi: POSSIBLE SECURITY VIOLATION:"
			 puts stderr "halfd.cgi: client from $raddr ($rhost) requested status"
			 puts stderr "halfd.cgi: on $addr:$port at [http_time [clock seconds]]"
			 exit 0
		}
	} else {
		# Use the default defined up-top
		lassign [split $address :] addr port
	}

	set clientOpts(addr) $addr
	set clientOpts(port) $port

	connectToServer
	if [catch {vwait connected} err] { 
		textError $err
		exit 0
	}

	writeClientSock $authstr
	fileevent $sockFd readable readClientSock
	if [catch {vwait gotData} err] {
		textError $err
		exit 0
	}

	# If we're here, we got the data we need...
	puts "Content-type: text/html\n\n"
	putServerInfo $kl

	# Execute footer.pl...
	if ![catch {exec ./footer.pl} out] { echo $out }

	echo "</body>\n</html> "
}

set connected 0
set gotData 0


main [llength $argv] $argv