Diff

Differences From Artifact [321099ebe7]:

To Artifact [d0efc436d5]:


1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
1
2
3
4
5
6
7
8
9
10
11
12

13
14
15
16
17
18
19
20












-
+







# Commands tested in this file: socket.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# 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
# which they connect. The remote server must be an instance of tcltest and it
# must run the script found in the file "remote.tcl" in this directory. You
48
49
50
51
52
53
54
55

56
57
58
59
60
61
62
63


64
65
66
67
68
69
70
71
72
73
74
75
76

77

78
79
80
81
82





83
84

85
86
87

88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107























108
109
110
111
112
113
114
48
49
50
51
52
53
54

55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77

78
79
80





81
82
83
84
85
86

87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141







-
+








+
+












-
+

+
-
-
-
-
-
+
+
+
+
+

-
+



+




















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







# 
#     % set remoteServerIP <name or address of machine on which server runs>
#     % 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::*
}

# Load the tls package

package require tls

set tlsServerPort 8048

set certsDir [file join [file dirname [info script]] certs] 
# 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]
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
# 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.
#

if {![info exists remoteServerIP]} {
    if {[info exists env(remoteServerIP)]} {
	set remoteServerIP $env(remoteServerIP)
    }
}
if {![info exists remoteServerPort]} {
    if {[info exists env(remoteServerPort)]} {
	set remoteServerPort $env(remoteServerPort)
    } else {
        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
#

set doTestsWithRemoteServer 1
if {![info exists remoteServerIP] && ($tcl_platform(platform) != "macintosh")} {
127
128
129
130
131
132
133
134

135
136
137
138
139
140
141
142
143
144


145
146

147
148
149
150
151


152
153

154
155
156
157
158
159
160
154
155
156
157
158
159
160

161

162
163
164
165
166
167
168


169
170


171


172


173
174


175
176
177
178
179
180
181
182







-
+
-







-
-
+
+
-
-
+
-
-

-
-
+
+
-
-
+








set remoteProcChan ""
set commandSocket ""
if {$doTestsWithRemoteServer} {
    catch {close $commandSocket}
    if {[catch {set commandSocket [tls::socket \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    $remoteServerIP \
	    $remoteServerIP $remoteServerPort]}] != 0} {
	    $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 \
		    [open "|[list $::tcltest::tcltest $remoteFile \
		    -serverIsSilent -port $remoteServerPort \
					-port $remoteServerPort \
					-address $remoteServerIP]" \
		    -address $remoteServerIP]" w+]} msg] == 0} {
					w+]} \
		   msg] == 0} {
		after 1000
		if {[catch {set commandSocket [tls::socket \
		    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
		if {[catch {set commandSocket [tls::socket -cafile $caCert \
			-certfile $clientCert -keyfile $clientKey \
				$remoteServerIP \
				$remoteServerPort]} msg] == 0} {
			$remoteServerIP $remoteServerPort]} msg] == 0} {
		    fconfigure $commandSocket -translation crlf -buffering line
		} else {
		    set noRemoteTestReason $msg
		    set doTestsWithRemoteServer 0
		}
	    } else {
		set noRemoteTestReason "$msg $::tcltest::tcltest"
209
210
211
212
213
214
215















216
217
218
219
220
221
222
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







		    return [lindex $resp 1]
		}
	    } 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"}}

test tlsIO-1.2 {arg parsing for socket command} {socket} {
309
310
311
312
313
314
315
316

317
318
319


320
321
322
323
324
325
326
346
347
348
349
350
351
352

353
354


355
356
357
358
359
360
361
362
363







-
+

-
-
+
+







    set f [open script w]
    puts $f {
	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
	close $f
    }
348
349
350
351
352
353
354
355

356
357
358


359
360
361
362
363
364
365
385
386
387
388
389
390
391

392
393


394
395
396
397
398
399
400
401
402







-
+

-
-
+
+







    set f [open script w]
    puts $f {
	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
	close $f
    }
385
386
387
388
389
390
391
392

393
394
395


396
397
398
399
400
401
402
422
423
424
425
426
427
428

429
430


431
432
433
434
435
436
437
438
439







-
+

-
-
+
+







    set f [open script w]
    puts $f {
	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
	close $f
    }
421
422
423
424
425
426
427
428

429
430
431


432
433
434
435
436
437
438
458
459
460
461
462
463
464

465
466


467
468
469
470
471
472
473
474
475







-
+

-
-
+
+







    set f [open script w]
    puts $f {
	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
	close $f
    }
560
561
562
563
564
565
566
567

568
569
570

571
572
573
574
575
576
577
578
579
580
581

582
583
584
585
586
587
588
597
598
599
600
601
602
603

604
605
606

607









608

609
610
611
612
613
614
615
616







-
+


-
+
-
-
-
-
-
-
-
-
-

-
+







    removeFile script
    set f [open script w]
    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
} {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} {
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} {
	global ss
	close $ss
600
601
602
603
604
605
606
607

608
609




610
611
612

613
614
615
616
617
618
619


620
621
622




623
624
625


626
627
628
629


630
631
632
633
634

635
636
637
638
639
640

641
642




643
644
645
646
647
648
649
628
629
630
631
632
633
634

635
636
637
638
639
640
641
642


643



644
645


646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661


662
663
664
665
666
667

668
669
670
671
672
673

674
675

676
677
678
679
680
681
682
683
684
685
686







-
+


+
+
+
+

-
-
+
-
-
-


-
-
+
+



+
+
+
+



+
+


-
-
+
+




-
+





-
+

-
+
+
+
+







    close $cs

    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]
	fileevent $s readable [list do_handshake $s]
	puts $f "err: $err"
	puts $f "[tls::status $sock]"
	close $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"]
	set f [tls::socket -server accept 8828]
	proc accept {file addr port} {
759
760
761
762
763
764
765

766
767
768
769
770
771
772
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810







+







    close $s3
    lappend x [gets $f]
    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
    }
    puts $f "set s \[tls::socket -certfile $clientCert -cafile $caCert -keyfile $clientKey 127.0.0.1 8828 \]"
802
803
804
805
806
807
808
809

810
811
812
813
814
815
816
840
841
842
843
844
845
846

847
848
849
850
851
852
853
854







-
+







        }
    }
    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
    vwait x
    after cancel $t1
