socket api - nonblocking tcp made easy

[user]

This is an attempt to make the built in sockets even more user friendly. I just started coding this thing, so please help me find bugs/suggest new features/tell me what you think

Code: Select all

# ::sock::Connect <host> <port> ?options?
#
#	Create a tcp connection and return the socket id or "" if it
#	failed. A failure to create the socket most likely means the dns
#	lookup failed. If you need the actual error message, it will be
#	stored in $::sock::(error)
#
#	Options:
#
#		Anything that can be set via ::sock::Set (see below), plus
#		'-myaddr <vhost>' and '-myport <local port>'


# ::sock::Listen <port> ?options?
#
#	Like Connect, but for creating listening sockets
#	All options listed under ::sock::Set can be set and are copied to
#	incoming client connections except "timeout".
#	The "onDisc" code will be executed if you set a timeout for the
#	listening socket and let it time out.
#	You can also specify a vhost using -myaddr <vhost>

# ::sock::Puts <sock> <data>
#
# 	Write data to a client socket.

# ::sock::Close <sock>
#
# 	Close a socket and clean up its mess
#	(cancel timers and unset variables used to store options)


# ::sock::Set <sock> <option> <value>
#
#	All options are stored untill the socket is closed. If the
#   connection is closed by the remote host, they are deleted AFTER 
#	invoking the "onDisc" code.
#	All options can be changed at any time, but the "onConn" code will
#	only be	evaluated once for each client socket, so changing it
#	after the connection has been established has no effect.
#
# Options:
#
#	mode <line|binary>
#		affects how data is read/written
#
#	timeout <milliseconds>
#		If the time runs out, the onDisc callback will be executed
#		before the socket is closed. The timer is killed before
#		"onConn" is executed, so you'll have to set the timeout again
#		from within your onConn code if you want it to keep running
#		after that.
#
#	onConn <code>
#		This code is executed when a connection is established
#		Appended arguments: the client socket id (and server socket id
#		if it is a client connecting to a listening socket)
#
#	onData <code>
#		Invoked when data is recieved (set to {} if you don't expect
#		to recieve any data)
#		Appended arguments: the socket id and a chunk of data
#
#	onDisc <code>
#		Invoked when an error occurs or the connection is closed by
#		the remote host or a timeout occurs.
#		Appended arguments: the socket id and reason/error message.
#
#   onAll <code>
#		A shortcut to set all the other on* callbacks to call the same
#		proc. The callback name (onConn, onData or onDisc) is appended
#		as an argument if you provide an empty "code" part, the
#		commands "onConn", "onData" and "onDisc" will be invoked in 
#		the global namespace.
#
# Reserved/custom options:
#
#	Options starting with two underscore characters (__) are reserved
#	for internal use - don't touch them!
#	Options starting with a dash (-) will be passed to the "socket" 
#	command when creating the socket and then deleted.
#
#	Feel free to invent your own options. (As long as they don't
#	conflict with the reserved ones) This can come in handy if you
#	need to store som data associated with the socket.


# ::sock::Get <sock> <option>
#
# Retrieve the value of the given option


# ::sock::Info <sock> <local|remote> <ip/host/port combinations>
# 
# Retrieve local or remote host, ip and/or port
# Eg: ::sock::Info $sock local ip:port => 127.0.0.1:6667
#     ::sock::Info $sock remote host   => wiki.tcl.tk

package require Tcl 8.2


namespace eval ::sock {

	variable ""

	# default "Connect" options
	set (connect) {
		timeout 20000
		mode line
		onAll ::sock::Log
	}

	# default "Listen" options
	set (listen) {
		timeout 0
		mode line
		onAll ::sock::Log
	}
	lappend (listen) -myaddr [info host]


	# the "public" procs
	proc Connect {host port args} {
		array set "" [concat $::sock::(connect) $args {__type client}]
		set code [concat [list socket -async] [array get "" -*] [list $host $port]]
		array unset "" -*
		if {[catch $code sock]} {
			set ::sock::(error) $sock
			return
		}
		fconfigure $sock -blocking 0
		fileevent $sock writable [list ::sock::__onConn $sock]
		variable $sock
		array set $sock {}
		foreach key [lsort -dict [array names ""]] {
			Set $sock $key $($key)
		}
		set sock
	}

