Overview
Comment: | Improved tlsIO testing |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | tls-1-7 |
Files: | files | file ages | folders |
SHA1: |
61578a1d914e0ab770ac0996fc634a43 |
User & Date: | rkeene on 2016-11-29 23:42:24 |
Other Links: | branch diff | manifest | tags |
Context
2016-11-29
| ||
23:46 | Updated key tests check-in: baa98c9b5d user: rkeene tags: tls-1-7 | |
23:42 | Improved tlsIO testing check-in: 61578a1d91 user: rkeene tags: tls-1-7 | |
2016-11-24
| ||
05:18 | Updated to add the parent directory to the testing interpreters search path check-in: 5d996983fc user: rkeene tags: tls-1-7 | |
Changes
Modified tests/tlsIO.test
from [29322e679c]
to [eaefd1ceb9].
︙ | ︙ | |||
66 67 68 69 70 71 72 | if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } # The build dir is added as the first element of $PATH | < | | 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 | 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 { | > < | 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 | } 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 { | > < | 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 | 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 { | > < | 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 | 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 { | > < | 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 | 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 { | > < | 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 | } set status } ok test tlsIO-2.7 {echo server, one line} {socket stdio} { removeFile script set f [open script w] puts $f { | > < | 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 | 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 { | > < | 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 | 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 { | > < | 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 | 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 { | > < | 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 | close $f set x } {ready done {}} test tlsIO-3.1 {socket conflict} {socket stdio} { removeFile script set f [open script w] puts $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 | 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 { | > < | 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 | 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 { | > < | 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 | } {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 { | > < | 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 | 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 { | > < | 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 | 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 { | > < | 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 | # 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 { | > < | 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 | # 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 { | > < | 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 | after 10000 exit vwait forever } close $f set f [open script2 w] puts $f [list set tclsh $::tcltest::tcltest] puts $f { | > < | 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 | test tlsIO-13.1 {Testing use of shared socket between two threads} \ {socket testthread} { # HOBBS: never tested removeFile script threadReap makeFile { | < | 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} { |
︙ | ︙ |