︙ | | | ︙ | |
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
static Tcl_Mutex *locks = NULL;
static int locksCount = 0;
static Tcl_Mutex init_mx;
#endif /* OPENSSL_THREADS */
#endif /* TCL_THREADS */
/*
*-------------------------------------------------------------------
*
* InfoCallback --
*
* monitors SSL connection process
*
* Results:
* None
*
* Side effects:
* Calls callback (if defined)
*-------------------------------------------------------------------
*/
static void
InfoCallback(const SSL *ssl, int where, int ret) {
State *statePtr = (State*)SSL_get_app_data((SSL *)ssl);
Tcl_Obj *cmdPtr;
char *major; char *minor;
dprintf("Called");
if (statePtr->callback == (Tcl_Obj*)NULL)
return;
|
>
>
>
>
>
|
91
92
93
94
95
96
97
98
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
|
static Tcl_Mutex *locks = NULL;
static int locksCount = 0;
static Tcl_Mutex init_mx;
#endif /* OPENSSL_THREADS */
#endif /* TCL_THREADS */
/********************/
/* Callbacks */
/********************/
/*
*-------------------------------------------------------------------
*
* InfoCallback --
*
* monitors SSL connection process
*
* Results:
* None
*
* Side effects:
* Calls callback (if defined)
*-------------------------------------------------------------------
*/
static void
InfoCallback(const SSL *ssl, int where, int ret) {
State *statePtr = (State*)SSL_get_app_data((SSL *)ssl);
Tcl_Interp *interp = statePtr->interp;
Tcl_Obj *cmdPtr;
char *major; char *minor;
dprintf("Called");
if (statePtr->callback == (Tcl_Obj*)NULL)
return;
|
︙ | | | ︙ | |
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
|
if (where & SSL_CB_READ) minor = "read";
else if (where & SSL_CB_WRITE) minor = "write";
else if (where & SSL_CB_LOOP) minor = "loop";
else if (where & SSL_CB_EXIT) minor = "exit";
else minor = "unknown";
}
Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj("info", -1));
Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj(major, -1));
Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj(minor, -1));
if (where & (SSL_CB_LOOP|SSL_CB_EXIT)) {
Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
Tcl_NewStringObj(SSL_state_string_long(ssl), -1));
} else if (where & SSL_CB_ALERT) {
const char *cp = (char *) SSL_alert_desc_string_long(ret);
Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj(cp, -1));
} else {
Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
Tcl_NewStringObj(SSL_state_string_long(ssl), -1));
}
Tcl_Preserve((ClientData) statePtr->interp);
Tcl_Preserve((ClientData) statePtr);
Tcl_IncrRefCount(cmdPtr);
(void) Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(cmdPtr);
Tcl_Release((ClientData) statePtr);
Tcl_Release((ClientData) statePtr->interp);
}
/*
*-------------------------------------------------------------------
*
* VerifyCallback --
*
|
|
|
|
|
|
|
|
|
|
|
|
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
|
if (where & SSL_CB_READ) minor = "read";
else if (where & SSL_CB_WRITE) minor = "write";
else if (where & SSL_CB_LOOP) minor = "loop";
else if (where & SSL_CB_EXIT) minor = "exit";
else minor = "unknown";
}
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("info", -1));
Tcl_ListObjAppendElement(interp, cmdPtr,
Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(major, -1));
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(minor, -1));
if (where & (SSL_CB_LOOP|SSL_CB_EXIT)) {
Tcl_ListObjAppendElement(interp, cmdPtr,
Tcl_NewStringObj(SSL_state_string_long(ssl), -1));
} else if (where & SSL_CB_ALERT) {
const char *cp = (char *) SSL_alert_desc_string_long(ret);
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(cp, -1));
} else {
Tcl_ListObjAppendElement(interp, cmdPtr,
Tcl_NewStringObj(SSL_state_string_long(ssl), -1));
}
Tcl_Preserve((ClientData) interp);
Tcl_Preserve((ClientData) statePtr);
Tcl_IncrRefCount(cmdPtr);
(void) Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(cmdPtr);
Tcl_Release((ClientData) statePtr);
Tcl_Release((ClientData) interp);
}
/*
*-------------------------------------------------------------------
*
* VerifyCallback --
*
|
︙ | | | ︙ | |
203
204
205
206
207
208
209
210
211
212
213
214
215
216
|
VerifyCallback(int ok, X509_STORE_CTX *ctx) {
Tcl_Obj *cmdPtr, *result;
char *errStr, *string;
int length;
SSL *ssl = (SSL*)X509_STORE_CTX_get_ex_data(ctx, SSL_get_ex_data_X509_STORE_CTX_idx());
X509 *cert = X509_STORE_CTX_get_current_cert(ctx);
State *statePtr = (State*)SSL_get_app_data(ssl);
int depth = X509_STORE_CTX_get_error_depth(ctx);
int err = X509_STORE_CTX_get_error(ctx);
int code;
dprintf("Verify: %d", ok);
if (!ok) {
|
>
|
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
|
VerifyCallback(int ok, X509_STORE_CTX *ctx) {
Tcl_Obj *cmdPtr, *result;
char *errStr, *string;
int length;
SSL *ssl = (SSL*)X509_STORE_CTX_get_ex_data(ctx, SSL_get_ex_data_X509_STORE_CTX_idx());
X509 *cert = X509_STORE_CTX_get_current_cert(ctx);
State *statePtr = (State*)SSL_get_app_data(ssl);
Tcl_Interp *interp = statePtr->interp;
int depth = X509_STORE_CTX_get_error_depth(ctx);
int err = X509_STORE_CTX_get_error(ctx);
int code;
dprintf("Verify: %d", ok);
if (!ok) {
|
︙ | | | ︙ | |
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
|
return ok;
} else {
return 1;
}
}
cmdPtr = Tcl_DuplicateObj(statePtr->callback);
Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj("verify", -1));
Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewIntObj(depth));
Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tls_NewX509Obj(statePtr->interp, cert));
Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewIntObj(ok));
Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj(errStr ? errStr : "", -1));
Tcl_Preserve((ClientData) statePtr->interp);
Tcl_Preserve((ClientData) statePtr);
statePtr->flags |= TLS_TCL_CALLBACK;
Tcl_IncrRefCount(cmdPtr);
code = Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL);
if (code != TCL_OK) {
/* It got an error - reject the certificate. */
#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6)
Tcl_BackgroundError(statePtr->interp);
#else
Tcl_BackgroundException(statePtr->interp, code);
#endif
ok = 0;
} else {
result = Tcl_GetObjResult(statePtr->interp);
string = Tcl_GetStringFromObj(result, &length);
/* An empty result leaves verification unchanged. */
if (string != NULL && length > 0) {
code = Tcl_GetIntFromObj(statePtr->interp, result, &ok);
if (code != TCL_OK) {
#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6)
Tcl_BackgroundError(statePtr->interp);
#else
Tcl_BackgroundException(statePtr->interp, code);
#endif
ok = 0;
}
}
}
Tcl_DecrRefCount(cmdPtr);
statePtr->flags &= ~(TLS_TCL_CALLBACK);
Tcl_Release((ClientData) statePtr);
Tcl_Release((ClientData) statePtr->interp);
return(ok); /* By default, leave verification unchanged. */
}
/*
*-------------------------------------------------------------------
*
* Tls_Error --
*
* Calls callback with $fd and $msg - so the callback can decide
* what to do with errors.
*
* Side effects:
* The err field of the currently operative State is set
* to a string describing the SSL negotiation failure reason
*-------------------------------------------------------------------
*/
void
Tls_Error(State *statePtr, char *msg) {
Tcl_Obj *cmdPtr;
int code;
dprintf("Called");
if (msg && *msg) {
Tcl_SetErrorCode(statePtr->interp, "SSL", msg, (char *)NULL);
} else {
msg = Tcl_GetStringFromObj(Tcl_GetObjResult(statePtr->interp), NULL);
}
statePtr->err = msg;
if (statePtr->callback == (Tcl_Obj*)NULL) {
char buf[BUFSIZ];
sprintf(buf, "SSL channel \"%s\": error: %s",
Tcl_GetChannelName(statePtr->self), msg);
Tcl_SetResult(statePtr->interp, buf, TCL_VOLATILE);
#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6)
Tcl_BackgroundError(statePtr->interp);
#else
Tcl_BackgroundException(statePtr->interp, TCL_ERROR);
#endif
return;
}
cmdPtr = Tcl_DuplicateObj(statePtr->callback);
Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
Tcl_NewStringObj("error", -1));
Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
Tcl_NewStringObj(msg, -1));
Tcl_Preserve((ClientData) statePtr->interp);
Tcl_Preserve((ClientData) statePtr);
Tcl_IncrRefCount(cmdPtr);
code = Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL);
if (code != TCL_OK) {
#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6)
Tcl_BackgroundError(statePtr->interp);
#else
Tcl_BackgroundException(statePtr->interp, code);
#endif
}
Tcl_DecrRefCount(cmdPtr);
Tcl_Release((ClientData) statePtr);
Tcl_Release((ClientData) statePtr->interp);
}
void KeyLogCallback(const SSL *ssl, const char *line) {
char *str = getenv(SSLKEYLOGFILE);
FILE *fd;
if (str) {
fd = fopen(str, "a");
fprintf(fd, "%s\n",line);
fclose(fd);
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
|
|
|
|
<
|
<
|
<
<
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
|
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
|
return ok;
} else {
return 1;
}
}
cmdPtr = Tcl_DuplicateObj(statePtr->callback);
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("verify", -1));
Tcl_ListObjAppendElement(interp, cmdPtr,
Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(depth));
Tcl_ListObjAppendElement(interp, cmdPtr, Tls_NewX509Obj(interp, cert));
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(ok));
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(errStr ? errStr : "", -1));
Tcl_Preserve((ClientData) interp);
Tcl_Preserve((ClientData) statePtr);
statePtr->flags |= TLS_TCL_CALLBACK;
Tcl_IncrRefCount(cmdPtr);
code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
if (code != TCL_OK) {
/* It got an error - reject the certificate. */
#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6)
Tcl_BackgroundError(interp);
#else
Tcl_BackgroundException(interp, code);
#endif
ok = 0;
} else {
result = Tcl_GetObjResult(interp);
string = Tcl_GetStringFromObj(result, &length);
/* An empty result leaves verification unchanged. */
if (string != NULL && length > 0) {
code = Tcl_GetIntFromObj(interp, result, &ok);
if (code != TCL_OK) {
#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6)
Tcl_BackgroundError(interp);
#else
Tcl_BackgroundException(interp, code);
#endif
ok = 0;
}
}
}
Tcl_DecrRefCount(cmdPtr);
statePtr->flags &= ~(TLS_TCL_CALLBACK);
Tcl_Release((ClientData) statePtr);
Tcl_Release((ClientData) interp);
return(ok); /* By default, leave verification unchanged. */
}
/*
*-------------------------------------------------------------------
*
* Tls_Error --
*
* Calls callback with $fd and $msg - so the callback can decide
* what to do with errors.
*
* Side effects:
* The err field of the currently operative State is set
* to a string describing the SSL negotiation failure reason
*-------------------------------------------------------------------
*/
void
Tls_Error(State *statePtr, char *msg) {
Tcl_Interp *interp = statePtr->interp;
Tcl_Obj *cmdPtr;
int code;
dprintf("Called");
if (msg && *msg) {
Tcl_SetErrorCode(interp, "SSL", msg, (char *)NULL);
} else {
msg = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), NULL);
}
statePtr->err = msg;
if (statePtr->callback == (Tcl_Obj*)NULL) {
char buf[BUFSIZ];
sprintf(buf, "SSL channel \"%s\": error: %s",
Tcl_GetChannelName(statePtr->self), msg);
Tcl_SetResult(interp, buf, TCL_VOLATILE);
#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6)
Tcl_BackgroundError(interp);
#else
Tcl_BackgroundException(interp, TCL_ERROR);
#endif
return;
}
cmdPtr = Tcl_DuplicateObj(statePtr->callback);
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("error", -1));
Tcl_ListObjAppendElement(interp, cmdPtr,
Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(msg, -1));
Tcl_Preserve((ClientData) interp);
Tcl_Preserve((ClientData) statePtr);
Tcl_IncrRefCount(cmdPtr);
code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
if (code != TCL_OK) {
#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6)
Tcl_BackgroundError(interp);
#else
Tcl_BackgroundException(interp, code);
#endif
}
Tcl_DecrRefCount(cmdPtr);
Tcl_Release((ClientData) statePtr);
Tcl_Release((ClientData) interp);
}
/*
*-------------------------------------------------------------------
*
* KeyLogCallback --
*
* Write received key data to log file.
*
* Side effects:
* none
*-------------------------------------------------------------------
*/
void KeyLogCallback(const SSL *ssl, const char *line) {
char *str = getenv(SSLKEYLOGFILE);
FILE *fd;
if (str) {
fd = fopen(str, "a");
fprintf(fd, "%s\n",line);
fclose(fd);
|
︙ | | | ︙ | |
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
|
return 0;
cmdPtr = Tcl_DuplicateObj(statePtr->callback);
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj( "session", -1));
/* Session id */
session = SSL_get_session(statePtr->ssl);
session_id = SSL_SESSION_get0_id_context(session, &len);
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(session_id, len));
/* Session ticket */
SSL_SESSION_get0_ticket(session, &ticket, &len2);
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(ticket, (int)len2));
|
<
|
460
461
462
463
464
465
466
467
468
469
470
471
472
473
|
return 0;
cmdPtr = Tcl_DuplicateObj(statePtr->callback);
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj( "session", -1));
/* Session id */
session_id = SSL_SESSION_get0_id_context(session, &len);
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(session_id, len));
/* Session ticket */
SSL_SESSION_get0_ticket(session, &ticket, &len2);
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(ticket, (int)len2));
|
︙ | | | ︙ | |
477
478
479
480
481
482
483
484
485
486
487
488
489
490
|
Tcl_DecrRefCount(cmdPtr);
Tcl_Release((ClientData) statePtr);
Tcl_Release((ClientData) interp);
return 1;
}
/*
*-------------------------------------------------------------------
*
* CiphersObjCmd -- list available ciphers
*
* This procedure is invoked to process the "tls::ciphers" command
* to list available ciphers, based upon protocol selected.
|
>
>
>
>
|
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
|
Tcl_DecrRefCount(cmdPtr);
Tcl_Release((ClientData) statePtr);
Tcl_Release((ClientData) interp);
return 1;
}
/********************/
/* Commands */
/********************/
/*
*-------------------------------------------------------------------
*
* CiphersObjCmd -- list available ciphers
*
* This procedure is invoked to process the "tls::ciphers" command
* to list available ciphers, based upon protocol selected.
|
︙ | | | ︙ | |
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
|
}
chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
if (chan == (Tcl_Channel) NULL) {
return(TCL_ERROR);
}
/*
* Make sure to operate on the topmost channel
*/
chan = Tcl_GetTopChannel(chan);
if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan), "\": not a TLS channel", NULL);
return(TCL_ERROR);
}
statePtr = (State *)Tcl_GetChannelInstanceData(chan);
|
<
|
<
|
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
|
}
chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
if (chan == (Tcl_Channel) NULL) {
return(TCL_ERROR);
}
/* Make sure to operate on the topmost channel */
chan = Tcl_GetTopChannel(chan);
if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan), "\": not a TLS channel", NULL);
return(TCL_ERROR);
}
statePtr = (State *)Tcl_GetChannelInstanceData(chan);
|
︙ | | | ︙ | |
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
|
}
chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
/*
* Make sure to operate on the topmost channel
*/
chan = Tcl_GetTopChannel(chan);
for (idx = 2; idx < objc; idx++) {
char *opt = Tcl_GetStringFromObj(objv[idx], NULL);
if (opt[0] != '-')
break;
|
<
|
<
|
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
|
}
chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
/* Make sure to operate on the topmost channel */
chan = Tcl_GetTopChannel(chan);
for (idx = 2; idx < objc; idx++) {
char *opt = Tcl_GetStringFromObj(objv[idx], NULL);
if (opt[0] != '-')
break;
|
︙ | | | ︙ | |
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
|
}
chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
/*
* Make sure to operate on the topmost channel
*/
chan = Tcl_GetTopChannel(chan);
if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
"\": not a TLS channel", NULL);
return TCL_ERROR;
}
|
<
|
<
|
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
|
}
chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
/* Make sure to operate on the topmost channel */
chan = Tcl_GetTopChannel(chan);
if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
"\": not a TLS channel", NULL);
return TCL_ERROR;
}
|
︙ | | | ︙ | |
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
|
return TCL_ERROR;
}
chan = Tcl_GetChannel(interp, channelName, &mode);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
/*
* Make sure to operate on the topmost channel
*/
chan = Tcl_GetTopChannel(chan);
if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
"\": not a TLS channel", NULL);
return TCL_ERROR;
}
statePtr = (State *) Tcl_GetChannelInstanceData(chan);
|
<
|
<
|
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
|
return TCL_ERROR;
}
chan = Tcl_GetChannel(interp, channelName, &mode);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
/* Make sure to operate on the topmost channel */
chan = Tcl_GetTopChannel(chan);
if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
"\": not a TLS channel", NULL);
return TCL_ERROR;
}
statePtr = (State *) Tcl_GetChannelInstanceData(chan);
|
︙ | | | ︙ | |
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
|
}
chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
if (chan == (Tcl_Channel) NULL) {
return(TCL_ERROR);
}
/*
* Make sure to operate on the topmost channel
*/
chan = Tcl_GetTopChannel(chan);
if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan), "\": not a TLS channel", NULL);
return(TCL_ERROR);
}
objPtr = Tcl_NewListObj(0, NULL);
/* Get connection state */
statePtr = (State *)Tcl_GetChannelInstanceData(chan);
ssl = statePtr->ssl;
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("state", -1));
if (SSL_is_init_finished(ssl)) {
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("established", -1));
} else if (SSL_in_init(ssl)) {
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("handshake", -1));
} else {
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("initializing", -1));
}
/* Get server name */
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("servername", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_servername(ssl, TLSEXT_NAMETYPE_host_name), -1));
/* Get protocol */
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("protocol", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_version(ssl), -1));
/* Get security level */
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("securitylevel", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_get_security_level(ssl)));
/* Get cipher */
cipher = SSL_get_current_cipher(ssl);
if (cipher != NULL) {
char buf[BUFSIZ] = {0};
int bits, alg_bits;
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("cipher", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_CIPHER_get_name(cipher), -1));
|
<
|
<
|
>
>
|
>
|
|
|
|
|
|
|
>
>
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
|
|
|
|
>
|
|
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
|
}
chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
if (chan == (Tcl_Channel) NULL) {
return(TCL_ERROR);
}
/* Make sure to operate on the topmost channel */
chan = Tcl_GetTopChannel(chan);
if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan), "\": not a TLS channel", NULL);
return(TCL_ERROR);
}
objPtr = Tcl_NewListObj(0, NULL);
/* Connection info */
statePtr = (State *)Tcl_GetChannelInstanceData(chan);
ssl = statePtr->ssl;
if (ssl != NULL) {
const char *state;
/* connection state */
if (SSL_is_init_finished(ssl)) {
state = "established";
} else if (SSL_in_init(ssl)) {
state = "handshake";
} else {
state = "initializing";
}
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("state", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(state, -1));
/* Get server name */
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("servername", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_servername(ssl, TLSEXT_NAMETYPE_host_name), -1));
/* Get protocol */
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("protocol", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_version(ssl), -1));
/* Renegotiation allowed */
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("renegotiation", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(
SSL_get_secure_renegotiation_support(ssl) ? "allowed" : "not supported", -1));
/* Report the selected protocol as a result of the ALPN negotiation */
SSL_get0_alpn_selected(ssl, &proto, &len);
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("alpn", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj((char *)proto, (int)len));
/* Get security level */
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("securitylevel", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_get_security_level(ssl)));
}
/* Cipher info */
cipher = SSL_get_current_cipher(ssl);
if (cipher != NULL) {
char buf[BUFSIZ] = {0};
int bits, alg_bits;
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("cipher", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_CIPHER_get_name(cipher), -1));
|
︙ | | | ︙ | |
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
|
if (SSL_CIPHER_description(cipher, buf, sizeof(buf)) != NULL) {
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("description", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(buf, -1));
}
}
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("renegotiation", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(
SSL_get_secure_renegotiation_support(ssl) ? "allowed" : "not supported", -1));
/* Report the selected protocol as a result of the negotiation */
SSL_get0_alpn_selected(ssl, &proto, &len);
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("alpn", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj((char *)proto, (int)len));
/* Session info */
session = SSL_get_session(ssl);
if (session != NULL) {
const unsigned char *ticket;
size_t len2;
const unsigned char *session_id;
|
<
<
<
<
<
<
<
<
<
|
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
|
if (SSL_CIPHER_description(cipher, buf, sizeof(buf)) != NULL) {
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("description", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(buf, -1));
}
}
/* Session info */
session = SSL_get_session(ssl);
if (session != NULL) {
const unsigned char *ticket;
size_t len2;
const unsigned char *session_id;
|
︙ | | | ︙ | |
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
|
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewLongObj(SSL_SESSION_get_timeout(session)));
}
#if defined(HAVE_SSL_COMPRESSION)
/* Compression info */
comp = SSL_get_current_compression(ssl);
if (comp != NULL) {
expansion = SSL_get_current_expansion(ssl);
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("compression", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_COMP_get_name(comp), -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("expansion", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_COMP_get_name(expansion), -1));
}
#endif
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
clientData = clientData;
}
|
<
>
|
|
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
|
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewLongObj(SSL_SESSION_get_timeout(session)));
}
#if defined(HAVE_SSL_COMPRESSION)
/* Compression info */
comp = SSL_get_current_compression(ssl);
if (comp != NULL) {
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("compression", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_COMP_get_name(comp), -1));
comp = SSL_get_current_expansion(ssl);
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("expansion", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_COMP_get_name(comp), -1));
}
#endif
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
clientData = clientData;
}
|
︙ | | | ︙ | |
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
|
default:
break;
}
return TCL_OK;
clientData = clientData;
}
/*
*-------------------------------------------------------------------
*
* Tls_Free --
*
* This procedure cleans up when a SSL socket based channel
* is closed and its reference count falls below 1
|
>
>
>
>
|
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
|
default:
break;
}
return TCL_OK;
clientData = clientData;
}
/********************/
/* Init */
/********************/
/*
*-------------------------------------------------------------------
*
* Tls_Free --
*
* This procedure cleans up when a SSL socket based channel
* is closed and its reference count falls below 1
|
︙ | | | ︙ | |