Index: ChangeLog
==================================================================
--- ChangeLog
+++ ChangeLog
@@ -1,5 +1,88 @@
+2000-07-26  Jeff Hobbs  <hobbs@scriptics.com>
+
+	* merged all changes from tls-1-3-io-rewrite back into main branch
+
+	* tests/tlsIO.test: updated comments, fixed a pcCrash case that
+	was due to debug assertion in Windows SSL.
+
+	* tls.c (ImportObjCmd): removed unnecessary use of 'bio' arg.
+	(Tls_Init): check return value of SSL_library_init.  Also lots of
+	whitespace cleanup (more like Tcl Eng style guide), but not all
+	code was cleaned up.
+
+	* tlsBIO.c: minor whitespace cleanup
+
+	* tlsIO.c: minor whitespace cleanup.
+	(TlsInputProc, TlsOutputProc): Added ERR_clear_error before calls
+	to BIO_read or BIO_write, because we could otherwise end up
+	pulling an error off the stack that didn't belong to us.  Also
+	cleanup up excessive use of gotos.
+
+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
+
+2000-07-13  Jeff Hobbs  <hobbs@scriptics.com>
+
+	* tests/tlsIO.test: enabled tests 2.10, 7.[1245] (there is no 3),
+	which now pass.  Added some comments to other failing tests.
+
+2000-07-11  Jeff Hobbs  <hobbs@scriptics.com>
+
+	* tlsIO.c: changed all the channel procs to start with Tls* for
+	better parity when comparing with Transform channel procs.
+	Rewrote TlsWatchProc, added TlsNotifyProc according to the new
+	channel design, which also leaves TlsChannelHandler unused.
+
+	* tlsBIO.c (BioCtrl): changed BIO_CTRL_FLUSH case to use
+	Tcl_WriteRaw instead of Tcl_Flush (to operate on correct channel
+	in the stack instead of starting at the top again).  Would
+	otherwise cause a recursive stack bomb when implicit handshaking
+	took effect.
+
+	* tests/tlsIO.test: removed changes made to test suite (all tests
+	that ran before now pass correctly), and changed some accept proc
+	args to reflect that a sock is an arg, not a file.
+
+2000-07-10  Jeff Hobbs  <hobbs@scriptics.com>
+
+	* tlsBIO.c (BioWrite, BioRead): changed Tcl_Read/Write to
+	Tcl_ReadRaw/TclWriteRaw.
+
+	* tls.c: added use of Tcl_GetTopChannel after Tcl_GetChannel and
+	got return value from Tcl_StackChannel.
+
+	* tests/tlsIO.test: added some handshaking that shouldn't be
+	necessary, but we crash otherwise (needs more testing).
+
+	* tlsIO.c: added support for "corrected" stacked channels.  All
+	the above channels are in TCL_CHANNEL_VERSION_2 #ifdefs.
+
 2000-06-05  Scott Stanton  <stanton@ajubasolutions.com>
 
 	* Makefile.in: Fixed broken test target.
 
 	* tlsInt.h: 

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.14 2000/07/20 02:44:16 wart Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.15 2000/07/27 01:58:18 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: configure.in
==================================================================
--- configure.in
+++ configure.in
@@ -32,11 +32,11 @@
 #--------------------------------------------------------------------
 
 PACKAGE=tls
 
 MAJOR_VERSION=1
-MINOR_VERSION=3
+MINOR_VERSION=4
 PATCHLEVEL=
 
 VERSION=${MAJOR_VERSION}.${MINOR_VERSION}${PATCHLEVEL}
 NODOT_VERSION=${MAJOR_VERSION}${MINOR_VERSION}
 

Index: pkgIndex.tcl.in
==================================================================
--- pkgIndex.tcl.in
+++ pkgIndex.tcl.in
@@ -1,9 +1,9 @@
 
-# pkgIndex.tcl -
-#    A new manually generated "pkgIndex.tcl" file for tls to replace the original
-#    which didn't include the commands from "tls.tcl".
+# pkgIndex.tcl - 
+#
+#    A new manually generated "pkgIndex.tcl" file for tls to
+#    replace the original which didn't include the commands from "tls.tcl".
 #
-#    Al Borr 12/99, last revised Jan 11/00.
 
-package ifneeded tls 1.3 "[list load [file join $dir @RELPATH@ @tls_LIB_FILE@] ] ; [list source [file join $dir tls.tcl] ]"
+package ifneeded tls 1.4 "[list load [file join $dir @RELPATH@ @tls_LIB_FILE@] ] ; [list source [file join $dir tls.tcl] ]"
 

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.5 2000/07/27 01:58:19 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 2000/06/08 00:06:40 aborr Exp $
+# RCS: @(#) $Id: tlsIO.test,v 1.15 2000/07/27 01:58:19 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"}}
@@ -311,14 +348,14 @@
 	package require tls
 	set timer [after 2000 "set x done"]
     }
     puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8829 \]"
     puts $f {
-	proc accept {file addr port} {
+	proc accept {sock addr port} {
             global x
-            puts "[gets $file] $port"
-            close $file
+            puts "[gets $sock] $port"
+            close $sock
             set x done
 	}
 	puts ready
 	vwait x
 	after cancel $timer
@@ -350,14 +387,14 @@
 	package require tls
 	set timer [after 2000 "set x done"]
     }
     puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8830 \]"
     puts $f {
-	proc accept {file addr port} {
+	proc accept {sock addr port} {
             global x
-            puts "[gets $file] $addr"
-            close $file
+            puts "[gets $sock] $addr"
+            close $sock
             set x done
 	}
 	puts ready
 	vwait x
 	after cancel $timer
@@ -387,14 +424,14 @@
 	package require tls
 	set timer [after 2000 "set x done"]
     }
     puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey -myaddr [info hostname] 8831 \]"
     puts $f {
-	proc accept {file addr port} {
+	proc accept {sock addr port} {
             global x
-            puts "[gets $file]"
-            close $file
+            puts "[gets $sock]"
+            close $sock
             set x done
 	}
 	puts ready
 	vwait x
 	after cancel $timer
@@ -423,14 +460,14 @@
 	package require tls
 	set timer [after 2000 "set x done"]
     }
     puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8832 \]"
     puts $f {
-	proc accept {file addr port} {
+	proc accept {sock addr port} {
             global x
-            puts "[gets $file]"
-            close $file
+            puts "[gets $sock]"
+            close $sock
             set x done
 	}
 	puts ready
 	vwait x
 	after cancel $timer
@@ -562,25 +599,16 @@
     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)}}
-
-test tlsIO-2.10 {close on accept, accepted socket lives} {socket knownBug} {
+} {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 \
 	-keyfile $serverKey 8830]
     proc accept {s a p} {
@@ -602,46 +630,55 @@
     vwait done
     after cancel $timer
     set done
 } 1
 
