Diff

Differences From Artifact [7d00fa23e9]:

To Artifact [3c2ae49926]:


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.2.2 2000/07/12 01:54:03 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












|







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.2.3 2000/07/14 04:10:23 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
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
    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} {
    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







|







574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
    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} {
    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
601
602
603
604
605
606
607

608
609
610
611
612
613
614

    vwait done
    after cancel $timer
    set done
} 1

test tlsIO-2.11 {detecting new data} {socket knownBug} {

    proc accept {s a p} {
	global sock
	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]"







>







601
602
603
604
605
606
607
608
609
610
611
612
613
614
615

    vwait done
    after cancel $timer
    set done
} 1

test tlsIO-2.11 {detecting new data} {socket knownBug} {
    # HOBBS: hung pre-rewrite, hangs post-rewrite
    proc accept {s a p} {
	global sock
	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]"
864
865
866
867
868
869
870

871
872
873
874
875
876
877
	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} {

    removeFile script
    set f [open script w]
    puts $f {
    	package require tls
	gets stdin
	tls::socket 127.0.0.1 8848
    }







>







865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
	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} {
    # HOBBS: still fails post-rewrite
    removeFile script
    set f [open script w]
    puts $f {
    	package require tls
	gets stdin
	tls::socket 127.0.0.1 8848
    }
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
    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} {
    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 {







|







893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
    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} {
    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 {
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
    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} {
    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 {







|







927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
    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} {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
    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} {
    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







|







971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
    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} {
    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
    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} {
    set s [tls::socket \
	-certfile $serverCert -cafile $caCert -keyfile $serverKey \
    	-server accept 8829]
    proc accept {s a p} {
	global x
	set x [fconfigure $s -sockname]
	close $s







|







994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
    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} {socket unixOrPc} {
    set s [tls::socket \
	-certfile $serverCert -cafile $caCert -keyfile $serverKey \
    	-server accept 8829]
    proc accept {s a p} {
	global x
	set x [fconfigure $s -sockname]
	close $s
1014
1015
1016
1017
1018
1019
1020

1021
1022
1023
1024
1025
1026
1027
    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,







>







1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
    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} {
    # HOBBS: still fails post-rewrite
    # test seems to hang -- awb 6/2/2000
    # NOTE: This test may fail on some Solaris 2.4 systems. If it does,
    # check that you have these patches installed (using showrev -p):
    #
    # 101907-05, 101925-02, 101945-14, 101959-03, 101969-05, 101973-03,
    # 101977-03, 101981-02, 101985-01, 102001-03, 102003-01, 102007-01,
    # 102011-02, 102024-01, 102039-01, 102044-01, 102048-01, 102062-03,
1049
1050
1051
1052
1053
1054
1055

1056
1057
1058
1059
1060
1061
1062
    set z [gets $s1]
    close $s
    close $s1
    set z
} bye

test tlsIO-9.1 {testing spurious events} {unexplainedHang socket} {

    # locks up 
    set len 0
    set spurious 0
    set done 0
    proc readlittle {s} {
	global spurious done len
	set l [read $s 1]







>







1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
    set z [gets $s1]
    close $s
    close $s1
    set z
} bye

test tlsIO-9.1 {testing spurious events} {unexplainedHang socket} {
    # HOBBS: still fails post-rewrite
    # locks up 
    set len 0
    set spurious 0
    set done 0
    proc readlittle {s} {
	global spurious done len
	set l [read $s 1]
1087
1088
1089
1090
1091
1092
1093


1094
1095
1096
1097
1098
1099
1100
    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 ""
    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 \







>
>







1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
    vwait done
    after cancel $timer
    close $s
    list $spurious $len
} {0 50}

test tlsIO-9.2 {testing async write, fileevents, flush on close} {socket} {
    # HOBBS: This hangs when I turn blocking on.
    #
    set firstblock ""
    for {set i 0} {$i < 5} {incr i} {set firstblock "a$firstblock$firstblock"}
    set secondblock ""
    for {set i 0} {$i < 16} {incr i} {
	set secondblock "b$secondblock$secondblock"
    }
    set l [tls::socket \
1132
1133
1134
1135
1136
1137
1138

1139
1140
1141
1142
1143
1144
1145
1146

1147
1148
1149
1150
1151
1152
1153
	incr count [string length $l]
	if {[eof $s]} {
	    close $s
	    set done 1
	}
    }
    fileevent $s readable "readit $s"

    set timer [after 10000 "set done timed_out"]
    vwait done
    after cancel $timer
    close $l
    set count
} 65566

test tlsIO-9.3 {testing EOF stickyness} {unexplainedHang socket} {

    # hangs
    proc count_to_eof {s} {
	global count done timer
	set l [gets $s]
	if {[eof $s]} {
	    incr count
	    if {$count > 9} {







>




|
|


>







1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
	incr count [string length $l]
	if {[eof $s]} {
	    close $s
	    set done 1
	}
    }
    fileevent $s readable "readit $s"
    set done 0
    set timer [after 10000 "set done timed_out"]
    vwait done
    after cancel $timer
    close $l
    list $count $done
} {65566 1}

test tlsIO-9.3 {testing EOF stickyness} {unexplainedHang socket} {
    # HOBBS: still fails post-rewrite
    # hangs
    proc count_to_eof {s} {
	global count done timer
	set l [gets $s]
	if {[eof $s]} {
	    incr count
	    if {$count > 9} {