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