︙ | | | ︙ | |
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
# The build dir is added as the first element of $PATH
set auto_path [linsert $auto_path 0 [lindex [split $env(PATH) ";:"] 0]]
# Load the tls package
package require tls 1.6
set tlsServerPort 8048
# Specify where the certificates are
set certsDir [file join [file dirname [info script]] certs]
set serverCert [file join $certsDir server.pem]
|
<
|
|
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
# The build dir is added as the first element of $PATH
# Load the tls package
package require tls
set tlsServerPort 8048
# Specify where the certificates are
set certsDir [file join [file dirname [info script]] certs]
set serverCert [file join $certsDir server.pem]
|
︙ | | | ︙ | |
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
|
test tlsIO-1.12 {arg parsing for socket command} {socket} {
list [catch {tls::socket foo badport} msg] $msg
} {1 {expected integer but got "badport"}}
test tlsIO-2.1 {tcp connection} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
set auto_path [linsert $auto_path 0 [lindex [split $env(PATH) ";:"] 0]]
package require tls
set timer [after 2000 "set x timed_out"]
}
puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828 \]"
puts $f {
proc accept {file addr port} {
global x
|
>
<
|
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
|
test tlsIO-1.12 {arg parsing for socket command} {socket} {
list [catch {tls::socket foo badport} msg] $msg
} {1 {expected integer but got "badport"}}
test tlsIO-2.1 {tcp connection} {socket stdio} {
removeFile script
set f [open script w]
puts $f [list set auto_path $auto_path]
puts $f {
package require tls
set timer [after 2000 "set x timed_out"]
}
puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828 \]"
puts $f {
proc accept {file addr port} {
global x
|
︙ | | | ︙ | |
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
|
} else {
set port [expr {$tlsServerPort + [pid]%1024}]
}
test tlsIO-2.2 {tcp connection with client port specified} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
set auto_path [linsert $auto_path 0 [lindex [split $env(PATH) ";:"] 0]]
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 {sock addr port} {
global x
|
>
<
|
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
|
} else {
set port [expr {$tlsServerPort + [pid]%1024}]
}
test tlsIO-2.2 {tcp connection with client port specified} {socket stdio} {
removeFile script
set f [open script w]
puts $f [list set auto_path $auto_path]
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 {sock addr port} {
global x
|
︙ | | | ︙ | |
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
|
close $f
set x
} [list ready "hello $port"]
test tlsIO-2.3 {tcp connection with client interface specified} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
set auto_path [linsert $auto_path 0 [lindex [split $env(PATH) ";:"] 0]]
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 {sock addr port} {
global x
|
>
<
|
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
|
close $f
set x
} [list ready "hello $port"]
test tlsIO-2.3 {tcp connection with client interface specified} {socket stdio} {
removeFile script
set f [open script w]
puts $f [list set auto_path $auto_path]
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 {sock addr port} {
global x
|
︙ | | | ︙ | |
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
|
close $f
set x
} {ready {hello 127.0.0.1}}
test tlsIO-2.4 {tcp connection with server interface specified} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
set auto_path [linsert $auto_path 0 [lindex [split $env(PATH) ";:"] 0]]
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 {sock addr port} {
global x
|
>
<
|
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
|
close $f
set x
} {ready {hello 127.0.0.1}}
test tlsIO-2.4 {tcp connection with server interface specified} {socket stdio} {
removeFile script
set f [open script w]
puts $f [list set auto_path $auto_path]
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 {sock addr port} {
global x
|
︙ | | | ︙ | |
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
|
close $f
set x
} {ready hello}
test tlsIO-2.5 {tcp connection with redundant server port} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
set auto_path [linsert $auto_path 0 [lindex [split $env(PATH) ";:"] 0]]
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 {sock addr port} {
global x
|
>
<
|
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
|
close $f
set x
} {ready hello}
test tlsIO-2.5 {tcp connection with redundant server port} {socket stdio} {
removeFile script
set f [open script w]
puts $f [list set auto_path $auto_path]
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 {sock addr port} {
global x
|
︙ | | | ︙ | |
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
|
}
set status
} ok
test tlsIO-2.7 {echo server, one line} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
set auto_path [linsert $auto_path 0 [lindex [split $env(PATH) ";:"] 0]]
package require tls
set timer [after 2000 "set x done"]
}
puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8834 \]"
puts $f {
proc accept {s a p} {
fileevent $s readable [list echo $s]
|
>
<
|
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
|
}
set status
} ok
test tlsIO-2.7 {echo server, one line} {socket stdio} {
removeFile script
set f [open script w]
puts $f [list set auto_path $auto_path]
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 8834 \]"
puts $f {
proc accept {s a p} {
fileevent $s readable [list echo $s]
|
︙ | | | ︙ | |
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
|
set y [gets $f]
close $f
list $x $y
} {{hello abcdefghijklmnop} done}
test tlsIO-2.8 {echo server, loop 50 times, single connection} {socket stdio} {
set f [open script w]
puts $f {
set auto_path [linsert $auto_path 0 [lindex [split $env(PATH) ";:"] 0]]
package require tls
}
puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8835 \]"
puts $f {
proc accept {s a p} {
fileevent $s readable [list echo $s]
fconfigure $s -buffering line
|
>
<
|
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
|
set y [gets $f]
close $f
list $x $y
} {{hello abcdefghijklmnop} done}
test tlsIO-2.8 {echo server, loop 50 times, single connection} {socket stdio} {
set f [open script w]
puts $f [list set auto_path $auto_path]
puts $f {
package require tls
}
puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8835 \]"
puts $f {
proc accept {s a p} {
fileevent $s readable [list echo $s]
fconfigure $s -buffering line
|
︙ | | | ︙ | |
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
|
set x
} {done 50}
test tlsIO-2.9 {socket conflict} {socket stdio} {
set s [tls::socket -server accept 8828]
removeFile script
set f [open script w]
puts -nonewline $f {
set auto_path [linsert $auto_path 0 [lindex [split $env(PATH) ";:"] 0]]
package require tls
tls::socket -server accept 8828
}
close $f
set f [open "|[list $::tcltest::tcltest script]" r]
gets $f
after 100
|
>
<
|
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
|
set x
} {done 50}
test tlsIO-2.9 {socket conflict} {socket stdio} {
set s [tls::socket -server accept 8828]
removeFile script
set f [open script w]
puts $f [list set auto_path $auto_path]
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
|
︙ | | | ︙ | |
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
|
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 {
set auto_path [linsert $auto_path 0 [lindex [split $env(PATH) ";:"] 0]]
package require tls
set timer [after 2000 "set x timed_out"]
set f [tls::socket -server accept 8828]
proc accept {file addr port} {
global x
set x done
close $file
|
>
<
|
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
|
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 [list set auto_path $auto_path]
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} {
global x
set x done
close $file
|
︙ | | | ︙ | |
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
|
close $f
set x
} {ready done {}}
test tlsIO-3.1 {socket conflict} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
set auto_path [linsert $auto_path 0 [lindex [split $env(PATH) ";:"] 0]]
package require tls
}
puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828 \]"
puts $f {
puts ready
gets stdin
close $f
|
>
<
|
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
|
close $f
set x
} {ready done {}}
test tlsIO-3.1 {socket conflict} {socket stdio} {
removeFile script
set f [open script w]
puts $f [list set auto_path $auto_path]
puts $f {
package require tls
}
puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828 \]"
puts $f {
puts ready
gets stdin
close $f
|
︙ | | | ︙ | |
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
|
close $f
set x
} {1 {couldn't open socket: address already in use}}
test tlsIO-3.2 {server with several clients} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
set auto_path [linsert $auto_path 0 [lindex [split $env(PATH) ";:"] 0]]
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
}
puts $f "set s \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828 \]"
|
>
<
|
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
|
close $f
set x
} {1 {couldn't open socket: address already in use}}
test tlsIO-3.2 {server with several clients} {socket stdio} {
removeFile script
set f [open script w]
puts $f [list set auto_path $auto_path]
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
}
puts $f "set s \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828 \]"
|
︙ | | | ︙ | |
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
|
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 {
set auto_path [linsert $auto_path 0 [lindex [split $env(PATH) ";:"] 0]]
package require tls
gets stdin
}
puts $f "set s \[tls::socket -certfile $clientCert -cafile $caCert -keyfile $clientKey 127.0.0.1 8828 \]"
puts $f {
fconfigure $s -buffering line
for {set i 0} {$i < 100} {incr i} {
|
>
<
|
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
|
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 [list set auto_path $auto_path]
puts $f {
package require tls
gets stdin
}
puts $f "set s \[tls::socket -certfile $clientCert -cafile $caCert -keyfile $clientKey 127.0.0.1 8828 \]"
puts $f {
fconfigure $s -buffering line
for {set i 0} {$i < 100} {incr i} {
|
︙ | | | ︙ | |
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
|
} {couldn't open socket: not owner}
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 {
set auto_path [linsert $auto_path 0 [lindex [split $env(PATH) ";:"] 0]]
package require tls
gets stdin
}
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 {
|
>
<
|
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
|
} {couldn't open socket: not owner}
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 [list set auto_path $auto_path]
puts $f {
package require tls
gets stdin
}
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 {
|
︙ | | | ︙ | |
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
|
rename bgerror {}
set x
} {{divide by zero}}
test tlsIO-7.1 {testing socket specific options} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
set auto_path [linsert $auto_path 0 [lindex [split $env(PATH) ";:"] 0]]
package require tls
}
puts $f [list tls::socket -server accept \
-certfile $serverCert -cafile $caCert -keyfile $serverKey 8820]
puts $f {
proc accept args {
global x
|
>
<
|
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
|
rename bgerror {}
set x
} {{divide by zero}}
test tlsIO-7.1 {testing socket specific options} {socket stdio} {
removeFile script
set f [open script w]
puts $f [list set auto_path $auto_path]
puts $f {
package require tls
}
puts $f [list tls::socket -server accept \
-certfile $serverCert -cafile $caCert -keyfile $serverKey 8820]
puts $f {
proc accept args {
global x
|
︙ | | | ︙ | |
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
|
lappend l [string compare [lindex $p 2] 8820]
lappend l [llength $p]
} {0 0 3}
test tlsIO-7.2 {testing socket specific options} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
set auto_path [linsert $auto_path 0 [lindex [split $env(PATH) ";:"] 0]]
package require tls
}
puts $f "tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8821"
puts $f {
proc accept args {
global x
set x done
|
>
<
|
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
|
lappend l [string compare [lindex $p 2] 8820]
lappend l [llength $p]
} {0 0 3}
test tlsIO-7.2 {testing socket specific options} {socket stdio} {
removeFile script
set f [open script w]
puts $f [list set auto_path $auto_path]
puts $f {
package require tls
}
puts $f "tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8821"
puts $f {
proc accept args {
global x
set x done
|
︙ | | | ︙ | |
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
|
# 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 tclsh $::tcltest::tcltest]
puts $f {
set auto_path [linsert $auto_path 0 [lindex [split $env(PATH) ";:"] 0]]
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
|
>
<
|
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
|
# 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 tclsh $::tcltest::tcltest]
puts $f [list set auto_path $auto_path]
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
|
︙ | | | ︙ | |
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
|
# 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 $::tcltest::tcltest]
puts $f {
set auto_path [linsert $auto_path 0 [lindex [split $env(PATH) ";:"] 0]]
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
|
>
<
|
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
|
# 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 $::tcltest::tcltest]
puts $f [list set auto_path $auto_path]
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
|
︙ | | | ︙ | |
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
|
after 10000 exit
vwait forever
}
close $f
set f [open script2 w]
puts $f [list set tclsh $::tcltest::tcltest]
puts $f {
set auto_path [linsert $auto_path 0 [lindex [split $env(PATH) ";:"] 0]]
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
|
>
<
|
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
|
after 10000 exit
vwait forever
}
close $f
set f [open script2 w]
puts $f [list set tclsh $::tcltest::tcltest]
puts $f [list set auto_path $auto_path]
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
|
︙ | | | ︙ | |
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
|
test tlsIO-13.1 {Testing use of shared socket between two threads} \
{socket testthread} {
# HOBBS: never tested
removeFile script
threadReap
makeFile {
set auto_path [linsert $auto_path 0 [lindex [split $env(PATH) ";:"] 0]]
package require tls
set f [tls::socket -server accept 8828]
proc accept {s a p} {
fileevent $s readable [list echo $s]
fconfigure $s -buffering line
}
proc echo {s} {
|
<
|
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
|
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} {
fileevent $s readable [list echo $s]
fconfigure $s -buffering line
}
proc echo {s} {
|
︙ | | | ︙ | |