88cf64aed6 2000-06-06 1: #
88cf64aed6 2000-06-06 2: # Copyright (C) 1997-2000 Matt Newman <[email protected]>
88cf64aed6 2000-06-06 3: #
88cf64aed6 2000-06-06 4:
88cf64aed6 2000-06-06 5: set dir [file dirname [info script]]
88cf64aed6 2000-06-06 6: cd $dir
88cf64aed6 2000-06-06 7: source tls.tcl
88cf64aed6 2000-06-06 8:
88cf64aed6 2000-06-06 9: proc fromServer {chan} {
88cf64aed6 2000-06-06 10: if {[catch {read $chan 10} data]} {
88cf64aed6 2000-06-06 11: catch {close $chan}
88cf64aed6 2000-06-06 12: tclLog "EOF ($data)"
88cf64aed6 2000-06-06 13: set ::/Exit 1
88cf64aed6 2000-06-06 14: return
88cf64aed6 2000-06-06 15: }
88cf64aed6 2000-06-06 16: if {[eof $chan]} {
88cf64aed6 2000-06-06 17: close $chan
88cf64aed6 2000-06-06 18: set ::/Exit 1
88cf64aed6 2000-06-06 19: }
88cf64aed6 2000-06-06 20: if {$data != ""} {
88cf64aed6 2000-06-06 21: puts -nonewline stderr "$data"
88cf64aed6 2000-06-06 22: }
88cf64aed6 2000-06-06 23: }
88cf64aed6 2000-06-06 24: proc doit {chan count {delay 1000}} {
88cf64aed6 2000-06-06 25: if {$count == 0} {
88cf64aed6 2000-06-06 26: close $chan
88cf64aed6 2000-06-06 27: set ::/Exit 0
88cf64aed6 2000-06-06 28: return
88cf64aed6 2000-06-06 29: }
88cf64aed6 2000-06-06 30: puts $chan line$count
88cf64aed6 2000-06-06 31: flush $chan
88cf64aed6 2000-06-06 32:
88cf64aed6 2000-06-06 33: incr count -1
88cf64aed6 2000-06-06 34: after $delay doit $chan $count $delay
88cf64aed6 2000-06-06 35: }
88cf64aed6 2000-06-06 36: array set opts {
88cf64aed6 2000-06-06 37: -port 1234
88cf64aed6 2000-06-06 38: -host localhost
88cf64aed6 2000-06-06 39: }
88cf64aed6 2000-06-06 40: array set opts $argv
88cf64aed6 2000-06-06 41: #
88cf64aed6 2000-06-06 42: # Initialize context
88cf64aed6 2000-06-06 43: #
88cf64aed6 2000-06-06 44: #tls::init -certfile client.pem -cafile server.pem ;#-cipher RC4-MD5
88cf64aed6 2000-06-06 45: tls::init
88cf64aed6 2000-06-06 46: #
88cf64aed6 2000-06-06 47: # Create socket and import SSL layer
88cf64aed6 2000-06-06 48: #
88cf64aed6 2000-06-06 49: #set chan [tls::socket -async -request 0 $opts(-host) $opts(-port)]
88cf64aed6 2000-06-06 50: set chan [tls::socket -request 0 $opts(-host) $opts(-port)]
88cf64aed6 2000-06-06 51:
88cf64aed6 2000-06-06 52: fconfigure $chan -buffering none -blocking 0 -translation binary
88cf64aed6 2000-06-06 53: fileevent $chan readable [list fromServer $chan]
88cf64aed6 2000-06-06 54:
88cf64aed6 2000-06-06 55: doit $chan 1000 100
88cf64aed6 2000-06-06 56: vwait /Exit