#!/usr/bin/tclsh
# OpenVerse Server Program
# 
# This is the server code! :)
#
# Module Name		- Server Program
# Current Maintainter 	- Cruise <cruise@openverse.org>
# Sourced By		- Command Line or Client
#
# DRG: Cruise <cruise@openverse.org>
# AMG: Unununium <unununium@openverse.org>
#
# Copyright (C) 1999 David Gale <cruise@openverse.org>
# For more information visit http://OpenVerse.org/
#
# 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., 59 Temple Place - Suite 330, Boston, MA  02111-1307,
# USA.

set MVS(server_version) "2.0.0"

# UTILITY FUNCTIONS ----------------------------------------------------------

# Central logging facility
#
# Usage: LogIt "Text to log"
#
# This proc writes text to the log.
proc LogIt {text} {
	global MVS

	if $MVS(standalone) {
		# We are running from a command line
		puts "$text$MVS(ansi.reset)"
	} else {
		# We are running from a GUI
		if {[winfo exists .ovserver]} {
			# The window's there, so write to it
			.ovserver.log insert end "$text\n"
			.ovserver.log see end
			# TODO (6) Check for number of lines and trim.
		} else {
			# Uhm, it's gone (???) so just use stdout
			puts $text
		}
	}
	
	unset text
}

# Send text to a connected user
#
# Usage: SendToUser socket "text to send"
#
# This proc sends the provided text to the specified socket.  It should be
# preformatted and ready to go.
proc SendToUser {who what} {
	global MVS

	LogIt "$MVS(ansi.put)($who) -> $what"
	catch {puts $who "$what"}
	
	unset who what
}

# Send text to ALL users
#
# Usage: SendToAllUsers "Text to send"
#
# This proc sends the provided text to all connected users.  The text should
# be preformatted and ready to go.
proc SendToAllUsers {what} {
	global MVS
	
	foreach sock $MVS(socks) {
		if {$MVS($sock.name) != "*"} {
			# Only talk to authenticated sockets
			LogIt "$MVS(ansi.put)($sock) -> $what"
			catch {puts $sock "$what"}
		}
	}
	
	unset what
}

# Check name validity
#
# Usage: CheckName "nick"
#
# This proc checks a given nickname to be sure it is allowed.  Some nicknames
# are not allowed if they contain special characters.
proc CheckName {name} {
	if {[string trim $name] == "" || \
			[string trim $name] == "*" || \
			[string trim $name] == "." || \
			[string range $name 0 0] == "-"} {
		# The name is bad because it's either null, "*", ".", or
		# starts with a "-", so complain
		unset name
		return 0
	} else {
		# 'Tis a fine name
		unset name
		return 1
	}
}

# Check gif image size
#
# Usage: CheckGif "filename"
#
# This proc reads the GIF File header and determines its size.  It compares
# the size against the server limits and reports whether the file is good or
# bad.
proc CheckGif {file} {
	global MVS

	# Read the first ten bytes
	set infile [open $file r]
	fconfigure $infile -translation binary
	set bits [read $infile 10]
	close $infile
	unset infile

	# Check whether or not it's a GIF
	if {[string range $bits 0 2] != "GIF"} {
		LogIt "$MVS(ansi.concern){CheckGif|file=$file} Failed!  Not a GIF"
		unset bits file
		return 0
	}

	# Check the image size against the acceptible maximums
	binary scan $bits s* var
	if {[lindex $var 4] <= $MVS(maxheight) && [lindex $var 3] <= \
			$MVS(maxwidth)} {
		LogIt "{CheckGif|file=$file} Passed!  ([lindex $var 3] x [lindex $var 4])"
		unset var bits file
		return 1
	} else {
		LogIt "$MVS(ansi.concern){CheckGif|file=$file} Failed!  ([lindex $var 3] x [lindex $var 4])"
		unset var bits file
		return 0
	}
}

# Error logging routine
#
# Usage: Used internally when an error occurs
#
# This proc prints out error information as the program continues.
proc bgerror {stuff} {
	global errorInfo errorCode
	
	LogIt "-------------------------------------"
	LogIt "BGERROR Begin"
	LogIt "-------------------------------------"
	LogIt "Error Code: $stuff"
	LogIt "-------------------------------------"
	LogIt $errorInfo
	LogIt "-------------------------------------"
	LogIt "BGERROR End"
	LogIt "-------------------------------------"

	unset stuff
}

# Prefix stripper
#
# Usage: strip message word_count
#
# This proc removes the first word_count words from message and then returns
# the result.
proc strip {msg count} {
	# See if there are enough words
	if {[llength [split $msg " "]] <= $count} {
		unset msg count
		return ""
	}

	# Remove i words from the beginning
	for {set i 0} {$i < $count} {incr i} {
		set msg [string range $msg [expr [string first " " $msg] + 1] \
				end]
	}
	unset i count

	return $msg
}

# Timeout and event checker
#
# Usage: Serv_CheckTimeouts
#
# This proc infinitely recalls itself.  It checks whether various timeouts
# have expired.  It also looks for tickler files which cause the server to
# reload its configuration file(s).
proc Serv_CheckTimeouts {} {
	global MVS

	# Check user ping times
	set tme [clock seconds]
	foreach sock $MVS(socks) {
		if {[expr $tme - $MVS($sock.ping_response)] > 320} {
			# Client hasn't ponged a ping in time
			LogIt "$MVS(ansi.concern)($sock) -- Ping timeout"
			DisconnectUser $sock 1
		} elseif {[expr $tme - $MVS($sock.ping)] > 150} {
			# It's time to ping this user
			set MVS($sock.ping) [clock seconds]
			SendToUser $sock "PING"
		}
	}
	
	# Check active downloads
	set tme [clock seconds]
	foreach idx $MVS(dcc_list) {
		if {[expr $tme - $MVS(DCC.$idx.time)] > $MVS(timeout)} {
			# This transfer has taken too long
			if {$MVS(DCC.$idx.server) > 0} {
				# Kill it!
				catch {close $MVS(DCC.$idx.server)}
			}
			Serv_endDCC Timer $idx 0 "Connection timed out: $MVS(DCC.$idx.file)"
		}
	}
	
	# Check for tickler files
	if [file exists "$MVS(tickler)"] {
		Configure
		catch {file delete -force "$MVS(tickler)"}
	}
	if [file exists "$MVS(mem_tickler)"] {
		Serv_DumpMem
		catch {file delete -force "$MVS(mem_tickler)"}
	}
	
	# If we're serving, reload this function in 5 seconds.
	if $MVS(serving) {after 5000 Serv_CheckTimeouts}

	catch {unset sock idx}
	unset tme
}

# Memory dumper
#
# Usage: Serv_DumpMem
#
# This proc dumps the contents of the server array to Dump.mem.  The presence
# of the TickleMem file invokes this function.  It allows developers to find
# and remove memory leaks within the main array.  A text file will be created
# named Dump.mem containing the keys and values of the main array.
proc Serv_DumpMem {} {
	global MVS tl

	set arrays [list MVS tl]

	# Dump all arrays to disk
	set outfile [open "$MVS(homedir)/Dump.mem" "w"]
	foreach ar $arrays {
		puts $outfile "------------------------------------------------------------------------------"
		puts $outfile " OpenVerse Server - THIS IS THE $ar\() ARRAY"
		puts $outfile "------------------------------------------------------------------------------"
		set toggle 0
		set values {}
		set keys {}
		
		# Every other entry is a key
		foreach var [array get $ar] {
			if {!$toggle} {
				lappend keys $var
				set toggle 1
			} else {
				set toggle 0
			}
		}

		# List the keys and their values
		set keys [lsort $keys]
		foreach key $keys {
			puts $outfile [format "%-39.39s %-39.39s" $key \
					[set $ar($key)]]
		}
	}
	close $outfile

	unset arrays outfile toggle values keys
}

# User avatar changer
#
# Usage: Serv_ChangeAvatar who avatar_name nametag_x nametag_y size
#		balloon_x balloon_y
#
# This proc changes user avatars.  It announces the avatar change to all
# conneced users.
proc Serv_ChangeAvatar {who what x y size bx by} {
	global MVS

	# Change avatar-related variables
	set MVS($who.avatar) $what
	set MVS($who.av_head_x) $x
	set MVS($who.av_head_y) $y
	set MVS($who.av_baloon_x) $bx
	set MVS($who.av_baloon_y) $by
	
	if {$what == "default.gif"} {
		# Change to default avatar
		SendToAllUsers "AVATAR $MVS($who.name) $what $MVS($who.av_head_x) $MVS($who.av_head_y) [file size $MVS(icons)/$what] $bx $by"
		unset who what x y size bx by
		return
	}

	if ![file exists $MVS(avatars)/$what] {
		# Download a new avatar
		LogIt "($who) -- $what does not exist on server"
		GetBinaryFile $who $MVS($who.avatar) $size AVATAR
	} else {
		# Use an existing avatar
		if {[file size $MVS(avatars)/$what] != $size} {
			# It's a new version; download it
			LogIt "($who) -- $what's size of $size != [file size $MVS(avatars)/$what]"
			GetBinaryFile $who $MVS($who.avatar) $size AVATAR
		} else {
			# Check its validity
			if [CheckGif "$MVS(avatars)/$what"] {
				# Good!
				SendToAllUsers "AVATAR $MVS($who.name) $what $MVS($who.av_head_x) $MVS($who.av_head_y) [file size $MVS(avatars)/$what] $bx $by"
			} else {
				# No...
				SendToAllUsers "AVATAR $MVS($who.name) default.gif 0 20 [file size $MVS(icons)/default.gif] 24 6"
				SendToUser $who "TOOBIG"
				set MVS($who.avatar) "default.gif"
			}
		}
	}

	unset who what x y size bx by
}

# Color activator
#
# Usage: ColorSwitch value
#
# This proc turns on colors.  It is supposed to be called from server.cfg.  It
# also can turn them off, if value is set to zero.
proc ColorSwitch {value} {
	global MVS

	if $value {
		# TODO: add colors in GUI
		if $MVS(standalone) {
			# Set up ANSI codes in console
			set MVS(ansi.error) "\033\[1;33;41m"
			set MVS(ansi.concern) "\033\[1;33m"
			set MVS(ansi.put) "\033\[1;32m"
			set MVS(ansi.get) "\033\[1;35m"
			set MVS(ansi.reset) "\033\[0m"
		 }
	} else {
		# No colors
		set MVS(ansi.error) ""
		set MVS(ansi.concern) ""
		set MVS(ansi.put) ""
		set MVS(ansi.get) ""
		set MVS(ansi.reset) ""
	}

	unset value
}

