Check-in [913359443b]
Overview
Comment:TlsIO.test Hostname Fix. Patch by Sergei Golovan (Debian) to make the client socket connect to localhost instead of [info hostname] to prevent intermittent test failures inside mock(1). Also, account for a change in error message "unsupported protocol" instead of "wrong version number". -- Sergei Golovan <email address hidden> Thu, 18 Jul 2019 15:00:18 +0300 Source: https://sources.debian.org/src/tcltls/1.7.22-3/debian/patches/hostname-tests.patch
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | nijtmans
Files: files | file ages | folders
SHA3-256: 913359443b86c3fb4868574499f404971540f3f6975818b5f5bef30ffbfd944d
User & Date: jan.nijtmans on 2024-02-22 07:52:22
Other Links: branch diff | manifest | tags
Context
2024-02-22
07:56
Applied patch to add OpenSSL3 KTLS trivial processing. Description: Patch adds trivial processing for BIO_CTRL_GET_KTLS_SEND and BIO_CTRL_GET_KTLS_RECV control commands to make tcltls working with OpenSSL 3.0. See also: - https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=1006587 - https://bugzilla.redhat.com/show_bug.cgi?id=2088363 Source: https://sources.debian.org/src/tcltls/1.7.22-3/debian/patches/openssl3.patch check-in: 0f781794ab user: jan.nijtmans tags: nijtmans
07:52
TlsIO.test Hostname Fix. Patch by Sergei Golovan (Debian) to make the client socket connect to localhost instead of [info hostname] to prevent intermittent test failures inside mock(1). Also, account for a change in error message "unsupported protocol" instead of "wrong version number". -- Sergei Golovan <email address hidden> Thu, 18 Jul 2019 15:00:18 +0300 Source: https://sources.debian.org/src/tcltls/1.7.22-3/debian/patches/hostname-tests.patch check-in: 913359443b user: jan.nijtmans tags: nijtmans
07:35
Patch by Sergei Golovan (Debian) to replace 1024 bit certificates with 2048 bit ones because the new OpenSSL refuses to load small keys ("ee key too small"). Source: https://sources.debian.org/src/tcltls/1.7.22-3/debian/patches/certs-tests.patch check-in: fecca6f35e user: jan.nijtmans tags: nijtmans
Changes
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
	chan = Tls_GetParent((State *) BIO_get_data(bio), 0);

	dprintf("BioCtrl(%p, 0x%x, 0x%lx, %p)", bio, cmd, num, ptr);

	switch (cmd) {
		case BIO_CTRL_RESET:
			dprintf("Got BIO_CTRL_RESET");
			num = 0;
			ret = 0;
			break;
		case BIO_C_FILE_SEEK:
			dprintf("Got BIO_C_FILE_SEEK");
			ret = 0;
			break;
		case BIO_C_FILE_TELL:







<







227
228
229
230
231
232
233

234
235
236
237
238
239
240
	chan = Tls_GetParent((State *) BIO_get_data(bio), 0);

	dprintf("BioCtrl(%p, 0x%x, 0x%lx, %p)", bio, cmd, num, ptr);

	switch (cmd) {
		case BIO_CTRL_RESET:
			dprintf("Got BIO_CTRL_RESET");

			ret = 0;
			break;
		case BIO_C_FILE_SEEK:
			dprintf("Got BIO_C_FILE_SEEK");
			ret = 0;
			break;
		case BIO_C_FILE_TELL:
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 {
	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]
    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
        lappend x [gets $f]
        close $sock
    }







|
















|







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 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]
    gets $f x
    if {[catch {tls::socket -certfile $clientCert -cafile $caCert \
	-keyfile $clientKey localhost 8831} sock]} {
        set x $sock
    } else {
        puts $sock hello
	flush $sock
        lappend x [gets $f]
        close $sock
    }
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]
    close $cs

    vwait done
    after cancel $timer
    set done
} 1








|







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 localhost 8830]
    close $cs

    vwait done
    after cancel $timer
    set done
} 1

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







|







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 \
    	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
	# 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]
    # 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







|







1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
	# 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 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
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
		-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]
    # 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







|







1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
		-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 \
	    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
	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]
    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 ...]\" \







|







1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
	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 \
	    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
		-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]
    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}







|







1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
		-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 \
	    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}
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
		-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]
    # 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} {







|







2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
		-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 \
	    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} {
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059

2060
2061
2062
2063
2064
2065
2066
               -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]
    # Client - Only propose TLS1.0
    set c [tls::socket -async \
               -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







|





|
>







2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
               -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]
    # Client - Only propose TLS1.0
    set c [tls::socket -async \
               -cafile $caCert \
               -request 0 -require 0 -ssl2 0 -ssl3 0 -tls1 1 -tls1.1 0 -tls1.2 0 \
               localhost 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: unsupported protocol" {
            set ::done "handshake failed: wrong version number"
        }
    }
    set ::done
} {handshake failed: wrong version number}

# cleanup