Diff

Differences From Artifact [2200edd1d1]:

To Artifact [15d6345268]:


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] 2> /dev/null" w+]} msg] == 0} {
		    -address $remoteServerIP]" 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] 2> /dev/null" r]
    set f [open "|[list $::tcltest::tcltest script]" 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] 2> /dev/null" r]
    set f [open "|[list $::tcltest::tcltest script]" 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] 2> /dev/null" r]
    set f [open "|[list $::tcltest::tcltest script]" 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
424
425
426
427
428
429
430
431

432
433
434
435
436
437
438
439
440
441
442
443
444
445

446
447
448

449
450
451
452
453
454
455
424
425
426
427
428
429
430

431
432
433
434
435
436
437
438
439
440
441
442
443
444

445
446
447

448
449
450
451
452
453
454
455







-
+













-
+


-
+







    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 "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey -myaddr localhost 8831 \]"
    puts $f {
	proc accept {sock addr port} {
            global x
            puts "[gets $sock]"
            close $sock
            set x done
	}
	puts ready
	vwait x
	after cancel $timer
	close $f
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r]
    set f [open "|[list $::tcltest::tcltest script]" r]
    gets $f x
    if {[catch {tls::socket -certfile $clientCert -cafile $caCert \
	-keyfile $clientKey [info hostname] 8831} sock]} {
	-keyfile $clientKey localhost 8831} sock]} {
        set x $sock
    } else {
        puts $sock hello
	flush $sock
        lappend x [gets $f]
        close $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] 2> /dev/null" r]
    set f [open "|[list $::tcltest::tcltest script]" 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] 2> /dev/null" r]
    set f [open "|[list $::tcltest::tcltest script]" 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] 2> /dev/null" r]
    set f [open "|[list $::tcltest::tcltest script]" 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"
631
632
633
634
635
636
637
638

639
640
641
642
643
644
645
631
632
633
634
635
636
637

638
639
640
641
642
643
644
645







-
+







    proc readit {s} {
	global done
	gets $s
	close $s
	set done 1
    }
    set cs [tls::socket -certfile $clientCert -cafile $caCert \
	-keyfile $clientKey [info hostname] 8830]
	-keyfile $clientKey localhost 8830]
    close $cs

    vwait done
    after cancel $timer
    set done
} 1

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] 2> /dev/null" r]
    set f [open "|[list $::tcltest::tcltest script]" 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] 2> /dev/null" r+]
    set f [open "|[list $::tcltest::tcltest script]" 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] 2> /dev/null" r+]
    set f [open "|[list $::tcltest::tcltest script]" 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] 2> /dev/null" r+]
    set p1 [open "|[list $::tcltest::tcltest script]" r+]
    fconfigure $p1 -buffering line
    set p2 [open "|[list $::tcltest::tcltest script] 2> /dev/null" r+]
    set p2 [open "|[list $::tcltest::tcltest script]" r+]
    fconfigure $p2 -buffering line
    set p3 [open "|[list $::tcltest::tcltest script] 2> /dev/null" r+]
    set p3 [open "|[list $::tcltest::tcltest script]" 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] 2> /dev/null" r+]
    set f [open "|[list $::tcltest::tcltest script]" 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] 2> /dev/null" r]
    set f [open "|[list $::tcltest::tcltest script]" 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] 2> /dev/null" r]
    set f [open "|[list $::tcltest::tcltest script]" 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
1038
1039
1040
1041
1042
1043
1044
1045

1046
1047
1048
1049
1050
1051
1052
1038
1039
1040
1041
1042
1043
1044

1045
1046
1047
1048
1049
1050
1051
1052







-
+







    proc accept {s a p} {
	global x
	set x [fconfigure $s -sockname]
	close $s
    }
    set s1 [tls::socket \
	-certfile $clientCert -cafile $caCert -keyfile $clientKey \
    	[info hostname] 8823]
    	localhost 8823]
    set timer [after 10000 "set x timed_out"]
    vwait x
    after cancel $timer
    close $s
    close $s1
    set l ""
    lappend l [lindex $x 2] [llength $x]
1091
1092
1093
1094
1095
1096
1097
1098

1099
1100
1101
1102
1103
1104
1105
1106
1107

1108
1109
1110
1111
1112
1113
1114
1091
1092
1093
1094
1095
1096
1097

1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115







-
+









+







	# Only OpenSSL 0.9.5a on Windows seems to need the after (delayed)
	# close, but it works just the same for all others. -hobbs
	after 500 close $s
	set x done
    }
    set s1 [tls::socket \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    -async [info hostname] 8830]
	    -async localhost 8830]
    # when doing an in-process client/server test, both sides need
    # to be non-blocking for the TLS handshake  Also make sure to
    # return the channel to line buffering mode (TLS sets it to 'none').
    fconfigure $s1 -blocking 0 -buffering line
    vwait x
    # TLS handshaking needs one byte from the client...
    puts $s1 a
    # need update to complete TLS handshake in-process
    update
    fconfigure $s1 -blocking 1
    set z [gets $s1]
    close $s
    close $s1
    set z
} bye