-test tlsIO-2.11 {detecting new data} {socket knownBug} {
+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} {
+test tlsIO-2.12 {tcp connection; no certificates specified} \
+	{socket stdio unixOnly} {
+    # There is a debug assertion on Windows/SSL that causes a crash when the
+    # certificate isn't specified.
     removeFile script
     set f [open script w]
     puts $f {
     	package require tls
 	set timer [after 2000 "set x timed_out"]
@@ -761,10 +798,11 @@
     close $f
     set x
 } {ready done}
 
 test tlsIO-4.1 {server with several clients} {socket stdio} {
+    # have seen intermittent hangs on Windows
     removeFile script
     set f [open script w]
     puts $f {
     	package require tls
 	gets stdin
@@ -804,11 +842,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
@@ -865,26 +903,29 @@
 	close $msg
     }
     set x
 } {couldn't open socket: not owner}
 
-test tlsIO-6.1 {accept callback error} {unexplainedFailure socket stdio pcCrash} {
+test tlsIO-6.1 {accept callback error} {socket stdio} {
+    # There is a debug assertion on Windows/SSL that causes a crash when the
+    # certificate isn't specified.
     removeFile script
     set f [open script w]
     puts $f {
     	package require tls
 	gets stdin
-	tls::socket 127.0.0.1 8848
     }
+    puts $f [list tls::socket -cafile $caCert 127.0.0.1 8848]
     close $f
     set f [open "|[list $::tcltest::tcltest script]" r+]
     proc bgerror args {
 	global x
 	set x $args
     }
     proc accept {s a p} {expr 10 / 0}
-    set s [tls::socket -server accept 8848]
+    set s [tls::socket -server accept \
+	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8848]
     puts $f hello
     close $f
     set timer [after 10000 "set x timed_out"]
     vwait x
     after cancel $timer
@@ -891,19 +932,18 @@
     close $s
     rename bgerror {}
     set x
 } {{divide by zero}}
 
-# bug report #5812 fconfigure doesn't return value for '-peername'
-
-test tlsIO-7.1 {testing socket specific options} {knownBug socket stdio} {
+test tlsIO-7.1 {testing socket specific options} {socket stdio} {
     removeFile script
     set f [open script w]
     puts $f {
 	package require tls
     }
-    puts $f "tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8820"
+    puts $f [list tls::socket -server accept \
+	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8820]
     puts $f {
 	proc accept args {
 	    global x
 	    set x done
 	}
@@ -925,13 +965,11 @@
     lappend l [string compare [lindex $p 0] 127.0.0.1]
     lappend l [string compare [lindex $p 2] 8820]
     lappend l [llength $p]
 } {0 0 3}
 
-# bug report #5812 fconfigure doesn't return value for '-sockname'
-
-test tlsIO-7.2 {testing socket specific options} {knownBug socket stdio} {
+test tlsIO-7.2 {testing socket specific options} {socket stdio} {
     removeFile script
     set f [open script w]
     puts $f {
 	package require tls
     }
@@ -971,11 +1009,11 @@
     llength $l
 } 12
 
 # bug report #5812 fconfigure doesn't return value for '-sockname'
 
-test tlsIO-7.4 {testing socket specific options} {knownBug socket} {
+test tlsIO-7.4 {testing socket specific options} {socket} {
     set s [tls::socket \
 	-certfile $serverCert -cafile $caCert -keyfile $serverKey \
     	-server accept 8823]
     proc accept {s a p} {
 	global x
@@ -994,68 +1032,67 @@
     lappend l [lindex $x 2] [llength $x]
 } {8823 3}
 
 # bug report #5812 fconfigure doesn't return value for '-sockname'
 
-test tlsIO-7.5 {testing socket specific options} {knownBug socket unixOrPc} {
+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 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.
+test tlsIO-8.1 {testing -async flag on sockets} {socket} {
+    # HOBBS: still fails post-rewrite
+    # 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} {
-    # 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
@@ -1070,19 +1107,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
@@ -1089,64 +1130,69 @@
     close $s
     list $spurious $len
 } {0 50}
 
 test tlsIO-9.2 {testing async write, fileevents, flush on close} {socket} {
-    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
-    set count
-} 65566
+    close $s
+    list $count $done
+} {65566 1}
 
-test tlsIO-9.3 {testing EOF stickyness} {unexplainedHang socket} {
-    # 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
@@ -1169,22 +1215,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}
 
@@ -1191,38 +1238,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 \
@@ -1232,26 +1268,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
 	}
@@ -1267,10 +1296,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]}]} {
@@ -1281,23 +1311,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
@@ -1321,21 +1342,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
 	}
@@ -1385,19 +1399,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]
@@ -1433,43 +1444,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
@@ -1480,31 +1488,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
     }
@@ -1514,21 +1516,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 \
@@ -1540,27 +1536,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"
 	    }
@@ -1585,19 +1584,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]
@@ -1613,29 +1618,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
@@ -1650,33 +1649,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 {}
@@ -1693,12 +1680,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
@@ -1705,14 +1692,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]
@@ -1725,33 +1711,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.
 
@@ -1762,19 +1743,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]
@@ -1787,15 +1765,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
@@ -1804,23 +1781,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} {
@@ -1848,79 +1824,78 @@
     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
+	{socket exec unixOnly} {
+    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} {
@@ -1935,19 +1910,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
@@ -2006,6 +1978,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 2000/06/06 01:34:11 welch Exp $
+ * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.7 2000/07/27 01:58:18 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
@@ -217,30 +219,32 @@
  *-------------------------------------------------------------------
  */
 static int
 VerifyCallback(int ok, X509_STORE_CTX *ctx)
 {
-    SSL *ssl = (SSL*)X509_STORE_CTX_get_app_data(ctx);
-    X509 *cert = X509_STORE_CTX_get_current_cert(ctx);
-    State *statePtr = (State*)SSL_get_app_data(ssl);
     Tcl_Obj *cmdPtr;
-    int depth = X509_STORE_CTX_get_error_depth(ctx);
-    int err = X509_STORE_CTX_get_error(ctx);
     char *errStr;
+    SSL   *ssl		= (SSL*)X509_STORE_CTX_get_app_data(ctx);
+    X509  *cert		= X509_STORE_CTX_get_current_cert(ctx);
+    State *statePtr	= (State*)SSL_get_app_data(ssl);
+    int depth		= X509_STORE_CTX_get_error_depth(ctx);
+    int err		= X509_STORE_CTX_get_error(ctx);
 
     dprintf(stderr, "Verify: %d\n", ok);
 
-    if (!ok)
+    if (!ok) {
 	errStr = (char*)X509_verify_cert_error_string(err);
-    else
+    } else {
 	errStr = (char *)0;
+    }
 
     if (statePtr->callback == (Tcl_Obj*)NULL) {
-	if (statePtr->vflags & SSL_VERIFY_FAIL_IF_NO_PEER_CERT)
+	if (statePtr->vflags & SSL_VERIFY_FAIL_IF_NO_PEER_CERT) {
 	    return ok;
-	else
+	} else {
 	    return 1;
+	}
     }
     cmdPtr = Tcl_DuplicateObj(statePtr->callback);
 
     Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, 
 	    Tcl_NewStringObj( "verify", -1));
@@ -303,11 +307,11 @@
 Tls_Error(State *statePtr, char *msg)
 {
     Tcl_Obj *cmdPtr;
 
     if (msg && *msg) {
-	Tcl_SetErrorCode( statePtr->interp, "SSL", msg, (char *)NULL);
+	Tcl_SetErrorCode(statePtr->interp, "SSL", msg, (char *)NULL);
     } else {
 	msg = Tcl_GetStringFromObj(Tcl_GetObjResult(statePtr->interp), NULL);
     }
     statePtr->err = msg;
 
@@ -319,30 +323,30 @@
 	Tcl_BackgroundError( statePtr->interp);
 	return;
     }
     cmdPtr = Tcl_DuplicateObj(statePtr->callback);
 
-    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, 
-	    Tcl_NewStringObj( "error", -1));
-
-    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, 
-	    Tcl_NewStringObj( Tcl_GetChannelName(statePtr->self), -1) );
-
-    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
-	    Tcl_NewStringObj( msg, -1) );
-
-    Tcl_Preserve( (ClientData) statePtr->interp);
-    Tcl_Preserve( (ClientData) statePtr);
-
-    Tcl_IncrRefCount( cmdPtr);
+    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, 
+	    Tcl_NewStringObj("error", -1));
+
+    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, 
+	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
+
+    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
+	    Tcl_NewStringObj(msg, -1));
+
+    Tcl_Preserve((ClientData) statePtr->interp);
+    Tcl_Preserve((ClientData) statePtr);
+
+    Tcl_IncrRefCount(cmdPtr);
     if (Tcl_GlobalEvalObj(statePtr->interp, cmdPtr) != TCL_OK) {
-	Tcl_BackgroundError( statePtr->interp);
+	Tcl_BackgroundError(statePtr->interp);
     }
