Index: ChangeLog
==================================================================
--- ChangeLog
+++ ChangeLog
@@ -1,5 +1,27 @@
+2000-07-20  Jeff Hobbs  <hobbs@scriptics.com>
+
+	* tests/tlsIO.test: corrected various tests to be correct for TLS
+	stacked channels (as opposed to the standard sockets the test
+	suite was adopted from).  Key differences are that TLS cannot
+	operate in one process without all channels being non-blocking, or
+	the handshake will block, and handshaking must be forced in some
+	cases.  Also, handshakes don't seem to complete unless the client
+	has placed at least one byte for the server to read in the channel.
+
+	* tests/remote.tcl: corrected the finding of tests certificates
+
+	* tlsIO.c (TlsCloseProc): removed deleting of timer handler as
+	that is handled by Tls_Clean.
+
+	* tls.tcl (tls::_accept): corrected the internal _accept to
+	trickle callback errors to the user.
+
+	* Makefile.in: made the install-binaries target regenerate the
+	pkgIndex.tcl correctly.  The test target probably shouldn't screw
+	it up, but this is to be on the safe side.
+
 2000-07-17  Jeff Hobbs  <hobbs@scriptics.com>
 
 	* pkgIndex.tcl.in:
 	* configure.in: updated version to 1.4
 

Index: Makefile.in
==================================================================
--- Makefile.in
+++ Makefile.in
@@ -10,11 +10,11 @@
 # All rights reserved.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: Makefile.in,v 1.13 2000/06/21 21:00:56 wart Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.13.2.1 2000/07/21 05:32:56 hobbs Exp $
 
 
 lib_BINARIES=$(tls_LIB_FILE)
 BINARIES=$(lib_BINARIES)
 
@@ -93,10 +93,11 @@
 mandir = @mandir@
 includedir = @includedir@
 oldincludedir = /usr/include
 
 DESTDIR =
+RELPATH = @RELPATH@
 
 pkgdatadir = $(datadir)/@PACKAGE@@VERSION@
 pkglibdir = $(libdir)/@PACKAGE@@VERSION@
 pkgincludedir = $(includedir)/@PACKAGE@@VERSION@
 
@@ -208,10 +209,13 @@
 doc:
 
 install: all install-binaries install-libraries install-doc
 
 install-binaries: binaries install-lib-binaries install-bin-binaries
+	sed -e "s#\@RELPATH\@#$(RELPATH)#" \
+	-e "s#\@tls_LIB_FILE\@#$(tls_LIB_FILE)#" \
+	< $(srcdir)/pkgIndex.tcl.in > pkgIndex.tcl
 	$(INSTALL_DATA) pkgIndex.tcl $(pkglibdir)
 
 #========================================================================
 # This rule installs platform-independent files, such as header files.
 #========================================================================

Index: tests/remote.tcl
==================================================================
--- tests/remote.tcl
+++ tests/remote.tcl
@@ -7,11 +7,11 @@
 # Copyright (c) 1995-1996 Sun Microsystems, Inc.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: remote.tcl,v 1.4 2000/06/06 22:01:41 aborr Exp $
+# RCS: @(#) $Id: remote.tcl,v 1.4.2.1 2000/07/21 05:32:57 hobbs Exp $
 
 # load tls package
 package require tls
 
 # Initialize message delimitor
@@ -169,26 +169,17 @@
     puts ""
     puts -nonewline "Type Ctrl-C to terminate--> "
     flush stdout
 }
 
+set certsDir	[file join [file dirname [info script]] certs]
+set serverCert	[file join $certsDir server.pem]
+set caCert	[file join $certsDir cacert.pem]
+set serverKey	[file join $certsDir skey.pem]
 if {[catch {set serverSocket \
-    [tls::socket -myaddr $serverAddress -server __accept__ \
-    	-cafile [file join [pwd] certs cacert.pem] \
-    	-certfile [file join [pwd] certs server.pem] \
-    	-keyfile [file join [pwd] certs skey.pem] \
+	[tls::socket -myaddr $serverAddress -server __accept__ \
+	-cafile $caCert -certfile $serverCert -keyfile $serverKey \
 	$serverPort]} msg]} {
     puts "Server on $serverAddress:$serverPort cannot start: $msg"
 } else {
     vwait __server_wait_variable__
 }
-
-
-
-
-
-
-
-
-
-
-

Index: tests/tlsIO.test
==================================================================
--- tests/tlsIO.test
+++ tests/tlsIO.test
@@ -8,11 +8,11 @@
 # Copyright (c) 1998-2000 Ajuba Solutions. 
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: tlsIO.test,v 1.14.2.3 2000/07/14 04:10:23 hobbs Exp $
+# RCS: @(#) $Id: tlsIO.test,v 1.14.2.4 2000/07/21 05:32:57 hobbs Exp $
 
 # Running socket tests with a remote server:
 # ------------------------------------------
 # 
 # Some tests in socket.test depend on the existence of a remote server to
@@ -50,19 +50,21 @@
 #     % set remoteServerPort 8048
 # 
 # These variables are also settable from the environment. On Unix, you can:
 # 
 #     shell% setenv remoteServerIP machine.where.server.runs
-#     shell% senetv remoteServerPort 8048
+#     shell% setenv remoteServerPort 8048
 # 
 # The preamble of the socket.test file checks to see if the variables are set
 # either in Tcl or in the environment; if they are, it attempts to connect to
 # the server. If the connection is successful, the tests using the remote
 # server will be performed; otherwise, it will attempt to start the remote
 # server (via exec) on platforms that support this, on the local host,
 # listening at port 8048. If all fails, a message is printed and the tests
 # using the remote server are not performed.
+
+proc dputs {msg} { return ; puts stderr $msg ; flush stderr }
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
@@ -71,22 +73,24 @@
 
 package require tls
 
 set tlsServerPort 8048
 
-set certsDir [file join [file dirname [info script]] certs] 
-
-set serverCert [file join $certsDir server.pem]
-set clientCert [file join $certsDir client.pem]
-set caCert [file join $certsDir cacert.pem]
-set serverKey [file join $certsDir skey.pem]
-set clientKey [file join $certsDir ckey.pem]
-
-# Some tests require the testthread command
+# Specify where the certificates are
+
+set certsDir	[file join [file dirname [info script]] certs]
+set serverCert	[file join $certsDir server.pem]
+set clientCert	[file join $certsDir client.pem]
+set caCert	[file join $certsDir cacert.pem]
+set serverKey	[file join $certsDir skey.pem]
+set clientKey	[file join $certsDir ckey.pem]
+
+# Some tests require the testthread and exec commands
 
 set ::tcltest::testConstraints(testthread) \
 	[expr {[info commands testthread] != {}}]
+set ::tcltest::testConstraints(exec) [expr {[info commands exec] != {}}]
 
 #
 # If remoteServerIP or remoteServerPort are not set, check in the
 # environment variables for externally set values.
 #
@@ -103,10 +107,33 @@
         if {[info exists remoteServerIP]} {
 	    set remoteServerPort $tlsServerPort
         }
     }
 }
+
+proc do_handshake {s {type readable} {cmd {}} args} {
+    if {[eof $s]} {
+	close $s
+	dputs "handshake: eof"
+	set ::do_handshake "eof"
+    } elseif {[catch {tls::handshake $s} result]} {
+	# Some errors are normal.
+	dputs "handshake: $result"
+    } elseif {$result == 1} {
+	# Handshake complete
+	if {[llength $args]} { eval fconfigure $s $args }
+	if {$cmd == ""} {
+	    fileevent $s $type ""
+	} else {
+	    fileevent $s $type "$cmd $s"
+	}
+	dputs "handshake: complete"
+	set ::do_handshake "complete"
+    } else {
+	dputs "handshake: in progress"
+    }
+}
 
 #
 # Check if we're supposed to do tests against the remote server
 #
 