test tlsIO-9.1 {testing spurious events} {socket} {
1135
1136
1137
1138
1139
1140
1141
1142

1143
1144
1145
1146
1147
1148
1149
1136
1137
1138
1139
1140
1141
1142

1143
1144
1145
1146
1147
1148
1149
1150







-
+







		-buffering none]
    }
    set s [tls::socket \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
	    -server accept 8831]
    set c [tls::socket \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    [info hostname] 8831]
	    localhost 8831]
    # This differs from socket-9.1 in that both sides need to be
    # non-blocking because of TLS' required handshake
    fconfigure $c -blocking 0
    puts -nonewline $c 01234567890123456789012345678901234567890123456789
    close $c
    set timer [after 10000 "set done timed_out"]
    vwait done
1182
1183
1184
1185
1186
1187
1188
1189

1190
1191
1192
1193
1194
1195
1196
1183
1184
1185
1186
1187
1188
1189

1190
1191
1192
1193
1194
1195
1196
1197







-
+







	close $s
    }
    set s [tls::socket \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
	    -server accept 8832]
    set c [tls::socket \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    [info hostname] 8832]
	    localhost 8832]
    fconfigure $c -blocking 0 -trans lf -buffering line
    set count 0
    puts $c hello
    proc readit {s} {
	global count done
	set data [read $s]
	dputs "read \"[string replace $data 10 end-3 ...]\" \
1243
1244
1245
1246
1247
1248
1249
1250

1251
1252
1253
1254
1255
1256
1257
1244
1245
1246
1247
1248
1249
1250

1251
1252
1253
1254
1255
1256
1257
1258







-
+







		-buffering line -translation lf]
    }
    set s [tls::socket \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
	    -server accept 8833]
    set c [tls::socket \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    [info hostname] 8833]
	    localhost 8833]
    fconfigure $c -blocking 0 -buffering line -translation lf
    fileevent $c readable "count_to_eof $c"
    set timer [after 2000 timerproc]
    vwait done
    close $s
    set count
} {eof is sticky}
2010
2011
2012
2013
2014
2015
2016
2017
2018

2019
2020
2021
2022


2023
2024
2025
2026
2027
2028
2029
2011
2012
2013
2014
2015
2016
2017


2018
2019



2020
2021
2022
2023
2024
2025
2026
2027
2028







-
-
+

-
-
-
+
+







	}
    }
    proc accept {s a p} {
	fconfigure $s -blocking 0
	fileevent $s readable [list do_handshake $s readable readlittle \
		-buffering none]
    }
    set s [tls::socket \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
    set s [tls::socket -certfile $serverCert -cafile $caCert -keyfile $serverKey \
	    -server accept 8831]
    set c [tls::socket \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    [info hostname] 8831]
    set c [tls::socket -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    localhost 8831]
    # only the client gets tls::import
    set res [tls::unimport $c]
    list $res [catch {close $c} err] $err \
	[catch {close $s} err] $err
} {{} 0 {} 0 {}}

test tls-bug58-1.0 {test protocol negotiation failure} {socket} {
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048



2049
2050

2051
2052

2053
2054
2055
2056
2057
2058
2059


2060
2061
2062
2063
2064
2065
2066
2038
2039
2040
2041
2042
2043
2044



2045
2046
2047
2048

2049


2050

2051
2052
2053
2054
2055

2056
2057
2058
2059
2060
2061
2062
2063
2064







-
-
-
+
+
+

-
+
-
-
+
-





-
+
+







        set ::done $msg
    }
    # NOTE: when doing an in-process client/server test, both sides need
    # to be non-blocking for the TLS handshake

    # Server - Only accept TLS 1.2
    set s [tls::socket \
               -certfile $serverCert -cafile $caCert -keyfile $serverKey \
               -request 0 -require 0 -ssl2 0 -ssl3 0 -tls1 0 -tls1.1 0 -tls1.2 1 \
               -server Accept 8831]
        -certfile $serverCert -cafile $caCert -keyfile $serverKey -request 0 \
	-require 0 -ssl2 0 -ssl3 0 -tls1 0 -tls1.1 0 -tls1.2 1 -tls1.3 0 \
        -server Accept 8831]
    # Client - Only propose TLS1.0
    set c [tls::socket -async \
    set c [tls::socket -async -cafile $caCert -request 0 -require 0 \
               -cafile $caCert \
               -request 0 -require 0 -ssl2 0 -ssl3 0 -tls1 1 -tls1.1 0 -tls1.2 0 \
	-ssl2 0 -ssl3 0 -tls1 1 -tls1.1 0 -tls1.2 0 -tls1.3 0 localhost 8831]
               [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" {
        "handshake failed: wrong ssl version" -
        "handshake failed: unsupported protocol" {
            set ::done "handshake failed: wrong version number"
        }
    }
    set ::done
} {handshake failed: wrong version number}

# cleanup