︙ | | | ︙ | |
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
|
︙ | | | ︙ | |
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
|
after 500
fconfigure $sock -blocking 0
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 c:[gets $sock]
fconfigure $sock -blocking 1
close $s2
close $s
close $sock
set result
} {a:one b: c:two}
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
|
|
>
<
|
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
|
after 500
fconfigure $sock -blocking 0
set result a:[gets $sock]
lappend result b:[gets $sock]
fconfigure $sock -blocking 1
puts $s2 two
flush $s2
fconfigure $sock -blocking 1
lappend result c:[gets $sock]
fconfigure $sock -blocking 1
close $s2
close $s
close $sock
set result
} {a:one b: c:two}
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} {
|
︙ | | | ︙ | |