Overview
Comment: | More TCL9 updates |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | tls-1.8 |
Files: | files | file ages | folders |
SHA3-256: |
ea36bcf6c4a1218a4ac8508a78d221e4 |
User & Date: | bohagan on 2024-10-25 05:13:44 |
Other Links: | branch diff | manifest | tags |
Context
2024-10-26
| ||
16:08 | Removed extra padding, convert spaces to tabs, etc. check-in: 1ef3d3faef user: bohagan tags: tls-1.8 | |
2024-10-25
| ||
05:13 | More TCL9 updates check-in: ea36bcf6c4 user: bohagan tags: tls-1.8 | |
2024-10-05
| ||
17:46 | Changes to fix warnings check-in: c747afd200 user: bohagan tags: tls-1.8 | |
Changes
Deleted build/update-wiki-docs version [05d1cbbcf4].
Added build/update-wiki-docs.sh version [05d1cbbcf4].
Modified generic/tls.c
from [25bb520bd7]
to [08752c37a7].
︙ | ︙ | |||
952 953 954 955 956 957 958 | static int CiphersObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *objPtr = NULL; SSL_CTX *ctx = NULL; SSL *ssl = NULL; STACK_OF(SSL_CIPHER) *sk; char buf[BUFSIZ]; | > | | 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 | static int CiphersObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *objPtr = NULL; SSL_CTX *ctx = NULL; SSL *ssl = NULL; STACK_OF(SSL_CIPHER) *sk; char buf[BUFSIZ]; Tcl_Size index; int verbose = 0, use_supported = 0; const SSL_METHOD *method; (void) clientData; dprintf("Called"); if ((objc < 2) || (objc > 4)) { Tcl_WrongNumArgs(interp, 1, objv, "protocol ?verbose? ?supported?"); |
︙ | ︙ |
Modified generic/tlsX509.c
from [3dbab23885]
to [9f6686e000].
︙ | ︙ | |||
33 34 35 36 37 38 39 | * None * *----------------------------------------------------------------------------- */ Tcl_Obj *String_to_Hex(unsigned char* input, int ilen) { unsigned char *iptr = input; Tcl_Obj *resultObj = Tcl_NewByteArrayObj(NULL, 0); | | | 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 | * None * *----------------------------------------------------------------------------- */ Tcl_Obj *String_to_Hex(unsigned char* input, int ilen) { unsigned char *iptr = input; Tcl_Obj *resultObj = Tcl_NewByteArrayObj(NULL, 0); unsigned char *data = Tcl_SetByteArrayLength(resultObj, (Tcl_Size)ilen*2); unsigned char *dptr = &data[0]; const char *hex = "0123456789abcdef"; if (resultObj == NULL) { return NULL; } |
︙ | ︙ | |||
524 525 526 527 528 529 530 | unsigned int ulen; uint32_t xflags; unsigned long flags = XN_FLAG_RFC2253 | ASN1_STRFLGS_UTF8_CONVERT; flags &= ~ASN1_STRFLGS_ESC_MSB; char *buffer = ckalloc(BUFSIZ > EVP_MAX_MD_SIZE ? BUFSIZ : EVP_MAX_MD_SIZE); | | | 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 | unsigned int ulen; uint32_t xflags; unsigned long flags = XN_FLAG_RFC2253 | ASN1_STRFLGS_UTF8_CONVERT; flags &= ~ASN1_STRFLGS_ESC_MSB; char *buffer = ckalloc(BUFSIZ > EVP_MAX_MD_SIZE ? BUFSIZ : EVP_MAX_MD_SIZE); dprintf("Called"); if (interp == NULL || cert == NULL || bio == NULL || resultObj == NULL || buffer == NULL) { Tcl_DecrRefCount(resultObj); BIO_free(bio); if (buffer != NULL) ckfree(buffer); return NULL; } |
︙ | ︙ |
Modified library/tls.tcl
from [746b446198]
to [e92fa9f6e0].
︙ | ︙ | |||
327 328 329 330 331 332 333 | log 0 "TLS/$chan: error: $msg" } "info" { set type "" lassign $args major minor msg type | | | 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 | log 0 "TLS/$chan: error: $msg" } "info" { set type "" lassign $args major minor msg type if {$msg ne ""} { append state ": $msg" } # For tracing upvar #0 tls::$chan cb set cb($major) $minor log 2 "TLS/$chan: $major/$minor: $state" |
︙ | ︙ | |||
383 384 385 386 387 388 389 | log 0 "TLS/$chan: sni: $servername" } "verify" { lassign $args depth cert rc err array set c $cert | | | 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 | log 0 "TLS/$chan: sni: $servername" } "verify" { lassign $args depth cert rc err array set c $cert if {$rc ne "1"} { log 1 "TLS/$chan: verify/$depth: Bad Cert: $err (rc = $rc)" } else { log 2 "TLS/$chan: verify/$depth: $c(subject)" } if {$debug > 0} { return 1; # FORCE OK } else { |
︙ | ︙ | |||
406 407 408 409 410 411 412 | return 1 } proc tls::xhandshake {chan} { upvar #0 tls::$chan cb if {[info exists cb(handshake)] && \ | | | 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 | return 1 } proc tls::xhandshake {chan} { upvar #0 tls::$chan cb if {[info exists cb(handshake)] && \ $cb(handshake) eq "done"} { return 1 } while {1} { vwait tls::${chan}(handshake) if {![info exists cb(handshake)]} { return 0 } |
︙ | ︙ | |||
430 431 432 433 434 435 436 | return "secret" } proc tls::log {level msg} { variable debug variable logcmd | | | 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 | return "secret" } proc tls::log {level msg} { variable debug variable logcmd if {$level > $debug || $logcmd eq ""} { return } set cmd $logcmd lappend cmd $msg uplevel #0 $cmd } |
Modified tests/common.tcl
from [95c47b8587]
to [c72eccfcd4].
1 2 3 4 5 6 7 | # Common Constraints package require tls # Supported protocols set protocols [list ssl2 ssl3 tls1 tls1.1 tls1.2 tls1.3] foreach protocol $protocols { | > | 1 2 3 4 5 6 7 8 | #!/usr/bin/env tclsh # Common Constraints package require tls # Supported protocols set protocols [list ssl2 ssl3 tls1 tls1.1 tls1.2 tls1.3] foreach protocol $protocols { |
︙ | ︙ |
Modified tests/oldTests/tls.tcl
from [97deb6d14e]
to [c06b0f18ff].
1 2 3 4 5 | # # Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com> # set dir [file dirname [info script]] regsub {\.} [info tclversion] {} vshort | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | # # Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com> # set dir [file dirname [info script]] regsub {\.} [info tclversion] {} vshort if {$tcl_platform(platform) eq "windows"} { if {[info exists tcl_platform(debug)]} { load $dir/../win/Debug$vshort/tls.dll } else { load $dir/../win/Release$vshort/tls.dll } } else { load [glob $dir/../unix/libtls*] |
︙ | ︙ |
Modified tests/oldTests/tlsAuto.tcl
from [b149b6351b]
to [d3a552645b].
︙ | ︙ | |||
13 14 15 16 17 18 19 | set ::/Exit 1 return } if {[eof $chan]} { close $chan set ::/Exit 1 } | | | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | set ::/Exit 1 return } if {[eof $chan]} { close $chan set ::/Exit 1 } if {$data ne ""} { puts -nonewline stderr "$data" } } proc doit {chan count {delay 1000}} { if {$count == 0} { close $chan set ::/Exit 0 |
︙ | ︙ |
Modified tests/oldTests/tlsSrv.tcl
from [cb7a0f8fc4]
to [bc3785cc8b].
︙ | ︙ | |||
16 17 18 19 20 21 22 | set x hello if {[catch {read $chan 1024} data]} { puts stderr "EOF ($data)" catch {close $chan} return } | | | 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | set x hello if {[catch {read $chan 1024} data]} { puts stderr "EOF ($data)" catch {close $chan} return } if {$verbose && $data ne ""} { puts -nonewline stderr $data } if {[eof $chan]} { ;# client gone or finished puts stderr "EOF" close $chan ;# release the servers client channel return } |
︙ | ︙ |
Modified tests/oldTests/tlsSrv2.tcl
from [94b6f94d30]
to [7fd9a576f0].
︙ | ︙ | |||
15 16 17 18 19 20 21 | proc reflectCB {chan {verbose 0}} { if {[catch {read $chan 1024} data]} { puts stderr "EOF ($data)" catch {close $chan} return } | | | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | proc reflectCB {chan {verbose 0}} { if {[catch {read $chan 1024} data]} { puts stderr "EOF ($data)" catch {close $chan} return } if {$verbose && $data ne ""} { puts -nonewline stderr $data } if {[eof $chan]} { ;# client gone or finished puts stderr "EOF" close $chan ;# release the servers client channel return } |
︙ | ︙ |
Modified tests/oldTests/tlsUpload.tcl
from [542de50b9a]
to [40bb4e56d8].
︙ | ︙ | |||
13 14 15 16 17 18 19 | set ::/Exit 1 return } if {[eof $chan]} { close $chan set ::/Exit 1 } | | | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | set ::/Exit 1 return } if {[eof $chan]} { close $chan set ::/Exit 1 } if {$data ne ""} { puts -nonewline stderr "$data" } } proc doit {chan count {delay 1000}} { if {$count == 0} { close $chan set ::/Exit 0 |
︙ | ︙ |
Modified tests/remote.tcl
from [b1e4530462]
to [ef6ea299d6].
1 2 3 4 5 6 7 | # This file contains Tcl code to implement a remote server that can be # used during testing of Tcl socket code. This server is used by some # of the tests in socket.test. # # Source this file in the remote server you are using to test Tcl against. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. | > | 1 2 3 4 5 6 7 8 | #!/usr/bin/env tclsh # This file contains Tcl code to implement a remote server that can be # used during testing of Tcl socket code. This server is used by some # of the tests in socket.test. # # Source this file in the remote server you are using to test Tcl against. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. |
︙ | ︙ | |||
56 57 58 59 60 61 62 | } } proc __readAndExecute__ {s} { global command VERBOSE set l [gets $s] | | | | 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 | } } proc __readAndExecute__ {s} { global command VERBOSE set l [gets $s] if {$l eq "--Marker--Marker--Marker--"} { if {[info exists command($s)]} { puts $s [list error incomplete_command] } puts $s "--Marker--Marker--Marker--" return } if {$l eq ""} { if {[eof $s]} { if {$VERBOSE} { puts "Server closing $s, eof from client" } close $s } return |
︙ | ︙ | |||
99 100 101 102 103 104 105 | tls::handshake $s fileevent $s readable [list __readAndExecute__ $s] fconfigure $s -buffering line -translation crlf } set serverIsSilent 0 for {set i 0} {$i < $argc} {incr i} { | | | | | 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 | tls::handshake $s fileevent $s readable [list __readAndExecute__ $s] fconfigure $s -buffering line -translation crlf } set serverIsSilent 0 for {set i 0} {$i < $argc} {incr i} { if {[lindex $argv $i] eq "-serverIsSilent"} { set serverIsSilent 1 break } } if {![info exists serverPort]} { if {[info exists env(serverPort)]} { set serverPort $env(serverPort) } } if {![info exists serverPort]} { for {set i 0} {$i < $argc} {incr i} { if {[lindex $argv $i] eq "-port"} { if {$i < [expr $argc - 1]} { set serverPort [lindex $argv [expr $i + 1]] } break } } } if {![info exists serverPort]} { set serverPort 8048 } if {![info exists serverAddress]} { if {[info exists env(serverAddress)]} { set serverAddress $env(serverAddress) } } if {![info exists serverAddress]} { for {set i 0} {$i < $argc} {incr i} { if {[lindex $argv $i] eq "-address"} { if {$i < [expr $argc - 1]} { set serverAddress [lindex $argv [expr $i + 1]] } break } } } |
︙ | ︙ |
Modified tests/simpleClient.tcl
from [38bd23a6f6]
to [0aeefa628c].
︙ | ︙ | |||
59 60 61 62 63 64 65 | global OPTS if {[catch {read $chan} data]} { #dputs "EOF $chan ([shortstr $data])" incr OPTS(openports) -1 catch {close $chan} return } | | | 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 | global OPTS if {[catch {read $chan} data]} { #dputs "EOF $chan ([shortstr $data])" incr OPTS(openports) -1 catch {close $chan} return } #if {$data ne ""} { dputs "got $chan ([shortstr $data])" } if {[string match *CLOSE\n $data]} { dputs "CLOSE $chan" incr OPTS(openports) -1 close $chan return } elseif {[eof $chan]} { # client gone or finished |
︙ | ︙ |
Modified tests/simpleServer.tcl
from [0490845ed9]
to [fb8deda5e8].
︙ | ︙ | |||
38 39 40 41 42 43 44 | # proc respond {chan} { if {[catch {read $chan} data]} { #dputs "EOF $chan ([shortstr $data)" catch {close $chan} return } | | | 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | # proc respond {chan} { if {[catch {read $chan} data]} { #dputs "EOF $chan ([shortstr $data)" catch {close $chan} return } #if {$data ne ""} { dputs "got $chan ([shortstr $data])" } if {[eof $chan]} { # client gone or finished dputs "EOF $chan" close $chan ;# release the port return } puts -nonewline $chan $data |
︙ | ︙ |
Modified tests/tlsIO.test
from [861c833723]
to [2979185eed].
︙ | ︙ | |||
83 84 85 86 87 88 89 | set caCert [file join $certsDir ca.pem] set serverKey [file join $certsDir server.key] set clientKey [file join $certsDir client.key] # Some tests require the testthread and exec commands set ::tcltest::testConstraints(testthread) \ | | | | 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 | set caCert [file join $certsDir ca.pem] set serverKey [file join $certsDir server.key] set clientKey [file join $certsDir client.key] # Some tests require the testthread and exec commands set ::tcltest::testConstraints(testthread) \ [expr {[info commands testthread] ne {}}] set ::tcltest::testConstraints(exec) [expr {[info commands exec] ne {}}] # # If remoteServerIP or remoteServerPort are not set, check in the # environment variables for externally set values. # if {![info exists remoteServerIP]} { |
︙ | ︙ | |||
117 118 119 120 121 122 123 | set ::do_handshake "eof" } elseif {[catch {tls::handshake $s} result]} { # Some errors are normal. dputs "handshake: $result" } elseif {$result == 1} { # Handshake complete if {[llength $args]} { eval [list fconfigure $s] $args } | | | | | 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 | set ::do_handshake "eof" } elseif {[catch {tls::handshake $s} result]} { # Some errors are normal. dputs "handshake: $result" } elseif {$result == 1} { # Handshake complete if {[llength $args]} { eval [list fconfigure $s] $args } if {$cmd eq ""} { fileevent $s $type "" } else { fileevent $s $type "$cmd [list $s]" } dputs "handshake: complete" set ::do_handshake "complete" } else { dputs "handshake: in progress" } } # # Check if we're supposed to do tests against the remote server # set doTestsWithRemoteServer 1 if {![info exists remoteServerIP] && ($tcl_platform(platform) ne "macintosh")} { set remoteServerIP 127.0.0.1 } if {($doTestsWithRemoteServer == 1) && (![info exists remoteServerPort])} { set remoteServerPort $tlsServerPort } # Attempt to connect to a remote server if one is already running. If it # is not running or for some other reason the connect fails, attempt to # start the remote server on the local host listening on port 8048. This # is only done on platforms that support exec (i.e. not on the Mac). On # platforms that do not support exec, the remote server must be started # by the user before running the tests. set remoteProcChan "" set commandSocket "" if {$doTestsWithRemoteServer} { catch {close $commandSocket} if {[catch {set commandSocket [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ $remoteServerIP $remoteServerPort]}] != 0} { if {[info commands exec] eq ""} { set noRemoteTestReason "can't exec" 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 \ |
︙ | ︙ | |||
220 221 222 223 224 225 226 | set resp "" while {1} { set line [gets $commandSocket] if {[eof $commandSocket]} { error "remote server disappeared" } | | | | 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 | set resp "" while {1} { set line [gets $commandSocket] if {[eof $commandSocket]} { error "remote server disappeared" } if {$line eq "--Marker--Marker--Marker--"} { if {[lindex $resp 0] eq "error"} { error [lindex $resp 1] } else { return [lindex $resp 1] } } else { append resp $line "\n" } |
︙ | ︙ | |||
1386 1387 1388 1389 1390 1391 1392 | } set f [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ $remoteServerIP 8836] fconfigure $f -translation crlf -buffering line for {set cnt 0} {$cnt < 50} {incr cnt} { puts $f "hello, $cnt" | | | | 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 | } set f [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ $remoteServerIP 8836] fconfigure $f -translation crlf -buffering line for {set cnt 0} {$cnt < 50} {incr cnt} { puts $f "hello, $cnt" if {[gets $f] ne "hello, $cnt"} { break } } close $f sendCommand {close $socket10_7_test_server} set cnt } 50 # Macintosh sockets can have more than one server per port if {$tcl_platform(platform) eq "macintosh"} { set conflictResult {0 8836} } else { set conflictResult {1 {couldn't open socket: address already in use}} } test tlsIO-11.6 {socket conflict} {socket doTestsWithRemoteServer} { set s1 [tls::socket \ |
︙ | ︙ | |||
1720 1721 1722 1723 1724 1725 1726 | # Read handler on the accepted socket. global x global failed set status [catch {read $file} data] if {$status != 0} { set x "read failed, error was $data" catch { close $file } | | | 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 | # Read handler on the accepted socket. global x global failed set status [catch {read $file} data] if {$status != 0} { set x "read failed, error was $data" catch { close $file } } elseif {$data ne {}} { } elseif {[fblocked $file]} { } elseif {[eof $file]} { if {$failed} { set x "$type socket was inherited" } else { set x "$type socket was not inherited" } |
︙ | ︙ |