-    Tcl_DecrRefCount( cmdPtr);
+    Tcl_DecrRefCount(cmdPtr);
 
-    Tcl_Release( (ClientData) statePtr);
-    Tcl_Release( (ClientData) statePtr->interp);
+    Tcl_Release((ClientData) statePtr);
+    Tcl_Release((ClientData) statePtr->interp);
 }
 
 /*
  *-------------------------------------------------------------------
  *
@@ -455,18 +459,16 @@
 #else
 		ctx = SSL_CTX_new(TLSv1_method()); break;
 #endif
     }
     if (ctx == NULL) {
-	Tcl_AppendResult(interp, REASON(),
-	    (char *) NULL);
+	Tcl_AppendResult(interp, REASON(), (char *) NULL);
 	return TCL_ERROR;
     }
     ssl = SSL_new(ctx);
     if (ssl == NULL) {
-	Tcl_AppendResult(interp, REASON(),
-	    (char *) NULL);
+	Tcl_AppendResult(interp, REASON(), (char *) NULL);
 	SSL_CTX_free(ctx);
 	return TCL_ERROR;
     }
     objPtr = Tcl_NewListObj( 0, NULL);
 
@@ -538,32 +540,41 @@
 
     chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
     if (chan == (Tcl_Channel) NULL) {
         return TCL_ERROR;
     }
+#ifdef TCL_CHANNEL_VERSION_2
+    /*
+     * Make sure to operate on the topmost channel
+     */
+    chan = Tcl_GetTopChannel(chan);
+#endif
     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;
 }
 
 /*
@@ -590,23 +601,22 @@
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
 {
     Tcl_Channel chan;		/* The channel to set a mode on. */
-    BIO *bio;
     State *statePtr;		/* client state for ssl socket */
-    SSL_CTX *ctx = NULL;
-    Tcl_Obj *script = NULL;
+    SSL_CTX *ctx	= NULL;
+    Tcl_Obj *script	= NULL;
     int idx;
-    int flags = TLS_TCL_INIT;
-    int server = 0;		/* is connection incoming or outgoing? */
-    char *key = NULL;
-    char *cert = NULL;
-    char *ciphers = NULL;
-    char *CAfile = NULL;
-    char *CAdir = NULL;
-    char *model = NULL;
+    int flags		= TLS_TCL_INIT;
+    int server		= 0;	/* is connection incoming or outgoing? */
+    char *key		= NULL;
+    char *cert		= NULL;
+    char *ciphers	= NULL;
+    char *CAfile	= NULL;
+    char *CAdir		= NULL;
+    char *model		= NULL;
 #if defined(NO_SSL2)
     int ssl2 = 0;
 #else
     int ssl2 = 1;
 #endif
@@ -630,10 +640,16 @@
 
     chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
     if (chan == (Tcl_Channel) NULL) {
         return TCL_ERROR;
     }
+#ifdef TCL_CHANNEL_VERSION_2
+    /*
+     * Make sure to operate on the topmost channel
+     */
+    chan = Tcl_GetTopChannel(chan);
+#endif
 
     for (idx = 2; idx < objc; idx++) {
 	char *opt = Tcl_GetStringFromObj(objv[idx], NULL);
 
 	if (opt[0] != '-')
@@ -656,78 +672,97 @@
 
 	OPTBAD( "option", "-cafile, -cadir, -certfile, -cipher, -command, -keyfile, -model, -require, -request, -ssl2, -ssl3, -server, or -tls1");
 
 	return TCL_ERROR;
     }
-    if (request) verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER;
+    if (request)            verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER;
     if (request && require) verify |= SSL_VERIFY_FAIL_IF_NO_PEER_CERT;
-    if (verify == 0) verify = SSL_VERIFY_NONE;
+    if (verify == 0)        verify = SSL_VERIFY_NONE;
 
     proto |= (ssl2 ? TLS_PROTO_SSL2 : 0);
     proto |= (ssl3 ? TLS_PROTO_SSL3 : 0);
     proto |= (tls1 ? TLS_PROTO_TLS1 : 0);
 
     /* reset to NULL if blank string provided */
-    if (cert && !*cert) cert = NULL;
-    if (key && !*key) key = NULL;
-    if (ciphers && !*ciphers) ciphers = NULL;
-    if (CAfile && !*CAfile) CAfile = NULL;
-    if (CAdir && !*CAdir) CAdir = NULL;
+    if (cert && !*cert)		cert	= NULL;
+    if (key && !*key)		key	= NULL;
+    if (ciphers && !*ciphers)	ciphers	= NULL;
+    if (CAfile && !*CAfile)	CAfile	= NULL;
+    if (CAdir && !*CAdir)	CAdir	= NULL;
 
     if (model != NULL) {
 	int mode;
 	/* Get the "model" context */
-	chan = Tcl_GetChannel( interp, model, &mode);
-	if (chan == (Tcl_Channel)0) {
+	chan = Tcl_GetChannel(interp, model, &mode);
+	if (chan == (Tcl_Channel) NULL) {
 	    return TCL_ERROR;
 	}
+#ifdef TCL_CHANNEL_VERSION_2
+	/*
+	 * Make sure to operate on the topmost channel
+	 */
+	chan = Tcl_GetTopChannel(chan);
+#endif
 	if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
-	    Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
-		    "\": not a TLS channel", NULL);
+	    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);
 	ctx = statePtr->ctx;
     } else {
-	if ((ctx = CTX_Init( interp, proto, key, cert, CAdir, CAfile, ciphers))
+	if ((ctx = CTX_Init(interp, proto, key, cert, CAdir, CAfile, ciphers))
 	    == (SSL_CTX*)0) {
 	    return TCL_ERROR;
 	}
     }
 
     /* new SSL state */
-    statePtr = (State *) Tcl_Alloc((unsigned) sizeof(State));
-    statePtr->self = (Tcl_Channel)NULL;
-    statePtr->timer = (Tcl_TimerToken)NULL;
-
-    statePtr->flags = flags;
-    statePtr->watchMask = 0;
-    statePtr->mode = 0;
-
-    statePtr->interp = interp;
-    statePtr->callback = (Tcl_Obj *)0;
-
-    statePtr->vflags = verify;
-    statePtr->ssl = (SSL*)0;
-    statePtr->ctx = ctx;
-    statePtr->bio = (BIO*)0;
-    statePtr->p_bio = (BIO*)0;
-
-    statePtr->err = "";
-
+    statePtr		= (State *) Tcl_Alloc((unsigned) sizeof(State));
+    statePtr->self	= (Tcl_Channel)NULL;
+    statePtr->timer	= (Tcl_TimerToken)NULL;
+
+    statePtr->flags	= flags;
+    statePtr->watchMask	= 0;
+    statePtr->mode	= 0;
+
+    statePtr->interp	= interp;
+    statePtr->callback	= (Tcl_Obj *)0;
+
+    statePtr->vflags	= verify;
+    statePtr->ssl	= (SSL*)0;
+    statePtr->ctx	= ctx;
+    statePtr->bio	= (BIO*)0;
+    statePtr->p_bio	= (BIO*)0;
+
+    statePtr->err	= "";
+
+    /*
+     * We need to make sure that the channel works in binary (for the
+     * encryption not to get goofed up).
+     * We only want to adjust the buffering in pre-v2 channels, where
+     * each channel in the stack maintained its own buffers.
+     */
     Tcl_SetChannelOption(interp, chan, "-translation", "binary");
+#ifndef TCL_CHANNEL_VERSION_2
     Tcl_SetChannelOption(interp, chan, "-buffering", "none");
+#endif
 
 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 2
     statePtr->parent = chan;
-    statePtr->self = Tcl_ReplaceChannel( interp,
-				Tls_ChannelType(), (ClientData) statePtr,
-			       (TCL_READABLE | TCL_WRITABLE), statePtr->parent);
+    statePtr->self = Tcl_ReplaceChannel(interp,
+	    Tls_ChannelType(), (ClientData) statePtr,
+	    (TCL_READABLE | TCL_WRITABLE), statePtr->parent);
+#else
+#ifdef TCL_CHANNEL_VERSION_2
+    statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(),
+	    (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE), chan);
 #else
     statePtr->self = chan;
     Tcl_StackChannel( interp, Tls_ChannelType(), (ClientData) statePtr,
-			       (TCL_READABLE | TCL_WRITABLE), chan);
+	    (TCL_READABLE | TCL_WRITABLE), chan);
+#endif
 #endif
     if (statePtr->self == (Tcl_Channel) NULL) {
 	/*
 	 * No use of Tcl_EventuallyFree because no possible Tcl_Preserve.
 	 */
@@ -735,14 +770,14 @@
         return TCL_ERROR;
     }
 
     /* allocate script */
     if (script) {
-	char * tmp = Tcl_GetStringFromObj(script, NULL);
+	char *tmp = Tcl_GetStringFromObj(script, NULL);
 	if (tmp && *tmp) {
 	    statePtr->callback = Tcl_DuplicateObj(script);
-	    Tcl_IncrRefCount( statePtr->callback);
+	    Tcl_IncrRefCount(statePtr->callback);
 	}
     }
     /* This is only needed because of a bug in OpenSSL, where the
      * ssl->verify_callback is not referenced!!! (Must be done
      * *before* SSL_new() is called!
@@ -754,13 +789,12 @@
      */
 
     statePtr->ssl = SSL_new(statePtr->ctx);
     if (!statePtr->ssl) {
         /* SSL library error */
-        Tcl_AppendResult(interp,
-                         "couldn't construct ssl session: ", REASON(),
-                         (char *) NULL);
+        Tcl_AppendResult(interp, "couldn't construct ssl session: ", REASON(),
+		(char *) NULL);
 	Tls_Free((char *) statePtr);
         return TCL_ERROR;
     }
 
     /*
@@ -773,23 +807,23 @@
      * The following is broken - we need is to set the
      * verify_mode, but the library ignores the verify_callback!!!
      */
     /*SSL_set_verify(statePtr->ssl, verify, VerifyCallback);*/
 
