TclTLS
Check-in [5804017ad3]
Login
HomeTimelineDownloadBrowse SourceBranchesTagsTicketsWiki
Overview
Comment:Use better Eval APIs, cleaner Tcl_Obj-handling.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 5804017ad34a29dc3c9cfbf8d31589252b9fb04a
User & Date: hobbs2 on 2008-03-19 21:31:24
Other Links: manifest | tags
Context
2008-03-19
22:06
* tests/tlsIO.test (tlsIO-14.*): Add tls::unimport for symmetry * tls.htm, tls.c (UnimportObjCmd): to tls::import. [Bug 1203273] check-in: 61890c4886 user: hobbs2 tags: trunk
21:31
Use better Eval APIs, cleaner Tcl_Obj-handling. check-in: 5804017ad3 user: hobbs2 tags: trunk
19:59
* tls.c (Tls_Clean, ImportObjCmd): Fix cleanup mem leak [Bug 1414045] check-in: 8dd7366fcc user: hobbs2 tags: trunk
Changes
Side-by-Side Diff Ignore Whitespace Patch
Modified ChangeLog from [7fb55e6798] to [eaeb6e927e]. 
1
2
3

4
5
6
7
8
9
10

1
2
3
4
5
6
7
8
9
10
11




+








2008-03-19  Jeff Hobbs  <jeffh@ActiveState.com>

	* tls.c (Tls_Clean, ImportObjCmd): Fix cleanup mem leak [Bug 1414045]
	Use better Eval APIs, cleaner Tcl_Obj-handling.

2008-03-19  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* win/Makefile.vc  Updated the nmake build files with MSVC9 support
	* win/rules.vc:    and fixed to run the test-suite properly.
	* win/nmakehlp.c:
	* tls.tcl (tls::initlib): Corrected namespace handling.
︙
Modified tls.c from [ad0e17ca78] to [66ecdb7d9a]. 
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;
︙
Powered by Fossil · RSS