Overview
| Comment: | Made I/O test more useful when debugging is on and updated to deal with newer versions of OpenSSL |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | wip-fix-io-layer |
| Files: | files | file ages | folders |
| SHA1: |
270ffbbc3eb3f2a1a4096197584429ce |
| User & Date: | rkeene on 2016-12-12 01:51:43 |
| Other Links: | branch diff | manifest | tags |
Context
|
2016-12-12
| ||
| 01:56 | Disabled checking the client certificate and aborting if not found check-in: 916215af0a user: rkeene tags: wip-fix-io-layer | |
| 01:51 | Made I/O test more useful when debugging is on and updated to deal with newer versions of OpenSSL check-in: 270ffbbc3e user: rkeene tags: wip-fix-io-layer | |
| 01:15 | Updated wording in debugging message to be more accurate check-in: 6462992c95 user: rkeene tags: wip-fix-io-layer | |
Changes
Modified tests/tlsIO.test
from [c263e960c5]
to [4095544044].
| ︙ | ︙ | |||
164 165 166 167 168 169 170 |
set doTestsWithRemoteServer 0
} else {
set remoteServerIP 127.0.0.1
set remoteFile [file join [pwd] remote.tcl]
if {[catch {set remoteProcChan \
[open "|[list $::tcltest::tcltest $remoteFile \
-serverIsSilent -port $remoteServerPort \
| | | 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 |
set doTestsWithRemoteServer 0
} else {
set remoteServerIP 127.0.0.1
set remoteFile [file join [pwd] remote.tcl]
if {[catch {set remoteProcChan \
[open "|[list $::tcltest::tcltest $remoteFile \
-serverIsSilent -port $remoteServerPort \
-address $remoteServerIP] 2> /dev/null" w+]} msg] == 0} {
after 1000
if {[catch {set commandSocket [tls::socket -cafile $caCert \
-certfile $clientCert -keyfile $clientKey \
$remoteServerIP $remoteServerPort]} msg] == 0} {
fconfigure $commandSocket -translation crlf -buffering line
} else {
set noRemoteTestReason $msg
|
| ︙ | ︙ | |||
318 319 320 321 322 323 324 |
puts ready
vwait x
after cancel $timer
close $f
puts $x
}
close $f
| | | 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 |
puts ready
vwait x
after cancel $timer
close $f
puts $x
}
close $f
set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r]
gets $f x
if {[catch {tls::socket -certfile $clientCert -cafile $caCert \
-keyfile $clientKey 127.0.0.1 8828} msg]} {
set x $msg
} else {
lappend x [gets $f]
close $msg
|
| ︙ | ︙ | |||
360 361 362 363 364 365 366 |
}
puts ready
vwait x
after cancel $timer
close $f
}
close $f
| | | 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 |
}
puts ready
vwait x
after cancel $timer
close $f
}
close $f
set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r]
gets $f x
global port
if {[catch {tls::socket -myport $port \
-certfile $clientCert -cafile $caCert \
-keyfile $clientKey 127.0.0.1 8829} sock]} {
set x $sock
catch {close [tls::socket 127.0.0.1 8829]}
|
| ︙ | ︙ | |||
400 401 402 403 404 405 406 |
}
puts ready
vwait x
after cancel $timer
close $f
}
close $f
| | | 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 |
}
puts ready
vwait x
after cancel $timer
close $f
}
close $f
set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r]
gets $f x
if {[catch {tls::socket -myaddr 127.0.0.1 \
-certfile $clientCert -cafile $caCert \
-keyfile $clientKey 127.0.0.1 8830} sock]} {
set x $sock
} else {
puts $sock hello
|
| ︙ | ︙ | |||
438 439 440 441 442 443 444 |
}
puts ready
vwait x
after cancel $timer
close $f
}
close $f
| | | 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 |
}
puts ready
vwait x
after cancel $timer
close $f
}
close $f
set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r]
gets $f x
if {[catch {tls::socket -certfile $clientCert -cafile $caCert \
-keyfile $clientKey [info hostname] 8831} sock]} {
set x $sock
} else {
puts $sock hello
flush $sock
|
| ︙ | ︙ | |||
475 476 477 478 479 480 481 |
}
puts ready
vwait x
after cancel $timer
close $f
}
close $f
| | | 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 |
}
puts ready
vwait x
after cancel $timer
close $f
}
close $f
set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r]
gets $f x
if {[catch {tls::socket -certfile $clientCert -cafile $caCert \
-keyfile $clientKey 127.0.0.1 8832} sock]} {
set x $sock
} else {
puts $sock hello
flush $sock
|
| ︙ | ︙ | |||
531 532 533 534 535 536 537 |
puts ready
vwait x
after cancel $timer
close $f
puts done
}
close $f
| | | 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 |
puts ready
vwait x
after cancel $timer
close $f
puts done
}
close $f
set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r]
gets $f
set s [tls::socket -certfile $clientCert -cafile $caCert \
-keyfile $clientKey 127.0.0.1 8834]
fconfigure $s -buffering line -translation lf
puts $s "hello abcdefghijklmnop"
after 1000
set x [gets $s]
|
| ︙ | ︙ | |||
578 579 580 581 582 583 584 |
set timer [after 20000 "set x done"]
vwait x
after cancel $timer
close $f
puts "done $i"
}
close $f
| | | 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 |
set timer [after 20000 "set x done"]
vwait x
after cancel $timer
close $f
puts "done $i"
}
close $f
set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r]
gets $f
set s [tls::socket -certfile $clientCert -cafile $caCert \
-keyfile $clientKey 127.0.0.1 8835]
fconfigure $s -buffering line
catch {
for {set x 0} {$x < 50} {incr x} {
puts $s "hello abcdefghijklmnop"
|
| ︙ | ︙ | |||
703 704 705 706 707 708 709 |
puts ready
vwait x
after cancel $timer
close $f
puts $x
}
close $f
| | | 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 |
puts ready
vwait x
after cancel $timer
close $f
puts $x
}
close $f
set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r]
gets $f x
if {[catch {tls::socket 127.0.0.1 8828} msg]} {
set x $msg
} else {
lappend x [gets $f]
close $msg
}
|
| ︙ | ︙ | |||
730 731 732 733 734 735 736 |
puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828 \]"
puts $f {
puts ready
gets stdin
close $f
}
close $f
| | | 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 |
puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828 \]"
puts $f {
puts ready
gets stdin
close $f
}
close $f
set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r+]
gets $f
set x [list [catch {tls::socket \
-certfile $clientCert -cafile $caCert -keyfile $clientKey \
-server accept 8828} msg] \
$msg]
puts $f bye
close $f
|
| ︙ | ︙ | |||
779 780 781 782 783 784 785 |
after cancel $t2
vwait x
after cancel $t3
close $s
puts $x
}
close $f
| | | 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 |
after cancel $t2
vwait x
after cancel $t3
close $s
puts $x
}
close $f
set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r+]
set x [gets $f]
set s1 [tls::socket \
-certfile $clientCert -cafile $caCert -keyfile $clientKey \
127.0.0.1 8828]
fconfigure $s1 -buffering line
set s2 [tls::socket \
-certfile $clientCert -cafile $caCert -keyfile $clientKey \
|
| ︙ | ︙ | |||
830 831 832 833 834 835 836 |
gets $s
}
close $s
puts bye
gets stdin
}
close $f
| | | | | 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 |
gets $s
}
close $s
puts bye
gets stdin
}
close $f
set p1 [open "|[list $::tcltest::tcltest script] 2> /dev/null" r+]
fconfigure $p1 -buffering line
set p2 [open "|[list $::tcltest::tcltest script] 2> /dev/null" r+]
fconfigure $p2 -buffering line
set p3 [open "|[list $::tcltest::tcltest script] 2> /dev/null" r+]
fconfigure $p3 -buffering line
proc accept {s a p} {
fconfigure $s -buffering line
fileevent $s readable [list echo $s]
}
proc echo {s} {
global x
|
| ︙ | ︙ | |||
928 929 930 931 932 933 934 |
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
| | | 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 |
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] 2> /dev/null" r+]
proc bgerror args {
global x
set x $args
}
proc accept {s a p} {expr 10 / 0}
set s [tls::socket -server accept \
-certfile $serverCert -cafile $caCert -keyfile $serverKey 8848]
|
| ︙ | ︙ | |||
966 967 968 969 970 971 972 |
}
puts ready
set timer [after 10000 "set x timed_out"]
vwait x
after cancel $timer
}
close $f
| | | 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 |
}
puts ready
set timer [after 10000 "set x timed_out"]
vwait x
after cancel $timer
}
close $f
set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r]
gets $f
set s [tls::socket \
-certfile $clientCert -cafile $caCert -keyfile $clientKey \
127.0.0.1 8820]
set p [fconfigure $s -peername]
close $s
close $f
|
| ︙ | ︙ | |||
999 1000 1001 1002 1003 1004 1005 |
}
puts ready
set timer [after 10000 "set x timed_out"]
vwait x
after cancel $timer
}
close $f
| | | 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 |
}
puts ready
set timer [after 10000 "set x timed_out"]
vwait x
after cancel $timer
}
close $f
set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r]
gets $f
set s [tls::socket \
-certfile $clientCert -cafile $caCert -keyfile $clientKey \
127.0.0.1 8821]
set p [fconfigure $s -sockname]
close $s
close $f
|
| ︙ | ︙ | |||
2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 |
-cafile $caCert \
-request 0 -require 0 -ssl2 0 -ssl3 0 -tls1 1 -tls1.1 0 -tls1.2 0 \
[info hostname] 8831]
fconfigure $c -blocking 0
puts $c a ; flush $c
after 5000 [list set ::done timeout]
vwait ::done
set ::done
} {handshake failed: wrong version number}
# cleanup
if {[string match sock* $commandSocket] == 1} {
puts $commandSocket exit
flush $commandSocket
}
catch {close $commandSocket}
catch {close $remoteProcChan}
::tcltest::cleanupTests
flush stdout
return
| > > > > > | 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 |
-cafile $caCert \
-request 0 -require 0 -ssl2 0 -ssl3 0 -tls1 1 -tls1.1 0 -tls1.2 0 \
[info hostname] 8831]
fconfigure $c -blocking 0
puts $c a ; flush $c
after 5000 [list set ::done timeout]
vwait ::done
switch -exact -- $::done {
"handshake failed: wrong ssl version" {
set ::done "handshake failed: wrong version number"
}
}
set ::done
} {handshake failed: wrong version number}
# cleanup
if {[string match sock* $commandSocket] == 1} {
puts $commandSocket exit
flush $commandSocket
}
catch {close $commandSocket}
catch {close $remoteProcChan}
::tcltest::cleanupTests
flush stdout
return
|