-    SSL_CTX_set_info_callback( statePtr->ctx, InfoCallback);
+    SSL_CTX_set_info_callback(statePtr->ctx, InfoCallback);
 
     /* Create Tcl_Channel BIO Handler */
-    statePtr->p_bio = bio = BIO_new_tcl( statePtr, BIO_CLOSE);
-    statePtr->bio = BIO_new(BIO_f_ssl());
+    statePtr->p_bio	= BIO_new_tcl(statePtr, BIO_CLOSE);
+    statePtr->bio	= BIO_new(BIO_f_ssl());
 
     if (server) {
 	statePtr->flags |= TLS_TCL_SERVER;
 	SSL_set_accept_state(statePtr->ssl);
     } else {
 	SSL_set_connect_state(statePtr->ssl);
     }
-    SSL_set_bio(statePtr->ssl, bio, bio);
+    SSL_set_bio(statePtr->ssl, statePtr->p_bio, statePtr->p_bio);
     BIO_set_ssl(statePtr->bio, statePtr->ssl, BIO_CLOSE);
 
     /*
      * End of SSL Init
      */
@@ -939,11 +973,11 @@
 #if 0
 	Tcl_DStringFree(&ds);
 	Tcl_DStringFree(&ds1);
 	/* Don't currently care if this fails */
 	Tcl_AppendResult(interp, "SSL default verify paths: ",
-                             REASON(), (char *) NULL);
+		REASON(), (char *) NULL);
 	SSL_CTX_free(ctx);
 	return (SSL_CTX *)0;
 #endif
     }
     SSL_CTX_set_client_CA_list(ctx, SSL_load_client_CA_file( F2N(CAfile, &ds) ));
@@ -984,32 +1018,39 @@
         Tcl_WrongNumArgs(interp, 1, objv, "channel");
         return TCL_ERROR;
     }
     channelName = Tcl_GetStringFromObj(objv[1], NULL);
 
-    chan = Tcl_GetChannel( interp, channelName, &mode);
-    if (chan == (Tcl_Channel)0) {
+    chan = Tcl_GetChannel(interp, channelName, &mode);
+    if (chan == (Tcl_Channel) NULL) {
 	return TCL_ERROR;
     }
+#ifdef TCL_CHANNEL_VERSION_2
+    /*
+     * Make sure to operate on the topmost channel
+     */
+    chan = Tcl_GetTopChannel(chan);
+#endif
     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);
-    peer = SSL_get_peer_certificate(statePtr->ssl);
-    if (peer)
-	objPtr = Tls_NewX509Obj( interp, peer);
-    else
-	objPtr = Tcl_NewListObj( 0, NULL);
+    statePtr	= (State *) Tcl_GetChannelInstanceData(chan);
+    peer	= SSL_get_peer_certificate(statePtr->ssl);
+    if (peer) {
+	objPtr = Tls_NewX509Obj(interp, peer);
+    } else {
+	objPtr = Tcl_NewListObj(0, NULL);
+    }
 
     ciphers = (char*)SSL_get_cipher(statePtr->ssl);
     if (ciphers != NULL && strcmp(ciphers, "(NONE)")!=0) {
-	Tcl_ListObjAppendElement( interp, objPtr,
-		Tcl_NewStringObj( "cipher", -1) );
-	Tcl_ListObjAppendElement( interp, objPtr,
-		Tcl_NewStringObj( SSL_get_cipher(statePtr->ssl), -1) );
+	Tcl_ListObjAppendElement(interp, objPtr,
+		Tcl_NewStringObj("cipher", -1));
+	Tcl_ListObjAppendElement(interp, objPtr,
+		Tcl_NewStringObj(SSL_get_cipher(statePtr->ssl), -1));
     }
     Tcl_SetObjResult( interp, objPtr);
     return TCL_OK;
 }
 
@@ -1057,25 +1098,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;
-    }
 }
 
 /*
  *-------------------------------------------------------------------
  *
@@ -1099,29 +1143,31 @@
 #if TCL_MAJOR_VERSION >= 8 && TCL_MINOR_VERSION >= 2
     if (!Tcl_InitStubs(interp, TCL_VERSION, 0)) {
         return TCL_ERROR;
     }
 #endif
+    if (SSL_library_init() != 1) {
+        Tcl_AppendResult(interp, "could not initialize SSL library", NULL);
+	return TCL_ERROR;
+    }
     SSL_load_error_strings();
     ERR_load_crypto_strings();
-    SSL_library_init();
-
-    Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd , (ClientData) 0,
-                      (Tcl_CmdDeleteProc *) NULL);
-
-    Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd , (ClientData) 0,
-                      (Tcl_CmdDeleteProc *) NULL);
-
-    Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd , (ClientData) 0,
-                      (Tcl_CmdDeleteProc *) NULL);
-
-    Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd , (ClientData) 0,
-                      (Tcl_CmdDeleteProc *) NULL);
+
+    Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd,
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+
+    Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd,
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+
+    Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd,
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+
+    Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd,
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
 
     return Tcl_PkgProvide(interp, PACKAGE, VERSION);
 }
-
 
 /*
  *------------------------------------------------------*
  *
  *	Tls_SafeInit --

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.3 2000/07/27 01:58:18 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 2000/01/20 01:51:39 aborr Exp $
+ * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsBIO.c,v 1.3 2000/07/27 01:58:18 hobbs Exp $
  *
  * Provides BIO layer to interface openssl to Tcl.
  */
 
 #include "tlsInt.h"