@@ -129,30 +156,25 @@
 set commandSocket ""
 if {$doTestsWithRemoteServer} {
     catch {close $commandSocket}
     if {[catch {set commandSocket [tls::socket \
 	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
-	    $remoteServerIP \
-	    $remoteServerPort]}] != 0} {
+	    $remoteServerIP $remoteServerPort]}] != 0} {
 	if {[info commands exec] == ""} {
 	    set noRemoteTestReason "can't exec"
 	    set doTestsWithRemoteServer 0
 	} else {
 	    set remoteServerIP 127.0.0.1
 	    set remoteFile [file join [pwd] remote.tcl]
 	    if {[catch {set remoteProcChan \
-				[open "|[list $::tcltest::tcltest $remoteFile \
-					-serverIsSilent \
-					-port $remoteServerPort \
-					-address $remoteServerIP]" \
-					w+]} \
-		   msg] == 0} {
+		    [open "|[list $::tcltest::tcltest $remoteFile \
+		    -serverIsSilent -port $remoteServerPort \
+		    -address $remoteServerIP]" w+]} msg] == 0} {
 		after 1000
-		if {[catch {set commandSocket [tls::socket \
-		    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
-				$remoteServerIP \
-				$remoteServerPort]} msg] == 0} {
+		if {[catch {set commandSocket [tls::socket -cafile $caCert \
+			-certfile $clientCert -keyfile $clientKey \
+			$remoteServerIP $remoteServerPort]} msg] == 0} {
 		    fconfigure $commandSocket -translation crlf -buffering line
 		} else {
 		    set noRemoteTestReason $msg
 		    set doTestsWithRemoteServer 0
 		}
@@ -211,10 +233,25 @@
 	    } else {
 		append resp $line "\n"
 	    }
 	}
     }
+
+    sendCommand [list proc dputs [info args dputs] [info body dputs]]
+
+    proc sendCertValues {} {
+	# We need to be able to send certificate values that normalize
+	# filenames across platforms
+	sendCommand {
+	    set certsDir	[file join [file dirname [info script]] certs]
+	    set serverCert	[file join $certsDir server.pem]
+	    set clientCert	[file join $certsDir client.pem]
+	    set caCert		[file join $certsDir cacert.pem]
+	    set serverKey	[file join $certsDir skey.pem]
+	    set clientKey	[file join $certsDir ckey.pem]
+	}
+    }
 }
 
 test tlsIO-1.1 {arg parsing for socket command} {socket} {
     list [catch {tls::socket -server} msg] $msg
 } {1 {wrong # args: should be "tls::socket -server command ?options? port"}}
@@ -562,23 +599,14 @@
     puts -nonewline $f {package require tls; tls::socket -server accept 8828}
     close $f
     set f [open "|[list $::tcltest::tcltest script]" r]
     gets $f
     after 100
-    set x [list [catch {close $f} msg] $msg]
+    set x [list [catch {close $f} msg] [string range $msg 0 43]]
     close $s
     set x
-} {1 {couldn't open socket: address already in use
-    while executing
-"::socket -server {tls::_accept {-server 1} accept} 8828"
-    ("eval" body line 1)
-    invoked from within
-"eval ::socket $sopts"
-    (procedure "tls::socket" line 62)
-    invoked from within
-"tls::socket -server accept 8828"
-    (file "script" line 1)}}
+} {1 {couldn't open socket: address already in use}}
 
 test tlsIO-2.10 {close on accept, accepted socket lives} {socket} {
     set done 0
     set timer [after 20000 "set done timed_out"]
     set ss [tls::socket -server accept -certfile $serverCert -cafile $caCert \
@@ -602,45 +630,50 @@
     vwait done
     after cancel $timer
     set done
 } 1
 
-test tlsIO-2.11 {detecting new data} {socket knownBug} {
-    # HOBBS: hung pre-rewrite, hangs post-rewrite
+test tlsIO-2.11 {detecting new data} {socket} {
     proc accept {s a p} {
 	global sock
+	# when doing an in-process client/server test, both sides need
+	# to be non-blocking for the TLS handshake.  Also make sure
+	# to return the channel to line buffering mode.
+	fconfigure $s -blocking 0 -buffering line
 	set sock $s
-	set f [open awb.log w]
-	puts $f [catch {tls::handshake $sock} err]
-	puts $f "err: $err"
-	puts $f "[tls::status $sock]"
-	close $s
+	fileevent $s readable [list do_handshake $s]
     }
 
-    set s [tls::socket -require 0 -request 0 -server accept -certfile $serverCert -cafile $caCert \
-	-keyfile $serverKey 8400]
+    set s [tls::socket -server accept \
+	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8400]
     set sock ""
     set s2 [tls::socket -certfile $clientCert -cafile $caCert \
 	-keyfile $clientKey 127.0.0.1 8400]
+    # when doing an in-process client/server test, both sides need
+    # to be non-blocking for the TLS handshake  Also make sure to
+    # return the channel to line buffering mode (TLS sets it to 'none').
+    fconfigure $s2 -blocking 0 -buffering line
     vwait sock
     puts $s2 one
     flush $s2
+    # need update to complete TLS handshake in-process
+    update
     after 500
     fconfigure $sock -blocking 0
-    set result [gets $sock]
-    lappend result [gets $sock]
+    set result a:[gets $sock]
+    lappend result b:[gets $sock]
     fconfigure $sock -blocking 1
     puts $s2 two
     flush $s2
     fconfigure $sock -blocking 0
-    lappend result [gets $sock]
+    lappend result c:[gets $sock]
     fconfigure $sock -blocking 1
     close $s2
     close $s
     close $sock
     set result
-} {one {} two}
+} {a:one b: c:two}
 
 test tlsIO-2.12 {tcp connection; no certificates specified} {socket stdio pcCrash} {
     removeFile script
     set f [open script w]
     puts $f {
@@ -805,11 +838,11 @@
     set t1 [after 30000 "set x timed_out"]
     set t2 [after 31000 "set x timed_out"]
     set t3 [after 32000 "set x timed_out"]
     set s [tls::socket \
 	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
-    	-server accept 8828]
+	    -server accept 8828]
     puts $p1 open
     puts $p2 open
     puts $p3 open
     vwait x
     vwait x
@@ -866,11 +899,24 @@
 	close $msg
     }
     set x
 } {couldn't open socket: not owner}
 
-test tlsIO-6.1 {accept callback error} {unexplainedFailure socket stdio pcCrash} {
+if {0} {
+    package require tls
+
+    proc accept {s a p} {
+	puts [info level 0]
+	expr 10 / 0
+    }
+    set s [tls::socket -server accept 8848]
+
+    proc bgerror args { puts "bgerror: $args" }
+    set s [tls::socket zamora.scriptics.com 8848]
+}
+
+test tlsIO-6.1 {accept callback error} { socket stdio pcCrash} {
     # HOBBS: still fails post-rewrite
     removeFile script
     set f [open script w]
     puts $f {
     	package require tls
@@ -998,68 +1044,65 @@
 
 # bug report #5812 fconfigure doesn't return value for '-sockname'
 
 test tlsIO-7.5 {testing socket specific options} {socket unixOrPc} {
     set s [tls::socket \
-	-certfile $serverCert -cafile $caCert -keyfile $serverKey \
-    	-server accept 8829]
+	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
+	    -server accept 8829]
     proc accept {s a p} {
 	global x
 	set x [fconfigure $s -sockname]
 	close $s
     }
     set s1 [tls::socket \
-	-certfile $clientCert -cafile $caCert -keyfile $clientKey \
-    	127.0.0.1 8829]
+	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
+	    127.0.0.1 8829]
     set timer [after 10000 "set x timed_out"]
     vwait x
     after cancel $timer
     close $s
     close $s1
     set l ""
     lappend l [lindex $x 0] [lindex $x 2] [llength $x]
 } {127.0.0.1 8829 3}
 
-test tlsIO-8.1 {testing -async flag on sockets} {unexplainedHang socket} {
+test tlsIO-8.1 {testing -async flag on sockets} {socket} {
     # HOBBS: still fails post-rewrite
-    # test seems to hang -- awb 6/2/2000
-    # NOTE: This test may fail on some Solaris 2.4 systems. If it does,
-    # check that you have these patches installed (using showrev -p):
-    #
-    # 101907-05, 101925-02, 101945-14, 101959-03, 101969-05, 101973-03,
-    # 101977-03, 101981-02, 101985-01, 102001-03, 102003-01, 102007-01,
-    # 102011-02, 102024-01, 102039-01, 102044-01, 102048-01, 102062-03,
-    # 102066-04, 102070-01, 102105-01, 102153-03, 102216-01, 102232-01,
-    # 101878-03, 101879-01, 101880-03, 101933-01, 101950-01, 102030-01,
-    # 102057-08, 102140-01, 101920-02, 101921-09, 101922-07, 101923-03
-    #
-    # If after installing these patches you are still experiencing a
-    # problem, please email jyl@eng.sun.com. We have not observed this
-    # failure on Solaris 2.5, so another option (instead of installing
-    # these patches) is to upgrade to Solaris 2.5.
+    # NOTE: This test may fail on some Solaris 2.4 systems.
+    # See notes in Tcl's socket.test.
     set s [tls::socket \
-	-certfile $serverCert -cafile $caCert -keyfile $serverKey \
-    	-server accept 8830]
+	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
+	    -server accept 8830]
     proc accept {s a p} {
 	global x
+	# when doing an in-process client/server test, both sides need
+	# to be non-blocking for the TLS handshake.  Also make sure
+	# to return the channel to line buffering mode.
+	fconfigure $s -blocking 0 -buffering line
 	puts $s bye
 	close $s
 	set x done
     }
     set s1 [tls::socket \
-	-certfile $clientCert -cafile $caCert -keyfile $clientKey \
-	-async [info hostname] 8830]
+	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
+	    -async [info hostname] 8830]
+    # when doing an in-process client/server test, both sides need
+    # to be non-blocking for the TLS handshake  Also make sure to
+    # return the channel to line buffering mode (TLS sets it to 'none').
+    fconfigure $s1 -blocking 0 -buffering line
     vwait x
+    # TLS handshaking needs one byte from the client...
+    puts $s1 a
+    # need update to complete TLS handshake in-process
+    update
     set z [gets $s1]
     close $s
     close $s1
     set z
 } bye
 
-test tlsIO-9.1 {testing spurious events} {unexplainedHang socket} {
-    # HOBBS: still fails post-rewrite
-    # locks up 
+test tlsIO-9.1 {testing spurious events} {socket} {
     set len 0
     set spurious 0
     set done 0
     proc readlittle {s} {
 	global spurious done len
@@ -1074,19 +1117,23 @@
 	} else {
 	    incr len [string length $l]
 	}
     }
     proc accept {s a p} {
-	fconfigure $s -buffering none -blocking off
-	fileevent $s readable [list readlittle $s]
+	fconfigure $s -blocking 0
+	fileevent $s readable [list do_handshake $s readable readlittle \
+		-buffering none]
     }
     set s [tls::socket \
-	-certfile $serverCert -cafile $caCert -keyfile $serverKey \
-   	-server accept 8831]
+	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
+	    -server accept 8831]
     set c [tls::socket \
-	-certfile $clientCert -cafile $caCert -keyfile $clientKey \
-    	[info hostname] 8831]
+	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
+	    [info hostname] 8831]
+    # This differs from socket-9.1 in that both sides need to be
+    # non-blocking because of TLS' required handshake
+    fconfigure $c -blocking 0
     puts -nonewline $c 01234567890123456789012345678901234567890123456789
     close $c
     set timer [after 10000 "set done timed_out"]
     vwait done
     after cancel $timer
@@ -1093,68 +1140,69 @@
     close $s
     list $spurious $len
 } {0 50}
 
 test tlsIO-9.2 {testing async write, fileevents, flush on close} {socket} {
-    # HOBBS: This hangs when I turn blocking on.
-    #
-    set firstblock ""
-    for {set i 0} {$i < 5} {incr i} {set firstblock "a$firstblock$firstblock"}
-    set secondblock ""
-    for {set i 0} {$i < 16} {incr i} {
-	set secondblock "b$secondblock$secondblock"
-    }
-    set l [tls::socket \
-	-certfile $serverCert -cafile $caCert -keyfile $serverKey \
-    	-server accept 8832]
+    set firstblock [string repeat a 31]
+    set secondblock [string repeat b 65535]
     proc accept {s a p} {
-	fconfigure $s -blocking 0 -translation lf -buffersize 16384 \
-		-buffering line
-	fileevent $s readable "readable $s"
+	fconfigure $s -blocking 0
+	fileevent $s readable [list do_handshake $s readable readable \
+		-translation lf -buffersize 16384 -buffering line]
     }
     proc readable {s} {
 	set l [gets $s]
+	dputs "got \"[string replace $l 10 end-3 ...]\" \
+		([string length $l]) from $s"
 	fileevent $s readable {}
 	after 1000 respond $s
     }
     proc respond {s} {
 	global firstblock
+	dputs "send \"[string replace $firstblock 10 end-3 ...]\" \
+		([string length $firstblock]) down $s"
 	puts -nonewline $s $firstblock
 	after 1000 writedata $s
     }
     proc writedata {s} {
 	global secondblock
+	dputs "send \"[string replace $secondblock 10 end-3 ...]\" \
+		([string length $secondblock]) down $s"
 	puts -nonewline $s $secondblock
 	close $s
     }
     set s [tls::socket \
-	-certfile $clientCert -cafile $caCert -keyfile $clientKey \
-    	[info hostname] 8832]
-    fconfigure $s -blocking 0 -trans lf -buffering line
+	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
+	    -server accept 8832]
+    set c [tls::socket \
+	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
+	    [info hostname] 8832]
+    fconfigure $c -blocking 0 -trans lf -buffering line
     set count 0
-    puts $s hello
+    puts $c hello
     proc readit {s} {
 	global count done
-	set l [read $s]
-	incr count [string length $l]
+	set data [read $s]
+	dputs "read \"[string replace $data 10 end-3 ...]\" \
+		([string length $data]) from $s"
+	incr count [string length $data]
 	if {[eof $s]} {
 	    close $s
 	    set done 1
 	}
     }
-    fileevent $s readable "readit $s"
+    fileevent $c readable "readit $c"
     set done 0
     set timer [after 10000 "set done timed_out"]
     vwait done
     after cancel $timer
-    close $l
+    close $s
     list $count $done
 } {65566 1}
 
