Overview
Context
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
959
960
961
962
963
964
965
966
|
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 index, verbose = 0, use_supported = 0;
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
40
41
42
43
44
45
46
47
|
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, ilen*2);
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
531
532
533
534
535
536
537
538
|
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);
printf("Called\n");
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
334
335
336
337
338
339
340
341
|
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 != ""} {
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
390
391
392
393
394
395
396
397
|
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 != "1"} {
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
413
414
415
416
417
418
419
420
|
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) == "done"} {
$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
437
438
439
440
441
442
443
444
|
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 == ""} {
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
|
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
6
7
8
9
10
11
12
13
|
1
2
3
4
5
6
7
8
9
10
11
12
13
|
-
+
|
#
# Copyright (C) 1997-2000 Matt Newman <[email protected]>
#
set dir [file dirname [info script]]
regsub {\.} [info tclversion] {} vshort
if {$tcl_platform(platform) == "windows"} {
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
20
21
22
23
24
25
26
27
|
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 != ""} {
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
23
24
25
26
27
28
29
30
|
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 != ""} {
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
22
23
24
25
26
27
28
29
|
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 != ""} {
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
20
21
22
23
24
25
26
27
|
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 != ""} {
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
|
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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
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 {[string compare $l "--Marker--Marker--Marker--"] == 0} {
if {$l eq "--Marker--Marker--Marker--"} {
if {[info exists command($s)]} {
puts $s [list error incomplete_command]
}
puts $s "--Marker--Marker--Marker--"
return
}
if {[string compare $l ""] == 0} {
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
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
|
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 {[string compare -serverIsSilent [lindex $argv $i]] == 0} {
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 {[string compare -port [lindex $argv $i]] == 0} {
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 {[string compare -address [lindex $argv $i]] == 0} {
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
66
67
68
69
70
71
72
73
|
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 != ""} { dputs "got $chan ([shortstr $data])" }
#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
45
46
47
48
49
50
51
52
|
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 != ""} { dputs "got $chan ([shortstr $data])" }
#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
90
91
92
93
94
95
96
97
98
|
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] != {}}]
set ::tcltest::testConstraints(exec) [expr {[info commands exec] != {}}]
[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
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
|
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 == ""} {
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) != "macintosh")} {
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] == ""} {
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
227
228
229
230
231
232
233
234
235
|
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 {[string compare $line "--Marker--Marker--Marker--"] == 0} {
if {[string compare [lindex $resp 0] error] == 0} {
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
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
|
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 {[string compare [gets $f] "hello, $cnt"] != 0} {
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) == "macintosh"} {
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
1727
1728
1729
1730
1731
1732
1733
1734
|
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 {[string compare {} $data]} {
} 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"
}
|
| ︙ | | |