@@ -36,14 +36,14 @@
     State *statePtr;
     int flags;
 {
     BIO *bio;
 
-    bio = BIO_new(&BioMethods);
-    bio->ptr = (char*)statePtr;
-    bio->init = 1;
-    bio->shutdown = flags;
+    bio			= BIO_new(&BioMethods);
+    bio->ptr		= (char*)statePtr;
+    bio->init		= 1;
+    bio->shutdown	= flags;
 
     return bio;
 }
 
 BIO_METHOD *
@@ -56,30 +56,35 @@
 BioWrite (bio, buf, bufLen)
     BIO *bio;
     char *buf;
     int bufLen;
 {
-    Tcl_Channel chan = Tls_GetParent((State*)bio->ptr);
+    Tcl_Channel chan = Tls_GetParent((State*)(bio->ptr));
     int ret;
 
     dprintf(stderr,"\nBioWrite(0x%x, <buf>, %d) [0x%x]", bio, bufLen, chan);
 
-    ret = Tcl_Write( chan, buf, bufLen);
+#ifdef TCL_CHANNEL_VERSION_2
+    ret = Tcl_WriteRaw(chan, buf, bufLen);
+#else
+    ret = Tcl_Write(chan, buf, bufLen);
+#endif
 
     dprintf(stderr,"\n[0x%x] BioWrite(%d) -> %d [%d.%d]", chan, bufLen, ret,
-		Tcl_Eof( chan), Tcl_GetErrno());
+	    Tcl_Eof(chan), Tcl_GetErrno());
 
     BIO_clear_flags(bio, BIO_FLAGS_WRITE|BIO_FLAGS_SHOULD_RETRY);
 
     if (ret == 0) {
-	if (!Tcl_Eof( chan)) {
+	if (!Tcl_Eof(chan)) {
 	    BIO_set_retry_write(bio);
 	    ret = -1;
 	}
     }
-    if (BIO_should_read(bio))
+    if (BIO_should_read(bio)) {
 	BIO_set_retry_read(bio);
+    }
     return ret;
 }
 
 static int
 BioRead (bio, buf, bufLen)
@@ -92,34 +97,39 @@
 
     dprintf(stderr,"\nBioRead(0x%x, <buf>, %d) [0x%x]", bio, bufLen, chan);
 
     if (buf == NULL) return 0;
 
-    ret = Tcl_Read( chan, buf, bufLen);
+#ifdef TCL_CHANNEL_VERSION_2
+    ret = Tcl_ReadRaw(chan, buf, bufLen);
+#else
+    ret = Tcl_Read(chan, buf, bufLen);
+#endif
 
     dprintf(stderr,"\n[0x%x] BioRead(%d) -> %d [%d.%d]", chan, bufLen, ret,
-	Tcl_Eof(chan), Tcl_GetErrno());
+	    Tcl_Eof(chan), Tcl_GetErrno());
 
     BIO_clear_flags(bio, BIO_FLAGS_READ|BIO_FLAGS_SHOULD_RETRY);
 
     if (ret == 0) {
-	if (!Tcl_Eof( chan)) {
+	if (!Tcl_Eof(chan)) {
 	    BIO_set_retry_read(bio);
 	    ret = -1;
 	}
     }
-    if (BIO_should_write(bio))
+    if (BIO_should_write(bio)) {
 	BIO_set_retry_write(bio);
+    }
     return ret;
 }
 
 static int
 BioPuts	(bio, str)
     BIO *bio;
     char *str;
 {
-    return BioWrite( bio, str, strlen(str));
+    return BioWrite(bio, str, strlen(str));
 }
 
 static long
 BioCtrl	(bio, cmd, num, ptr)
     BIO *bio;
@@ -144,84 +154,91 @@
 	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);
+	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");
-	if (Tcl_Flush( chan) == TCL_OK)
-	    ret=1;
-	else
-	    ret=-1;
+	if (
+#ifdef TCL_CHANNEL_VERSION_2
+	    Tcl_WriteRaw(chan, "", 0) >= 0
+#else
+	    Tcl_Flush(chan) == TCL_OK
+#endif
+	    ) {
+	    ret = 1;
+	} else {
+	    ret = -1;
+	}
 	break;
     default:
-	ret=0;
+	ret = 0;
 	break;
     }
     return(ret);
 }
 
 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 2000/06/05 18:09:54 welch Exp $
+ * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsIO.c,v 1.8 2000/07/27 01:58:18 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
@@ -30,51 +30,75 @@
 
 /*
  * Forward declarations
  */
 
-static int	BlockModeProc _ANSI_ARGS_((ClientData instanceData, int mode));
-static int	CloseProc _ANSI_ARGS_ ((ClientData instanceData, Tcl_Interp *interp));
-static int	InputProc _ANSI_ARGS_((ClientData instanceData,
-			    char *buf, int bufSize, int *errorCodePtr));
-static int	OutputProc _ANSI_ARGS_((ClientData instanceData,
-			    char *buf, int toWrite, int *errorCodePtr));
-static int	GetOptionProc _ANSI_ARGS_ ((ClientData instanceData,
-			    Tcl_Interp *interp, char *optionName, Tcl_DString *dsPtr));
-static void	WatchProc _ANSI_ARGS_((ClientData instanceData, int mask));
-static int	GetHandleProc _ANSI_ARGS_ ((ClientData instanceData,
-			    int direction, ClientData *handlePtr));
-static void	ChannelHandler _ANSI_ARGS_ ((ClientData clientData, int mask));
-static void	ChannelHandlerTimer _ANSI_ARGS_ ((ClientData clientData));
+static int	TlsBlockModeProc _ANSI_ARGS_((ClientData instanceData,
+			int mode));
+static int	TlsCloseProc _ANSI_ARGS_ ((ClientData instanceData,
+			Tcl_Interp *interp));
+static int	TlsInputProc _ANSI_ARGS_((ClientData instanceData,
+			char *buf, int bufSize, int *errorCodePtr));
+static int	TlsOutputProc _ANSI_ARGS_((ClientData instanceData,
+			char *buf, int toWrite, int *errorCodePtr));
+static int	TlsGetOptionProc _ANSI_ARGS_ ((ClientData instanceData,
+			Tcl_Interp *interp, char *optionName,
+			Tcl_DString *dsPtr));
+static void	TlsWatchProc _ANSI_ARGS_((ClientData instanceData, int mask));
+static int	TlsGetHandleProc _ANSI_ARGS_ ((ClientData instanceData,
+			int direction, ClientData *handlePtr));
+static int	TlsNotifyProc _ANSI_ARGS_ ((ClientData instanceData,
+			int mask));
+static void	TlsChannelHandler _ANSI_ARGS_ ((ClientData clientData,
+			int mask));
+static void	TlsChannelHandlerTimer _ANSI_ARGS_ ((ClientData clientData));
 
 /*
  * This structure describes the channel type structure for TCP socket
  * based IO:
  */