# Server configuration file loader
#
# Usage: ReloadConfig
#
# This proc (re)loads the server configuration file.
proc ReloadConfig {} {
	global MVS

	LogIt "------------ Loading Config File ------------"

	# Server configuration defaults
	set MVS(port) "7000";				# Port
	set MVS(timeout) "120";				# Transfer timeout
	set MVS(roomname) "My Own Room";		# Room title
	set MVS(avatars) "$MVS(homedir)/simages";	# User avatars
	set MVS(images) "$MVS(homedir)/images";		# Servr images
	set MVS(icons) "$MVS(homedir)/icons";		# Icons
	set MVS(roomdir) "$MVS(homedir)/rooms";		# Room images
	set MVS(sobjects) "$MVS(homedir)/sobjects";	# Server objects
	set MVS(splugins) "$MVS(homedir)/splugins";	# Server plugins

	set MVS(tickler) "$MVS(homedir)/TickleMe";	# Tickler file
	set MVS(mem_tickler) "$MVS(homedir)/TickleMem";	# Memory dump flag file
	
	set MVS(maxwidth) "320";			# Max avatar width
	set MVS(maxheight) "200";			# Max avatar height

	set MVS(roomfile) "room.gif";			# Room image
	
	set MVS(sendbuffer) "4096";			# Send buffer size
	set MVS(maxmsglen) "256";			# Max message length
	
	set MVS(exits) {};				# Host IP:port list
	set MVS(locations) {};				# Coords of exits
	
	set MVS(max_same_users) 10;			# Max connections

	# Create missing directies
	if {![file exists $MVS(avatars)]} {file mkdir "$MVS(avatars)"}
	if {![file exists $MVS(sobjects)]} {file mkdir "$MVS(sobjects)"}
	if {![file exists $MVS(images)]} {file mkdir "$MVS(images)"}
	if {![file exists $MVS(roomdir)]} {file mkdir "$MVS(roomdir)"}
	if {![file exists $MVS(icons)]} {file mkdir "$MVS(icons)"}
	if {![file exists $MVS(roomdir)]} {file mkdir "$MVS(roomdir)"}
	if {![file exists $MVS(splugins)]} {file mkdir "$MVS(splugins)"}

	# Parse configuration file
	if {$MVS(configfile) != "" && [file exists "$MVS(configfile)"]} {
		source $MVS(configfile)
	}

	# Continue processing
	return 1
}

# Standard USERS authtype handler
#
# Usage: standard_connect.USERS socket input
#
# This proc tells the user how many users are connected to the server and then
# disconnects him.
proc standard_connect.USERS {who input} {
	global MVS

	# Do the magic
	SendToUser $who "USERS [expr [llength $MVS(socks)] - 1]"
	DisconnectUser $who 0
	
	# No further processing should be done with this socket
	unset who input
	return 0
}

# Standard AUTH authtype handler
#
# Usage: standard_connect.AUTH socket input
#
# This proc authenticates normal users.
proc standard_connect.AUTH {who input} {
	global MVS

	# Do the standard login stuff
	if ![StandardAuth $who $input] {
		# Login failed, so stop this business
		unset who input
		return 0
	}

	set size [lindex [split [string range $input 5 end] " "] 6]

	# This dude is logged in, but no one sees him and he sees no one.

	# Run server objects
	foreach object [glob -nocomplain "$MVS(sobjects)/*"] {
		source $object
	}
	catch {unset object}

	# Make the user known and possibly get his avatar
	if ![file exists $MVS(avatars)/$MVS($who.avatar)] {
		# This avatar is unknown to the server
		SendToAllUsers "NEW $MVS($who.name) $MVS($who.x) $MVS($who.y) default.gif 0 20 [file size $MVS(icons)/default.gif] 24 6"
		LogIt "($who) -- $MVS($who.avatar) does not exist"
		GetBinaryFile $who $MVS($who.avatar) $size AVATAR
	} else {
		if {[file size $MVS(avatars)/$MVS($who.avatar)] != $size} {
			# This avatar is different than one of the same name
			SendToAllUsers "NEW $MVS($who.name) $MVS($who.x) $MVS($who.y) default.gif 0 20 [file size $MVS(icons)/default.gif] 24 6"
			LogIt "($who) -- $MVS($who.avatar) $size != [file size $MVS(avatars)/$MVS($who.avatar)]"
			GetBinaryFile $who $MVS($who.avatar) $size AVATAR
		} else {
			if [CheckGif "$MVS(avatars)/$MVS($who.avatar)"] {
				# Avatar is acceptable
				SendToAllUsers "NEW $MVS($who.name) $MVS($who.x) $MVS($who.y) $MVS($who.avatar) $MVS($who.av_head_x) $MVS($who.av_head_y) [file size $MVS(avatars)/$MVS($who.avatar)] $MVS($who.av_baloon_x) $MVS($who.av_baloon_y)"
				LogIt "($who) -- $MVS($who.avatar) is acceptable"
			} else {
				# Avatar is either a bad file or a bad size
				SendToAllUsers "NEW $MVS($who.name) $MVS($who.x) $MVS($who.y) default.gif 0 20 [file size $MVS(icons)/default.gif] 24 6"
				SendToUser $who "TOOBIG"
				LogIt "($who) -- $MVS($who.avatar) is either too big or a bad file"
				set MVS($who.avatar) "default.gif"
			}
		}
	}

	# Now this part doesn't make sense... it seems redundant
	# Removing it, however, breaks this proc
	foreach sock $MVS(socks) {
		if {$MVS($sock.name) != $MVS($who.name)} {
			if [file exists $MVS(avatars)/$MVS($sock.avatar)] {
				SendToUser $who "NEW $MVS($sock.name) $MVS($sock.x) $MVS($sock.y) $MVS($sock.avatar) $MVS($sock.av_head_x) $MVS($sock.av_head_y) [file size $MVS(avatars)/$MVS($sock.avatar)] $MVS($sock.av_baloon_x) $MVS($sock.av_baloon_y)"
			} else {
				SendToUser $who "NEW $MVS($sock.name) $MVS($sock.x) $MVS($sock.y) default.gif 0 20 [file size $MVS(icons)/default.gif] 24 6"
			}
		}
	}

	unset input who size
	return 1
}

# Default initializer
#
# Usage: standard_init.start
#
# This proc basically starts the server.
proc standard_init.start {} {
	global MVS tcl_interactive

	# Set up some server variables
	set MVS(waiter) 1;	# Dummy variable for tclsh looping
	set MVS(serving) 1;	# Is the server running? (for GUI mode)
	set MVS(users) 0;	# Number of connected users
	set MVS(socks) {};	# List of connected user sockets
	set MVS(tell_registry) {};	# TELL objects (clickable regions)
	set MVS(entry_registry) {};	# ENTRY objects (textboxes)
	set MVS(submit_registry) {};	# SUBMIT objects (buttons)
	set MVS(dcc_list) {};	# List of DCC transfers
	set MVS(dcc_num) 0;	# ID of next DCC transfer

	# I suppose these procs are already defined in the GUI...
	if {!$tcl_interactive} {
		# Path validity checker
		# Usage: SanityCheck "pathname"
		#
		# This proc checks paths to see if they meet ultra-basic
		# standards of validity.  It returns 1 if the path it checks
		# passes the tests.  It returns 0 if the path cannot possibly
		# be valid.
		proc SanityCheck {what} {
			if {[string first "../" $what] != -1 || \
					[string first "//" $what] != -1 || \
					[string first "~/" $what] != -1 || \
					[string range $what 0 0] == "/"} {
				unset what
				return 0
			} else { 
				unset what
				return 1
			}
		}

		# Number identifier
		# Usage: TestNum number_to_test
		#
		# This proc returns 0 if number_to_test is a number or 1 if
		# it contains nonnumeric characters.
		proc TestNum {number} {
			if {[string length [string trim $number \
					"-0123456789"]]} {
				return 1
			} else {
				return 0 
			}
		}
	}

	# Open the server's listening socket
	set MVS(server_socket) [socket -server NewConnect $MVS(port)]

	# Delete tickler files
	if [file exists "$MVS(tickler)"] {
		catch {file delete -force "$MVS(tickler)"}
	}
	if [file exists "$MVS(mem_tickler)"] {
		catch {file delete -force "$MVS(mem_tickler)"}
	}

	# Call neverending procs
	Serv_CheckTimeouts

	# Continue processing
	return 1
}

# Tickle file manager
#
# Usage: standard_init.tickle
#
# This proc reloads the server configuration and tells everyone the new room
# name and image.
proc standard_init.tickle {} {
	global MVS
	
	# Give out room name
	SendToAllUsers "ROOMNAME $MVS(roomname)"
	SendToAllUsers "ROOM $MVS(roomfile) [file size "$MVS(roomdir)/$MVS(roomfile)"]"

	# Continue processing
	return 1
}

# LOGIN FUNCTIONS ------------------------------------------------------------

# New connection handler
#
# Usage: NewConnect socket address port
#
# This proc handles new connections to the server.  It sets a couple of
# initial variables and then passes control to all procs registered for
# whichever type of authentication is tendered.
proc NewConnect {who address port} {
	global MVS

	if {[lsearch $MVS(socks) $who] == -1} {
		# Not a duplicate socket; allow
		lappend MVS(socks) $who
	} else {
		# Duplicate socket; ignore
		LogIt "$MVS(ansi.error){NewConnect|who=$who|address=$address|port=$port} Duplicate socket"
		close $who
		unset who address port
		return
	}

	# Ensure that no one host has too many connections to this server
	set count 1
	foreach sock $MVS(socks) {
		if {$sock != $who && $MVS($sock.address) == $address} {
			incr count
		}
	}
	if {$count > $MVS(max_same_users)} {
		LogIt "$MVS(ansi.concern){NewConnect|who=$who|address=$address|port=$port} Max connection count exceeded"
		SendToUser $who "TOOMANYCONNECTIONS"
		close $who
		unset who address port count sock
		return
	}

	# So far so good... log it!
	LogIt "($who) -- Connected!  $address:$port"

	# Have AuthRead get the login stuff from the socket
	fconfigure $who -blocking 0 -buffering line
	fileevent $who readable "AuthRead $who"

	# Set server variables to defaults
	set MVS($who.name) "*"
	set MVS($who.address) "$address"
	set MVS($who.port) "$port"
	set MVS($who.ping) "0"
	set MVS($who.ping_response) "[clock seconds]"
	set MVS($who.x) "-1"
	set MVS($who.y) "-1"
	set MVS($who.avatar) "*connecting*"
	set MVS($who.av_head_x) "-1"
	set MVS($who.av_head_y) "-1"
	set MVS($who.downloads) {}

	# Update the user count and the GUI user count display
	incr MVS(users)
	if !$MVS(standalone) {
		.ovserver.buttons.info.v configure -text $MVS(users)
	}

	unset who address port count sock
}

# Login getter
#
# Usage: AuthRead socket
#
# This proc gets the first line of text from a socket and then passes control
# of the socket on to the appropriate hooked proc based on the first word of
# the first line.  It also passes a copy of the first line so that the hooked
# proc can extract more useful information from it.  If the login type is
# unsupported, it 
proc AuthRead {who} {
	global MVS

	# Don't let AuthRead get called again
	fileevent $who readable ""

	# See what the user has to say
	set input ""
	catch {gets $who input}

	# Did the poor dude quit on us?
	if [eof $who] {
		LogIt "$MVS(ansi.concern){AuthRead|who=$who} Unexpected EOF/disconnection"
		DisconnectUser $who 0
		unset who input
		return
	}

	LogIt "$MVS(ansi.get)($who) <- $input"
	
	# Get a list of procs hooked onto this authtype
	set hooks [array names MVS \
			"connect.[lindex [split $input " "] 0].hooks"]
	
	if [llength $hooks] {
		# Yes, this authtype is supported
		set hooks $MVS($hooks)
		foreach hook $hooks {
			# Call each hooked proc in turn
			if ![$hook $who $input] {
				# This hook requested processing to stop
				LogIt "{AuthRead|who=$who} $hook returned 0; stopping"
				break
			}
		}
		unset hook
	} else {
		# Unsupported authtype
		LogIt "$MVS(ansi.concern){AuthRead|who=$who} Unsupported authtype"
		SendToUser $who "AUTH REQD"
		DisconnectUser $who 0
	}

	unset who input hooks
}