863
864
865
866
867
868
869
870



871
872
873
874
875
876
877

878
879
880
881
882
883
884
885


886
887
888
889
890
891
892
893
894
895
896
897
898

899
900
901
902
903

904

905
906
907
908
909
910
911
901
902
903
904
905
906
907

908
909
910
911
912
913
914
915

916
917
918
919
920
921
922
923
924

925
926
927
928
929
930
931
932
933
934
935
936



937
938
939
940
941
942
943

944
945
946
947
948
949
950
951







-
+
+
+





-

+







-
+
+










-
-
-
+





+
-
+







    if {![catch {tls::socket -server dodo 21} msg]} {
	set x {htons problem, should be disallowed, are you running as SU?}
	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
    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 [list tls::socket -server accept \
    puts $f "tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8820"
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8820]
    puts $f {
	proc accept args {
	    global x
	    set x done
	}
	puts ready
	set timer [after 10000 "set x timed_out"]
923
924
925
926
927
928
929
930
931
932

933
934
935
936
937
938
939
963
964
965
966
967
968
969



970
971
972
973
974
975
976
977







-
-
-
+







    close $f
    set l ""
    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
    }
    puts $f "tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8821"
    puts $f {
969
970
971
972
973
974
975
976

977
978
979
980
981
982
983
1007
1008
1009
1010
1011
1012
1013

1014
1015
1016
1017
1018
1019
1020
1021







-
+







    close $s
    update
    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
	set x [fconfigure $s -sockname]
	close $s
992
993
994
995
996
997
998
999

1000
1001
1002


1003
1004
1005
1006
1007
1008
1009
1010


1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023




1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038


1039
1040




1041
1042
1043
1044
1045
1046
1047






1048




1049
1050
1051
1052
1053
1054
1055

1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076



1077
1078
1079
1080


1081
1082
1083





1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094

1095
1096

1097
1098
1099
1100
1101
1102
1103
1104

1105
1106


1107
1108
1109


1110
1111
1112
1113
1114


1115
1116
1117
1118
1119


1120
1121
1122
1123



1124
1125
1126



1127
1128

1129
1130
1131
1132




1133
1134
1135
1136
1137
1138


1139
1140
1141
1142
1143
1144



1145
1146
1147


1148
1149
1150
1151
1152
1153
1154
1030
1031
1032
1033
1034
1035
1036

1037
1038


1039
1040
1041
1042
1043
1044
1045
1046


1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057




1058
1059
1060
1061












1062


1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075


1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092

1093

1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111


1112
1113
1114
1115
1116


1117
1118
1119


1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134

1135


1136






1137

1138


1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166



1167
1168
1169
1170

1171
1172
1173


1174
1175
1176
1177
1178
1179
1180
1181
1182

1183
1184
1185
1186
1187



1188
1189
1190
1191


1192
1193
1194
1195
1196
1197
1198
1199
1200







-
+

-
-
+
+






-
-
+
+









-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-

-
-
+
+


+
+
+
+





-
-
+
+
+
+
+
+

+
+
+
+






-
+
-


















-
-
+
+
+


-
-
+
+

-
-
+
+
+
+
+










-
+
-
-
+
-
-
-
-
-
-

-
+
-
-
+
+



+
+





+
+





+
+




+
+
+
-
-
-
+
+
+

-
+


-
-
+
+
+
+





-
+
+



-
-
-
+
+
+

-
-
+
+







    close $s1
    set l ""
    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):
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.
    #
    # 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 [email protected]. 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.
    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} {
test tlsIO-9.1 {testing spurious events} {socket} {
    # locks up 
    set len 0
    set spurious 0
    set done 0
    proc readlittle {s} {
	global spurious done len
	set l [read $s 1]
	if {[string length $l] == 0} {
	    if {![eof $s]} {
		incr spurious
	    } else {
		close $s
		set done 1
	    }
	} 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
    close $s
    list $spurious $len
} {0 50}

test tlsIO-9.2 {testing async write, fileevents, flush on close} {socket} {
    set firstblock ""
    set firstblock [string repeat a 31]
    for {set i 0} {$i < 5} {incr i} {set firstblock "a$firstblock$firstblock"}
    set secondblock ""
    set secondblock [string repeat b 65535]
    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]
    proc accept {s a p} {
	fconfigure $s -blocking 0 -translation lf -buffersize 16384 \
	fconfigure $s -blocking 0
		-buffering line
	fileevent $s readable "readable $s"
	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 $serverCert -cafile $caCert -keyfile $serverKey \
	    -server accept 8832]
    set c [tls::socket \
	-certfile $clientCert -cafile $caCert -keyfile $clientKey \
    	[info hostname] 8832]
    fconfigure $s -blocking 0 -trans lf -buffering line
	    -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
	    if {$count > 9} {
		close $s
1167
1168
1169
1170
1171
1172
1173
1174
1175



1176
1177
1178
1179


1180
1181
1182
1183



1184
1185

1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196

1197
1198
1199
1200

1201
1202
1203
1204
1205
1206
1207
1208
1209
1210

1211
1212
1213
1214
1215
1216
1217

1218
1219
1220
1221
1222
1223

1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246

1247
1248
1249

1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271

1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286

1287
1288
1289
1290
1291
1292
1293
1294
1295
1296

1297
1298
1299
1300
1301
1302
1303
1304
1305
1213
1214
1215
1216
1217
1218
1219


1220
1221
1222
1223
1224


1225
1226
1227



1228
1229
1230
1231

1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242

1243


1244

1245


1246
1247
1248
1249
1250
1251
1252

1253




1254
1255

1256



1257

1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272





1273
1274
1275
1276
1277
1278
1279
1280

1281



1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315

1316




1317



1318

1319


1320
1321
1322
1323
1324
1325
1326







-
-
+
+
+


-
-
+
+

-
-
-
+
+
+

-
+










-
+
-
-

-
+
-
-







-
+
-
-
-
-


-
+
-
-
-

-

+













-
-
-
-
-





+


-
+
-
-
-



















+














-
+
-
-
-
-

-
-
-

-
+
-
-







    set count 0
    set done false
    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}

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 \
    set s [tls::socket -cafile $caCert -server accept 8898]
	-certfile $serverCert -cafile $caCert -keyfile $serverKey \
    	-server accept 8898]
    proc accept {s a p} {close $s; error}
    set c [tls::socket \
    set c [tls::socket -cafile $caCert 127.0.0.1 8898]
	-certfile $clientCert -cafile $caCert -keyfile $clientKey \
	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"
    sendCertValues
    sendCommand "set serverCert $serverCert"
    sendCommand "set clientCert $clientCert"
    sendCommand "set serverKey $serverKey"
    sendCommand "set clientKey $clientKey"
    sendCommand {
	set socket9_1_test_server [tls::socket -server accept \
		-certfile $serverCert \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey 8834]
		-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 \
	    $remoteServerIP 8834]
    set r [gets $s]
    close $s
    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 \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey 8835]
		-cafile $caCert \
		-keyfile $serverKey \
	    8835]
	proc accept {s a p} {
	    tls::handshake $s
	    puts $s $p
	    close $s
	}
    }
    set s [tls::socket \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    -myport $port $remoteServerIP 8835]
    set r [gets $s]
    close $s
    sendCommand {close $socket9_2_test_server}
    if {$r == $port} {
	set result ok
    } 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]}]} {
	if {![catch {gets $s}]} {
	    set status broken
	}
	close $s
    }
    set status
} ok

