an extension to class which creates connections

# oo::socket.tcl - class to listen on a given port, etc
package provide oo::socket 1.0

oo::class create oo::socket {
    method listen {params} {
	set -tls {}
	set -port 8080
	dict with params {}

	::socket -server [list ::apply [list {class opts sock ipaddr rport} {
	    if {[dict exists $opts -tls] && [dict get $opts -tls] ne {}} {
		set tlsopts [dict merge {
		    -certfile server-public.pem
		    -keyfile server-private.pem
		    -cadir .
		    -cafile ca.pem
		    -ssl2 0
		    -ssl3 1
		    -tls1 1
		    -require 0
		    -request 1
		} [dict get $opts -tls]]
		
		if {[dict exists $tlsopts -progress]} {
		    set progress "-command [dict get $tlsopts -progress]"
		    dict unset tlsopts -progress
		} else {
		    set progress {}
		}
		if {[dict exists $tlsopts -password]} {
		    set password [list -password [list ::apply [list {} [list return \"$password\"]]]]
		    dict unset tlsopts -password
		} else {
		    set password {}
		}
		
		chan configure $sock -blocking 1 -translation {binary binary}
		tls::import $sock -server 1 {*}$tlsopts {*}$progress {*}$password
		tls::handshake $sock
	    }
	    {*}$class create $sock {*}[expr {[dict exists $opts -args]? [dict get $opts -args] : {}}]
	} [namespace current]] [self] [list -tls ${-tls}]] {*}[expr {([info exists -myaddr] && ${-myaddr} ne "")?"-myaddr ${-myaddr}":""}] ${-port}
    }

    superclass ::oo::class
    constructor {definition args} {
	next $definition
	my listen $args
	return [self]
    }
}

if {[info script] eq $argv0} {
    oo::socket create echo {
	method readable {} {
	    variable sock
	    if {[chan eof $sock]} {
		my destroy
	    } else {
		puts $sock [gets $sock]
	    }
	}

	destructor {
	    puts stderr "[self] destroyed"
	    catch {variable sock; close $sock}
	}

	constructor {args} {
	    variable sock [namespace tail [self]]
	    puts stderr "[self] connected to $sock"
	    chan configure $sock -buffering line
	    chan event $sock readable [list [self] readable]
	}
    }
    vwait forever
}