# AUTH handler helper
#
# Usage: StandardAuth socket input
#
# This proc does the basic validity checking and bookkeeping for AUTH logins.
# It returns 0 on error and 1 on success.
proc StandardAuth {who input} {
	global MVS
	
	# AUTH name x y avatarFile headX headY fileSize balloonX balloonY

	# Strip first five characters off of input and call it "parms"
	set parms [split [string range $input 5 end] " "]

	# Ensure that the numeric fields really are numeric
	if {[TestNum [lindex $parms 1]] || \
			[TestNum [lindex $parms 2]] || \
			[TestNum [lindex $parms 4]] || \
			[TestNum [lindex $parms 5]] || \
			[TestNum [lindex $parms 6]] || \
			[TestNum [lindex $parms 7]] || \
			[TestNum [lindex $parms 8]] } {
		# Nonnumeric characters in AUTH line; disconnect
		LogIt "$MVS(ansi.concern){HandleConnect.AUTH|who=$who|input=$input} Invalid numeric fields in AUTH line"
		SendToUser $who "AUTH FAILED (invalid numeric fields)"
		DisconnectUser $who 0

		# Allow no further processing
		unset input who parms
		return 0
	}

	# Ensure that no field is too long
	if {[string length [lindex $parms 1]] > 3 || \
			[string length [lindex $parms 2]] > 3 || \
			[string length [lindex $parms 4]] > 4 || \
			[string length [lindex $parms 5]] > 4 || \
			[string length [lindex $parms 6]] > 6 || \
			[string length [lindex $parms 7]] > 4 || \
			[string length [lindex $parms 8]] > 4} {
		LogIt "$MVS(ansi.concern){HandleConnect.AUTH|who=$who|input=$input} Field too long"
		SendToUser $who "AUTH FAILED (invalid field lengths)"
		DisconnectUser $who 0

		# Allow no further processing
		unset input who parms
		return 0
	}

	# Ensure that some fields are positive
	if {[lindex $parms 1] < 0 || \
			[lindex $parms 2] < 0 || \
			[lindex $parms 6] < 0} {
		LogIt "$MVS(ansi.concern){HandleConnect.AUTH|who=$who|input=$input} Negative field"
		SendToUser $who "AUTH FAILED (negative numbers not allowed)"
		DisconnectUser $who 0

		# Allow no further processing
		unset input who parms
		return 0
	}

	# Ensure that nickname is valid
	if ![CheckName [string range [lindex $parms 0] 0 12]] {
		LogIt "$MVS(ansi.concern){HandleConnect.AUTH|who=$who|input=$input} Bad nickname"
		SendToUser $who "BADNAME"
		DisconnectUser $who 0

		# Allow no further processing
		unset input who parms
		return 0
	}

	# Ensure nickname is unique
	foreach sock $MVS(socks) {
		if {$MVS($sock.name) == [string range [lindex $parms 0] 0 12]} {
			LogIt "$MVS(ansi.concern){HandleConnect.AUTH|who=$who|input=$input} Nickname already in use"
			SendToUser $who "NAMEINUSE"
			DisconnectUser $who 0

			# Allow no further processing
			unset input who parms sock
			return 0
		}
	}
	
	# Extricate various bits of info from input line
	set MVS($who.name) [string range [lindex $parms 0] 0 12]
	set MVS($who.x) [lindex $parms 1]
	set MVS($who.y) [lindex $parms 2]
	set MVS($who.avatar) [lindex $parms 3]
	set MVS($who.av_head_x) [lindex $parms 4]
	set MVS($who.av_head_y) [lindex $parms 5]
	set MVS($who.av_baloon_x) [lindex $parms 7]; # Should be "balloon",
	set MVS($who.av_baloon_y) [lindex $parms 8]; # but Cruise can't speel

	# Pass on control of this socket
	fileevent $who readable "Serv_ReadFrom $who"

	# Send the user some information about the room
	SendToUser $who "ROOMNAME $MVS(roomname)"
	SendToUser $who "ROOM $MVS(roomfile) [file size $MVS(roomdir)/$MVS(roomfile)]"

	unset input who parms sock
	return 1
}

# DISCONNECTION FUNCTIONS -----------------------------------------------------

# User disconnecter
#
# Usage: DisconnectUser socket announce_disconnect
#
# This proc disconnects users from the system and cleans up some variables.  If
# announce_disconnect is set to 1, hooks will be processed.
proc DisconnectUser {who announce} {
	global MVS
	
	# Cancel if this guy isn't listed
	if {[lsearch -exact $MVS(socks) $who] == -1} {
		LogIt "$MVS(ansi.error){DisconnectUser|who=$who|announce=$announce} This guy doesn't exist!"
		unset who announce
		return
	}
	
	# Moved back here DRG 09/18/00 - did not belong in a plugin.
	if {$announce} {
		foreach sock $MVS(socks) {
			if {$sock != $who} {SendToUser $sock "NOMORE $MVS($who.name)"}
		}
	}

	if {$announce && [array names MVS "disconnect.pre.hooks"] != ""} {
		# Call pre-cleanup hooks
		foreach hook $MVS(disconnect.pre.hooks) {
			# Call each hooked proc in turn
			if ![$hook $who] {
				# This hook requested processing to stop
				LogIt "{DisconnectUser|who=$who|announce=$announce} $hook returned 0; stopping"
				break
			}
		}
		catch {unset hook}
	}
	
	LogIt "($who) -- Disconnected!  $MVS($who.address):$MVS($who.port)"

	# Update the user count
	incr MVS(users) -1
	if !$MVS(standalone) {
		.ovserver.buttons.info.v configure -text $MVS(users)
	}

	# Actually close the connection
	catch {close $who}

	# Remove this entry from the list of sockets
	set which [lsearch -exact $MVS(socks) $who]
	set MVS(socks) [lreplace $MVS(socks) $which $which]

	# Clean up the mess this user made
	catch {unset MVS($who.name)}
	catch {unset MVS($who.downloads)}
	catch {unset MVS($who.address)}
	catch {unset MVS($who.av_baloon_x)}
	catch {unset MVS($who.av_baloon_y)}
	catch {unset MVS($who.av_head_x)}
	catch {unset MVS($who.av_head_y)}
	catch {unset MVS($who.avatar)}
	catch {unset MVS($who.ping)}
	catch {unset MVS($who.ping_response)}
	catch {unset MVS($who.port)}
	catch {unset MVS($who.x)}
	catch {unset MVS($who.y)}

	if {$announce && [array names MVS "disconnect.post.hooks"] != ""} {
		# Call post-cleanup hooks
		foreach hook $MVS(disconnect.post.hooks) {
			# Call each hooked proc in turn
			if ![$hook] {
				# This hook requested processing to stop
				LogIt "{DisconnectUser|who=$who|announce=$announce} $hook returned 0; stopping"
				break
			}
		}
		catch {unset hook}
	}

	unset who announce
}

# CHAT FUNCTIONS --------------------------------------------------------------

# Incoming text reader
# 
# Usage: Serv_ReadFrom socket
#
# This proc reads text from sockets and farms out processing to hooked procs
# depending on the first word of the text.
proc Serv_ReadFrom {who} {
	global MVS
	
	set input ""
	catch {gets $who input}

	# Did the poor dude quit on us?
	if [eof $who] {
		LogIt "{Serv_ReadFrom|who=$who} Unexpected EOF/disconnection"
		DisconnectUser $who 1
		unset who input
		return
	}

	# Nope... processing time!
	LogIt "$MVS(ansi.get)($who) <- $input"

	# See if this command is supported
	set hooks [array names MVS -exact "message.[lindex [split $input " "] 0].hooks"]
	if [llength $hooks] {
		# Yes, this command is supported
		set hooks $MVS($hooks)
		foreach hook $hooks {
			# Call each hooked proc in turn
			if ![$hook $who $input] {
				# This hook requested processing to stop
				LogIt "{Serv_ReadFrom|who=$who} $hook returned 0; stopping"
				break
			}
		}
		unset hook
	} else {
		# Unsupported command
		LogIt "$MVS(ansi.concern){Serv_ReadFrom|who=$who} Unsupported command"
	}

	unset who input hooks
}

# INITIALIZATION FUNCTIONS ---------------------------------------------------

# Server initializer
#
# Usage: Initialize
#
# This proc calls the one-time startup initialization hooks.
proc Initialize {} {
	global MVS

	# Call initialization hooks
	if {[array names MVS "init.start.hooks"] == ""} {return}
	foreach hook $MVS(init.start.hooks) {
		# Call each hooked proc in turn
		LogIt "Calling $hook"
		if {![$hook]} {
			# This hook requested processing to stop
			LogIt "{Initialize} $hook returned 0; stopping"
			break
		}
	}

	catch {unset hook}
}

# Server configurator
#
# Usage: Configure
#
# This proc calls the configuration (ticklish) hooks.
proc Configure {} {
	global MVS

	# Call configuration hooks
	if {[array names MVS "init.tickle.hooks"] == ""} {return}
	foreach hook $MVS(init.tickle.hooks) {
		# Call each hooked proc in turn
		if ![$hook] {
			# This hook requested processing to stop
			LogIt "{Configure} $hook returned 0; stopping"
			break
		}
	}
	
	catch {unset hook}
}

# Plugin loader
#
# Usage: LoadPlugins
#
# This proc sources all the server plugins.
proc LoadPlugins {} {
	global MVS

	foreach dir [lsort -ascii [glob -nocomplain "$MVS(splugins)/*"]] {
		if {[file isdirectory "$dir"] && \
				[file exists "$dir/PlugInit.tcl"]} {
			LogIt "Loading plugin \"$dir\"..."
			set MVS(current_plugin_dir) $dir
			catch {source [file nativename "$dir/PlugInit.tcl"]}
		}
	}
	
	catch {unset dir}
}

# DCC FUNCTIONS --------------------------------------------------------------

# Duplicate download checker
#
# Usage: DuplicateCheck socket filename
#
# This proc returns 0 if the user is already getting the named file.
proc DuplicateCheck {who what} {
	global MVS

	# No transfers, no duplicates!
	if {[llength $MVS(dcc_list)] == 0} {
		unset who what
		return 1
	}

	# Scan through all file transfers
	foreach idx $MVS(dcc_list) {
		# See if it's the same person and the same file
		if {$MVS(DCC.$idx.sender) == $who && \
				[file tail $MVS(DCC.$idx.file)] == $what} {
			# Yup
			unset who what idx
			return 0
		}
	}

	# Nope
	unset who what
	return 1
}