test tlsIO-11.4 {remote echo, one line} {socket doTestsWithRemoteServer} {
    sendCommand "set caCert $caCert"
    sendCertValues
    sendCommand "set serverCert $serverCert"
    sendCommand "set clientCert $clientCert"
    sendCommand "set serverKey $serverKey"
    sendCommand "set clientKey $clientKey"
    sendCommand {
    	global serverCert
	global caCert
	global serverKey
	set socket10_6_test_server [tls::socket \
		-certfile $serverCert \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey \
		-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
	}
	proc echo {s} {
1319
1320
1321
1322
1323
1324
1325
1326

1327
1328
1329
1330
1331
1332
1333

1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1340
1341
1342
1343
1344
1345
1346

1347




1348
1349

1350



1351
1352
1353
1354
1355
1356
1357







-
+
-
-
-
-


-
+
-
-
-







    set r [gets $f]
    close $f
    sendCommand {close $socket10_6_test_server}
    set r
} hello

test tlsIO-11.5 {remote echo, 50 lines} {socket doTestsWithRemoteServer} {
    sendCommand "set caCert $caCert"
    sendCertValues
    sendCommand "set serverCert $serverCert"
    sendCommand "set clientCert $clientCert"
    sendCommand "set serverKey $serverKey"
    sendCommand "set clientKey $clientKey"
    sendCommand {
	set socket10_7_test_server [tls::socket -server accept \
		-certfile $serverCert \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey 8836]
		-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
	}
	proc echo {s} {
	    set l [gets $s]
1383
1384
1385
1386
1387
1388
1389

1390
1391
1392

1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406

1407


1408
1409


1410
1411
1412
1413
1414
1415
1416







+


-
+
-
-


-
-







	close $s2
    }
    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] \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey \
		-cafile [file join [pwd] certs caFile.pem] \
		-keyfile [file join [pwd] certs skey.pem] \
		-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]
	    if {[eof $s]} {
		close $s
1431
1432
1433
1434
1435
1436
1437
1438
1439


1440
1441
1442

1443
1444
1445
1446


1447
1448
1449
1450
1451

1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465






















1466
1467
1468

1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485

1486
1487
1488
1489
1490
1491
1492
1493
1494

1495
1496
1497
1498
1499
1500
1501
1502

1503
1504
1505

1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520


1521
1522
1523
1524
1525
1526
1527

1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547



1548
1549
1550
1551
1552
1553
1554
1555
1556
1557













1558
1559
1560
1561

1562
1563
1564
1565
1566
1567
1568
1442
1443
1444
1445
1446
1447
1448


1449
1450
1451


1452




1453
1454





1455














1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477



1478


1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492

1493
1494
1495
1496
1497
1498
1499
1500
1501

1502




1503
1504
1505

1506



1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520


1521
1522




1523
1524

1525


1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540



1541
1542
1543




1544





1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558

1559

1560
1561
1562
1563
1564
1565
1566
1567







-
-
+
+

-
-
+
-
-
-
-
+
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
-
-














-
+








-
+
-
-
-
-



-
+
-
-
-
+













-
-
+
+
-
-
-
-


-
+
-
-















-
-
-
+
+
+
-
-
-
-

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

-

-
+







    close $s1
    close $s2
    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] \
	tls::init -certfile $serverCert -cafile $caCert -keyfile $serverKey
		-cafile [file join [pwd] certs caFile.pem] \
		-keyfile [file join [pwd] certs skey.pem] \
		-server "accept 4003" 4003]
	set s2 [tls::socket \
	set s1 [tls::socket -server "accept 4003" 4003]
	set s2 [tls::socket -server "accept 4004" 4004]
		-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 \
	set s3 [tls::socket -server "accept 4005" 4005]
		-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]
	proc accept {mp s a p} {
	    tls::handshake $s
	    puts $s $mp
	    close $s
	}
    }
    set s1 [tls::socket \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    $remoteServerIP 4003]
    set s2 [tls::socket \
	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} {
	    # 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]
	}
    }
    tls::init -certfile $clientCert -cafile $caCert -keyfile $clientKey
    set s1 [tls::socket $remoteServerIP 4003]
    set s2 [tls::socket $remoteServerIP 4004]
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    $remoteServerIP 4004]
    set s3 [tls::socket \
    set s3 [tls::socket $remoteServerIP 4005]
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    $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
    close $s3
    sendCommand {
	close $s1
	close $s2
	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"
    sendCertValues
    sendCommand "set serverCert $serverCert"
    sendCommand "set clientCert $clientCert"
    sendCommand "set serverKey $serverKey"
    sendCommand "set clientKey $clientKey"
    if {[catch {sendCommand {
	    set peername [fconfigure $callerSocket -peername]
	    set s [tls::socket \
		-certfile $clientCert \
		    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
		-cafile $caCert \
		-keyfile $clientKey \
	    	[lindex $peername 0] 8836]
		    [lindex $peername 0] 8836]
	    close $s
    	 }} msg]} {
	close $s
	error $msg
    }
    set timer [after 10000 "set x timed_out"]
    vwait x
    after cancel $timer
    close $s
    rename bgerror {}
    set x
} {{divide by zero}}