-
+#ifdef TCL_CHANNEL_VERSION_2
+static Tcl_ChannelType tlsChannelType = {
+    "tls",		/* Type name. */
+    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. */
+    TlsGetHandleProc,	/* Get file handle out of channel. */
+    NULL,		/* Close2Proc. */
+    TlsBlockModeProc,	/* Set blocking/nonblocking mode.*/
+    NULL,		/* FlushProc. */
+    TlsNotifyProc,	/* handlerProc. */
+};
+#else
 static Tcl_ChannelType tlsChannelType = {
     "tls",		/* Type name. */
-    BlockModeProc,	/* Set blocking/nonblocking mode.*/
-    CloseProc,		/* Close proc. */
-    InputProc,		/* Input proc. */
-    OutputProc,		/* Output proc. */
+    TlsBlockModeProc,	/* Set blocking/nonblocking mode.*/
+    TlsCloseProc,	/* Close proc. */
+    TlsInputProc,	/* Input proc. */
+    TlsOutputProc,	/* Output proc. */
     NULL,		/* Seek proc. */
     NULL,		/* Set option proc. */
-    GetOptionProc,	/* Get option proc. */
-    WatchProc,		/* Initialize notifier. */
-    GetHandleProc,	/* Get file handle out of channel. */
+    TlsGetOptionProc,	/* Get option proc. */
+    TlsWatchProc,	/* Initialize notifier. */
+    TlsGetHandleProc,	/* Get file handle out of channel. */
 };
+#endif
 
 Tcl_ChannelType *Tls_ChannelType()
 {
     return &tlsChannelType;
 }
 
 /*
  *-------------------------------------------------------------------
  *
- * BlockModeProc --
+ * TlsBlockModeProc --
  *
  *	This procedure is invoked by the generic IO level
  *       to set blocking and nonblocking modes
  * Results:
  *	0 if successful, errno when failed.
@@ -84,11 +108,11 @@
  *
  *-------------------------------------------------------------------
  */
 
 static int
-BlockModeProc(ClientData instanceData,	/* Socket state. */
+TlsBlockModeProc(ClientData instanceData,	/* Socket state. */
                  int mode)			/* The mode to set. Can be one of
 						* TCL_MODE_BLOCKING or
 						* TCL_MODE_NONBLOCKING. */
 {
     State *statePtr = (State *) instanceData;
@@ -96,18 +120,22 @@
     if (mode == TCL_MODE_NONBLOCKING) {
 	statePtr->flags |= TLS_TCL_ASYNC;
     } else {
 	statePtr->flags &= ~(TLS_TCL_ASYNC);
     }
+#ifdef TCL_CHANNEL_VERSION_2
+    return 0;
+#else
     return Tcl_SetChannelOption(statePtr->interp, Tls_GetParent(statePtr),
 		"-blocking", (mode == TCL_MODE_NONBLOCKING) ? "0" : "1");
+#endif
 }
 
 /*
  *-------------------------------------------------------------------
  *
- * CloseProc --
+ * TlsCloseProc --
  *
  *	This procedure is invoked by the generic IO level to perform
  *	channel-type-specific cleanup when a SSL socket based channel
  *	is closed.
  *
@@ -120,39 +148,36 @@
  *	Closes the socket of the channel.
  *
  *-------------------------------------------------------------------
  */
 static int
-CloseProc(ClientData instanceData,	/* The socket to close. */
+TlsCloseProc(ClientData instanceData,	/* The socket to close. */
              Tcl_Interp *interp)	/* For error reporting - unused. */
 {
     State *statePtr = (State *) instanceData;
 
-    dprintf(stderr,"\nCloseProc(0x%x)", statePtr);
+    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".
      */
 
     Tcl_DeleteChannelHandler(Tls_GetParent(statePtr),
-	ChannelHandler, (ClientData) statePtr);
-
-    if (statePtr->timer != (Tcl_TimerToken)NULL) {
-	Tcl_DeleteTimerHandler (statePtr->timer);
-	statePtr->timer = (Tcl_TimerToken)NULL;
-    }
+	TlsChannelHandler, (ClientData) statePtr);
+#endif
 
     Tls_Clean(statePtr);
-    Tcl_EventuallyFree( (ClientData)statePtr, Tls_Free);
+    Tcl_EventuallyFree((ClientData)statePtr, Tls_Free);
     return TCL_OK;
 }
 
 /*
  *-------------------------------------------------------------------
  *
- * InputProc --
+ * TlsInputProc --
  *
  *	This procedure is invoked by the generic IO level
  *       to read input from a SSL socket based channel.
  *
  * Results:
@@ -165,15 +190,15 @@
  *
  *-------------------------------------------------------------------
  */
 
 static int
-InputProc(ClientData instanceData,	/* Socket state. */
-             char *buf,			/* Where to store data read. */
-             int bufSize,		/* How much space is available
-                                         * in the buffer? */
-             int *errorCodePtr)		/* Where to store error code. */
+TlsInputProc(ClientData instanceData,	/* Socket state. */
+	char *buf,			/* Where to store data read. */
+	int bufSize,			/* How much space is available
+					 * in the buffer? */
+	int *errorCodePtr)		/* Where to store error code. */
 {
     State *statePtr = (State *) instanceData;
     int bytesRead;			/* How many bytes were read? */
 
     *errorCodePtr = 0;
@@ -187,43 +212,52 @@
 	}
     }
     if (statePtr->flags & TLS_TCL_INIT) {
 	statePtr->flags &= ~(TLS_TCL_INIT);
     }
+    /*
+     * We need to clear the SSL error stack now because we sometimes reach
+     * this function with leftover errors in the stack.  If BIO_read
+     * returns -1 and intends EAGAIN, there is a leftover error, it will be
+     * misconstrued as an error, not EAGAIN.
+     *
+     * Alternatively, we may want to handle the <0 return codes from
+     * BIO_read specially (as advised in the RSA docs).  TLS's lower level BIO
+     * functions play with the retry flags though, and this seems to work
+     * correctly.  Similar fix in TlsOutputProc. - hobbs
+     */
+    ERR_clear_error();
     bytesRead = BIO_read(statePtr->bio, buf, bufSize);
     dprintf(stderr,"\nBIO_read -> %d", bytesRead);
 
     if (bytesRead < 0) {
 	int err = SSL_get_error(statePtr->ssl, bytesRead);
 
 	if (err == SSL_ERROR_SSL) {
 	    Tls_Error(statePtr, SSL_ERROR(statePtr->ssl, bytesRead));
 	    *errorCodePtr = ECONNABORTED;
-	    goto input;
 	} else if (BIO_should_retry(statePtr->bio)) {
 	    dprintf(stderr,"RE! ");
 	    *errorCodePtr = EAGAIN;
-	    goto input;
-	}
-	if (Tcl_GetErrno() == ECONNRESET) {
-	    /* Soft EOF */
-	    bytesRead = 0;
-	    goto input;
 	} else {
 	    *errorCodePtr = Tcl_GetErrno();
-	    goto input;
+	    if (*errorCodePtr == ECONNRESET) {
+		/* Soft EOF */
+		*errorCodePtr = 0;
+		bytesRead = 0;
+	    }
 	}
     }
-input:
+    input:
     dprintf(stderr, "\nInput(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr);
     return bytesRead;
 }
 
 /*
  *-------------------------------------------------------------------
  *
- * OutputProc --
+ * TlsOutputProc --
  *
  *	This procedure is invoked by the generic IO level
  *       to write output to a SSL socket based channel.
  *
  * Results:
@@ -235,21 +269,21 @@
  *
  *-------------------------------------------------------------------
  */
 
 static int
