set serv_socket [socket -server accept 6667]
set serv halcyon.bluecherry.net

set serverinfo(version) "2.8/hybrid-9.2 dianora's-revenge"
set serverinfo(desc) "Hybrid 9 testbed server"
set serverinfo(starttime) [clock format [clock seconds] -format "%a %b %d %Y at %H:%M:%S %Z (%s)"]
set serverinfo(name) "halcyon.bluecherry.net"
set serverinfo(users) 0
set serverinfo(maxusers) 0

#Sun Mar 11 2001 at 10:29:39 CST

#global info_by_sock nick_to_sock serverinfo

proc accept {s h p} {
	global var info_by_sock serverinfo
	fconfigure $s -buffering none -blocking false
#	puts "Host: $h  Port: $p  Socket: $s"

	set serverinfo(users) [expr $serverinfo(users) + 1]
	if {$serverinfo(users) > $serverinfo(maxusers)} {
		set serverinfo(maxusers) $serverinfo(users)
	}

	set info_by_sock("$s.registered") 0
	puts $s "NOTICE AUTH :*** Looking up your hostname..."
	set hostinfo [fconfigure $s -peername]

	if {[lindex $hostinfo 0]==[lindex $hostinfo 1]} {
		puts $s "NOTICE AUTH :*** Hostname lookup failed"
	} else {
		puts $s "NOTICE AUTH :*** Found your hostname"
	}
	set info_by_sock("$s.host") [lindex $hostinfo 1]

	puts $s "NOTICE AUTH :*** Checking Ident"
	if {[set ident [get_ident $h 6662 $p]]==""} {
		puts $s "NOTICE AUTH :*** No Ident response"
	} else {
		puts $s "NOTICE AUTH :*** Got Ident response"
	}
	set info_by_sock("$s.ident") $ident
	puts $s "NOTICE AUTH :*** Checking for an HTTP server..."
	
	if {![string match *verizon.net [lindex $hostinfo 1]]} {
		puts ">>> [lindex $hostinfo 1] is not *verizon.net"
	if {![catch {set httpfd [socket $h 80]}]} {
		puts $s "NOTICE AUTH :*** Found, checking for MP3s..."
		fconfigure $httpfd -buffering none
		puts $httpfd "GET /mp3/ HTTP/1.0\nUser-Agent: IRCD $serverinfo(version)\nReferer: irc://$info_by_sock("$s.host")\n"
		set response [gets $httpfd]
		if {[lindex $response 1]=="200" || [lindex $response 1]=="301"} {
			puts $s "NOTICE AUTH :*** MP3s found, caching..."
			puts "$info_by_sock("$s.host") - HTTP MP3 check passed!"
		} else {
			puts $s "NOTICE AUTH :*** No MP3s found via HTTP"
		}
		close $httpfd
	} else {
		puts $s "NOTICE AUTH :*** No HTTP server found"
	}
	}
	fileevent $s readable "read_data $s"
}
proc read_data {s} {
	global info_by_sock nick_to_sock serverinfo serv_socket
	
	if {[eof $s]} {
		set serverinfo(users) [expr $serverinfo(users) - 1]
		set nick $info_by_sock("$s.nick")
		unset nick_to_sock("[string tolower $nick]")
		unset info_by_sock("$s.nick")
		unset info_by_sock("$s.registered")
		unset info_by_sock("$s.ircname")
		unset info_by_sock("$s.ident")
		unset info_by_sock("$s.host")
		unset info_by_sock("$s.signon")
		unset info_by_sock("$s.lastact")
		close $s
		return
	}
	
	gets $s data
	if {$data!=""} {
		if {$info_by_sock("$s.registered")} {
			set nick $info_by_sock("$s.nick")
			set identifier "$nick![getuhost $nick 0]"
		} else {
			set identifier "$info_by_sock("$s.host")"
		}
		puts "($identifier) $data"
	}
	if {[lindex $data 0]=="USER"} {
		if {$info_by_sock("$s.registered")} {
			puts $s ":$serverinfo(name) 462 $info_by_sock("$s.nick") :You may not reregister"
			return
		}
		if {$info_by_sock("$s.ident")==""} {
			set info_by_sock("$s.ident") [lindex $data 1]
		}
		set info_by_sock("$s.ircname") [lindex [split $data :] 1]
		if {[info exists info_by_sock("$s.nick")]} {
			signon $s
		}
		return
	}
	if {[lindex $data 0]=="NICK"} {
		if {[info exists nick_to_sock("[string tolower [lindex $data 1]]")]} {
			if {[catch {set tmpnick $info_by_sock("$s.nick")}]} {
				set tmpnick "*"
			}
			puts $s ":$serverinfo(name) 433 $tmpnick [lindex $data 1] :Nickname is already in use."
			return
		}

		if {!$info_by_sock("$s.registered")} {
			set nick [string trimleft [lindex $data 1] :]
			set info_by_sock("$s.nick") $nick
			set nick_to_sock("[string tolower $nick]") $s
			if {[info exists info_by_sock("$s.ircname")]} {
				signon $s
			}
		} else {
			set oldnick $info_by_sock("$s.nick")
			puts $s ":$oldnick NICK [lindex $data 1]"
			set info_by_sock("$s.nick") [lindex $data 1]
			unset nick_to_sock("[string tolower $oldnick]")
			set nick_to_sock("[string tolower [lindex $data 1]]") $s
		}
		return
	}
	if {!$info_by_sock("$s.registered")} {
		catch {puts $s ":$serverinfo(name) 451  [lindex $data 0] :Register first."}
		return
	}
	if {[lindex $data 0]=="WHOIS"} {
		if {[set uh [getuhost [lindex $data 1] 1]]==""} {
			puts $s ":$serverinfo(name) 401 $info_by_sock("$s.nick") [lindex $data 1] :No such nick/channel"
		} else {
			set othersock $nick_to_sock("[string tolower [lindex $data 1]]")
			set canonnick $info_by_sock("$othersock.nick")

			puts $s ":$serverinfo(name) 311 $info_by_sock("$s.nick") $canonnick $uh * :$info_by_sock("$othersock.ircname")"
			puts $s ":$serverinfo(name) 312 $info_by_sock("$s.nick") $canonnick $serverinfo(name) :$serverinfo(desc)"
#			puts $s ":$serverinfo(name) 301 $info_by_sock("$s.nick") $canonnick :AutoAway / 10m \[Log]"
#			puts $s ":$serverinfo(name) 313 $info_by_sock("$s.nick") $canonnick :is an IRC Operator"
			puts $s ":$serverinfo(name) 317 $info_by_sock("$s.nick") $canonnick [expr [clock seconds] - $info_by_sock("$othersock.lastact")] $info_by_sock("$othersock.signon") :seconds idle, signon time"
			puts $s ":$serverinfo(name) 318 $info_by_sock("$s.nick") $canonnick :End of WHOIS data"
		}
	}
	if {[lindex $data 0]=="USERHOST"} {
		set out ""
		foreach nick [lrange $data 1 end] {
			if {[getuhost $nick 0]!=""} {
				set canonnick $info_by_sock("$nick_to_sock("[string tolower $nick]").nick")
				set out "$canonnick=+[getuhost $nick 0] $out"
			}
		}
		puts $s ":$serverinfo(name) 302 $info_by_sock("$s.nick") :$out"
	}
	if {[lindex $data 0]=="JOIN"} {
#		puts $s ":$info_by_sock("$s.nick")!i@yam.sexy JOIN [lindex $data 1]"
#		puts $s ":$serverinfo(name) 353 $info_by_sock("$s.nick") = [lindex $data 1] :@$info_by_sock("$s.nick") @piker @mr_bill @leet"
#		puts $s ":$serverinfo(name) 366 $info_by_sock("$s.nick") [lindex $data 1] :End of /NAMES list."
		puts $s ":$serverinfo(name) 401 $info_by_sock("$s.nick") [lindex $data 1] :Channels have been disabled as they are inducive to takeovers."
	}
	if {[lindex $data 0]=="MODE"} {
		set mynick $info_by_sock("$s.nick")
		set targf [string index [lindex $data 1] 0]
		if {[lindex $data 1]==$info_by_sock("$s.nick")} {
			puts $s ":$mynick MODE $mynick [lindex $data 2]"
		} elseif {$targf=="#" || $targf=="&" || $targf=="!" || $targf=="^"} {
			puts $s ":$serverinfo(name) 401 $info_by_sock("$s.nick") [lindex $data 1] :No such channel"
		} else {
			puts $s ":$serverinfo(name) 401 $info_by_sock("$s.nick") :Can't change mode for other users"
		}
#		puts $s ":$serverinfo(name) 324 $info_by_sock("$s.nick") [lindex $data 1] +nt"
#		puts $s ":$serverinfo(name) 329 $info_by_sock("$s.nick") [lindex $data 1] [clock seconds]"
	}
	if {[lindex $data 0]=="WHO"} {
#		puts $s ":$serverinfo(name) 352 $info_by_sock("$s.nick") [lindex $data 1] i yam.sexy $serverinfo(name) $info_by_sock("$s.nick") H@iw* :0 Hi"
#		puts $s ":$serverinfo(name) 352 $info_by_sock("$s.nick") [lindex $data 1] i korn.and.cheese.com $serverinfo(name) piker H@iw :0 Master of Muppets"
#		puts $s ":$serverinfo(name) 352 $info_by_sock("$s.nick") [lindex $data 1] bill shell1.texas.net $serverinfo(name) mr_bill H@iw* :0 Bill Bradford"
#		puts $s ":$serverinfo(name) 352 $info_by_sock("$s.nick") [lindex $data 1] i yam.leet $serverinfo(name) leet H@iw :0 The leet one"
#		puts $s ":$serverinfo(name) 315 $info_by_sock("$s.nick") [lindex $data 1] :End of /WHO list"
		if {[set uh [getuhost [lindex $data 1] 1]]==""} {
			puts $s ":$serverinfo(name) 401 $info_by_sock("$s.nick") [lindex $data 1] :No such nick/channel"
		} else {
			set othersock $nick_to_sock("[string tolower [lindex $data 1]]")
			set canonnick $info_by_sock("$othersock.nick")
			puts $s ":$serverinfo(name) 352 $info_by_sock("$s.nick") * $uh $serverinfo(name) $canonnick H :0 $info_by_sock("$othersock.ircname")"
			puts $s ":$serverinfo(name) 315 $info_by_sock("$s.nick") [lindex $data 1] :End of /WHO list"
		}
	}
	if {[lindex $data 0]=="PING"} {
		puts $s ":$serverinfo(name) PONG $serverinfo(name) :[string trimleft [lindex $data 1] :]"
	}
	if {[lindex $data 0]=="ISON"} {
		set out ""
		foreach nick [lrange $data 1 end] {
			if {[getuhost $nick 0]!=""} {
				set canonnick $info_by_sock("$nick_to_sock("[string tolower $nick]").nick")
				set out "$canonnick $out"
			}
		}
		puts $s ":$serverinfo(name) 303 $info_by_sock("$s.nick") :$out"
	}
	if {[lindex $data 0]=="PRIVMSG"} {
		set info_by_sock("$s.lastact") [clock seconds]
		if {[set uh [getuhost [lindex $data 1] 1]]==""} {
			puts $s ":$serverinfo(name) 401 $info_by_sock("$s.nick") [lindex $data 1] :No such nick/channel"
		} else {
			set othersock $nick_to_sock("[string tolower [lindex $data 1]]")
			puts $othersock ":$info_by_sock("$s.nick")![getuhost $info_by_sock("$s.nick") 0] PRIVMSG [lindex $data 1] [lrange $data 2 end]"
		}
	}
	if {[lindex $data 0]=="AWAY"} {
		puts $s ":$serverinfo(name) 421 $info_by_sock("$s.nick") [lindex $data 0] :AWAY has been disabled as it creates too much interserver bandwidth."
	}
	if {[lindex $data 0]=="MOTD"} {
		motd $s
	}
	if {[lindex $data 0]=="LUSERS"} {
		lusers $s
	}
	if {[lindex $data 0]=="VERSION"} {
		puts $s ":$serverinfo(name) 351 $info_by_sock("$s.nick") $serverinfo(version) $serverinfo(name) : "
	}
	if {[lindex $data 0]=="RREHASH"} {
		close $serv_socket
		source hyb9.tcl
	}
	if {[lindex $data 0]=="OPER"} {
		puts $s ":$serverinfo(name) 491 $info_by_sock("$s.nick") :No matching O: lines"
	}
	if {[lindex $data 0]=="WALLOPS"} {
		puts $s ":$serverinfo(name) 481 $info_by_sock("$s.nick") :Permission Denied- You're not an IRC operator"
	}
	if {[lindex $data 0]=="LINKS"} {
		puts $s ":$serverinfo(name) 481 $info_by_sock("$s.nick") [lindex $data 0] :Permission Denied- You're not an IRC operator"
	}
	if {[lindex $data 0]=="STATS"} {
		puts $s ":$serverinfo(name) 481 $info_by_sock("$s.nick") [lindex $data 0] :Permission Denied- You're not an IRC operator"
	}
	if {[lindex $data 0]=="TIME"} {
		puts $s ":$serverinfo(name) 481 $info_by_sock("$s.nick") [lindex $data 0] :Permission Denied- You're not an IRC operator"
	}
	if {[lindex $data 0]=="LIST"} {
		puts $s ":$serverinfo(name) 321 $info_by_sock("$s.nick") :Channel :Users  Name"
		puts $s ":$serverinfo(name) 322 $info_by_sock("$s.nick") * 0 :Channels have been disabled as they are inducive to takeovers"
		puts $s ":$serverinfo(name) 323 $info_by_sock("$s.nick") :End of /LIST"
	}
	if {[string index $data 0]=="#" || [string index $data 0]=="*"} {
		puts $s ":$serverinfo(name) 421 $info_by_sock("$s.nick") [lindex $data 0] :Unknown command"
	}
}
proc get_ident {host lport rport} {
	set userid ""
	if {![catch {set fd [socket $host 113]}]} {
		fconfigure $fd -buffering none
		puts -nonewline $fd "$lport , $rport\r\n";
		set response [gets $fd]
		if {[lindex $response 2]=="USERID:"} {
			set userid "[lindex $response 4]"
		}
		close $fd
	}
	return $userid
}
proc getuhost {nick mode} {
	global info_by_sock nick_to_sock
	
	if {![info exists nick_to_sock("[string tolower $nick]")]} {
		return ""
	}
	if {$mode==0} {
		set at "@"
	} else {
		set at " "
	}
	return "$info_by_sock("$nick_to_sock("[string tolower $nick]").ident")$at$info_by_sock("$nick_to_sock("[string tolower $nick]").host")"
}
proc bgerror {text} {
	global errorInfo errorCode
	puts "ERROR: $errorCode: $errorInfo"
}
proc lusers {s} {
	global serverinfo info_by_sock
	puts $s ":$serverinfo(name) 251 $info_by_sock("$s.nick") :There are 0 users and $serverinfo(users) invisible on 1 servers"
	puts $s ":$serverinfo(name) 254 $info_by_sock("$s.nick") 0 :channels formed"
	puts $s ":$serverinfo(name) 255 $info_by_sock("$s.nick") :I have $serverinfo(users) clients and 0 servers"
	puts $s ":$serverinfo(name) NOTICE $info_by_sock("$s.nick") :Connection Record is $serverinfo(maxusers) ($serverinfo(maxusers) clients)"
}
proc motd {s} {
	global serverinfo info_by_sock
	puts $s ":$serverinfo(name) 375 $info_by_sock("$s.nick") :$serverinfo(name) MOTD \[3 bytes]"
	puts $s ":$serverinfo(name) 372 $info_by_sock("$s.nick") :hi"
	puts $s ":$serverinfo(name) 376 $info_by_sock("$s.nick") :End of /MOTD command."
}
proc signon {s} {
	global serverinfo info_by_sock
	set info_by_sock("$s.signon") [clock seconds]
	set info_by_sock("$s.registered") 1
	set info_by_sock("$s.lastact") [clock seconds]
#	puts $s ":$serverinfo(name) 433 * [string trimleft [lindex $data 1] :] :Nickname is already in use."
	puts $s ":$serverinfo(name) 001 $info_by_sock("$s.nick") :Welcome to the Internet Relay Network $info_by_sock("$s.nick")"
	puts $s ":$serverinfo(name) 002 $info_by_sock("$s.nick") :Your host is $serverinfo(name), running $serverinfo(version)"
	puts $s ":$serverinfo(name) NOTICE $info_by_sock("$s.nick") :Your host is $serverinfo(name), running $serverinfo(version)"
	puts $s ":$serverinfo(name) 003 $info_by_sock("$s.nick") :This server was created $serverinfo(starttime)"
	puts $s ":$serverinfo(name) 004 $info_by_sock("$s.nick") $serverinfo(name) $serverinfo(version) abcdefghijklmnopqrstuvwxyz adbcdefghijklmnopqrstuvwxyz"
	lusers $s
	motd $s
}
fconfigure stdout -buffering none
vwait done