Posted to tcl by jima at Thu Nov 26 10:09:00 GMT 2015view pretty
set ::showTheError 1;# make this 0 or 1 to show or not the bad behavior. package require http #package require -exact tls 1.6 package require tls proc JIMA_TLS {args} { puts JIMA_TLS($args) } proc JIMA_OTHER_TLS {args} { puts JIMA_OTHER_TLS($args) } set ::caFile caFile set ::certFile certFile set ::keyFile keyFile http::register https 443 [ list ::tls::socket -cafile {} -certfile {} -keyfile {} -require 0 -request 0 -ssl3 0 -ssl2 0 -tls1 1 -tls1.1 1 -tls1.2 1 -command JIMA_OTHER_TLS ] # Procedure called whenever a new connection is made by a client. proc on_connect {serverPort newsock clientAddress clientPort} { fconfigure $newsock -blocking 0 puts $newsock/$clientAddress/$clientPort fileevent $newsock readable [ list handleInput $newsock $clientPort $serverPort ] } # Procedure called whenever input arrives on a connection. proc handleInput {f clientPort serverPort} { # Delete the handler if the input was exhausted. if {[eof $f]} { fileevent $f readable {} close $f return } # gets $f # set code OK if {$::showTheError} { set tok [http::geturl https://www.google.es] set code [http::code $tok] http::cleanup $tok } # puts HANDLING($f)($code) puts $f $code/$serverPort/$clientPort close $f return } # Server 0 ::tls::socket -server {on_connect 8080} -cafile $::caFile -certfile $::certFile -keyfile $::keyFile -require 0 -request 0 -ssl3 0 -ssl2 0 -tls1 1 -tls1.1 1 -tls1.2 1 -command JIMA_TLS 8080 # Server 1 #::tls::socket -server {on_connect 8090} -cafile $::caFile -certfile $::certFile -keyfile $::keyFile -require 0 -request 0 -ssl3 0 -ssl2 0 -tls1 1 -tls1.1 1 -tls1.2 1 -command JIMA_TLS 8090 vwait forever