# File sender
#
# Usage: Serv_DCCSend socket filename transfer_type
#
# This proc initiates file transfers.  It sends rooms, avatars, and object
# images.  It is a passive DCC transfer so that it works through firewalls.
proc Serv_DCCSend {who what type} {
	global MVS

	# Don't send more than once!
	if ![DuplicateCheck $who $what] {
		LogIt "$MVS(ansi.concern)($who) -- Already getting $what"
		unset who what type
		return
	}

	# Depending on the type, do different stuff
	switch -exact -- $type {
		"AVATAR" {
			if {$what == "default.gif"} {
				set file "$MVS(icons)/default.gif"
			} else {
				set file "$MVS(avatars)/$what"
			}
			set get_command "DCCGETAV"
		} "OBJECT" {
			set file "$MVS(images)/$what"
			set get_command "DCCGETOB"
		} "ROOM" {
			set file "$MVS(roomdir)/$what"
			set get_command "DCCGETROOM"
		} "ORT" {
			set file "$MVS(homedir)/images/$what"
			set get_command "DCCGETAV"
		} default {
			unset who what type
			return
		}
	}

	# Don't do anything if the file doesn't exist!
	if ![file exists $file] || ![file readable $file] {
		LogIt "$MVS(ansi.concern){Serv_DCCSend|who=$who|what=$what|type=$type} Cannot read file $file"
		unset who what type
		return
	}
	
	# Find the file size
	set size [file size $file]

	# Increment the DCC counter
	set idx [incr MVS(dcc_num)]

	# Open a listening socket
	set sock [socket -server "Serv_acceptSend $idx" 0]

	# Get the port
	if {[catch {fconfigure $sock -sockname} port]} {
		LogIt "$MVS(ansi.concern){Serv_DCCSend|who=$who|what=$what|type=$type} Cannot get port for server ($port)"
	}

	# Set all sorts of DCC variables
	lappend MVS(dcc_list) $idx
	set MVS(DCC.$idx.sender) $who
	set MVS(DCC.$idx.file) "$file"
	set MVS(DCC.$idx.size) $size
	set MVS(DCC.$idx.posn) 0
	set MVS(DCC.$idx.type) "AVATAR"
	set MVS(DCC.$idx.time) [clock seconds]
	set MVS(DCC.$idx.server) $sock
	set MVS(DCC.$idx.sock) -1
	set MVS(DCC.$idx.port) [lindex $port 2]
	set MVS(DCC.$idx.remote) "0.0.0.0"
	set MVS(DCC.$idx.av_head_x) 0
	set MVS(DCC.$idx.av_head_y) 0
	set MVS(DCC.$idx.av_baloon_x) 0
	set MVS(DCC.$idx.av_baloon_y) 0

	# Tell the user to get the file
	SendToUser $who "$get_command [lindex $port 2] $what $size"

	unset size idx sock port file get_command who what type
}

# File send accepter
#
# Usage: Serv_acceptSend index socket host port
#
# This proc is called by the opening of the server socket.  It accepts a
# connection, closes the server socket, and starts sending the file to the
# user.
proc Serv_acceptSend {index chan hst port} {
	global MVS

	# close the server port
	catch {close $MVS(DCC.$index.server)}
	uplevel set MVS(DCC.$index.server) -1
	uplevel #0 set MVS(DCC.$index.sock) $chan
	
	set msg ""

	# Open the file to send
	if {[catch {open $MVS(DCC.$index.file) RDONLY} infile]} {
		Serv_endDCC Send $index 0 "$MVS(ansi.concern){Serv_acceptSend|index=$index|chan=$chan|hst=$hst|port=$port} Cannot read $MVS(DCC.$index.file) ($infile)"
		unset infile index chan hst port msg
		return 0
	}

	# See if the transfer starts at byte zero
	if {[set posn $MVS(DCC.$index.posn)] != "" && $posn > 0} {
		# Don't start at the beginning
		if {[catch {seek $infile $posn start} msg]} {
			# Can't go that far into the file
			Serv_endDCC Send $index 0 "$MVS(ansi.concern){Serv_acceptSend|index=$index|chan=$chan|hst=$hst|port=$port} Cannot seek $MVS(DCC.$index.file) ($msg)"
			close $infile
			unset infile posn msg index chat hst port
			return 0
		}
		# This many bytes less to send
		uplevel #0 incr MVS(DCC.$index.size) -$posn
	} 

	# See if the transfer is done (i.e. posn >= size)
	if {$MVS(DCC.$index.size) == 0} {
		# Done!
		close $infile
		after 50 "Serv_endDCC Send $index 1 \"Transfer completed\""
		unset infile posn msg index chan hst port
		return 1
	}

	# Get start time
	set st [clock seconds]

	# Don't warp the file in any way
	fconfigure $infile -translation binary

	# Read the start of the file
	if {[catch {set buffer [read $infile $MVS(sendbuffer)]} msg]} {
		# Trouble
		Serv_endDCC Send $index 0 "Error reading $file ($msg)"
		close $infile
		unset infile posn msg st buffer index chan hst port
		return 0
	}

	# 
	global tl
	set tl($chan) [string length $buffer]

	# Set up some junk
	fconfigure $chan -blocking 0 -buffering none -translation binary

	# Send the first hunk of the file
	if {[catch {puts -nonewline $chan $buffer} msg]} {
		# Trouble
		Serv_endDCC Send $index 0 "Error writing to $chan ($msg)"
		close $infile
		unset infile posn msg st buffer index hst port tl($chan) chan
		return 0
	}

	# Good!
	LogIt "($MVS(DCC.$index.sender)) -- Accepted Serv_DCCSend"

	# From now on have Serv_dccSendEvent process the channel
	fileevent $chan readable "Serv_dccSendEvent $index $st $infile"

	unset infile posn msg st buffer index hst port chan
}

# File send event trigger
#
# Usage: Serv_dccSendEvent index start_time file_stream_descriptor 
#
# This proc is triggered when the client sends a response announcing the number
# of bytes this server has sent to it.  It sends more data if the client
# successfully received all the data sent to it last time.  It ends the
# transfer when the client receives all the data.
proc Serv_dccSendEvent {index st fd} {
	global MVS tl
	
	# For convenience...
	set sock $MVS(DCC.$index.sock)

	# Adjust the timeout data
	uplevel #0 set MVS(DCC.$index.time) [clock seconds]

	set msg ""

	# Quit if the file transfer has been broken
	if [eof $sock] {
		after 50 "Serv_endDCC Send $index 0 \"Transfer interrupted\""
		close $fd
		unset index st fd msg tl($sock) sock
		return
	}

	# Read the byte count from the client
	if [catch {set l [read $sock 4]} msg] {
		Serv_endDCC Send $index 0 "Read error ($msg)"
		catch {unset l} 
		close $fd
		unset index st fd msg tl($sock) sock
		return
	}

	# Quit if the byte count is null
	if {$l == ""} {
		Serv_endDCC Send $index 0 "Sync read error"
		close $fd
		unset index st fd msg l tl($sock) sock
		return
	}

	# Convert the byte count to an integer
	set cl 0
	binary scan $l "I1" cl

	# If the client returned a different byte count than expected, quit
	if {$cl != $tl($sock)} {
		unset index st fd msg l cl sock
		return
	}

	# See if the transfer is done
	if [eof $fd] {
		LogIt "($MVS(DCC.$index.sender)) -- Got check (OK/EOF)"
		close $fd
		after 50 "Serv_endDCC Send $index 1 \"Transfer completed\""
		unset index st fd msg l cl tl($sock) sock
		return
	}

	# It's not done
	LogIt "($MVS(DCC.$index.sender)) -- Got check (OK/not EOF)"

	# Read some more data
	if [catch {set buffer [read $fd $MVS(sendbuffer)]} msg] {
		# Trouble
		Serv_endDCC Send $index 0 "Error reading $MVS(DCC.$index.file) : $msg"
		close $fd
		unset index st fd msg l cl msg tl($sock) sock
		catch {unset buffer}
		return
	}

	# See how much data was read
	if {[set lng [string length $buffer]] == 0} {
		close $fd
		after 50 "Serv_endDCC Send $index 1 \"Transfer completed\""
		unset index st fd msg l cl msg buffer lng tl($sock) sock
		return
	}

	# Adjust the location indicator
	incr tl($sock) $lng
	LogIt "($MVS(DCC.$index.sender)) -- Sent $lng bytes ($tl($sock) total)"

	# Send some more data
	if [catch {puts -nonewline $sock $buffer} msg] {
		Serv_endDCC Send $index 0 "Write error ($msg)"
		close $fd
		unset index st fd msg l cl msg buffer lng tl($sock) sock
		return
	}
	unset index st fd sock msg l cl buffer lng
	catch {unset msg}
}

# Passive DCC file downloader
#
# Usage: GetBinaryFile socket filename file size
#
# This proc sets up a passive DCC transfer between a user and the server.  It
# sets up a listening port and tells the user where to connect to.  It also
# sets up an event to accept the connection and download the file.
proc GetBinaryFile {who what size type} {
	global MVS
	
	# See if the filename is possible
	if ![SanityCheck "$what"] {
		LogIt "$MVS(ansi.concern)($who) -- $what fails SanityCheck"
		unset who what size type
		return
	}

	# Don't download multiple times
	if ![DuplicateCheck $who $what] {
		LogIt "$MVS(ansi.concern)($who) -- Already getting $what from this user"
		unset who what size type
		return
	}

	# The only thing users ever send is avatars, anyway...
	set file "$MVS(avatars)/$what"	
	
	# Increment the DCC counter
	set idx [incr MVS(dcc_num)]

	# Open a socket to accept the transfer
	set sock [socket -server "acceptGet $idx" 0]

	# Find its port
	if [catch {fconfigure $sock -sockname} port] {
		LogIt "$MVS(ansi.concern){GetBinaryFile|who=$who|what=$what|size=$size|type=$type} Cannot get port for server ($port)"
	}

	# Set up DCC variables
	lappend MVS(dcc_list) $idx
	set MVS(DCC.$idx.sender) $who
	set MVS(DCC.$idx.file) "$file"
	set MVS(DCC.$idx.size) $size
	set MVS(DCC.$idx.type) $type
	set MVS(DCC.$idx.posn) 0
	set MVS(DCC.$idx.time) [clock seconds]
	set MVS(DCC.$idx.server) $sock
	set MVS(DCC.$idx.sock) -1
	set MVS(DCC.$idx.port) [lindex $port 2]
	set MVS(DCC.$idx.remote) $MVS($who.address)
	set MVS(DCC.$idx.av_head_x) $MVS($who.av_head_x)
	set MVS(DCC.$idx.av_head_y) $MVS($who.av_head_y)
	set MVS(DCC.$idx.av_baloon_x) $MVS($who.av_baloon_x)
	set MVS(DCC.$idx.av_baloon_y) $MVS($who.av_baloon_y)

	# Tell the user where to send
	SendToUser $who "DCCSENDAV [lindex $port 2] $what"

	unset who what size type file idx sock port
}

