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: |
5804017ad34a29dc3c9cfbf8d3158925 |
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
Modified ChangeLog from [7fb55e6798] to [eaeb6e927e].
1 2 3 4 5 6 7 8 9 10 | 2008-03-19 Jeff Hobbs <[email protected]> * tls.c (Tls_Clean, ImportObjCmd): Fix cleanup mem leak [Bug 1414045] 2008-03-19 Pat Thoyts <[email protected]> * 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. | > | 1 2 3 4 5 6 7 8 9 10 11 | 2008-03-19 Jeff Hobbs <[email protected]> * tls.c (Tls_Clean, ImportObjCmd): Fix cleanup mem leak [Bug 1414045] Use better Eval APIs, cleaner Tcl_Obj-handling. 2008-03-19 Pat Thoyts <[email protected]> * 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 | /* * Copyright (C) 1997-1999 Matt Newman <[email protected]> * some modifications: * Copyright (C) 2000 Ajuba Solutions * Copyright (C) 2002 ActiveState Corporation * Copyright (C) 2004 Starfish Systems * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | /* * Copyright (C) 1997-1999 Matt Newman <[email protected]> * 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.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 | 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); | | | 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_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 | Tcl_Preserve( (ClientData) statePtr->interp); Tcl_Preserve( (ClientData) statePtr); statePtr->flags |= TLS_TCL_CALLBACK; Tcl_IncrRefCount( cmdPtr); | | | 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_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 | Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj(msg, -1)); Tcl_Preserve((ClientData) statePtr->interp); Tcl_Preserve((ClientData) statePtr); Tcl_IncrRefCount(cmdPtr); | | | 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_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 | { State *statePtr = (State *) udata; Tcl_Interp *interp = statePtr->interp; Tcl_Obj *cmdPtr; int result; if (statePtr->password == NULL) { | | > | | 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_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_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 | 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; | | | 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, 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 | statePtr->flags = flags; statePtr->interp = interp; statePtr->vflags = verify; statePtr->err = ""; /* allocate script */ if (script) { | | | | | | | | 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) { (void) Tcl_GetStringFromObj(script, &len); if (len) { statePtr->callback = script; Tcl_IncrRefCount(statePtr->callback); } } /* allocate password */ if (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 | 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)) | | | 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) { Tls_Free((char *) statePtr); return TCL_ERROR; } } statePtr->ctx = ctx; |
︙ | ︙ |