Posted to tcl by jima at Thu Nov 19 13:42:24 GMT 2015view pretty

package require http
package require -exact tls 1.6
proc JIMA_TLS {args} {
    puts JIMA_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_TLS
]

# Procedure called whenever a new connection is made by a client.
proc on_connect {newsock clientAddress clientPort} {

    # This is the place to add checks disallowing connections based
    # upon the hostname/ipaddress of the peer.

    fconfigure $newsock -blocking 0
    fileevent  $newsock readable [list handleInput $newsock]
}

# Procedure called whenever input arrives on a connection.
proc handleInput {f} {
    # Delete the handler if the input was exhausted.
    if {[eof $f]} {
        fileevent $f readable {}
        close     $f
        return
    }

    # Read and handle the incoming information. Here we just log it to
    # stdout.

    set tok [http::geturl https://www.google.es]
    set data [http::data $tok]
    set code [http::code $tok]
    http::cleanup $tok

    puts $f $code
    close $f
    return
}

# Server
::tls::socket -server on_connect -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

vwait forever