Index: ChangeLog ================================================================== --- ChangeLog +++ ChangeLog @@ -1,5 +1,20 @@ +2000-07-26 Jeff Hobbs + + * tls.c (ImportObjCmd): removed unnecessary use of 'bio' arg. + (Tls_Init): check return value of SSL_library_init. Also lots of + whitespace cleanup (more like Tcl Eng style guide), but not all + code was cleaned up. + + * tlsBIO.c: minor whitespace cleanup + + * tlsIO.c: minor whitespace cleanup. + (TlsInputProc, TlsOutputProc): Added ERR_clear_error before calls + to BIO_read or BIO_write, because we could otherwise end up + pulling an error off the stack that didn't belong to us. Also + cleanup up excessive use of gotos. + 2000-07-20 Jeff Hobbs * tests/tlsIO.test: corrected various tests to be correct for TLS stacked channels (as opposed to the standard sockets the test suite was adopted from). Key differences are that TLS cannot Index: tls.c ================================================================== --- tls.c +++ tls.c @@ -1,9 +1,9 @@ /* * Copyright (C) 1997-1999 Matt Newman * - * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.6.2.2 2000/07/21 05:32:56 hobbs Exp $ + * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.6.2.3 2000/07/26 22:15:07 hobbs 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 @@ -219,30 +219,32 @@ *------------------------------------------------------------------- */ static int VerifyCallback(int ok, X509_STORE_CTX *ctx) { - SSL *ssl = (SSL*)X509_STORE_CTX_get_app_data(ctx); - X509 *cert = X509_STORE_CTX_get_current_cert(ctx); - State *statePtr = (State*)SSL_get_app_data(ssl); Tcl_Obj *cmdPtr; - int depth = X509_STORE_CTX_get_error_depth(ctx); - int err = X509_STORE_CTX_get_error(ctx); char *errStr; + SSL *ssl = (SSL*)X509_STORE_CTX_get_app_data(ctx); + 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); dprintf(stderr, "Verify: %d\n", ok); - if (!ok) + if (!ok) { errStr = (char*)X509_verify_cert_error_string(err); - else + } else { errStr = (char *)0; + } if (statePtr->callback == (Tcl_Obj*)NULL) { - if (statePtr->vflags & SSL_VERIFY_FAIL_IF_NO_PEER_CERT) + if (statePtr->vflags & SSL_VERIFY_FAIL_IF_NO_PEER_CERT) { return ok; - else + } else { return 1; + } } cmdPtr = Tcl_DuplicateObj(statePtr->callback); Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, Tcl_NewStringObj( "verify", -1)); @@ -305,11 +307,11 @@ Tls_Error(State *statePtr, char *msg) { Tcl_Obj *cmdPtr; if (msg && *msg) { - Tcl_SetErrorCode( statePtr->interp, "SSL", msg, (char *)NULL); + Tcl_SetErrorCode(statePtr->interp, "SSL", msg, (char *)NULL); } else { msg = Tcl_GetStringFromObj(Tcl_GetObjResult(statePtr->interp), NULL); } statePtr->err = msg; @@ -321,30 +323,30 @@ Tcl_BackgroundError( statePtr->interp); 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); + 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); if (Tcl_GlobalEvalObj(statePtr->interp, cmdPtr) != TCL_OK) { - Tcl_BackgroundError( statePtr->interp); + Tcl_BackgroundError(statePtr->interp); } - Tcl_DecrRefCount( cmdPtr); + Tcl_DecrRefCount(cmdPtr); - Tcl_Release( (ClientData) statePtr); - Tcl_Release( (ClientData) statePtr->interp); + Tcl_Release((ClientData) statePtr); + Tcl_Release((ClientData) statePtr->interp); } /* *------------------------------------------------------------------- * @@ -457,18 +459,16 @@ #else ctx = SSL_CTX_new(TLSv1_method()); break; #endif } if (ctx == NULL) { - Tcl_AppendResult(interp, REASON(), - (char *) NULL); + Tcl_AppendResult(interp, REASON(), (char *) NULL); return TCL_ERROR; } ssl = SSL_new(ctx); if (ssl == NULL) { - Tcl_AppendResult(interp, REASON(), - (char *) NULL); + Tcl_AppendResult(interp, REASON(), (char *) NULL); SSL_CTX_free(ctx); return TCL_ERROR; } objPtr = Tcl_NewListObj( 0, NULL); @@ -570,10 +570,11 @@ Tcl_AppendResult(interp, "handshake failed: ", errStr, (char *) NULL); return TCL_ERROR; } } + Tcl_SetObjResult(interp, Tcl_NewIntObj(ret)); return TCL_OK; } /* @@ -600,23 +601,22 @@ Tcl_Interp *interp; int objc; Tcl_Obj *CONST objv[]; { Tcl_Channel chan; /* The channel to set a mode on. */ - BIO *bio; State *statePtr; /* client state for ssl socket */ - SSL_CTX *ctx = NULL; - Tcl_Obj *script = NULL; + SSL_CTX *ctx = NULL; + Tcl_Obj *script = NULL; int idx; - 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; - char *model = NULL; + 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; + char *model = NULL; #if defined(NO_SSL2) int ssl2 = 0; #else int ssl2 = 1; #endif @@ -672,80 +672,88 @@ OPTBAD( "option", "-cafile, -cadir, -certfile, -cipher, -command, -keyfile, -model, -require, -request, -ssl2, -ssl3, -server, or -tls1"); return TCL_ERROR; } - if (request) verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER; + if (request) verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER; if (request && require) verify |= SSL_VERIFY_FAIL_IF_NO_PEER_CERT; - if (verify == 0) verify = SSL_VERIFY_NONE; + if (verify == 0) verify = SSL_VERIFY_NONE; proto |= (ssl2 ? TLS_PROTO_SSL2 : 0); proto |= (ssl3 ? TLS_PROTO_SSL3 : 0); proto |= (tls1 ? TLS_PROTO_TLS1 : 0); /* reset to NULL if blank string provided */ - if (cert && !*cert) cert = NULL; - if (key && !*key) key = NULL; - if (ciphers && !*ciphers) ciphers = NULL; - if (CAfile && !*CAfile) CAfile = NULL; - if (CAdir && !*CAdir) CAdir = NULL; + if (cert && !*cert) cert = NULL; + if (key && !*key) key = NULL; + if (ciphers && !*ciphers) ciphers = NULL; + if (CAfile && !*CAfile) CAfile = NULL; + if (CAdir && !*CAdir) CAdir = NULL; if (model != NULL) { int mode; /* Get the "model" context */ - chan = Tcl_GetChannel( interp, model, &mode); - if (chan == (Tcl_Channel)0) { + chan = Tcl_GetChannel(interp, model, &mode); + if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } #ifdef TCL_CHANNEL_VERSION_2 /* * Make sure to operate on the topmost channel */ chan = Tcl_GetTopChannel(chan); #endif if (Tcl_GetChannelType(chan) != Tls_ChannelType()) { - Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan), - "\": not a TLS channel", NULL); + Tcl_AppendResult(interp, "bad channel \"", + Tcl_GetChannelName(chan), "\": not a TLS channel", NULL); return TCL_ERROR; } - statePtr = (State *)Tcl_GetChannelInstanceData( chan); + statePtr = (State *) Tcl_GetChannelInstanceData(chan); ctx = statePtr->ctx; } else { - if ((ctx = CTX_Init( interp, proto, key, cert, CAdir, CAfile, ciphers)) + if ((ctx = CTX_Init(interp, proto, key, cert, CAdir, CAfile, ciphers)) == (SSL_CTX*)0) { return TCL_ERROR; } } /* new SSL state */ - statePtr = (State *) Tcl_Alloc((unsigned) sizeof(State)); - statePtr->self = (Tcl_Channel)NULL; - statePtr->timer = (Tcl_TimerToken)NULL; - - statePtr->flags = flags; - statePtr->watchMask = 0; - statePtr->mode = 0; - - statePtr->interp = interp; - statePtr->callback = (Tcl_Obj *)0; - - statePtr->vflags = verify; - statePtr->ssl = (SSL*)0; - statePtr->ctx = ctx; - statePtr->bio = (BIO*)0; - statePtr->p_bio = (BIO*)0; - - statePtr->err = ""; - + statePtr = (State *) Tcl_Alloc((unsigned) sizeof(State)); + statePtr->self = (Tcl_Channel)NULL; + statePtr->timer = (Tcl_TimerToken)NULL; + + statePtr->flags = flags; + statePtr->watchMask = 0; + statePtr->mode = 0; + + statePtr->interp = interp; + statePtr->callback = (Tcl_Obj *)0; + + statePtr->vflags = verify; + statePtr->ssl = (SSL*)0; + statePtr->ctx = ctx; + statePtr->bio = (BIO*)0; + statePtr->p_bio = (BIO*)0; + + statePtr->err = ""; + + /* + * We need to make sure that the channel works in binary (for the + * encryption not to get goofed up). + * We only want to adjust the buffering in pre-v2 channels, where + * each channel in the stack maintained its own buffers. + */ Tcl_SetChannelOption(interp, chan, "-translation", "binary"); +#ifndef TCL_CHANNEL_VERSION_2 Tcl_SetChannelOption(interp, chan, "-buffering", "none"); +#endif #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 2 statePtr->parent = chan; - statePtr->self = Tcl_ReplaceChannel( interp, - Tls_ChannelType(), (ClientData) statePtr, - (TCL_READABLE | TCL_WRITABLE), statePtr->parent); + statePtr->self = Tcl_ReplaceChannel(interp, + Tls_ChannelType(), (ClientData) statePtr, + (TCL_READABLE | TCL_WRITABLE), statePtr->parent); #else #ifdef TCL_CHANNEL_VERSION_2 statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(), (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE), chan); #else @@ -762,14 +770,14 @@ return TCL_ERROR; } /* allocate script */ if (script) { - char * tmp = Tcl_GetStringFromObj(script, NULL); + char *tmp = Tcl_GetStringFromObj(script, NULL); if (tmp && *tmp) { statePtr->callback = Tcl_DuplicateObj(script); - Tcl_IncrRefCount( statePtr->callback); + Tcl_IncrRefCount(statePtr->callback); } } /* This is only needed because of a bug in OpenSSL, where the * ssl->verify_callback is not referenced!!! (Must be done * *before* SSL_new() is called! @@ -781,13 +789,12 @@ */ statePtr->ssl = SSL_new(statePtr->ctx); if (!statePtr->ssl) { /* SSL library error */ - Tcl_AppendResult(interp, - "couldn't construct ssl session: ", REASON(), - (char *) NULL); + Tcl_AppendResult(interp, "couldn't construct ssl session: ", REASON(), + (char *) NULL); Tls_Free((char *) statePtr); return TCL_ERROR; } /* @@ -800,23 +807,23 @@ * The following is broken - we need is to set the * verify_mode, but the library ignores the verify_callback!!! */ /*SSL_set_verify(statePtr->ssl, verify, VerifyCallback);*/ - SSL_CTX_set_info_callback( statePtr->ctx, InfoCallback); + SSL_CTX_set_info_callback(statePtr->ctx, InfoCallback); /* Create Tcl_Channel BIO Handler */ - statePtr->p_bio = bio = BIO_new_tcl( statePtr, BIO_CLOSE); - statePtr->bio = BIO_new(BIO_f_ssl()); + statePtr->p_bio = BIO_new_tcl(statePtr, BIO_CLOSE); + statePtr->bio = BIO_new(BIO_f_ssl()); if (server) { statePtr->flags |= TLS_TCL_SERVER; SSL_set_accept_state(statePtr->ssl); } else { SSL_set_connect_state(statePtr->ssl); } - SSL_set_bio(statePtr->ssl, bio, bio); + SSL_set_bio(statePtr->ssl, statePtr->p_bio, statePtr->p_bio); BIO_set_ssl(statePtr->bio, statePtr->ssl, BIO_CLOSE); /* * End of SSL Init */ @@ -966,11 +973,11 @@ #if 0 Tcl_DStringFree(&ds); Tcl_DStringFree(&ds1); /* Don't currently care if this fails */ Tcl_AppendResult(interp, "SSL default verify paths: ", - REASON(), (char *) NULL); + REASON(), (char *) NULL); SSL_CTX_free(ctx); return (SSL_CTX *)0; #endif } SSL_CTX_set_client_CA_list(ctx, SSL_load_client_CA_file( F2N(CAfile, &ds) )); @@ -1011,12 +1018,12 @@ Tcl_WrongNumArgs(interp, 1, objv, "channel"); return TCL_ERROR; } channelName = Tcl_GetStringFromObj(objv[1], NULL); - chan = Tcl_GetChannel( interp, channelName, &mode); - if (chan == (Tcl_Channel)0) { + chan = Tcl_GetChannel(interp, channelName, &mode); + if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } #ifdef TCL_CHANNEL_VERSION_2 /* * Make sure to operate on the topmost channel @@ -1026,23 +1033,24 @@ 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); - peer = SSL_get_peer_certificate(statePtr->ssl); - if (peer) - objPtr = Tls_NewX509Obj( interp, peer); - else - objPtr = Tcl_NewListObj( 0, NULL); + statePtr = (State *) Tcl_GetChannelInstanceData(chan); + peer = SSL_get_peer_certificate(statePtr->ssl); + if (peer) { + objPtr = Tls_NewX509Obj(interp, peer); + } else { + objPtr = Tcl_NewListObj(0, NULL); + } ciphers = (char*)SSL_get_cipher(statePtr->ssl); if (ciphers != NULL && strcmp(ciphers, "(NONE)")!=0) { - Tcl_ListObjAppendElement( interp, objPtr, - Tcl_NewStringObj( "cipher", -1) ); - Tcl_ListObjAppendElement( interp, objPtr, - Tcl_NewStringObj( SSL_get_cipher(statePtr->ssl), -1) ); + Tcl_ListObjAppendElement(interp, objPtr, + Tcl_NewStringObj("cipher", -1)); + Tcl_ListObjAppendElement(interp, objPtr, + Tcl_NewStringObj(SSL_get_cipher(statePtr->ssl), -1)); } Tcl_SetObjResult( interp, objPtr); return TCL_OK; } @@ -1135,29 +1143,31 @@ #if TCL_MAJOR_VERSION >= 8 && TCL_MINOR_VERSION >= 2 if (!Tcl_InitStubs(interp, TCL_VERSION, 0)) { return TCL_ERROR; } #endif + if (SSL_library_init() != 1) { + Tcl_AppendResult(interp, "could not initialize SSL library", NULL); + return TCL_ERROR; + } SSL_load_error_strings(); ERR_load_crypto_strings(); - SSL_library_init(); - - Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd , (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); - - Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd , (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); - - Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd , (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); - - Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd , (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); + + Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, + (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + + Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd, + (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + + Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd, + (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + + Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, + (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); return Tcl_PkgProvide(interp, PACKAGE, VERSION); } - /* *------------------------------------------------------* * * Tls_SafeInit -- Index: tlsBIO.c ================================================================== --- tlsBIO.c +++ tlsBIO.c @@ -1,9 +1,9 @@ /* * Copyright (C) 1997-2000 Matt Newman * - * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsBIO.c,v 1.2.2.3 2000/07/21 05:32:57 hobbs Exp $ + * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsBIO.c,v 1.2.2.4 2000/07/26 22:15:07 hobbs Exp $ * * Provides BIO layer to interface openssl to Tcl. */ #include "tlsInt.h" @@ -36,14 +36,14 @@ State *statePtr; int flags; { BIO *bio; - bio = BIO_new(&BioMethods); - bio->ptr = (char*)statePtr; - bio->init = 1; - bio->shutdown = flags; + bio = BIO_new(&BioMethods); + bio->ptr = (char*)statePtr; + bio->init = 1; + bio->shutdown = flags; return bio; } BIO_METHOD * @@ -56,34 +56,35 @@ BioWrite (bio, buf, bufLen) BIO *bio; char *buf; int bufLen; { - Tcl_Channel chan = Tls_GetParent((State*)bio->ptr); + Tcl_Channel chan = Tls_GetParent((State*)(bio->ptr)); int ret; dprintf(stderr,"\nBioWrite(0x%x, , %d) [0x%x]", bio, bufLen, chan); #ifdef TCL_CHANNEL_VERSION_2 - ret = Tcl_WriteRaw( chan, buf, bufLen); + ret = Tcl_WriteRaw(chan, buf, bufLen); #else - ret = Tcl_Write( chan, buf, bufLen); + ret = Tcl_Write(chan, buf, bufLen); #endif dprintf(stderr,"\n[0x%x] BioWrite(%d) -> %d [%d.%d]", chan, bufLen, ret, - Tcl_Eof( chan), Tcl_GetErrno()); + Tcl_Eof(chan), Tcl_GetErrno()); BIO_clear_flags(bio, BIO_FLAGS_WRITE|BIO_FLAGS_SHOULD_RETRY); if (ret == 0) { - if (!Tcl_Eof( chan)) { + if (!Tcl_Eof(chan)) { BIO_set_retry_write(bio); ret = -1; } } - if (BIO_should_read(bio)) + if (BIO_should_read(bio)) { BIO_set_retry_read(bio); + } return ret; } static int BioRead (bio, buf, bufLen) @@ -97,37 +98,38 @@ dprintf(stderr,"\nBioRead(0x%x, , %d) [0x%x]", bio, bufLen, chan); if (buf == NULL) return 0; #ifdef TCL_CHANNEL_VERSION_2 - ret = Tcl_ReadRaw( chan, buf, bufLen); + ret = Tcl_ReadRaw(chan, buf, bufLen); #else - ret = Tcl_Read( chan, buf, bufLen); + ret = Tcl_Read(chan, buf, bufLen); #endif dprintf(stderr,"\n[0x%x] BioRead(%d) -> %d [%d.%d]", chan, bufLen, ret, - Tcl_Eof(chan), Tcl_GetErrno()); + Tcl_Eof(chan), Tcl_GetErrno()); BIO_clear_flags(bio, BIO_FLAGS_READ|BIO_FLAGS_SHOULD_RETRY); if (ret == 0) { - if (!Tcl_Eof( chan)) { + if (!Tcl_Eof(chan)) { BIO_set_retry_read(bio); ret = -1; } } - if (BIO_should_write(bio)) + if (BIO_should_write(bio)) { BIO_set_retry_write(bio); + } return ret; } static int BioPuts (bio, str) BIO *bio; char *str; { - return BioWrite( bio, str, strlen(str)); + return BioWrite(bio, str, strlen(str)); } static long BioCtrl (bio, cmd, num, ptr) BIO *bio; @@ -175,11 +177,11 @@ case BIO_CTRL_SET_CLOSE: bio->shutdown = (int)num; break; case BIO_CTRL_EOF: dprintf(stderr, "BIO_CTRL_EOF\n"); - ret = Tcl_Eof( chan); + ret = Tcl_Eof(chan); break; case BIO_CTRL_PENDING: ret = (Tcl_InputBuffered(chan) ? 1 : 0); dprintf(stderr, "BIO_CTRL_PENDING(%d)\n", ret); break; @@ -192,11 +194,11 @@ dprintf(stderr, "BIO_CTRL_FLUSH\n"); if ( #ifdef TCL_CHANNEL_VERSION_2 Tcl_WriteRaw(chan, "", 0) >= 0 #else - Tcl_Flush( chan) == TCL_OK + Tcl_Flush(chan) == TCL_OK #endif ) { ret = 1; } else { ret = -1; Index: tlsIO.c ================================================================== --- tlsIO.c +++ tlsIO.c @@ -1,9 +1,9 @@ /* * Copyright (C) 1997-2000 Matt Newman * - * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsIO.c,v 1.7.2.3 2000/07/21 05:32:57 hobbs Exp $ + * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsIO.c,v 1.7.2.4 2000/07/26 22:15:07 hobbs Exp $ * * TLS (aka SSL) Channel - can be layered on any bi-directional * Tcl_Channel (Note: Requires Trf Core Patch) * * This was built from scratch based upon observation of OpenSSL 0.9.2B @@ -166,11 +166,11 @@ Tcl_DeleteChannelHandler(Tls_GetParent(statePtr), TlsChannelHandler, (ClientData) statePtr); #endif Tls_Clean(statePtr); - Tcl_EventuallyFree( (ClientData)statePtr, Tls_Free); + Tcl_EventuallyFree((ClientData)statePtr, Tls_Free); return TCL_OK; } /* *------------------------------------------------------------------- @@ -191,14 +191,14 @@ *------------------------------------------------------------------- */ static int TlsInputProc(ClientData instanceData, /* Socket state. */ - char *buf, /* Where to store data read. */ - int bufSize, /* How much space is available - * in the buffer? */ - int *errorCodePtr) /* Where to store error code. */ + char *buf, /* Where to store data read. */ + int bufSize, /* How much space is available + * in the buffer? */ + int *errorCodePtr) /* Where to store error code. */ { State *statePtr = (State *) instanceData; int bytesRead; /* How many bytes were read? */ *errorCodePtr = 0; @@ -212,35 +212,44 @@ } } if (statePtr->flags & TLS_TCL_INIT) { statePtr->flags &= ~(TLS_TCL_INIT); } + /* + * We need to clear the SSL error stack now because we sometimes reach + * this function with leftover errors in the stack. If BIO_read + * returns -1 and intends EAGAIN, there is a leftover error, it will be + * misconstrued as an error, not EAGAIN. + * + * Alternatively, we may want to handle the <0 return codes from + * BIO_read specially (as advised in the RSA docs). TLS's lower level BIO + * functions play with the retry flags though, and this seems to work + * correctly. Similar fix in TlsOutputProc. - hobbs + */ + ERR_clear_error(); bytesRead = BIO_read(statePtr->bio, buf, bufSize); dprintf(stderr,"\nBIO_read -> %d", bytesRead); if (bytesRead < 0) { int err = SSL_get_error(statePtr->ssl, bytesRead); if (err == SSL_ERROR_SSL) { Tls_Error(statePtr, SSL_ERROR(statePtr->ssl, bytesRead)); *errorCodePtr = ECONNABORTED; - goto input; } else if (BIO_should_retry(statePtr->bio)) { dprintf(stderr,"RE! "); *errorCodePtr = EAGAIN; - goto input; - } - if (Tcl_GetErrno() == ECONNRESET) { - /* Soft EOF */ - bytesRead = 0; - goto input; } else { *errorCodePtr = Tcl_GetErrno(); - goto input; + if (*errorCodePtr == ECONNRESET) { + /* Soft EOF */ + *errorCodePtr = 0; + bytesRead = 0; + } } } -input: + input: dprintf(stderr, "\nInput(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr); return bytesRead; } /* @@ -261,20 +270,20 @@ *------------------------------------------------------------------- */ static int TlsOutputProc(ClientData instanceData, /* Socket state. */ - char *buf, /* The data buffer. */ + char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCodePtr) /* Where to store error code. */ { State *statePtr = (State *) instanceData; int written, err; *errorCodePtr = 0; - dprintf(stderr,"\nBIO_write(%d)", toWrite); + dprintf(stderr,"\nBIO_write(0x%x, %d)", statePtr, toWrite); if (!SSL_is_init_finished(statePtr->ssl)) { written = Tls_WaitForConnect(statePtr, errorCodePtr); if (written <= 0) { goto output; @@ -287,49 +296,63 @@ dprintf(stderr, "zero-write\n"); BIO_flush(statePtr->bio); written = 0; goto output; } else { + /* + * We need to clear the SSL error stack now because we sometimes reach + * this function with leftover errors in the stack. If BIO_write + * returns -1 and intends EAGAIN, there is a leftover error, it will be + * misconstrued as an error, not EAGAIN. + * + * Alternatively, we may want to handle the <0 return codes from + * BIO_write specially (as advised in the RSA docs). TLS's lower level + * BIO functions play with the retry flags though, and this seems to + * work correctly. Similar fix in TlsInputProc. - hobbs + */ + ERR_clear_error(); written = BIO_write(statePtr->bio, buf, toWrite); - dprintf(stderr,"\nBIO_write(%d) -> [%d]", toWrite, written); + dprintf(stderr,"\nBIO_write(0x%x, %d) -> [%d]", + statePtr, toWrite, written); } - if (written < 0 || written == 0) { + if (written <= 0) { switch ((err = SSL_get_error(statePtr->ssl, written))) { - case SSL_ERROR_NONE: - if (written <= 0) { - written = 0; - goto output; - } - break; - case SSL_ERROR_WANT_WRITE: - dprintf(stderr,"write W BLOCK\n"); - break; - case SSL_ERROR_WANT_READ: - dprintf(stderr,"write R BLOCK\n"); - break; - case SSL_ERROR_WANT_X509_LOOKUP: - dprintf(stderr,"write X BLOCK\n"); - break; - case SSL_ERROR_ZERO_RETURN: - dprintf(stderr,"closed\n"); - written = 0; - goto output; - case SSL_ERROR_SYSCALL: - *errorCodePtr = Tcl_GetErrno(); - dprintf(stderr,"[%d] syscall errr: %d\n", written, Tcl_GetErrno()); - written = -1; - goto output; - case SSL_ERROR_SSL: - Tls_Error(statePtr, SSL_ERROR(statePtr->ssl, written)); - *errorCodePtr = ECONNABORTED; - written = -1; - goto output; - default: - dprintf(stderr,"unknown err: %d\n", err); - } - } -output: + case SSL_ERROR_NONE: + if (written < 0) { + written = 0; + } + break; + case SSL_ERROR_WANT_WRITE: + dprintf(stderr," write W BLOCK"); + break; + case SSL_ERROR_WANT_READ: + dprintf(stderr," write R BLOCK"); + break; + case SSL_ERROR_WANT_X509_LOOKUP: + dprintf(stderr," write X BLOCK"); + break; + case SSL_ERROR_ZERO_RETURN: + dprintf(stderr," closed\n"); + written = 0; + break; + case SSL_ERROR_SYSCALL: + *errorCodePtr = Tcl_GetErrno(); + dprintf(stderr," [%d] syscall errr: %d", + written, *errorCodePtr); + written = -1; + break; + case SSL_ERROR_SSL: + Tls_Error(statePtr, SSL_ERROR(statePtr->ssl, written)); + *errorCodePtr = ECONNABORTED; + written = -1; + break; + default: + dprintf(stderr," unknown err: %d\n", err); + break; + } + } + output: dprintf(stderr, "\nOutput(%d) -> %d", toWrite, written); return written; } /*