-OutputProc(ClientData instanceData,	/* Socket state. */
-              char *buf,			/* The data buffer. */
+TlsOutputProc(ClientData instanceData,	/* Socket state. */
+              char *buf,		/* The data buffer. */
               int toWrite,		/* How many bytes to write? */
               int *errorCodePtr)	/* Where to store error code. */
 {
     State *statePtr = (State *) instanceData;
     int written, err;
 
     *errorCodePtr = 0;
 
-    dprintf(stderr,"\nBIO_write(%d)", toWrite);
+    dprintf(stderr,"\nBIO_write(0x%x, %d)", statePtr, toWrite);
 
     if (!SSL_is_init_finished(statePtr->ssl)) {
 	written = Tls_WaitForConnect(statePtr, errorCodePtr);
 	if (written <= 0) {
 	    goto output;
@@ -262,57 +296,71 @@
 	dprintf(stderr, "zero-write\n");
 	BIO_flush(statePtr->bio);
 	written = 0;
 	goto output;
     } else {
+	/*
+	 * We need to clear the SSL error stack now because we sometimes reach
+	 * this function with leftover errors in the stack.  If BIO_write
+	 * returns -1 and intends EAGAIN, there is a leftover error, it will be
+	 * misconstrued as an error, not EAGAIN.
+	 *
+	 * Alternatively, we may want to handle the <0 return codes from
+	 * BIO_write specially (as advised in the RSA docs).  TLS's lower level
+	 * BIO functions play with the retry flags though, and this seems to
+	 * work correctly.  Similar fix in TlsInputProc. - hobbs
+	 */
+	ERR_clear_error();
 	written = BIO_write(statePtr->bio, buf, toWrite);
-	dprintf(stderr,"\nBIO_write(%d) -> [%d]", toWrite, written);
+	dprintf(stderr,"\nBIO_write(0x%x, %d) -> [%d]",
+		statePtr, toWrite, written);
     }
-    if (written < 0 || written == 0) {
+    if (written <= 0) {
 	switch ((err = SSL_get_error(statePtr->ssl, written))) {
-	case SSL_ERROR_NONE:
-	    if (written <= 0) {
-		written = 0;
-		goto output;
-	    }
-	    break;
-	case SSL_ERROR_WANT_WRITE:
-	    dprintf(stderr,"write W BLOCK\n");
-	    break;
-	case SSL_ERROR_WANT_READ:
-	    dprintf(stderr,"write R BLOCK\n");
-	    break;
-	case SSL_ERROR_WANT_X509_LOOKUP:
-	    dprintf(stderr,"write X BLOCK\n");
-	    break;
-	case SSL_ERROR_ZERO_RETURN:
-	    dprintf(stderr,"closed\n");
-	    written = 0;
-	    goto output;
-	case SSL_ERROR_SYSCALL:
-	    *errorCodePtr = Tcl_GetErrno();
-	    dprintf(stderr,"[%d] syscall errr: %d\n", written, Tcl_GetErrno());
-	    written = -1;
-	    goto output;
-	case SSL_ERROR_SSL:
-	    Tls_Error(statePtr, SSL_ERROR(statePtr->ssl, written));
-	    *errorCodePtr = ECONNABORTED;
-	    written = -1;
-	    goto output;
-	default:
-	    dprintf(stderr,"unknown err: %d\n", err);
-	}
-    }
-output:
+	    case SSL_ERROR_NONE:
+		if (written < 0) {
+		    written = 0;
+		}
+		break;
+	    case SSL_ERROR_WANT_WRITE:
+		dprintf(stderr," write W BLOCK");
+		break;
+	    case SSL_ERROR_WANT_READ:
+		dprintf(stderr," write R BLOCK");
+		break;
+	    case SSL_ERROR_WANT_X509_LOOKUP:
+		dprintf(stderr," write X BLOCK");
+		break;
+	    case SSL_ERROR_ZERO_RETURN:
+		dprintf(stderr," closed\n");
+		written = 0;
+		break;
+	    case SSL_ERROR_SYSCALL:
+		*errorCodePtr = Tcl_GetErrno();
+		dprintf(stderr," [%d] syscall errr: %d",
+			written, *errorCodePtr);
+		written = -1;
+		break;
+	    case SSL_ERROR_SSL:
+		Tls_Error(statePtr, SSL_ERROR(statePtr->ssl, written));
+		*errorCodePtr = ECONNABORTED;
+		written = -1;
+		break;
+	    default:
+		dprintf(stderr," unknown err: %d\n", err);
+		break;
+	}
+    }
+    output:
     dprintf(stderr, "\nOutput(%d) -> %d", toWrite, written);
     return written;
 }
 
 /*
  *-------------------------------------------------------------------
  *
- * GetOptionProc --
+ * TlsGetOptionProc --
  *
  *	Computes an option value for a SSL socket based channel, or a
  *	list of all options and their values.
  *
  *	Note: This code is based on code contributed by John Haxby.
@@ -326,19 +374,39 @@
  *	None.
  *
  *-------------------------------------------------------------------
  */
 static int
-GetOptionProc(ClientData instanceData,	/* Socket state. */
+TlsGetOptionProc(ClientData instanceData,	/* Socket state. */
                  Tcl_Interp *interp,		/* For errors - can be NULL. */
                  char *optionName,		/* Name of the option to
                                                  * retrieve the value for, or
                                                  * NULL to get all options and
                                                  * their values. */
                  Tcl_DString *dsPtr)	         /* Where to store the computed value
                                                   * initialized by caller. */
 {
+#ifdef TCL_CHANNEL_VERSION_2
+    State *statePtr = (State *) instanceData;
+    Tcl_Channel downChan = Tls_GetParent(statePtr);
+    Tcl_DriverGetOptionProc *getOptionProc;
+
+    getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan));
+    if (getOptionProc != NULL) {
+	return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan),
+		interp, optionName, dsPtr);
+    } else if (optionName == (char*) NULL) {
+	/*
+	 * Request is query for all options, this is ok.
+	 */
+	return TCL_OK;
+    }
+    /*
+     * Request for a specific option has to fail, we don't have any.
+     */
+    return TCL_ERROR;
+#else
     State *statePtr = (State *) instanceData;
     size_t len = 0;
 
     if (optionName != (char *) NULL) {
         len = strlen(optionName);
@@ -355,16 +423,17 @@
             return TCL_OK;
         }
     }
 #endif
     return TCL_OK;
+#endif
 }
 
 /*
  *-------------------------------------------------------------------
  *
- * WatchProc --
+ * TlsWatchProc --
  *
  *	Initialize the notifier to watch Tcl_Files from this channel.
  *
  * Results:
  *	None.
@@ -375,17 +444,52 @@
  *
  *-------------------------------------------------------------------
  */
 
 static void
-WatchProc(ClientData instanceData,	/* The socket state. */
+TlsWatchProc(ClientData instanceData,	/* The socket state. */
              int mask)			/* Events of interest; an OR-ed
                                          * combination of TCL_READABLE,
                                          * TCL_WRITABLE and TCL_EXCEPTION. */
 {
     State *statePtr = (State *) instanceData;
 
+#ifdef TCL_CHANNEL_VERSION_2
+    Tcl_Channel     downChan;
+
+    statePtr->watchMask = mask;
+
+    /* No channel handlers any more. We will be notified automatically
+     * about events on the channel below via a call to our
+     * 'TransformNotifyProc'. But we have to pass the interest down now.
+     * We are allowed to add additional 'interest' to the mask if we want
+     * to. But this transformation has no such interest. It just passes
+     * the request down, unchanged.
+     */
+
+    downChan = Tls_GetParent(statePtr);
+
+    (Tcl_GetChannelType(downChan))
+	->watchProc(Tcl_GetChannelInstanceData(downChan), mask);
+
+    /*
+     * Management of the internal timer.
+     */
+
+    if (statePtr->timer != (Tcl_TimerToken) NULL) {
+        Tcl_DeleteTimerHandler(statePtr->timer);
+	statePtr->timer = (Tcl_TimerToken) NULL;
+    }
+    if ((mask & TCL_READABLE) && Tcl_InputBuffered(statePtr->self) > 0) {
+        /*
+	 * There is interest in readable events and we actually have
+	 * data waiting, so generate a timer to flush that.
+	 */
+	statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY,
+		TlsChannelHandlerTimer, (ClientData) statePtr);
+    }
+#else
     if (mask == statePtr->watchMask)
 	return;
 
     if (statePtr->watchMask) {
 	/*
@@ -392,27 +496,28 @@
 	 * Remove event handler to underlying channel, this could
 	 * be because we are closing for real, or being "unstacked".
 	 */
 
 	Tcl_DeleteChannelHandler(Tls_GetParent(statePtr),
-		ChannelHandler, (ClientData) statePtr);
+		TlsChannelHandler, (ClientData) statePtr);
     }
     statePtr->watchMask = mask;
     if (statePtr->watchMask) {
 	/*
 	 * Setup active monitor for events on underlying Channel.
 	 */
 
 	Tcl_CreateChannelHandler(Tls_GetParent(statePtr),
-		statePtr->watchMask, ChannelHandler, (ClientData) statePtr);
+		statePtr->watchMask, TlsChannelHandler, (ClientData) statePtr);
     }
