tlsSrv2.tcl at [1303418e93]
Bounty program for improvements to Tcl and certain Tcl packages.

File tests/oldTests/tlsSrv2.tcl artifact 26eb405e56 part of check-in 1303418e93

# Copyright (C) 1997-2000 Matt Newman <[email protected]>
# Sample Tls-enabled server
set dir [file dirname [info script]]
cd $dir
source tls.tcl
#lappend auto_path d:/tcl80/lib
#package require tls

# Sample callback - just reflect data back to client
proc reflectCB {chan {verbose 0}} {
    if {[catch {read $chan 1024} data]} {
	puts stderr "EOF ($data)"
	catch {close $chan}
    if {$verbose && $data != ""} {
	puts -nonewline stderr $data
    if {[eof $chan]} {    ;# client gone or finished
	puts stderr "EOF"
	close $chan        ;# release the servers client channel
    puts -nonewline $chan $data
    flush $chan
proc acceptCB { chan ip port } {
    puts "accept: $chan $ip $port"

    if {![tls::handshake $chan]} {
	puts stderr "Handshake pending"
    array set cert [tls::status $chan]
    parray cert

    fconfigure $chan -buffering none -blocking 0
    fileevent $chan readable [list reflectCB $chan 1]
tls::init -certfile server.pem -tls1 1 ;#-cipher RC4-SHA

set chan [tls::socket -server acceptCB \
		-request 1 -require 0 -command tls::callback 1234]

puts "Server waiting connection on $chan (1234)"

# Go into the eventloop
vwait /Exit