# Incoming file transfer accepter
#
# Usage: Serv_acceptGet index socket host port
#
# This proc is called by the server socket being connected to.  It accepts the
# connection, closes the server socket, and starts downloading the file from
# the user.
proc acceptGet {index chan hst port} {
	global MVS

	# Close the server socket
	catch {close $MVS(DCC.$index.server)}
	uplevel set MVS(DCC.$index.server) -1
	uplevel #0 set MVS(DCC.$index.sock) $chan

	# For convenience...
	set file $MVS(DCC.$index.file)
	set posn $MVS(DCC.$index.posn)

	# Set up the transfer socket
	fconfigure $MVS(DCC.$index.sock) -buffering none -blocking 0 -translation binary -buffersize 4096

	# Write-only and create the file if it doesn't exist
	set flags [list WRONLY CREAT]
	
	set msg ""

	# If starting from the beginning, delete any existing file
	if {$posn == 0} {lappend flags TRUNC}

	# Open the file to write to
	if ![catch {open $file $flags 0600} outfile] {
		# No problem
		if {$posn != 0} {
			# Not starting at beginning; seek to position
			if [catch {seek $outfile $posn start} msg] {
				# Trouble
				close $outfile
				Serv_endDCC Get $index 0 "Cannot seek on $file ($msg)"
				unset index chan hst port file posn flags msg
				return 0
			}
			# Woohoo!  Less bytes to transfer
			uplevel #0 incr MVS(DCC.$index.size) -$posn
		}
		# Start at byte zero
		uplevel #0 set tl($MVS(DCC.$index.sock)) 0

		# Don't mutate file
		fconfigure $outfile -translation binary 

		# When client tries to send data, call this proc
		fileevent $MVS(DCC.$index.sock) readable "Serv_dccGetEvent $index [clock seconds] $outfile"
	} else {
		# Trouble
		Serv_endDCC Get $index 0 "Cannot write $file ($outfile)"
		unset index chan hst port file posn flags msg
        	return 0
	}
	
	unset index chan hst port file posn flags msg
	return 1
}

# File read event trigger
#
# Usage: Serv_dccGetEvent index start_time file_stream_descriptor 
#
# This proc is called when the client sends data to this server.
proc Serv_dccGetEvent {index st out} {
	global tl MVS

	# Download from this source
	set in $MVS(DCC.$index.sock)

	# Download this many bytes total
	set leng $MVS(DCC.$index.size)
	
	# Update the timeout value
	uplevel #0 set MVS(DCC.$index.time) [clock seconds]

	# Fail cleanly or bleed all over the motherboard?
	set fail_type 0

	if [eof $in] {
		# The source socket has been closed
		if {$tl($in) < $leng} {
			# Not all data received
			set msg "Transfer interrupted"
			set fail_type 0
		} elseif {$tl($in) > $leng} {
			# What the fsck...?
			set msg "Too much data transferred!!"
			set fail_type 0
		} else {
			# Just right
			if {[set st [expr {[clock seconds] - $st}]] == 0} {
				set st 1
			}
			set msg "Transfer completed at [expr $leng / ($st * 1024.0)] Kb/sec"
			set fail_type 1
		}
	} else {
		# Read data from the socket
		if ![catch {set buffer [read $in]} msg] {
			# No trouble

			# This much data less to transfer before completion
			incr tl($in) [set l [string length $buffer]]

			# Make a note of it
			LogIt "($in) -- Downloaded $l bytes ($tl($in) total)"

			# Write data to file
			if ![catch {puts -nonewline $out $buffer} msg] {
				# Success; now report to client how much data
				# was transferred
				if ![catch {puts -nonewline $in [binary \
						format "I1" $tl($in)]} msg] {
					# Good!
					flush $in
					unset index st out in leng fail_type \
							buffer
					catch {unset msg}
					return
				} else {
					# Failure responding
					unset buffer
				}
			} else {
				# Failure writing
				unset buffer
				set fail_type 0
			}
		} else {
			# Trouble
			set fail_type 0
			catch {unset buffer}
		}
    	}
	# Close output file
	catch {close $out} 

	# End transfer
	Serv_endDCC Get $index $fail_type $msg

	unset index st out in leng fail_type
}

# DCC transfer killer
#
# Usage: Serv_endDCC transfer_type index fail_type debug_info
#
# This proc ends DCC transfers.  On failures, it logs information about the
# transfer.  On successful avatar downloads, it announces the avatar to the
# connected users.  Finally, it unsets all variables used by the transfer.
proc Serv_endDCC {type index fail_type debug} {
        global MVS tl

	# Log debugging stuff on failured file transfers
        if !$fail_type {
                LogIt "$MVS(ansi.concern)($MVS(DCC.$index.sender)) (DCC$type) - $debug"
        }

	# Close the transfer socket
	catch {close $MVS(DCC.$index.sock)}

	# Cut out this entry from the DCC list
	set idx [lsearch -exact $MVS(dcc_list) $index]
	set MVS(dcc_list) [lreplace $MVS(dcc_list) $idx $idx]

	# If a successful avatar download, announce
	if {$type == "Get" && $fail_type} {
		switch -- $MVS(DCC.$index.type) {
		"ORT" {
			# ORT transfer complete

			# Too bad there's no way to put this with the rest of
			# the ORT code...
			LogIt "(ORT) Image transfer ($MVS(DCC.$index.file)) complete"
		} default {
			# Check image validity
			if [CheckGif "$MVS(DCC.$index.file)"] {
				# It's fine
				SendToAllUsers "AVATAR $MVS($MVS(DCC.$index.sender).name) [file tail $MVS(DCC.$index.file)] $MVS(DCC.$index.av_head_x) $MVS(DCC.$index.av_head_y) $MVS(DCC.$index.size) $MVS(DCC.$index.av_baloon_x) $MVS(DCC.$index.av_baloon_y)"
			} else {
				# Nope
				set MVS($MVS(DCC.$index.sender).avatar) \
						"default.gif"
				SendToAllUsers "AVATAR $MVS($MVS(DCC.$index.sender).name) default.gif 0 20 [file size $MVS(icons)/default.gif] 24 6"
				SendToUser $MVS(DCC.$index.sender) "TOOBIG"
			}
		}}
	}
	
	# Clean up the memory this download was using
	catch {unset MVS(DCC.$index.av_baloon_x)}
	catch {unset MVS(DCC.$index.av_baloon_y)}
	catch {unset MVS(DCC.$index.av_head_x)}
	catch {unset MVS(DCC.$index.av_head_y)}
	catch {unset MVS(DCC.$index.port)}
	catch {unset MVS(DCC.$index.remote)}
	catch {unset MVS(DCC.$index.sock)}
	catch {unset MVS(DCC.$index.type)}
	catch {unset MVS(DCC.$index.file)}
	catch {unset MVS(DCC.$index.posn)}
	catch {unset MVS(DCC.$index.sender)}
	catch {unset MVS(DCC.$index.server)}
	catch {unset MVS(DCC.$index.size)}
	catch {unset MVS(DCC.$index.time)}

	unset type index fail_type debug idx
}