	proc Listen {port args} {
		set sid [incr ::sock::(sid)]
		array set "" [concat $::sock::(listen) $args [list __type server __sid $sid]]
		set code [list socket -server [list ::sock::__onListen $sid]]
		eval lappend code [array get "" -*] [list $port]
		array unset "" -*
		if {[catch $code sock]} {
			set ::sock(error) $sock
			return
		}
		set ::sock::($sid) $sock
		variable $sock
		array set $sock {}
		foreach key [lsort -dict [array names ""]] {
			Set $sock $key $($key)
		}
		set sock
	}

	proc Puts {sock data} {
		upvar #0 ::sock::$sock ""
		if {$(mode)=="binary"} {
			puts -nonewline $sock $data
		} {
			puts $sock $data
		}
		flush $sock
	}

	proc Close {sock} {
		upvar #0 ::sock::$sock ""
		if {[info exists (__after)]} {after cancel $(__after)}
		if {$(__type)=="server"} {unset ::sock::($(__sid))}
		close $sock
		unset ""
	}

	proc Set {sock key val} {
		upvar #0 ::sock::$sock ""
		if {![array exists ""]} {error "invalid socket \"$sock\""}
		switch -- $key {
			"timeout" {
				if {[info exists (__after)]} {
					after cancel $(__after)
					unset (__after)
				}
				if {$val>0} {
					set (__after) [after $val [list ::sock::__onDisc $sock timeout]]
				}
			}
			"mode" {
				if {$(__type)=="client"} {
					if {$val=="binary"} {
						fconfigure $sock -buffering none -translation binary
					} {
						fconfigure $sock -buffering line -translation auto
					}
				}
			}
			"onData" {
				if {$(__type)=="client"} {
					if {$val=={}} {
						fileevent $sock readable {}
					} {
						fileevent $sock readable [list ::sock::__onData $sock]
					}
				}
			}
			"onAll" {
				Set $sock onConn [concat $val onConn]
				Set $sock onData [concat $val onData]
				Set $sock onDisc [concat $val onDisc]
			}
		}
		set ($key) $val
	}
	
	proc Get {sock key} {
		set ::sock::${sock}($key)
	}

	proc Info {sock where what} {
		set where [string map {local -sockname remote -peername} $where]
		foreach {ip host port} [fconfigure $sock $where] break
		string map [list ip $ip host $host port $port] $what
	}
	
	
	# "private" procs
	# (you should never have to invoke these yourself)
	if {![info exists (sid)]} {set (sid) 0}
	
	proc __onConn sock {
		upvar #0 ::sock::$sock ""
		if {[set err [fconfigure $sock -error]]!=""} {
			__onDisc $sock $err
		} {
			fileevent $sock writable {}
			__callback $(onConn) $sock
		}
	}

	proc __onListen {sid csock chost cport} {
		set ssock $::sock::($sid)
		array set "" [array get ::sock::$ssock]
		if {[info exists (__after)]} {unset (__after)}
		set (__type) client
		set (ssock) $ssock
		fconfigure $csock -blocking 0
		variable $csock
		array set $csock {}
		foreach key [lsort -dict [array names ""]] {
			Set $csock $key $($key)
		}
		__callback $(onConn) $csock $ssock
	}

	proc __onDisc {sock why} {
		upvar #0 ::sock::$sock ""
		__callback $(onDisc) $sock $why
		if {[info exists (__after)]} {after cancel $(__after)}
		close $sock
		unset ""
	}

	proc __onData sock {
		upvar #0 ::sock::$sock ""
		if {$(mode)=="binary"} {
			set code {![fblocked $sock]&&[set data [read $sock]]!=""}
		} {
			set code {[gets $sock data]>0}
		}
		if {[catch {while $code {__callback $(onData) $sock $data}} err]} {
			__onDisc $sock $err
		} elseif {[eof $sock]} {
			__onDisc $sock EOF
		} elseif {[set err [fconfigure $sock -error]]!=""} {
			__onDisc $sock $err
		}
	}