-test tlsIO-9.3 {testing EOF stickyness} {unexplainedHang socket} {
-    # HOBBS: still fails post-rewrite
-    # hangs
+test tlsIO-9.3 {testing EOF stickyness} {unexplainedFailure socket} {
+    # HOBBS: never worked correctly
     proc count_to_eof {s} {
 	global count done timer
 	set l [gets $s]
 	if {[eof $s]} {
 	    incr count
@@ -1177,22 +1225,23 @@
     proc write_then_close {s} {
 	puts $s bye
 	close $s
     }
     proc accept {s a p} {
-	fconfigure $s -buffering line -translation lf
-	fileevent $s writable "write_then_close $s"
+	fconfigure $s -blocking 0 -buffering line -translation lf
+	fileevent $s writable [list do_handshake $s writable write_then_close \
+		-buffering line -translation lf]
     }
     set s [tls::socket \
-	-certfile $serverCert -cafile $caCert -keyfile $serverKey \
-    	-server accept 8833]
+	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
+	    -server accept 8833]
     set c [tls::socket \
-	-certfile $clientCert -cafile $caCert -keyfile $clientKey \
-    	[info hostname] 8833]
-    fconfigure $c -blocking off -buffering line -translation lf
+	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
+	    [info hostname] 8833]
+    fconfigure $c -blocking 0 -buffering line -translation lf
     fileevent $c readable "count_to_eof $c"
-    set timer [after 1000 timerproc]
+    set timer [after 2000 timerproc]
     vwait done
     close $s
     set count
 } {eof is sticky}
 
@@ -1199,38 +1248,27 @@
 removeFile script
 
 test tlsIO-10.1 {testing socket accept callback error handling} {socket} {
     set goterror 0
     proc bgerror args {global goterror; set goterror 1}
-    set s [tls::socket \
-	-certfile $serverCert -cafile $caCert -keyfile $serverKey \
-    	-server accept 8898]
+    set s [tls::socket -cafile $caCert -server accept 8898]
     proc accept {s a p} {close $s; error}
-    set c [tls::socket \
-	-certfile $clientCert -cafile $caCert -keyfile $clientKey \
-	127.0.0.1 8898]
+    set c [tls::socket -cafile $caCert 127.0.0.1 8898]
     vwait goterror
     close $s
     close $c
     set goterror
 } 1
 
 test tlsIO-11.1 {tcp connection} {socket doTestsWithRemoteServer} {
-    sendCommand "set caCert $caCert"
-    sendCommand "set serverCert $serverCert"
-    sendCommand "set clientCert $clientCert"
-    sendCommand "set serverKey $serverKey"
-    sendCommand "set clientKey $clientKey"
+    sendCertValues
     sendCommand {
 	set socket9_1_test_server [tls::socket -server accept \
-		-certfile $serverCert \
-		-cafile $caCert \
-		-keyfile $serverKey \
-		8834]
+		-certfile $serverCert -cafile $caCert -keyfile $serverKey 8834]
 	proc accept {s a p} {
-	    puts $s done
 	    tls::handshake $s
+	    puts $s done
 	    close $s
 	}
     }
     set s [tls::socket \
 	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
@@ -1240,26 +1278,19 @@
     sendCommand {close $socket9_1_test_server}
     set r
 } done
 
 test tlsIO-11.2 {client specifies its port} {socket doTestsWithRemoteServer} {
-    sendCommand "set caCert $caCert"
-    sendCommand "set serverCert $serverCert"
-    sendCommand "set clientCert $clientCert"
-    sendCommand "set serverKey $serverKey"
-    sendCommand "set clientKey $clientKey"
     if {[info exists port]} {
 	incr port
     } else {
 	set port [expr $tlsServerPort + [pid]%1024]
     }
+    sendCertValues
     sendCommand {
 	set socket9_2_test_server [tls::socket -server accept \
-		-certfile $serverCert \
-		-cafile $caCert \
-		-keyfile $serverKey \
-	    8835]
+		-certfile $serverCert -cafile $caCert -keyfile $serverKey 8835]
 	proc accept {s a p} {
 	    tls::handshake $s
 	    puts $s $p
 	    close $s
 	}
@@ -1275,10 +1306,11 @@
     } else {
 	set result broken
     }
     set result
 } ok
