💾 Archived View for thrig.me › tech › ssl › pingpong.tcl captured on 2024-06-16 at 13:40:15.
⬅️ Previous capture (2023-04-19)
-=-=-=-=-=-=-
#!/usr/bin/env tclsh8.6 # # pingpong - send a ping, get a pong. this code contains both the client # and the server, both of which require the CA certificate for # verification. The CA certificate could be a self-signed certificate # # ./pingpong.tcl host.cert host.cert host.key # # in which case only the certificate will be verified against itself. # More typical is for a distinct root certificate to have signed some # certificate, so any certificate signed by said root should work # # ./pingpong.tcl minca.cert minca-test.cert minca-test.key # on OpenBSD: # doas pkg_add tcl tcltls package require Tcl 8.6 package require tls if {[llength $argv] == 3} { set ca_cert_file [lindex $argv 0] set cert_file [lindex $argv 1] set key_file [lindex $argv 2] } else { puts stderr "Usage: pingpong ca-cert-file cert-file key-file" exit 1 } set pings 0 proc client-response {socket} { global done pings gets $socket response if {$response ne ""} { puts stderr "CLIENT server said: $response" close $socket incr pings # TWEAK increase or remove so the server runs longer and can be # tested with other implementations, e.g. nc(1) if {$pings >= 3} {set done 1} } } proc client-request {host port} { global ca_cert_file cert_file key_file set socket [tls::socket -tls1 true -ssl2 false -ssl3 false -require 1 \ -cafile $ca_cert_file -certfile $cert_file -keyfile $key_file $host $port] socket-config $socket puts stderr "CLIENT $host $port pinging" puts $socket PING fileevent $socket readable [list client-response $socket] client-spawn-after 500 $host $port } proc client-spawn-after {delay host port} { after $delay client-request localhost $port } proc server-response {socket} { gets $socket request if {$request eq "PING"} { puts stderr "SERVER ponging" puts $socket "PONG [clock milliseconds]" close $socket } } proc server-spawn {socket addr port} { puts stderr "SERVER client $addr $port" socket-config $socket fileevent $socket readable [list server-response $socket] } proc socket-config {socket} { fconfigure $socket -blocking 0 -buffering none -translation crlf \ -encoding utf-8 } set sock [tls::socket -server server-spawn \ -tls1 true -ssl2 false -ssl3 false -require 1 \ -cafile $ca_cert_file \ -certfile $cert_file -keyfile $key_file 0] set port [lindex [chan configure $sock -sockname] end] puts stderr "SERVER listen $port" client-spawn-after 500 localhost $port vwait done