#!/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
#
# Copyright (C) 1999-2001 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.
#
#
# FIRST - Setup some server variables.
#
# Please see the Technical Help section of the documentation in your
# client software for a complete list of variables and their descriptions.
# Whenever possible, they have been described here in the code too.
#
global MVS tcl_interactive
# -----------------------------------------------------------------------
set MVS(log) 1;				# Do we output our logs at all?
set MVS(log_scroll) 1;			# Do we scroll the log file in GUI mode?
set MVS(waiter) 1;			# Sleeper variable for a dedicated server.
set MVS(serving) 1;			# Is server running?
set MVS(users) 0;			# Total number of conected users.
set MVS(socks) {};			# List of connected users.
set MVS(tell_registry) {};		# List of objects with TELL registry needs.
set MVS(entry_registry) {};		# List of object with ENTRY registry needs.
set MVS(submit_registry) {};		# List of objects with SUBMIT reigstry needs.
set MVS(registry.servers) {};		# List of objects in the SERVERS registry. (Used with ORT Registrations
set MVS(ORT_current_ort) -1;		# Is an ORT stopped at our server? -1 is no.
set MVS(dcc_list) {};			# A list of active file transfers.
set MVS(dcc_num) 0;			# Self incremening list of transfer IDs
set MVS(hooks.Connect) {};		# List of hooks for new connections.
set MVS(hooks.DisconnectUser) {};	# List of hooks for DisconnectUser
set MVS(hooks.Move) {};			# List of hooks for MOVE Commands.
set MVS(hooks.Input) {};		# List of hooks for general input
set MVS(hooks.Chat) {};			# List of hooks for CHAT commands.
# -----------------------------------------------------------------------
#
# Central Logging Facility
#
# Usage: LogIt "Text To Log"
#
# Everything uses this so we must define it first.
# CRUISE - 10/23/2001 - Added a time stamp (duh!)
# CRUISE - 10/23/2001 - Added a ability to shut off logs.
#
proc LogIt {text} {
	global MVS

	if {!$MVS(log)} {return}

	set timestamp [clock format [clock seconds] -format "%b %d %Y - %T"]
	if $MVS(standalone) {
		# we are running from a command line
		puts "$timestamp -- $text"
	} else {
		# we are running from a gui
		if {[winfo exists .ovserver]} {
			.ovserver.log.text insert end "$timestamp -- $text\n"
			if {$MVS(log_scroll)} {
				.ovserver.log.text see end
			}
			# TODO (6) Check for number of lines and trim.
		}
	}
	unset text
}
#
# Send text to ALL users.
#
# Usage: SendToAllUsers "Text To Send"
#
# This function will send the provided text to all connected users. The
# text should be pre-formated and ready to go.
#
proc SendToAllUsers {what} {
	global MVS
	
	foreach sckt $MVS(socks) {
		if [string compare $MVS($sckt.name) "*"] {
			LogIt "($sckt)-> $what"
			catch {puts $sckt "$what"}
		}
	}
	unset what
}
# Server Hooks Registration
#
# Call thusly....
# RegisterHook ModuleName HookName YourFunction
#
# When a hook is activated, it will check the return value of the
# function. If it is 0, it will not continue it's normal processing. You
# should always return 1 unless you are sure you don't want the server to
# continue with the function it was processing!!!!
#
# Available hooks {and the parameters they call with} include.....
#
# ------------------------------------
# Connect {$who}
# ------------------------------------
# DisconnectUser {$who $announce}
# ------------------------------------
# Move {$who $is_exiting}
# ------------------------------------
# Input {$who $what}
# ------------------------------------
# Chat {$who $what}
# ------------------------------------
# 
proc RegisterHook {module hook func} {
	global MVS

	lappend MVS(hooks.$hook) $module
	lappend MVS(hooks.$hook.$module) $func
}
#
# (re)Load the server config file.
#
# Usage: ReloadConfig
#
# This function will (re)load the server config file. Any changes will
# take effect at the time of reload.
#
# CRUISE - 10/25/2001 - The maxusers variable was blank by default, now it's set to 100
# CRUISE - 11/08/2001 - Moved things around a bit, added some docs to the variables.
#
proc ReloadConfig {} {
	global MVS

	LogIt "------------ Loading Config File -----------"
	#
	# Basic Server Settings.
	# 
	set MVS(port) "7000";					# What port the server is runing on.
	set MVS(timeout) 120;					# Seconds to wait before calling a transfer failed.
	set MVS(roomname) "My Own Room";			# The name of this room.
	set MVS(maxheight) "200";				# Maximum allowed image height
	set MVS(maxwidth) "320";				# Maximum Allowed Image Width.
	set MVS(push) 1;					# Does the server support pushing?
	set MVS(sendbuffer) 4096;				# Sending buffer size for file transfers.
	set MVS(maxmsglen) 256;					# Maximum lengs of messages which the server accepts.
	set MVS(flood_threshold) 10;				# Maximum things a user can send before they are flooded offline.
	set MVS(exits) {};					# A list of exit server:port entries.
	set MVS(locations) {};					# A list of coords for the EXIT type exits.
	set MVS(maxpushdistance) 100;				# How far (pixels) can we push someone?
	set MVS(maxpushvelocity) 100;				# How fast can we push them?
	set MVS(max_same_users) 10;				# Maximum users from the same host.
	set MVS(maxusers) 100;					# Maximum number of users allowed to log in.
	set MVS(max_ignores) 50;				# Maximum users you may ignore (per type)
	set MVS(max_socket_retries) 20;				# Maximum times we will try to open a socket on a busy day.
	set MVS(retry_wait_time) 300;				# Time to wait between retries to open a new socket.
	#
	# File and dir names
	#
	set MVS(avatars) "$MVS(homedir)/simages";		# Where the remote user's avatars will be placed.
	set MVS(sobjects) "$MVS(homedir)/sobjects";		# The directory where avatars are stored.
	set MVS(images) "$MVS(homedir)/images";			# Where our images are stored.
	set MVS(icons) "$MVS(homedir)/icons";			# Where our icons are stored
	set MVS(tickler) "$MVS(homedir)/TickleMe";		# Config File Tickler, reload config when it exists.
	set MVS(mem_tickler) "$MVS(homedir)/TickleMem";		# Memory tickler - Dump mem when it exists.
	set MVS(roomdir) "$MVS(homedir)/rooms";			# The directory where room images are stored.
	set MVS(roomfile) "room.gif";				# The name (not the full path) of the room image.
	# 
	# ORT Section
	# 
	set MVS(register_ort) 1;				# Should we register with the ort?
	set MVS(ORT_Admin) "Joe Admin";				# The Admin's name
	set MVS(ORT_AdminEmail) "openverse@openverse.org";	# The Admin's email address.
	set MVS(ORT_Country) "United States";			# The country this server is in.
	set MVS(ORT_Description) "Description Not Set!";	# A brief description of this server.
	set MVS(ORT_Image) "ov_tram_logo.gif";			# Our banner image for the ORT
	set MVS(ORT_Rating) "PG";				# Our content Rating.
	set MVS(ORT_WebSite) "http://openverse.org/";		# This server's website address.
	set MVS(ORT_Server) {};					# A list of ORT server:port values.
	set MVS(ORT_Username) {};				# A list of ORT username values for each server.
	set MVS(ORT_Password) {};				# A list of ORT passwords for each server.
	set MVS(ORT_Location) {};				# A list of ORT screen locations for each server.
	set MVS(ORT.force) 0;					# Force the ORT image?
	set MVS(ORT.force.image) "default.gif";			# Force the ORT image?
	set MVS(ORT.msg) "All Aboard!!!";			# What does the ORT say?
	#
	# Create required directories.
	#
	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)"}
	#
	# reset the variables as we want them to be.
	#
	if [file exists "$MVS(configfile)"] {source $MVS(configfile)}
	if [file exists "$MVS(tickler)"] {
		catch {
			file delete -force "$MVS(tickler)"
		}
	}
	if [file exists "$MVS(mem_tickler)"] {
		catch {
			file delete -force "$MVS(mem_tickler)"
		}
	}
	#
	# These might have changed, lets send them just in case.
	#
	SendToAllUsers "ROOMNAME $MVS(roomname)"
	SendToAllUsers "ROOM $MVS(roomfile) [file size "$MVS(roomdir)/$MVS(roomfile)"]"
}
#
# Accept New Connections.
#
# Usage: NewConnect socket address port
#
# This function will accept a new connection and setup some initial
# variables for the user. It will also set a trigger on the incoming
# socket which will read data on the socket.
#
# CRUISE - 10/25/2001 - Made the maxusers variable actually do something.
#
proc NewConnect {sck address port} {
	global MVS

	LogIt "($sck)<- New Connection! $address:$port"
	fconfigure $sck -blocking 0 -buffering line
	fileevent $sck readable "Serv_ReadFrom $sck"
	if {[lsearch $MVS(socks) $sck] == -1} {
		lappend MVS(socks) $sck
	} else {
		close $sck
		unset sck address port
		return
	}
	set MVS($sck.name) "*"
	set MVS($sck.flood) 0
	set MVS($sck.time) [clock seconds]
	set MVS($sck.address) "$address"
	set MVS($sck.port) "$port"
	set MVS($sck.ping) 0
	set MVS($sck.ping_response) [clock seconds]
	set MVS($sck.x) -1
	set MVS($sck.y) -1
	set MVS($sck.avatar) "*connecting*"
	set MVS($sck.av_head_x) "-1"
	set MVS($sck.av_head_y) "-1"
	set MVS($sck.av_baloon_x) "-1"
	set MVS($sck.av_baloon_y) "-1"
	set MVS($sck.downloads) {}
	set MVS($sck.ig.av) {}
	set MVS($sck.ig.effect) {}
	set MVS($sck.ig.move) {}
	set MVS($sck.ig.chat) {}
	set MVS($sck.ig.sub) {}
	set MVS($sck.ig.url) {}
	set MVS($sck.ig.all) {}
	incr MVS(users)
	if !$MVS(standalone) {
		.ovserver.buttons.info.v configure -text $MVS(users)
	}
	set count 0
	foreach sock $MVS(socks) {
		if {$MVS($sock.address) == $address} {incr count}
	}
	if {$count > $MVS(max_same_users)} {
		SendToUser $sck "TOOMANYCONNECTIONS"
		DisconnectUser $sck 0
	}
	if {[llength $MVS(socks)] >= $MVS(maxusers)} {
		SendToUser $sck "ROOMFULL"
		DisconnectUser $sck 0
	}
	unset sck address port
}
#
# Check name validity.
#
# Usage: CheckName "NickName"
#
# this function will check 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] == "-"} {
		unset name
		return 0
	} else {
		unset name
		return 1
	}
}
#
# Read Incomming Text
# 
# Usage: Serv_ReadFrom socket
#
# This function will read text from a socket and process it. If the user
# is not authenticated, it will authenticate them. If the user is just
# requesting a number of connected users, this function will process the
# request. If it has nothing to do other than to read the text, it will
# pass this text off to the Serv_ProcessInput function for processing.
#
proc Serv_ReadFrom {who} {
	global MVS
	
	set input ""
	catch {gets $who input}
	# Update before we process anything!
	if {[eof $who] == 1} {
		if {![string compare $MVS($who.name) "*"]} {
			DisconnectUser $who 0
		} else {
			DisconnectUser $who 1
		}
		unset input who
		return
	}

	if {![string compare $MVS($who.name) "*"]} {
		#
		# User is not logged in yet.
		#
		LogIt "<- $input"
		set Srv_Cmd [lindex [split $input " "] 0]
		switch -- $Srv_Cmd {
			"USERS" {
				SendToUser $who "USERS [expr [llength $MVS(socks)] -1]"
				DisconnectUser $who 0
				return
			}
			"TRANS" {
				TransAuth $who $input
				return
			}
			"AUTH" {
				# For now allow it to just pass through.
				# User auth needs to be broken out of this
				# function and sent to it's own function.
			}
			default {
				SendToUser $who "AUTH REQD"
				DisconnectUser $who 0
			}
		}
		set parms [split [string range $input 5 end] " "]
		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]] } {
			SendToUser $who "AUTH FAILED (Non Numeric)"
			DisconnectUser $who 0
			unset input who
			return
		}
		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 || \
				[lindex $parms 1] < 0 || \
				[lindex $parms 2] < 0 || \
				[lindex $parms 6] < 0} {
				SendToUser $who "AUTH FAILED (String Lengths)"
				DisconnectUser $who 0
				unset input who
				return
			}

			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]
			set MVS($who.av_baloon_y) [lindex $parms 8]
			set size [lindex $parms 6]

			if ![CheckName $MVS($who.name)] {
					SendToUser $who "BADNAME"
					DisconnectUser $who 0
					unset input parms size who
					return
			}
			foreach sckt $MVS(socks) {
				if {![string compare $MVS($sckt.name) $MVS($who.name)] && [string compare $sckt $who]} {
					SendToUser $who "NAMEINUSE"
					DisconnectUser $who 0
					unset input parms size sckt who
					return
				}
			}

			# User is logged in now. But no one can see him
			# and we have not told him about anyone else. at
			# this point, a server object may want to
			# disconnect the user. If this returns 0, we will
			# disconnect the
			# user (the object should have sent notification)

			foreach hook $MVS(hooks.Connect) {
				if {![$MVS(hooks.Connect.$hook) $who]} {
					# dont notify cause no one knew
					# they were here.
					DisconnectUser $who 0
					return
				}
			}
			SendToUser $who "ROOMNAME $MVS(roomname)"
			SendToUser $who "ROOM $MVS(roomfile) [file size $MVS(roomdir)/$MVS(roomfile)]"
			#
			# If we have an ORT stopped, display it.
			#
			if {$MVS(ORT_current_ort) != -1} {
				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"
				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)"
			}
			#
			# This is where server objects happen.
			#
			SendObjects $who

			if ![file exists $MVS(avatars)/$MVS($who.avatar)] {
				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 0
			} else {
				if {[file size $MVS(avatars)/$MVS($who.avatar)] != $size} {
					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 0
				} else {
					if [CheckGif "$MVS(avatars)/$MVS($who.avatar)"] {
						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)"
					} else {
						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"
						set MVS($who.avatar) "default.gif"
					}
				}
			}

			foreach sckt $MVS(socks) {
				if [string compare $MVS($sckt.name) "*"] {
					if {[string compare $MVS($sckt.name) $MVS($who.name)]} {
						if [file exists $MVS(avatars)/$MVS($sckt.avatar)] {
							SendToUser $who "NEW $MVS($sckt.name) $MVS($sckt.x) $MVS($sckt.y) $MVS($sckt.avatar) $MVS($sckt.av_head_x) $MVS($sckt.av_head_y) [file size $MVS(avatars)/$MVS($sckt.avatar)] $MVS($sckt.av_baloon_x) $MVS($sckt.av_baloon_y)"
						} else {
							SendToUser $who "NEW $MVS($sckt.name) $MVS($sckt.x) $MVS($sckt.y) default.gif 0 20 [file size $MVS(icons)/default.gif] 24 6"
					}
				}
			}
		}
		unset input who
		return
	}
	Serv_ProcessInput $who $input
	unset input who
}
#
# Authenticate transport systems
#
# Usage: TransAuth user_socket parms_list
#
# This function will authenticate transport systems.
#
# Transport systems are assigned a username and password by each server
# which registers with a transport system. Your transport registration
# information should be in your server.cfg file.
#
proc TransAuth {who what} {
	global MVS

	if {[llength $MVS(ORT_Server)] <= 0} {
		LogIt "No ORTs Configured (not expecting this login, rejecting)"
		SendToUser $who "AUTH REQD"
		DisconnectUser $who 0
	}
	set what [string range $what [expr [string first " " $what] +1] end]
	set parms [split $what]
	#
	# Login		0
	# Password	1
	# Image		2
	# Image size	3
	# Time		4
	# OrtUserPort	5
	# name		6-
	set valid 0
	for {set idx 0} {$idx < [llength $MVS(ORT_Server)] && !$valid} {incr idx} {
		if {![string compare [lindex $MVS(ORT_Username) $idx] [lindex $parms 0]] && ![string compare [lindex $MVS(ORT_Password) $idx] [lindex $parms 1]]} {
			# Valid ORT, You are welcome here.
			set valid $idx
		}
	}
	set idx $valid
	unset valid
	if {$idx >= 0} {
		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 0
		} else {
			LogIt "(ORT - $who) Image exists."
		}
		SendToUser $who "USERS [llength $MVS(socks)]"
		SendToUser $who "REGISTERED"
		DisconnectUser $who 0	
		DisplayORT $idx [lindex $parms 2] "[string range $what [expr [string first "|" $what] +1] end]" [lindex $parms 4] [lindex $parms 5]
	} else {
		LogIt "Invalid ORT (no login/password), Rejecting Connection."
		SendToUser $who "AUTH REQD"
		DisconnectUser $who 0
	}
}
#
# Display Transport System
# 
# Usage: TransAuth index image name time port
#
# This function will display the ORT to the users. It will schedule it to
# be destroyed later.
#
proc DisplayORT {idx image name time port} {
	global MVS

	set name_parts [split $name]
	set name [join $name_parts "_"]
	set parms [split [lindex $MVS(ORT_Location) $idx]]
	set x [lindex $parms 0]
	set y [lindex $parms 1]
	set server_parms [split [lindex $MVS(ORT_Server) $idx] ":"]

	set unique 1
	foreach sck $MVS(socks) {
		if {![string compare $name $MVS($sck.name)]} {
			set unique 0
		}
	}
	if {!$unique} {
		append name "_(REAL)"
	}

	set MVS(ORT_info.$idx.image) $image
	set MVS(ORT_info.$idx.name) $name
	set MVS(ORT_info.$idx.host) [lindex $server_parms 0]
	set MVS(ORT_info.$idx.port) $port
	set MVS(ORT_info.$idx.time) $time
	set MVS(ORT_info.$idx.x) [lindex $parms 0]
	set MVS(ORT_info.$idx.y) [lindex $parms 1]
	set MVS(ORT_current_ort) $idx

	if {![file exists "$MVS(avatars)/$image"]} {
		set image "default.gif"
	}

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

	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 [lindex $server_parms 0] $port"
	after [expr 500 * $time] "WarnOrt $idx"
}
#
# Announce transport departure.
# 
# Usage: WarnOrt index
#
# This will announce that the transport is getting ready to leave.
#
proc WarnOrt {idx} {
	global MVS

	SendToAllUsers "CHAT $MVS(ORT_info.$idx.name) $MVS(ORT.msg)"
	after [expr 500 * $MVS(ORT_info.$idx.time)] "KillOrt $idx"
}
#
# Remove transport.
#
# Usage: KillOrt: index
#
# Removes a transport telling all user's it's gone.
#
proc KillOrt {idx} {
	global MVS

	set MVS(ORT_current_ort) -1
	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)}
}
#
# Disconnect users from the system.
#
# Usage: DisconnectUser socket announce_disconnect
#
# This function is used to disconnect a user from the system.
# A general cleanup will be done with the variables the user was
# consuming and an annoucement will be made to all connected users if it
# is requested with the announce_disconnect parameter (set to 1)
#
# CRUISE - 10/24/2001  - Fixing a bug which would make ending a DCC for
# 	a logged off user cause an error. UPDATE - Forgot to close listening
#	sockets :) they're closed too when a user logs off.
#
proc DisconnectUser {who announce} {
	global MVS
	
	# Process Server Hooks.
	#
	# NOTE!!! YOU NEED TO BE DAMN SURE IF YOU ARE RETURNING 0 FROM
	# YOUR HOOK TO THIS FUNCTION!
	#
	foreach hook $MVS(hooks.Connect) {
		if {![$MVS(hooks.Connect.$hook) $who $announce]} {
			return
		}
	}

	if {[lsearch -exact $MVS(socks) $who] == -1} {return}
	LogIt "($who)<- Disconnected! $MVS($who.address):$MVS($who.port)"
	incr MVS(users) -1
	if !$MVS(standalone) {
		.ovserver.buttons.info.v configure -text $MVS(users)
	}
	catch {close $who}
	set which [lsearch -exact $MVS(socks) $who]
	set MVS(socks) [lreplace $MVS(socks) $which $which]

	if $announce {
		foreach sckt $MVS(socks) {
			SendToUser $sckt "NOMORE $MVS($who.name)"
		}
	}
	#
	# Kill any DCC Transfers this user had going.
	#
	foreach idx $MVS(dcc_list) {
		if {$MVS(DCC.$idx.sender) == $who} {
			if {$MVS(DCC.$idx.server) > 0} {
				catch {close $MVS(DCC.$idx.server)}
			}
			Serv_endDCC Logout $idx 0 "User Disconnected - $MVS(DCC.$idx.file)"
		}
	}
	#
	# 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)}
	catch {unset MVS($who.flood)}
	catch {unset MVS($who.time)}
	catch {unset MVS($sck.ig.av)}
	catch {unset MVS($sck.ig.effect)}
	catch {unset MVS($sck.ig.move)}
	catch {unset MVS($sck.ig.chat)}
	catch {unset MVS($sck.ig.sub)}
	catch {unset MVS($sck.ig.url)}
	catch {unset MVS($sck.ig.all)}
}
#
# Flood Checker
#
# Usage: FloodCheck who
#
# This process keeps track of how much information the user has
# Sent to the server in how much time. It's used to disconnect
# malicious users. See the MVS(flood_threshold) variable to
# Change the ammount of flood a user is allowed.
#
proc FloodCheck {who} {
        global MVS
 
        incr MVS($who.flood)
        if {$MVS($who.flood) >= $MVS(flood_threshold)} {
                if {[clock seconds] == $MVS($who.time)} {
                        SendToUser $who "CHAT $MVS($who.name) You are being booted for flooding"
                        LogIt "($who) <- FLOODER (IP is $MVS($who.address) - BOOTING!"
                        DisconnectUser $who 1
                        return 1
                } else {
                        set MVS($who.flood) 0
                        set MVS($who.time) [clock seconds]
                }
        }
        return 0
}
#
# Send Text To a Connect User
#
# Usage: SendToUser socket "text to send"
#
# This function will send the provided text to the user specified
# It should be pre-formated and ready to go.
#
proc SendToUser {who what} {
	LogIt "($who)-> $what"
	catch {puts $who "$what"}
	unset who what
}
#
# Process Input from users.
#
# Usage: Serv_ProcessInput socket "text to process"
#
# This function is the root of the protocol. It processes all of the
# things which a client can send to the server. If the client sends
# something it does not understand... it will ignore it. Please see the
# protocol documentation within the technical documentation for a complete
# descritption of the logic within this function.
#
proc Serv_ProcessInput {who what} {
	global MVS

	LogIt "($who)<- $what"
	# Process hooks.
	#
	# If 0 is returned then we will ignore the input.
	#
	foreach hook $MVS(hooks.Input) {
		if {![$MVS(hooks.Input.$hook) $who $what]} {
			return
		}
	}

	if {[string first " " $what] != -1} {
		set cmd [string range $what 0 [expr [string first " " $what] -1]]
		set rest [string range $what [expr [string first " " $what] +1] end]
		set parms [split $rest " "]
	} else {
		set cmd $what
		set rest ""
		set parms {}
	}
	switch -exact -- $cmd {
		"MOVE" {
			if {[FloodCheck $who]} {return}
			#
			#fixes a bug that MVSbMVS found.
			#
			set retflag 0
			if {[TestNum [lindex $parms 1]] || \
				[TestNum [lindex $parms 2]] || \
				[TestNum [lindex $parms 3]]} {set retflag 1}
			if {[string length [lindex $parms 1]] > 4} {set retflag 1}
			if {[string length [lindex $parms 2]] > 4} {set retflag 1}
			if {[string length [lindex $parms 3]] > 2} {set retflag 1}
			if {[lindex $parms 1] < 0} {set retflag 1}
			if {[lindex $parms 2] < 0} {set retflag 1}
			if {[lindex $parms 3] < 0} {set retflag 1}
			if $retflag {
				unset cmd rest parms retflag
				return
			}
			set MVS($who.x) [lindex $parms 1]
			set MVS($who.y) [lindex $parms 2]
			set is_exiting 0
			set idx 0
			foreach exit $MVS(exits) {
				set exl [split $exit " "]
				set x1 	[lindex $exl 0]
				set y1 	[lindex $exl 1]
				set x2 	[lindex $exl 2]
				set y2 	[lindex $exl 3]
				if {$MVS($who.x) > $x1 && \
					$MVS($who.x) < $x2 && \
					$MVS($who.y) > $y1 && \
					$MVS($who.y) < $y2} {
						set is_exiting 1
						set eidx $idx
				}
				incr idx
				unset exl x1 y1 x2 y2
			}
			# Process hooks.
			#
			# If 0 is returned then we will stop processing.
			#
			foreach hook $MVS(hooks.Move) {
				if {![$MVS(hooks.Move.$hook) $who $is_exiting]} {
					return
				}
			}
		
			# Ignorable. We send to each from here.
			foreach w $MVS(socks) {
				if {[lsearch -exact $MVS($w.ig.move) $MVS($who.name)] == -1} {
					SendToUser $w "MOVE $MVS($who.name) [lindex $parms 1] [lindex $parms 2] [lindex $parms 3]"
				}
			}
			if $is_exiting {				
				SendToUser $who "EXIT [lindex $MVS(locations) $eidx]"
				unset eidx
			}
			unset idx is_exiting retflag
		}
		"QUERY" {
			if {[FloodCheck $who]} {return}
			switch -- [lindex $parms 0] {
				"POS_ALL" {
					foreach person $MVS(socks) {
						SendToUser $who "MOVE $MVS($person.name) $MVS($person.x) $MVS($person.y) 50"
					}
				}
			}
		}
		"PUSH" {
			if {[FloodCheck $who]} {return}
			if !$MVS(push) {return}
			set retflag 0
			if {[lindex $parms 0] == ""} {set retflag 1}
			set velocity [lindex $parms 0]
			if {[TestNum $velocity]} {set retflag 1}
			if $retflag {
				unset cmd rest parms retflag velocity
				return
			}
			if { $velocity > $MVS(maxpushvelocity)} {set velocity $MVS(maxpushvelocity)}
			if { $velocity < 0} {set velocity 1}
			foreach s $MVS(socks) {
				if {![string compare $who $s]} {continue}
				if {$MVS($who.x) >= $MVS($s.x)} {
					set xdistance [expr $MVS($who.x) - $MVS($s.x)]
					set xpush "-"
				} else {
					set xdistance [expr $MVS($s.x) - $MVS($who.x)]
					set xpush "+"
				}
				if {$MVS($who.y) >= $MVS($s.y)} {
					set ydistance [expr $MVS($who.y) - $MVS($s.y)]
					set ypush "-"
				} else {
					set ydistance [expr $MVS($s.y) - $MVS($who.y)]
					set ypush "+"
				}
				if {$xdistance <= $MVS(maxpushdistance) && $ydistance <= $MVS(maxpushdistance)} {
					LogIt "(PUSH) $xdistance $ydistance $xpush $ypush $velocity"
					set MVS($s.x) [expr $MVS($s.x) $xpush ($velocity - $ydistance)]
					set MVS($s.y) [expr $MVS($s.y) $ypush ($velocity - $xdistance)]
					if {$MVS($s.x) <= 0 } {set MVS($s.x) 10}
					if {$MVS($s.y) <= 0 } {set MVS($s.y) 10}
					if {$MVS($s.x) >= 640 } {set MVS($s.x) 630}
					if {$MVS($s.y) >= 480 } {set MVS($s.y) 470}
					set is_exiting 0
					set idx 0
					foreach exit $MVS(exits) {
						set exl [split $exit " "]
						set x1 	[lindex $exl 0]
						set y1 	[lindex $exl 1]
						set x2 	[lindex $exl 2]
						set y2 	[lindex $exl 3]
						if {$MVS($s.x) > $x1 && \
							$MVS($s.x) < $x2 && \
							$MVS($s.y) > $y1 && \
							$MVS($s.y) < $y2} {
							set is_exiting 1
							set eidx $idx
						}
						incr idx
					}
					catch {unset exl}
					if $is_exiting {
						SendToUser $s "PUSH $MVS($s.x) $MVS($s.y) 20"
						SendToAllUsers "MOVE $MVS($s.name) $MVS($s.x) $MVS($s.y) 20"
						SendToUser $s "EXIT [lindex $MVS(locations) $eidx]"
					} else {
						SendToUser $s "PUSH $MVS($s.x) $MVS($s.y) 20"
						SendToAllUsers "MOVE $MVS($s.name) $MVS($s.x) $MVS($s.y) 20"
					}
				}
			}
			catch {
				unset retflag velocity xdistance xpush ydistance \
				ypush is_exiting idx x1 y1 x2 y2 eidx
			}
		}
		"SEND" {
			if ![SanityCheck [lindex $parms 0]] {return}
			SendBinaryFile $who [lindex $parms 0]
		}
		"DCCSENDAV" {
			if ![SanityCheck [lindex $parms 0]] {return}
			Serv_DCCSend $who [lindex $parms 0] AVATAR 0
		}
		"DCCSENDOB" {
			if ![SanityCheck [lindex $parms 0]] {return}
			Serv_DCCSend $who [lindex $parms 0] OBJECT 0
		}
		"DCCSENDROOM" {
			if {[FloodCheck $who]} {return}
			if ![SanityCheck [lindex $parms 0]] {return}
			Serv_DCCSend $who [lindex $parms 0] ROOM 0
		}
		"IGNORE" {
			#
			# will accept a list of people.
			# Send only one IGNORE for each type with a list of people to ignore.
			# Maximum in (each) list is configurable.
			#
			if {[FloodCheck $who]} {return}
			set type [lindex $parms 0]
			for {set c 1} {$c < [llength $parms]} {incr c} {
				if {[string compare [lindex $parms $c] ""]} {
					switch -- $type {
						"AVATAR" {
							if {[llength $MVS($who.ig.av)] >= $MVS(max_ignores)} {
								SendToUser $who "IGNORE AVATAR LIST FULL"
								return
							}
							if {[lsearch -exact $MVS($who.ig.av) [lindex $parms $c]] == -1} {
								lappend MVS($who.ig.av) [lindex $parms $c]
							}
						}
						"EFFECT" {
							if {[llength $MVS($who.ig.effect)] > $MVS(max_ignores)} {
								SendToUser $who "IGNORE EFFECT LIST FULL"
								return
							}
							if {[lsearch -exact $MVS($who.ig.effect) [lindex $parms $c]] == -1} {
								lappend MVS($who.ig.effect) [lindex $parms $c]
							}
						}
						"MOVE" {
							if {[llength $MVS($who.ig.move)] > $MVS(max_ignores)} {
								SendToUser $who "IGNORE MOVE LIST FULL"
								return
							}
							if {[lsearch -exact $MVS($who.ig.move) [lindex $parms $c]] == -1} {
								lappend MVS($who.ig.move) [lindex $parms $c]
							}
						}
						"CHAT" {
							if {[llength $MVS($who.ig.chat)] > $MVS(max_ignores)} {
								SendToUser $who "IGNORE CHAT LIST FULL"
								return
							}
							if {[lsearch -exact $MVS($who.ig.chat) [lindex $parms $c]] == -1} {
								lappend MVS($who.ig.chat) [lindex $parms $c]
							}
						}
						"SUB" {
							if {[llength $MVS($who.ig.sub)] > $MVS(max_ignores)} {
								SendToUser $who "IGNORE SUB LIST FULL"
								return
							}
							if {[lsearch -exact $MVS($who.ig.sub) [lindex $parms $c]] == -1} {
								lappend MVS($who.ig.sub) [lindex $parms $c]
							}
						}
						"URL" {
							if {[llength $MVS($who.ig.url)] > $MVS(max_ignores)} {
								SendToUser $who "IGNORE URL LIST FULL"
								return
							}
							if {[lsearch -exact $MVS($who.ig.url) [lindex $parms $c]] == -1} {
								lappend MVS($who.ig.url) [lindex $parms $c]
							}
						}
						"ALL" {
							# AVATAR
							if {[llength $MVS($who.ig.av)] > $MVS(max_ignores)} {
								SendToUser $who "IGNORE AVATAR LIST FULL"
							} else {
								if {[lsearch -exact $MVS($who.ig.av) [lindex $parms $c]] == -1} {
									lappend MVS($who.ig.av) [lindex $parms $c]
								}
							}
							# EFFECT
							if {[llength $MVS($who.ig.effect)] > $MVS(max_ignores)} {
								SendToUser $who "IGNORE EFFECT LIST FULL"
							} else {
								if {[lsearch -exact $MVS($who.ig.effect) [lindex $parms $c]] == -1} {
									lappend MVS($who.ig.effect) [lindex $parms $c]
								}
							}
							# MOVE
							if {[llength $MVS($who.ig.move)] > $MVS(max_ignores)} {
								SendToUser $who "IGNORE MOVE LIST FULL"
							} else {
								if {[lsearch -exact $MVS($who.ig.move) [lindex $parms $c]] == -1} {
									lappend MVS($who.ig.move) [lindex $parms $c]
								}
							}
							# CHAT
							if {[llength $MVS($who.ig.chat)] > $MVS(max_ignores)} {
								SendToUser $who "IGNORE CHAT LIST FULL"
							} else {
								if {[lsearch -exact $MVS($who.ig.chat) [lindex $parms $c]] == -1} {
									lappend MVS($who.ig.chat) [lindex $parms $c]
								}
							}
							# SUB
							if {[llength $MVS($who.ig.sub)] > $MVS(max_ignores)} {
								SendToUser $who "IGNORE SUB LIST FULL"
							} else {
								if {[lsearch -exact $MVS($who.ig.sub) [lindex $parms $c]] == -1} {
									lappend MVS($who.ig.sub) [lindex $parms $c]
								}
							}
							# URL
							if {[llength $MVS($who.ig.url)] > $MVS(max_ignores)} {
								SendToUser $who "IGNORE URL LIST FULL"
							} else {
								if {[lsearch -exact $MVS($who.ig.url) [lindex $parms $c]] == -1} {
									lappend MVS($who.ig.url) [lindex $parms $c]
								}
							}
						}
					}
				}
			}
		}
		"UNIGNORE" {
			#
			# will accept a list of people.
			# Send only one UNIGNORE for each type with a list of people to ignore.
			# Maximum in (each) list is configurable.
			#
			if {[FloodCheck $who]} {return}
			set type [lindex $parms 0]
			for {set c 1} {$c < [llength $parms]} {incr c} {
				if {[string compare [lindex $parms $c] ""]} {
					switch -- $type {
						"AVATAR" {
							if {[lsearch -exact $MVS($who.ig.av) [lindex $parms $c]] != -1} {
								set idx [lsearch -exact $MVS($who.ig.av) [lindex $parms $c]]
								set MVS($who.ig.av) [lreplace $MVS($who.ig.av) $idx $idx]
							}
						}
						"EFFECT" {
							if {[lsearch -exact $MVS($who.ig.effect) [lindex $parms $c]] != -1} {
								set idx [lsearch -exact $MVS($who.ig.effect) [lindex $parms $c]]
								set MVS($who.ig.effect) [lreplace $MVS($who.ig.effect) $idx $idx]
							}
						}
						"MOVE" {
							if {[lsearch -exact $MVS($who.ig.move) [lindex $parms $c]] != -1} {
								set idx [lsearch -exact $MVS($who.ig.move) [lindex $parms $c]]
								set MVS($who.ig.move) [lreplace $MVS($who.ig.move) $idx $idx]
							}
						}
						"CHAT" {
							if {[lsearch -exact $MVS($who.ig.chat) [lindex $parms $c]] != -1} {
								set idx [lsearch -exact $MVS($who.ig.chat) [lindex $parms $c]]
								set MVS($who.ig.chat) [lreplace $MVS($who.ig.chat) $idx $idx]
							}
						}
						"SUB" {
							if {[lsearch -exact $MVS($who.ig.sub) [lindex $parms $c]] != -1} {
								set idx [lsearch -exact $MVS($who.ig.sub) [lindex $parms $c]]
								set MVS($who.ig.sub) [lreplace $MVS($who.ig.sub) $idx $idx]
							}
						}
						"URL" {
							if {[lsearch -exact $MVS($who.ig.url) [lindex $parms $c]] != -1} {
								set idx [lsearch -exact $MVS($who.ig.url) [lindex $parms $c]]
								set MVS($who.ig.url) [lreplace $MVS($who.ig.url) $idx $idx]
							}
						}
						"ALL" {
							# AVATAR
							if {[lsearch -exact $MVS($who.ig.av) [lindex $parms $c]] != -1} {
								set idx [lsearch -exact $MVS($who.ig.av) [lindex $parms $c]]
								set MVS($who.ig.av) [lreplace $MVS($who.ig.av) $idx $idx]
							}
							# EFFECT
							if {[lsearch -exact $MVS($who.ig.effect) [lindex $parms $c]] != -1} {
								set idx [lsearch -exact $MVS($who.ig.effect) [lindex $parms $c]]
								set MVS($who.ig.effect) [lreplace $MVS($who.ig.effect) $idx $idx]
							}
							# MOVE
							if {[lsearch -exact $MVS($who.ig.move) [lindex $parms $c]] != -1} {
								set idx [lsearch -exact $MVS($who.ig.move) [lindex $parms $c]]
								set MVS($who.ig.move) [lreplace $MVS($who.ig.move) $idx $idx]
							}
							# CHAT
							if {[lsearch -exact $MVS($who.ig.chat) [lindex $parms $c]] != -1} {
								set idx [lsearch -exact $MVS($who.ig.chat) [lindex $parms $c]]
								set MVS($who.ig.chat) [lreplace $MVS($who.ig.chat) $idx $idx]
							}
							# SUB
							if {[lsearch -exact $MVS($who.ig.sub) [lindex $parms $c]] != -1} {
								set idx [lsearch -exact $MVS($who.ig.sub) [lindex $parms $c]]
								set MVS($who.ig.sub) [lreplace $MVS($who.ig.sub) $idx $idx]
							}
							# URL
							if {[lsearch -exact $MVS($who.ig.url) [lindex $parms $c]] != -1} {
								set idx [lsearch -exact $MVS($who.ig.url) [lindex $parms $c]]
								set MVS($who.ig.url) [lreplace $MVS($who.ig.url) $idx $idx]
							}
						}
					}
				}
			}
		}
		"EFFECT" {
			if {[FloodCheck $who]} {return}
			# Ignorable. We send to each from here.
			foreach w $MVS(socks) {
				if {[lsearch -exact $MVS($w.ig.effect) $MVS($who.name)] == -1} {
					SendToUser $w "EFFECT $MVS($who.name) [lindex $parms 0]"
				}
			}
		}
		"USERS" {
			if {[FloodCheck $who]} {return}
			SendToUser $what "USERS [llength $MVS(socks)]"
		}
		"SUB" {
			if {[lindex $parms 0] == ""} {return}
			set stuff [string range $rest [expr [string first " " $rest] +1] end]
			if {[string length $stuff] > $MVS(maxmsglen)} {
				set stuff [string range $stuff 0 $MVS(maxmsglen)]
			}
			foreach s $MVS(socks) {
				if {![string compare $MVS($s.name) [lindex $parms 0]] || ![string compare [lindex $parms 0] "*"]} {
					if {[lsearch -exact $MVS($s.ig.sub) $MVS($who.name)] == -1} {
						SendToUser $s "SUB $MVS($who.name) $stuff"
					}
				}
			}
			unset stuff
		}
		"URL" {
			if {[FloodCheck $who]} {return}
			if {[lindex $parms 0] == ""} {return}
			set stuff [string range $rest [expr [string first " " $rest] +1] end]
			if {[string length $stuff] > $MVS(maxmsglen)} {
				set stuff [string range $stuff 0 $MVS(maxmsglen)]
			}
			foreach s $MVS(socks) {
				if {![string compare $MVS($s.name) [lindex $parms 0]] || ![string compare [lindex $parms 0] "*"]} {
					if {[lsearch -exact $MVS($s.ig.sub) $MVS($who.name)] == -1} {
						SendToUser $s "URL $MVS($who.name) $stuff"
					}
				}
			}
			unset stuff
		}
		"PONG" {
			if {[FloodCheck $who]} {return}
			set MVS($who.ping_response) [clock seconds]
		}
		"RSEND" {
			if {[FloodCheck $who]} {return}
			if ![SanityCheck [lindex $parms 0]] {return}
			SendRoomFile $who [lindex $parms 0]
		}
		"CHAT" {
			if {[FloodCheck $who]} {return}
			set cmsg [string range $rest 0 $MVS(maxmsglen)]
			if {[string compare $rest ""]} {
				# Process hooks.
				#
				# If 0 is returned then we will ignore the input.
				#
				set ig 0
				foreach hook $MVS(hooks.Chat) {
					if {![$MVS(hooks.Chat.$hook) $who $cmsg]} {
						set ig 1
					}
				}
				if {!$ig} {
					foreach s $MVS(socks) {
						if {[lsearch -exact $MVS($s.ig.chat) $MVS($who.name)] == -1} {
							SendToUser $s "CHAT $MVS($who.name) $cmsg"
						}
					}
				}
			}
		}
		"SCHAT" {
			if {[FloodCheck $who]} {return}
			set parms [split $rest " "]
			set rest [string range $rest [expr [string first " " $rest] +1] end]
			if {[string compare $rest ""]} {
				foreach s $MVS(socks) {
					if {[lsearch -exact $MVS($s.ig.chat) $MVS($who.name)] == -1} {
						SendToUser $s "SCHAT [lindex $parms 0] $MVS($who.name) [string range $rest 0 $MVS(maxmsglen)]"
					}
				}
			}
		}
		"AVATAR" {
			if {[FloodCheck $who]} {return}
			  if {[TestNum [lindex $parms 1]] || \
			 	[TestNum [lindex $parms 2]] || \
			 	[TestNum [lindex $parms 3]] || \
			 	[TestNum [lindex $parms 4]] || \
			  	[TestNum [lindex $parms 5]]} {
				SendToUser $who "BAD AVATAR"
				unset cmd rest parms
				return
			}
			set retflag 0
			if {[string length [lindex $parms 1]] > 4} {set retflag 1}
			if {[string length [lindex $parms 2]] > 4} {set retflag 1}
			if {[string length [lindex $parms 3]] > 6} {set retflag 1}
			if {[string length [lindex $parms 4]] > 4} {set retflag 1}
			if {[string length [lindex $parms 5]] > 4} {set retflag 1}
			if {[lindex $parms 3] < 0} {set retflag 1}
			if $retflag {
				unset cmd rest parms retflag
				return
			}
			Serv_ChangeAvatar $who [lindex $parms 0] [lindex $parms 1] [lindex $parms 2] [lindex $parms 3] [lindex $parms 4] [lindex $parms 5]
		}
		"WHOIS" {
			if {[FloodCheck $who]} {return}
			if {[lindex $parms 0] == ""} {return}
			foreach s $MVS(socks) {
				if {![string compare $MVS($s.name) [lindex $parms 0]] || ![string compare [lindex $parms 0] "*"]} {
					SendToUser $who "WHOIS $MVS($s.name) $MVS($s.name)@$MVS($s.address)"
				}
			}
		}
		"PRIVMSG" {
			if {[FloodCheck $who]} {return}
			if {[lindex $parms 0] == ""} {return}
			set stuff [string range $rest [expr [string first " " $rest] +1] end]
			if {[string length $stuff] > $MVS(maxmsglen)} {
				set stuff [string range $stuff 0 $MVS(maxmsglen)]
			}
			foreach s $MVS(socks) {
				if {![string compare $MVS($s.name) [lindex $parms 0]] || ![string compare [lindex $parms 0] "*"]} {
					if {[lsearch -exact $MVS($s.ig.chat) $MVS($who.name)] == -1} {
						SendToUser $s "PRIVMSG $MVS($who.name) $stuff"
					}
				}
			}
			unset stuff
		}
		"NICK" {
			if {[FloodCheck $who]} {return}
			if {![string compare $MVS($who.name) [lindex $parms 0]] || ![string compare $MVS($who.name) "*"]} {
				unset cmd rest parms
				return
			}
			if ![CheckName [lindex $parms 0]] {
				SendToUser $who "NAMEINUSE"
				unset cmd rest parms
				return
			}
			foreach sckt $MVS(socks) {
				if {![string compare $MVS($sckt.name) [lindex $parms 0]]} {
					SendToUser $who "NAMEINUSE"
					DisconnectUser $what 1
					unset cmd rest parms
					return
				}
			}
			SendToAllUsers "NOMORE $MVS($who.name)"
			set MVS($who.name) [string range [lindex $parms 0] 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"
 			SendAvatarToAll $who $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)
		}
		"TELL" {
			if {[FloodCheck $who]} {return}
			# Object Interaction. (tell)
			foreach tell $MVS(tell_registry) {
				set reg [split $tell " "]
				if {[lindex $parms 0] == [lindex $reg 0]} {
					[lindex $reg 1] $who
				}
			}
		}
		"SUBMIT" {
			if {[FloodCheck $who]} {return}
			# Object Interaction. (submit)
			foreach submit $MVS(submit_registry) {
				set reg [split $submit " "]
				if {[lindex $parms 0] == [lindex $reg 0]} {
					[lindex $reg 1] $who
				}
			}
		}
		"ENTRY" {
			if {[FloodCheck $who]} {return}
			# Object Interaction.
			set text [string range $rest [expr [string first " " $rest] +1] end]
			if {![string compare $text $rest]} {set text ""}
			foreach entry $MVS(entry_registry) {
				set reg [split $entry " "]
				if {[lindex $parms 0] == [lindex $reg 0]} {
					[lindex $reg 1] $who $text
				}
			}
		}
	}
	unset cmd rest parms
}
#
# Send the AVATAR command.
#
# Usage: SendAvatarToAll who filename nametag_x nametag_y size balloon_x balloon_y
#
# This is centralized here so that ignoring it is easier.
# All it does is send the AVATAR command out. You should be using
# Serv_ChangeAvatar to do this.
#
proc SendAvatarToAll {who what x y size bx by} {
	global MVS
	foreach w $MVS(socks) {
		if {[lsearch -exact $MVS($w.ig.av) $MVS($who.name)] == -1} {
			SendToUser $w "AVATAR $MVS($who.name) $what $x $y $size $bx $by"
		}
	}
}
#
# Change a user's avatar.
#
# Usage: Serv_ChangeAvatar who avatar_name nametag_x nametag_y size
#		balloon_x balloon_y
#
# This function is used to change a user's avatar. It will announce the
# change to all connected users.
#
proc Serv_ChangeAvatar {who what x y size bx by} {
	global MVS

	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 {![string compare $what "default.gif"]} {
		SendAvatarToAll $who $what $MVS($who.av_head_x) $MVS($who.av_head_y) [file size $MVS(icons)/$what] $bx $by
		return
	}
	if ![file exists $MVS(avatars)/$what] {
		LogIt "-> $what does not exist"
		GetBinaryFile $who $MVS($who.avatar) $size AVATAR 0
	} else {
		if {[file size $MVS(avatars)/$what] != $size} {
			LogIt "-> $what $size != [file size $MVS(avatars)/$what]"
			GetBinaryFile $who $MVS($who.avatar) $size AVATAR 0
		} else {
			if [CheckGif "$MVS(avatars)/$what"] {
				SendAvatarToAll $who $what $MVS($who.av_head_x) $MVS($who.av_head_y) [file size $MVS(avatars)/$what] $bx $by
			} else {
				SendAvatarToAll $who default.gif 0 20 [file size $MVS(icons)/default.gif] 24 6
				SendToUser $who "TOOBIG"
				set MVS($who.avatar) "default.gif"
			}
		}
	}
}
#
# Check various timeouts and events.
#
# Usage: Serv_CheckTimeouts
#
# This function should be run only ONCE when the server is started. It
# should never be run multiple times within a given instance. Once it is
# run, it will re-spawn iteself later and check again, add infinitium.
# What it does is check timeouts. Download Timeouts, Ping Timeouts and it
# also checks for the existance of a tickler file which, when it exists,
# will cause the server to reload it's config file.
#
proc Serv_CheckTimeouts {} {
	global MVS

	#
	# Check user ping times.
	#
	set tme [clock seconds]
	set disco {}
	foreach who $MVS(socks) {
		if {[expr $tme - $MVS($who.ping_response)] > 320} {
			LogIt "($who) - Ping Timeout!"
			lappend disco $who
		} else {
			if {[expr $tme - $MVS($who.ping)] > 150} {
				set MVS($who.ping) [clock seconds]
				SendToUser $who "PING"
			}
		}
	}
	foreach who $disco {
		DisconnectUser $who 1
	}
	#
	# Check active downloads.
	#
	set tme [clock seconds]
	foreach idx $MVS(dcc_list) {
		if {[expr $tme - $MVS(DCC.$idx.time)] > $MVS(timeout)} {
			if {$MVS(DCC.$idx.server) > 0} {
				catch {close $MVS(DCC.$idx.server)}
			}
			Serv_endDCC Timer $idx 0 "Connection Timed Out $MVS(DCC.$idx.file)"
		}
	}
	#
	# Check out ORT Registry timeouts.
	#
	foreach sck $MVS(registry.servers) {
		if {$MVS(registry.$sck.timeout) < [expr [clock seconds] - 180]} {
			LogIt "(ORT) Connection to $sck timed out!"
			DisconnectOrtRegistry $sck
		}
	}
	#
	# Check for tickler file(s)
	#
	if [file exists "$MVS(tickler)"] {ReloadConfig}
	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
	}
	unset disco tme
}
#
# Error Logging Routine.
#
# Usage: Used internally when an error occurs.
#
# Will print out information on errors
# and continue running (we hope)
#
proc bgerror {stuff} {
	global errorInfo
	global errorCode
	
	LogIt "-------------------------------------"
	LogIt "BGERROR Begin"
	LogIt "-------------------------------------"
	LogIt "Error Code: $stuff"
	LogIt "-------------------------------------"
	LogIt $errorInfo
	LogIt "-------------------------------------"
	LogIt "BGERROR End"
	LogIt "-------------------------------------"
}
#
# Check for duplicate downloads.
#
# Usage: MVSerifyAvailable socket filename
#
# This function will check to see if the
# user is already getting the file named.
#
proc MVSerifyAvailable {who what} {
	global MVS


	foreach idx $MVS(dcc_list) {
		if {![string compare $MVS(DCC.$idx.sender) $who] && ![string compare "[file tail $MVS(DCC.$idx.file)]" $what]} {
			return 0
		}
	}
	return 1
}
#
#
# Scheduler routine for Serv_DCCSend
#
# Usage: SchedServ_DCCSend index who
#
# Schedules downloads to be sent again if there was not
# enough resources to send it the first time. It is done
# though this routine to prevent hack with filenames
# interrupting the code.
#
# CRUISE - 11/01/2001 - Fixed a bug here, had GBF array for type,  not SDCCS
#
proc SchedServ_DCCSend {idx who} {
	global MVS

	Serv_DCCSend $MVS($who.SDCCS.$idx.who) $MVS($who.SDCCS.$idx.what) $MVS($who.SDCCS.$idx.type) $idx
}
#
# Send a file
#
# Usage: Serv_DCCSend socket filename transfer_type retry_flag
#
# This function will initiate a file transfer. It is used for rooms and
# avatars and object images. This is a passive dcc transfer so things work
# better through modern firewalls.
#
proc Serv_DCCSend {who what type retry} {
	global MVS

	if ![MVSerifyAvailable $who $what] {
		LogIt "($who) -- Already Getting $what"
		return
	}

	switch -exact -- $type {
		"AVATAR" {
			if {![string compare $what "default.gif"]} {
				set file "$MVS(icons)/default.gif"
			} else {
				set file "$MVS(avatars)/$what"
			}
			set GETCMD "DCCGETAV"
		}
		"OBJECT" {
			set file "$MVS(images)/$what"
			set GETCMD "DCCGETOB"
		}
		"ROOM" {
			set file "$MVS(roomdir)/$what"
			set GETCMD "DCCGETROOM"
		}
		"ORT" {
			set file "$MVS(homedir)/images/$what"
			set GETCMD "DCCGETAV"
		}
		default {return}
	}

	if {[file exists $file]} {
		if {![file readable $file]} {
            		LogIt "($who) (Serv_DCCSend) Cannot read file $file."
			return
		}

		set size [file size $file]
		#
		# BUG - We're having problems with an error here
		# which reads "No Buffer Space Available"
		# Lets keep trying with a max timeout.
		#
		if {!$retry} {
			set idx [incr MVS(dcc_num)]
		} else {
			set idx $retry
		}
		
		if {[catch {set sock [socket -server "Serv_acceptSend $idx" 0]}]} {
			#
			# Secure the variable settings in this array.
			# for a retry.
			#
			set MVS($who.SDCCS.$idx.who) $who
			set MVS($who.SDCCS.$idx.what) $what
			set MVS($who.SDCCS.$idx.type) $type
			if {$retry} {
				incr MVS($who.SDCCS.$idx.tries)
			} else {
				set MVS($who.SDCCS.$idx.tries) 1
			}
			LogIt "($who) (Serv_DCCSend) Unable to open listening socket. Try number $MVS($who.SDCCS.$idx.tries)"
			if {$MVS($who.SDCCS.$idx.tries) > $MVS(max_socket_retries)} {
				LogIt "($who) (Serv_DCCSend) Too Many Retries ($MVS($who.SDCCS.$idx.tries)) Giving up!"
				unset MVS($who.SDCCS.$idx.who)
        	                unset MVS($who.SDCCS.$idx.what)
        	                unset MVS($who.SDCCS.$idx.type)
        	                unset MVS($who.SDCCS.$idx.tries)
			} else {
				after $MVS(retry_wait_time) "SchedServ_DCCSend $idx $who"
				return
			}
		} else {
			if {$retry} {
				LogIt "($who) (Serv_DCCSend) Retry Success!"
				unset MVS($who.SDCCS.$idx.who)
				unset MVS($who.SDCCS.$idx.what)
				unset MVS($who.SDCCS.$idx.type)
				unset MVS($who.SDCCS.$idx.tries)
			}
		}

		if {[catch {fconfigure $sock -sockname} port]} {
			LogIt "($who) (Serv_DCCSend) Cannot get port for server - $port"
		}

		lappend MVS(dcc_list) $idx
		set MVS(DCC.$idx.sender) $who
		set MVS(DCC.$idx.file) "$file"
		set MVS(DCC.$idx.fd) -1
		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

		SendToUser $who "$GETCMD [lindex $port 2] $what $size"
		unset size idx sock
	} else {
		LogIt "($who) (Serv_DCCSend) File $file does not exist."
	}
	unset file GETCMD
}
#
# Accept pending outbout transfers.
#
# Usage: Serv_acceptSend index socket host port
#
# This function is not called directly, it is instead called by the
# opening of the server socket. It accepts the connection, closes the
# server socket and starts the sending of the file to the user.
#
proc Serv_acceptSend {index chan hst port} {
	global MVS

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

	if {[catch {open $MVS(DCC.$index.file) RDONLY} infile]} {
		Serv_endDCC Send $index 0 "Cannot read $MVS(DCC.$index.file) : $infile"
		unset infile
		return 0
	}
	set MVS(DCC.$index.fd) $infile

	if {[set posn $MVS(DCC.$index.posn)] != {} && $posn > 0} {
		if {[catch {seek $infile $posn start} msg]} {
			Serv_endDCC Send $index 0 "Cannot seek $MVS(DCC.$index.file) : $msg"
			close $infile
			unset infile posn msg
			return 0
		}
		uplevel #0 incr MVS(DCC.$index.size) -$posn
	} 

	if {$MVS(DCC.$index.size) == 0} {
		close $infile
		Serv_endDCC Send $index 1 "Transfer completed."
		unset infile posn msg
		return 1
	}

	set st [clock seconds]
	fconfigure $infile -translation binary

	if {[catch {set buffer [read $infile $MVS(sendbuffer)]} msg]} {
		Serv_endDCC Send $index 0 "Error reading $file : $msg"
		close $infile
		unset infile posn msg st buffer
		return 0
	}

	global tl
	set tl($chan) [string length $buffer]
	fconfigure $chan -blocking 0 -buffering none -translation binary
	if {[catch {puts -nonewline $chan $buffer} msg]} {
		Serv_endDCC Send $index 0 "Write error : $msg"
		close $infile
		unset infile posn msg st buffer
		return 0
	}
	LogIt "($MVS(DCC.$index.sender)) -- Accepted Serv_DCCSend"
	fileevent $chan readable "Serv_dccSendEvent $index $st $infile"
	unset infile posn msg st buffer
}
#
# The file send event (read trigger) for sending files.
#
# Usage: Serv_dccSendEvent index start_time file_stream_descriptor 
#
# This function is triggered each time the remote client sends a response
# announcing the number of bytes the server has sent to it. It will send
# some more bytes if the client has received all of what we've sent so
# far. It will end the transfer when the client informs us that it has all
# of the data we've sent.
#
proc Serv_dccSendEvent {index st fd} {
	global MVS
	
	set sk $MVS(DCC.$index.sock)
	uplevel #0 set MVS(DCC.$index.time) [clock seconds]
	set msg ""

	if {[eof $sk]} {
		Serv_endDCC Send $index 0 "Transfer interrupted"
		unset sk
		return
	}

	if {[catch {set l [read $sk 4]} msg]} {
		Serv_endDCC Send $index 0 "Read error : $msg"
		catch {unset sk msg l} 
		return
	}

	if {[string length $l] == 0} {
		Serv_endDCC Send $index 0 "Sync read error"
		catch {unset sk msg l}
		return
	}

        global tl
	set cl 0
	binary scan $l I1 cl
	if {$cl != $tl($sk)} {
		catch {unset sk msg cl l}
		return
	}

	LogIt "($MVS(DCC.$index.sender)) Got Check (OK)"
	if {![info exists fd]} {
		Serv_endDCC Send $index 0 "File descriptor closed or missing (timeout?)"
		return
	}
	if {[catch {
		if {[eof $fd]} {
			if {[set st [expr {[clock seconds] - $st}]] == 0} {
				    set st 1
			}
			catch {unset sk msg cl st l}
			Serv_endDCC Send $index 1 "Transfer completed"
			return
		} 
	} err]} {
		Serv_endDCC Send $index 0 "File descriptor closed or missing: $err"
		return
	}

	LogIt "($MVS(DCC.$index.sender)) Got Check (OK Not EOF)"

	if {[catch {set buffer [read $fd $MVS(sendbuffer)]} msg]} {
		Serv_endDCC Send $index 0 "Error reading $MVS(DCC.$index.file) : $msg"
		catch {unset sk msg cl st buffer l}
		return
	}

	if {[set lng [string length $buffer]] == 0} {
		if {[set st [expr {[clock seconds] - $st}]] == 0} {
			set st 1
		}
		catch {unset sk msg cl st buffer lng l}
		Serv_endDCC Send $index 1 "Transfer completed."
		return
	}
	incr tl($sk) $lng
	LogIt "($MVS(DCC.$index.sender)) -- Sent $lng bytes ($tl($sk) total)"
	if {[catch {puts -nonewline $sk $buffer} msg]} {
		Serv_endDCC Send $index 0 "Write error : $msg"
		catch {unset sk msg cl st buffer lng l}
		return
	}

	if {[set dt [expr {[clock seconds] - $st}]] == 0} {
		set elt 0
	} {
		set elt [expr {($MVS(DCC.$index.size) - $tl($sk)) / ($tl($sk) /([clock seconds] - $st))}]
	}
	catch {unset sk msg cl st buffer lng dt elt l}
}
#
# Scheduler routine for GetBinaryFile.
#
proc SchedGetBinaryFile {idx who} {
	global MVS

	GetBinaryFile $MVS($who.GBF.$idx.who) $MVS($who.GBF.$idx.what) $MVS($who.GBF.$idx.size) $MVS($who.GBF.$idx.type) $idx
}
#
# DCC Get Code (Passive)
#
# Usage: GetBinaryFile socket filename file size
#
# This function initializes a passive DCC transfer between a connected
# user and the server. It will set up the listening connection and tell
# the user where to connect to. It will then set up an event to accep the
# connection and transfer the file.
#
# This is our central location for DOWNLOADING files.
# 
proc GetBinaryFile {who what size type retry} {
	global MVS
	
	
	if ![SanityCheck "$what"] {
		LogIt "(!) $what fails SanityCheck"
		return
	}
	if ![MVSerifyAvailable $who $what] {
		LogIt "($who) -- Already GetTing $what from this user"
		return
	}
	set file "$MVS(avatars)/$what"	


	#
	# BUG - We're having problems with an error here
	# which reads "No Buffer Space Available"
	# Lets keep trying with a max timeout.
	#
	if {!$retry} {
		set idx [incr MVS(dcc_num)]
	} else {
		set idx $retry
	}
	if {[catch {set sock [socket -server "acceptGet $idx" 0]}]} {
		#
		# Secure the variable settings in this array.
		# for a retry.
		#
		set MVS($who.GBF.$idx.who) $who
		set MVS($who.GBF.$idx.what) $what
		set MVS($who.GBF.$idx.size) $size
		set MVS($who.GBF.$idx.type) $type
		if {$retry} {
			incr MVS($who.GBF.$idx.tries)
		} else {
			set MVS($who.GBF.$idx.tries) 1
		}
		LogIt "($who) (GetBinaryFile) Unable to open listening socket. Try number $MVS($who.GBF.$idx.tries)"
		if {$MVS($who.GBF.$idx.tries) > $MVS(max_socket_retries)} {
			LogIt "($who) (GetBinaryFile) Too Many Retries ($MVS($who.GBF.$idx.tries)) Giving up!"
			unset MVS($who.GBF.$idx.who)
                        unset MVS($who.GBF.$idx.what)
                        unset MVS($who.GBF.$idx.size)
                        unset MVS($who.GBF.$idx.type)
                        unset MVS($who.GBF.$idx.tries)
		} else {
			after $MVS(retry_wait_time) "SchedGetBinaryFile $idx $who"
			return
		}
	} else {
		if {$retry} {
			LogIt "($who) (GetBinaryFile) Retry Success!"
			unset MVS($who.GBF.$idx.who)
			unset MVS($who.GBF.$idx.what)
			unset MVS($who.GBF.$idx.size)
			unset MVS($who.GBF.$idx.type)
			unset MVS($who.GBF.$idx.tries)
		}
	}

	if {[catch {fconfigure $sock -sockname} port]} {
		LogIt "($who) (Serv_DCCSend) Cannot get port for server - $port"
	}
	lappend MVS(dcc_list) $idx
	set MVS(DCC.$idx.sender) $who
	set MVS(DCC.$idx.file) "$file"
	set MVS(DCC.$idx.fd) -1
	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)
	SendToUser $who "DCCSENDAV [lindex $port 2] $what"
	unset file idx sock port
}	
#
#
# Accept pending inbound transfers.
#
# Usage: Serv_acceptGet index socket host port
#
# This function is not called directly, it is instead called by the
# opening of the server socket. It accepts the connection, closes the
# server socket and starts the getting of the file to the user.
#
proc acceptGet {index chan hst port} {
	global MVS

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

	set file $MVS(DCC.$index.file)
	set posn $MVS(DCC.$index.posn)
	fconfigure $MVS(DCC.$index.sock) -buffering none -blocking 0 -translation binary -buffersize 4096
	set flags [list WRONLY CREAT]
	set msg ""
	if {$posn == 0} { lappend flags TRUNC }
	if {![catch {open $file $flags 0600} outfile]} {
		set MVS(DCC.$index.fd) $outfile
		if {$posn != 0} {
			if {[catch {seek $outfile $posn start} msg]} {
				close $outfile
				Serv_endDCC Get $index 0 "Cannot seek on $file : $msg"
				unset file posn flags outfile msg
				return 0
			}
			uplevel #0 incr MVS(DCC.$index.size) -$posn
		}
		uplevel #0 set tl($MVS(DCC.$index.sock)) 0
		fconfigure $outfile -translation binary 
		fileevent $MVS(DCC.$index.sock) readable "Serv_dccgevent $index [clock seconds] $outfile"
	} {
		Serv_endDCC Get $index 0 "Cannot write $file : $outfile"
		unset file posn flags outfile msg
        	return 0
	}
	unset file posn flags outfile msg
	return 1
}
#
# The file get event (read trigger) for getting files.
#
# Usage: Serv_dccgevent index start_time file_stream_descriptor 
#
# This function is triggered each time the remote client sends a response
# announcing the number of bytes the server has sent to it. It will send
# some more bytes if the client has received all of what we've sent so
# far. It will end the transfer when the client informs us that it has all
# of the data we've sent.
#
# CRUISE - 10/24/2001 - fixed a problem with unsetting sx on failed transfers
# by catching it.
#
proc Serv_dccgevent {index st out} {
	global tl MVS

	set xc 0
	set in $MVS(DCC.$index.sock)
	set leng $MVS(DCC.$index.size)
	uplevel #0 set MVS(DCC.$index.time) [clock seconds]
	set fail_type 0
	if {[eof $in]} {
		if {$tl($in) < $leng} {
			set msg "Transfer Interrupted"
			set fail_type 0
		} elseif {$tl($in) > $leng} {
			set msg "Too much data transferred!!"
			set fail_type 0
		} else {
			set sx s
			if {[set st [expr {[clock seconds] - $st}]] == 0} {
				set st 1
				set sx {}
			}
			set xc 1
			set msg "Transfer completed. [expr {$leng / ($st * 1024.0)}] Kbytes/sec"
			set fail_type 1
		}
		catch {unset sx}
		catch {unset st}
	} {
		if {![catch {set buffer [read $in]} msg]} {
			incr tl($in) [set l [string length $buffer]]
			LogIt "downloaded $l bytes ($tl($in) total)"
			if {[set dt [expr {[clock seconds] - $st}]] == 0 || $tl($in) == 0} {
				set elt 0
			} {
				set elt [expr {($leng - $tl($in)) / ($tl($in) /([clock seconds] - $st))}]
			}
			if {$leng == 0} {
				set xt 0
			} {
				set xt [expr {($tl($in) * 100.0) / $leng}]
			}
		
			if {![catch {puts -nonewline $out $buffer} msg]} {
				if {![catch {puts -nonewline $in [binary format I1 $tl($in)]} msg]} {
					flush $in
					unset xc in leng fail_type dt elt xt
					return
				}
			} else {
				set fail_type 0
			}
		} else {
			set fail_type 0
		}
    	}
	catch {close $out} 
	Serv_endDCC Get $index $fail_type $msg
	catch {unset xc in leng fail_type l dt elt xt}
}
#
# End a DCC Transfer
#
# Usage: Serv_endDCC transfer_type index fail_type debug_info
#
# This function will end a user's DCC transfer. If it is a failure, it
# will print information about the transfer out to the log, if it is
# successful and the transfer is an incoming avatar, it will announce the
# avatar to all connected users. Once it's done ending the transfer, it
# will cleanup the mess made.
#
proc Serv_endDCC {type index fail_type debug} {
        global MVS tl

	catch {close $MVS(DCC.$index.sock)}
	set idx [lsearch -exact $MVS(dcc_list) $index]
	set MVS(dcc_list) [lreplace $MVS(dcc_list) $idx $idx]
	if {![string compare $type "Get"] && $fail_type} {
		switch -- $MVS(DCC.$index.type) {
			"ORT" {
				# Wonderful!
				LogIt "(ORT) Image transfer ($MVS(DCC.$index.file)) Complete"
			}
			default {
				
				if [CheckGif "$MVS(DCC.$index.file)"] {
					SendAvatarToAll $MVS(DCC.$index.sender) [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 {
					set MVS($MVS(DCC.$index.sender).avatar) "default.gif"
					SendAvatarToAll $MVS(DCC.$index.sender) default.gif 0 20 [file size $MVS(icons)/default.gif] 24 6
					SendToUser $MVS(DCC.$index.sender) "TOOBIG"
				}
			}
		}
	}
        if !$fail_type {
		if {[info exists MVS(DCC.$index.sender]} {
                	LogIt "($MVS(DCC.$index.sender)) (DCC$type) - $debug"
		}
        }
	#
	# Close the file descriptor for this file
	# in case it wasn't closed. This should clear
	# up our file descriptor leak.
	catch {close $MVS(DCC.$index.fd)}
	#
	# 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.fd)}
	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)}
}
#
# Check gif file size
#
# Usage: CheckGif "filename"
#
# This will read in the GIF File header and determine it's size. It will
# comare the size against the server limits and report back if the file is
# good or bad.
#
proc CheckGif {file} {
	global MVS

	if {[catch {set infile [open $file r]} err]} {
		LogIt "(CheckGif) Unable to open file : $err"
		return 0
	}
	fconfigure $infile -translation binary
	set bits [read $infile 10]
	close $infile

	if {[string range $bits 0 2] != "GIF"} {
		LogIt "(CheckGif) FAILED! NOT A GIF"
		unset infile bits
		return 0
	}
	binary scan $bits s* var
	if {[lindex $var 4] <= $MVS(maxheight) && [lindex $var 3] <= $MVS(maxwidth)} {
		LogIt "(CheckGif) PASSED! [lindex $var 3] X [lindex $var 4]"
		unset infile bits var
		return 1
	} else {
		LogIt "(CheckGif) FAILED! [lindex $var 3] X [lindex $var 4]"
		unset infile bits var
		return 0
	}
}
#
# Send objects to a user.
#
# Usage: SendObjects socket
#
# This function will send all server objects to a user. It is normally
# used at connect time to initalize an object for a user. 
#
proc SendObjects {who} {
	global MVS
	foreach object [glob -nocomplain "$MVS(sobjects)/*"] {
		source $object
	}	
}
#
# this function reads input from a registry connection to an ORT. It keeps
# track of where it is in the registration process and calles any needed
# support functions based on input from the ORT. Usually, this is a quick
# process as we are usually only updating our information with the ORT.
#
proc ReadFromOrtRegistry {sck} {
	global MVS
	set input ""
	catch {gets $sck input}
	if {[eof $sck] == 1 || $input == ""} {
		LogIt "(ORT_Reg) - Registration with $MVS(registry.$sck.username) FAILED!"
		DisconnectOrtRegistry $sck
		return
	}
	set MVS(registry.$sck.timeout) [clock seconds]
	#LogIt "<- (ORT) $input"
	set parms [split $input " "]
	switch -- [lindex $parms 0] {
		"OK" {
			# Move along please.
		}
		"DCCSENDAV" {
			if ![SanityCheck [lindex $parms 1]] {
				LogIt "(ORT_Reg) - Registration with $MVS(registry.$sck.username) FAILED! (Sanity Check!)"
				DisconnectOrtRegistry $sck
				return
			}
			Serv_DCCSend $sck [lindex $parms 1] ORT 0
			LogIt "(ORT) Sending Image."
			return
		}
		"GOODBYE" {
			if {$MVS(registry.$sck.stage) >= 13} {
				LogIt "(ORT_Reg) - Registration with $MVS(registry.$sck.username) Complete."
			} else {
				LogIt "(ORT_Reg) - Registration with $MVS(registry.$sck.username) FAILED!"
			}
			DisconnectOrtRegistry $sck
			return
		}
		default {
			LogIt "(ORT_Reg) - Registration with $MVS(registry.$sck.username) FAILED!"
			DisconnectOrtRegistry $sck
			return
		}
	}
	switch $MVS(registry.$sck.stage) {
		0 {
			puts $sck "LOGIN $MVS(registry.$sck.username)"
			incr MVS(registry.$sck.stage)
			flush $sck
		}
		1 {
			puts $sck "PASSWORD $MVS(registry.$sck.password)"
			incr MVS(registry.$sck.stage)
			flush $sck
		}
		2 {
			puts $sck "IMAGE $MVS(ORT_Image) [file size "$MVS(homedir)/images/$MVS(ORT_Image)"]"
			incr MVS(registry.$sck.stage)
			flush $sck
		}
		3 {
			puts $sck "RATING $MVS(ORT_Rating)"
			incr MVS(registry.$sck.stage)
			flush $sck
		}
		4 {
			puts $sck "DESCRIPTION $MVS(ORT_Description)"
			incr MVS(registry.$sck.stage)
			flush $sck
		}
		5 {
			puts $sck "STATE $MVS(ORT_State)"
			incr MVS(registry.$sck.stage)
			flush $sck
		}
		6 {
			puts $sck "COUNTRY $MVS(ORT_Country)"
			incr MVS(registry.$sck.stage)
			flush $sck
		}
		7 {
			puts $sck "ADMIN $MVS(ORT_Admin)"
			incr MVS(registry.$sck.stage)
			flush $sck
		}
		8 {
			puts $sck "ADMINEMAIL $MVS(ORT_AdminEmail)"
			incr MVS(registry.$sck.stage)
			flush $sck
		}
		9 {
			puts $sck "WEBSITE $MVS(ORT_WebSite)"
			incr MVS(registry.$sck.stage)
			flush $sck
		}
		10 {
			puts $sck "PORT $MVS(port)"
			incr MVS(registry.$sck.stage)
			flush $sck
		}
		11 {
			puts $sck "NAME $MVS(roomname)"
			incr MVS(registry.$sck.stage)
			flush $sck
		}
		12 {
			puts $sck "END"
			incr MVS(registry.$sck.stage)
			flush $sck		
		}
	}
}
#
#
proc DisconnectOrtRegistry {sck} {
	global MVS
	catch {close $sck}
	set idx [lsearch $MVS(registry.servers) $sck]
	set MVS(registry.servers) [lreplace $MVS(registry.servers) $idx $idx]
	LogIt "(ORT) Disconnected from Ort Registry"
	#
	# Clean up the memory this registry was using.
	#
	catch {unset MVS(registry.$sck.password)}
	catch {unset MVS(registry.$sck.stage)}
	catch {unset MVS(registry.$sck.timeout)}
	catch {unset MVS(registry.$sck.username)}
}
#
# This function will register our server with the ORT systems defined in
# the config file. We must register every few minutes to let the ORT know
# that we are still alive / interested in it.
#
proc RegisterWithORTs {} {
	global MVS
	
	set idx 0
	if {$MVS(register_ort)} {
		set MVS(registry.servers) {}
		foreach server $MVS(ORT_Server) {
			if {[catch {
				set parms [split $server ":"]
				set sck [socket -async [lindex $parms 0] [lindex $parms 1]]
				fconfigure $sck -blocking 0
				set MVS(registry.$sck.stage) 0
				set MVS(registry.$sck.username) [lindex $MVS(ORT_Username) $idx]
				set MVS(registry.$sck.password) [lindex $MVS(ORT_Password) $idx]
				puts $sck "TRANS_REG"
				set MVS(registry.$sck.timeout) [clock seconds]
				lappend MVS(registry.servers) $sck
				fileevent $sck readable "ReadFromOrtRegistry $sck"
				flush $sck
			} error]} {
				LogIt "(ERROR) $error"
			} else {
				LogIt "(ORT_REG) Registering with $server"
			}
			incr idx
		}
	}
	after 300000 RegisterWithORTs
	if {$idx} {
		LogIt "(ORT_Reg) All ORT Registration(s) initiated."
	}
}
#
# Serv_DumpMem
#
# This function will dump the contents of the MVS array and is mostly used
# with the TickleMem tickler file to incvoke 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]
	set outfile [open "$MVS(homedir)/Dump.mem" "w"]
	#
	# debug all the arrays.
	#
	foreach ar $arrays {
		puts $outfile "------------------------------------------------------------------------------"
		puts $outfile " OpenVerse Server - THIS IS THE $ar\() ARRAY"
		puts $outfile "------------------------------------------------------------------------------"
		set toggle 0
		set values {}
		set keys {}
		foreach var [array get $ar] {
			if {!$toggle} {
				lappend keys $var
				set toggle 1
			} else {
				set toggle 0
			}
		}
		set keys [lsort $keys]
		foreach key $keys {
			puts $outfile [format "%-39.39s %-39.39s" $key [set $ar\($key)]]
		}
	}
	#
	# Open Files
	#
	set files 0
	puts $outfile "------------------------------------------------------------------------------"
	puts $outfile " Open FILES"
	puts $outfile "------------------------------------------------------------------------------"
	for {set c 0} {$c <= 255} {incr c} {
		if {![catch {set slist [tell file$c]} err]} {
			# This one is open.
			puts $outfile "file$c - OPEN - $slist"
			incr files
		}
	}
	if {$files} {puts $outfile "$files OPEN FILES"}
	#
	# Open Socks
	#
	set socks 0
	puts $outfile "------------------------------------------------------------------------------"
	puts $outfile " Open SOCKETS"
	puts $outfile "------------------------------------------------------------------------------"
	for {set c 0} {$c <= 255} {incr c} {
		if {![catch {set slist [tell sock$c]} err]} {
			# This one is open.
			puts $outfile "sock$c - OPEN - $slist"
			incr socks
		}
	}
	if {$socks} {puts $outfile "$socks OPEN SOCKETS"}
	puts $outfile "[expr $files + $socks] TOTAL OPEN CONNECTIONS"
	close $outfile
}
#-------------------------------------------------------------------------
#-------------------------------------------------------------------------
#	THIS IS IT, THIS IS WHERE THE SERVER IS OFICIALLY STARTED.
#-------------------------------------------------------------------------
#-------------------------------------------------------------------------
#
# Check to see if we're stand alone or not.
# If we're not stand alone, then we need to add a couple of functions.
# These are for testing variable values mostly.
#
if {!$tcl_interactive} {
	set MVS(standalone) 1
	set app "$argv0"
	catch { set app [file readlink $app] }
	set MVS(homedir) "[file dirname $app]"
	set MVS(configfile) "$MVS(homedir)/$argv"
	unset app
	# Sanity Checker.
	#
	# Usage: SanityCheck "pathname"
	#
	# Checks a path to be sure it passed sane rules. It will return 1
	# if this path passes or else it will return 0 if it does not
	# pass.
	#
	# Only defined if running standalone. (command line daemon)
	#
	proc SanityCheck {what} {
		if {[string first "../" $what] != -1} {
			unset what
			return 0
		}
		if {[string first "//" $what] != -1} {
			unset what
			return 0
		}
		if {[string first "~/" $what] != -1} {
			unset what
			return 0
		}
		if {[string range $what 0 0] == "/"} {
			unset what
			return 0
		} else { 
			unset what
			return 1
		}
	}
	#
	# Test a value to be sure it is a number.
	#
	# Usage: TestNum "12345"
	#
	# This function will test a value to be sure it is a number. The
	# function will return 0 if it is a number and 1 if it is not a
	# number.
	# only defined if running standalone. (command line daemon)
	#
	proc TestNum {number} {
		global MVS

		if {[string length [string trim $number -0123456789]]} {
			return 1
		} else {
			return 0                  
		}
	}
} else {
	set MVS(standalone) 0
	set MVS(homedir) $homedir
	set MVS(configfile) "$MVS(homedir)/pserver.cfg"
	set argv "Sourced!"
}
#
# Make sure they gave a config file name.
#
if {![string compare $argv ""]} {
	LogIt "Usage: server.tcl <Config File>"
	exit
}
#
# Load the config.
#
ReloadConfig
#
# Open the listening socket.
#
set MVS(server_socket) [socket -server NewConnect $MVS(port)]
#
# Call our recursing functions.
# These functions call themselves over time to perform routine repetetive
# tasks.
#
Serv_CheckTimeouts
RegisterWithORTs
#
# Thats it! If we are in stand alone mode then use the vwait command to 
# create a means for events to trigger wile waiting forever for a variable
# which will never be changed.
#
if $MVS(standalone) {
	vwait MVS(waiter)
}