# Standard message handler
#
# Usage: standard_message socket input
#
# This proc handles all the standard messages.
proc standard_message {who input} {
	global MVS

	set parms [split $input " "]

	switch -exact -- [lindex $parms 0] {
	"MOVE" {
		# MOVE nick x y speed
		# I think "nick" is ignored... why the hell is it there?

		# Check the validity of the MOVE line
		if {[TestNum [lindex $parms 2]] || \
				[TestNum [lindex $parms 3]] || \
				[TestNum [lindex $parms 4]] || \
				[string length [lindex $parms 2]] > 4 || \
				[string length [lindex $parms 3]] > 4 || \
				[string length [lindex $parms 4]] > 2 || \
				[lindex $parms 2] < 0 || \
				[lindex $parms 3] < 0 || \
				[lindex $parms 4] < 0} {
			# Bad MOVE line; halt processing
			LogIt "$MVS(ansi.concern){standard_message_handler|who=$who|input=$input} Invalid MOVE line"
			unset who input parms
			return 0
		}

		# It passed, so move the user
		set MVS($who.x) [lindex $parms 2]
		set MVS($who.y) [lindex $parms 3]

		# Tell everyone about it
		SendToAllUsers "MOVE $MVS($who.name) [lindex $parms 2] [lindex $parms 3] [lindex $parms 4]"

		# See if the user is moving to an exit
		if {[llength $MVS(exits)] > 0} {
			set idx 0
			foreach exit $MVS(exits) {
				set exl [split $exit " "]
				if {$MVS($who.x) >= [lindex $ex1 0] && \
						$MVS($who.y) >= [lindex $ex1 \
						1] && $MVS($who.x) <= [lindex \
						$ex1 2] && $MVS($who.y) <= \
						[lindex $ex1 3]} {
					# Yup... inform him
					SendToUser $who "EXIT [lindex $MVS(locations) $idx]"
				}
				incr idx
				unset exl
			}
			unset idx exit
		}
	} "QUERY" {
		# This reads MVS(message.QUERY.<type>.hooks) to see what procs
		# to call for each type of query request.

		# See if this query is supported
		set hooks [array names MVS -exact \
				"message.QUERY.[lindex [split $input " "] 1].hooks"]
		if [llength $hooks] {
			# Yes, this query is supported
			set hooks $MVS($hooks)
			foreach hook $hooks {
				# Call each hooked proc in turn
				if ![$hook $who $input] {
					# This hook requested processing to stop
					LogIt "$MVS(ansi.concern){standard_message_handler|who=$who|input=$input} $hook returned 0; stopping"
					unset who input hook parms hooks
					return 0
				}
			}
			unset hook
		} else {
			# Unsupported query; log and then stop processing
			LogIt "$MVS(ansi.concern){standard_message_handler|who=$who|input=$input} Unsupported query type"
			unset who input parms hooks
			return 0
		}
		unset hooks
	} "SEND" {
		# Test the path name of the file to send
		if ![SanityCheck [lindex $parms 1]] {
			# The path name can't be right
			LogIt "$MVS(ansi.concern){standard_message_handler|who=$who|input=$input} Bad path name"
			unset who input parms
			return 0
		}

		# Chain to SendBinaryFile
		SendBinaryFile $who [lindex $parms 1]
	} "DCCSENDAV" {
		# Test the path name of the file to send
		if ![SanityCheck [lindex $parms 1]] {
			# The path name can't be right
			LogIt "$MVS(ansi.concern){standard_message_handler|who=$who|input=$input} Bad path name"
			unset who input parms
			return 0
		}
	
		# Chain to Serv_DCCSend
		Serv_DCCSend $who [lindex $parms 1] "AVATAR"
	} "DCCSENDOB" {
		# Test the path name of the file to send
		if ![SanityCheck [lindex $parms 1]] {
			# The path name can't be right
			LogIt "$MVS(ansi.concern){standard_message_handler|who=$who|input=$input} Bad path name"
			unset who input parms
			return 0
		}
	
		# Chain to Serv_DCCSend
		Serv_DCCSend $who [lindex $parms 1] "OBJECT"
	} "DCCSENDROOM" {
		# Test the path name of the file to send
		if ![SanityCheck [lindex $parms 1]] {
			# The path name can't be right
			LogIt "$MVS(ansi.concern){standard_message_handler|who=$who|input=$input} Bad path name"
			unset who input parms
			return 0
		}
	
		# Chain to Serv_DCCSend
		Serv_DCCSend $who [lindex $parms 1] "ROOM"
	} "EFFECT" {
		# Extricate the message portion of the EFFECT line
		set message [strip $input 1]

		# See if there's anything to say
		if {$message == ""} {
			LogIt "$MVS(ansi.concern){standard_message_handler|who=$who|input=$input} Nothing to say"
			unset who input parms message
			return 0
		}

		# Limit it to the maximum message length
		if {[string length $message] > $MVS(maxmsglen)}	{
			set message [string range $message 0 $MVS(maxmsglen)]
		}

		# Broadcast the effect
		SendToAllUsers "EFFECT $MVS($who.name) $message"
		unset message
	} "USERS" {
		# Say how many users are connected
		SendToUser $who "USERS [llength $MVS(socks)]"
	} "SUB" {
		set message [strip $input 2]

		# See if there's anything to say
		if {$message == ""} {
			LogIt "$MVS(ansi.concern){standard_message_handler|who=$who|input=$input} Nothing to say"
			unset who input parms message
			return 0
		}

		# Limit it to the maximum message length
		if {[string length $message] > $MVS(maxmsglen)}	{
			set message [string range $message 0 $MVS(maxmsglen)]
		}
	
		# Disperse the message
		if {[lindex $parms 1] == "*"} {
			# Tell all users the subchannel message
			SendToAllUsers "SUB $MVS($who.name) $message"
		} else {
			# Find the user and send him the message on the subchannel
			foreach sock $MVS(socks) {
				if {$MVS($sock.name) == [lindex $parms 1]} {
					# Here he is; do it!
					SendToUser $sock "SUB $MVS($who.name) $message"
					break
				}
			}
		}
		unset message
	} "URL" {
		set message [strip $input 2]

		# See if there's anything to say
		if {$message == ""} {
			LogIt "$MVS(ansi.concern){standard_message_handler|who=$who|input=$input} Nothing to say"
			unset who input parms message
			return 0
		}

		# Limit it to the maximum message length
		if {[string length $message] > $MVS(maxmsglen)}	{
			set message [string range $message 0 $MVS(maxmsglen)]
		}
	
		# Disperse the message
		if {[lindex $parms 1] == "*"} {
			# Tell all users the subchannel message
			SendToAllUsers "URL $MVS($who.name) $message"
		} else {
			# Find the user and send him the message on the subchannel
			foreach sock $MVS(socks) {
				if {$MVS($sock.name) == [lindex $parms 1]} {
					# Here he is; do it!
					SendToUser $sock "URL $MVS($who.name) $message"
					break
				}
			}
		}
		unset message
	} "PONG" {
		# Reset the time
		set MVS($who.ping_response) [clock seconds]
	} "RSEND" {
		# Test the path name of the file to send
		if ![SanityCheck [lindex $parms 1]] {
			# The path name can't be right
			LogIt "$MVS(ansi.concern){standard_message_handler|who=$who|input=$input} Bad path name"
			unset who input parms
			return 0
		}
	
		# Chain to Serv_DCCSend
		SendRoomFile $who [lindex $parms 1]
	} "CHAT" {
		# Extricate the message portion of the CHAT line
		set message [strip $input 1]
		
		if {$message == ""} {
			# There's nothing to say!
			LogIt "$MVS(ansi.concern){standard_message_handler|who=$who|input=$input} No text on CHAT line"
			unset who input parms message
			return 0
		}

		# Limit it to the maximum message length
		if {[string length $message] > $MVS(maxmsglen)}	{
			set message [string range $message 0 $MVS(maxmsglen)]
		}

		# Broadcast the chat message
		SendToAllUsers "CHAT $MVS($who.name) $message"
		unset message
	} "SCHAT" {
	# Extricate the message portion of the SCHAT line
		set message [strip $input 2]

		if {$message == ""} {
			# There's nothing to say!
			LogIt "$MVS(ansi.concern){standard_message_handler|who=$who|input=$input} No text on SCHAT line"
			unset who input parms message
			return 0
		}

		# Limit it to the maximum message length
		if {[string length $message] > $MVS(maxmsglen)}	{
			set message [string range $message 0 $MVS(maxmsglen)]
		}

		# Broadcast the chat message
		SendToAllUsers "SCHAT [lindex $parms 1] $MVS($who.name) $message"
		unset message
	} "AVATAR" {
		# Test the validity of the arguments
		if {[TestNum [lindex $parms 2]] || \
			 	[TestNum [lindex $parms 3]] || \
			 	[TestNum [lindex $parms 4]] || \
			 	[TestNum [lindex $parms 5]] || \
			  	[TestNum [lindex $parms 6]]} {
			# Something's not a number...
			LogIt "$MVS(ansi.concern){standard_message_handler|who=$who|input=$input} Invalid number"
			SendToUser $who "BAD AVATAR"
			unset who input parms
			return 0
		} elseif {[string length [lindex $parms 2]] > 4 || \
				[string length [lindex $parms 3]] > 4 || \
				[string length [lindex $parms 4]] > 6 || \
				[string length [lindex $parms 5]] > 4 || \
				[string length [lindex $parms 6]] > 4 || \
				[lindex $parms 4] < 0} {
			# A field is out of range
			LogIt "$MVS(ansi.concern){standard_message_handler|who=$who|input=$input} Field out of range"
			SendToUser $who "BAD AVATAR"
			unset who input parms
			return 0
		}

		# It's good, so change the avatar
		Serv_ChangeAvatar $who [lindex $parms 1] [lindex $parms 2] \
				[lindex $parms 3] [lindex $parms 4] \
				[lindex $parms 5] [lindex $parms 6]
	} "WHOIS" {
		# Test the validity of the arguments
		if {[lindex $parms 1] == ""} {
			LogIt "$MVS(ansi.concern){standard_message_handler|who=$who|input=$input} Bad argument"
			unset who input parms
			return 0
		}

		# Find the requested user and send information about him
		foreach sock $MVS(socks) {
			if {$MVS($sock.name) == [lindex $parms 1] || $MVS($sock.name) == "*"} {
				SendToUser $who "WHOIS $MVS($sock.name) $MVS($sock.name)@$MVS($sock.address)"
			}
		}
	} "PRIVMSG" {
		# Find the message to send
		set message [strip $input 2] \

		# Make sure there's a message
		if {$message == ""} {
			# There's nothing to say!
			LogIt "$MVS(ansi.concern){standard_message_handler|who=$who|input=$input} Nothing to say"
			unset who input parms message
			return 0
		}

		# Limit it to the maximum message length
		if {[string length $message] > $MVS(maxmsglen)}	{
			set message [string range $message 0 $MVS(maxmsglen)]
		}

		# Disperse the message
		if {[lindex $parms 1] == "*"} {
			# Send  to all users
			SendToAllUsers "PRIVMSG $MVS($who.name) $message"
		} else {
			# Find the requested user and send him the message
			foreach sock $MVS(socks) {
				if {$MVS($sock.name) == [lindex $parms 1]} {
					# Here he is; do it!
					SendToUser $sock "PRIVMSG $MVS($who.name) $message"
					break
				}
			}
			unset sock
		}

		unset message
	} "NICK" {
		# Check nick validity
		if {$MVS($who.name) == [lindex $parms 1] || \
				![CheckName [lindex $parms 1]]} {
			# Bad nick
			LogIt "$MVS(ansi.concern){standard_message_handler|who=$who|input=$input} Bad nick"
			SendToUser $who "NAMEINUSE"
			unset who input parms
			return 0
		}

		# See if the name is in use
		foreach sock $MVS(socks) {
			if {$MVS($sock.name) == [lindex $parms 1]} {
				# It is; kick the f00 who dared intrude on it
				LogIt "$MVS(ansi.concern){standard_message_handler|who=$who|input=$input} Nick already in use"
				SendToUser $who "NAMEINUSE"
				DisconnectUser $who 1
				unset who input parms sock
				return 0
			}
		}

		# TODO: make this work without an apparent disconnect
		# Tell everyone about the change
		SendToAllUsers "NOMORE $MVS($who.name)"
		set MVS($who.name) [string range [lindex $parms 1] 0 12]
		SendToAllUsers "NEW $MVS($who.name) $MVS($who.x) $MVS($who.y) default.gif 0 20 [file size $MVS(icons)/default.gif] 24 6"
		SendToAllUsers "AVATAR $MVS($who.name) $MVS($who.avatar) $MVS($who.av_head_x) $MVS($who.av_head_y) [file size $MVS(avatars)/$MVS($who.avatar)] $MVS($who.av_baloon_x) $MVS($who.av_baloon_y)"

		unset sock
	} "TELL" {
		# Quit if there is no TELL registry
		if {[llength $MVS(tell_registry)] == 0} {
			# There's nothing to do
			LogIt "$MVS(ansi.concern){standard_message_handler|who=$who|input=$input} TELL registry empty"
			unset who input parms
			return 0
		}

		# Scan the TELL registry
		foreach tell $MVS(tell_registry) {
			set reg [split $tell " "]
			if {[lindex $parms 1] == [lindex $reg 0]} {
				# Requested object; call its hooked proc
				[lindex $reg 1] $who
			}
			unset reg
		}
		unset tell
	} "SUBMIT" {
		# Quit if there is no SUBMIT registry
		if {[llength $MVS(submit_registry)] == 0} {
			# There's nothing to do
			LogIt "$MVS(ansi.concern){standard_message_handler|who=$who|input=$input} SUBMIT registry empty"
			unset who input parms
			return 0
		}

		# Scan the SUBMIT registry
		foreach submit $MVS(submit_registry) {
			set reg [split $submit " "]
			if {[lindex $parms 1] == [lindex $reg 0]} {
				# Requested object; call its hooked proc
				[lindex $reg 1] $who
			}
			unset reg
		}
		unset submit
	} "ENTRY" {
		# Quit if there is no ENTRY registry
		if {[llength $MVS(entry_registry)] == 0} {
			# There's nothing to do
			LogIt "$MVS(ansi.concern){standard_message_handler|who=$who|input=$input} ENTRY registry empty"
			unset who input parms
			return 0
		}

		# Divine what the user wants to put in the entry form
		set text [strip $input 2]

		# Scan the ENTRY registry
		foreach entry $MVS(entry_registry) {
			set reg [split $entry " "]
			if {[lindex $parms 1] == [lindex $reg 0]} {
				# Requested object; call its hooked proc
				[lindex $reg 1] $who $text
			}
			unset reg
		}
		unset entry text
	} default {
		# This is invalid
		LogIt "$MVS(ansi.error){standard_message_handler|who=$who|input=$input} Invalid message type"
	}}

	# All's well; allow plugin processing to continue
	unset who input parms
	return 1
}

# QUERY message handler
#
# Usage: standard_message.QUERY socket input
#
# This proc handles the standard QUERY messages
proc standard_message.QUERY {who input} {
	global MVS

	switch -exact -- [lindex [split $input " "] 1] {
	"POS_ALL" {
		# Tell the user where everybody is
		foreach sock $MVS(socks) {
			SendToUser $who "MOVE $MVS($sock.name) $MVS($sock.x) $MVS($sock.y) 50"
		}
		unset sock
	} "AVATAR_MAX" {
		# Report maximum avatar size
		SendToUser $who "INFO AVATAR_MAX $MVS(maxwidth) $MVS(maxheight)"
	} "SERVER_VERSION" {
		# Report verison of server
		SendToUser $who "INFO SERVER_VERSION $MVS(server_version)"
	} "EXITS" {
		# Report all old-timey exits
		if {[llength $MVS(exits)] > 0} {
			set idx 0
			foreach exit $MVS(exits) {
				set exl [split $exit " "]
				SendToUser $who "INFO EXIT [lindex $ex1 0] [lindex $ex1 1] [lindex $ex1 2] [lindex $ex1 3] [lindex $MVS(locations) $idx]"
				incr idx
				unset exl
			}
			unset idx exit
		}
	} default {
		# This is invalid
		LogIt "$MVS(ansi.error){standard_message.QUERY|who=$who|input=$input} Invalid query type"
	}}
	
	unset who input
	return 1
}

