Posted to tcl by kostix at Wed Dec 06 14:14:46 GMT 2006view pretty

#! /usr/bin/wish

set host    aquinas.domain007.com
set port    6666
set timeout 2000 ;# msec
variable socket

proc connect {host port timeout} {
	set sock [socket -async $host $port]
	fileevent $sock writable [list connected $host $port $sock]

	after $timeout timed_out $sock
}

proc connected {host port sock} {
	after cancel timed_out $sock
	fileevent $sock writable {}

	set failed [catch {fconfigure $sock -peername} msg]
	if {$failed} {
		tk_messageBox -message "Failed to connect:\
			[fconfigure $sock -error]"
	} else {
		global socket
		set socket $sock
		tk_messageBox -message "Connected: [fconfigure $sock]"
	}
	.connect config -state normal
}

proc timed_out {sock} {
	shutdown $sock
	.connect config -state normal
	tk_messageBox -message "Connection timed out"
}

proc shutdown {sock} {
	catch { close $sock }
}

proc do_connect {} {
	global host port timeout

	.connect config -state disabled

	connect $host $port $timeout
}

proc do_disc {} {
	global socket
	shutdown $socket
}

foreach t {host port timeout} {
	pack [entry .$t -textvariable ::$t]
}
pack [button .connect -text "Connect" -command do_connect]
pack [button .disc -text "Disconnect" -command do_disc]