summaryrefslogtreecommitdiffstats
path: root/tls/tests/simpleServer.tcl
diff options
context:
space:
mode:
authorWilliam Joye <wjoye@cfa.harvard.edu>2019-01-02 21:21:14 (GMT)
committerWilliam Joye <wjoye@cfa.harvard.edu>2019-01-02 21:21:14 (GMT)
commit4db70369bb58c270b362c5696a6fe8c91a1a0217 (patch)
tree51cf1fa59473c1451a3b45698e010b8843d53d07 /tls/tests/simpleServer.tcl
parentfd7981505543bf2c863a97fc94bb2119411fb093 (diff)
downloadblt-4db70369bb58c270b362c5696a6fe8c91a1a0217.zip
blt-4db70369bb58c270b362c5696a6fe8c91a1a0217.tar.gz
blt-4db70369bb58c270b362c5696a6fe8c91a1a0217.tar.bz2
update TEA 3.13
Diffstat (limited to 'tls/tests/simpleServer.tcl')
-rwxr-xr-xtls/tests/simpleServer.tcl90
1 files changed, 0 insertions, 90 deletions
diff --git a/tls/tests/simpleServer.tcl b/tls/tests/simpleServer.tcl
deleted file mode 100755
index 4450d28..0000000
--- a/tls/tests/simpleServer.tcl
+++ /dev/null
@@ -1,90 +0,0 @@
-#!/bin/sh
-# The next line is executed by /bin/sh, but not tcl \
-exec tclsh8.3 "$0" ${1+"$@"}
-
-package require tls
-
-set dir [file join [file dirname [info script]] ../tests/certs]
-set OPTS(-cafile) [file join $dir ca.pem]
-set OPTS(-cert) [file join $dir server.pem]
-set OPTS(-key) [file join $dir server.key]
-
-set OPTS(-port) 2468
-set OPTS(-debug) 1
-set OPTS(-require) 1
-
-foreach {key val} $argv {
- if {![info exists OPTS($key)]} {
- puts stderr "Usage: $argv0 ?options?\
- \n\t-debug boolean Debugging on or off ($OPTS(-debug))\
- \n\t-cafile file Cert. Auth. File ($OPTS(-cafile))\
- \n\t-cert file Server Cert ($OPTS(-cert))\
- \n\t-key file Server Key ($OPTS(-key))\
- \n\t-require boolean Require Certification ($OPTS(-require))\
- \n\t-port num Port to listen on ($OPTS(-port))"
- exit
- }
- set OPTS($key) $val
-}
-
-# Catch any background errors.
-proc bgerror {msg} { puts stderr "BGERROR: $msg" }
-
-# debugging helper code
-proc shortstr {str} {
- return "[string replace $str 10 end ...] [string length $str]b"
-}
-proc dputs {msg} { if {$::OPTS(-debug)} { puts stderr $msg ; flush stderr } }
-
-# As a response we just echo the data sent to us.
-#
-proc respond {chan} {
- if {[catch {read $chan} data]} {
- #dputs "EOF $chan ([shortstr $data)"
- catch {close $chan}
- return
- }
- #if {$data != ""} { dputs "got $chan ([shortstr $data])" }
- if {[eof $chan]} {
- # client gone or finished
- dputs "EOF $chan"
- close $chan ;# release the port
- return
- }
- puts -nonewline $chan $data
- flush $chan
- #dputs "sent $chan ([shortstr $data])"
-}
-
-# Once connection is established, we need to ensure handshake.
-#
-proc handshake {s cmd} {
- if {[eof $s]} {
- dputs "handshake eof $s"
- close $s
- } elseif {[catch {tls::handshake $s} result]} {
- # Some errors are normal. Specifically, I (hobbs) believe that
- # TLS throws EAGAINs when it may not need to (or is inappropriate).
- dputs "handshake error $s: $result"
- } elseif {$result == 1} {
- # Handshake complete
- dputs "handshake complete $s"
- fileevent $s readable [list $cmd $s]
- }
-}
-
-# Callback proc to accept a connection from a client.
-#
-proc accept { chan ip port } {
- dputs "[info level 0] [fconfigure $chan]"
- fconfigure $chan -blocking 0
- fileevent $chan readable [list handshake $chan respond]
-}
-
-tls::init -cafile $OPTS(-cafile) -certfile $OPTS(-cert) -keyfile $OPTS(-key)
-set chan [tls::socket -server accept -require $OPTS(-require) $OPTS(-port)]
-
-puts "Server waiting connection on $chan ($OPTS(-port))"
-puts [fconfigure $chan]
-
-vwait __forever__