# PUSH message handler
#
# Usage: push_message.PUSH socket input
#
# This proc lets users shove other users around.
proc push_message.PUSH {who input} {
	global MVS
	
	if !$MVS(push) {
		# No pushing allowed!  Cancel processing
		LogIt "$MVS(ansi.concern){push_message.PUSH|who=$who|input=$input} Pushing's not allowed"
		unset who input
		return 0
	}

	# Break up the input line into parameters
	set parms [split $input " "]

	# Check validity of velocity parameter
	if {[lindex $parms 1] == "" || [TestNum [lindex $parms 1]]} {
		# Bad velocity value
		LogIt "$MVS(ansi.concern){push_message.PUSH|who=$who|input=$input} Bad velocity"
		unset who input parms
		return 0
	}

	# Get velocity value and clip it to the acceptable range
	set velocity [lindex $parms 1]
	if {$velocity > $MVS(maxpushvelocity)} {
		set velocity $MVS(maxpushvelocity)
	}
	# This next little bit prevents pulling others toward user
	if {$velocity > $MVS(maxpushdistance)} {
		set velocity $MVS(maxpushdistance)
	}
	# Don't allow pushing in the opposite direction
	if {$velocity < 0} {
		set velocity 1
	}

	# See who is pushed
	foreach sock $MVS(socks) {
		# Don't allow users to push themselves
		if {$who == $sock} {continue}

		# See how far the victim is
		set distance [expr int(sqrt(($MVS($sock.x) - $MVS($who.x)) * \
				($MVS($sock.x) - $MVS($who.x)) + \
				($MVS($sock.y) - $MVS($who.y)) * \
				($MVS($sock.y) - $MVS($who.y))))]
		if {$distance <= $MVS(maxpushdistance)} {
			# Do the push
			set angle [expr atan2($MVS($sock.y) - $MVS($who.y), \
					$MVS($sock.x) - $MVS($who.x))]
			set MVS($sock.x) [expr int(cos($angle) * $velocity) + \
					$MVS($who.x)]
			set MVS($sock.y) [expr int(sin($angle) * $velocity) + \
					$MVS($who.y)]
			
			# Keep the victim onscreen
			if {$MVS($sock.x) < 0 } {set MVS($sock.x) 10}
			if {$MVS($sock.y) < 0 } {set MVS($sock.y) 10}
			if {$MVS($sock.x) > 639 } {set MVS($sock.x) 629}
			if {$MVS($sock.y) > 479 } {set MVS($sock.y) 469}

			# Tell everybody about the move
			SendToUser $sock "PUSH $MVS($sock.x) $MVS($sock.y) 20"
			SendToAllUsers "MOVE $MVS($sock.name) $MVS($sock.x) $MVS($sock.y) 20"

			# Now this... this is mean.  I vote it be removed!
			
			# Check to see if the victim has been pushed to an exit
			if {[llength $MVS(exits)] > 0} {
				set idx 0
				foreach exit $MVS(exits) {
					set exl [split $exit " "]
					if {$MVS($who.x) >= [lindex $ex1 0] && \
							$MVS($who.y) >= \
							[lindex $ex1 1] && \
							$MVS($who.x) <= \
							[lindex $ex1 2] && \
							$MVS($who.y) <= \
							[lindex $ex1 3]} {
						# Yup... inform him
						SendToUser $who "EXIT [lindex $MVS(locations) $idx]"
					}
					incr idx
					unset exl
				}
				unset idx exits
			}
			unset angle
		}
		unset distance
	}

	# Good; allow processing to continue
	unset who input parms velocity sock
	return 1
}

# PUSH default configuration setter
#
# Usage: push_init.start
#
# This proc sets the PUSH configuration defaults.
proc push_init.start {} {
	global MVS

	if {[llength [array names MVS push]] == 0} {
		# Set some defaults for the push plugin
		set MVS(push) 1
		set MVS(maxpushdistance) 142
		set MVS(maxpushvelocity) 142
	}

	return 1
}


# TRANS authtype handler
#
# Usage: standard_connect.TRANS socket input
#
# This proc handles ORT logins.
proc ortclient_connect.TRANS {who input} {
	global MVS

	# TRANS login password image image-size time ort-user-port name...

	# Quit if no ORTs are configured
	if {[llength $MVS(ORT_Server)] == 0} {
		# This dude's bogus; kick him
		LogIt "$MVS(ansi.concern){standard_connect.TRANS|who=$who|input=$input} No ORTs configured (not expecting this login); rejecting"
		SendToUser $who "AUTH REQD"
		DisconnectUser $who 0
		unset who input
		return 0
	}
	
	# Strip first word off input and break it into bite-sized parameters
	set input [string range $input [expr [string first " " $input] + 1] \
			end]
	set parms [split $input]

	# Scan ORT registry and see if this is a valid login
	set invalid 1
	for {set idx 0} {$idx < [llength $MVS(ORT_Server)]} {incr idx} {
		# Check name and password
		if {[lindex $MVS(ORT_Username) $idx] == [lindex $parms 0] && \
				[lindex $MVS(ORT_Password) $idx] == [lindex \
				$parms 1]} {
			# Valid ORT
			set invalid 0
			break
		}
	}
	if $invalid {
		# Bad ORT login
		LogIt "$MVS(ansi.conern){standard_connect.TRANS|who=$who|input=$input} Invalid ORT login; rejecting"
		SendToUser $who "AUTH REQD"
		DisconnectUser $who 0
		unset who input parms invalid idx
		return 0
	}
	
	# Get ORT image if necessary
	if {![file exists "$MVS(avatars)/[lindex $parms 2]"]} {
		LogIt "(ORT-$who) [lindex $parms 2] does not exist"
		set MVS($who.av_baloon_x) 0
		set MVS($who.av_baloon_y) 0
		GetBinaryFile $who [lindex $parms 2] [lindex $parms 3] "ORT"
	} else {
		LogIt "($who) -- [lindex $parms 2] exists"
	}

	# Tell ORT what it wants to hear and then give it the boot
	SendToUser $who "USERS [llength $MVS(socks)]"
	SendToUser $who "REGISTERED"
	DisconnectUser $who 0

	# Tell everyone about the ORT
	DisplayORT $idx [lindex $parms 2] "[string range $input [expr [string first "|" $input] + 1] end]" [lindex $parms 4] [lindex $parms 5]
	
	# The socket has been closed, so allow no further processing
	unset who input parms invalid idx
	return 0
}

# ORT displayer for new connections
#
# Usage: ortclient_connect.AUTH socket input
#
# This proc displays the ORT to the guy who just connected.
proc ortclient_connect.AUTH {who input} {
	global MVS

	# If we have an ORT stopped, display it.
	if {$MVS(ORT_current_ort) != -1} {
		# Display the fake user
		if {![file exists "$MVS(avatars)/$MVS(ORT_info.$MVS(ORT_current_ort).image)"]} {
			set image "default.gif"
		} else {
			set image "$MVS(ORT_info.$MVS(ORT_current_ort).image)"
		}
		SendToUser $who "NEW $MVS(ORT_info.$MVS(ORT_current_ort).name) $MVS(ORT_info.$MVS(ORT_current_ort).x) $MVS(ORT_info.$MVS(ORT_current_ort).y) $image 0 60 [file size $MVS(avatars)/$image] 66 -44"

		# Send the exit information
		set a $MVS(ORT_info.$MVS(ORT_current_ort).x)
		set b $MVS(ORT_info.$MVS(ORT_current_ort).y)
		SendToUser $who "EXIT_OBJ ov_tram_exit [expr $a - 60] [expr $b - 60] [expr $a + 60] [expr $b + 60] 0 $MVS(ORT_info.$MVS(ORT_current_ort).host) $MVS(ORT_info.$MVS(ORT_current_ort).port)"
		unset a b
	}

	unset who input
	return 1
}

# ORT initializer
#
# Usage: ortclient_init.start
#
# This proc starts the ORT registry process.
proc ortclient_init.start {} {
	global MVS

	# Ugly hack to see if ORT has been configured already
	if {[llength [array names MVS "ORT_Server"]] == 0} {
		# ORT configuration defaults
		set MVS(ORT_Admin) "Joe Admin";			# Admin's name
		set MVS(ORT_AdminEmail) "openverse@openverse.org";# Email addy
		set MVS(ORT_Country) "United States";		# Country
		set MVS(ORT_Description) "Description not set!";# Description
		set MVS(ORT_Image) "ov_tram_logo.gif";		# Banner image
		set MVS(ORT_Rating) "PG";			# Content rate
		set MVS(ORT_WebSite) "http://openverse.org/";	# Website

		set MVS(ORT_Server) {};				# Host IP:port
		set MVS(ORT_Username) {};			# Usernames
		set MVS(ORT_Password) {};			# Passwords
		set MVS(ORT_Location) {};			# Coordinates
	}

	# Force the ORT Image?
	set MVS(ORT.force) 0;
	set MVS(ORT.force.image) "default.gif";

	# ORT toggle
	set MVS(register_ort) 1

	# Is ORT here?
	set MVS(ORT_current_ort) -1

	# Initialize the registry list
	set MVS(registry.servers) {}

	# Register with all the ORTs specified in the configuration
	RegisterWithORTs

	return 1
}

# ORT timeout checker
#
# Usage: ortclient_CheckTimeouts
#
# This proc infinitely recalls itself.  It checks whether the ORT is taking
# too long.
proc ortclient_CheckTimeouts {} {
	global MVS

	# Quit if no ORT is set up
	if {[array names MVS "registry.servers"] == ""]} {return}

	# Check out ORT registry timeouts
	foreach sock $MVS(registry.servers) {
		if {$MVS(registry.$sock.timeout) < [expr [clock seconds] - \
				180]} {
			LogIt "$MVS(ansi.concern)($sock) -- ORT connection timeout"
			DisconnectOrtRegistry $sock
		}
	}

	# If we're serving, reload this function in 5 seconds.
	if $MVS(serving) {after 5000 ortclient_CheckTimeouts}

	catch {unset sock}
}

# ORT displayer
# 
# Usage: TransAuth index image name time port
#
# This proc displays the ORT to the users.  It also schedules it to leave.
proc DisplayORT {idx image name time port} {
	global MVS

	# Convert spaces to underscores in ORT name
	set name [join [split $name] "_"]

	# Fetch the coordinates of the ORT
	set parms [split [lindex $MVS(ORT_Location) $idx]]
	set x [lindex $parms 0]
	set y [lindex $parms 1]

	# See where the ORT server is
	set host [lindex [split [lindex $MVS(ORT_Server) $idx] ":"] 0]

	# Determine if some wonk is claiming to be the ORT
	foreach sock $MVS(socks) {
		if {$name == $MVS($sock.name)} {
			append name "_(REAL)"
			break
		}
	}

	# Set various bits of info about the ORT
	set MVS(ORT_info.$idx.image) $image
	set MVS(ORT_info.$idx.name) $name
	set MVS(ORT_info.$idx.host) $host
	set MVS(ORT_info.$idx.port) $port
	set MVS(ORT_info.$idx.time) $time
	set MVS(ORT_info.$idx.x) $x
	set MVS(ORT_info.$idx.y) $y
	set MVS(ORT_current_ort) $idx

	# Use the default image if the ORT image hasn't arrived
	if {![file exists "$MVS(avatars)/$image"]} {
		set image "default.gif"
	}

	if {$MVS(ORT.force)} {
		set image $MVS(ORT.force.image)
	}

	# Inform everybody
	SendToAllUsers "NEW $name [lindex $parms 0] [lindex $parms 1] $image 0 60 [file size $MVS(avatars)/$image] 66 -44"
	SendToAllUsers "EXIT_OBJ ov_tram_exit [expr $x - 60] [expr $y - 60] [expr $x + 60] [expr $y + 60] 0 $host $port"

	# Arrange to have the ORT whine
	after [expr 500 * $time] "WarnOrt $idx"

	unset idx image name time port parms x y host
}

