TclTLS
Check-in [270ffbbc3e]
Login
HomeTimelineDownloadBrowse SourceBranchesTagsTicketsWiki
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: 270ffbbc3eb3f2a1a4096197584429ce3fd03947
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
Side-by-Side Diff Ignore Whitespace Patch
Modified tests/tlsIO.test from [c263e960c5] to [4095544044].
︙
164
165
166
167
168
169
170
171

172
173
174
175
176
177
178

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]" w+]} msg] == 0} {
		    -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
325

326
327
328
329
330
331
332

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]" r]
    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
367

368
369
370
371
372
373
374

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]" r]
    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
407

408
409
410
411
412
413
414

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]" r]
    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
445

446
447
448
449
450
451
452

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]" r]
    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
482

483
484
485
486
487
488
489

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]" r]
    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
538

539
540
541
542
543
544
545

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]" r]
    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
585

586
587
588
589
590
591
592

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]" r]
    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
710

711
712
713
714
715
716
717

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]" r]
    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
737

738
739
740
741
742
743
744

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]" r+]
    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
786

787
788
789
790
791
792
793

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]" r+]
    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
837

838
839

840
841

842
843
844
845
846
847
848

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]" r+]
    set p1 [open "|[list $::tcltest::tcltest script] 2> /dev/null" r+]
    fconfigure $p1 -buffering line
    set p2 [open "|[list $::tcltest::tcltest script]" r+]
    set p2 [open "|[list $::tcltest::tcltest script] 2> /dev/null" r+]
    fconfigure $p2 -buffering line
    set p3 [open "|[list $::tcltest::tcltest script]" r+]
    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
935

936
937
938
939
940
941
942

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]" r+]
    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
973

974
975
976
977
978
979
980

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]" r]
    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
1006

1007
1008
1009
1010
1011
1012
1013

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]" r]
    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

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
Powered by Fossil · RSS