Index: tclOpts.h ================================================================== --- tclOpts.h +++ tclOpts.h @@ -2,10 +2,11 @@ * Copyright (C) 1997-2000 Matt Newman * * Stylized option processing - requires consistent * external vars: opt, idx, objc, objv */ + #ifndef _TCL_OPTS_H #define _TCL_OPTS_H #define OPT_PROLOG(option) \ if (strcmp(opt, (option)) == 0) { \ Index: tests/all.tcl ================================================================== --- tests/all.tcl +++ tests/all.tcl @@ -4,11 +4,11 @@ # tests. Execute it by invoking "source all.test" when running tcltest # in this directory. # # Copyright (c) 1998-2000 by Ajuba Solutions. # All rights reserved. -# +# # RCS: @(#) $Id: all.tcl,v 1.5 2000/08/15 18:45:01 hobbs Exp $ #set auto_path [linsert $auto_path 0 [file normalize [file join [file dirname [info script]] ..]]] set auto_path [linsert $auto_path 0 [file normalize [pwd]]] Index: tls.c ================================================================== --- tls.c +++ tls.c @@ -1,11 +1,11 @@ /* * Copyright (C) 1997-1999 Matt Newman * some modifications: * Copyright (C) 2000 Ajuba Solutions * Copyright (C) 2002 ActiveState Corporation - * Copyright (C) 2004 Starfish Systems + * Copyright (C) 2004 Starfish Systems * * 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 @@ -33,19 +33,19 @@ /* * Forward declarations */ -#define F2N( key, dsp) \ +#define F2N(key, dsp) \ (((key) == NULL) ? (char *) NULL : \ Tcl_TranslateFileName(interp, (key), (dsp))) #define REASON() ERR_reason_error_string(ERR_get_error()) static SSL_CTX *CTX_Init(State *statePtr, int isServer, int proto, char *key, - char *certfile, unsigned char *key_asn1, unsigned char *cert_asn1, - int key_asn1_len, int cert_asn1_len, char *CAdir, char *CAfile, - char *ciphers, char *DHparams); + char *certfile, unsigned char *key_asn1, unsigned char *cert_asn1, + int key_asn1_len, int cert_asn1_len, char *CAdir, char *CAfile, + char *ciphers, char *DHparams); static int TlsLibInit(int uninitialize); #define TLS_PROTO_SSL2 0x01 #define TLS_PROTO_SSL3 0x02 @@ -79,11 +79,11 @@ */ #ifndef STACK_OF #define STACK_OF(x) STACK #define sk_SSL_CIPHER_num(sk) sk_num((sk)) -#define sk_SSL_CIPHER_value( sk, index) (SSL_CIPHER*)sk_value((sk), (index)) +#define sk_SSL_CIPHER_value(sk, index) (SSL_CIPHER*)sk_value((sk), (index)) #endif /* * Thread-Safe TLS Code */ @@ -108,37 +108,38 @@ # if OPENSSL_VERSION_NUMBER < 0x10100000L void CryptoThreadLockCallback(int mode, int n, const char *file, int line) { - if (mode & CRYPTO_LOCK) { - /* This debugging is turned off by default -- it's too noisy. */ - /* dprintf("Called to lock (n=%i of %i)", n, locksCount); */ - Tcl_MutexLock(&locks[n]); - } else { - /* dprintf("Called to unlock (n=%i of %i)", n, locksCount); */ - Tcl_MutexUnlock(&locks[n]); - } - - /* dprintf("Returning"); */ - - return; - file = file; - line = line; + if (mode & CRYPTO_LOCK) { + /* This debugging is turned off by default -- it's too noisy. */ + /* dprintf("Called to lock (n=%i of %i)", n, locksCount); */ + Tcl_MutexLock(&locks[n]); + } else { + /* dprintf("Called to unlock (n=%i of %i)", n, locksCount); */ + Tcl_MutexUnlock(&locks[n]); + } + + /* dprintf("Returning"); */ + + return; + file = file; + line = line; } unsigned long CryptoThreadIdCallback(void) { - unsigned long ret; - - dprintf("Called"); - - ret = (unsigned long) Tcl_GetCurrentThread(); - - dprintf("Returning %lu", ret); - - return(ret); -} + unsigned long ret; + + dprintf("Called"); + + ret = (unsigned long) Tcl_GetCurrentThread(); + + dprintf("Returning %lu", ret); + + return(ret); +} + #endif #endif /* OPENSSL_THREADS */ #endif /* TCL_THREADS */ @@ -170,11 +171,11 @@ cmdPtr = Tcl_DuplicateObj(statePtr->callback); #if 0 if (where & SSL_CB_ALERT) { sev = SSL_alert_type_string_long(ret); - if (strcmp( sev, "fatal")==0) { /* Map to error */ + if (strcmp(sev, "fatal")==0) { /* Map to error */ Tls_Error(statePtr, SSL_ERROR(ssl, 0)); return; } } #endif @@ -195,44 +196,36 @@ 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) ); + 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) ); + 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) ); + Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj(cp, -1)); } else { - Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, - Tcl_NewStringObj( SSL_state_string_long(ssl), -1) ); + Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, + Tcl_NewStringObj(SSL_state_string_long(ssl), -1)); } - Tcl_Preserve( (ClientData) statePtr->interp); - Tcl_Preserve( (ClientData) statePtr); + Tcl_Preserve((ClientData) statePtr->interp); + Tcl_Preserve((ClientData) statePtr); - Tcl_IncrRefCount( cmdPtr); + Tcl_IncrRefCount(cmdPtr); (void) Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL); - Tcl_DecrRefCount( cmdPtr); + Tcl_DecrRefCount(cmdPtr); - Tcl_Release( (ClientData) statePtr); - Tcl_Release( (ClientData) statePtr->interp); - + Tcl_Release((ClientData) statePtr); + Tcl_Release((ClientData) statePtr->interp); } /* *------------------------------------------------------------------- * @@ -280,34 +273,24 @@ 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); + 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); + 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); @@ -329,17 +312,16 @@ #endif ok = 0; } } } - Tcl_DecrRefCount( cmdPtr); + Tcl_DecrRefCount(cmdPtr); statePtr->flags &= ~(TLS_TCL_CALLBACK); - Tcl_Release( (ClientData) statePtr); - Tcl_Release( (ClientData) statePtr->interp); - + Tcl_Release((ClientData) statePtr); + Tcl_Release((ClientData) statePtr->interp); return(ok); /* By default, leave verification unchanged. */ } /* *------------------------------------------------------------------- @@ -370,24 +352,24 @@ 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); + 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_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj("error", -1)); - Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, + Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1)); Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj(msg, -1)); @@ -402,11 +384,10 @@ #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) { @@ -420,11 +401,11 @@ } /* *------------------------------------------------------------------- * - * PasswordCallback -- + * PasswordCallback -- * * Called when a password is needed to unpack RSA and PEM keys. * Evals any bound password script and returns the result as * the password string. *------------------------------------------------------------------- @@ -435,11 +416,11 @@ * variable to access the Tcl interpreter. */ static int PasswordCallback(char *buf, int size, int verify) { return -1; - buf = buf; + buf = buf; size = size; verify = verify; } #else static int @@ -450,12 +431,11 @@ int code; dprintf("Called"); if (statePtr->password == NULL) { - if (Tcl_EvalEx(interp, "tls::password", -1, TCL_EVAL_GLOBAL) - == 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; @@ -481,17 +461,18 @@ Tcl_Release((ClientData) statePtr); if (code == TCL_OK) { char *ret = (char *) Tcl_GetStringResult(interp); if (strlen(ret) < size - 1) { - strncpy(buf, ret, (size_t) size); + strncpy(buf, ret, (size_t) size); Tcl_Release((ClientData) interp); - return (int)strlen(ret); + return (int)strlen(ret); } } Tcl_Release((ClientData) interp); return -1; + verify = verify; } #endif /* *------------------------------------------------------------------- @@ -528,66 +509,64 @@ if ((objc < 2) || (objc > 3)) { Tcl_WrongNumArgs(interp, 1, objv, "protocol ?verbose?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj( interp, objv[1], protocols, "protocol", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObj(interp, objv[1], protocols, "protocol", 0, &index) != TCL_OK) { return TCL_ERROR; } - if ((objc > 2) && Tcl_GetBooleanFromObj( interp, objv[2], - &verbose) != TCL_OK) { + if ((objc > 2) && Tcl_GetBooleanFromObj(interp, objv[2], &verbose) != TCL_OK) { return TCL_ERROR; } switch ((enum protocol)index) { - case TLS_SSL2: + case TLS_SSL2: #if OPENSSL_VERSION_NUMBER >= 0x10101000L || defined(NO_SSL2) || defined(OPENSSL_NO_SSL2) - Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); - return TCL_ERROR; + Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); + return TCL_ERROR; #else - ctx = SSL_CTX_new(SSLv2_method()); break; + ctx = SSL_CTX_new(SSLv2_method()); break; #endif - case TLS_SSL3: + case TLS_SSL3: #if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3) - Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); - return TCL_ERROR; + Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); + return TCL_ERROR; #else - ctx = SSL_CTX_new(SSLv3_method()); break; + ctx = SSL_CTX_new(SSLv3_method()); break; #endif - case TLS_TLS1: + case TLS_TLS1: #if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1) - Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); - return TCL_ERROR; + Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); + return TCL_ERROR; #else - ctx = SSL_CTX_new(TLSv1_method()); break; + ctx = SSL_CTX_new(TLSv1_method()); break; #endif - case TLS_TLS1_1: + case TLS_TLS1_1: #if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1) - Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); - return TCL_ERROR; + Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); + return TCL_ERROR; #else - ctx = SSL_CTX_new(TLSv1_1_method()); break; + ctx = SSL_CTX_new(TLSv1_1_method()); break; #endif - case TLS_TLS1_2: + case TLS_TLS1_2: #if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2) - Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); - return TCL_ERROR; + Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); + return TCL_ERROR; #else - ctx = SSL_CTX_new(TLSv1_2_method()); break; + ctx = SSL_CTX_new(TLSv1_2_method()); break; #endif - case TLS_TLS1_3: + case TLS_TLS1_3: #if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3) - Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); - return TCL_ERROR; + Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); + return TCL_ERROR; #else - ctx = SSL_CTX_new(TLS_method()); - SSL_CTX_set_min_proto_version (ctx, TLS1_3_VERSION); - SSL_CTX_set_max_proto_version (ctx, TLS1_3_VERSION); - break; + ctx = SSL_CTX_new(TLS_method()); + SSL_CTX_set_min_proto_version(ctx, TLS1_3_VERSION); + SSL_CTX_set_max_proto_version(ctx, TLS1_3_VERSION); + break; #endif - default: - break; + default: + break; } if (ctx == NULL) { Tcl_AppendResult(interp, REASON(), NULL); return TCL_ERROR; } @@ -595,44 +574,40 @@ if (ssl == NULL) { Tcl_AppendResult(interp, REASON(), NULL); SSL_CTX_free(ctx); return TCL_ERROR; } - objPtr = Tcl_NewListObj( 0, NULL); + objPtr = Tcl_NewListObj(0, NULL); if (!verbose) { for (index = 0; ; index++) { - cp = (char*)SSL_get_cipher_list( ssl, index); + cp = (char*)SSL_get_cipher_list(ssl, index); if (cp == NULL) break; - Tcl_ListObjAppendElement( interp, objPtr, - Tcl_NewStringObj( cp, -1) ); + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(cp, -1)); } } else { sk = SSL_get_ciphers(ssl); for (index = 0; index < sk_SSL_CIPHER_num(sk); index++) { register size_t i; - SSL_CIPHER_description( sk_SSL_CIPHER_value( sk, index), - buf, sizeof(buf)); + SSL_CIPHER_description(sk_SSL_CIPHER_value(sk, index), buf, sizeof(buf)); for (i = strlen(buf) - 1; i ; i--) { - if ((buf[i] == ' ') || (buf[i] == '\n') || - (buf[i] == '\r') || (buf[i] == '\t')) { + if ((buf[i] == ' ') || (buf[i] == '\n') || (buf[i] == '\r') || (buf[i] == '\t')) { buf[i] = '\0'; } else { break; } } - Tcl_ListObjAppendElement( interp, objPtr, - Tcl_NewStringObj( buf, -1) ); + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(buf, -1)); } } SSL_free(ssl); SSL_CTX_free(ctx); - Tcl_SetObjResult( interp, objPtr); + Tcl_SetObjResult(interp, objPtr); return TCL_OK; - clientData = clientData; + clientData = clientData; } /* *------------------------------------------------------------------- * @@ -647,72 +622,69 @@ * Side effects: * May force SSL negotiation to take place. * *------------------------------------------------------------------- */ - static int HandshakeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - Tcl_Channel chan; /* The channel to set a mode on. */ - State *statePtr; /* client state for ssl socket */ - const char *errStr = NULL; - int ret = 1; - int err = 0; - - dprintf("Called"); - - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "channel"); - return(TCL_ERROR); - } - - 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); - - dprintf("Calling Tls_WaitForConnect"); - ret = Tls_WaitForConnect(statePtr, &err, 1); - dprintf("Tls_WaitForConnect returned: %i", ret); - - if (ret < 0 && ((statePtr->flags & TLS_TCL_ASYNC) && (err == EAGAIN))) { - dprintf("Async set and err = EAGAIN"); - ret = 0; - } else if (ret < 0) { - errStr = statePtr->err; - Tcl_ResetResult(interp); - Tcl_SetErrno(err); - - if (!errStr || (*errStr == 0)) { - errStr = Tcl_PosixError(interp); - } - - Tcl_AppendResult(interp, "handshake failed: ", errStr, (char *) NULL); - dprintf("Returning TCL_ERROR with handshake failed: %s", errStr); - return(TCL_ERROR); - } else { - if (err != 0) { - dprintf("Got an error with a completed handshake: err = %i", err); - } - - ret = 1; - } - - dprintf("Returning TCL_OK with data \"%i\"", ret); - Tcl_SetObjResult(interp, Tcl_NewIntObj(ret)); - return(TCL_OK); - - clientData = clientData; + Tcl_Channel chan; /* The channel to set a mode on. */ + State *statePtr; /* client state for ssl socket */ + const char *errStr = NULL; + int ret = 1; + int err = 0; + + dprintf("Called"); + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "channel"); + return(TCL_ERROR); + } + + 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); + + dprintf("Calling Tls_WaitForConnect"); + ret = Tls_WaitForConnect(statePtr, &err, 1); + dprintf("Tls_WaitForConnect returned: %i", ret); + + if (ret < 0 && ((statePtr->flags & TLS_TCL_ASYNC) && (err == EAGAIN))) { + dprintf("Async set and err = EAGAIN"); + ret = 0; + } else if (ret < 0) { + errStr = statePtr->err; + Tcl_ResetResult(interp); + Tcl_SetErrno(err); + + if (!errStr || (*errStr == 0)) { + errStr = Tcl_PosixError(interp); + } + + Tcl_AppendResult(interp, "handshake failed: ", errStr, (char *) NULL); + dprintf("Returning TCL_ERROR with handshake failed: %s", errStr); + return(TCL_ERROR); + } else { + if (err != 0) { + dprintf("Got an error with a completed handshake: err = %i", err); + } + ret = 1; + } + + dprintf("Returning TCL_OK with data \"%i\"", ret); + Tcl_SetObjResult(interp, Tcl_NewIntObj(ret)); + return(TCL_OK); + clientData = clientData; } /* *------------------------------------------------------------------- * @@ -728,11 +700,10 @@ * Side effects: * May modify the behavior of an IO channel. * *------------------------------------------------------------------- */ - static int ImportObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, 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; @@ -802,37 +773,37 @@ char *opt = Tcl_GetStringFromObj(objv[idx], NULL); if (opt[0] != '-') break; - OPTSTR( "-cadir", CAdir); - OPTSTR( "-cafile", CAfile); - OPTSTR( "-certfile", certfile); - OPTSTR( "-cipher", ciphers); - OPTOBJ( "-command", script); - OPTSTR( "-dhparams", DHparams); - OPTSTR( "-keyfile", keyfile); - OPTSTR( "-model", model); - OPTOBJ( "-password", password); - OPTBOOL( "-require", require); - OPTBOOL( "-request", request); - OPTBOOL( "-server", server); + OPTSTR("-cadir", CAdir); + OPTSTR("-cafile", CAfile); + OPTSTR("-certfile", certfile); + OPTSTR("-cipher", ciphers); + OPTOBJ("-command", script); + OPTSTR("-dhparams", DHparams); + OPTSTR("-keyfile", keyfile); + OPTSTR("-model", model); + OPTOBJ("-password", password); + OPTBOOL("-require", require); + OPTBOOL("-request", request); + OPTBOOL("-server", server); #ifndef OPENSSL_NO_TLSEXT - OPTSTR( "-servername", servername); - OPTOBJ( "-alpn", alpn); + OPTSTR("-servername", servername); + OPTOBJ("-alpn", alpn); #endif - OPTBOOL( "-ssl2", ssl2); - OPTBOOL( "-ssl3", ssl3); - OPTBOOL( "-tls1", tls1); - OPTBOOL( "-tls1.1", tls1_1); - OPTBOOL( "-tls1.2", tls1_2); - OPTBOOL( "-tls1.3", tls1_3); - OPTBYTE("-cert", cert, cert_len); - OPTBYTE("-key", key, key_len); - - OPTBAD( "option", "-alpn, -cadir, -cafile, -cert, -certfile, -cipher, -command, -dhparams, -key, -keyfile, -model, -password, -require, -request, -server, -servername, -ssl2, -ssl3, -tls1, -tls1.1, -tls1.2, or -tls1.3"); + OPTBOOL("-ssl2", ssl2); + OPTBOOL("-ssl3", ssl3); + OPTBOOL("-tls1", tls1); + OPTBOOL("-tls1.1", tls1_1); + OPTBOOL("-tls1.2", tls1_2); + OPTBOOL("-tls1.3", tls1_3); + OPTBYTE("-cert", cert, cert_len); + OPTBYTE("-key", key, key_len); + + OPTBAD("option", "-alpn, -cadir, -cafile, -cert, -certfile, -cipher, -command, -dhparams, -key, -keyfile, -model, -password, -require, -request, -server, -servername, -ssl2, -ssl3, -tls1, -tls1.1, -tls1.2, or -tls1.3"); return TCL_ERROR; } if (request) verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER; if (request && require) verify |= SSL_VERIFY_FAIL_IF_NO_PEER_CERT; @@ -889,17 +860,17 @@ if (chan == (Tcl_Channel) NULL) { Tls_Free((char *) statePtr); return TCL_ERROR; } - /* - * Make sure to operate on the topmost channel - */ - chan = Tcl_GetTopChannel(chan); + /* + * 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); + Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan), + "\": not a TLS channel", NULL); Tls_Free((char *) statePtr); return TCL_ERROR; } ctx = ((State *)Tcl_GetChannelInstanceData(chan))->ctx; } else { @@ -945,25 +916,22 @@ Tcl_SetChannelOption(interp, statePtr->self, "-blocking", Tcl_DStringValue(&upperChannelBlocking)); /* * SSL Initialization */ - 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; } #ifndef OPENSSL_NO_TLSEXT if (servername) { - if (!SSL_set_tlsext_host_name(statePtr->ssl, servername) && require) { - Tcl_AppendResult(interp, "setting TLS host name extension failed", - (char *) NULL); + if (!SSL_set_tlsext_host_name(statePtr->ssl, servername) && require) { + Tcl_AppendResult(interp, "setting TLS host name extension failed", (char *) NULL); Tls_Free((char *) statePtr); return TCL_ERROR; } } if (alpn) { @@ -978,12 +946,11 @@ } /* Determine the memory required for the protocol-list */ for (i = 0; i < cnt; i++) { Tcl_GetStringFromObj(list[i], &len); if (len > 255) { - Tcl_AppendResult(interp, "alpn protocol name too long", - (char *) NULL); + Tcl_AppendResult(interp, "alpn protocol name too long", (char *) NULL); Tls_Free((char *) statePtr); return TCL_ERROR; } protoslen += 1 + len; } @@ -996,12 +963,11 @@ memcpy(p, str, len); p += len; } /* Note: This functions reverses the return value convention */ if (SSL_set_alpn_protos(statePtr->ssl, protos, protoslen)) { - Tcl_AppendResult(interp, "failed to set alpn protocols", - (char *) NULL); + Tcl_AppendResult(interp, "failed to set alpn protocols", (char *) NULL); Tls_Free((char *) statePtr); ckfree(protos); return TCL_ERROR; } /* SSL_set_alpn_protos makes a copy of the protocol-list */ @@ -1010,15 +976,12 @@ #endif /* * SSL Callbacks */ - SSL_set_app_data(statePtr->ssl, (void *)statePtr); /* point back to us */ - SSL_set_verify(statePtr->ssl, verify, VerifyCallback); - SSL_CTX_set_info_callback(statePtr->ctx, InfoCallback); /* Create Tcl_Channel BIO Handler */ statePtr->p_bio = BIO_new_tcl(statePtr, BIO_NOCLOSE); statePtr->bio = BIO_new(BIO_f_ssl()); @@ -1034,14 +997,14 @@ /* * End of SSL Init */ dprintf("Returning %s", Tcl_GetChannelName(statePtr->self)); - Tcl_SetResult(interp, (char *) Tcl_GetChannelName(statePtr->self), - TCL_VOLATILE); + Tcl_SetResult(interp, (char *) Tcl_GetChannelName(statePtr->self), TCL_VOLATILE); + return TCL_OK; - clientData = clientData; + clientData = clientData; } /* *------------------------------------------------------------------- * @@ -1055,11 +1018,10 @@ * Side effects: * May modify the behavior of an IO channel. * *------------------------------------------------------------------- */ - static int UnimportObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Channel chan; /* The channel to set a mode on. */ dprintf("Called"); @@ -1088,11 +1050,11 @@ if (Tcl_UnstackChannel(interp, chan) == TCL_ERROR) { return TCL_ERROR; } return TCL_OK; - clientData = clientData; + clientData = clientData; } /* *------------------------------------------------------------------- * @@ -1104,11 +1066,10 @@ * Side effects: * constructs SSL context (CTX) * *------------------------------------------------------------------- */ - static SSL_CTX * CTX_Init(State *statePtr, int isServer, int proto, char *keyfile, char *certfile, unsigned char *key, unsigned char *cert, int key_len, int cert_len, char *CAdir, char *CAfile, char *ciphers, char *DHparams) { Tcl_Interp *interp = statePtr->interp; @@ -1190,24 +1151,24 @@ method = TLSv1_2_method(); break; #endif #if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3) case TLS_PROTO_TLS1_3: - /* - * The version range is constrained below, - * after the context is created. Use the - * generic method here. - */ + /* + * The version range is constrained below, + * after the context is created. Use the + * generic method here. + */ method = TLS_method(); break; #endif default: #if OPENSSL_VERSION_NUMBER >= 0x10100000L /* Negotiate highest available SSL/TLS version */ - method = TLS_method(); + method = TLS_method(); #else - method = SSLv23_method(); + method = SSLv23_method(); #endif #if OPENSSL_VERSION_NUMBER < 0x10100000L && !defined(NO_SSL2) && !defined(OPENSSL_NO_SSL2) off |= (ENABLED(proto, TLS_PROTO_SSL2) ? 0 : SSL_OP_NO_SSLv2); #endif #if !defined(NO_SSL3) && !defined(OPENSSL_NO_SSL3) @@ -1225,39 +1186,39 @@ #if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3) off |= (ENABLED(proto, TLS_PROTO_TLS1_3) ? 0 : SSL_OP_NO_TLSv1_3); #endif break; } - + ctx = SSL_CTX_new(method); if (!ctx) { - return(NULL); + return(NULL); } if (getenv(SSLKEYLOGFILE)) { SSL_CTX_set_keylog_callback(ctx, KeyLogCallback); } #if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3) if (proto == TLS_PROTO_TLS1_3) { - SSL_CTX_set_min_proto_version (ctx, TLS1_3_VERSION); - SSL_CTX_set_max_proto_version (ctx, TLS1_3_VERSION); + SSL_CTX_set_min_proto_version(ctx, TLS1_3_VERSION); + SSL_CTX_set_max_proto_version(ctx, TLS1_3_VERSION); if (!isServer) { SSL_CTX_set_options(ctx, SSL_OP_CIPHER_SERVER_PREFERENCE); } } #endif - - SSL_CTX_set_app_data( ctx, (void*)interp); /* remember the interpreter */ - SSL_CTX_set_options( ctx, SSL_OP_ALL); /* all SSL bug workarounds */ - SSL_CTX_set_options( ctx, off); /* all SSL bug workarounds */ + + SSL_CTX_set_app_data(ctx, (void*)interp); /* remember the interpreter */ + SSL_CTX_set_options(ctx, SSL_OP_ALL); /* all SSL bug workarounds */ + SSL_CTX_set_options(ctx, off); /* disable protocol versions */ #if OPENSSL_VERSION_NUMBER < 0x10101000L SSL_CTX_set_mode(ctx, SSL_MODE_AUTO_RETRY); /* handle new handshakes in background */ #endif - SSL_CTX_sess_set_cache_size( ctx, 128); + SSL_CTX_sess_set_cache_size(ctx, 128); if (ciphers != NULL) SSL_CTX_set_cipher_list(ctx, ciphers); /* set some callbacks */ @@ -1268,12 +1229,11 @@ #endif /* read a Diffie-Hellman parameters file, or use the built-in one */ #ifdef OPENSSL_NO_DH if (DHparams != NULL) { - Tcl_AppendResult(interp, - "DH parameter support not available", (char *) NULL); + Tcl_AppendResult(interp, "DH parameter support not available", (char *) NULL); SSL_CTX_free(ctx); return (SSL_CTX *)0; } #else { @@ -1282,22 +1242,20 @@ BIO *bio; Tcl_DStringInit(&ds); bio = BIO_new_file(F2N(DHparams, &ds), "r"); if (!bio) { Tcl_DStringFree(&ds); - Tcl_AppendResult(interp, - "Could not find DH parameters file", (char *) NULL); + Tcl_AppendResult(interp, "Could not find DH parameters file", (char *) NULL); SSL_CTX_free(ctx); return (SSL_CTX *)0; } - + dh = PEM_read_bio_DHparams(bio, NULL, NULL, NULL); BIO_free(bio); Tcl_DStringFree(&ds); if (!dh) { - Tcl_AppendResult(interp, - "Could not read DH parameters from file", (char *) NULL); + Tcl_AppendResult(interp, "Could not read DH parameters from file", (char *) NULL); SSL_CTX_free(ctx); return (SSL_CTX *)0; } } else { dh = get_dhParams(); @@ -1312,38 +1270,33 @@ if (certfile != NULL) { load_private_key = 1; Tcl_DStringInit(&ds); - if (SSL_CTX_use_certificate_file(ctx, F2N( certfile, &ds), - SSL_FILETYPE_PEM) <= 0) { + if (SSL_CTX_use_certificate_file(ctx, F2N(certfile, &ds), SSL_FILETYPE_PEM) <= 0) { Tcl_DStringFree(&ds); - Tcl_AppendResult(interp, - "unable to set certificate file ", certfile, ": ", + Tcl_AppendResult(interp, "unable to set certificate file ", certfile, ": ", REASON(), (char *) NULL); SSL_CTX_free(ctx); return (SSL_CTX *)0; } } else if (cert != NULL) { load_private_key = 1; if (SSL_CTX_use_certificate_ASN1(ctx, cert_len, cert) <= 0) { Tcl_DStringFree(&ds); - Tcl_AppendResult(interp, - "unable to set certificate: ", + Tcl_AppendResult(interp, "unable to set certificate: ", REASON(), (char *) NULL); SSL_CTX_free(ctx); return (SSL_CTX *)0; } } else { certfile = (char*)X509_get_default_cert_file(); - if (SSL_CTX_use_certificate_file(ctx, certfile, - SSL_FILETYPE_PEM) <= 0) { + if (SSL_CTX_use_certificate_file(ctx, certfile, SSL_FILETYPE_PEM) <= 0) { #if 0 Tcl_DStringFree(&ds); - Tcl_AppendResult(interp, - "unable to use default certificate file ", certfile, ": ", + Tcl_AppendResult(interp, "unable to use default certificate file ", certfile, ": ", REASON(), (char *) NULL); SSL_CTX_free(ctx); return (SSL_CTX *)0; #endif } @@ -1359,39 +1312,35 @@ /* get the private key associated with this certificate */ if (keyfile == NULL) { keyfile = certfile; } - if (SSL_CTX_use_PrivateKey_file(ctx, F2N( keyfile, &ds), SSL_FILETYPE_PEM) <= 0) { + if (SSL_CTX_use_PrivateKey_file(ctx, F2N(keyfile, &ds), SSL_FILETYPE_PEM) <= 0) { Tcl_DStringFree(&ds); /* flush the passphrase which might be left in the result */ Tcl_SetResult(interp, NULL, TCL_STATIC); - Tcl_AppendResult(interp, - "unable to set public key file ", keyfile, " ", + Tcl_AppendResult(interp, "unable to set public key file ", keyfile, " ", REASON(), (char *) NULL); SSL_CTX_free(ctx); return (SSL_CTX *)0; } - Tcl_DStringFree(&ds); + } else if (key != NULL) { if (SSL_CTX_use_PrivateKey_ASN1(EVP_PKEY_RSA, ctx, key,key_len) <= 0) { Tcl_DStringFree(&ds); /* flush the passphrase which might be left in the result */ Tcl_SetResult(interp, NULL, TCL_STATIC); - Tcl_AppendResult(interp, - "unable to set public key: ", - REASON(), (char *) NULL); + Tcl_AppendResult(interp, "unable to set public key: ", REASON(), (char *) NULL); SSL_CTX_free(ctx); return (SSL_CTX *)0; } } /* Now we know that a key and cert have been set against * the SSL context */ if (!SSL_CTX_check_private_key(ctx)) { - Tcl_AppendResult(interp, - "private key does not match the certificate public key", + Tcl_AppendResult(interp, "private key does not match the certificate public key", (char *) NULL); SSL_CTX_free(ctx); return (SSL_CTX *)0; } } @@ -1403,23 +1352,22 @@ !SSL_CTX_set_default_verify_paths(ctx)) { #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); + Tcl_AppendResult(interp, "SSL default verify paths: ", REASON(), (char *) NULL); SSL_CTX_free(ctx); return (SSL_CTX *)0; #endif } /* https://sourceforge.net/p/tls/bugs/57/ */ /* XXX:TODO: Let the user supply values here instead of something that exists on the filesystem */ - if ( CAfile != NULL ) { - STACK_OF(X509_NAME) *certNames = SSL_load_client_CA_file( F2N(CAfile, &ds) ); - if ( certNames != NULL ) { - SSL_CTX_set_client_CA_list(ctx, certNames ); + if (CAfile != NULL) { + STACK_OF(X509_NAME) *certNames = SSL_load_client_CA_file(F2N(CAfile, &ds)); + if (certNames != NULL) { + SSL_CTX_set_client_CA_list(ctx, certNames); } } Tcl_DStringFree(&ds); Tcl_DStringFree(&ds1); @@ -1497,38 +1445,31 @@ if (objc == 2) { X509_free(peer); } } else { objPtr = Tcl_NewListObj(0, NULL); } - Tcl_ListObjAppendElement (interp, objPtr, - Tcl_NewStringObj ("sbits", -1)); - Tcl_ListObjAppendElement (interp, objPtr, - Tcl_NewIntObj (SSL_get_cipher_bits (statePtr->ssl, NULL))); + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("sbits", -1)); + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_get_cipher_bits(statePtr->ssl, 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)); } #ifndef OPENSSL_NO_TLSEXT /* Report the selected protocol as a result of the negotiation */ SSL_get0_alpn_selected(statePtr->ssl, &proto, &len); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("alpn", -1)); - Tcl_ListObjAppendElement(interp, objPtr, - Tcl_NewStringObj((char *)proto, (int)len)); + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj((char *)proto, (int)len)); #endif - Tcl_ListObjAppendElement(interp, objPtr, - Tcl_NewStringObj("version", -1)); - Tcl_ListObjAppendElement(interp, objPtr, - Tcl_NewStringObj(SSL_get_version(statePtr->ssl), -1)); + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("version", -1)); + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_version(statePtr->ssl), -1)); - Tcl_SetObjResult( interp, objPtr); + Tcl_SetObjResult(interp, objPtr); return TCL_OK; - clientData = clientData; + clientData = clientData; } /* *------------------------------------------------------------------- * @@ -1547,16 +1488,16 @@ Tcl_Obj *objPtr; dprintf("Called"); objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1); - Tcl_SetObjResult(interp, objPtr); + return TCL_OK; - clientData = clientData; - objc = objc; - objv = objv; + clientData = clientData; + objc = objc; + objv = objv; } /* *------------------------------------------------------------------- * @@ -1607,11 +1548,11 @@ RSA *rsa = NULL; #elif OPENSSL_VERSION_NUMBER < 0x30000000L BIGNUM *bne = NULL; RSA *rsa = NULL; #else - EVP_PKEY_CTX *ctx = NULL; + EVP_PKEY_CTX *ctx = NULL; #endif if ((objc<5) || (objc>6)) { Tcl_WrongNumArgs(interp, 2, objv, "keysize keyfile certfile ?info?"); return TCL_ERROR; @@ -1726,11 +1667,11 @@ #else X509_gmtime_adj(X509_getm_notBefore(cert),0); X509_gmtime_adj(X509_getm_notAfter(cert),(long)60*60*24*days); #endif X509_set_pubkey(cert,pkey); - + name=X509_get_subject_name(cert); X509_NAME_add_entry_by_txt(name,"C", MBSTRING_ASC, (const unsigned char *) k_C, -1, -1, 0); X509_NAME_add_entry_by_txt(name,"ST", MBSTRING_ASC, (const unsigned char *) k_ST, -1, -1, 0); X509_NAME_add_entry_by_txt(name,"L", MBSTRING_ASC, (const unsigned char *) k_L, -1, -1, 0); @@ -1777,11 +1718,11 @@ break; default: break; } return TCL_OK; - clientData = clientData; + clientData = clientData; } /* *------------------------------------------------------------------- * @@ -1797,12 +1738,11 @@ * Frees all the state * *------------------------------------------------------------------- */ void -Tls_Free( char *blockPtr ) -{ +Tls_Free(char *blockPtr) { State *statePtr = (State *)blockPtr; dprintf("Called"); Tls_Clean(statePtr); @@ -1878,59 +1818,58 @@ * Side effects: * create the ssl command, initialize ssl context * *------------------------------------------------------------------- */ - DLLEXPORT int Tls_Init(Tcl_Interp *interp) { - const char tlsTclInitScript[] = { + const char tlsTclInitScript[] = { #include "tls.tcl.h" - 0x00 - }; - - dprintf("Called"); - - /* - * We only support Tcl 8.4 or newer - */ - if ( + 0x00 + }; + + dprintf("Called"); + + /* + * We only support Tcl 8.4 or newer + */ + if ( #ifdef USE_TCL_STUBS - Tcl_InitStubs(interp, "8.4", 0) + Tcl_InitStubs(interp, "8.4", 0) #else - Tcl_PkgRequire(interp, "Tcl", "8.4-", 0) + Tcl_PkgRequire(interp, "Tcl", "8.4-", 0) #endif - == NULL) { - return TCL_ERROR; - } - - if (TlsLibInit(0) != TCL_OK) { - Tcl_AppendResult(interp, "could not initialize SSL library", NULL); - return TCL_ERROR; - } - - 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::unimport", UnimportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - - if (interp) { - Tcl_Eval(interp, tlsTclInitScript); - } - - return(Tcl_PkgProvide(interp, "tls", PACKAGE_VERSION)); + == NULL) { + return TCL_ERROR; + } + + if (TlsLibInit(0) != TCL_OK) { + Tcl_AppendResult(interp, "could not initialize SSL library", NULL); + return TCL_ERROR; + } + + 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::unimport", UnimportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + + if (interp) { + Tcl_Eval(interp, tlsTclInitScript); + } + + return(Tcl_PkgProvide(interp, "tls", PACKAGE_VERSION)); } /* *------------------------------------------------------* * * Tls_SafeInit -- * * ------------------------------------------------* - * Standard procedure required by 'load'. + * Standard procedure required by 'load'. * Initializes this extension for a safe interpreter. * ------------------------------------------------* * * Side effects: * As of 'Tls_Init' @@ -1938,14 +1877,13 @@ * Result: * A standard Tcl error code. * *------------------------------------------------------* */ - DLLEXPORT int Tls_SafeInit(Tcl_Interp *interp) { - dprintf("Called"); - return(Tls_Init(interp)); + dprintf("Called"); + return(Tls_Init(interp)); } /* *------------------------------------------------------* * @@ -1962,115 +1900,114 @@ * none * *------------------------------------------------------* */ static int TlsLibInit(int uninitialize) { - static int initialized = 0; - int status = TCL_OK; -#if defined(OPENSSL_THREADS) && defined(TCL_THREADS) - size_t num_locks; -#endif - - if (uninitialize) { - if (!initialized) { - dprintf("Asked to uninitialize, but we are not initialized"); - - return(TCL_OK); - } - - dprintf("Asked to uninitialize"); - -#if defined(OPENSSL_THREADS) && defined(TCL_THREADS) - Tcl_MutexLock(&init_mx); + static int initialized = 0; + int status = TCL_OK; +#if defined(OPENSSL_THREADS) && defined(TCL_THREADS) + size_t num_locks; +#endif + + if (uninitialize) { + if (!initialized) { + dprintf("Asked to uninitialize, but we are not initialized"); + + return(TCL_OK); + } + + dprintf("Asked to uninitialize"); + +#if defined(OPENSSL_THREADS) && defined(TCL_THREADS) + Tcl_MutexLock(&init_mx); #if OPENSSL_VERSION_NUMBER < 0x10000000L - CRYPTO_set_locking_callback(NULL); - CRYPTO_set_id_callback(NULL); -#elif OPENSSL_VERSION_NUMBER < 0x10100000L - CRYPTO_set_locking_callback(NULL); - CRYPTO_THREADID_set_callback(NULL) -#endif - - if (locks) { - free(locks); - locks = NULL; - locksCount = 0; - } -#endif - initialized = 0; - -#if defined(OPENSSL_THREADS) && defined(TCL_THREADS) - Tcl_MutexUnlock(&init_mx); -#endif - - return(TCL_OK); - } - - if (initialized) { - dprintf("Called, but using cached value"); - return(status); - } - - dprintf("Called"); - -#if defined(OPENSSL_THREADS) && defined(TCL_THREADS) - Tcl_MutexLock(&init_mx); -#endif - initialized = 1; + CRYPTO_set_locking_callback(NULL); + CRYPTO_set_id_callback(NULL); +#elif OPENSSL_VERSION_NUMBER < 0x10100000L + CRYPTO_set_locking_callback(NULL); + CRYPTO_THREADID_set_callback(NULL) +#endif + + if (locks) { + free(locks); + locks = NULL; + locksCount = 0; + } +#endif + initialized = 0; + +#if defined(OPENSSL_THREADS) && defined(TCL_THREADS) + Tcl_MutexUnlock(&init_mx); +#endif + + return(TCL_OK); + } + + if (initialized) { + dprintf("Called, but using cached value"); + return(status); + } + + dprintf("Called"); + +#if defined(OPENSSL_THREADS) && defined(TCL_THREADS) + Tcl_MutexLock(&init_mx); +#endif + initialized = 1; #if defined(OPENSSL_THREADS) && defined(TCL_THREADS) #if OPENSSL_VERSION_NUMBER < 0x10100000L - num_locks = CRYPTO_num_locks(); -#else - num_locks = 1; -#endif - locksCount = (int) num_locks; - locks = malloc(sizeof(*locks) * num_locks); - memset(locks, 0, sizeof(*locks) * num_locks); - -#if OPENSSL_VERSION_NUMBER < 0x10000000L - CRYPTO_set_locking_callback(CryptoThreadLockCallback); - CRYPTO_set_id_callback(CryptoThreadIdCallback); -#elif OPENSSL_VERSION_NUMBER < 0x10100000L - CRYPTO_set_locking_callback(CryptoThreadLockCallback); - CRYPTO_THREADID_set_callback(CryptoThreadIdCallback) -#endif -#endif - -# if OPENSSL_VERSION_NUMBER < 0x10100000L - if (SSL_library_init() != 1) { - status = TCL_ERROR; - goto done; - } -#else - /* Initialize BOTH libcrypto and libssl. */ - OPENSSL_init_ssl(OPENSSL_INIT_LOAD_SSL_STRINGS | OPENSSL_INIT_LOAD_CRYPTO_STRINGS - | OPENSSL_INIT_ADD_ALL_CIPHERS | OPENSSL_INIT_ADD_ALL_DIGESTS, NULL); -#endif - -# if OPENSSL_VERSION_NUMBER < 0x10100000L - SSL_load_error_strings(); - ERR_load_crypto_strings(); -#else - /* Only initialize libcrypto */ - OPENSSL_init_crypto(OPENSSL_INIT_LOAD_CRYPTO_STRINGS, NULL); -#endif - - BIO_new_tcl(NULL, 0); - -#if 0 - /* - * XXX:TODO: Remove this code and replace it with a check - * for enough entropy and do not try to create our own - * terrible entropy - */ + num_locks = CRYPTO_num_locks(); +#else + num_locks = 1; +#endif + locksCount = (int) num_locks; + locks = malloc(sizeof(*locks) * num_locks); + memset(locks, 0, sizeof(*locks) * num_locks); + +#if OPENSSL_VERSION_NUMBER < 0x10000000L + CRYPTO_set_locking_callback(CryptoThreadLockCallback); + CRYPTO_set_id_callback(CryptoThreadIdCallback); +#elif OPENSSL_VERSION_NUMBER < 0x10100000L + CRYPTO_set_locking_callback(CryptoThreadLockCallback); + CRYPTO_THREADID_set_callback(CryptoThreadIdCallback) +#endif +#endif + +# if OPENSSL_VERSION_NUMBER < 0x10100000L + if (SSL_library_init() != 1) { + status = TCL_ERROR; + goto done; + } +#else + /* Initialize BOTH libcrypto and libssl. */ + OPENSSL_init_ssl(OPENSSL_INIT_LOAD_SSL_STRINGS | OPENSSL_INIT_LOAD_CRYPTO_STRINGS + | OPENSSL_INIT_ADD_ALL_CIPHERS | OPENSSL_INIT_ADD_ALL_DIGESTS, NULL); +#endif + +# if OPENSSL_VERSION_NUMBER < 0x10100000L + SSL_load_error_strings(); + ERR_load_crypto_strings(); +#else + OPENSSL_init_crypto(OPENSSL_INIT_LOAD_CRYPTO_STRINGS, NULL); +#endif + + BIO_new_tcl(NULL, 0); + +#if 0 + /* + * XXX:TODO: Remove this code and replace it with a check + * for enough entropy and do not try to create our own + * terrible entropy + */ /* * Seed the random number generator in the SSL library, * using the do/while construct because of the bug note in the * OpenSSL FAQ at http://www.openssl.org/support/faq.html#USER1 * - * The crux of the problem is that Solaris 7 does not have a + * The crux of the problem is that Solaris 7 does not have a * /dev/random or /dev/urandom device so it cannot gather enough * entropy from the RAND_seed() when TLS initializes and refuses * to go further. Earlier versions of OpenSSL carried on regardless. */ srand((unsigned int) time((time_t *) NULL)); Index: tls.h ================================================================== --- tls.h +++ tls.h @@ -13,10 +13,11 @@ * Also work done by the follow people provided the impetus to do this "right":- * tclSSL (Colin McCormack, Shared Technology) * SSLtcl (Peter Antman) * */ + #ifndef _TLS_H #define _TLS_H #include Index: tls.tcl ================================================================== --- tls.tcl +++ tls.tcl @@ -1,12 +1,12 @@ # -# Copyright (C) 1997-2000 Matt Newman +# Copyright (C) 1997-2000 Matt Newman # namespace eval tls { variable logcmd tclLog variable debug 0 - + # Default flags passed to tls::import variable defaults {} # Maps UID to Server Socket variable srvmap @@ -98,11 +98,11 @@ switch -- $ruleVarArgsToConsume { 0 { set argToExecute { lappend @VAR@ $arg set argsArray($arg) true - } + } } 1 { set argToExecute { incr idx if {$idx >= [llength $args]} { Index: tlsBIO.c ================================================================== --- tlsBIO.c +++ tlsBIO.c @@ -14,327 +14,328 @@ #define BIO_set_init(bio, val) (bio)->init = (val) #define BIO_set_shutdown(bio, val) (bio)->shutdown = (val) /* XXX: This assumes the variable being assigned to is BioMethods */ #define BIO_meth_new(type_, name_) (BIO_METHOD *)Tcl_Alloc(sizeof(BIO_METHOD)); \ - memset(BioMethods, 0, sizeof(BIO_METHOD)); \ - BioMethods->type = type_; \ - BioMethods->name = name_; + memset(BioMethods, 0, sizeof(BIO_METHOD)); \ + BioMethods->type = type_; \ + BioMethods->name = name_; #define BIO_meth_set_write(bio, val) (bio)->bwrite = val; #define BIO_meth_set_read(bio, val) (bio)->bread = val; #define BIO_meth_set_puts(bio, val) (bio)->bputs = val; #define BIO_meth_set_ctrl(bio, val) (bio)->ctrl = val; #define BIO_meth_set_create(bio, val) (bio)->create = val; #define BIO_meth_set_destroy(bio, val) (bio)->destroy = val; #endif static int BioWrite(BIO *bio, const char *buf, int bufLen) { - Tcl_Channel chan; - int ret; - int tclEofChan, tclErrno; - - chan = Tls_GetParent((State *) BIO_get_data(bio), 0); - - dprintf("[chan=%p] BioWrite(%p, , %d)", (void *)chan, (void *) bio, bufLen); - - ret = Tcl_WriteRaw(chan, buf, bufLen); - - tclEofChan = Tcl_Eof(chan); - tclErrno = Tcl_GetErrno(); - - dprintf("[chan=%p] BioWrite(%d) -> %d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, Tcl_GetErrno()); - - BIO_clear_flags(bio, BIO_FLAGS_WRITE | BIO_FLAGS_SHOULD_RETRY); - - if (tclEofChan && ret <= 0) { - dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF"); - Tcl_SetErrno(ECONNRESET); - ret = 0; - } else if (ret == 0) { - dprintf("Got 0 from Tcl_WriteRaw, and EOF is not set; ret = 0"); - dprintf("Setting retry read flag"); - BIO_set_retry_read(bio); - } else if (ret < 0) { - dprintf("We got some kind of I/O error"); - - if (tclErrno == EAGAIN) { - dprintf("It's EAGAIN"); - } else { - dprintf("It's an unepxected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno); - } - } else { - dprintf("Successfully wrote some data"); - } - - if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) { - if (BIO_should_read(bio)) { - dprintf("Setting should retry read flag"); - - BIO_set_retry_read(bio); - } - } - - return(ret); + Tcl_Channel chan; + int ret; + int tclEofChan, tclErrno; + + chan = Tls_GetParent((State *) BIO_get_data(bio), 0); + + dprintf("[chan=%p] BioWrite(%p, , %d)", (void *)chan, (void *) bio, bufLen); + + ret = Tcl_WriteRaw(chan, buf, bufLen); + + tclEofChan = Tcl_Eof(chan); + tclErrno = Tcl_GetErrno(); + + dprintf("[chan=%p] BioWrite(%d) -> %d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, Tcl_GetErrno()); + + BIO_clear_flags(bio, BIO_FLAGS_WRITE | BIO_FLAGS_SHOULD_RETRY); + + if (tclEofChan && ret <= 0) { + dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF"); + Tcl_SetErrno(ECONNRESET); + ret = 0; + + } else if (ret == 0) { + dprintf("Got 0 from Tcl_WriteRaw, and EOF is not set; ret = 0"); + dprintf("Setting retry read flag"); + BIO_set_retry_read(bio); + + } else if (ret < 0) { + dprintf("We got some kind of I/O error"); + + if (tclErrno == EAGAIN) { + dprintf("It's EAGAIN"); + } else { + dprintf("It's an unepxected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno); + } + + } else { + dprintf("Successfully wrote some data"); + } + + if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) { + if (BIO_should_read(bio)) { + dprintf("Setting should retry read flag"); + + BIO_set_retry_read(bio); + } + } + return(ret); } static int BioRead(BIO *bio, char *buf, int bufLen) { - Tcl_Channel chan; - int ret = 0; - int tclEofChan, tclErrno; - - chan = Tls_GetParent((State *) BIO_get_data(bio), 0); - - dprintf("[chan=%p] BioRead(%p, , %d)", (void *) chan, (void *) bio, bufLen); - - if (buf == NULL) { - return 0; - } - - ret = Tcl_ReadRaw(chan, buf, bufLen); - - tclEofChan = Tcl_Eof(chan); - tclErrno = Tcl_GetErrno(); - - dprintf("[chan=%p] BioRead(%d) -> %d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, tclErrno); - - BIO_clear_flags(bio, BIO_FLAGS_READ | BIO_FLAGS_SHOULD_RETRY); - - if (tclEofChan && ret <= 0) { - dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF"); - Tcl_SetErrno(ECONNRESET); - ret = 0; - } else if (ret == 0) { - dprintf("Got 0 from Tcl_Read or Tcl_ReadRaw, and EOF is not set; ret = 0"); - dprintf("Setting retry read flag"); - BIO_set_retry_read(bio); - } else if (ret < 0) { - dprintf("We got some kind of I/O error"); - - if (tclErrno == EAGAIN) { - dprintf("It's EAGAIN"); - } else { - dprintf("It's an unepxected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno); - } - } else { - dprintf("Successfully read some data"); - } - - if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) { - if (BIO_should_write(bio)) { - dprintf("Setting should retry write flag"); - - BIO_set_retry_write(bio); - } - } - - dprintf("BioRead(%p, , %d) [%p] returning %i", (void *) bio, bufLen, (void *) chan, ret); - - return(ret); + Tcl_Channel chan; + int ret = 0; + int tclEofChan, tclErrno; + + chan = Tls_GetParent((State *) BIO_get_data(bio), 0); + + dprintf("[chan=%p] BioRead(%p, , %d)", (void *) chan, (void *) bio, bufLen); + + if (buf == NULL) { + return 0; + } + + ret = Tcl_ReadRaw(chan, buf, bufLen); + + tclEofChan = Tcl_Eof(chan); + tclErrno = Tcl_GetErrno(); + + dprintf("[chan=%p] BioRead(%d) -> %d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, tclErrno); + + BIO_clear_flags(bio, BIO_FLAGS_READ | BIO_FLAGS_SHOULD_RETRY); + + if (tclEofChan && ret <= 0) { + dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF"); + Tcl_SetErrno(ECONNRESET); + ret = 0; + + } else if (ret == 0) { + dprintf("Got 0 from Tcl_Read or Tcl_ReadRaw, and EOF is not set; ret = 0"); + dprintf("Setting retry read flag"); + BIO_set_retry_read(bio); + + } else if (ret < 0) { + dprintf("We got some kind of I/O error"); + + if (tclErrno == EAGAIN) { + dprintf("It's EAGAIN"); + } else { + dprintf("It's an unepxected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno); + } + + } else { + dprintf("Successfully read some data"); + } + + if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) { + if (BIO_should_write(bio)) { + dprintf("Setting should retry write flag"); + + BIO_set_retry_write(bio); + } + } + + dprintf("BioRead(%p, , %d) [%p] returning %i", (void *) bio, bufLen, (void *) chan, ret); + + return(ret); } static int BioPuts(BIO *bio, const char *str) { - dprintf("BioPuts(%p, ) called", bio, str); + dprintf("BioPuts(%p, ) called", bio, str); - return BioWrite(bio, str, (int) strlen(str)); + return BioWrite(bio, str, (int) strlen(str)); } static long BioCtrl(BIO *bio, int cmd, long num, void *ptr) { - Tcl_Channel chan; - long ret = 1; + Tcl_Channel chan; + long ret = 1; - chan = Tls_GetParent((State *) BIO_get_data(bio), 0); + chan = Tls_GetParent((State *) BIO_get_data(bio), 0); dprintf("BioCtrl(%p, 0x%x, 0x%lx, %p)", (void *) bio, cmd, num, ptr); - switch (cmd) { - case BIO_CTRL_RESET: - dprintf("Got BIO_CTRL_RESET"); - num = 0; - ret = 0; - break; - case BIO_C_FILE_SEEK: - dprintf("Got BIO_C_FILE_SEEK"); - ret = 0; - break; - case BIO_C_FILE_TELL: - dprintf("Got BIO_C_FILE_TELL"); - ret = 0; - break; - case BIO_CTRL_INFO: - dprintf("Got BIO_CTRL_INFO"); - ret = 1; - break; - case BIO_C_SET_FD: - dprintf("Unsupported call: BIO_C_SET_FD"); - ret = -1; - break; - case BIO_C_GET_FD: - dprintf("Unsupported call: BIO_C_GET_FD"); - ret = -1; - break; - case BIO_CTRL_GET_CLOSE: - dprintf("Got BIO_CTRL_CLOSE"); - ret = BIO_get_shutdown(bio); - break; - case BIO_CTRL_SET_CLOSE: - dprintf("Got BIO_SET_CLOSE"); - BIO_set_shutdown(bio, num); - break; - case BIO_CTRL_EOF: - dprintf("Got BIO_CTRL_EOF"); - ret = ((chan) ? Tcl_Eof(chan) : 1); - break; - case BIO_CTRL_PENDING: - dprintf("Got BIO_CTRL_PENDING"); - ret = ((chan) ? ((Tcl_InputBuffered(chan) ? 1 : 0)) : 0); - dprintf("BIO_CTRL_PENDING(%d)", (int) ret); - break; - case BIO_CTRL_WPENDING: - dprintf("Got BIO_CTRL_WPENDING"); - ret = 0; - break; - case BIO_CTRL_DUP: - dprintf("Got BIO_CTRL_DUP"); - break; - case BIO_CTRL_FLUSH: - dprintf("Got BIO_CTRL_FLUSH"); - ret = ((chan) && (Tcl_WriteRaw(chan, "", 0) >= 0) ? 1 : -1); - dprintf("BIO_CTRL_FLUSH returning value %li", ret); - break; - case BIO_CTRL_PUSH: - dprintf("Got BIO_CTRL_PUSH"); - ret = 0; - break; - case BIO_CTRL_POP: - dprintf("Got BIO_CTRL_POP"); - ret = 0; - break; - case BIO_CTRL_SET: - dprintf("Got BIO_CTRL_SET"); - ret = 0; - break; - case BIO_CTRL_GET : - dprintf("Got BIO_CTRL_GET "); - ret = 0; - break; -#ifdef BIO_CTRL_GET_KTLS_SEND - case BIO_CTRL_GET_KTLS_SEND: - dprintf("Got BIO_CTRL_GET_KTLS_SEND"); - ret = 0; - break; + switch (cmd) { + case BIO_CTRL_RESET: + dprintf("Got BIO_CTRL_RESET"); + num = 0; + ret = 0; + break; + case BIO_C_FILE_SEEK: + dprintf("Got BIO_C_FILE_SEEK"); + ret = 0; + break; + case BIO_C_FILE_TELL: + dprintf("Got BIO_C_FILE_TELL"); + ret = 0; + break; + case BIO_CTRL_INFO: + dprintf("Got BIO_CTRL_INFO"); + ret = 1; + break; + case BIO_C_SET_FD: + dprintf("Unsupported call: BIO_C_SET_FD"); + ret = -1; + break; + case BIO_C_GET_FD: + dprintf("Unsupported call: BIO_C_GET_FD"); + ret = -1; + break; + case BIO_CTRL_GET_CLOSE: + dprintf("Got BIO_CTRL_CLOSE"); + ret = BIO_get_shutdown(bio); + break; + case BIO_CTRL_SET_CLOSE: + dprintf("Got BIO_SET_CLOSE"); + BIO_set_shutdown(bio, num); + break; + case BIO_CTRL_EOF: + dprintf("Got BIO_CTRL_EOF"); + ret = ((chan) ? Tcl_Eof(chan) : 1); + break; + case BIO_CTRL_PENDING: + dprintf("Got BIO_CTRL_PENDING"); + ret = ((chan) ? ((Tcl_InputBuffered(chan) ? 1 : 0)) : 0); + dprintf("BIO_CTRL_PENDING(%d)", (int) ret); + break; + case BIO_CTRL_WPENDING: + dprintf("Got BIO_CTRL_WPENDING"); + ret = 0; + break; + case BIO_CTRL_DUP: + dprintf("Got BIO_CTRL_DUP"); + break; + case BIO_CTRL_FLUSH: + dprintf("Got BIO_CTRL_FLUSH"); + ret = ((chan) && (Tcl_WriteRaw(chan, "", 0) >= 0) ? 1 : -1); + dprintf("BIO_CTRL_FLUSH returning value %li", ret); + break; + case BIO_CTRL_PUSH: + dprintf("Got BIO_CTRL_PUSH"); + ret = 0; + break; + case BIO_CTRL_POP: + dprintf("Got BIO_CTRL_POP"); + ret = 0; + break; + case BIO_CTRL_SET: + dprintf("Got BIO_CTRL_SET"); + ret = 0; + break; + case BIO_CTRL_GET : + dprintf("Got BIO_CTRL_GET "); + ret = 0; + break; +#ifdef BIO_CTRL_GET_KTLS_SEND + case BIO_CTRL_GET_KTLS_SEND: + dprintf("Got BIO_CTRL_GET_KTLS_SEND"); + ret = 0; + break; #endif #ifdef BIO_CTRL_GET_KTLS_RECV - case BIO_CTRL_GET_KTLS_RECV: - dprintf("Got BIO_CTRL_GET_KTLS_RECV"); - ret = 0; - break; + case BIO_CTRL_GET_KTLS_RECV: + dprintf("Got BIO_CTRL_GET_KTLS_RECV"); + ret = 0; + break; #endif - default: - dprintf("Got unknown control command (%i)", cmd); - ret = 0; - break; - } - - return(ret); + default: + dprintf("Got unknown control command (%i)", cmd); + ret = 0; + break; + } + return(ret); } static int BioNew(BIO *bio) { - dprintf("BioNew(%p) called", bio); + dprintf("BioNew(%p) called", bio); - BIO_set_init(bio, 0); - BIO_set_data(bio, NULL); - BIO_clear_flags(bio, -1); - - return(1); + BIO_set_init(bio, 0); + BIO_set_data(bio, NULL); + BIO_clear_flags(bio, -1); + return(1); } static int BioFree(BIO *bio) { - if (bio == NULL) { - return(0); - } - - dprintf("BioFree(%p) called", bio); - - if (BIO_get_shutdown(bio)) { - if (BIO_get_init(bio)) { - /*shutdown(bio->num, 2) */ - /*closesocket(bio->num) */ - } - - BIO_set_init(bio, 0); - BIO_clear_flags(bio, -1); - } - - return(1); + if (bio == NULL) { + return(0); + } + + dprintf("BioFree(%p) called", bio); + + if (BIO_get_shutdown(bio)) { + if (BIO_get_init(bio)) { + /*shutdown(bio->num, 2) */ + /*closesocket(bio->num) */ + } + + BIO_set_init(bio, 0); + BIO_clear_flags(bio, -1); + } + return(1); } BIO *BIO_new_tcl(State *statePtr, int flags) { - BIO *bio; - static BIO_METHOD *BioMethods = NULL; -#ifdef TCLTLS_SSL_USE_FASTPATH - Tcl_Channel parentChannel; - const Tcl_ChannelType *parentChannelType; - void *parentChannelFdIn_p, *parentChannelFdOut_p; - int parentChannelFdIn, parentChannelFdOut, parentChannelFd; - int validParentChannelFd; - int tclGetChannelHandleRet; -#endif - - dprintf("BIO_new_tcl() called"); - - if (BioMethods == NULL) { - BioMethods = BIO_meth_new(BIO_TYPE_TCL, "tcl"); - BIO_meth_set_write(BioMethods, BioWrite); - BIO_meth_set_read(BioMethods, BioRead); - BIO_meth_set_puts(BioMethods, BioPuts); - BIO_meth_set_ctrl(BioMethods, BioCtrl); - BIO_meth_set_create(BioMethods, BioNew); - BIO_meth_set_destroy(BioMethods, BioFree); - } - - if (statePtr == NULL) { - dprintf("Asked to setup a NULL state, just creating the initial configuration"); - - return(NULL); - } - -#ifdef TCLTLS_SSL_USE_FASTPATH - /* - * If the channel can be mapped back to a file descriptor, just use the file descriptor - * with the SSL library since it will likely be optimized for this. - */ - parentChannel = Tls_GetParent(statePtr, 0); - parentChannelType = Tcl_GetChannelType(parentChannel); - - validParentChannelFd = 0; - if (strcmp(parentChannelType->typeName, "tcp") == 0) { - tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_READABLE, (ClientData) &parentChannelFdIn_p); - if (tclGetChannelHandleRet == TCL_OK) { - tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_WRITABLE, (ClientData) &parentChannelFdOut_p); - if (tclGetChannelHandleRet == TCL_OK) { - parentChannelFdIn = PTR2INT(parentChannelFdIn_p); - parentChannelFdOut = PTR2INT(parentChannelFdOut_p); - if (parentChannelFdIn == parentChannelFdOut) { - parentChannelFd = parentChannelFdIn; - validParentChannelFd = 1; - } - } - } - } - - if (validParentChannelFd) { - dprintf("We found a shortcut, this channel is backed by a socket: %i", parentChannelFdIn); - bio = BIO_new_socket(parentChannelFd, flags); - statePtr->flags |= TLS_TCL_FASTPATH; - return(bio); - } - - dprintf("Falling back to Tcl I/O for this channel"); -#endif - - bio = BIO_new(BioMethods); - BIO_set_data(bio, statePtr); - BIO_set_shutdown(bio, flags); - BIO_set_init(bio, 1); - - return(bio); + BIO *bio; + static BIO_METHOD *BioMethods = NULL; +#ifdef TCLTLS_SSL_USE_FASTPATH + Tcl_Channel parentChannel; + const Tcl_ChannelType *parentChannelType; + void *parentChannelFdIn_p, *parentChannelFdOut_p; + int parentChannelFdIn, parentChannelFdOut, parentChannelFd; + int validParentChannelFd; + int tclGetChannelHandleRet; +#endif + + dprintf("BIO_new_tcl() called"); + + if (BioMethods == NULL) { + BioMethods = BIO_meth_new(BIO_TYPE_TCL, "tcl"); + BIO_meth_set_write(BioMethods, BioWrite); + BIO_meth_set_read(BioMethods, BioRead); + BIO_meth_set_puts(BioMethods, BioPuts); + BIO_meth_set_ctrl(BioMethods, BioCtrl); + BIO_meth_set_create(BioMethods, BioNew); + BIO_meth_set_destroy(BioMethods, BioFree); + } + + if (statePtr == NULL) { + dprintf("Asked to setup a NULL state, just creating the initial configuration"); + + return(NULL); + } + +#ifdef TCLTLS_SSL_USE_FASTPATH + /* + * If the channel can be mapped back to a file descriptor, just use the file descriptor + * with the SSL library since it will likely be optimized for this. + */ + parentChannel = Tls_GetParent(statePtr, 0); + parentChannelType = Tcl_GetChannelType(parentChannel); + + validParentChannelFd = 0; + if (strcmp(parentChannelType->typeName, "tcp") == 0) { + tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_READABLE, (ClientData) &parentChannelFdIn_p); + if (tclGetChannelHandleRet == TCL_OK) { + tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_WRITABLE, (ClientData) &parentChannelFdOut_p); + if (tclGetChannelHandleRet == TCL_OK) { + parentChannelFdIn = PTR2INT(parentChannelFdIn_p); + parentChannelFdOut = PTR2INT(parentChannelFdOut_p); + if (parentChannelFdIn == parentChannelFdOut) { + parentChannelFd = parentChannelFdIn; + validParentChannelFd = 1; + } + } + } + } + + if (validParentChannelFd) { + dprintf("We found a shortcut, this channel is backed by a socket: %i", parentChannelFdIn); + bio = BIO_new_socket(parentChannelFd, flags); + statePtr->flags |= TLS_TCL_FASTPATH; + return(bio); + } + + dprintf("Falling back to Tcl I/O for this channel"); +#endif + + bio = BIO_new(BioMethods); + BIO_set_data(bio, statePtr); + BIO_set_shutdown(bio, flags); + BIO_set_init(bio, 1); + return(bio); } Index: tlsIO.c ================================================================== --- tlsIO.c +++ tlsIO.c @@ -10,12 +10,12 @@ * Addition credit is due for Andreas Kupries (a.kupries@westend.com), for * providing the Tcl_ReplaceChannel mechanism and working closely with me * to enhance it to support full fileevent semantics. * * Also work done by the follow people provided the impetus to do this "right": - * tclSSL (Colin McCormack, Shared Technology) - * SSLtcl (Peter Antman) + * tclSSL (Colin McCormack, Shared Technology) + * SSLtcl (Peter Antman) * */ #include "tlsInt.h" @@ -32,59 +32,58 @@ /* *------------------------------------------------------------------- * * TlsBlockModeProc -- * - * This procedure is invoked by the generic IO level + * This procedure is invoked by the generic IO level * to set blocking and nonblocking modes * Results: - * 0 if successful, errno when failed. + * 0 if successful, errno when failed. * * Side effects: - * Sets the device into blocking or nonblocking mode. + * Sets the device into blocking or nonblocking mode. * *------------------------------------------------------------------- */ static int TlsBlockModeProc(ClientData instanceData, int mode) { - State *statePtr = (State *) instanceData; - - if (mode == TCL_MODE_NONBLOCKING) { - statePtr->flags |= TLS_TCL_ASYNC; - } else { - statePtr->flags &= ~(TLS_TCL_ASYNC); - } - - return(0); + State *statePtr = (State *) instanceData; + + if (mode == TCL_MODE_NONBLOCKING) { + statePtr->flags |= TLS_TCL_ASYNC; + } else { + statePtr->flags &= ~(TLS_TCL_ASYNC); + } + return(0); } /* *------------------------------------------------------------------- * * TlsCloseProc -- * - * This procedure is invoked by the generic IO level to perform - * channel-type-specific cleanup when a SSL socket based channel - * is closed. + * This procedure is invoked by the generic IO level to perform + * channel-type-specific cleanup when a SSL socket based channel + * is closed. * - * Note: we leave the underlying socket alone, is this right? + * Note: we leave the underlying socket alone, is this right? * * Results: - * 0 if successful, the value of Tcl_GetErrno() if failed. + * 0 if successful, the value of Tcl_GetErrno() if failed. * * Side effects: - * Closes the socket of the channel. + * Closes the socket of the channel. * *------------------------------------------------------------------- */ static int TlsCloseProc(ClientData instanceData, Tcl_Interp *interp) { - State *statePtr = (State *) instanceData; + State *statePtr = (State *) instanceData; - dprintf("TlsCloseProc(%p)", (void *) statePtr); + dprintf("TlsCloseProc(%p)", (void *) statePtr); - Tls_Clean(statePtr); - Tcl_EventuallyFree((ClientData)statePtr, Tls_Free); - return(0); + Tls_Clean(statePtr); + Tcl_EventuallyFree((ClientData)statePtr, Tls_Free); + return(0); /* Interp is unused. */ interp = interp; } @@ -96,491 +95,492 @@ } /* *------------------------------------------------------* * - * Tls_WaitForConnect -- + * Tls_WaitForConnect -- * - * Sideeffects: - * Issues SSL_accept or SSL_connect + * Sideeffects: + * Issues SSL_accept or SSL_connect * - * Result: - * None. + * Result: + * None. * *------------------------------------------------------* */ int Tls_WaitForConnect(State *statePtr, int *errorCodePtr, int handshakeFailureIsPermanent) { - unsigned long backingError; - int err, rc; - int bioShouldRetry; - - dprintf("WaitForConnect(%p)", (void *) statePtr); - dprintFlags(statePtr); - - if (!(statePtr->flags & TLS_TCL_INIT)) { - dprintf("Tls_WaitForConnect called on already initialized channel -- returning with immediate success"); - *errorCodePtr = 0; - return(0); - } - - if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) { - /* - * Different types of operations have different requirements - * SSL being established - */ - if (handshakeFailureIsPermanent) { - dprintf("Asked to wait for a TLS handshake that has already failed. Returning fatal error"); - *errorCodePtr = ECONNABORTED; - } else { - dprintf("Asked to wait for a TLS handshake that has already failed. Returning soft error"); - *errorCodePtr = ECONNRESET; - } - return(-1); - } - - for (;;) { - /* Not initialized yet! */ - if (statePtr->flags & TLS_TCL_SERVER) { - dprintf("Calling SSL_accept()"); - - err = SSL_accept(statePtr->ssl); - } else { - dprintf("Calling SSL_connect()"); - - err = SSL_connect(statePtr->ssl); - } - - if (err > 0) { - dprintf("That seems to have gone okay"); - - err = BIO_flush(statePtr->bio); - - if (err <= 0) { - dprintf("Flushing the lower layers failed, this will probably terminate this session"); - } - } - - rc = SSL_get_error(statePtr->ssl, err); - - dprintf("Got error: %i (rc = %i)", err, rc); - - bioShouldRetry = 0; - if (err <= 0) { - if (rc == SSL_ERROR_WANT_CONNECT || rc == SSL_ERROR_WANT_ACCEPT || rc == SSL_ERROR_WANT_READ || rc == SSL_ERROR_WANT_WRITE) { - bioShouldRetry = 1; - } else if (BIO_should_retry(statePtr->bio)) { - bioShouldRetry = 1; - } else if (rc == SSL_ERROR_SYSCALL && Tcl_GetErrno() == EAGAIN) { - bioShouldRetry = 1; - } - } else { - if (!SSL_is_init_finished(statePtr->ssl)) { - bioShouldRetry = 1; - } - } - - if (bioShouldRetry) { - dprintf("The I/O did not complete -- but we should try it again"); - - if (statePtr->flags & TLS_TCL_ASYNC) { - dprintf("Returning EAGAIN so that it can be retried later"); - - *errorCodePtr = EAGAIN; - - return(-1); - } else { - dprintf("Doing so now"); - - continue; - } - } - - dprintf("We have either completely established the session or completely failed it -- there is no more need to ever retry it though"); - break; - } - - - *errorCodePtr = EINVAL; - - switch (rc) { - case SSL_ERROR_NONE: - /* The connection is up, we are done here */ - dprintf("The connection is up"); - break; - case SSL_ERROR_ZERO_RETURN: - dprintf("SSL_ERROR_ZERO_RETURN: Connect returned an invalid value...") - return(-1); - case SSL_ERROR_SYSCALL: - backingError = ERR_get_error(); - - if (backingError == 0 && err == 0) { - dprintf("EOF reached") - *errorCodePtr = ECONNRESET; - } else if (backingError == 0 && err == -1) { - dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno()); - *errorCodePtr = Tcl_GetErrno(); - if (*errorCodePtr == ECONNRESET) { - *errorCodePtr = ECONNABORTED; - } - } else { - dprintf("I/O error occurred (backingError = %lu)", backingError); - *errorCodePtr = backingError; - if (*errorCodePtr == ECONNRESET) { - *errorCodePtr = ECONNABORTED; - } - } - - statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED; - - return(-1); - case SSL_ERROR_SSL: - dprintf("Got permanent fatal SSL error, aborting immediately"); - Tls_Error(statePtr, (char *)ERR_reason_error_string(ERR_get_error())); - statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED; - *errorCodePtr = ECONNABORTED; - return(-1); - case SSL_ERROR_WANT_CONNECT: - case SSL_ERROR_WANT_ACCEPT: - case SSL_ERROR_WANT_X509_LOOKUP: - default: - dprintf("We got a confusing reply: %i", rc); - *errorCodePtr = Tcl_GetErrno(); - dprintf("ERR(%d, %d) ", rc, *errorCodePtr); - return(-1); - } + unsigned long backingError; + int err, rc; + int bioShouldRetry; + + dprintf("WaitForConnect(%p)", (void *) statePtr); + dprintFlags(statePtr); + + if (!(statePtr->flags & TLS_TCL_INIT)) { + dprintf("Tls_WaitForConnect called on already initialized channel -- returning with immediate success"); + *errorCodePtr = 0; + return(0); + } + + if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) { + /* + * Different types of operations have different requirements + * SSL being established + */ + if (handshakeFailureIsPermanent) { + dprintf("Asked to wait for a TLS handshake that has already failed. Returning fatal error"); + *errorCodePtr = ECONNABORTED; + } else { + dprintf("Asked to wait for a TLS handshake that has already failed. Returning soft error"); + *errorCodePtr = ECONNRESET; + } + return(-1); + } + + for (;;) { + /* Not initialized yet! */ + if (statePtr->flags & TLS_TCL_SERVER) { + dprintf("Calling SSL_accept()"); + err = SSL_accept(statePtr->ssl); + + } else { + dprintf("Calling SSL_connect()"); + err = SSL_connect(statePtr->ssl); + } + + if (err > 0) { + dprintf("That seems to have gone okay"); + + err = BIO_flush(statePtr->bio); + if (err <= 0) { + dprintf("Flushing the lower layers failed, this will probably terminate this session"); + } + } + + rc = SSL_get_error(statePtr->ssl, err); + + dprintf("Got error: %i (rc = %i)", err, rc); + + bioShouldRetry = 0; + if (err <= 0) { + if (rc == SSL_ERROR_WANT_CONNECT || rc == SSL_ERROR_WANT_ACCEPT || rc == SSL_ERROR_WANT_READ || rc == SSL_ERROR_WANT_WRITE) { + bioShouldRetry = 1; + } else if (BIO_should_retry(statePtr->bio)) { + bioShouldRetry = 1; + } else if (rc == SSL_ERROR_SYSCALL && Tcl_GetErrno() == EAGAIN) { + bioShouldRetry = 1; + } + } else { + if (!SSL_is_init_finished(statePtr->ssl)) { + bioShouldRetry = 1; + } + } + + if (bioShouldRetry) { + dprintf("The I/O did not complete -- but we should try it again"); + + if (statePtr->flags & TLS_TCL_ASYNC) { + dprintf("Returning EAGAIN so that it can be retried later"); + + *errorCodePtr = EAGAIN; + return(-1); + } else { + dprintf("Doing so now"); + + continue; + } + } + + dprintf("We have either completely established the session or completely failed it -- there is no more need to ever retry it though"); + break; + } + + *errorCodePtr = EINVAL; + + switch (rc) { + case SSL_ERROR_NONE: + /* The connection is up, we are done here */ + dprintf("The connection is up"); + break; + case SSL_ERROR_ZERO_RETURN: + dprintf("SSL_ERROR_ZERO_RETURN: Connect returned an invalid value...") + return(-1); + case SSL_ERROR_SYSCALL: + backingError = ERR_get_error(); + + if (backingError == 0 && err == 0) { + dprintf("EOF reached") + *errorCodePtr = ECONNRESET; + } else if (backingError == 0 && err == -1) { + dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno()); + *errorCodePtr = Tcl_GetErrno(); + if (*errorCodePtr == ECONNRESET) { + *errorCodePtr = ECONNABORTED; + } + } else { + dprintf("I/O error occurred (backingError = %lu)", backingError); + *errorCodePtr = backingError; + if (*errorCodePtr == ECONNRESET) { + *errorCodePtr = ECONNABORTED; + } + } + + statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED; + return(-1); + + case SSL_ERROR_SSL: + dprintf("Got permanent fatal SSL error, aborting immediately"); + Tls_Error(statePtr, (char *)ERR_reason_error_string(ERR_get_error())); + statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED; + *errorCodePtr = ECONNABORTED; + return(-1); + + case SSL_ERROR_WANT_CONNECT: + case SSL_ERROR_WANT_ACCEPT: + case SSL_ERROR_WANT_X509_LOOKUP: + default: + dprintf("We got a confusing reply: %i", rc); + *errorCodePtr = Tcl_GetErrno(); + dprintf("ERR(%d, %d) ", rc, *errorCodePtr); + return(-1); + } #if 0 - if (statePtr->flags & TLS_TCL_SERVER) { - dprintf("This is an TLS server, checking the certificate for the peer"); - - err = SSL_get_verify_result(statePtr->ssl); - if (err != X509_V_OK) { - dprintf("Invalid certificate, returning in failure"); - - Tls_Error(statePtr, (char *)X509_verify_cert_error_string(err)); - statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED; - *errorCodePtr = ECONNABORTED; - return(-1); - } - } + if (statePtr->flags & TLS_TCL_SERVER) { + dprintf("This is an TLS server, checking the certificate for the peer"); + + err = SSL_get_verify_result(statePtr->ssl); + if (err != X509_V_OK) { + dprintf("Invalid certificate, returning in failure"); + + Tls_Error(statePtr, (char *)X509_verify_cert_error_string(err)); + statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED; + *errorCodePtr = ECONNABORTED; + return(-1); + } + } #endif - dprintf("Removing the \"TLS_TCL_INIT\" flag since we have completed the handshake"); - statePtr->flags &= ~TLS_TCL_INIT; + dprintf("Removing the \"TLS_TCL_INIT\" flag since we have completed the handshake"); + statePtr->flags &= ~TLS_TCL_INIT; - dprintf("Returning in success"); - *errorCodePtr = 0; - - return(0); + dprintf("Returning in success"); + *errorCodePtr = 0; + return(0); } /* *------------------------------------------------------------------- * * TlsInputProc -- * - * This procedure is invoked by the generic IO level + * This procedure is invoked by the generic IO level * to read input from a SSL socket based channel. * * Results: - * The number of bytes read is returned or -1 on error. An output - * argument contains the POSIX error code on error, or zero if no - * error occurred. - * - * Side effects: - * Reads input from the input device of the channel. - * - *------------------------------------------------------------------- - */ - -static int TlsInputProc(ClientData instanceData, char *buf, int bufSize, int *errorCodePtr) { - unsigned long backingError; - State *statePtr = (State *) instanceData; - int bytesRead; - int tlsConnect; - int err; - - *errorCodePtr = 0; - - dprintf("BIO_read(%d)", bufSize); - - if (statePtr->flags & TLS_TCL_CALLBACK) { - /* don't process any bytes while verify callback is running */ - dprintf("Callback is running, reading 0 bytes"); - return(0); - } - - dprintf("Calling Tls_WaitForConnect"); - tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 0); - if (tlsConnect < 0) { - dprintf("Got an error waiting to connect (tlsConnect = %i, *errorCodePtr = %i)", tlsConnect, *errorCodePtr); - - bytesRead = -1; - if (*errorCodePtr == ECONNRESET) { - dprintf("Got connection reset"); - /* Soft EOF */ - *errorCodePtr = 0; - bytesRead = 0; - } - - return(bytesRead); - } - - /* - * 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("BIO_read -> %d", bytesRead); - - err = SSL_get_error(statePtr->ssl, bytesRead); + * The number of bytes read is returned or -1 on error. An output + * argument contains the POSIX error code on error, or zero if no + * error occurred. + * + * Side effects: + * Reads input from the input device of the channel. + * + *------------------------------------------------------------------- + */ +static int TlsInputProc(ClientData instanceData, char *buf, int bufSize, int *errorCodePtr) { + unsigned long backingError; + State *statePtr = (State *) instanceData; + int bytesRead; + int tlsConnect; + int err; + + *errorCodePtr = 0; + + dprintf("BIO_read(%d)", bufSize); + + if (statePtr->flags & TLS_TCL_CALLBACK) { + /* don't process any bytes while verify callback is running */ + dprintf("Callback is running, reading 0 bytes"); + return(0); + } + + dprintf("Calling Tls_WaitForConnect"); + tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 0); + if (tlsConnect < 0) { + dprintf("Got an error waiting to connect (tlsConnect = %i, *errorCodePtr = %i)", tlsConnect, *errorCodePtr); + + bytesRead = -1; + if (*errorCodePtr == ECONNRESET) { + dprintf("Got connection reset"); + /* Soft EOF */ + *errorCodePtr = 0; + bytesRead = 0; + } + return(bytesRead); + } + + /* + * 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("BIO_read -> %d", bytesRead); + + err = SSL_get_error(statePtr->ssl, bytesRead); #if 0 - if (bytesRead <= 0) { - if (BIO_should_retry(statePtr->bio)) { - dprintf("I/O failed, will retry based on EAGAIN"); - *errorCodePtr = EAGAIN; - } + if (bytesRead <= 0) { + if (BIO_should_retry(statePtr->bio)) { + dprintf("I/O failed, will retry based on EAGAIN"); + *errorCodePtr = EAGAIN; } + } #endif - switch (err) { - case SSL_ERROR_NONE: - dprintBuffer(buf, bytesRead); - break; - case SSL_ERROR_SSL: - dprintf("SSL negotiation error, indicating that the connection has been aborted"); - - Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, bytesRead)); - *errorCodePtr = ECONNABORTED; - bytesRead = -1; - - break; - case SSL_ERROR_SYSCALL: - backingError = ERR_get_error(); - - if (backingError == 0 && bytesRead == 0) { - dprintf("EOF reached") - *errorCodePtr = 0; - bytesRead = 0; - } else if (backingError == 0 && bytesRead == -1) { - dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno()); - *errorCodePtr = Tcl_GetErrno(); - bytesRead = -1; - } else { - dprintf("I/O error occurred (backingError = %lu)", backingError); - *errorCodePtr = backingError; - bytesRead = -1; - } - - break; - case SSL_ERROR_ZERO_RETURN: - dprintf("Got SSL_ERROR_ZERO_RETURN, this means an EOF has been reached"); - bytesRead = 0; - *errorCodePtr = 0; - break; - case SSL_ERROR_WANT_READ: - dprintf("Got SSL_ERROR_WANT_READ, mapping this to EAGAIN"); - bytesRead = -1; - *errorCodePtr = EAGAIN; - break; - default: - dprintf("Unknown error (err = %i), mapping to EOF", err); - *errorCodePtr = 0; - bytesRead = 0; - break; - } - - dprintf("Input(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr); - return(bytesRead); + switch (err) { + case SSL_ERROR_NONE: + dprintBuffer(buf, bytesRead); + break; + + case SSL_ERROR_SSL: + dprintf("SSL negotiation error, indicating that the connection has been aborted"); + + Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, bytesRead)); + *errorCodePtr = ECONNABORTED; + bytesRead = -1; + break; + + case SSL_ERROR_SYSCALL: + backingError = ERR_get_error(); + + if (backingError == 0 && bytesRead == 0) { + dprintf("EOF reached") + *errorCodePtr = 0; + bytesRead = 0; + } else if (backingError == 0 && bytesRead == -1) { + dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno()); + *errorCodePtr = Tcl_GetErrno(); + bytesRead = -1; + } else { + dprintf("I/O error occurred (backingError = %lu)", backingError); + *errorCodePtr = backingError; + bytesRead = -1; + } + break; + + case SSL_ERROR_ZERO_RETURN: + dprintf("Got SSL_ERROR_ZERO_RETURN, this means an EOF has been reached"); + bytesRead = 0; + *errorCodePtr = 0; + break; + + case SSL_ERROR_WANT_READ: + dprintf("Got SSL_ERROR_WANT_READ, mapping this to EAGAIN"); + bytesRead = -1; + *errorCodePtr = EAGAIN; + break; + + default: + dprintf("Unknown error (err = %i), mapping to EOF", err); + *errorCodePtr = 0; + bytesRead = 0; + break; + } + + dprintf("Input(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr); + return(bytesRead); } /* *------------------------------------------------------------------- * * TlsOutputProc -- * - * This procedure is invoked by the generic IO level + * This procedure is invoked by the generic IO level * to write output to a SSL socket based channel. * * Results: - * The number of bytes written is returned. An output argument is - * set to a POSIX error code if an error occurred, or zero. - * - * Side effects: - * Writes output on the output device of the channel. - * - *------------------------------------------------------------------- - */ - -static int TlsOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr) { - unsigned long backingError; - State *statePtr = (State *) instanceData; - int written, err; - int tlsConnect; - - *errorCodePtr = 0; - - dprintf("BIO_write(%p, %d)", (void *) statePtr, toWrite); - dprintBuffer(buf, toWrite); - - if (statePtr->flags & TLS_TCL_CALLBACK) { - dprintf("Don't process output while callbacks are running") - written = -1; - *errorCodePtr = EAGAIN; - return(-1); - } - - dprintf("Calling Tls_WaitForConnect"); - tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 1); - if (tlsConnect < 0) { - dprintf("Got an error waiting to connect (tlsConnect = %i, *errorCodePtr = %i)", tlsConnect, *errorCodePtr); - - written = -1; - if (*errorCodePtr == ECONNRESET) { - dprintf("Got connection reset"); - /* Soft EOF */ - *errorCodePtr = 0; - written = 0; - } - - return(written); - } - - if (toWrite == 0) { - dprintf("zero-write"); - err = BIO_flush(statePtr->bio); - - if (err <= 0) { - dprintf("Flushing failed"); - - *errorCodePtr = EIO; - written = 0; - return(-1); - } - - written = 0; - *errorCodePtr = 0; - return(0); - } - - /* - * 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("BIO_write(%p, %d) -> [%d]", (void *) statePtr, toWrite, written); - - err = SSL_get_error(statePtr->ssl, written); - switch (err) { - case SSL_ERROR_NONE: - if (written < 0) { - written = 0; - } - break; - case SSL_ERROR_WANT_WRITE: - dprintf("Got SSL_ERROR_WANT_WRITE, mapping it to EAGAIN"); - *errorCodePtr = EAGAIN; - written = -1; - break; - case SSL_ERROR_WANT_READ: - dprintf(" write R BLOCK"); - break; - case SSL_ERROR_WANT_X509_LOOKUP: - dprintf(" write X BLOCK"); - break; - case SSL_ERROR_ZERO_RETURN: - dprintf(" closed"); - written = 0; - *errorCodePtr = 0; - break; - case SSL_ERROR_SYSCALL: - backingError = ERR_get_error(); - - if (backingError == 0 && written == 0) { - dprintf("EOF reached") - *errorCodePtr = 0; - written = 0; - } else if (backingError == 0 && written == -1) { - dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno()); - *errorCodePtr = Tcl_GetErrno(); - written = -1; - } else { - dprintf("I/O error occurred (backingError = %lu)", backingError); - *errorCodePtr = backingError; - written = -1; - } - - break; - case SSL_ERROR_SSL: - Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, written)); - *errorCodePtr = ECONNABORTED; - written = -1; - break; - default: - dprintf(" unknown err: %d", err); - break; - } - - dprintf("Output(%d) -> %d", toWrite, written); - return(written); + * The number of bytes written is returned. An output argument is + * set to a POSIX error code if an error occurred, or zero. + * + * Side effects: + * Writes output on the output device of the channel. + * + *------------------------------------------------------------------- + */ +static int TlsOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr) { + unsigned long backingError; + State *statePtr = (State *) instanceData; + int written, err; + int tlsConnect; + + *errorCodePtr = 0; + + dprintf("BIO_write(%p, %d)", (void *) statePtr, toWrite); + dprintBuffer(buf, toWrite); + + if (statePtr->flags & TLS_TCL_CALLBACK) { + dprintf("Don't process output while callbacks are running"); + written = -1; + *errorCodePtr = EAGAIN; + return(-1); + } + + dprintf("Calling Tls_WaitForConnect"); + tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 1); + if (tlsConnect < 0) { + dprintf("Got an error waiting to connect (tlsConnect = %i, *errorCodePtr = %i)", tlsConnect, *errorCodePtr); + + written = -1; + if (*errorCodePtr == ECONNRESET) { + dprintf("Got connection reset"); + /* Soft EOF */ + *errorCodePtr = 0; + written = 0; + } + return(written); + } + + if (toWrite == 0) { + dprintf("zero-write"); + err = BIO_flush(statePtr->bio); + + if (err <= 0) { + dprintf("Flushing failed"); + + *errorCodePtr = EIO; + written = 0; + return(-1); + } + + written = 0; + *errorCodePtr = 0; + return(0); + } + + /* + * 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("BIO_write(%p, %d) -> [%d]", (void *) statePtr, toWrite, written); + + err = SSL_get_error(statePtr->ssl, written); + switch (err) { + case SSL_ERROR_NONE: + if (written < 0) { + written = 0; + } + break; + + case SSL_ERROR_WANT_WRITE: + dprintf("Got SSL_ERROR_WANT_WRITE, mapping it to EAGAIN"); + *errorCodePtr = EAGAIN; + written = -1; + break; + + case SSL_ERROR_WANT_READ: + dprintf(" write R BLOCK"); + break; + + case SSL_ERROR_WANT_X509_LOOKUP: + dprintf(" write X BLOCK"); + break; + + case SSL_ERROR_ZERO_RETURN: + dprintf(" closed"); + written = 0; + *errorCodePtr = 0; + break; + + case SSL_ERROR_SYSCALL: + backingError = ERR_get_error(); + + if (backingError == 0 && written == 0) { + dprintf("EOF reached") + *errorCodePtr = 0; + written = 0; + } else if (backingError == 0 && written == -1) { + dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno()); + *errorCodePtr = Tcl_GetErrno(); + written = -1; + } else { + dprintf("I/O error occurred (backingError = %lu)", backingError); + *errorCodePtr = backingError; + written = -1; + } + break; + + case SSL_ERROR_SSL: + Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, written)); + *errorCodePtr = ECONNABORTED; + written = -1; + break; + + default: + dprintf(" unknown err: %d", err); + break; + } + + dprintf("Output(%d) -> %d", toWrite, written); + return(written); } /* *------------------------------------------------------------------- * * TlsSetOptionProc -- * - * Computes an option value for a SSL socket based channel, or a - * list of all options and their values. + * Computes an option value for a SSL socket based channel, or a + * list of all options and their values. * * Results: - * A standard Tcl result. The value of the specified option or a - * list of all options and their values is returned in the - * supplied DString. + * A standard Tcl result. The value of the specified option or a + * list of all options and their values is returned in the + * supplied DString. * * Side effects: - * None. + * None. * *------------------------------------------------------------------- */ static int -TlsSetOptionProc(ClientData instanceData, /* Socket state. */ - Tcl_Interp *interp, /* For errors - can be NULL. */ - const char *optionName, /* Name of the option to set the value for, or - * NULL to get all options and their values. */ - const char *optionValue) /* Value for option. */ +TlsSetOptionProc(ClientData instanceData, /* Socket state. */ + Tcl_Interp *interp, /* For errors - can be NULL. */ + const char *optionName, /* Name of the option to set the value for, or + * NULL to get all options and their values. */ + const char *optionValue) /* Value for option. */ { State *statePtr = (State *) instanceData; - Tcl_Channel downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH); - Tcl_DriverSetOptionProc *setOptionProc; + Tcl_Channel downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH); + Tcl_DriverSetOptionProc *setOptionProc; setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(downChan)); if (setOptionProc != NULL) { return (*setOptionProc)(Tcl_GetChannelInstanceData(downChan), interp, optionName, optionValue); } else if (optionName == (char*) NULL) { /* * Request is query for all options, this is ok. */ - return TCL_OK; + return TCL_OK; } /* * Request for a specific option has to fail, we don't have any. */ return TCL_ERROR; @@ -589,44 +589,43 @@ /* *------------------------------------------------------------------- * * TlsGetOptionProc -- * - * Computes an option value for a SSL socket based channel, or a - * list of all options and their values. + * Computes an option value for a SSL socket based channel, or a + * list of all options and their values. * * Results: - * A standard Tcl result. The value of the specified option or a - * list of all options and their values is returned in the - * supplied DString. + * A standard Tcl result. The value of the specified option or a + * list of all options and their values is returned in the + * supplied DString. * * Side effects: - * None. + * None. * *------------------------------------------------------------------- */ static int -TlsGetOptionProc(ClientData instanceData, /* Socket state. */ - Tcl_Interp *interp, /* For errors - can be NULL. */ - const char *optionName, /* Name of the option to retrieve the value for, or - * NULL to get all options and their values. */ - Tcl_DString *dsPtr) /* Where to store the computed value - * initialized by caller. */ +TlsGetOptionProc(ClientData instanceData, /* Socket state. */ + Tcl_Interp *interp, /* For errors - can be NULL. */ + const char *optionName, /* Name of the option to retrieve the value for, or + * NULL to get all options and their values. */ + Tcl_DString *dsPtr) /* Where to store the computed value initialized by caller. */ { State *statePtr = (State *) instanceData; - Tcl_Channel downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH); - Tcl_DriverGetOptionProc *getOptionProc; + Tcl_Channel downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH); + Tcl_DriverGetOptionProc *getOptionProc; getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan)); if (getOptionProc != NULL) { - return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan), interp, optionName, dsPtr); + return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan), interp, optionName, dsPtr); } else if (optionName == (char*) NULL) { - /* - * Request is query for all options, this is ok. - */ - return TCL_OK; + /* + * Request is query for all options, this is ok. + */ + return TCL_OK; } /* * Request for a specific option has to fail, we don't have any. */ return TCL_ERROR; @@ -635,78 +634,71 @@ /* *------------------------------------------------------------------- * * TlsWatchProc -- * - * Initialize the notifier to watch Tcl_Files from this channel. + * Initialize the notifier to watch Tcl_Files from this channel. * * Results: - * None. + * None. * * Side effects: - * Sets up the notifier so that a future event on the channel - * will be seen by Tcl. + * Sets up the notifier so that a future event on the channel + * will be seen by Tcl. * *------------------------------------------------------------------- */ - static void -TlsWatchProc(ClientData instanceData, /* The socket state. */ - int mask) /* Events of interest; an OR-ed combination of */ - /* TCL_READABLE, TCL_WRITABLE and TCL_EXCEPTION. */ +TlsWatchProc(ClientData instanceData, /* The socket state. */ + int mask) /* Events of interest; an OR-ed combination of + * TCL_READABLE, TCL_WRITABLE and TCL_EXCEPTION. */ { Tcl_Channel downChan; State *statePtr = (State *) instanceData; dprintf("TlsWatchProc(0x%x)", mask); - /* Pretend to be dead as long as the verify callback is running. + /* Pretend to be dead as long as the verify callback is running. * Otherwise that callback could be invoked recursively. */ if (statePtr->flags & TLS_TCL_CALLBACK) { - dprintf("Callback is on-going, doing nothing"); - return; + dprintf("Callback is on-going, doing nothing"); + return; } dprintFlags(statePtr); downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH); if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) { - dprintf("Asked to watch a socket with a failed handshake -- nothing can happen here"); - + dprintf("Asked to watch a socket with a failed handshake -- nothing can happen here"); dprintf("Unregistering interest in the lower channel"); - (Tcl_GetChannelType(downChan))->watchProc(Tcl_GetChannelInstanceData(downChan), 0); + (Tcl_GetChannelType(downChan))->watchProc(Tcl_GetChannelInstanceData(downChan), 0); statePtr->watchMask = 0; - - return; - } - - statePtr->watchMask = mask; - - /* No channel handlers any more. We will be notified automatically - * about events on the channel below via a call to our - * 'TransformNotifyProc'. But we have to pass the interest down now. - * We are allowed to add additional 'interest' to the mask if we want - * to. But this transformation has no such interest. It just passes - * the request down, unchanged. - */ - - - dprintf("Registering our interest in the lower channel (chan=%p)", (void *) downChan); - (Tcl_GetChannelType(downChan)) - ->watchProc(Tcl_GetChannelInstanceData(downChan), mask); - - /* - * Management of the internal timer. - */ - - if (statePtr->timer != (Tcl_TimerToken) NULL) { - dprintf("A timer was found, deleting it"); - Tcl_DeleteTimerHandler(statePtr->timer); - statePtr->timer = (Tcl_TimerToken) NULL; - } + return; + } + + statePtr->watchMask = mask; + + /* No channel handlers any more. We will be notified automatically + * about events on the channel below via a call to our + * 'TransformNotifyProc'. But we have to pass the interest down now. + * We are allowed to add additional 'interest' to the mask if we want + * to. But this transformation has no such interest. It just passes + * the request down, unchanged. + */ + dprintf("Registering our interest in the lower channel (chan=%p)", (void *) downChan); + (Tcl_GetChannelType(downChan))->watchProc(Tcl_GetChannelInstanceData(downChan), mask); + + /* + * Management of the internal timer. + */ + if (statePtr->timer != (Tcl_TimerToken) NULL) { + dprintf("A timer was found, deleting it"); + Tcl_DeleteTimerHandler(statePtr->timer); + statePtr->timer = (Tcl_TimerToken) NULL; + } if ((mask & TCL_READABLE) && ((Tcl_InputBuffered(statePtr->self) > 0) || (BIO_ctrl_pending(statePtr->bio) > 0))) { /* * There is interest in readable events and we actually have @@ -720,85 +712,84 @@ /* *------------------------------------------------------------------- * * TlsGetHandleProc -- * - * Called from Tcl_GetChannelFile to retrieve o/s file handler - * from the SSL socket based channel. + * Called from Tcl_GetChannelFile to retrieve o/s file handler + * from the SSL socket based channel. * * Results: - * The appropriate Tcl_File or NULL if not present. + * The appropriate Tcl_File or NULL if not present. * * Side effects: - * None. + * None. * *------------------------------------------------------------------- */ static int TlsGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr) { - State *statePtr = (State *) instanceData; + State *statePtr = (State *) instanceData; - return(Tcl_GetChannelHandle(Tls_GetParent(statePtr, TLS_TCL_FASTPATH), direction, handlePtr)); + return(Tcl_GetChannelHandle(Tls_GetParent(statePtr, TLS_TCL_FASTPATH), direction, handlePtr)); } /* *------------------------------------------------------------------- * * TlsNotifyProc -- * - * Handler called by Tcl to inform us of activity - * on the underlying channel. + * Handler called by Tcl to inform us of activity + * on the underlying channel. * * Results: - * None. + * None. * * Side effects: - * May process the incoming event by itself. + * May process the incoming event by itself. * *------------------------------------------------------------------- */ - -static int TlsNotifyProc(ClientData instanceData, int mask) { - State *statePtr = (State *) instanceData; - int errorCode; - - /* - * An event occurred in the underlying channel. This - * transformation doesn't process such events thus returns the - * incoming mask unchanged. - */ - if (statePtr->timer != (Tcl_TimerToken) NULL) { - /* - * Delete an existing timer. It was not fired, yet we are - * here, so the channel below generated such an event and we - * don't have to. The renewal of the interest after the - * execution of channel handlers will eventually cause us to - * recreate the timer (in WatchProc). - */ - Tcl_DeleteTimerHandler(statePtr->timer); - statePtr->timer = (Tcl_TimerToken) NULL; - } - - if (statePtr->flags & TLS_TCL_CALLBACK) { - dprintf("Returning 0 due to callback"); - return 0; - } - - dprintf("Calling Tls_WaitForConnect"); - errorCode = 0; - if (Tls_WaitForConnect(statePtr, &errorCode, 1) < 0) { - if (errorCode == EAGAIN) { - dprintf("Async flag could be set (didn't check) and errorCode == EAGAIN: Returning 0"); - - return 0; - } - - dprintf("Tls_WaitForConnect returned an error"); - } - - dprintf("Returning %i", mask); - - return(mask); +static int TlsNotifyProc(ClientData instanceData, int mask) { + State *statePtr = (State *) instanceData; + int errorCode; + + /* + * An event occurred in the underlying channel. This + * transformation doesn't process such events thus returns the + * incoming mask unchanged. + */ + if (statePtr->timer != (Tcl_TimerToken) NULL) { + /* + * Delete an existing timer. It was not fired, yet we are + * here, so the channel below generated such an event and we + * don't have to. The renewal of the interest after the + * execution of channel handlers will eventually cause us to + * recreate the timer (in WatchProc). + */ + Tcl_DeleteTimerHandler(statePtr->timer); + statePtr->timer = (Tcl_TimerToken) NULL; + } + + if (statePtr->flags & TLS_TCL_CALLBACK) { + dprintf("Returning 0 due to callback"); + return 0; + } + + dprintf("Calling Tls_WaitForConnect"); + errorCode = 0; + if (Tls_WaitForConnect(statePtr, &errorCode, 1) < 0) { + if (errorCode == EAGAIN) { + dprintf("Async flag could be set (didn't check) and errorCode == EAGAIN: Returning 0"); + + return 0; + } + + dprintf("Tls_WaitForConnect returned an error"); + } + + dprintf("Returning %i", mask); + + return(mask); } #if 0 /* *------------------------------------------------------* @@ -818,17 +809,16 @@ * Result: * None. * *------------------------------------------------------* */ - static void TlsChannelHandler (ClientData clientData, int mask) { State *statePtr = (State *) clientData; dprintf("HANDLER(0x%x)", mask); - Tcl_Preserve( (ClientData)statePtr); + Tcl_Preserve((ClientData)statePtr); if (mask & TCL_READABLE) { BIO_set_flags(statePtr->p_bio, BIO_FLAGS_READ); } else { BIO_clear_flags(statePtr->p_bio, BIO_FLAGS_READ); @@ -858,147 +848,143 @@ * * stanton: It looks like this could result in an infinite loop if * the upper channel doesn't cause ChannelHandler to be removed * before Tcl_NotifyChannel calls channel handlers on the lower channel. */ - Tcl_NotifyChannel(statePtr->self, mask); - + if (statePtr->timer != (Tcl_TimerToken)NULL) { Tcl_DeleteTimerHandler(statePtr->timer); statePtr->timer = (Tcl_TimerToken)NULL; } if ((mask & TCL_READABLE) && Tcl_InputBuffered(statePtr->self) > 0) { /* * Data is waiting, flush it out in short time */ - statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, - TlsChannelHandlerTimer, (ClientData) statePtr); + statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, (ClientData) statePtr); } - Tcl_Release( (ClientData)statePtr); + Tcl_Release((ClientData)statePtr); } #endif /* *------------------------------------------------------* * - * TlsChannelHandlerTimer -- - * - * ------------------------------------------------* - * Called by the notifier (-> timer) to flush out - * information waiting in channel buffers. - * ------------------------------------------------* - * - * Sideeffects: - * As of 'TlsChannelHandler'. - * - * Result: - * None. + * TlsChannelHandlerTimer -- + * + * ------------------------------------------------* + * Called by the notifier (-> timer) to flush out + * information waiting in channel buffers. + * ------------------------------------------------* + * + * Sideeffects: + * As of 'TlsChannelHandler'. + * + * Result: + * None. * *------------------------------------------------------* */ - static void TlsChannelHandlerTimer(ClientData clientData) { - State *statePtr = (State *) clientData; - int mask = 0; - - dprintf("Called"); - - statePtr->timer = (Tcl_TimerToken) NULL; - - if (BIO_wpending(statePtr->bio)) { - dprintf("[chan=%p] BIO writable", statePtr->self); - - mask |= TCL_WRITABLE; - } - - if (BIO_pending(statePtr->bio)) { - dprintf("[chan=%p] BIO readable", statePtr->self); - - mask |= TCL_READABLE; - } - - dprintf("Notifying ourselves"); - Tcl_NotifyChannel(statePtr->self, mask); - - dprintf("Returning"); - - return; + State *statePtr = (State *) clientData; + int mask = 0; + + dprintf("Called"); + + statePtr->timer = (Tcl_TimerToken) NULL; + + if (BIO_wpending(statePtr->bio)) { + dprintf("[chan=%p] BIO writable", statePtr->self); + + mask |= TCL_WRITABLE; + } + + if (BIO_pending(statePtr->bio)) { + dprintf("[chan=%p] BIO readable", statePtr->self); + + mask |= TCL_READABLE; + } + + dprintf("Notifying ourselves"); + Tcl_NotifyChannel(statePtr->self, mask); + + dprintf("Returning"); + + return; } Tcl_Channel Tls_GetParent(State *statePtr, int maskFlags) { - dprintf("Requested to get parent of channel %p", statePtr->self); - - if ((statePtr->flags & ~maskFlags) & TLS_TCL_FASTPATH) { - dprintf("Asked to get the parent channel while we are using FastPath -- returning NULL"); - return(NULL); - } - - return(Tcl_GetStackedChannel(statePtr->self)); + dprintf("Requested to get parent of channel %p", statePtr->self); + + if ((statePtr->flags & ~maskFlags) & TLS_TCL_FASTPATH) { + dprintf("Asked to get the parent channel while we are using FastPath -- returning NULL"); + return(NULL); + } + return(Tcl_GetStackedChannel(statePtr->self)); } /* *------------------------------------------------------------------- * * Tls_ChannelType -- * - * Return the correct TLS channel driver info + * Return the correct TLS channel driver info * * Results: - * The correct channel driver for the current version of Tcl. + * The correct channel driver for the current version of Tcl. * * Side effects: - * None. + * None. * *------------------------------------------------------------------- */ Tcl_ChannelType *Tls_ChannelType(void) { - unsigned int size; - - /* - * Initialize the channel type if necessary - */ - if (tlsChannelType == NULL) { - /* - * Allocate new channeltype structure - */ - size = sizeof(Tcl_ChannelType); /* Base size */ - - tlsChannelType = (Tcl_ChannelType *) ckalloc(size); - memset((void *) tlsChannelType, 0, size); - - tlsChannelType->typeName = "tls"; + unsigned int size; + + /* + * Initialize the channel type if necessary + */ + if (tlsChannelType == NULL) { + /* + * Allocate new channeltype structure + */ + size = sizeof(Tcl_ChannelType); /* Base size */ + + tlsChannelType = (Tcl_ChannelType *) ckalloc(size); + memset((void *) tlsChannelType, 0, size); + + tlsChannelType->typeName = "tls"; #ifdef TCL_CHANNEL_VERSION_5 - tlsChannelType->version = TCL_CHANNEL_VERSION_5; - tlsChannelType->closeProc = TlsCloseProc; - tlsChannelType->inputProc = TlsInputProc; - tlsChannelType->outputProc = TlsOutputProc; - tlsChannelType->seekProc = NULL; - tlsChannelType->setOptionProc = TlsSetOptionProc; - tlsChannelType->getOptionProc = TlsGetOptionProc; - tlsChannelType->watchProc = TlsWatchProc; - tlsChannelType->getHandleProc = TlsGetHandleProc; - tlsChannelType->close2Proc = TlsCloseProc2; - tlsChannelType->blockModeProc = TlsBlockModeProc; - tlsChannelType->flushProc = NULL; - tlsChannelType->handlerProc = TlsNotifyProc; - tlsChannelType->wideSeekProc = NULL; - tlsChannelType->threadActionProc= NULL; - tlsChannelType->truncateProc = NULL; + tlsChannelType->version = TCL_CHANNEL_VERSION_5; + tlsChannelType->closeProc = TlsCloseProc; + tlsChannelType->inputProc = TlsInputProc; + tlsChannelType->outputProc = TlsOutputProc; + tlsChannelType->seekProc = NULL; + tlsChannelType->setOptionProc = TlsSetOptionProc; + tlsChannelType->getOptionProc = TlsGetOptionProc; + tlsChannelType->watchProc = TlsWatchProc; + tlsChannelType->getHandleProc = TlsGetHandleProc; + tlsChannelType->close2Proc = TlsCloseProc2; + tlsChannelType->blockModeProc = TlsBlockModeProc; + tlsChannelType->flushProc = NULL; + tlsChannelType->handlerProc = TlsNotifyProc; + tlsChannelType->wideSeekProc = NULL; + tlsChannelType->threadActionProc = NULL; + tlsChannelType->truncateProc = NULL; #else - tlsChannelType->version = TCL_CHANNEL_VERSION_2; - tlsChannelType->closeProc = TlsCloseProc; - tlsChannelType->inputProc = TlsInputProc; - tlsChannelType->outputProc = TlsOutputProc; - tlsChannelType->seekProc = NULL; - tlsChannelType->setOptionProc = TlsSetOptionProc; - tlsChannelType->getOptionProc = TlsGetOptionProc; - tlsChannelType->watchProc = TlsWatchProc; - tlsChannelType->getHandleProc = TlsGetHandleProc; - tlsChannelType->close2Proc = NULL; - tlsChannelType->blockModeProc = TlsBlockModeProc; - tlsChannelType->flushProc = NULL; - tlsChannelType->handlerProc = TlsNotifyProc; + tlsChannelType->version = TCL_CHANNEL_VERSION_2; + tlsChannelType->closeProc = TlsCloseProc; + tlsChannelType->inputProc = TlsInputProc; + tlsChannelType->outputProc = TlsOutputProc; + tlsChannelType->seekProc = NULL; + tlsChannelType->setOptionProc = TlsSetOptionProc; + tlsChannelType->getOptionProc = TlsGetOptionProc; + tlsChannelType->watchProc = TlsWatchProc; + tlsChannelType->getHandleProc = TlsGetHandleProc; + tlsChannelType->close2Proc = NULL; + tlsChannelType->blockModeProc = TlsBlockModeProc; + tlsChannelType->flushProc = NULL; + tlsChannelType->handlerProc = TlsNotifyProc; #endif - } - return(tlsChannelType); + } + return(tlsChannelType); } Index: tlsInt.h ================================================================== --- tlsInt.h +++ tlsInt.h @@ -66,43 +66,43 @@ #endif #ifdef TCLEXT_TCLTLS_DEBUG #include #define dprintf(...) { \ - char dprintfBuffer[8192], *dprintfBuffer_p; \ - dprintfBuffer_p = &dprintfBuffer[0]; \ - dprintfBuffer_p += sprintf(dprintfBuffer_p, "%s:%i:%s():", __FILE__, __LINE__, __func__); \ - dprintfBuffer_p += sprintf(dprintfBuffer_p, __VA_ARGS__); \ - fprintf(stderr, "%s\n", dprintfBuffer); \ - } + char dprintfBuffer[8192], *dprintfBuffer_p; \ + dprintfBuffer_p = &dprintfBuffer[0]; \ + dprintfBuffer_p += sprintf(dprintfBuffer_p, "%s:%i:%s():", __FILE__, __LINE__, __func__); \ + dprintfBuffer_p += sprintf(dprintfBuffer_p, __VA_ARGS__); \ + fprintf(stderr, "%s\n", dprintfBuffer); \ +} #define dprintBuffer(bufferName, bufferLength) { \ - int dprintBufferIdx; \ - unsigned char dprintBufferChar; \ - fprintf(stderr, "%s:%i:%s():%s[%llu]={", __FILE__, __LINE__, __func__, #bufferName, (unsigned long long) bufferLength); \ - for (dprintBufferIdx = 0; dprintBufferIdx < bufferLength; dprintBufferIdx++) { \ - dprintBufferChar = bufferName[dprintBufferIdx]; \ - if (isalpha(dprintBufferChar) || isdigit(dprintBufferChar)) { \ - fprintf(stderr, "'%c' ", dprintBufferChar); \ - } else { \ - fprintf(stderr, "%02x ", (unsigned int) dprintBufferChar); \ - }; \ - }; \ - fprintf(stderr, "}\n"); \ - } + int dprintBufferIdx; \ + unsigned char dprintBufferChar; \ + fprintf(stderr, "%s:%i:%s():%s[%llu]={", __FILE__, __LINE__, __func__, #bufferName, (unsigned long long) bufferLength); \ + for (dprintBufferIdx = 0; dprintBufferIdx < bufferLength; dprintBufferIdx++) { \ + dprintBufferChar = bufferName[dprintBufferIdx]; \ + if (isalpha(dprintBufferChar) || isdigit(dprintBufferChar)) { \ + fprintf(stderr, "'%c' ", dprintBufferChar); \ + } else { \ + fprintf(stderr, "%02x ", (unsigned int) dprintBufferChar); \ + }; \ + }; \ + fprintf(stderr, "}\n"); \ +} #define dprintFlags(statePtr) { \ - char dprintfBuffer[8192], *dprintfBuffer_p; \ - dprintfBuffer_p = &dprintfBuffer[0]; \ - dprintfBuffer_p += sprintf(dprintfBuffer_p, "%s:%i:%s():%s->flags=0", __FILE__, __LINE__, __func__, #statePtr); \ - if (((statePtr)->flags & TLS_TCL_ASYNC) == TLS_TCL_ASYNC) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_ASYNC"); }; \ - if (((statePtr)->flags & TLS_TCL_SERVER) == TLS_TCL_SERVER) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_SERVER"); }; \ - if (((statePtr)->flags & TLS_TCL_INIT) == TLS_TCL_INIT) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_INIT"); }; \ - if (((statePtr)->flags & TLS_TCL_DEBUG) == TLS_TCL_DEBUG) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_DEBUG"); }; \ - if (((statePtr)->flags & TLS_TCL_CALLBACK) == TLS_TCL_CALLBACK) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_CALLBACK"); }; \ - if (((statePtr)->flags & TLS_TCL_HANDSHAKE_FAILED) == TLS_TCL_HANDSHAKE_FAILED) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_HANDSHAKE_FAILED"); }; \ - if (((statePtr)->flags & TLS_TCL_FASTPATH) == TLS_TCL_FASTPATH) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_FASTPATH"); }; \ - fprintf(stderr, "%s\n", dprintfBuffer); \ - } + char dprintfBuffer[8192], *dprintfBuffer_p; \ + dprintfBuffer_p = &dprintfBuffer[0]; \ + dprintfBuffer_p += sprintf(dprintfBuffer_p, "%s:%i:%s():%s->flags=0", __FILE__, __LINE__, __func__, #statePtr); \ + if (((statePtr)->flags & TLS_TCL_ASYNC) == TLS_TCL_ASYNC) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_ASYNC"); }; \ + if (((statePtr)->flags & TLS_TCL_SERVER) == TLS_TCL_SERVER) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_SERVER"); }; \ + if (((statePtr)->flags & TLS_TCL_INIT) == TLS_TCL_INIT) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_INIT"); }; \ + if (((statePtr)->flags & TLS_TCL_DEBUG) == TLS_TCL_DEBUG) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_DEBUG"); }; \ + if (((statePtr)->flags & TLS_TCL_CALLBACK) == TLS_TCL_CALLBACK) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_CALLBACK"); }; \ + if (((statePtr)->flags & TLS_TCL_HANDSHAKE_FAILED) == TLS_TCL_HANDSHAKE_FAILED) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_HANDSHAKE_FAILED"); }; \ + if (((statePtr)->flags & TLS_TCL_FASTPATH) == TLS_TCL_FASTPATH) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_FASTPATH"); }; \ + fprintf(stderr, "%s\n", dprintfBuffer); \ +} #else #define dprintf(...) if (0) { fprintf(stderr, __VA_ARGS__); } #define dprintBuffer(bufferName, bufferLength) /**/ #define dprintFlags(statePtr) /**/ #endif @@ -114,25 +114,23 @@ #define BIO_TYPE_TCL (19|0x0400) /* * Defines for State.flags */ -#define TLS_TCL_ASYNC (1<<0) /* non-blocking mode */ -#define TLS_TCL_SERVER (1<<1) /* Server-Side */ -#define TLS_TCL_INIT (1<<2) /* Initializing connection */ -#define TLS_TCL_DEBUG (1<<3) /* Show debug tracing */ +#define TLS_TCL_ASYNC (1<<0) /* non-blocking mode */ +#define TLS_TCL_SERVER (1<<1) /* Server-Side */ +#define TLS_TCL_INIT (1<<2) /* Initializing connection */ +#define TLS_TCL_DEBUG (1<<3) /* Show debug tracing */ #define TLS_TCL_CALLBACK (1<<4) /* In a callback, prevent update * looping problem. [Bug 1652380] */ -#define TLS_TCL_HANDSHAKE_FAILED (1<<5) /* Set on handshake failures and once - * set, all further I/O will result - * in ECONNABORTED errors. */ -#define TLS_TCL_FASTPATH (1<<6) /* The parent channel is being used directly by the SSL library */ +#define TLS_TCL_HANDSHAKE_FAILED (1<<5) /* Set on handshake failures and once set, all + * further I/O will result in ECONNABORTED errors. */ +#define TLS_TCL_FASTPATH (1<<6) /* The parent channel is being used directly by the SSL library */ #define TLS_TCL_DELAY (5) /* - * This structure describes the per-instance state - * of an ssl channel. + * This structure describes the per-instance state of an SSL channel. * * The SSL processing context is maintained here, in the ClientData */ typedef struct State { Tcl_Channel self; /* this socket channel */ @@ -142,11 +140,11 @@ int watchMask; /* current WatchProc mask */ int mode; /* current mode of parent channel */ Tcl_Interp *interp; /* interpreter in which this resides */ Tcl_Obj *callback; /* script called for tracing, verifying and errors */ - Tcl_Obj *password; /* script called for certificate password */ + Tcl_Obj *password; /* script called for certificate password */ int vflags; /* verify flags */ SSL *ssl; /* Struct for SSL processing */ SSL_CTX *ctx; /* SSL Context */ BIO *bio; /* Struct for SSL processing */ Index: tlsX509.c ================================================================== --- tlsX509.c +++ tlsX509.c @@ -9,11 +9,11 @@ #include #include #include "tlsInt.h" /* - * Ensure these are not macros - known to be defined on Win32 + * Ensure these are not macros - known to be defined on Win32 */ #ifdef min #undef min #endif @@ -39,18 +39,17 @@ { static char bp[128]; char *v; int gmt=0; static char *mon[12]={ - "Jan","Feb","Mar","Apr","May","Jun", - "Jul","Aug","Sep","Oct","Nov","Dec"}; + "Jan","Feb","Mar","Apr","May","Jun", "Jul","Aug","Sep","Oct","Nov","Dec"}; int i; int y=0,M=0,d=0,h=0,m=0,s=0; - + i=tm->length; v=(char *)tm->data; - + if (i < 10) goto err; if (v[i-1] == 'Z') gmt=1; for (i=0; i<10; i++) if ((v[i] > '9') || (v[i] < '0')) goto err; y= (v[0]-'0')*10+(v[1]-'0'); @@ -58,16 +57,14 @@ M= (v[2]-'0')*10+(v[3]-'0'); if ((M > 12) || (M < 1)) goto err; d= (v[4]-'0')*10+(v[5]-'0'); h= (v[6]-'0')*10+(v[7]-'0'); m= (v[8]-'0')*10+(v[9]-'0'); - if ( (v[10] >= '0') && (v[10] <= '9') && - (v[11] >= '0') && (v[11] <= '9')) + if ((v[10] >= '0') && (v[10] <= '9') && (v[11] >= '0') && (v[11] <= '9')) s= (v[10]-'0')*10+(v[11]-'0'); - - sprintf(bp,"%s %2d %02d:%02d:%02d %d%s", - mon[M-1],d,h,m,s,y+1900,(gmt)?" GMT":""); + + sprintf(bp,"%s %2d %02d:%02d:%02d %d%s", mon[M-1],d,h,m,s,y+1900,(gmt)?" GMT":""); return bp; err: return "Bad time value"; } @@ -91,12 +88,12 @@ */ #define CERT_STR_SIZE 16384 Tcl_Obj* -Tls_NewX509Obj( Tcl_Interp *interp, X509 *cert) { - Tcl_Obj *certPtr = Tcl_NewListObj( 0, NULL); +Tls_NewX509Obj(Tcl_Interp *interp, X509 *cert) { + Tcl_Obj *certPtr = Tcl_NewListObj(0, NULL); BIO *bio; int n; unsigned long flags; char subject[BUFSIZ]; char issuer[BUFSIZ]; @@ -123,11 +120,11 @@ serial[0] = 0; } else { flags = XN_FLAG_RFC2253 | ASN1_STRFLGS_UTF8_CONVERT; flags &= ~ASN1_STRFLGS_ESC_MSB; - X509_NAME_print_ex(bio, X509_get_subject_name(cert), 0, flags); + X509_NAME_print_ex(bio, X509_get_subject_name(cert), 0, flags); n = BIO_read(bio, subject, min(BIO_pending(bio), BUFSIZ - 1)); n = max(n, 0); subject[n] = 0; (void)BIO_flush(bio); @@ -166,15 +163,15 @@ BIO_free(bio); } #if OPENSSL_VERSION_NUMBER < 0x10100000L - strcpy( notBefore, ASN1_UTCTIME_tostr( X509_get_notBefore(cert) )); - strcpy( notAfter, ASN1_UTCTIME_tostr( X509_get_notAfter(cert) )); + strcpy(notBefore, ASN1_UTCTIME_tostr(X509_get_notBefore(cert))); + strcpy(notAfter, ASN1_UTCTIME_tostr(X509_get_notAfter(cert))); #else - strcpy( notBefore, ASN1_UTCTIME_tostr( X509_getm_notBefore(cert) )); - strcpy( notAfter, ASN1_UTCTIME_tostr( X509_getm_notAfter(cert) )); + strcpy(notBefore, ASN1_UTCTIME_tostr(X509_getm_notBefore(cert))); + strcpy(notAfter, ASN1_UTCTIME_tostr(X509_getm_notAfter(cert))); #endif #ifndef NO_SSL_SHA /* SHA1 */ X509_digest(cert, EVP_sha1(), sha1_hash_binary, NULL);