Index: tls.c ================================================================== --- tls.c +++ tls.c @@ -36,38 +36,38 @@ #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 _ANSI_ARGS_ ((CONST SSL *ssl, int where, int ret)); - -static int CiphersObjCmd _ANSI_ARGS_ ((ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); - -static int HandshakeObjCmd _ANSI_ARGS_ ((ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); - -static int ImportObjCmd _ANSI_ARGS_ ((ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); - -static int StatusObjCmd _ANSI_ARGS_ ((ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); - -static int VersionObjCmd _ANSI_ARGS_ ((ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); - -static int MiscObjCmd _ANSI_ARGS_ ((ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); - -static int UnimportObjCmd _ANSI_ARGS_ ((ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); - -static SSL_CTX *CTX_Init _ANSI_ARGS_((State *statePtr, int proto, char *key, +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 proto, char *key, char *cert, char *CAdir, char *CAfile, char *ciphers, - char *DHparams)); + char *DHparams); -static int TlsLibInit _ANSI_ARGS_ ((void)) ; +static int TlsLibInit(void); #define TLS_PROTO_SSL2 0x01 #define TLS_PROTO_SSL3 0x02 #define TLS_PROTO_TLS1 0x04 #define TLS_PROTO_TLS1_1 0x08 @@ -1606,53 +1606,48 @@ * create the ssl command, initialise ssl context * *------------------------------------------------------------------- */ -int -Tls_Init(Tcl_Interp *interp) /* Interpreter in which the package is - * to be made available. */ -{ - const char tlsTclInitScript[] = { +int Tls_Init(Tcl_Interp *interp) { + const char tlsTclInitScript[] = { #include "tls.tcl.h" - }; - - int major, minor, patchlevel, release; - - /* - * We only support Tcl 8.4 or newer - */ - if ( + }; + + /* + * 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() != 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() != 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 -- * @@ -1668,17 +1663,14 @@ * A standard Tcl error code. * *------------------------------------------------------* */ -int -Tls_SafeInit (Tcl_Interp* interp) -{ - return Tls_Init (interp); +int Tls_SafeInit(Tcl_Interp *interp) { + return(Tls_Init(interp)); } - /* *------------------------------------------------------* * * TlsLibInit -- * @@ -1692,46 +1684,52 @@ * Result: * none * *------------------------------------------------------* */ -static int TlsLibInit (void) { - static int initialized = 0; - int i; - char rnd_seed[16] = "GrzSlplKqUdnnzP!"; /* 16 bytes */ - int status = TCL_OK; - - if (initialized) { - return(status); - } - initialized = 1; - -#if defined(OPENSSL_THREADS) && defined(TCL_THREADS) - size_t num_locks; - - Tcl_MutexLock(&init_mx); -#endif - -#if defined(OPENSSL_THREADS) && defined(TCL_THREADS) - /* should we consider allocating mutexes? */ - num_locks = CRYPTO_num_locks(); - if (num_locks > CRYPTO_NUM_LOCKS) { - status = TCL_ERROR; - goto done; - } - - CRYPTO_set_locking_callback(CryptoThreadLockCallback); - CRYPTO_set_id_callback(CryptoThreadIdCallback); -#endif - - if (SSL_library_init() != 1) { - status = TCL_ERROR; - goto done; - } - SSL_load_error_strings(); - ERR_load_crypto_strings(); - +static int TlsLibInit(void) { + static int initialized = 0; + int status = TCL_OK; + + if (initialized) { + return(status); + } + + initialized = 1; + +#if defined(OPENSSL_THREADS) && defined(TCL_THREADS) + size_t num_locks; + + Tcl_MutexLock(&init_mx); +#endif + +#if defined(OPENSSL_THREADS) && defined(TCL_THREADS) + /* should we consider allocating mutexes? */ + num_locks = CRYPTO_num_locks(); + if (num_locks > CRYPTO_NUM_LOCKS) { + status = TCL_ERROR; + goto done; + } + + CRYPTO_set_locking_callback(CryptoThreadLockCallback); + CRYPTO_set_id_callback(CryptoThreadIdCallback); +#endif + + if (SSL_library_init() != 1) { + status = TCL_ERROR; + goto done; + } + + SSL_load_error_strings(); + ERR_load_crypto_strings(); + +#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 * @@ -1745,13 +1743,14 @@ for (i = 0; i < 16; i++) { rnd_seed[i] = 1 + (char) (255.0 * rand()/(RAND_MAX+1.0)); } RAND_seed(rnd_seed, sizeof(rnd_seed)); } while (RAND_status() != 1); -done: +#endif +done: #if defined(OPENSSL_THREADS) && defined(TCL_THREADS) - Tcl_MutexUnlock(&init_mx); + Tcl_MutexUnlock(&init_mx); #endif - return status; + return(status); } Index: tls.h ================================================================== --- tls.h +++ tls.h @@ -16,24 +16,14 @@ * */ #ifndef _TLS_H #define _TLS_H -#include /* Internal definitions for Tcl. */ - -#ifdef TCL_STORAGE_CLASS -# undef TCL_STORAGE_CLASS -#endif -#ifdef BUILD_tls -# define TCL_STORAGE_CLASS DLLEXPORT -#else -# define TCL_STORAGE_CLASS DLLIMPORT -#endif +#include /* - * Forward declarations + * Initialization routines -- our entire public C API. */ - -EXTERN int Tls_Init _ANSI_ARGS_ ((Tcl_Interp *)); -EXTERN int Tls_SafeInit _ANSI_ARGS_ ((Tcl_Interp *)); +int Tls_Init(Tcl_Interp *interp); +int Tls_SafeInit(Tcl_Interp *interp); #endif /* _TLS_H */ Index: tlsIO.c ================================================================== --- tlsIO.c +++ tlsIO.c @@ -250,11 +250,11 @@ if (bytesRead < 0) { int err = SSL_get_error(statePtr->ssl, bytesRead); if (err == SSL_ERROR_SSL) { - Tls_Error(statePtr, SSL_ERROR(statePtr->ssl, bytesRead)); + Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, bytesRead)); *errorCodePtr = ECONNABORTED; } else if (BIO_should_retry(statePtr->bio)) { dprintf("RE! "); *errorCodePtr = EAGAIN; } else { @@ -368,11 +368,11 @@ dprintf(" [%d] syscall errr: %d", written, *errorCodePtr); written = -1; break; case SSL_ERROR_SSL: - Tls_Error(statePtr, SSL_ERROR(statePtr->ssl, written)); + Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, written)); *errorCodePtr = ECONNABORTED; written = -1; break; default: dprintf(" unknown err: %d", err); Index: tlsInt.h ================================================================== --- tlsInt.h +++ tlsInt.h @@ -42,38 +42,23 @@ # ifndef NO_SSL2 # define NO_SSL2 # endif #endif -#ifdef BSAFE -#include -#include -#include -#else #include #include #include #include -#endif /* * Determine if we should use the pre-OpenSSL 1.1.0 API */ #undef TCLTLS_OPENSSL_PRE_1_1 #if (defined(LIBRESSL_VERSION_NUMBER)) || OPENSSL_VERSION_NUMBER < 0x10100000L # define TCLTLS_OPENSSL_PRE_1_1_API 1 #endif -#ifdef TCL_STORAGE_CLASS -# undef TCL_STORAGE_CLASS -#endif -#ifdef BUILD_tls -# define TCL_STORAGE_CLASS DLLEXPORT -#else -# define TCL_STORAGE_CLASS DLLIMPORT -#endif - #ifndef ECONNABORTED #define ECONNABORTED 130 /* Software caused connection abort */ #endif #ifndef ECONNRESET #define ECONNRESET 131 /* Connection reset by peer */ @@ -83,12 +68,11 @@ #define dprintf(...) { fprintf(stderr, "%s:%i:", __func__, __LINE__); fprintf(stderr, __VA_ARGS__); fprintf(stderr, "\n"); } #else #define dprintf(...) if (0) { fprintf(stderr, __VA_ARGS__); } #endif -#define SSL_ERROR(ssl,err) \ - ((char*)ERR_reason_error_string((unsigned long)SSL_get_error((ssl),(err)))) +#define TCLTLS_SSL_ERROR(ssl,err) ((char*)ERR_reason_error_string((unsigned long)SSL_get_error((ssl),(err)))) /* * OpenSSL BIO Routines */ #define BIO_TYPE_TCL (19|0x0400) @@ -112,28 +96,28 @@ * of an ssl channel. * * The SSL processing context is maintained here, in the ClientData */ typedef struct State { - Tcl_Channel self; /* this socket channel */ - Tcl_TimerToken timer; - - int flags; /* see State.flags above */ - 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 */ - - int vflags; /* verify flags */ - SSL *ssl; /* Struct for SSL processing */ - SSL_CTX *ctx; /* SSL Context */ - BIO *bio; /* Struct for SSL processing */ - BIO *p_bio; /* Parent BIO (that is layered on Tcl_Channel) */ - - char *err; + Tcl_Channel self; /* this socket channel */ + Tcl_TimerToken timer; + + int flags; /* see State.flags above */ + 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 */ + + int vflags; /* verify flags */ + SSL *ssl; /* Struct for SSL processing */ + SSL_CTX *ctx; /* SSL Context */ + BIO *bio; /* Struct for SSL processing */ + BIO *p_bio; /* Parent BIO (that is layered on Tcl_Channel) */ + + char *err; } State; #ifdef USE_TCL_STUBS #ifndef Tcl_StackChannel #error "Unable to compile on this version of Tcl" @@ -141,18 +125,17 @@ #endif /* USE_TCL_STUBS */ /* * Forward declarations */ - -Tcl_ChannelType *Tls_ChannelType _ANSI_ARGS_((void)); -Tcl_Channel Tls_GetParent _ANSI_ARGS_((State *statePtr)); - -Tcl_Obj *Tls_NewX509Obj _ANSI_ARGS_ (( Tcl_Interp *interp, X509 *cert)); -void Tls_Error _ANSI_ARGS_ ((State *statePtr, char *msg)); -void Tls_Free _ANSI_ARGS_ ((char *blockPtr)); -void Tls_Clean _ANSI_ARGS_ ((State *statePtr)); -int Tls_WaitForConnect _ANSI_ARGS_(( State *statePtr, int *errorCodePtr)); - -BIO *BIO_new_tcl _ANSI_ARGS_((State* statePtr, int flags)); +Tcl_ChannelType *Tls_ChannelType(void); +Tcl_Channel Tls_GetParent(State *statePtr); + +Tcl_Obj *Tls_NewX509Obj(Tcl_Interp *interp, X509 *cert); +void Tls_Error(State *statePtr, char *msg); +void Tls_Free(char *blockPtr); +void Tls_Clean(State *statePtr); +int Tls_WaitForConnect(State *statePtr, int *errorCodePtr); + +BIO *BIO_new_tcl(State* statePtr, int flags); #endif /* _TLSINT_H */