	proc __callback {code args} {
		if {[catch {uplevel #0 [concat $code $args]} err]} {
			Log "Error executing callback: $err"
		}
	}

	if {[llength [info commands putlog]]} {
		proc Log args {putlog "::sock: [join $args ", "]"}
	} {
		proc Log args {puts   "::sock: [join $args ", "]"}
	}

}

[user]

Code: Select all

# Some examples
#
# PS: the vwaits and setting of the ::done variable are there
# to enter/exit the event loop if you test the examples in tclsh.
# You can remove all the vwaits and lines containg ::done if
# you're testing under Eggdrop


# Making a http request (using onAll with empty code)
proc onConn {sock} {
	puts $sock "GET / HTTP/1.0\nHost: www.google.com\nConnection: close\n"
	sock::Set $sock mode binary
	sock::Log "REQUEST SENT."
}
proc onData {sock data} {
	sock::Log "GOT: $data"
}
proc onDisc {sock why} {
	sock::Log "DISCONNECTED: $why"
	set ::done now
}
proc test1 {} {
	sock::Connect www.google.com 80 onAll {}
	if {$::tcl_interactive} {vwait ::done}
}
test1



# Same thing with non-empty callback which makes it a bit more 
# compact and flexible...
proc test2_handler {host uri type sock {arg ""}} {
	switch -- $type {
		"onConn" {
			puts "CONN: requesting $uri from $host"
			puts $sock "GET $uri HTTP/1.0\nHost: $host\nConnection: close\n"
			# try commenting out the next line:
			sock::Set $sock mode binary
		}
		"onData" {
			puts "DATA: $arg"
		}
		"onDisc" {
			puts "DISC: $arg"
			set ::done 1
		}
	}
}
proc test2 {host port uri} {
	set sock [sock::Connect $host $port onAll [list test2_handler $host $uri]]
	if {$::tcl_interactive} {vwait ::done}
}
test2 www.google.com 80 /404


# A basic server on a random port
# It will wait for an incoming connection, send a message to the first
# client that connects, then kill both the server and client sockets.
proc test3 {} {
	set sock [sock::Listen 0]
	sock::Set $sock onConn test3_conn
	sock::Set $sock onDisc test3_disc
	sock::Set $sock timeout 60000
	set name [sock::Info $sock local ip:port]
	sock::Log test3 "Telnet to $name within 60 seconds..."
	if {$::tcl_interactive} {vwait ::done}
}
proc test3_disc {sock why} {
	set ::done now
}
proc test3_conn {csock ssock} {
	sock::Log test3_conn "Incoming connection from [sock::Info $csock remote ip:port]"
	puts $csock "Hello and good bye!"
	sock::Close $csock
	sock::Close $ssock
	set ::done now
}
test3

EDIT: here's another one

Code: Select all

# This one requires Eggdrop
# DCC chat with temporary password to prevent hijacking by port scanners
# After checking nick+password, control is handed over to the
# "onData" code passed to the dccchat proc.
proc dccchat {nick onData} {
	set pass [string trimleft [expr {rand()}] 0.]
	set sock [::sock::Listen 0 onConn [list dccchat_A $nick $pass $onData]]
	foreach {ip port} [::sock::Info $sock local "ip port"] break
	set longip [format %u [eval format 0x%02x%02x%02x%02x [split $ip .]]]
	putserv "NOTICE $nick :Your temporary password is: $pass"
	putserv "PRIVMSG $nick :\001DCC CHAT chat $longip $port\001"
}
proc dccchat_A {nick pass onData sock ssock} {
	::sock::Close $ssock
	::sock::Set $sock timeout 20000
	::sock::Puts $sock "nick?"
	::sock::Set $sock onData [list dccchat_B $nick $pass $onData]
}
proc dccchat_B {nick pass onData sock answer} {
	if {[string eq -nocase $nick $answer]} {
		::sock::Puts $sock "pass?"
		::sock::Set $sock timeout 20000
		::sock::Set $sock onData [list dccchat_C $nick $pass $onData]
	} {
		::sock::Puts $sock "Go away!"
		::sock::Close $sock
	}
}
proc dccchat_C {nick pass onData sock answer} {
	if {[string eq $pass $answer]} {
		::sock::Puts $sock "Correct. $onData will handle your input from now on."
		::sock::Set $sock timeout 0
		::sock::Set $sock onData $onData
	} {
		::sock::Puts $sock "WRONG!"
		::sock::Close $sock
	}
}

proc dccecho {sock data} {
	::sock::Puts $sock $data
}
# Load this into your egg, then try:
# .tcl dccchat YourNick dccecho

[sKy]

This is very interesting and promising.

Code: Select all

proc test_server { } {
   set sock [sock::Listen 35189]
   sock::Set $sock onAll [list test_server_all]
   return $sock
}

proc test_server_all { args } {
   putlog "test_server_all: $args"
}

proc test_connect { } {
   set sock [::sock::Connect 127.0.0.1 35189]
   sock::Set $sock onAll [list test_connect_all]
   return $sock
}

proc test_connect_all { args } {
   putlog "test_connect_all: $args"
}

Tcl error: couldn't open socket: connection refused
Can you tell me please what`s wrong?

[user]

Looks like you're not listening on 127.0.0.1 ... try

Code: Select all

sock::Listen 35189 -myaddr 127.0.0.1

or

Code: Select all

sock::Connect [info host] 35189

or change/remove the default listening host

[sKy]

This is an attempt to make the built in sockets even more user friendly.

You can`t imagine how much this decreases my amount of time to write socket related stuff.

I just started coding this thing, so please help me find bugs/suggest new features/tell me what you think

Bugs so far none, but I will use this always now and guaranteed that I would report them.

Suggestions:
- I wish to have -timeout 0 for unlimited (long lived connections), check internal if the connection is still alive and send some ping/pong packages if this is not already done by tcp.
- provide this as package
- try to get this into tcl standardlib

Edit:
I have a great new idea. Would be awesome if you could include optional symmetric encryption (also also authentication though the password, readable = authenticated, not readable = unauthenticard), though using aes.

Like ::sock::Set $sock symencr "password"

Not all transmissions need to be encrypted. Just everything send with ::sock::Puts and incoming though onData.

It`s quite complicated to implement an encryption. If you encrypt and send you need to use -translation/-encoding binary because many chars from all encoding types will be used. But the target can`t use the encrypted stream so easy, because he is getting in in binary mode he can`t find a new line, even if you are already using flush.

[user]

I wish to have -timeout 0 for unlimited (long lived connections),

That's already implemented (and even used in my last example).

check internal if the connection is still alive and send some ping/pong packages if this is not already done by tcp.

That's better handled by the code using this api IMO, as it would intercept traffic that might be part of the data you expect to recieve .

provide this as package

Just add "package provide whatever 0.1" to the end of the script

I have a great new idea. Would be awesome if you could include optional symmetric encryption (also also authentication though the password, readable = authenticated, not readable = unauthenticard), though using aes.

Like ::sock::Set $sock symencr "password"

Not all transmissions need to be encrypted. Just everything send with ::sock::Puts and incoming though onData.

It`s quite complicated to implement an encryption. If you encrypt and send you need to use -translation/-encoding binary because many chars from all encoding types will be used. But the target can`t use the encrypted stream so easy, because he is getting in in binary mode he can`t find a new line, even if you are already using flush.

Again, I think this is better handled outside the api... eg.

Code: Select all

proc putsEncrypted {sock data} {
	sock::Puts $sock [encrypt $data]
}

proc onEncryptedData {sock data} {
	onDataExpectingUnencryptedData $sock [decrypt $data]
}

The code added is minimal and the users can pick what ever encryption algorithm they want/have access to.

[sparc317]

Thanks so much for this, saves so much hassle

I was wondering if you could tell me how it is possible to "address" an individual socket, using the following example:

Code: Select all

proc connection_handler {host port type sock {arg ""}} {
   switch -- $type {
      "onConn" {
         sock::Set $sock mode binary
         sock::Set $sock timeout 0
         putlog "Connected to $host"
      }
      "onData" {
                       putlog "$arg"
       }
      }
      "onDisc" {
                       putlog "lost connection to $host"
                       
       }
   }
}

# Opens a connection to a server

proc connectionOpen {host port} {
  set sock [sock::Connect $host $port onAll [list connection_handler $host $port]]
}

# Servers to connect to

connectionOpen 1.2.3.4 10000 
connectionOpen 1.2.3.4 20000
connectionOpen 1.2.3.4 30000

So, what I want to do here is within "onDisc" tell the specific socket that was disconnected, to reconnect.

I would be grateful for any ideas.

[user]

So, what I want to do here is within "onDisc" tell the specific socket that was disconnected, to reconnect.

You could create a new connection to the same destination... It would not be the same socket (that's not possible using tcl's socket command), but I don't think it makes any difference to you...

Code: Select all

"onDisc" {
	putlog "lost connection to $host - reconnecting..."
	connectionOpen $host $port
}

[Ofloo]

I was wondering, ..

if i just made regular socket connection which is blocking and without the async and once it's active i would fconfigure socket -blocking 0 and fconfigure socket -buffering line .. would that make it a non blocking socket cause i don't see it block anymore, my point is, can anyone tell me the difference and is it worth going through all that fileevent crap with vwait ... instead wouldn't it be easier just to use fconfigure?

ofcourse if you don't mind the connecting of the socket to be blocking..

[nml375]

The big issue/difference is the blocking behaviour of the connection...
For accepted and refused connection attempts, that's not a big deal, but for dropped connections (like a lot of "stealth" firewalls these days do it), that means your script will block for quite some time, until the kernel figures the connection attempt got lost somewhere and times it out...