test tlsIO-11.10 {testing socket specific options} {unexplainedFailure socket doTestsWithRemoteServer} {
    sendCommand "set caCert $caCert"
test tlsIO-11.10 {testing socket specific options} {socket doTestsWithRemoteServer} {
    sendCertValues
    sendCommand "set serverCert $serverCert"
    sendCommand "set clientCert $clientCert"
    sendCommand "set serverKey $serverKey"
    sendCommand "set clientKey $clientKey"
    sendCommand {
	set socket10_12_test_server [tls::socket \
		-certfile $serverCert \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey \
		-cafile $caCert \
		-keyfile $serverKey \
		-server accept 8836]
	proc accept {s a p} {close $s}
    }
    set s [tls::socket \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    $remoteServerIP 8836]
    set p [fconfigure $s -peername]
    set n [fconfigure $s -sockname]
    set l ""
    lappend l [lindex $p 2] [llength $p] [llength $p]
    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"
test tlsIO-11.11 {testing spurious events} {socket doTestsWithRemoteServer} {
    # remote equivalent of 9.1
    sendCertValues
    sendCommand "set serverCert $serverCert"
    sendCommand "set clientCert $clientCert"
    sendCommand "set serverKey $serverKey"
    sendCommand "set clientKey $clientKey"
    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"
	    }
	    close $s
	}
1583
1584
1585
1586
1587
1588
1589




1590

1591
1592
1593
1594

1595
1596
1597
1598



1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618

1619
1620
1621
1622
1623
1624
1625

1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636

1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655

1656
1657
1658
1659
1660
1661

1662
1663
1664
1665

1666
1667
1668
1669
1670

1671
1672
1673
1674
1675
1676
1677

1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699


1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710

1711
1712
1713


1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731

1732
1733
1734

1735
1736


1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751

1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772

1773
1774
1775


1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792

1793
1794

1795
1796


1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810


1811
1812
1813
1814
1815

1816
1817


1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592

1593
1594
1595
1596

1597
1598
1599
1600

1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622

1623




1624
1625

1626


1627
1628
1629
1630
1631
1632
1633
1634

1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653

1654




1655

1656




1657



1658

1659


1660
1661
1662
1663

1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684


1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696

1697



1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715


1716



1717


1718
1719
1720
1721
1722
1723

1724
1725
1726
1727
1728
1729
1730
1731
1732

1733

1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747


1748
1749
1750

1751



1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769

1770


1771


1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785


1786
1787
1788

1789
1790
1791
1792


1793
1794
1795
1796
1797

1798
1799
1800
1801
1802
1803
1804







+
+
+
+
-
+



-
+



-
+
+
+



















-
+
-
-
-
-


-
+
-
-








-
+


















-
+
-
-
-
-

-
+
-
-
-
-
+
-
-
-

-
+
-
-




-
+




















-
-
+
+










-
+
-
-
-
+
+
















-
-
+
-
-
-
+
-
-
+
+




-









-
+
-














-
-



-
+
-
-
-
+
+
















-
+
-
-
+
-
-
+
+












-
-
+
+

-



+
-
-
+
+



-







	} else {
	    incr len [string length $l]
	}
    }
    set c [tls::socket \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    $remoteServerIP 8836]
    # 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 "readlittle $c"
    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]
	if {[eof $s]} {
	    incr counter
	    if {$counter > 9} {
		set done {EOF is sticky}
		after cancel $after_id
		close $s
	    }
	}
    }
    proc timed_out {} {
	global c done
	set done {timed_out, EOF is not sticky}
	close $c
    }
    sendCommand "set caCert $caCert"
    sendCertValues
    sendCommand "set serverCert $serverCert"
    sendCommand "set clientCert $clientCert"
    sendCommand "set serverKey $serverKey"
    sendCommand "set clientKey $clientKey"
    sendCommand {
	set socket10_14_test_server [tls::socket \
		-certfile $serverCert \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey \
		-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
} {EOF is sticky}

test tlsIO-11.13 {testing async write, async flush, async close} \
	{socket doTestsWithRemoteServer} {
    proc readit {s} {
	global count done
	set l [read $s]
	incr count [string length $l]
	if {[eof $s]} {
	    close $s
	    set done 1
	}
    }
    sendCommand "set caCert $caCert"
    sendCertValues
    sendCommand "set serverCert $serverCert"
    sendCommand "set clientCert $clientCert"
    sendCommand "set serverKey $serverKey"
    sendCommand "set clientKey $clientKey"
    sendCommand {
	set firstblock ""
	set firstblock [string repeat a 31]
	for {set i 0} {$i < 5} {incr i} {
		set firstblock "a$firstblock$firstblock"
	}
	set secondblock ""
	set secondblock [string repeat b 65535]
	for {set i 0} {$i < 16} {incr i} {
	    set secondblock "b$secondblock$secondblock"
	}
	set l [tls::socket \
		-certfile $serverCert \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey \
		-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 {}
	    after 1000 respond $s
	}
	proc respond {s} {
	    global firstblock
	    puts -nonewline $s $firstblock
	    after 1000 writedata $s
	}
	proc writedata {s} {
	    global secondblock
	    puts -nonewline $s $secondblock
	    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
    after cancel $timer
    sendCommand {close $l}
    set count
} 65566

test tlsIO-12.1 {testing inheritance of server sockets} \
test tlsIO-12.1 {testing inheritance of server sockets} {socket exec} {
	{socket doTestsWithRemoteServer} {
    removeFile script1
    removeFile script2
    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]
    puts $f {
	after 10000 exit
	vwait forever
    }
    close $f

    # 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 [list set tclsh $::tcltest::tcltest]
    puts $f {
	package require tcltest
	package require tls
    puts $f {package require tls}
    }
    puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828 \]"
    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 $::tcltest::tcltest script2 &
    exec [info nameofexecutable] script2 &
    after 5000 { set ok_to_proceed 1 }
    vwait ok_to_proceed

    # If we can still connect to the server, the socket got inherited.

    if {[catch {tls::socket \
	-certfile $clientCert -cafile $caCert -keyfile $clientKey \
   	 127.0.0.1 8828} msg]} {
	set x {server socket was not inherited}
    } 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} \
test tlsIO-12.2 {testing inheritance of client sockets} {socket exec} {
	{unexplainedFailure socket doTestsWithRemoteServer} {
    removeFile script1
    removeFile script2
    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]
    puts $f {
	after 10000 exit
	vwait forever
    }
    close $f

    # 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 [list set tclsh $::tcltest::tcltest]
    puts $f {
    	package require tls
    puts $f {package require tls}
    }
    puts $f "set f \[tls::socket -certfile $clientCert -cafile $caCert -keyfile $clientKey 127.0.0.1 8829 \]"
    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
	vwait forever
    }
    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
	fconfigure $file -blocking 0
	fileevent $file readable [list getdata $file]
	fconfigure $file -buffering line -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} {
	    set x {read failed, error was $data}
	    catch { close $file }
1846
1847
1848
1849
1850
1851
1852
1853

1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865

1866
1867
1868


1869
1870
1871
1872
1873
1874
1875
1876
1877
1878

1879
1880

1881
1882


1883
1884
1885

1886
1887
1888
1889
1890

1891
1892
1893
1894
1895
1896
1897

1898
1899

1900
1901
1902
1903
1904
1905



1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921

1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948

1949
1950
1951
1952
1953
1954
1955
1822
1823
1824
1825
1826
1827
1828

1829
1830
1831
1832
1833
1834


1835
1836
1837
1838

1839



1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850

1851


1852


1853
1854
1855
1856
1857
1858
1859
1860
1861
1862

1863
1864
1865
1866
1867
1868
1869

1870
1871

1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890

1891
1892
1893
1894
1895

1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914



1915
1916
1917
1918
1919

1920
1921
1922
1923
1924
1925
1926
1927







-
+





-
-




-
+
-
-
-
+
+









-
+
-
-
+
-
-
+
+



+




-
+






-
+

-
+






+
+
+









-





-
+


















-
-
-





-
+







    # script1 process must have inherited the client.

    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} {
	{socket exec unixOnly} {
    # hangs on Linux
    removeFile script1
    removeFile script2
    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 [list set tclsh $::tcltest::tcltest]
    puts $f {
    	package require tls
    puts $f {package require tls}
    }
    puts $f "catch {set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8930 \]}"
    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} {
		set x {accepted socket was inherited}
	    } else {
		set x {accepted socket was not inherited}
	    }
	    catch { close $file }
	} else {
	    set x {impossible case}
	    catch { close $file }
	}
	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
	set f [tls::socket -server accept 8828]
	proc accept {s a p} {
2004
2005
2006
2007
2008
2009
2010
2011
1976
1977
1978
1979
1980
1981
1982








-
   flush $commandSocket
}
catch {close $commandSocket}
catch {close $remoteProcChan}
::tcltest::cleanupTests
flush stdout
return