Index: pkgIndex.tcl.in ================================================================== --- pkgIndex.tcl.in +++ pkgIndex.tcl.in @@ -1,6 +1,6 @@ -if {[package vsatisfies [package present Tcl] 8.5]} { +if {[package vsatisfies [package present Tcl] 8.5-]} { package ifneeded tls @PACKAGE_VERSION@ [list apply {{dir} { if {{@TCLEXT_BUILD@} eq "static"} { load {} Tls } else { load [file join $dir @EXTENSION_TARGET@] Tls Index: tclOpts.h ================================================================== --- tclOpts.h +++ tclOpts.h @@ -1,9 +1,9 @@ /* * Copyright (C) 1997-2000 Matt Newman * - * Stylized option processing - requires consitent + * Stylized option processing - requires consistent * external vars: opt, idx, objc, objv */ #ifndef _TCL_OPTS_H #define _TCL_OPTS_H Index: tls.c ================================================================== --- tls.c +++ tls.c @@ -36,37 +36,14 @@ #define F2N( key, dsp) \ (((key) == NULL) ? (char *) NULL : \ Tcl_TranslateFileName(interp, (key), (dsp))) #define REASON() ERR_reason_error_string(ERR_get_error()) -static void InfoCallback(CONST SSL *ssl, int where, int ret); - -static int CiphersObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); - -static int HandshakeObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); - -static int ImportObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); - -static int StatusObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); - -static int VersionObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); - -static int MiscObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); - -static int UnimportObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); - 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 @@ -171,12 +148,11 @@ * Side effects: * Calls callback (if defined) *------------------------------------------------------------------- */ static void -InfoCallback(CONST SSL *ssl, int where, int ret) -{ +InfoCallback(const SSL *ssl, int where, int ret) { State *statePtr = (State*)SSL_get_app_data((SSL *)ssl); Tcl_Obj *cmdPtr; char *major; char *minor; dprintf("Called"); @@ -228,11 +204,11 @@ if (where & (SSL_CB_LOOP|SSL_CB_EXIT)) { 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); + const char *cp = (char *) SSL_alert_desc_string_long(ret); Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, Tcl_NewStringObj( cp, -1) ); } else { Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, @@ -269,20 +245,20 @@ * The err field of the currently operative State is set * to a string describing the SSL negotiation failure reason *------------------------------------------------------------------- */ static int -VerifyCallback(int ok, X509_STORE_CTX *ctx) -{ +VerifyCallback(int ok, X509_STORE_CTX *ctx) { Tcl_Obj *cmdPtr, *result; char *errStr, *string; int length; SSL *ssl = (SSL*)X509_STORE_CTX_get_ex_data(ctx, SSL_get_ex_data_X509_STORE_CTX_idx()); X509 *cert = X509_STORE_CTX_get_current_cert(ctx); State *statePtr = (State*)SSL_get_app_data(ssl); int depth = X509_STORE_CTX_get_error_depth(ctx); int err = X509_STORE_CTX_get_error(ctx); + int code; dprintf("Verify: %d", ok); if (!ok) { errStr = (char*)X509_verify_cert_error_string(err); @@ -321,21 +297,31 @@ Tcl_Preserve( (ClientData) statePtr); statePtr->flags |= TLS_TCL_CALLBACK; Tcl_IncrRefCount( cmdPtr); - if (Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) { + code = Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL); + if (code != TCL_OK) { /* It got an error - reject the certificate. */ - Tcl_BackgroundError( statePtr->interp); +#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6) + Tcl_BackgroundError(statePtr->interp); +#else + Tcl_BackgroundException(statePtr->interp, code); +#endif ok = 0; } else { result = Tcl_GetObjResult(statePtr->interp); string = Tcl_GetStringFromObj(result, &length); /* An empty result leaves verification unchanged. */ if (string != NULL && length > 0) { - if (Tcl_GetIntFromObj(statePtr->interp, result, &ok) != TCL_OK) { + code = Tcl_GetIntFromObj(statePtr->interp, result, &ok); + if (code != TCL_OK) { +#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6) Tcl_BackgroundError(statePtr->interp); +#else + Tcl_BackgroundException(statePtr->interp, code); +#endif ok = 0; } } } Tcl_DecrRefCount( cmdPtr); @@ -360,13 +346,13 @@ * The err field of the currently operative State is set * to a string describing the SSL negotiation failure reason *------------------------------------------------------------------- */ void -Tls_Error(State *statePtr, char *msg) -{ +Tls_Error(State *statePtr, char *msg) { Tcl_Obj *cmdPtr; + int code; dprintf("Called"); if (msg && *msg) { Tcl_SetErrorCode(statePtr->interp, "SSL", msg, (char *)NULL); @@ -378,11 +364,15 @@ 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_BackgroundError( statePtr->interp); +#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, @@ -396,12 +386,17 @@ Tcl_Preserve((ClientData) statePtr->interp); Tcl_Preserve((ClientData) statePtr); Tcl_IncrRefCount(cmdPtr); - if (Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) { + code = Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL); + if (code != TCL_OK) { +#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6) Tcl_BackgroundError(statePtr->interp); +#else + Tcl_BackgroundException(statePtr->interp, code); +#endif } Tcl_DecrRefCount(cmdPtr); Tcl_Release((ClientData) statePtr); Tcl_Release((ClientData) statePtr->interp); @@ -431,25 +426,23 @@ /* * No way to handle user-data therefore no way without a global * variable to access the Tcl interpreter. */ static int -PasswordCallback(char *buf, int size, int verify) -{ +PasswordCallback(char *buf, int size, int verify) { return -1; - buf = buf; + buf = buf; size = size; verify = verify; } #else static int -PasswordCallback(char *buf, int size, int verify, void *udata) -{ +PasswordCallback(char *buf, int size, int verify, void *udata) { State *statePtr = (State *) udata; Tcl_Interp *interp = statePtr->interp; Tcl_Obj *cmdPtr; - int result; + int code; dprintf("Called"); if (statePtr->password == NULL) { if (Tcl_EvalEx(interp, "tls::password", -1, TCL_EVAL_GLOBAL) @@ -462,31 +455,36 @@ } } cmdPtr = Tcl_DuplicateObj(statePtr->password); - Tcl_Preserve((ClientData) statePtr->interp); + Tcl_Preserve((ClientData) interp); Tcl_Preserve((ClientData) statePtr); Tcl_IncrRefCount(cmdPtr); - result = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL); - if (result != TCL_OK) { - Tcl_BackgroundError(statePtr->interp); + code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL); + if (code != TCL_OK) { +#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6) + Tcl_BackgroundError(interp); +#else + Tcl_BackgroundException(interp, code); +#endif } Tcl_DecrRefCount(cmdPtr); Tcl_Release((ClientData) statePtr); - Tcl_Release((ClientData) statePtr->interp); - if (result == TCL_OK) { + if (code == TCL_OK) { char *ret = (char *) Tcl_GetStringResult(interp); - strncpy(buf, ret, (size_t) size); - return (int)strlen(ret); - } else { - return -1; - } - verify = verify; + if (strlen(ret) < size - 1) { + strncpy(buf, ret, (size_t) size); + Tcl_Release((ClientData) interp); + return (int)strlen(ret); + } + } + Tcl_Release((ClientData) interp); + return -1; } #endif /* *------------------------------------------------------------------- @@ -503,17 +501,12 @@ * constructs and destroys SSL context (CTX) * *------------------------------------------------------------------- */ static int -CiphersObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST objv[]; -{ - static CONST84 char *protocols[] = { +CiphersObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { + static const char *protocols[] = { "ssl2", "ssl3", "tls1", "tls1.1", "tls1.2", "tls1.3", NULL }; enum protocol { TLS_SSL2, TLS_SSL3, TLS_TLS1, TLS_TLS1_1, TLS_TLS1_2, TLS_TLS1_3, TLS_NONE }; @@ -579,11 +572,11 @@ 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); + SSL_CTX_set_max_proto_version (ctx, TLS1_3_VERSION); break; #endif default: break; } @@ -628,11 +621,11 @@ SSL_free(ssl); SSL_CTX_free(ctx); Tcl_SetObjResult( interp, objPtr); return TCL_OK; - clientData = clientData; + clientData = clientData; } /* *------------------------------------------------------------------- * @@ -648,14 +641,14 @@ * May force SSL negotiation to take place. * *------------------------------------------------------------------- */ -static int HandshakeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +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; + const char *errStr = NULL; int ret = 1; int err = 0; dprintf("Called"); @@ -681,14 +674,11 @@ 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) - ) { + 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); @@ -711,11 +701,11 @@ dprintf("Returning TCL_OK with data \"%i\"", ret); Tcl_SetObjResult(interp, Tcl_NewIntObj(ret)); return(TCL_OK); - clientData = clientData; + clientData = clientData; } /* *------------------------------------------------------------------- * @@ -733,16 +723,11 @@ * *------------------------------------------------------------------- */ static int -ImportObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST objv[]; -{ +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; Tcl_Obj *script = NULL; Tcl_Obj *password = NULL; @@ -823,30 +808,30 @@ OPTOBJ( "-password", password); OPTBOOL( "-require", require); OPTBOOL( "-request", request); OPTBOOL( "-server", server); #ifndef OPENSSL_NO_TLSEXT - OPTSTR( "-servername", servername); + 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); + 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; - if (verify == 0) verify = SSL_VERIFY_NONE; + if (verify == 0) verify = SSL_VERIFY_NONE; proto |= (ssl2 ? TLS_PROTO_SSL2 : 0); proto |= (ssl3 ? TLS_PROTO_SSL3 : 0); proto |= (tls1 ? TLS_PROTO_TLS1 : 0); proto |= (tls1_1 ? TLS_PROTO_TLS1_1 : 0); @@ -897,14 +882,14 @@ 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); Tls_Free((char *) statePtr); return TCL_ERROR; @@ -965,16 +950,16 @@ 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); - Tls_Free((char *) statePtr); - return TCL_ERROR; - } + 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) { /* Convert a Tcl list into a protocol-list in wire-format */ unsigned char *protos, *p; unsigned int protoslen = 0; @@ -1019,11 +1004,11 @@ /* * SSL Callbacks */ - SSL_set_app_data(statePtr->ssl, (VOID *)statePtr); /* point back to us */ + 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); @@ -1045,11 +1030,11 @@ */ dprintf("Returning %s", Tcl_GetChannelName(statePtr->self)); Tcl_SetResult(interp, (char *) Tcl_GetChannelName(statePtr->self), TCL_VOLATILE); return TCL_OK; - clientData = clientData; + clientData = clientData; } /* *------------------------------------------------------------------- * @@ -1065,16 +1050,11 @@ * *------------------------------------------------------------------- */ static int -UnimportObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST objv[]; -{ +UnimportObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Channel chan; /* The channel to set a mode on. */ dprintf("Called"); if (objc != 2) { @@ -1101,11 +1081,11 @@ if (Tcl_UnstackChannel(interp, chan) == TCL_ERROR) { return TCL_ERROR; } return TCL_OK; - clientData = clientData; + clientData = clientData; } /* *------------------------------------------------------------------- * @@ -1119,26 +1099,13 @@ * *------------------------------------------------------------------- */ static SSL_CTX * -CTX_Init(statePtr, isServer, proto, keyfile, certfile, key, cert, - key_len, cert_len, CAdir, CAfile, ciphers, DHparams) - 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; -{ +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; SSL_CTX *ctx = NULL; Tcl_DString ds; Tcl_DString ds1; int off = 0; @@ -1191,48 +1158,48 @@ #endif switch (proto) { #if !defined(NO_SSL2) case TLS_PROTO_SSL2: - method = SSLv2_method (); + method = SSLv2_method(); break; #endif #if !defined(NO_SSL3) case TLS_PROTO_SSL3: - method = SSLv3_method (); + method = SSLv3_method(); break; #endif #if !defined(NO_TLS1) case TLS_PROTO_TLS1: - method = TLSv1_method (); + method = TLSv1_method(); break; #endif #if !defined(NO_TLS1_1) case TLS_PROTO_TLS1_1: - method = TLSv1_1_method (); + method = TLSv1_1_method(); break; #endif #if !defined(NO_TLS1_2) case TLS_PROTO_TLS1_2: - method = TLSv1_2_method (); + method = TLSv1_2_method(); break; #endif #if !defined(NO_TLS1_3) case TLS_PROTO_TLS1_3: - /* - * The version range is constrained below, - * after the context is created. Use the - * generic method here. - */ - method = TLS_method (); + /* + * The version range is constrained below, + * after the context is created. Use the + * generic method here. + */ + method = TLS_method(); break; #endif default: #ifdef HAVE_TLS_METHOD - method = TLS_method (); + method = TLS_method(); #else - method = SSLv23_method (); + method = SSLv23_method(); #endif #if !defined(NO_SSL2) off |= (ENABLED(proto, TLS_PROTO_SSL2) ? 0 : SSL_OP_NO_SSLv2); #endif #if !defined(NO_SSL3) @@ -1251,28 +1218,28 @@ off |= (ENABLED(proto, TLS_PROTO_TLS1_3) ? 0 : SSL_OP_NO_TLSv1_3); #endif break; } - ctx = SSL_CTX_new (method); + 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) 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); } #endif - SSL_CTX_set_app_data( ctx, (VOID*)interp); /* remember the interpreter */ + 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_sess_set_cache_size( ctx, 128); if (ciphers != NULL) @@ -1431,11 +1398,11 @@ } /* 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) ); + STACK_OF(X509_NAME) *certNames = SSL_load_client_CA_file( F2N(CAfile, &ds) ); if ( certNames != NULL ) { SSL_CTX_set_client_CA_list(ctx, certNames ); } } @@ -1456,16 +1423,11 @@ * None. * *------------------------------------------------------------------- */ static int -StatusObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST objv[]; -{ +StatusObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { State *statePtr; X509 *peer; Tcl_Obj *objPtr; Tcl_Channel chan; char *channelName, *ciphers; @@ -1548,11 +1510,11 @@ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_version(statePtr->ssl), -1)); Tcl_SetObjResult( interp, objPtr); return TCL_OK; - clientData = clientData; + clientData = clientData; } /* *------------------------------------------------------------------- * @@ -1565,27 +1527,22 @@ * None. * *------------------------------------------------------------------- */ static int -VersionObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST objv[]; -{ +VersionObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { 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; } /* *------------------------------------------------------------------- * @@ -1598,17 +1555,12 @@ * None. * *------------------------------------------------------------------- */ static int -MiscObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST objv[]; -{ - static CONST84 char *commands [] = { "req", NULL }; +MiscObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { + static const char *commands [] = { "req", "strreq", NULL }; enum command { C_REQ, C_STRREQ, C_DUMMY }; int cmd, isStr; char buffer[16384]; dprintf("Called"); @@ -1615,12 +1567,11 @@ if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], commands, - "command", 0,&cmd) != TCL_OK) { + if (Tcl_GetIndexFromObj(interp, objv[1], commands, "command", 0,&cmd) != TCL_OK) { return TCL_ERROR; } isStr = (cmd == C_STRREQ); switch ((enum command) cmd) { @@ -1635,11 +1586,11 @@ BIO *out=NULL; char *k_C="",*k_ST="",*k_L="",*k_O="",*k_OU="",*k_CN="",*k_Email=""; char *keyout,*pemout,*str; int keysize,serial=0,days=365; - + if ((objc<5) || (objc>6)) { Tcl_WrongNumArgs(interp, 2, objv, "keysize keyfile certfile ?info?"); return TCL_ERROR; } @@ -1869,31 +1820,31 @@ * by Tcl when this package is to be added to an interpreter. * * Results: Ssl configured and loaded * * Side effects: - * create the ssl command, initialise ssl context + * create the ssl command, initialize ssl context * *------------------------------------------------------------------- */ DLLEXPORT int Tls_Init(Tcl_Interp *interp) { const char tlsTclInitScript[] = { #include "tls.tcl.h" - 0x00 + 0x00 }; - dprintf("Called"); + dprintf("Called"); /* * We only support Tcl 8.4 or newer */ if ( #ifdef USE_TCL_STUBS 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; } @@ -1925,11 +1876,11 @@ * ------------------------------------------------* * Standard procedure required by 'load'. * Initializes this extension for a safe interpreter. * ------------------------------------------------* * - * Sideeffects: + * Side effects: * As of 'Tls_Init' * * Result: * A standard Tcl error code. * @@ -1949,11 +1900,11 @@ * ------------------------------------------------* * Initializes SSL library once per application * ------------------------------------------------* * * Side effects: - * initilizes SSL library + * initializes SSL library * * Result: * none * *------------------------------------------------------* Index: tls.htm ================================================================== --- tls.htm +++ tls.htm @@ -70,15 +70,13 @@

DESCRIPTION

This extension provides a generic binding to OpenSSL, utilizing the Tcl_StackChannel -API for Tcl 8.2 and higher. The sockets behave exactly the same +API for Tcl 8.4 and higher. The sockets behave exactly the same as channels created using Tcl's built-in socket command with additional options for controlling the SSL session. -To use TLS with an earlier version of Tcl than 8.4, please obtain -TLS 1.3.

COMMANDS

Typically one would use the tls::socket command Index: tlsBIO.c ================================================================== --- tlsBIO.c +++ tlsBIO.c @@ -14,105 +14,22 @@ #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 -/* - * Forward declarations - */ - -static int BioWrite _ANSI_ARGS_((BIO *h, CONST char *buf, int num)); -static int BioRead _ANSI_ARGS_((BIO *h, char *buf, int num)); -static int BioPuts _ANSI_ARGS_((BIO *h, CONST char *str)); -static long BioCtrl _ANSI_ARGS_((BIO *h, int cmd, long arg1, void *ptr)); -static int BioNew _ANSI_ARGS_((BIO *h)); -static int BioFree _ANSI_ARGS_((BIO *h)); - -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); -} - -static int BioWrite(BIO *bio, CONST char *buf, int bufLen) { +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); @@ -212,11 +129,11 @@ dprintf("BioRead(%p, , %d) [%p] returning %i", (void *) bio, bufLen, (void *) chan, ret); return(ret); } -static int BioPuts(BIO *bio, CONST char *str) { +static int BioPuts(BIO *bio, const char *str) { dprintf("BioPuts(%p, ) called", bio, str); return BioWrite(bio, str, (int) strlen(str)); } @@ -335,5 +252,77 @@ 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); +} Index: tlsIO.c ================================================================== --- tlsIO.c +++ tlsIO.c @@ -20,104 +20,17 @@ #include "tlsInt.h" /* * Forward declarations */ -static int TlsBlockModeProc _ANSI_ARGS_((ClientData instanceData, int mode)); -static int TlsCloseProc _ANSI_ARGS_((ClientData instanceData, Tcl_Interp *interp)); -static int TlsInputProc _ANSI_ARGS_((ClientData instanceData, char *buf, int bufSize, int *errorCodePtr)); -static int TlsOutputProc _ANSI_ARGS_((ClientData instanceData, CONST char *buf, int toWrite, int *errorCodePtr)); -static int TlsGetOptionProc _ANSI_ARGS_((ClientData instanceData, Tcl_Interp *interp, CONST84 char *optionName, Tcl_DString *dsPtr)); -static int TlsSetOptionProc _ANSI_ARGS_((ClientData instanceData, Tcl_Interp *interp, CONST84 char *optionName, CONST84 char *optionValue)); -static void TlsWatchProc _ANSI_ARGS_((ClientData instanceData, int mask)); -static int TlsGetHandleProc _ANSI_ARGS_((ClientData instanceData, int direction, ClientData *handlePtr)); -static int TlsNotifyProc _ANSI_ARGS_((ClientData instanceData, int mask)); -#if 0 -static void TlsChannelHandler _ANSI_ARGS_((ClientData clientData, int mask)); -#endif -static void TlsChannelHandlerTimer _ANSI_ARGS_((ClientData clientData)); +static void TlsChannelHandlerTimer(ClientData clientData); /* * TLS Channel Type */ static Tcl_ChannelType *tlsChannelType = NULL; -/* - *------------------------------------------------------------------- - * - * Tls_ChannelType -- - * - * Return the correct TLS channel driver info - * - * Results: - * The correct channel driver for the current version of Tcl. - * - * Side effects: - * None. - * - *------------------------------------------------------------------- - */ -Tcl_ChannelType *Tls_ChannelType(void) { - unsigned int size; - - /* - * Initialize the channel type if necessary - */ - if (tlsChannelType == NULL) { - /* - * Allocation of a new channeltype structure is not easy, because of - * the various verson of the core and subsequent changes to the - * structure. The main challenge is to allocate enough memory for - * modern versions even if this extsension is compiled against one - * of the older variant! - * - * (1) Versions before stubs (8.0.x) are simple, because they are - * supported only if the extension is compiled against exactly - * that version of the core. - * - * (2) With stubs we just determine the difference between the older - * and modern variant and overallocate accordingly if compiled - * against an older variant. - */ - size = sizeof(Tcl_ChannelType); /* Base size */ - - tlsChannelType = (Tcl_ChannelType *) ckalloc(size); - memset((VOID *) tlsChannelType, 0, size); - - /* - * Common elements of the structure (no changes in location or name) - * close2Proc, seekProc, setOptionProc stay NULL. - */ - - tlsChannelType->typeName = "tls"; - tlsChannelType->closeProc = TlsCloseProc; - tlsChannelType->inputProc = TlsInputProc; - tlsChannelType->outputProc = TlsOutputProc; - tlsChannelType->getOptionProc = TlsGetOptionProc; - tlsChannelType->setOptionProc = TlsSetOptionProc; - tlsChannelType->watchProc = TlsWatchProc; - tlsChannelType->getHandleProc = TlsGetHandleProc; - - /* - * Compiled against 8.3.2+. Direct access to all elements possible. Use - * channelTypeVersion information to select the values to use. - */ - - /* - * For the 8.3.2 core we present ourselves as a version 2 - * driver. This means a special value in version (ex - * blockModeProc), blockModeProc in a different place and of - * course usage of the handlerProc. - */ - tlsChannelType->version = TCL_CHANNEL_VERSION_2; - tlsChannelType->blockModeProc = TlsBlockModeProc; - tlsChannelType->handlerProc = TlsNotifyProc; - } - - return(tlsChannelType); -} - /* *------------------------------------------------------------------- * * TlsBlockModeProc -- * @@ -167,18 +80,22 @@ dprintf("TlsCloseProc(%p)", (void *) statePtr); Tls_Clean(statePtr); Tcl_EventuallyFree((ClientData)statePtr, Tls_Free); - - dprintf("Returning TCL_OK"); - - return(TCL_OK); + return(0); /* Interp is unused. */ interp = interp; } + +static int TlsCloseProc2(ClientData instanceData, Tcl_Interp *interp, int flags) { + if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) { + return TlsCloseProc(instanceData, interp); + } + return EINVAL; +} /* *------------------------------------------------------* * * Tls_WaitForConnect -- @@ -501,11 +418,11 @@ * Writes output on the output device of the channel. * *------------------------------------------------------------------- */ -static int TlsOutputProc(ClientData instanceData, CONST char *buf, int toWrite, int *errorCodePtr) { +static int TlsOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr) { unsigned long backingError; State *statePtr = (State *) instanceData; int written, err; int tlsConnect; @@ -627,41 +544,43 @@ /* *------------------------------------------------------------------- * * TlsSetOptionProc -- * - * Sets an option value for a SSL socket based channel. + * Computes an option value for a SSL socket based channel, or a + * list of all options and their values. * * Results: - * A standard Tcl result. + * 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. * *------------------------------------------------------------------- */ static int TlsSetOptionProc(ClientData instanceData, /* Socket state. */ Tcl_Interp *interp, /* For errors - can be NULL. */ - CONST84 char *optionName, /* Name of the option to - * set the value for, or - * NULL to get all options. */ - CONST84 char *optionValue) /* Value for option. */ + 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; @@ -686,30 +605,28 @@ *------------------------------------------------------------------- */ static int TlsGetOptionProc(ClientData instanceData, /* Socket state. */ Tcl_Interp *interp, /* For errors - can be NULL. */ - CONST84 char *optionName, /* Name of the option to - * retrieve the value for, or - * NULL to get all options and - * their values. */ + 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; @@ -732,39 +649,38 @@ *------------------------------------------------------------------- */ 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. */ + 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. * 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); statePtr->watchMask = 0; - return; + return; } statePtr->watchMask = mask; /* No channel handlers any more. We will be notified automatically @@ -774,32 +690,32 @@ * 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); + 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"); + 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 - * data waiting, so generate a timer to flush that. - */ - dprintf("Creating a new timer since data appears to be waiting"); - statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, (ClientData) statePtr); + /* + * There is interest in readable events and we actually have + * data waiting, so generate a timer to flush that. + */ + dprintf("Creating a new timer since data appears to be waiting"); + statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, (ClientData) statePtr); } } /* *------------------------------------------------------------------- @@ -904,14 +820,11 @@ * *------------------------------------------------------* */ static void -TlsChannelHandler (clientData, mask) - ClientData clientData; - int mask; -{ +TlsChannelHandler (ClientData clientData, int mask) { State *statePtr = (State *) clientData; dprintf("HANDLER(0x%x)", mask); Tcl_Preserve( (ClientData)statePtr); @@ -1020,5 +933,72 @@ return(NULL); } return(Tcl_GetStackedChannel(statePtr->self)); } + +/* + *------------------------------------------------------------------- + * + * Tls_ChannelType -- + * + * Return the correct TLS channel driver info + * + * Results: + * The correct channel driver for the current version of Tcl. + * + * Side effects: + * 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"; +#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; +#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; +#endif + } + return(tlsChannelType); +} Index: tlsInt.h ================================================================== --- tlsInt.h +++ tlsInt.h @@ -21,19 +21,19 @@ #include "tls.h" #include #include #include -#ifdef __WIN32__ +#ifdef _WIN32 #define WIN32_LEAN_AND_MEAN #include #include /* OpenSSL needs this on Windows */ #endif -/* Handle tcl8.3->tcl8.4 CONST changes */ -#ifndef CONST84 -#define CONST84 +/* Handle TCL 8.6 CONST changes */ +#ifndef CONST86 +#define CONST86 #endif #ifdef NO_PATENTS # define NO_IDEA # define NO_RC2 Index: tlsX509.c ================================================================== --- tlsX509.c +++ tlsX509.c @@ -33,35 +33,35 @@ { 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; + if ((v[i] > '9') || (v[i] < '0')) goto err; y= (v[0]-'0')*10+(v[1]-'0'); if (y < 70) y+=100; 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')) - s= (v[10]-'0')*10+(v[11]-'0'); + 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":""); + mon[M-1],d,h,m,s,y+1900,(gmt)?" GMT":""); return bp; err: return "Bad time value"; } @@ -85,14 +85,11 @@ */ #define CERT_STR_SIZE 16384 Tcl_Obj* -Tls_NewX509Obj( interp, cert) - Tcl_Interp *interp; - X509 *cert; -{ +Tls_NewX509Obj( Tcl_Interp *interp, X509 *cert) { Tcl_Obj *certPtr = Tcl_NewListObj( 0, NULL); BIO *bio; int n; unsigned long flags; char subject[BUFSIZ]; @@ -138,30 +135,30 @@ n = BIO_read(bio, serial, min(BIO_pending(bio), BUFSIZ - 1)); n = max(n, 0); serial[n] = 0; (void)BIO_flush(bio); - if (PEM_write_bio_X509(bio, cert)) { - certStr_p = certStr; - certStr_len = 0; - while (1) { - toRead = min(BIO_pending(bio), CERT_STR_SIZE - certStr_len - 1); - toRead = min(toRead, BUFSIZ); - if (toRead == 0) { - break; - } - dprintf("Reading %i bytes from the certificate...", toRead); - n = BIO_read(bio, certStr_p, toRead); - if (n <= 0) { - break; - } - certStr_len += n; - certStr_p += n; - } - *certStr_p = '\0'; - (void)BIO_flush(bio); - } + if (PEM_write_bio_X509(bio, cert)) { + certStr_p = certStr; + certStr_len = 0; + while (1) { + toRead = min(BIO_pending(bio), CERT_STR_SIZE - certStr_len - 1); + toRead = min(toRead, BUFSIZ); + if (toRead == 0) { + break; + } + dprintf("Reading %i bytes from the certificate...", toRead); + n = BIO_read(bio, certStr_p, toRead); + if (n <= 0) { + break; + } + certStr_len += n; + certStr_p += n; + } + *certStr_p = '\0'; + (void)BIO_flush(bio); + } BIO_free(bio); } strcpy( notBefore, ASN1_UTCTIME_tostr( X509_get_notBefore(cert) )); @@ -169,12 +166,12 @@ #ifndef NO_SSL_SHA /* SHA1 */ X509_digest(cert, EVP_sha1(), sha1_hash_binary, NULL); for (int n = 0; n < SHA_DIGEST_LENGTH; n++) { - sha1_hash_ascii[n * 2] = shachars[(sha1_hash_binary[n] & 0xF0) >> 4]; - sha1_hash_ascii[n * 2 + 1] = shachars[(sha1_hash_binary[n] & 0x0F)]; + sha1_hash_ascii[n * 2] = shachars[(sha1_hash_binary[n] & 0xF0) >> 4]; + sha1_hash_ascii[n * 2 + 1] = shachars[(sha1_hash_binary[n] & 0x0F)]; } Tcl_ListObjAppendElement( interp, certPtr, Tcl_NewStringObj("sha1_hash", -1) ); Tcl_ListObjAppendElement( interp, certPtr, Tcl_NewStringObj(sha1_hash_ascii, SHA_DIGEST_LENGTH * 2) ); /* SHA256 */