1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
|
-
+
|
/*
* Copyright (C) 1997-1999 Matt Newman <matt@novadigm.com>
* some modifications:
* Copyright (C) 2000 Ajuba Solutions
* Copyright (C) 2002 ActiveState Corporation
* Copyright (C) 2004 Starfish Systems
*
* $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.28 2008/03/19 19:59:40 hobbs2 Exp $
* $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.29 2008/03/19 21:31:24 hobbs2 Exp $
*
* TLS (aka SSL) Channel - can be layered on any bi-directional
* Tcl_Channel (Note: Requires Trf Core Patch)
*
* This was built (almost) from scratch based upon observation of
* OpenSSL 0.9.2B
*
|
| ︙ | | |
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
|
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
|
-
+
|
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_GlobalEvalObj(statePtr->interp, cmdPtr);
(void) Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount( cmdPtr);
Tcl_Release( (ClientData) statePtr);
Tcl_Release( (ClientData) statePtr->interp);
}
|
| ︙ | | |
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
|
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
|
-
+
|
Tcl_Preserve( (ClientData) statePtr->interp);
Tcl_Preserve( (ClientData) statePtr);
statePtr->flags |= TLS_TCL_CALLBACK;
Tcl_IncrRefCount( cmdPtr);
if (Tcl_GlobalEvalObj(statePtr->interp, cmdPtr) != TCL_OK) {
if (Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {
/* It got an error - reject the certificate. */
Tcl_BackgroundError( statePtr->interp);
ok = 0;
} else {
result = Tcl_GetObjResult(statePtr->interp);
string = Tcl_GetStringFromObj(result, &length);
/* An empty result leaves verification unchanged. */
|
| ︙ | | |
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
|
-
+
|
Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
Tcl_NewStringObj(msg, -1));
Tcl_Preserve((ClientData) statePtr->interp);
Tcl_Preserve((ClientData) statePtr);
Tcl_IncrRefCount(cmdPtr);
if (Tcl_GlobalEvalObj(statePtr->interp, cmdPtr) != TCL_OK) {
if (Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {
Tcl_BackgroundError(statePtr->interp);
}
Tcl_DecrRefCount(cmdPtr);
Tcl_Release((ClientData) statePtr);
Tcl_Release((ClientData) statePtr->interp);
}
|
| ︙ | | |
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
|
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
|
-
+
+
-
+
|
{
State *statePtr = (State *) udata;
Tcl_Interp *interp = statePtr->interp;
Tcl_Obj *cmdPtr;
int result;
if (statePtr->password == NULL) {
if (Tcl_Eval(interp, "tls::password") == TCL_OK) {
if (Tcl_EvalEx(interp, "tls::password", -1, TCL_EVAL_GLOBAL)
== TCL_OK) {
char *ret = (char *) Tcl_GetStringResult(interp);
strncpy(buf, ret, (size_t) size);
return (int)strlen(ret);
} else {
return -1;
}
}
cmdPtr = Tcl_DuplicateObj(statePtr->password);
Tcl_Preserve((ClientData) statePtr->interp);
Tcl_Preserve((ClientData) statePtr);
Tcl_IncrRefCount(cmdPtr);
result = Tcl_GlobalEvalObj(interp, cmdPtr);
result = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
if (result != TCL_OK) {
Tcl_BackgroundError(statePtr->interp);
}
Tcl_DecrRefCount(cmdPtr);
Tcl_Release((ClientData) statePtr);
Tcl_Release((ClientData) statePtr->interp);
|
| ︙ | | |
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
|
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
|
-
+
|
Tcl_Obj *CONST objv[];
{
Tcl_Channel chan; /* The channel to set a mode on. */
State *statePtr; /* client state for ssl socket */
SSL_CTX *ctx = NULL;
Tcl_Obj *script = NULL;
Tcl_Obj *password = NULL;
int idx;
int idx, len;
int flags = TLS_TCL_INIT;
int server = 0; /* is connection incoming or outgoing? */
char *key = NULL;
char *cert = NULL;
char *ciphers = NULL;
char *CAfile = NULL;
char *CAdir = NULL;
|
| ︙ | | |
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
|
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
|
-
-
-
+
+
+
-
-
-
+
+
+
|
statePtr->flags = flags;
statePtr->interp = interp;
statePtr->vflags = verify;
statePtr->err = "";
/* allocate script */
if (script) {
char *tmp = Tcl_GetStringFromObj(script, NULL);
if (tmp && *tmp) {
statePtr->callback = Tcl_DuplicateObj(script);
(void) Tcl_GetStringFromObj(script, &len);
if (len) {
statePtr->callback = script;
Tcl_IncrRefCount(statePtr->callback);
}
}
/* allocate password */
if (password) {
char *tmp = Tcl_GetStringFromObj(password, NULL);
if (tmp && *tmp) {
statePtr->password = Tcl_DuplicateObj(password);
(void) Tcl_GetStringFromObj(password, &len);
if (len) {
statePtr->password = password;
Tcl_IncrRefCount(statePtr->password);
}
}
if (model != NULL) {
int mode;
/* Get the "model" context */
|
| ︙ | | |
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
|
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
|
-
+
|
Tcl_GetChannelName(chan), "\": not a TLS channel", NULL);
Tls_Free((char *) statePtr);
return TCL_ERROR;
}
ctx = ((State *)Tcl_GetChannelInstanceData(chan))->ctx;
} else {
if ((ctx = CTX_Init(statePtr, proto, key, cert, CAdir, CAfile, ciphers))
== (SSL_CTX*)0) {
== (SSL_CTX*)0) {
Tls_Free((char *) statePtr);
return TCL_ERROR;
}
}
statePtr->ctx = ctx;
|
| ︙ | | |