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.3 2000/06/05 20:39:31 aborr Exp $
# RCS: @(#) $Id: tlsIO.test,v 1.4 2000/06/05 22:33:26 aborr 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
|
| ︙ | | |
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
|
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
|
-
+
|
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} {socket stdio pcCrash} {
test tlsIO-6.1 {accept callback error} {unexplainedFailure socket stdio pcCrash} {
removeFile script
set f [open script w]
puts $f {
package require tls
gets stdin
tls::socket 127.0.0.1 2848
}
|
| ︙ | | |
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
|
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
|
+
+
-
+
|
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} {socket stdio} {
test tlsIO-7.1 {testing socket specific options} {knownBug 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 2820"
puts $f {
|
| ︙ | | |
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
|
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
|
+
+
-
+
|
close $f
set l ""
lappend l [string compare [lindex $p 0] 127.0.0.1]
lappend l [string compare [lindex $p 2] 2820]
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} {socket stdio} {
test tlsIO-7.2 {testing socket specific options} {knownBug 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 2821"
puts $f {
|
| ︙ | | |
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
|
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
|
+
+
-
+
+
+
-
+
|
-server accept 2822]
set l [fconfigure $s]
close $s
update
llength $l
} 12
# bug report #5812 fconfigure doesn't return value for '-sockname'
test tlsIO-7.4 {testing socket specific options} {socket} {
test tlsIO-7.4 {testing socket specific options} {knownBug socket} {
set s [tls::socket \
-certfile $serverCert -cafile $caCert -keyfile $serverKey \
-server accept 2823]
proc accept {s a p} {
global x
set x [fconfigure $s -sockname]
close $s
}
set s1 [tls::socket \
-certfile $clientCert -cafile $caCert -keyfile $clientKey \
[info hostname] 2823]
set timer [after 10000 "set x timed_out"]
vwait x
after cancel $timer
close $s
close $s1
set l ""
lappend l [lindex $x 2] [llength $x]
} {2823 3}
# bug report #5812 fconfigure doesn't return value for '-sockname'
test tlsIO-7.5 {testing socket specific options} {socket unixOrPc} {
test tlsIO-7.5 {testing socket specific options} {knownBug socket unixOrPc} {
set s [tls::socket \
-certfile $serverCert -cafile $caCert -keyfile $serverKey \
-server accept 2829]
proc accept {s a p} {
global x
set x [fconfigure $s -sockname]
close $s
|
| ︙ | | |
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
|
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
|
+
+
|
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"
}
puts "firstblock = [string length $firstblock]"
puts "secondblock = [string length $secondblock]"
set l [tls::socket \
-certfile $serverCert -cafile $caCert -keyfile $serverKey \
-server accept 2832]
proc accept {s a p} {
fconfigure $s -blocking 0 -translation lf -buffersize 16384 \
-buffering line
fileevent $s readable "readable $s"
|
| ︙ | | |