# Whiny ORT facilitator
# 
# Usage: WarnOrt index
#
# This fscking proc makes the ORT whine about leaving.
proc WarnOrt {idx} {
	global MVS

	# Do the damned thing
	SendToAllUsers "CHAT $MVS(ORT_info.$idx.name) All aboard!"
	
	# And git the hell on outta here
	after [expr 500 * $MVS(ORT_info.$idx.time)] "KillOrt $idx"
}

# ORT remover
#
# Usage: KillOrt index
#
# This proc tells users the ORT has left.  Finally.
proc KillOrt {idx} {
	global MVS

	# This looks suspicious
	set MVS(ORT_current_ort) -1

	# Tell everyone the horror has passed
	SendToAllUsers "NOMORE $MVS(ORT_info.$idx.name)"
	SendToAllUsers "EXIT_OBJ ov_tram_exit 0 0 0 0 1 dummyhost 0"
	
	# Clean up the memory this ORT was using
	catch {unset MVS(ORT_info.$idx.host)}
	catch {unset MVS(ORT_info.$idx.image)}
	catch {unset MVS(ORT_info.$idx.name)}
	catch {unset MVS(ORT_info.$idx.port)}
	catch {unset MVS(ORT_info.$idx.time)}
	catch {unset MVS(ORT_info.$idx.x)}
	catch {unset MVS(ORT_info.$idx.y)}
}

# ORT registration system
#
# Usage: ReadFromOrtRegistry socket
#
# This proc reads from a connection to an ORT registrar and responds to it.
proc ReadFromOrtRegistry {sock} {
	global MVS
	
	# Read!
	set input ""
	catch {gets $sock input}
	
	# Quit if nothing was read
	if {[eof $sock] || $input == ""} {
		LogIt "$MVS(ansi.concern)($sock) -- Registration as \"$MVS(registry.$sock.username)\" failed"
		DisconnectOrtRegistry $sock
		unset sock input
		return
	}

	# Update the timeout value
	set MVS(registry.$sock.timeout) [clock seconds]

	# Break up input line into parameters and process
	set parms [split $input " "]
	switch -- [lindex $parms 0] {
	"OK" {
		# Send various bits of information about this server
		switch $MVS(registry.$sock.stage) {
		0 {puts $sock "LOGIN $MVS(registry.$sock.username)"}
		1 {puts $sock "PASSWORD $MVS(registry.$sock.password)"}
		2 {puts $sock "IMAGE $MVS(ORT_Image) [file size \
				"$MVS(homedir)/images/$MVS(ORT_Image)"]"}
		3 {puts $sock "RATING $MVS(ORT_Rating)"}
		4 {puts $sock "DESCRIPTION $MVS(ORT_Description)"}
		5 {puts $sock "STATE $MVS(ORT_State)"}
		6 {puts $sock "COUNTRY $MVS(ORT_Country)"}
		7 {puts $sock "ADMIN $MVS(ORT_Admin)"}
		8 {puts $sock "ADMINEMAIL $MVS(ORT_AdminEmail)"}
		9 {puts $sock "WEBSITE $MVS(ORT_WebSite)"}
		10 {puts $sock "PORT $MVS(port)"}
		11 {puts $sock "NAME $MVS(roomname)"}
		12 {puts $sock "END"}
		}
		incr MVS(registry.$sock.stage)
		flush $sock
	} "DCCSENDAV" {
		# Check validity of path
	 	if ![SanityCheck [lindex $parms 1]] {
			# Can't be right...
			LogIt "$MVS(ansi.concern)($sock) -- Invalid ORT avatar"
			DisconnectOrtRegistry $sock
		} else {
			# Good!  Accept the file
			Serv_DCCSend $sock [lindex $parms 1] ORT
			LogIt "($sock) -- Transferring ORT avatar"
		}
	} "GOODBYE" {
		# See if everything was sent
		if {$MVS(registry.$sock.stage) >= 13} {
			# Yup
			LogIt "($sock) -- Registration as \"$MVS(registry.$sock.username)\" successful"
		} else {
			# Nope
			LogIt "$MVS(ansi.concern)($sock) -- Registration as \"$MVS(registry.$sock.username)\" failed"
		}
		DisconnectOrtRegistry $sock
	} default {
		# Invalid input
		LogIt "$MVS(ansi.concern)($sock) -- Registration as \"$MVS(registry.$sock.username)\" failed"
		DisconnectOrtRegistry $sock
	}}
	unset sock input parms
}

# ORT registry connection killer
#
# Usage: DisconnectOrtRegistry socket
#
# This proc breaks the connection to a particular ORT registry
proc DisconnectOrtRegistry {sock} {
	global MVS

	# Close the socket
	catch {close $sock}

	# Remove the registry from the list
	set idx [lsearch $MVS(registry.servers) $sock]
	set MVS(registry.servers) [lreplace $MVS(registry.servers) $idx $idx]

	# Log the disconnection
	LogIt "($sock) -- Disconnected from ORT registry"
	
	# Clean up the memory this registry was using
	catch {unset MVS(registry.$sock.password)}
	catch {unset MVS(registry.$sock.stage)}
	catch {unset MVS(registry.$sock.timeout)}
	catch {unset MVS(registry.$sock.username)}

	unset sock
}

# Main ORT registrator
#
# Usage: RegisterWithORTs
# 
# This proc registers our server with all the ORT systems defined in the
# configuration file.  It schedules itself to be called every so often to
# keep the ORT system posted.
proc RegisterWithORTs {} {
	global MVS

	# This switches registration on and off
	if {$MVS(register_ort) && [llength $MVS(ORT_Server)] > 0} {
		set idx 0
		set MVS(registry.servers) {}
		
		# Consider every server in the list
		foreach server $MVS(ORT_Server) {
			if [catch {
				# Open connection
				set parms [split $server ":"]
				set sock [socket -async [lindex $parms 0] [lindex $parms 1]]
				fconfigure $sock -blocking 0

				# Start from the beginning (where else?)
				set MVS(registry.$sock.stage) 0

				# Fetch username and password
				set MVS(registry.$sock.username) [lindex $MVS(ORT_Username) $idx]
				set MVS(registry.$sock.password) [lindex $MVS(ORT_Password) $idx]

				# Start the dialogue
				puts $sock "TRANS_REG"

				# Initialize the timeout checker
				set MVS(registry.$sock.timeout) [clock seconds]

				# Add this guy to the list
				lappend MVS(registry.servers) $sock

				# Call this proc when the ORT replies
				fileevent $sock readable "ReadFromOrtRegistry $sock"
				flush $sock

				unset parms sock
			} error] {
				LogIt "$MVS(ansi.concern){RegisterWithORTs} Error: $error"
			} else {
				LogIt "{RegisterWithORTs} Initiating registration with $server"
			}
			incr idx
		}
		# Do this again in a bit
		after 300000 RegisterWithORTs
		unset idx
	}
}

global MVS

# Basic configuration 
if !$tcl_interactive {
	# Find the home directory of the server
	set app "$argv0"
	catch {set app [file readlink $app]}
	set MVS(homedir) "[file dirname $app]"
	if {$argv != ""} {
		set MVS(configfile) "$MVS(homedir)/$argv"
	} else {
		set MVS(configfile) ""
	}
	unset app
	set MVS(standalone) 1
} else {
	# Defaults
	set MVS(homedir) "$homedir"
	set MVS(configfile) "$MVS(homedir)/pserver.cfg"
	set MVS(standalone) 0
}


# Default to no colors
ColorSwitch 0

# Read configuration file
ReloadConfig

# Arrange to have configuration reloaded on tickle
lappend MVS(init.tickle.hooks) "ReloadConfig"

# Load the plugins
LoadPlugins

# Setup our internal routines which are registered as hooks.

# Register connection procs
lappend MVS(connect.AUTH.hooks) "standard_connect.AUTH"
lappend MVS(connect.USERS.hooks) "standard_connect.USERS"

# Register disconnection procs
# MVS(disconnect.pre.hooks) {$who}

# Register message procs
lappend MVS(message.MOVE.hooks) "standard_message"
lappend MVS(message.QUERY.hooks) "standard_message"
lappend MVS(message.QUERY.POS_ALL.hooks) "standard_message.QUERY"
lappend MVS(message.QUERY.AVATAR_MAX.hooks) "standard_message.QUERY"
lappend MVS(message.QUERY.EXITS.hooks) "standard_message.QUERY"
lappend MVS(message.SEND.hooks) "standard_message"
lappend MVS(message.DCCSENDAV.hooks) "standard_message"
lappend MVS(message.DCCSENDOB.hooks) "standard_message"
lappend MVS(message.DCCSENDROOM.hooks) "standard_message"
lappend MVS(message.EFFECT.hooks) "standard_message"
lappend MVS(message.USERS.hooks) "standard_message"
lappend MVS(message.SUB.hooks) "standard_message"
lappend MVS(message.URL.hooks) "standard_message"
lappend MVS(message.PONG.hooks) "standard_message"
lappend MVS(message.RSEND.hooks) "standard_message"
lappend MVS(message.CHAT.hooks) "standard_message"
lappend MVS(message.SCHAT.hooks) "standard_message"
lappend MVS(message.AVATAR.hooks) "standard_message"
lappend MVS(message.WHOIS.hooks) "standard_message"
lappend MVS(message.PRIVMSG.hooks) "standard_message"
lappend MVS(message.NICK.hooks) "standard_message"
lappend MVS(message.TELL.hooks) "standard_message"
lappend MVS(message.SUBMIT.hooks) "standard_message"
lappend MVS(message.ENTRY.hooks) "standard_message"
# Register initialization procs
lappend MVS(init.start.hooks) "standard_init.start"
lappend MVS(init.tickle.hooks) "standard_init.tickle"

# Register PUSH message
lappend MVS(message.PUSH.hooks) "push_message.PUSH"
# Register PUSH initialization proc
lappend MVS(init.start.hooks) "push_init.start"


# Register ORT login hooks
lappend MVS(connect.TRANS.hooks) "ortclient_connect.TRANS"
lappend MVS(connect.AUTH.hooks) "ortclient_connect.AUTH"
# Register ORT initialization hook
lappend MVS(init.start.hooks) "ortclient_init.start"



# One-time startup stuff for plugins
Initialize

# Wait until the server crashes or is stopped.
if $MVS(standalone) {vwait MVS(waiter)}