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.10 2000/06/03 03:17:58 awb Exp $
# RCS: @(#) $Id: tlsIo.test,v 1.11 2000/06/03 03:35:36 awb 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
|
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
|
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
|
+
-
+
+
-
+
+
+
-
+
+
-
+
+
|
test socket-3.1 {socket conflict} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
package require tls
}
set f [tls::socket -server accept 2828]
set x [list [catch {tls::socket -server accept 2828} msg] \
set x [list [catch {tls::socket \
-certfile $clientCert -cafile $caCert -keyfile $clientKey \
-server accept 2828} msg] \
$msg]
puts $f bye
close $f
set x
} {1 {couldn't open socket: address already in use}}
test socket-3.2 {server with several clients} {socket stdio pcCrash} {
test socket-3.2 {server with several clients} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
package require tls
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 counter 0
}
set s [tls::socket -server accept 2828]
|
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
|
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
|
-
+
+
+
-
+
+
+
-
+
+
+
-
+
+
-
+
+
|
after cancel $t3
close $s
puts $x
}
close $f
set f [open "|[list $::tcltest::tcltest script]" r+]
set x [gets $f]
set s1 [tls::socket 127.0.0.1 2828]
set s1 [tls::socket \
-certfile $clientCert -cafile $caCert -keyfile $clientKey \
127.0.0.1 2828]
fconfigure $s1 -buffering line
set s2 [tls::socket 127.0.0.1 2828]
set s2 [tls::socket \
-certfile $clientCert -cafile $caCert -keyfile $clientKey \
127.0.0.1 2828]
fconfigure $s2 -buffering line
set s3 [tls::socket 127.0.0.1 2828]
set s3 [tls::socket \
-certfile $clientCert -cafile $caCert -keyfile $clientKey \
127.0.0.1 2828]
fconfigure $s3 -buffering line
for {set i 0} {$i < 100} {incr i} {
puts $s1 hello,s1
gets $s1
puts $s2 hello,s2
gets $s2
puts $s3 hello,s3
gets $s3
}
close $s1
close $s2
close $s3
lappend x [gets $f]
close $f
set x
} {ready done}
test socket-4.1 {server with several clients} {socket stdio pcCrash} {
test socket-4.1 {server with several clients} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
package require tls
gets stdin
}
set s [tls::socket 127.0.0.1 2828]
|
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
|
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
|
-
+
+
+
|
} else {
puts $s $l
}
}
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 -server accept 2828]
set s [tls::socket \
-certfile $serverCert -cafile $caCert -keyfile $serverKey \
-server accept 2828]
puts $p1 open
puts $p2 open
puts $p3 open
vwait x
vwait x
vwait x
after cancel $t1
|
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
|
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
|
-
+
|
vwait x
after cancel $timer
close $s
rename bgerror {}
set x
} {{divide by zero}}
test socket-7.1 {testing socket specific options} {socket stdio pcCrash} {
test socket-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 2820"
puts $f {
|
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
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
994
995
996
997
998
|
953
954
955
956
957
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
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
|
+
-
+
+
+
-
+
-
+
|
lappend l [llength $p]
lappend l [lindex $p 0]
lappend l [expr [lindex $p 2] == 2821]
} {3 127.0.0.1 0}
test socket-7.3 {testing socket specific options} {socket} {
set s [tls::socket \
-certfile $serverCert -cafile $caCert -keyfile $serverKey \
-server accept 2822]
set l [fconfigure $s]
close $s
update
llength $l
} 12
test socket-7.4 {testing socket specific options} {socket pcCrash} {
test socket-7.4 {testing socket specific options} {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}
test socket-7.5 {testing socket specific options} {socket unixOrPc pcCrash} {
test socket-7.5 {testing socket specific options} {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
}
set s1 [tls::socket \
-certfile $clientCert -cafile $caCert -keyfile $clientKey \
127.0.0.1 2829]
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 2829 3}
test socket-8.1 {testing -async flag on sockets} {empty socket pcCrash} {
test socket-8.1 {testing -async flag on sockets} {empty socket} {
# 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,
|