+
 test tlsIO-11.3 {trying to connect, no server} {socket doTestsWithRemoteServer} {
     set status ok
     if {![catch {set s [tls::socket \
 	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
 	    $remoteServerIp 8836]}]} {
@@ -1289,23 +1321,14 @@
     }
     set status
 } ok
 
 test tlsIO-11.4 {remote echo, one line} {socket doTestsWithRemoteServer} {
-    sendCommand "set caCert $caCert"
-    sendCommand "set serverCert $serverCert"
-    sendCommand "set clientCert $clientCert"
-    sendCommand "set serverKey $serverKey"
-    sendCommand "set clientKey $clientKey"
+    sendCertValues
     sendCommand {
-    	global serverCert
-	global caCert
-	global serverKey
 	set socket10_6_test_server [tls::socket \
-		-certfile $serverCert \
-		-cafile $caCert \
-		-keyfile $serverKey \
+		-certfile $serverCert -cafile $caCert -keyfile $serverKey \
 		-server accept 8836]
 	proc accept {s a p} {
 	    tls::handshake $s
 	    fileevent $s readable [list echo $s]
 	    fconfigure $s -buffering line -translation crlf
@@ -1329,21 +1352,14 @@
     sendCommand {close $socket10_6_test_server}
     set r
 } hello
 
 test tlsIO-11.5 {remote echo, 50 lines} {socket doTestsWithRemoteServer} {
-    sendCommand "set caCert $caCert"
-    sendCommand "set serverCert $serverCert"
-    sendCommand "set clientCert $clientCert"
-    sendCommand "set serverKey $serverKey"
-    sendCommand "set clientKey $clientKey"
+    sendCertValues
     sendCommand {
 	set socket10_7_test_server [tls::socket -server accept \
-		-certfile $serverCert \
-		-cafile $caCert \
-		-keyfile $serverKey \
-		8836]
+		-certfile $serverCert -cafile $caCert -keyfile $serverKey 8836]
 	proc accept {s a p} {
 	    tls::handshake $s
 	    fileevent $s readable [list echo $s]
 	    fconfigure $s -buffering line -translation crlf
 	}
@@ -1393,19 +1409,16 @@
     close $s1
     set result
 } $conflictResult
 
 test tlsIO-11.7 {server with several clients} {socket doTestsWithRemoteServer} {
+    sendCertValues
     sendCommand {
 	set socket10_9_test_server [tls::socket \
-		-certfile [file join [pwd] certs server.pem] \
-		-cafile [file join [pwd] certs caFile.pem] \
-		-keyfile [file join [pwd] certs skey.pem] \
+		-certfile $serverCert -cafile $caCert -keyfile $serverKey \
 		-server accept 8836]
 	proc accept {s a p} {
-	    # handshake locks up the three synchronous clients
-	    # tls::handshake $s
 	    fconfigure $s -buffering line
 	    fileevent $s readable [list echo $s]
 	}
 	proc echo {s} {
 	    set l [gets $s]
@@ -1441,43 +1454,40 @@
     close $s3
     sendCommand {close $socket10_9_test_server}
     set i
 } 100    
 
-test tlsIO-11.8 {client with several servers} {unexplainedHang socket doTestsWithRemoteServer} {
-    # this one seems to hang -- awb 6/2/2000
+test tlsIO-11.8 {client with several servers} {socket doTestsWithRemoteServer} {
+    sendCertValues
     sendCommand {
-	set s1 [tls::socket \
-		-certfile [file join [pwd] certs server.pem] \
-		-cafile [file join [pwd] certs caFile.pem] \
-		-keyfile [file join [pwd] certs skey.pem] \
-		-server "accept 4003" 4003]
-	set s2 [tls::socket \
-		-certfile [file join [pwd] certs server.pem] \
-		-cafile [file join [pwd] certs caFile.pem] \
-		-keyfile [file join [pwd] certs skey.pem] \
-		-server "accept 4004" 4004]
-	set s3 [tls::socket \
-		-certfile [file join [pwd] certs server.pem] \
-		-cafile [file join [pwd] certs caFile.pem] \
-		-keyfile [file join [pwd] certs skey.pem] \
-		-server "accept 4005" 4005]
+	tls::init -certfile $serverCert -cafile $caCert -keyfile $serverKey
+	set s1 [tls::socket -server "accept 4003" 4003]
+	set s2 [tls::socket -server "accept 4004" 4004]
+	set s3 [tls::socket -server "accept 4005" 4005]
+	proc handshake {s mp} {
+	    if {[eof $s]} {
+		close $s
+	    } elseif {[catch {tls::handshake $s} result]} {
+		# Some errors are normal.
+	    } elseif {$result == 1} {
+		# Handshake complete
+		fileevent $s readable ""
+		puts $s $mp
+		close $s
+	    }
+	}
 	proc accept {mp s a p} {
-	    tls::handshake $s
-	    puts $s $mp
-	    close $s
+	    # These have to accept non-blocking, because the handshaking
+	    # order isn't deterministic
+	    fconfigure $s -blocking 0 -buffering line
+	    fileevent $s readable [list handshake $s $mp]
 	}
     }
-    set s1 [tls::socket \
-	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
-	    $remoteServerIP 4003]
-    set s2 [tls::socket \
-	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
-	    $remoteServerIP 4004]
-    set s3 [tls::socket \
-	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
-	    $remoteServerIP 4005]
+    tls::init -certfile $clientCert -cafile $caCert -keyfile $clientKey
+    set s1 [tls::socket $remoteServerIP 4003]
+    set s2 [tls::socket $remoteServerIP 4004]
+    set s3 [tls::socket $remoteServerIP 4005]
     set l ""
     lappend l [gets $s1] [gets $s1] [eof $s1] [gets $s2] [gets $s2] [eof $s2] \
 	[gets $s3] [gets $s3] [eof $s3]
     close $s1
     close $s2
@@ -1488,31 +1498,25 @@
 	close $s3
     }
     set l
 } {4003 {} 1 4004 {} 1 4005 {} 1}
 
-test tlsIO-11.9 {accept callback error} {knownBug socket doTestsWithRemoteServer} {
+test tlsIO-11.9 {accept callback error} {socket doTestsWithRemoteServer} {
     set s [tls::socket \
 	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
 	    -server accept 8836]
     proc accept {s a p} {expr 10 / 0}
     proc bgerror args {
 	global x
 	set x $args
     }
-    sendCommand "set caCert $caCert"
-    sendCommand "set serverCert $serverCert"
-    sendCommand "set clientCert $clientCert"
-    sendCommand "set serverKey $serverKey"
-    sendCommand "set clientKey $clientKey"
+    sendCertValues
     if {[catch {sendCommand {
 	    set peername [fconfigure $callerSocket -peername]
 	    set s [tls::socket \
-		-certfile $clientCert \
-		-cafile $caCert \
-		-keyfile $clientKey \
-	    	[lindex $peername 0] 8836]
+		    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
+		    [lindex $peername 0] 8836]
 	    close $s
     	 }} msg]} {
 	close $s
 	error $msg
     }
@@ -1522,21 +1526,15 @@
     close $s
     rename bgerror {}
     set x
 } {{divide by zero}}
 
-test tlsIO-11.10 {testing socket specific options} {unexplainedFailure socket doTestsWithRemoteServer} {
-    sendCommand "set caCert $caCert"
-    sendCommand "set serverCert $serverCert"
-    sendCommand "set clientCert $clientCert"
-    sendCommand "set serverKey $serverKey"
-    sendCommand "set clientKey $clientKey"
+test tlsIO-11.10 {testing socket specific options} {socket doTestsWithRemoteServer} {
+    sendCertValues
     sendCommand {
 	set socket10_12_test_server [tls::socket \
-		-certfile $serverCert \
-		-cafile $caCert \
-		-keyfile $serverKey \
+		-certfile $serverCert -cafile $caCert -keyfile $serverKey \
 		-server accept 8836]
 	proc accept {s a p} {close $s}
     }
     set s [tls::socket \
 	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
@@ -1548,27 +1546,30 @@
     close $s
     sendCommand {close $socket10_12_test_server}
     set l
 } {8836 3 3}
 
-test tlsIO-11.11 {testing spurious events} {unexplainedHang socket doTestsWithRemoteServer} {
-    # hangs
-    sendCommand "set caCert $caCert"
-    sendCommand "set serverCert $serverCert"
-    sendCommand "set clientCert $clientCert"
-    sendCommand "set serverKey $serverKey"
-    sendCommand "set clientKey $clientKey"
+test tlsIO-11.11 {testing spurious events} {socket doTestsWithRemoteServer} {
+    # remote equivalent of 9.1
+    sendCertValues
     sendCommand {
-	set socket10_13_test_server [tls::socket \
-		-certfile $serverCert \
-		-cafile $caCert \
-		-keyfile $serverKey \
-		-server accept 8836]
+	set socket_test_server [tls::socket -server accept \
+		-certfile $serverCert -cafile $caCert -keyfile $serverKey 8836]
+	proc handshake {s} {
+	    if {[eof $s]} {
+		close $s
+	    } elseif {[catch {tls::handshake $s} result]} {
+		# Some errors are normal.
+	    } elseif {$result == 1} {
+		# Handshake complete
+		fileevent $s writable ""
+		after 100 writesome $s
+	    }
+	}
 	proc accept {s a p} {
-	    tls::handshake $s
 	    fconfigure $s -translation "auto lf"
-	    after 100 writesome $s
+	    fileevent $s writable [list handshake $s]
 	}
 	proc writesome {s} {
 	    for {set i 0} {$i < 100} {incr i} {
 		puts $s "line $i from remote server"
 	    }
@@ -1593,19 +1594,25 @@
 	}
     }
     set c [tls::socket \
 	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
 	    $remoteServerIP 8836]
-    fileevent $c readable "readlittle $c"
+    # Get the buffering corrected
+    fconfigure $c -buffering line
+    # Put a byte into the client pipe to trigger TLS handshaking
+    puts $c a
+    fileevent $c readable [list readlittle $c]
     set timer [after 10000 "set done timed_out"]
     vwait done
     after cancel $timer
-    sendCommand {close $socket10_13_test_server}
+    sendCommand {close $socket_test_server}
     list $spurious $len
 } {0 2690}
 
-test tlsIO-11.12 {testing EOF stickyness} {knownBug socket doTestsWithRemoteServer} {
+test tlsIO-11.12 {testing EOF stickyness} {unexplainedFailure socket doTestsWithRemoteServer} {
+    # remote equivalent of 9.3
+    # HOBBS: never worked correctly
     set counter 0
     set done 0
     proc count_up {s} {
 	global counter done after_id
 	set l [gets $s]
@@ -1621,29 +1628,23 @@
     proc timed_out {} {
 	global c done
 	set done {timed_out, EOF is not sticky}
 	close $c
     }
-    sendCommand "set caCert $caCert"
-    sendCommand "set serverCert $serverCert"
-    sendCommand "set clientCert $clientCert"
-    sendCommand "set serverKey $serverKey"
-    sendCommand "set clientKey $clientKey"
+    sendCertValues
     sendCommand {
 	set socket10_14_test_server [tls::socket \
-		-certfile $serverCert \
-		-cafile $caCert \
-		-keyfile $serverKey \
+		-certfile $serverCert -cafile $caCert -keyfile $serverKey \
 		-server accept 8836]
 	proc accept {s a p} {
 	    tls::handshake $s
 	    after 100 close $s
 	}
     }
     set c [tls::socket \
 	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
-    	$remoteServerIP 8836]
+	    $remoteServerIP 8836]
     fileevent $c readable "count_up $c"
     set after_id [after 1000 timed_out]
     vwait done
     sendCommand {close $socket10_14_test_server}
     set done
@@ -1658,33 +1659,21 @@
 	if {[eof $s]} {
 	    close $s
 	    set done 1
 	}
     }
-    sendCommand "set caCert $caCert"
-    sendCommand "set serverCert $serverCert"
-    sendCommand "set clientCert $clientCert"
-    sendCommand "set serverKey $serverKey"
-    sendCommand "set clientKey $clientKey"
+    sendCertValues
     sendCommand {
-	set firstblock ""
-	for {set i 0} {$i < 5} {incr i} {
-		set firstblock "a$firstblock$firstblock"
-	}
-	set secondblock ""
-	for {set i 0} {$i < 16} {incr i} {
-	    set secondblock "b$secondblock$secondblock"
-	}
+	set firstblock [string repeat a 31]
+	set secondblock [string repeat b 65535]
 	set l [tls::socket \
-		-certfile $serverCert \
-		-cafile $caCert \
-		-keyfile $serverKey \
+		-certfile $serverCert -cafile $caCert -keyfile $serverKey \
 		-server accept 8845]
 	proc accept {s a p} {
 	    tls::handshake $s
 	    fconfigure $s -blocking 0 -translation lf -buffersize 16384 \
-		-buffering line
+		    -buffering line
 	    fileevent $s readable "readable $s"
 	}
 	proc readable {s} {
 	    set l [gets $s]
 	    fileevent $s readable {}
@@ -1701,12 +1690,12 @@
 	    close $s
 	}
     }
     set s [tls::socket \
 	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
-    	$remoteServerIP 8845]
-    fconfigure $s -blocking 0 -trans lf -buffering line
+	    $remoteServerIP 8845]
+    fconfigure $s -blocking 0 -translation lf -buffering line
     set count 0
     puts $s hello
     fileevent $s readable "readit $s"
     set timer [after 10000 "set done timed_out"]
     vwait done
@@ -1713,14 +1702,13 @@
     after cancel $timer
     sendCommand {close $l}
     set count
 } 65566
 
-test tlsIO-12.1 {testing inheritance of server sockets} \
-	{socket doTestsWithRemoteServer} {
-    removeFile script1
-    removeFile script2
+test tlsIO-12.1 {testing inheritance of server sockets} {socket exec} {
+    makeFile {} script1
+    makeFile {} script2
 
     # Script1 is just a 10 second delay.  If the server socket
     # is inherited, it will be held open for 10 seconds
 
     set f [open script1 w]
@@ -1733,33 +1721,28 @@
     # Script2 creates the server socket, launches script1,
     # waits a second, and exits.  The server socket will now
     # be closed unless script1 inherited it.
 
     set f [open script2 w]
-    # puts $f [list set tcltest $::tcltest::tcltest]
-    puts $f [list set tclsh [info nameofexecutable]]
-    puts $f {
-	package require tcltest
-	package require tls
-    }
-    puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828 \]"
+    puts $f [list set tclsh $::tcltest::tcltest]
+    puts $f {package require tls}
+    puts $f "set f \[tls::socket -server accept \
+	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828\]"
     puts $f {
 	proc accept { file addr port } {
 	    close $file
 	}
-	# exec $::tcltest::tcltest script1 &
 	exec $tclsh script1 &
 	close $f
 	after 1000 exit
 	vwait forever
     }
     close $f
 	
     # Launch script2 and wait 5 seconds
 
-    # exec $::tcltest::tcltest script2 &
-    exec [info nameofexecutable] script2 &
+    exec $::tcltest::tcltest script2 &
     after 5000 { set ok_to_proceed 1 }
     vwait ok_to_proceed
 
     # If we can still connect to the server, the socket got inherited.
 
@@ -1770,19 +1753,16 @@
     } else {
 	close $msg
 	set x {server socket was inherited}
     }
 
-    removeFile script1
-    removeFile script2
     set x
 } {server socket was not inherited}
 
-test tlsIO-12.2 {testing inheritance of client sockets} \
-	{unexplainedFailure socket doTestsWithRemoteServer} {
-    removeFile script1
-    removeFile script2
+test tlsIO-12.2 {testing inheritance of client sockets} {socket exec} {
+    makeFile {} script1
+    makeFile {} script2
 
     # Script1 is just a 10 second delay.  If the server socket
     # is inherited, it will be held open for 10 seconds
 
     set f [open script1 w]
@@ -1795,15 +1775,14 @@
     # Script2 opens the client socket and writes to it.  It then
     # launches script1 and exits.  If the child process inherited the
     # client socket, the socket will still be open.
 
     set f [open script2 w]
-    puts $f [list set tclsh [info nameofexecutable]]
-    puts $f {
-    	package require tls
-    }
-    puts $f "set f \[tls::socket -certfile $clientCert -cafile $caCert -keyfile $clientKey 127.0.0.1 8829 \]"
+    puts $f [list set tclsh $::tcltest::tcltest]
+    puts $f {package require tls}
+    puts $f "set f \[tls::socket -certfile $clientCert -cafile $caCert \
+	    -keyfile $clientKey 127.0.0.1 8829\]"
     puts $f {
 	exec $tclsh script1 &
 	puts $f testing
 	flush $f
 	after 1000 exit
@@ -1812,23 +1791,22 @@
     close $f
 
     # Create the server socket
 
     set server [tls::socket \
-	-certfile $serverCert -cafile $caCert -keyfile $serverKey \
-	-server accept 8829]
+	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
+	    -server accept 8829]
     proc accept { file host port } {
-
 	# When the client connects, establish the read handler
 	global server
 	close $server
-	fileevent $file readable [list getdata $file]
-	fconfigure $file -buffering line -blocking 0
+	fconfigure $file -blocking 0
+	fileevent $file readable [list do_handshake $file readable getdata \
+		-buffering line]
 	return
     }
     proc getdata { file } {
-
 	# Read handler on the accepted socket.
 	global x
 	global failed
 	set status [catch {read $file} data]
 	if {$status != 0} {
@@ -1856,79 +1834,77 @@
     set failed 0
     after 5000 [list set failed 1]
 
     # Launch the script2 process
 
-    exec [info nameofexecutable] script2 &
+    exec $::tcltest::tcltest script2 &
 
     vwait x
     if {!$failed} {
 	vwait failed
     }
-    removeFile script1
-    removeFile script2
     set x
 } {client socket was not inherited}
 
-test tlsIO-12.3 {testing inheritance of accepted sockets} \
-	{hangsOnLinux socket doTestsWithRemoteServer} {
-    # hangs on Linux
-    removeFile script1
-    removeFile script2
+test tlsIO-12.3 {testing inheritance of accepted sockets} {socket exec} {
+    makeFile {} script1
+    makeFile {} script2
 
     set f [open script1 w]
     puts $f {
 	after 10000 exit
 	vwait forever
     }
     close $f
 
     set f [open script2 w]
-    puts $f [list set tclsh [info nameofexecutable]]
-    puts $f {
-    	package require tls
-    }
-    puts $f "catch {set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8930 \]}"
+    puts $f [list set tclsh $::tcltest::tcltest]
+    puts $f {package require tls}
+    puts $f "set f \[tls::socket -server accept \
+	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8930\]"
     puts $f {
 	proc accept { file host port } {
 	    global tclsh
+	    fconfigure $file -buffering line
 	    puts $file {test data on socket}
 	    exec $tclsh script1 &
 	    after 1000 exit
 	}
-	catch {vwait forever}
+	vwait forever
     }
     close $f
 
     # Launch the script2 process and connect to it.  See how long
     # the socket stays open
 
-    exec [info nameofexecutable] script2 &
+    exec $::tcltest::tcltest script2 &
 
-    after 1000 set ok_to_proceed 1
+    after 2000 set ok_to_proceed 1
     vwait ok_to_proceed
 
     set f [tls::socket \
 	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
 	    127.0.0.1 8930]
     fconfigure $f -buffering full -blocking 0
+    # We need to put a byte into the read queue, otherwise the
+    # TLS handshake doesn't finish
+    puts $f a; flush $f
     fileevent $f readable [list getdata $f]
 
     # If the socket is still open after 5 seconds, the script1 process
     # must have inherited the accepted socket.
 
     set failed 0
     after 5000 set failed 1
 
     proc getdata { file } {
-
 	# Read handler on the client socket.
 	global x
 	global failed
 	set status [catch {read $file} data]
 	if {$status != 0} {
-	    set x {read failed, error was $data}
+	    set x "read failed, error was $data"
 	    catch { close $file }
 	} elseif {[string compare {} $data]} {
 	} elseif {[fblocked $file]} {
 	} elseif {[eof $file]} {
 	    if {$failed} {
@@ -1943,19 +1919,16 @@
 	}
 	return
     }
     
     vwait x
-
-    removeFile script1
-    removeFile script2
     set x
 } {accepted socket was not inherited}
 
 test tlsIO-13.1 {Testing use of shared socket between two threads} \
 	{socket testthread} {
-
+    # HOBBS: never tested
     removeFile script
     threadReap
 
     makeFile {
     	package require tls
@@ -2014,6 +1987,5 @@
 catch {close $commandSocket}
 catch {close $remoteProcChan}
 ::tcltest::cleanupTests
 flush stdout
 return
-

Index: tls.c
==================================================================
--- tls.c
+++ tls.c
@@ -1,9 +1,9 @@
 /*
  * Copyright (C) 1997-1999 Matt Newman <matt@novadigm.com>
  *
- * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.6.2.1 2000/07/11 04:58:46 hobbs Exp $
+ * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.6.2.2 2000/07/21 05:32:56 hobbs Exp $
  *
  * TLS (aka SSL) Channel - can be layered on any bi-directional
  * Tcl_Channel (Note: Requires Trf Core Patch)
  *
  * This was built (almost) from scratch based upon observation of
@@ -29,31 +29,33 @@
 /*
  * Forward declarations
  */
 
 #define F2N( key, dsp) \
-	(((key) == NULL)?(char*)NULL:Tcl_TranslateFileName( interp, (key), (dsp)))
+	(((key) == NULL) ? (char *) NULL : \
+		Tcl_TranslateFileName(interp, (key), (dsp)))
 #define REASON()	ERR_reason_error_string(ERR_get_error())
 
-static int	CiphersObjCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp,
-			   int objc, Tcl_Obj *CONST objv[]));
-
-static int	HandshakeObjCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp,
-			   int objc, Tcl_Obj *CONST objv[]));
-
-static int	ImportObjCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp,
-			   int objc, Tcl_Obj *CONST objv[]));
-
-static int	StatusObjCmd _ANSI_ARGS_ ((ClientData clientData, Tcl_Interp *interp,
-			   int objc, Tcl_Obj *CONST objv[]));
+static int	CiphersObjCmd _ANSI_ARGS_ ((ClientData clientData,
+			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+
+static int	HandshakeObjCmd _ANSI_ARGS_ ((ClientData clientData,
+			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+
+static int	ImportObjCmd _ANSI_ARGS_ ((ClientData clientData,
+			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+
+static int	StatusObjCmd _ANSI_ARGS_ ((ClientData clientData,
+			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 static SSL_CTX *CTX_Init _ANSI_ARGS_((Tcl_Interp *interp, int proto, char *key,
-			    char *cert, char *CAdir, char *CAfile, char *ciphers));
+			char *cert, char *CAdir, char *CAfile, char *ciphers));
 
 #define TLS_PROTO_SSL2	0x01
 #define TLS_PROTO_SSL3	0x02
 #define TLS_PROTO_TLS1	0x04
 #define ENABLED(flag, mask)	(((flag) & (mask)) == (mask))
+
 /*
  * Static data structures
  */
 
 #ifndef NO_DH
@@ -549,24 +551,26 @@
     if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
         Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
                 "\": not a TLS channel", NULL);
         return TCL_ERROR;
     }
-    statePtr = (State *)Tcl_GetChannelInstanceData( chan);
+    statePtr = (State *)Tcl_GetChannelInstanceData(chan);
 
     if (!SSL_is_init_finished(statePtr->ssl)) {
 	int err;
 	ret = Tls_WaitForConnect(statePtr, &err);
 	if (ret < 0) {
 	    char *errStr = statePtr->err;
 	    Tcl_ResetResult(interp);
 	    Tcl_SetErrno(err);
 
-	    if (!errStr || *errStr == 0)
+	    if (!errStr || *errStr == 0) {
 	        errStr = Tcl_PosixError(interp);
+	    }
 
-	    Tcl_AppendResult(interp, "handshake failed: ", errStr, (char*)NULL);
+	    Tcl_AppendResult(interp, "handshake failed: ", errStr,
+		    (char *) NULL);
 	    return TCL_ERROR;
 	}
     }
     Tcl_SetObjResult(interp, Tcl_NewIntObj(ret));
     return TCL_OK;
@@ -1086,25 +1090,28 @@
  *-------------------------------------------------------------------
  */
 void
 Tls_Clean(State *statePtr)
 {
-    /* we're assuming here that we're single-threaded */
+    /*
+     * we're assuming here that we're single-threaded
+     */
+
+    if (statePtr->timer != (Tcl_TimerToken) NULL) {
+	Tcl_DeleteTimerHandler(statePtr->timer);
+	statePtr->timer = NULL;
+    }
+
     if (statePtr->ssl) {
 	SSL_shutdown(statePtr->ssl);
 	SSL_free(statePtr->ssl);
 	statePtr->ssl = NULL;
     }
     if (statePtr->callback) {
 	Tcl_DecrRefCount(statePtr->callback);
 	statePtr->callback = NULL;
     }
-
-    if (statePtr->timer != (Tcl_TimerToken)NULL) {
-	Tcl_DeleteTimerHandler (statePtr->timer);
-	statePtr->timer = NULL;
-    }
 }
 
 /*
  *-------------------------------------------------------------------
  *

Index: tls.tcl
==================================================================
--- tls.tcl
+++ tls.tcl
@@ -1,9 +1,9 @@
 #
 # Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com>
 #
-# $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.tcl,v 1.2 2000/01/20 01:51:05 aborr Exp $
+# $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.tcl,v 1.2.2.1 2000/07/21 05:32:56 hobbs Exp $
 #
 namespace eval tls {
     variable logcmd tclLog
     variable debug 0
  
@@ -46,26 +46,26 @@
     set iopts [concat [list -server $server] ${tls::defaults}]	;# Import options
 
     for {set idx 0} {$idx < $argc} {incr idx} {
 	set arg [lindex $args $idx]
 	switch -glob -- $server,$arg {
-	0,-myport	-
-	*,-myaddr	{lappend sopts $arg [lindex $args [incr idx]]}
-	0,-async	{lappend sopts $arg}
-	*,-cipher	-
-	*,-cadir	-
-	*,-cafile	-
-	*,-certfile	-
-	*,-keyfile	-
-	*,-command	-
-	*,-request	-
-	*,-require	-
-	*,-ssl2		-
-	*,-ssl3		-
-	*,-tls1		{lappend iopts $arg [lindex $args [incr idx]]}
-	-*		{return -code error "bad option \"$arg\": must be one of $options"}
-	default	{break}
+	    0,-myport	-
+	    *,-myaddr	{lappend sopts $arg [lindex $args [incr idx]]}
+	    0,-async	{lappend sopts $arg}
+	    *,-cipher	-
+	    *,-cadir	-
+	    *,-cafile	-
+	    *,-certfile	-
+	    *,-keyfile	-
+	    *,-command	-
+	    *,-request	-
+	    *,-require	-
+	    *,-ssl2	-
+	    *,-ssl3	-
+	    *,-tls1	{lappend iopts $arg [lindex $args [incr idx]]}
+	    -*		{return -code error "bad option \"$arg\": must be one of $options"}
+	    default	{break}
 	}
     }
     if {$server} {
 	if {($idx + 1) != $argc} {
 	    return -code error $usage
@@ -72,10 +72,11 @@
 	}
 	set uid [incr ::tls::srvuid]
 
 	set port [lindex $args [expr {$argc-1}]]
 	lappend sopts $port
+	#set sopts [linsert $sopts 0 -server $callback]
 	set sopts [linsert $sopts 0 -server [list tls::_accept $iopts $callback]]
 	#set sopts [linsert $sopts 0 -server [list tls::_accept $uid $callback]]
     } else {
 	if {($idx + 2) != $argc} {
 	    return -code error $usage
@@ -98,10 +99,26 @@
 	catch {close $chan}
 	return -code error -errorinfo $info $err
     }
     return $chan
 }
+
+# tls::_accept --
+#
+#   This is the actual accept that TLS sockets use, which then calls
+#   the callback registered by tls::socket.
+#
+# Arguments:
+#   iopts	tls::import opts
+#   callback	server callback to invoke
+#   chan	socket channel to accept/deny
+#   ipaddr	calling IP address
+#   port	calling port
+#
+# Results:
+#   Returns an error if the callback throws one.
+#
 proc tls::_accept { iopts callback chan ipaddr port } {
     log 2 [list tls::_accept $iopts $callback $chan $ipaddr $port]
 
     set chan [eval [list tls::import $chan] $iopts]
 
@@ -109,10 +126,11 @@
     if {[catch {
 	uplevel #0 $callback
     } err]} {
 	log 1 "tls::_accept error: ${::errorInfo}"
 	close $chan
+	error $err $::errorInfo $::errorCode
     } else {
 	log 2 "tls::_accept - called \"$callback\" succeeded"
     }
 }
 #
@@ -127,49 +145,50 @@
     variable debug
 
     #log 2 [concat $option $args]
 
     switch -- $option {
-    "error"	{
-	foreach {chan msg} $args break
-
-	log 0 "TLS/$chan: error: $msg"
-    }
-    "verify"	{
-	# poor man's lassign
-	foreach {chan depth cert rc err} $args break
-
-	array set c $cert
-
-	if {$rc != "1"} {
-	    log 1 "TLS/$chan: verify/$depth: Bad Cert: $err (rc = $rc)"
-	} else {
-	    log 2 "TLS/$chan: verify/$depth: $c(subject)"
-	}
-	if {$debug > 0} {
-	    return 1;	# FORCE OK
-	} else {
-	    return $rc
-	}
-    }
-    "info"	{
-	# poor man's lassign
-	foreach {chan major minor state msg} $args break
-
-	if {$msg != ""} {
-	    append state ": $msg"
-	}
-	# For tracing
-	upvar #0 tls::$chan cb
-	set cb($major) $minor
-
-	log 2 "TLS/$chan: $major/$minor: $state"
-    }
-    default	{
-	return -code error "bad option \"$option\": must be one of error, info, or verify"
-    }
-    };#sw
+	"error"	{
+	    foreach {chan msg} $args break
+
+	    log 0 "TLS/$chan: error: $msg"
+	}
+	"verify"	{
+	    # poor man's lassign
+	    foreach {chan depth cert rc err} $args break
+
+	    array set c $cert
+
+	    if {$rc != "1"} {
+		log 1 "TLS/$chan: verify/$depth: Bad Cert: $err (rc = $rc)"
+	    } else {
+		log 2 "TLS/$chan: verify/$depth: $c(subject)"
+	    }
+	    if {$debug > 0} {
+		return 1;	# FORCE OK
+	    } else {
+		return $rc
+	    }
+	}
+	"info"	{
+	    # poor man's lassign
+	    foreach {chan major minor state msg} $args break
+
+	    if {$msg != ""} {
+		append state ": $msg"
+	    }
+	    # For tracing
+	    upvar #0 tls::$chan cb
+	    set cb($major) $minor
+
+	    log 2 "TLS/$chan: $major/$minor: $state"
+	}
+	default	{
+	    return -code error "bad option \"$option\":\
+		    must be one of error, info, or verify"
+	}
+    }
 }
 
 proc tls::xhandshake {chan} {
     upvar #0 tls::$chan cb
 

Index: tlsBIO.c
==================================================================
--- tlsBIO.c
+++ tlsBIO.c
@@ -1,9 +1,9 @@
 /*
  * Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com>
  *
- * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsBIO.c,v 1.2.2.2 2000/07/12 01:54:26 hobbs Exp $
+ * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsBIO.c,v 1.2.2.3 2000/07/21 05:32:57 hobbs Exp $
  *
  * Provides BIO layer to interface openssl to Tcl.
  */
 
 #include "tlsInt.h"
@@ -152,42 +152,41 @@
 	ret = 1;
 	break;
     case BIO_C_SET_FD:
 	BioFree(bio);
 	/* Sets State* */
-	bio->ptr = *((char **)ptr);
-	bio->shutdown = (int)num;
-	bio->init = 1;
+	bio->ptr	= *((char **)ptr);
+	bio->shutdown	= (int)num;
+	bio->init	= 1;
 	break;
     case BIO_C_GET_FD:
 	if (bio->init) {
-	    ip=(int *)ptr;
-	    if (ip != NULL) *ip=bio->num;
-		ret=bio->num;
+	    ip = (int *)ptr;
+	    if (ip != NULL) {
+		*ip = bio->num;
+	    }
+	    ret = bio->num;
 	} else {
-	    ret= -1;
+	    ret = -1;
 	}
 	break;
     case BIO_CTRL_GET_CLOSE:
-	ret=bio->shutdown;
+	ret = bio->shutdown;
 	break;
     case BIO_CTRL_SET_CLOSE:
-	bio->shutdown=(int)num;
+	bio->shutdown = (int)num;
 	break;
     case BIO_CTRL_EOF:
 	dprintf(stderr, "BIO_CTRL_EOF\n");
 	ret = Tcl_Eof( chan);
 	break;
     case BIO_CTRL_PENDING:
-	if (Tcl_InputBuffered(chan))
-	    ret = 1;
-	else
-	    ret = 0;
+	ret = (Tcl_InputBuffered(chan) ? 1 : 0);
 	dprintf(stderr, "BIO_CTRL_PENDING(%d)\n", ret);
 	break;
     case BIO_CTRL_WPENDING:
-	ret=0;
+	ret = 0;
 	break;
     case BIO_CTRL_DUP:
 	break;
     case BIO_CTRL_FLUSH:
 	dprintf(stderr, "BIO_CTRL_FLUSH\n");
@@ -212,31 +211,32 @@
 
 static int
 BioNew	(bio)
     BIO *bio;
 {
-    bio->init = 0;
-    bio->num = 0;
-    bio->ptr = NULL;
-    bio->flags = 0;
+    bio->init	= 0;
+    bio->num	= 0;
+    bio->ptr	= NULL;
+    bio->flags	= 0;
 
     return 1;
 }
 
 static int
 BioFree	(bio)
     BIO *bio;
 {
-    if (bio == NULL)
+    if (bio == NULL) {
 	return 0;
+    }
 
     if (bio->shutdown) {
 	if (bio->init) {
 	    /*shutdown(bio->num, 2) */
 	    /*closesocket(bio->num) */
 	}
-	bio->init = 0;
-	bio->flags = 0;
-	bio->num = 0;
+	bio->init	= 0;
+	bio->flags	= 0;
+	bio->num	= 0;
     }
     return 1;
 }

Index: tlsIO.c
==================================================================
--- tlsIO.c
+++ tlsIO.c
@@ -1,9 +1,9 @@
 /*
  * Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com>
  *
- * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsIO.c,v 1.7.2.2 2000/07/12 01:54:26 hobbs Exp $
+ * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsIO.c,v 1.7.2.3 2000/07/21 05:32:57 hobbs Exp $
  *
  * TLS (aka SSL) Channel - can be layered on any bi-directional
  * Tcl_Channel (Note: Requires Trf Core Patch)
  *
  * This was built from scratch based upon observation of OpenSSL 0.9.2B
@@ -57,18 +57,18 @@
  * based IO:
  */
 #ifdef TCL_CHANNEL_VERSION_2
 static Tcl_ChannelType tlsChannelType = {
     "tls",		/* Type name. */
-    TCL_CHANNEL_VERSION_2,	/* A NG channel */
-    TlsCloseProc,		/* Close proc. */
-    TlsInputProc,		/* Input proc. */
-    TlsOutputProc,		/* Output proc. */
+    TCL_CHANNEL_VERSION_2,	/* A v2 channel (8.3.2/8.4a2+) */
+    TlsCloseProc,	/* Close proc. */
+    TlsInputProc,	/* Input proc. */
+    TlsOutputProc,	/* Output proc. */
     NULL,		/* Seek proc. */
     NULL,		/* Set option proc. */
     TlsGetOptionProc,	/* Get option proc. */
-    TlsWatchProc,		/* Initialize notifier. */
+    TlsWatchProc,	/* Initialize notifier. */
     TlsGetHandleProc,	/* Get file handle out of channel. */
     NULL,		/* Close2Proc. */
     TlsBlockModeProc,	/* Set blocking/nonblocking mode.*/
     NULL,		/* FlushProc. */
     TlsNotifyProc,	/* handlerProc. */
@@ -75,17 +75,17 @@
 };
 #else
 static Tcl_ChannelType tlsChannelType = {
     "tls",		/* Type name. */
     TlsBlockModeProc,	/* Set blocking/nonblocking mode.*/
-    TlsCloseProc,		/* Close proc. */
-    TlsInputProc,		/* Input proc. */
-    TlsOutputProc,		/* Output proc. */
+    TlsCloseProc,	/* Close proc. */
+    TlsInputProc,	/* Input proc. */
+    TlsOutputProc,	/* Output proc. */
     NULL,		/* Seek proc. */
     NULL,		/* Set option proc. */
     TlsGetOptionProc,	/* Get option proc. */
-    TlsWatchProc,		/* Initialize notifier. */
+    TlsWatchProc,	/* Initialize notifier. */
     TlsGetHandleProc,	/* Get file handle out of channel. */
 };
 #endif
 
 Tcl_ChannelType *Tls_ChannelType()
@@ -155,22 +155,19 @@
 {
     State *statePtr = (State *) instanceData;
 
     dprintf(stderr,"\nTlsCloseProc(0x%x)", statePtr);
 
+#ifndef TCL_CHANNEL_VERSION_2
     /*
      * Remove event handler to underlying channel, this could
      * be because we are closing for real, or being "unstacked".
      */
-#ifndef TCL_CHANNEL_VERSION_2
+
     Tcl_DeleteChannelHandler(Tls_GetParent(statePtr),
 	TlsChannelHandler, (ClientData) statePtr);
 #endif
-    if (statePtr->timer != (Tcl_TimerToken)NULL) {
-	Tcl_DeleteTimerHandler (statePtr->timer);
-	statePtr->timer = (Tcl_TimerToken)NULL;
-    }
 
     Tls_Clean(statePtr);
     Tcl_EventuallyFree( (ClientData)statePtr, Tls_Free);
     return TCL_OK;
 }
@@ -711,18 +708,20 @@
 	    err = SSL_accept(statePtr->ssl);
 	} else {
 	    err = SSL_connect(statePtr->ssl);
 	}
 	/*SSL_write(statePtr->ssl, (char*)&err, 0);	HACK!!! */
-	if (err > 0)
+	if (err > 0) {
 	    BIO_flush(statePtr->bio);
+	}
 
 	if (err <= 0) {
 	    int rc = SSL_get_error(statePtr->ssl, err);
 
 	    if (rc == SSL_ERROR_SSL) {
-		Tls_Error(statePtr, (char*)ERR_reason_error_string(ERR_get_error()));
+		Tls_Error(statePtr,
+			(char *)ERR_reason_error_string(ERR_get_error()));
 		*errorCodePtr = ECONNABORTED;
 		return -1;
 	    } else if (BIO_should_retry(statePtr->bio)) {
 		if (statePtr->flags & TLS_TCL_ASYNC) {
 		    dprintf(stderr,"E! ");
@@ -737,11 +736,12 @@
 		return -1;
 	    }
 	    if (statePtr->flags & TLS_TCL_SERVER) {
 		err = SSL_get_verify_result(statePtr->ssl);
 		if (err != X509_V_OK) {
-		    Tls_Error(statePtr, (char*)X509_verify_cert_error_string(err));
+		    Tls_Error(statePtr,
+			    (char *)X509_verify_cert_error_string(err));
 		    *errorCodePtr = ECONNABORTED;
 		    return -1;
 		}
 	    }
 	    *errorCodePtr = Tcl_GetErrno();