+#endif
 }
 
 /*
  *-------------------------------------------------------------------
  *
- * GetHandleProc --
+ * TlsGetHandleProc --
  *
  *	Called from Tcl_GetChannelFile to retrieve o/s file handler
  *	from the SSL socket based channel.
  *
  * Results:
@@ -422,23 +527,70 @@
  *	None.
  *
  *-------------------------------------------------------------------
  */
 static int
-GetHandleProc(ClientData instanceData,	/* The socket state. */
+TlsGetHandleProc(ClientData instanceData,	/* The socket state. */
                  int direction,		/* Which Tcl_File to retrieve? */
                  ClientData *handlePtr)	/* Where to store the handle.  */
 {
     State *statePtr = (State *) instanceData;
 
-    return Tcl_GetChannelHandle (Tls_GetParent(statePtr), direction, handlePtr);
+    return Tcl_GetChannelHandle(Tls_GetParent(statePtr), direction, handlePtr);
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * TlsNotifyProc --
+ *
+ *	Handler called by Tcl to inform us of activity
+ *	on the underlying channel.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May process the incoming event by itself.
+ *
+ *-------------------------------------------------------------------
+ */
+
+static int
+TlsNotifyProc(instanceData, mask)
+    ClientData	   instanceData; /* The state of the notified transformation */
+    int		   mask;       /* The mask of occuring events */
+{
+    State *statePtr = (State *) instanceData;
+
+    /*
+     * An event occured in the underlying channel.  This
+     * transformation doesn't process such events thus returns the
+     * incoming mask unchanged.
+     */
+
+    if (statePtr->timer != (Tcl_TimerToken) NULL) {
+	/*
+	 * Delete an existing timer. It was not fired, yet we are
+	 * here, so the channel below generated such an event and we
+	 * don't have to. The renewal of the interest after the
+	 * execution of channel handlers will eventually cause us to
+	 * recreate the timer (in WatchProc).
+	 */
+
+	Tcl_DeleteTimerHandler(statePtr->timer);
+	statePtr->timer = (Tcl_TimerToken) NULL;
+    }
+
+    return mask;
 }
 
+#ifndef TCL_CHANNEL_VERSION_2
 /*
  *------------------------------------------------------*
  *
- *      ChannelHandler --
+ *      TlsChannelHandler --
  *
  *      ------------------------------------------------*
  *      Handler called by Tcl as a result of
  *      Tcl_CreateChannelHandler - to inform us of activity
  *      on the underlying channel.
@@ -453,13 +605,13 @@
  *
  *------------------------------------------------------*
  */
 
 static void
-ChannelHandler (clientData, mask)
-ClientData     clientData;
-int            mask;
+TlsChannelHandler (clientData, mask)
+    ClientData     clientData;
+    int            mask;
 {
     State *statePtr = (State *) clientData;
 
 dprintf(stderr, "HANDLER(0x%x)\n", mask);
     Tcl_Preserve( (ClientData)statePtr);
@@ -501,41 +653,42 @@
     
     if (statePtr->timer != (Tcl_TimerToken)NULL) {
 	Tcl_DeleteTimerHandler(statePtr->timer);
 	statePtr->timer = (Tcl_TimerToken)NULL;
     }
-    if ((mask & TCL_READABLE) && Tcl_InputBuffered (statePtr->self) > 0) {
+    if ((mask & TCL_READABLE) && Tcl_InputBuffered(statePtr->self) > 0) {
 	/*
 	 * Data is waiting, flush it out in short time
 	 */
 	statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY,
-		ChannelHandlerTimer, (ClientData) statePtr);
+		TlsChannelHandlerTimer, (ClientData) statePtr);
     }
     Tcl_Release( (ClientData)statePtr);
 }
+#endif
 
 /*
  *------------------------------------------------------*
  *
- *	ChannelHandlerTimer --
+ *	TlsChannelHandlerTimer --
  *
  *	------------------------------------------------*
  *	Called by the notifier (-> timer) to flush out
  *	information waiting in channel buffers.
  *	------------------------------------------------*
  *
  *	Sideeffects:
- *		As of 'ChannelHandler'.
+ *		As of 'TlsChannelHandler'.
  *
  *	Result:
  *		None.
  *
  *------------------------------------------------------*
  */
 
 static void
-ChannelHandlerTimer (clientData)
+TlsChannelHandlerTimer (clientData)
 ClientData clientData; /* Transformation to query */
 {
     State *statePtr = (State *) clientData;
     int mask = 0;
 
@@ -578,18 +731,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! ");
@@ -604,11 +759,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();
@@ -622,10 +778,13 @@
 
 Tcl_Channel
 Tls_GetParent( statePtr )
     State *statePtr;
 {
+#ifdef TCL_CHANNEL_VERSION_2
+    return Tcl_GetStackedChannel(statePtr->self);
+#else
 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 2
     return statePtr->parent;
 #else
     /* The reason for the existence of this procedure is
      * the fact that stacking a transform over another
@@ -640,29 +799,31 @@
      * It walks the chain of Channel structures until it
      * finds the one pointing having 'ctrl' as instanceData
      * and then returns the superceding channel to that. (AK)
      */
  
-  Tcl_Channel self = statePtr->self;
-  Tcl_Channel next;
-
-  while ((ClientData) statePtr != Tcl_GetChannelInstanceData (self)) {
-    next = Tcl_GetStackedChannel (self);
-    if (next == (Tcl_Channel) NULL) {
-      /* 09/24/1999 Unstacking bug, found by Matt Newman <matt@sensus.org>.
-       *
-       * We were unable to find the channel structure for this
-       * transformation in the chain of stacked channel. This
-       * means that we are currently in the process of unstacking
-       * it *and* there were some bytes waiting which are now
-       * flushed. In this situation the pointer to the channel
-       * itself already refers to the parent channel we have to
-       * write the bytes into, so we return that.
-       */
-      return statePtr->self;
-    }
-    self = next;
-  }
-
-  return Tcl_GetStackedChannel (self);
+    Tcl_Channel self = statePtr->self;
+    Tcl_Channel next;
+
+    while ((ClientData) statePtr != Tcl_GetChannelInstanceData (self)) {
+	next = Tcl_GetStackedChannel (self);
+	if (next == (Tcl_Channel) NULL) {
+	    /* 09/24/1999 Unstacking bug,
+	     * found by Matt Newman <matt@sensus.org>.
+	     *
+	     * We were unable to find the channel structure for this
+	     * transformation in the chain of stacked channel. This
+	     * means that we are currently in the process of unstacking
+	     * it *and* there were some bytes waiting which are now
+	     * flushed. In this situation the pointer to the channel
+	     * itself already refers to the parent channel we have to
+	     * write the bytes into, so we return that.
+	     */
+	    return statePtr->self;
+	}
+	self = next;
+    }
+
+    return Tcl_GetStackedChannel (self);
+#endif
 #endif
 }