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); Index: win/README.txt ================================================================== --- win/README.txt +++ win/README.txt @@ -1,64 +1,74 @@ Windows DLL Build instructions using nmake build system 2020-10-15 Harald.Oehlmann@elmicron.de + 2023-04-23 Brian O'Hagan Properties: -- 32 bit DLL +- 64 bit DLL - VisualStudio 2015 -Note: Vuisual C++ 6 does not build OpenSSL (long long syntax error) +Note: Visual C++ 6 does not build OpenSSL (long long syntax error) - Cygwin32 (temporary helper, please help to replace by tclsh) - OpenSSL statically linked to TCLTLS DLL. -Note: Dynamic linking also works but results in a DLL dependeny on OPENSSL DLL's +Note: Dynamic linking also works but results in a DLL dependency on OPENSSL DLL's 1) Build OpenSSL static libraries: -OpenSSL source distribtution unpacked in: -c:\test\tcltls\Openssl_1_1_1h - -- Install Perl from http://strawberryperl.com/download/5.32.0.1/strawberry-perl-5.32.0.1-32bit.msi - to C:\perl - (ActivePerl failed due to missing 32 bit console module) -- Install NASM Assembler: - -https://www.nasm.us/pub/nasm/releasebuilds/2.15.05/win32/nasm-2.15.05-installer-x86.exe - to C:\Program Files (x86)\NASM - --> Visual Studio x86 native prompt. - -set Path=%PATH%;C:\Program Files (x86)\NASM;C:\Perl\perl\bin +(1a) Get OpenSSL + https://github.com/openssl/openssl/releases/download/OpenSSL_1_1_1t/openssl-1.1.1t.tar.gz + + OpenSSL source distribution unpacked in: + C:\Users\Brian\Documents\Source\Build\openssl-1.1.1t + +(1b) Install Perl from https://strawberryperl.com/ + https://strawberryperl.com/download/5.32.1.1/strawberry-perl-5.32.1.1-64bit.msi + to C:\Strawberry\perl + (ActivePerl failed due to missing 32 bit console module) + +(1c) Install NASM Assembler from https://www.nasm.us/ + https://www.nasm.us/pub/nasm/releasebuilds/2.16.01/win64/nasm-2.16.01-installer-x64.exe + to C:\Program Files\NASM + +(1d) +- Configure + At Visual Studio x86 native prompt: + +set Path=%PATH%;C:\Program Files\NASM;C:\Strawberry\perl\bin perl Configure VC-WIN32 --prefix=c:\test\tcltls\openssl --openssldir=c:\test\tcltls\openssldir no-shared no-filenames threads +perl ..\Configure VC-WIN64A no-asm no-ssl3 no-zlib no-comp no-ui-console no-autoload-config --api=1.1.0 --prefix="%installdir%" --openssldir="%commoninstalldir%" -DOPENSSL_NO_DEPRECATED + nmake nmake test -namke install +nmake install 2) Build TCLTLS -Unzip distribution in: -c:\test\tcltls\tcltls-1.7.22 +2a) Unzip distribution in: +C:\Users\Brian\Documents\Source\Build\tcltls-b5c41cdeb6 --> start cygwin bash prompt +2b) Start BASH shell (MinGW62 Git shell) -cd /cygdrive/c/test/tcltls/tcltls-1.7.22 +cd /c/Users/Brian/Documents/Source/Build/tcltls-b5c41cdeb6 ./gen_dh_params > dh_params.h od -A n -v -t xC < 'tls.tcl' > tls.tcl.h.new.1 sed 's@[^0-9A-Fa-f]@@g;s@..@0x&, @g' < tls.tcl.h.new.1 > tls.tcl.h rm -f tls.tcl.h.new.1 --> Visual Studio x86 native prompt. +2c) Start Visual Studio shell -cd C:\test\tcltls\tcltls-1.7.22\win +cd C:\Users\Brian\Documents\Source\Build\tcltls-b5c41cdeb6\win nmake -f makefile.vc TCLDIR=c:\test\tcl8610 SSL_INSTALL_FOLDER=C:\test\tcltls\openssl nmake -f makefile.vc install TCLDIR=c:\test\tcl8610 INSTALLDIR=c:\test\tcltls SSL_INSTALL_FOLDER=C:\test\tcltls\openssl 3) Test Start tclsh or wish -lappend auto_path {C:\test\tcltls\tls1.7.22} package require tls - -A small "1.7.22" showing up is hopefully the end of this long way... +package require http +http::register https 443 [list ::tls::socket -autoservername true] +set tok [http::data [http::geturl https://www.tcl-lang.org]] +::http::cleanup $tok Index: win/makefile.vc ================================================================== --- win/makefile.vc +++ win/makefile.vc @@ -1,13 +1,22 @@ # call nmake with additional parameter SSL_INSTALL_FOLDER= with the -# OpenSSL instalation folder following. +# OpenSSL installation folder following. PROJECT=tls DOTVERSION = 1.7.22 -PRJ_INCLUDES = -I"$(SSL_INSTALL_FOLDER)\include" -PRJ_DEFINES = -D NO_SSL2 -D NO_SSL3 -D _CRT_SECURE_NO_WARNINGS +PRJ_INCLUDES = -I"$(SSL_INSTALL_FOLDER)\include" -I"$(OPENSSL_INSTALL_DIR)\include" +PRJ_DEFINES = -D NO_SSL2 -D NO_SSL3 -D _CRT_SECURE_NO_WARNINGS + +# SSL Libs: +# 1. ${LIBCRYPTO}.dll +# 2. ${LIBSSL}.dll +# Where LIBCRYPTO (#1.) and LIBSSL (#2.) are defined as follows: +# v1.1: libcrypto-1.1-x64.dll and libssl-1.1-x64.dll +# v3: libcrypto-3-x64.dll and libssl-3-x64.dll +# On *nix libcrypto.so.* and libssl.so.* (where suffix is a version indicator). +# PRJ_LIBS = \ "$(SSL_INSTALL_FOLDER)\lib\libssl.lib" \ "$(SSL_INSTALL_FOLDER)\lib\libcrypto.lib" \ WS2_32.LIB GDI32.LIB ADVAPI32.LIB CRYPT32.LIB USER32.LIB ADDED win/nmakehlp.c Index: win/nmakehlp.c ================================================================== --- /dev/null +++ win/nmakehlp.c @@ -0,0 +1,815 @@ +/* + * ---------------------------------------------------------------------------- + * nmakehlp.c -- + * + * This is used to fix limitations within nmake and the environment. + * + * Copyright (c) 2002 by David Gravereaux. + * Copyright (c) 2006 by Pat Thoyts + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + * ---------------------------------------------------------------------------- + */ + +#define _CRT_SECURE_NO_DEPRECATE +#include +#ifdef _MSC_VER +#pragma comment (lib, "user32.lib") +#pragma comment (lib, "kernel32.lib") +#endif +#include +#include + +/* + * This library is required for x64 builds with _some_ versions of MSVC + */ +#if defined(_M_IA64) || defined(_M_AMD64) +#if _MSC_VER >= 1400 && _MSC_VER < 1500 +#pragma comment(lib, "bufferoverflowU") +#endif +#endif + +/* ISO hack for dumb VC++ */ +#ifdef _MSC_VER +#define snprintf _snprintf +#endif + + +/* protos */ + +static int CheckForCompilerFeature(const char *option); +static int CheckForLinkerFeature(char **options, int count); +static int IsIn(const char *string, const char *substring); +static int SubstituteFile(const char *substs, const char *filename); +static int QualifyPath(const char *path); +static int LocateDependency(const char *keyfile); +static const char *GetVersionFromFile(const char *filename, const char *match, int numdots); +static DWORD WINAPI ReadFromPipe(LPVOID args); + +/* globals */ + +#define CHUNK 25 +#define STATICBUFFERSIZE 1000 +typedef struct { + HANDLE pipe; + char buffer[STATICBUFFERSIZE]; +} pipeinfo; + +pipeinfo Out = {INVALID_HANDLE_VALUE, ""}; +pipeinfo Err = {INVALID_HANDLE_VALUE, ""}; + +/* + * exitcodes: 0 == no, 1 == yes, 2 == error + */ + +int +main( + int argc, + char *argv[]) +{ + char msg[300]; + DWORD dwWritten; + int chars; + const char *s; + + /* + * Make sure children (cl.exe and link.exe) are kept quiet. + */ + + SetErrorMode(SEM_FAILCRITICALERRORS | SEM_NOOPENFILEERRORBOX); + + /* + * Make sure the compiler and linker aren't effected by the outside world. + */ + + SetEnvironmentVariable("CL", ""); + SetEnvironmentVariable("LINK", ""); + + if (argc > 1 && *argv[1] == '-') { + switch (*(argv[1]+1)) { + case 'c': + if (argc != 3) { + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -c \n" + "Tests for whether cl.exe supports an option\n" + "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); + return 2; + } + return CheckForCompilerFeature(argv[2]); + case 'l': + if (argc < 3) { + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -l ? ...?\n" + "Tests for whether link.exe supports an option\n" + "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); + return 2; + } + return CheckForLinkerFeature(&argv[2], argc-2); + case 'f': + if (argc == 2) { + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -f \n" + "Find a substring within another\n" + "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); + return 2; + } else if (argc == 3) { + /* + * If the string is blank, there is no match. + */ + + return 0; + } else { + return IsIn(argv[2], argv[3]); + } + case 's': + if (argc == 2) { + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -s \n" + "Perform a set of string map type substutitions on a file\n" + "exitcodes: 0\n", + argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); + return 2; + } + return SubstituteFile(argv[2], argv[3]); + case 'V': + if (argc != 4) { + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -V filename matchstring\n" + "Extract a version from a file:\n" + "eg: pkgIndex.tcl \"package ifneeded http\"", + argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); + return 0; + } + s = GetVersionFromFile(argv[2], argv[3], *(argv[1]+2) - '0'); + if (s && *s) { + printf("%s\n", s); + return 0; + } else + return 1; /* Version not found. Return non-0 exit code */ + + case 'Q': + if (argc != 3) { + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -Q path\n" + "Emit the fully qualified path\n" + "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); + return 2; + } + return QualifyPath(argv[2]); + + case 'L': + if (argc != 3) { + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -L keypath\n" + "Emit the fully qualified path of directory containing keypath\n" + "exitcodes: 0 == success, 1 == not found, 2 == error\n", argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); + return 2; + } + return LocateDependency(argv[2]); + } + } + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -c|-f|-l|-Q|-s|-V ...\n" + "This is a little helper app to equalize shell differences between WinNT and\n" + "Win9x and get nmake.exe to accomplish its job.\n", + argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); + return 2; +} + +static int +CheckForCompilerFeature( + const char *option) +{ + STARTUPINFO si; + PROCESS_INFORMATION pi; + SECURITY_ATTRIBUTES sa; + DWORD threadID; + char msg[300]; + BOOL ok; + HANDLE hProcess, h, pipeThreads[2]; + char cmdline[100]; + + hProcess = GetCurrentProcess(); + + ZeroMemory(&pi, sizeof(PROCESS_INFORMATION)); + ZeroMemory(&si, sizeof(STARTUPINFO)); + si.cb = sizeof(STARTUPINFO); + si.dwFlags = STARTF_USESTDHANDLES; + si.hStdInput = INVALID_HANDLE_VALUE; + + ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES)); + sa.nLength = sizeof(SECURITY_ATTRIBUTES); + sa.lpSecurityDescriptor = NULL; + sa.bInheritHandle = FALSE; + + /* + * Create a non-inheritible pipe. + */ + + CreatePipe(&Out.pipe, &h, &sa, 0); + + /* + * Dupe the write side, make it inheritible, and close the original. + */ + + DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE, + DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); + + /* + * Same as above, but for the error side. + */ + + CreatePipe(&Err.pipe, &h, &sa, 0); + DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 0, TRUE, + DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); + + /* + * Base command line. + */ + + lstrcpy(cmdline, "cl.exe -nologo -c -TC -Zs -X -Fp.\\_junk.pch "); + + /* + * Append our option for testing + */ + + lstrcat(cmdline, option); + + /* + * Filename to compile, which exists, but is nothing and empty. + */ + + lstrcat(cmdline, " .\\nul"); + + ok = CreateProcess( + NULL, /* Module name. */ + cmdline, /* Command line. */ + NULL, /* Process handle not inheritable. */ + NULL, /* Thread handle not inheritable. */ + TRUE, /* yes, inherit handles. */ + DETACHED_PROCESS, /* No console for you. */ + NULL, /* Use parent's environment block. */ + NULL, /* Use parent's starting directory. */ + &si, /* Pointer to STARTUPINFO structure. */ + &pi); /* Pointer to PROCESS_INFORMATION structure. */ + + if (!ok) { + DWORD err = GetLastError(); + int chars = snprintf(msg, sizeof(msg) - 1, + "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err); + + FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS| + FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPSTR)&msg[chars], + (300-chars), 0); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL); + return 2; + } + + /* + * Close our references to the write handles that have now been inherited. + */ + + CloseHandle(si.hStdOutput); + CloseHandle(si.hStdError); + + WaitForInputIdle(pi.hProcess, 5000); + CloseHandle(pi.hThread); + + /* + * Start the pipe reader threads. + */ + + pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID); + pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID); + + /* + * Block waiting for the process to end. + */ + + WaitForSingleObject(pi.hProcess, INFINITE); + CloseHandle(pi.hProcess); + + /* + * Wait for our pipe to get done reading, should it be a little slow. + */ + + WaitForMultipleObjects(2, pipeThreads, TRUE, 500); + CloseHandle(pipeThreads[0]); + CloseHandle(pipeThreads[1]); + + /* + * Look for the commandline warning code in both streams. + * - in MSVC 6 & 7 we get D4002, in MSVC 8 we get D9002. + */ + + return !(strstr(Out.buffer, "D4002") != NULL + || strstr(Err.buffer, "D4002") != NULL + || strstr(Out.buffer, "D9002") != NULL + || strstr(Err.buffer, "D9002") != NULL + || strstr(Out.buffer, "D2021") != NULL + || strstr(Err.buffer, "D2021") != NULL); +} + +static int +CheckForLinkerFeature( + char **options, + int count) +{ + STARTUPINFO si; + PROCESS_INFORMATION pi; + SECURITY_ATTRIBUTES sa; + DWORD threadID; + char msg[300]; + BOOL ok; + HANDLE hProcess, h, pipeThreads[2]; + int i; + char cmdline[255]; + + hProcess = GetCurrentProcess(); + + ZeroMemory(&pi, sizeof(PROCESS_INFORMATION)); + ZeroMemory(&si, sizeof(STARTUPINFO)); + si.cb = sizeof(STARTUPINFO); + si.dwFlags = STARTF_USESTDHANDLES; + si.hStdInput = INVALID_HANDLE_VALUE; + + ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES)); + sa.nLength = sizeof(SECURITY_ATTRIBUTES); + sa.lpSecurityDescriptor = NULL; + sa.bInheritHandle = TRUE; + + /* + * Create a non-inheritible pipe. + */ + + CreatePipe(&Out.pipe, &h, &sa, 0); + + /* + * Dupe the write side, make it inheritible, and close the original. + */ + + DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE, + DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); + + /* + * Same as above, but for the error side. + */ + + CreatePipe(&Err.pipe, &h, &sa, 0); + DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 0, TRUE, + DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); + + /* + * Base command line. + */ + + lstrcpy(cmdline, "link.exe -nologo "); + + /* + * Append our option for testing. + */ + + for (i = 0; i < count; i++) { + lstrcat(cmdline, " \""); + lstrcat(cmdline, options[i]); + lstrcat(cmdline, "\""); + } + + ok = CreateProcess( + NULL, /* Module name. */ + cmdline, /* Command line. */ + NULL, /* Process handle not inheritable. */ + NULL, /* Thread handle not inheritable. */ + TRUE, /* yes, inherit handles. */ + DETACHED_PROCESS, /* No console for you. */ + NULL, /* Use parent's environment block. */ + NULL, /* Use parent's starting directory. */ + &si, /* Pointer to STARTUPINFO structure. */ + &pi); /* Pointer to PROCESS_INFORMATION structure. */ + + if (!ok) { + DWORD err = GetLastError(); + int chars = snprintf(msg, sizeof(msg) - 1, + "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err); + + FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS| + FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPSTR)&msg[chars], + (300-chars), 0); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL); + return 2; + } + + /* + * Close our references to the write handles that have now been inherited. + */ + + CloseHandle(si.hStdOutput); + CloseHandle(si.hStdError); + + WaitForInputIdle(pi.hProcess, 5000); + CloseHandle(pi.hThread); + + /* + * Start the pipe reader threads. + */ + + pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID); + pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID); + + /* + * Block waiting for the process to end. + */ + + WaitForSingleObject(pi.hProcess, INFINITE); + CloseHandle(pi.hProcess); + + /* + * Wait for our pipe to get done reading, should it be a little slow. + */ + + WaitForMultipleObjects(2, pipeThreads, TRUE, 500); + CloseHandle(pipeThreads[0]); + CloseHandle(pipeThreads[1]); + + /* + * Look for the commandline warning code in the stderr stream. + */ + + return !(strstr(Out.buffer, "LNK1117") != NULL || + strstr(Err.buffer, "LNK1117") != NULL || + strstr(Out.buffer, "LNK4044") != NULL || + strstr(Err.buffer, "LNK4044") != NULL || + strstr(Out.buffer, "LNK4224") != NULL || + strstr(Err.buffer, "LNK4224") != NULL); +} + +static DWORD WINAPI +ReadFromPipe( + LPVOID args) +{ + pipeinfo *pi = (pipeinfo *) args; + char *lastBuf = pi->buffer; + DWORD dwRead; + BOOL ok; + + again: + if (lastBuf - pi->buffer + CHUNK > STATICBUFFERSIZE) { + CloseHandle(pi->pipe); + return (DWORD)-1; + } + ok = ReadFile(pi->pipe, lastBuf, CHUNK, &dwRead, 0L); + if (!ok || dwRead == 0) { + CloseHandle(pi->pipe); + return 0; + } + lastBuf += dwRead; + goto again; + + return 0; /* makes the compiler happy */ +} + +static int +IsIn( + const char *string, + const char *substring) +{ + return (strstr(string, substring) != NULL); +} + +/* + * GetVersionFromFile -- + * Looks for a match string in a file and then returns the version + * following the match where a version is anything acceptable to + * package provide or package ifneeded. + */ + +static const char * +GetVersionFromFile( + const char *filename, + const char *match, + int numdots) +{ + static char szBuffer[100]; + char *szResult = NULL; + FILE *fp = fopen(filename, "rt"); + + if (fp != NULL) { + /* + * Read data until we see our match string. + */ + + while (fgets(szBuffer, sizeof(szBuffer), fp) != NULL) { + LPSTR p, q; + + p = strstr(szBuffer, match); + if (p != NULL) { + /* + * Skip to first digit after the match. + */ + + p += strlen(match); + while (*p && !isdigit((unsigned char)*p)) { + ++p; + } + + /* + * Find ending whitespace. + */ + + q = p; + while (*q && (strchr("0123456789.ab", *q)) && (((!strchr(".ab", *q) + && !strchr("ab", q[-1])) || --numdots))) { + ++q; + } + + *q = 0; + szResult = p; + break; + } + } + fclose(fp); + } + return szResult; +} + +/* + * List helpers for the SubstituteFile function + */ + +typedef struct list_item_t { + struct list_item_t *nextPtr; + char * key; + char * value; +} list_item_t; + +/* insert a list item into the list (list may be null) */ +static list_item_t * +list_insert(list_item_t **listPtrPtr, const char *key, const char *value) +{ + list_item_t *itemPtr = (list_item_t *)malloc(sizeof(list_item_t)); + if (itemPtr) { + itemPtr->key = strdup(key); + itemPtr->value = strdup(value); + itemPtr->nextPtr = NULL; + + while(*listPtrPtr) { + listPtrPtr = &(*listPtrPtr)->nextPtr; + } + *listPtrPtr = itemPtr; + } + return itemPtr; +} + +static void +list_free(list_item_t **listPtrPtr) +{ + list_item_t *tmpPtr, *listPtr = *listPtrPtr; + while (listPtr) { + tmpPtr = listPtr; + listPtr = listPtr->nextPtr; + free(tmpPtr->key); + free(tmpPtr->value); + free(tmpPtr); + } +} + +/* + * SubstituteFile -- + * As windows doesn't provide anything useful like sed and it's unreliable + * to use the tclsh you are building against (consider x-platform builds - + * eg compiling AMD64 target from IX86) we provide a simple substitution + * option here to handle autoconf style substitutions. + * The substitution file is whitespace and line delimited. The file should + * consist of lines matching the regular expression: + * \s*\S+\s+\S*$ + * + * Usage is something like: + * nmakehlp -S << $** > $@ + * @PACKAGE_NAME@ $(PACKAGE_NAME) + * @PACKAGE_VERSION@ $(PACKAGE_VERSION) + * << + */ + +static int +SubstituteFile( + const char *substitutions, + const char *filename) +{ + static char szBuffer[1024], szCopy[1024]; + list_item_t *substPtr = NULL; + FILE *fp, *sp; + + fp = fopen(filename, "rt"); + if (fp != NULL) { + + /* + * Build a list of substutitions from the first filename + */ + + sp = fopen(substitutions, "rt"); + if (sp != NULL) { + while (fgets(szBuffer, sizeof(szBuffer), sp) != NULL) { + unsigned char *ks, *ke, *vs, *ve; + ks = (unsigned char*)szBuffer; + while (ks && *ks && isspace(*ks)) ++ks; + ke = ks; + while (ke && *ke && !isspace(*ke)) ++ke; + vs = ke; + while (vs && *vs && isspace(*vs)) ++vs; + ve = vs; + while (ve && *ve && !(*ve == '\r' || *ve == '\n')) ++ve; + *ke = 0, *ve = 0; + list_insert(&substPtr, (char*)ks, (char*)vs); + } + fclose(sp); + } + + /* debug: dump the list */ +#ifndef NDEBUG + { + int n = 0; + list_item_t *p = NULL; + for (p = substPtr; p != NULL; p = p->nextPtr, ++n) { + fprintf(stderr, "% 3d '%s' => '%s'\n", n, p->key, p->value); + } + } +#endif + + /* + * Run the substitutions over each line of the input + */ + + while (fgets(szBuffer, sizeof(szBuffer), fp) != NULL) { + list_item_t *p = NULL; + for (p = substPtr; p != NULL; p = p->nextPtr) { + char *m = strstr(szBuffer, p->key); + if (m) { + char *cp, *op, *sp; + cp = szCopy; + op = szBuffer; + while (op != m) *cp++ = *op++; + sp = p->value; + while (sp && *sp) *cp++ = *sp++; + op += strlen(p->key); + while (*op) *cp++ = *op++; + *cp = 0; + memcpy(szBuffer, szCopy, sizeof(szCopy)); + } + } + printf("%s", szBuffer); + } + + list_free(&substPtr); + } + fclose(fp); + return 0; +} + +BOOL FileExists(LPCTSTR szPath) +{ +#ifndef INVALID_FILE_ATTRIBUTES + #define INVALID_FILE_ATTRIBUTES ((DWORD)-1) +#endif + DWORD pathAttr = GetFileAttributes(szPath); + return (pathAttr != INVALID_FILE_ATTRIBUTES && + !(pathAttr & FILE_ATTRIBUTE_DIRECTORY)); +} + + +/* + * QualifyPath -- + * + * This composes the current working directory with a provided path + * and returns the fully qualified and normalized path. + * Mostly needed to setup paths for testing. + */ + +static int +QualifyPath( + const char *szPath) +{ + char szCwd[MAX_PATH + 1]; + + GetFullPathName(szPath, sizeof(szCwd)-1, szCwd, NULL); + printf("%s\n", szCwd); + return 0; +} + +/* + * Implements LocateDependency for a single directory. See that command + * for an explanation. + * Returns 0 if found after printing the directory. + * Returns 1 if not found but no errors. + * Returns 2 on any kind of error + * Basically, these are used as exit codes for the process. + */ +static int LocateDependencyHelper(const char *dir, const char *keypath) +{ + HANDLE hSearch; + char path[MAX_PATH+1]; + size_t dirlen; + int keylen, ret; + WIN32_FIND_DATA finfo; + + if (dir == NULL || keypath == NULL) + return 2; /* Have no real error reporting mechanism into nmake */ + dirlen = strlen(dir); + if ((dirlen + 3) > sizeof(path)) + return 2; + strncpy(path, dir, dirlen); + strncpy(path+dirlen, "\\*", 3); /* Including terminating \0 */ + keylen = strlen(keypath); + +#if 0 /* This function is not available in Visual C++ 6 */ + /* + * Use numerics 0 -> FindExInfoStandard, + * 1 -> FindExSearchLimitToDirectories, + * as these are not defined in Visual C++ 6 + */ + hSearch = FindFirstFileEx(path, 0, &finfo, 1, NULL, 0); +#else + hSearch = FindFirstFile(path, &finfo); +#endif + if (hSearch == INVALID_HANDLE_VALUE) + return 1; /* Not found */ + + /* Loop through all subdirs checking if the keypath is under there */ + ret = 1; /* Assume not found */ + do { + int sublen; + /* + * We need to check it is a directory despite the + * FindExSearchLimitToDirectories in the above call. See SDK docs + */ + if ((finfo.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) == 0) + continue; + sublen = strlen(finfo.cFileName); + if ((dirlen+1+sublen+1+keylen+1) > sizeof(path)) + continue; /* Path does not fit, assume not matched */ + strncpy(path+dirlen+1, finfo.cFileName, sublen); + path[dirlen+1+sublen] = '\\'; + strncpy(path+dirlen+1+sublen+1, keypath, keylen+1); + if (FileExists(path)) { + /* Found a match, print to stdout */ + path[dirlen+1+sublen] = '\0'; + QualifyPath(path); + ret = 0; + break; + } + } while (FindNextFile(hSearch, &finfo)); + FindClose(hSearch); + return ret; +} + +/* + * LocateDependency -- + * + * Locates a dependency for a package. + * keypath - a relative path within the package directory + * that is used to confirm it is the correct directory. + * The search path for the package directory is currently only + * the parent and grandparent of the current working directory. + * If found, the command prints + * name_DIRPATH= + * and returns 0. If not found, does not print anything and returns 1. + */ +static int LocateDependency(const char *keypath) +{ + size_t i; + int ret; + static const char *paths[] = {"..", "..\\..", "..\\..\\.."}; + + for (i = 0; i < (sizeof(paths)/sizeof(paths[0])); ++i) { + ret = LocateDependencyHelper(paths[i], keypath); + if (ret == 0) + return ret; + } + return ret; +} + + +/* + * Local variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * indent-tabs-mode: t + * tab-width: 8 + * End: + */ ADDED win/rules-ext.vc Index: win/rules-ext.vc ================================================================== --- /dev/null +++ win/rules-ext.vc @@ -0,0 +1,118 @@ +# This file should only be included in makefiles for Tcl extensions, +# NOT in the makefile for Tcl itself. + +!ifndef _RULES_EXT_VC + +# We need to run from the directory the parent makefile is located in. +# nmake does not tell us what makefile was used to invoke it so parent +# makefile has to set the MAKEFILEVC macro or we just make a guess and +# warn if we think that is not the case. +!if "$(MAKEFILEVC)" == "" + +!if exist("$(PROJECT).vc") +MAKEFILEVC = $(PROJECT).vc +!elseif exist("makefile.vc") +MAKEFILEVC = makefile.vc +!endif +!endif # "$(MAKEFILEVC)" == "" + +!if !exist("$(MAKEFILEVC)") +MSG = ^ +You must run nmake from the directory containing the project makefile.^ +If you are doing that and getting this message, set the MAKEFILEVC^ +macro to the name of the project makefile. +!message WARNING: $(MSG) +!endif + +!if "$(PROJECT)" == "tcl" +!error The rules-ext.vc file is not intended for Tcl itself. +!endif + +# We extract version numbers using the nmakehlp program. For now use +# the local copy of nmakehlp. Once we locate Tcl, we will use that +# one if it is newer. +!if [$(CC) -nologo -DNDEBUG "nmakehlp.c" -link -subsystem:console > nul] +!endif + +# First locate the Tcl directory that we are working with. +!if "$(TCLDIR)" != "" + +_RULESDIR = $(TCLDIR:/=\) + +!else + +# If an installation path is specified, that is also the Tcl directory. +# Also Tk never builds against an installed Tcl, it needs Tcl sources +!if defined(INSTALLDIR) && "$(PROJECT)" != "tk" +_RULESDIR=$(INSTALLDIR:/=\) +!else +# Locate Tcl sources +!if [echo _RULESDIR = \> nmakehlp.out] \ + || [nmakehlp -L generic\tcl.h >> nmakehlp.out] +_RULESDIR = ..\..\tcl +!else +!include nmakehlp.out +!endif + +!endif # defined(INSTALLDIR).... + +!endif # ifndef TCLDIR + +# Now look for the targets.vc file under the Tcl root. Note we check this +# file and not rules.vc because the latter also exists on older systems. +!if exist("$(_RULESDIR)\lib\nmake\targets.vc") # Building against installed Tcl +_RULESDIR = $(_RULESDIR)\lib\nmake +!elseif exist("$(_RULESDIR)\win\targets.vc") # Building against Tcl sources +_RULESDIR = $(_RULESDIR)\win +!else +# If we have not located Tcl's targets file, most likely we are compiling +# against an older version of Tcl and so must use our own support files. +_RULESDIR = . +!endif + +!if "$(_RULESDIR)" != "." +# Potentially using Tcl's support files. If this extension has its own +# nmake support files, need to compare the versions and pick newer. + +!if exist("rules.vc") # The extension has its own copy + +!if [echo TCL_RULES_MAJOR = \> versions.vc] \ + && [nmakehlp -V "$(_RULESDIR)\rules.vc" RULES_VERSION_MAJOR >> versions.vc] +!endif +!if [echo TCL_RULES_MINOR = \>> versions.vc] \ + && [nmakehlp -V "$(_RULESDIR)\rules.vc" RULES_VERSION_MINOR >> versions.vc] +!endif + +!if [echo OUR_RULES_MAJOR = \>> versions.vc] \ + && [nmakehlp -V "rules.vc" RULES_VERSION_MAJOR >> versions.vc] +!endif +!if [echo OUR_RULES_MINOR = \>> versions.vc] \ + && [nmakehlp -V "rules.vc" RULES_VERSION_MINOR >> versions.vc] +!endif +!include versions.vc +# We have a newer version of the support files, use them +!if ($(TCL_RULES_MAJOR) != $(OUR_RULES_MAJOR)) || ($(TCL_RULES_MINOR) < $(OUR_RULES_MINOR)) +_RULESDIR = . +!endif + +!endif # if exist("rules.vc") + +!endif # if $(_RULESDIR) != "." + +# Let rules.vc know what copy of nmakehlp.c to use. +NMAKEHLPC = $(_RULESDIR)\nmakehlp.c + +# Get rid of our internal defines before calling rules.vc +!undef TCL_RULES_MAJOR +!undef TCL_RULES_MINOR +!undef OUR_RULES_MAJOR +!undef OUR_RULES_MINOR + +!if exist("$(_RULESDIR)\rules.vc") +!message *** Using $(_RULESDIR)\rules.vc +!include "$(_RULESDIR)\rules.vc" +!else +!error *** Could not locate rules.vc in $(_RULESDIR) +!endif + +!endif # _RULES_EXT_VC ADDED win/rules.vc Index: win/rules.vc ================================================================== --- /dev/null +++ win/rules.vc @@ -0,0 +1,1885 @@ +#------------------------------------------------------------- -*- makefile -*- +# rules.vc -- +# +# Part of the nmake based build system for Tcl and its extensions. +# This file does all the hard work in terms of parsing build options, +# compiler switches, defining common targets and macros. The Tcl makefile +# directly includes this. Extensions include it via "rules-ext.vc". +# +# See TIP 477 (https://core.tcl-lang.org/tips/doc/main/tip/477.md) for +# detailed documentation. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# Copyright (c) 2001-2003 David Gravereaux. +# Copyright (c) 2003-2008 Patrick Thoyts +# Copyright (c) 2017 Ashok P. Nadkarni +#------------------------------------------------------------------------------ + +!ifndef _RULES_VC +_RULES_VC = 1 + +# The following macros define the version of the rules.vc nmake build system +# For modifications that are not backward-compatible, you *must* change +# the major version. +RULES_VERSION_MAJOR = 1 +RULES_VERSION_MINOR = 11 + +# The PROJECT macro must be defined by parent makefile. +!if "$(PROJECT)" == "" +!error *** Error: Macro PROJECT not defined! Please define it before including rules.vc +!endif + +!if "$(PRJ_PACKAGE_TCLNAME)" == "" +PRJ_PACKAGE_TCLNAME = $(PROJECT) +!endif + +# Also special case Tcl and Tk to save some typing later +DOING_TCL = 0 +DOING_TK = 0 +!if "$(PROJECT)" == "tcl" +DOING_TCL = 1 +!elseif "$(PROJECT)" == "tk" +DOING_TK = 1 +!endif + +!ifndef NEED_TK +# Backwards compatibility +!ifdef PROJECT_REQUIRES_TK +NEED_TK = $(PROJECT_REQUIRES_TK) +!else +NEED_TK = 0 +!endif +!endif + +!ifndef NEED_TCL_SOURCE +NEED_TCL_SOURCE = 0 +!endif + +!ifdef NEED_TK_SOURCE +!if $(NEED_TK_SOURCE) +NEED_TK = 1 +!endif +!else +NEED_TK_SOURCE = 0 +!endif + +################################################################ +# Nmake is a pretty weak environment in syntax and capabilities +# so this file is necessarily verbose. It's broken down into +# the following parts. +# +# 0. Sanity check that compiler environment is set up and initialize +# any built-in settings from the parent makefile +# 1. First define the external tools used for compiling, copying etc. +# as this is independent of everything else. +# 2. Figure out our build structure in terms of the directory, whether +# we are building Tcl or an extension, etc. +# 3. Determine the compiler and linker versions +# 4. Build the nmakehlp helper application +# 5. Determine the supported compiler options and features +# 6. Parse the OPTS macro value for user-specified build configuration +# 7. Parse the STATS macro value for statistics instrumentation +# 8. Parse the CHECKS macro for additional compilation checks +# 9. Extract Tcl, and possibly Tk, version numbers from the headers +# 10. Based on this selected configuration, construct the output +# directory and file paths +# 11. Construct the paths where the package is to be installed +# 12. Set up the actual options passed to compiler and linker based +# on the information gathered above. +# 13. Define some standard build targets and implicit rules. These may +# be optionally disabled by the parent makefile. +# 14. (For extensions only.) Compare the configuration of the target +# Tcl and the extensions and warn against discrepancies. +# +# One final note about the macro names used. They are as they are +# for historical reasons. We would like legacy extensions to +# continue to work with this make include file so be wary of +# changing them for consistency or clarity. + +# 0. Sanity check compiler environment + +# Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or +# VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir) + +!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WINDOWSSDKDIR) +MSG = ^ +Visual C++ compiler environment not initialized. +!error $(MSG) +!endif + +# We need to run from the directory the parent makefile is located in. +# nmake does not tell us what makefile was used to invoke it so parent +# makefile has to set the MAKEFILEVC macro or we just make a guess and +# warn if we think that is not the case. +!if "$(MAKEFILEVC)" == "" + +!if exist("$(PROJECT).vc") +MAKEFILEVC = $(PROJECT).vc +!elseif exist("makefile.vc") +MAKEFILEVC = makefile.vc +!endif +!endif # "$(MAKEFILEVC)" == "" + +!if !exist("$(MAKEFILEVC)") +MSG = ^ +You must run nmake from the directory containing the project makefile.^ +If you are doing that and getting this message, set the MAKEFILEVC^ +macro to the name of the project makefile. +!message WARNING: $(MSG) +!endif + + +################################################################ +# 1. Define external programs being used + +#---------------------------------------------------------- +# Set the proper copy method to avoid overwrite questions +# to the user when copying files and selecting the right +# "delete all" method. +#---------------------------------------------------------- + +RMDIR = rmdir /S /Q +CPY = xcopy /i /y >NUL +CPYDIR = xcopy /e /i /y >NUL +COPY = copy /y >NUL +MKDIR = mkdir + +###################################################################### +# 2. Figure out our build environment in terms of what we're building. +# +# (a) Tcl itself +# (b) Tk +# (c) a Tcl extension using libraries/includes from an *installed* Tcl +# (d) a Tcl extension using libraries/includes from Tcl source directory +# +# This last is needed because some extensions still need +# some Tcl interfaces that are not publicly exposed. +# +# The fragment will set the following macros: +# ROOT - root of this module sources +# COMPATDIR - source directory that holds compatibility sources +# DOCDIR - source directory containing documentation files +# GENERICDIR - platform-independent source directory +# WIN_DIR - Windows-specific source directory +# TESTDIR - directory containing test files +# TOOLSDIR - directory containing build tools +# _TCLDIR - root of the Tcl installation OR the Tcl sources. Not set +# when building Tcl itself. +# _INSTALLDIR - native form of the installation path. For Tcl +# this will be the root of the Tcl installation. For extensions +# this will be the lib directory under the root. +# TCLINSTALL - set to 1 if _TCLDIR refers to +# headers and libraries from an installed Tcl, and 0 if built against +# Tcl sources. Not set when building Tcl itself. Yes, not very well +# named. +# _TCL_H - native path to the tcl.h file +# +# If Tk is involved, also sets the following +# _TKDIR - native form Tk installation OR Tk source. Not set if building +# Tk itself. +# TKINSTALL - set 1 if _TKDIR refers to installed Tk and 0 if Tk sources +# _TK_H - native path to the tk.h file + +# Root directory for sources and assumed subdirectories +ROOT = $(MAKEDIR)\.. +# The following paths CANNOT have spaces in them as they appear on the +# left side of implicit rules. +!ifndef COMPATDIR +COMPATDIR = $(ROOT)\compat +!endif +!ifndef DOCDIR +DOCDIR = $(ROOT)\doc +!endif +!ifndef GENERICDIR +GENERICDIR = $(ROOT)\generic +!endif +!ifndef TOOLSDIR +TOOLSDIR = $(ROOT)\tools +!endif +!ifndef TESTDIR +TESTDIR = $(ROOT)\tests +!endif +!ifndef LIBDIR +!if exist("$(ROOT)\library") +LIBDIR = $(ROOT)\library +!else +LIBDIR = $(ROOT)\lib +!endif +!endif +!ifndef DEMODIR +!if exist("$(LIBDIR)\demos") +DEMODIR = $(LIBDIR)\demos +!else +DEMODIR = $(ROOT)\demos +!endif +!endif # ifndef DEMODIR +# Do NOT use WINDIR because it is Windows internal environment +# variable to point to c:\windows! +WIN_DIR = $(ROOT)\win + +!ifndef RCDIR +!if exist("$(WIN_DIR)\rc") +RCDIR = $(WIN_DIR)\rc +!else +RCDIR = $(WIN_DIR) +!endif +!endif +RCDIR = $(RCDIR:/=\) + +# The target directory where the built packages and binaries will be installed. +# INSTALLDIR is the (optional) path specified by the user. +# _INSTALLDIR is INSTALLDIR using the backslash separator syntax +!ifdef INSTALLDIR +### Fix the path separators. +_INSTALLDIR = $(INSTALLDIR:/=\) +!else +### Assume the normal default. +_INSTALLDIR = $(HOMEDRIVE)\Tcl +!endif + +!if $(DOING_TCL) + +# BEGIN Case 2(a) - Building Tcl itself + +# Only need to define _TCL_H +_TCL_H = ..\generic\tcl.h + +# END Case 2(a) - Building Tcl itself + +!elseif $(DOING_TK) + +# BEGIN Case 2(b) - Building Tk + +TCLINSTALL = 0 # Tk always builds against Tcl source, not an installed Tcl +!if "$(TCLDIR)" == "" +!if [echo TCLDIR = \> nmakehlp.out] \ + || [nmakehlp -L generic\tcl.h >> nmakehlp.out] +!error *** Could not locate Tcl source directory. +!endif +!include nmakehlp.out +!endif # TCLDIR == "" + +_TCLDIR = $(TCLDIR:/=\) +_TCL_H = $(_TCLDIR)\generic\tcl.h +!if !exist("$(_TCL_H)") +!error Could not locate tcl.h. Please set the TCLDIR macro to point to the Tcl *source* directory. +!endif + +_TK_H = ..\generic\tk.h + +# END Case 2(b) - Building Tk + +!else + +# BEGIN Case 2(c) or (d) - Building an extension other than Tk + +# If command line has specified Tcl location through TCLDIR, use it +# else default to the INSTALLDIR setting +!if "$(TCLDIR)" != "" + +_TCLDIR = $(TCLDIR:/=\) +!if exist("$(_TCLDIR)\include\tcl.h") # Case 2(c) with TCLDIR defined +TCLINSTALL = 1 +_TCL_H = $(_TCLDIR)\include\tcl.h +!elseif exist("$(_TCLDIR)\generic\tcl.h") # Case 2(d) with TCLDIR defined +TCLINSTALL = 0 +_TCL_H = $(_TCLDIR)\generic\tcl.h +!endif + +!else # # Case 2(c) for extensions with TCLDIR undefined + +# Need to locate Tcl depending on whether it needs Tcl source or not. +# If we don't, check the INSTALLDIR for an installed Tcl first + +!if exist("$(_INSTALLDIR)\include\tcl.h") && !$(NEED_TCL_SOURCE) + +TCLINSTALL = 1 +TCLDIR = $(_INSTALLDIR)\.. +# NOTE: we will be resetting _INSTALLDIR to _INSTALLDIR/lib for extensions +# later so the \.. accounts for the /lib +_TCLDIR = $(_INSTALLDIR)\.. +_TCL_H = $(_TCLDIR)\include\tcl.h + +!else # exist(...) && !$(NEED_TCL_SOURCE) + +!if [echo _TCLDIR = \> nmakehlp.out] \ + || [nmakehlp -L generic\tcl.h >> nmakehlp.out] +!error *** Could not locate Tcl source directory. +!endif +!include nmakehlp.out +TCLINSTALL = 0 +TCLDIR = $(_TCLDIR) +_TCL_H = $(_TCLDIR)\generic\tcl.h + +!endif # exist(...) && !$(NEED_TCL_SOURCE) + +!endif # TCLDIR + +!ifndef _TCL_H +MSG =^ +Failed to find tcl.h. The TCLDIR macro is set incorrectly or is not set and default path does not contain tcl.h. +!error $(MSG) +!endif + +# Now do the same to locate Tk headers and libs if project requires Tk +!if $(NEED_TK) + +!if "$(TKDIR)" != "" + +_TKDIR = $(TKDIR:/=\) +!if exist("$(_TKDIR)\include\tk.h") +TKINSTALL = 1 +_TK_H = $(_TKDIR)\include\tk.h +!elseif exist("$(_TKDIR)\generic\tk.h") +TKINSTALL = 0 +_TK_H = $(_TKDIR)\generic\tk.h +!endif + +!else # TKDIR not defined + +# Need to locate Tcl depending on whether it needs Tcl source or not. +# If we don't, check the INSTALLDIR for an installed Tcl first + +!if exist("$(_INSTALLDIR)\include\tk.h") && !$(NEED_TK_SOURCE) + +TKINSTALL = 1 +# NOTE: we will be resetting _INSTALLDIR to _INSTALLDIR/lib for extensions +# later so the \.. accounts for the /lib +_TKDIR = $(_INSTALLDIR)\.. +_TK_H = $(_TKDIR)\include\tk.h +TKDIR = $(_TKDIR) + +!else # exist("$(_INSTALLDIR)\include\tk.h") && !$(NEED_TK_SOURCE) + +!if [echo _TKDIR = \> nmakehlp.out] \ + || [nmakehlp -L generic\tk.h >> nmakehlp.out] +!error *** Could not locate Tk source directory. +!endif +!include nmakehlp.out +TKINSTALL = 0 +TKDIR = $(_TKDIR) +_TK_H = $(_TKDIR)\generic\tk.h + +!endif # exist("$(_INSTALLDIR)\include\tk.h") && !$(NEED_TK_SOURCE) + +!endif # TKDIR + +!ifndef _TK_H +MSG =^ +Failed to find tk.h. The TKDIR macro is set incorrectly or is not set and default path does not contain tk.h. +!error $(MSG) +!endif + +!endif # NEED_TK + +!if $(NEED_TCL_SOURCE) && $(TCLINSTALL) +MSG = ^ +*** Warning: This extension requires the source distribution of Tcl.^ +*** Please set the TCLDIR macro to point to the Tcl sources. +!error $(MSG) +!endif + +!if $(NEED_TK_SOURCE) +!if $(TKINSTALL) +MSG = ^ +*** Warning: This extension requires the source distribution of Tk.^ +*** Please set the TKDIR macro to point to the Tk sources. +!error $(MSG) +!endif +!endif + + +# If INSTALLDIR set to Tcl installation root dir then reset to the +# lib dir for installing extensions +!if exist("$(_INSTALLDIR)\include\tcl.h") +_INSTALLDIR=$(_INSTALLDIR)\lib +!endif + +# END Case 2(c) or (d) - Building an extension +!endif # if $(DOING_TCL) + +################################################################ +# 3. Determine compiler version and architecture +# In this section, we figure out the compiler version and the +# architecture for which we are building. This sets the +# following macros: +# VCVERSION - the internal compiler version as 1200, 1400, 1910 etc. +# This is also printed by the compiler in dotted form 19.10 etc. +# VCVER - the "marketing version", for example Visual C++ 6 for internal +# compiler version 1200. This is kept only for legacy reasons as it +# does not make sense for recent Microsoft compilers. Only used for +# output directory names. +# ARCH - set to IX86, ARM64 or AMD64 depending on 32- or 64-bit target +# NATIVE_ARCH - set to IX86, ARM64 or AMD64 for the host machine +# MACHINE - same as $(ARCH) - legacy +# _VC_MANIFEST_EMBED_{DLL,EXE} - commands for embedding a manifest if needed + +cc32 = $(CC) # built-in default. +link32 = link +lib32 = lib +rc32 = $(RC) # built-in default. + +#---------------------------------------------------------------- +# Figure out the compiler architecture and version by writing +# the C macros to a file, preprocessing them with the C +# preprocessor and reading back the created file + +_HASH=^# +_VC_MANIFEST_EMBED_EXE= +_VC_MANIFEST_EMBED_DLL= +VCVER=0 +!if ![echo VCVERSION=_MSC_VER > vercl.x] \ + && ![echo $(_HASH)if defined(_M_IX86) >> vercl.x] \ + && ![echo ARCH=IX86 >> vercl.x] \ + && ![echo $(_HASH)elif defined(_M_AMD64) >> vercl.x] \ + && ![echo ARCH=AMD64 >> vercl.x] \ + && ![echo $(_HASH)elif defined(_M_ARM64) >> vercl.x] \ + && ![echo ARCH=ARM64 >> vercl.x] \ + && ![echo $(_HASH)endif >> vercl.x] \ + && ![$(cc32) -nologo -TC -P vercl.x 2>NUL] +!include vercl.i +!if $(VCVERSION) < 1900 +!if ![echo VCVER= ^\> vercl.vc] \ + && ![set /a $(VCVERSION) / 100 - 6 >> vercl.vc] +!include vercl.vc +!endif +!else +# The simple calculation above does not apply to new Visual Studio releases +# Keep the compiler version in its native form. +VCVER = $(VCVERSION) +!endif +!endif + +!if ![del 2>NUL /q/f vercl.x vercl.i vercl.vc] +!endif + +#---------------------------------------------------------------- +# The MACHINE macro is used by legacy makefiles so set it as well +!ifdef MACHINE +!if "$(MACHINE)" == "x86" +!undef MACHINE +MACHINE = IX86 +!elseif "$(MACHINE)" == "arm64" +!undef MACHINE +MACHINE = ARM64 +!elseif "$(MACHINE)" == "x64" +!undef MACHINE +MACHINE = AMD64 +!endif +!if "$(MACHINE)" != "$(ARCH)" +!error Specified MACHINE macro $(MACHINE) does not match detected target architecture $(ARCH). +!endif +!else +MACHINE=$(ARCH) +!endif + +#--------------------------------------------------------------- +# The PLATFORM_IDENTIFY macro matches the values returned by +# the Tcl platform::identify command +!if "$(MACHINE)" == "AMD64" +PLATFORM_IDENTIFY = win32-x86_64 +!elseif "$(MACHINE)" == "ARM64" +PLATFORM_IDENTIFY = win32-arm +!else +PLATFORM_IDENTIFY = win32-ix86 +!endif + +# The MULTIPLATFORM macro controls whether binary extensions are installed +# in platform-specific directories. Intended to be set/used by extensions. +!ifndef MULTIPLATFORM_INSTALL +MULTIPLATFORM_INSTALL = 0 +!endif + +#------------------------------------------------------------ +# Figure out the *host* architecture by reading the registry + +!if ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i x86] +NATIVE_ARCH=IX86 +!elseif ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i ARM | findstr /i 64-bit] +NATIVE_ARCH=ARM64 +!else +NATIVE_ARCH=AMD64 +!endif + +# Since MSVC8 we must deal with manifest resources. +!if $(VCVERSION) >= 1400 +_VC_MANIFEST_EMBED_EXE=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1 +_VC_MANIFEST_EMBED_DLL=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2 +!endif + +################################################################ +# 4. Build the nmakehlp program +# This is a helper app we need to overcome nmake's limiting +# environment. We will call out to it to get various bits of +# information about supported compiler options etc. +# +# Tcl itself will always use the nmakehlp.c program which is +# in its own source. It will be kept updated there. +# +# Extensions built against an installed Tcl will use the installed +# copy of Tcl's nmakehlp.c if there is one and their own version +# otherwise. In the latter case, they would also be using their own +# rules.vc. Note that older versions of Tcl do not install nmakehlp.c +# or rules.vc. +# +# Extensions built against Tcl sources will use the one from the Tcl source. +# +# When building an extension using a sufficiently new version of Tcl, +# rules-ext.vc will define NMAKEHLPC appropriately to point to the +# copy of nmakehlp.c to be used. + +!ifndef NMAKEHLPC +# Default to the one in the current directory (the extension's own nmakehlp.c) +NMAKEHLPC = nmakehlp.c + +!if !$(DOING_TCL) +!if $(TCLINSTALL) +!if exist("$(_TCLDIR)\lib\nmake\nmakehlp.c") +NMAKEHLPC = $(_TCLDIR)\lib\nmake\nmakehlp.c +!endif +!else # !$(TCLINSTALL) +!if exist("$(_TCLDIR)\win\nmakehlp.c") +NMAKEHLPC = $(_TCLDIR)\win\nmakehlp.c +!endif +!endif # $(TCLINSTALL) +!endif # !$(DOING_TCL) + +!endif # NMAKEHLPC + +# We always build nmakehlp even if it exists since we do not know +# what source it was built from. +!if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)" +!if [$(cc32) -nologo "$(NMAKEHLPC)" -link -subsystem:console > nul] +!endif +!else +!if [copy $(NMAKEHLPC:nmakehlp.c=x86_64-w64-mingw32-nmakehlp.exe) nmakehlp.exe >NUL] +!endif +!endif + +################################################################ +# 5. Test for compiler features +# Visual C++ compiler options have changed over the years. Check +# which options are supported by the compiler in use. +# +# The following macros are set: +# OPTIMIZATIONS - the compiler flags to be used for optimized builds +# DEBUGFLAGS - the compiler flags to be used for debug builds +# LINKERFLAGS - Flags passed to the linker +# +# Note that these are the compiler settings *available*, not those +# that will be *used*. The latter depends on the OPTS macro settings +# which we have not yet parsed. +# +# Also note that some of the flags in OPTIMIZATIONS are not really +# related to optimization. They are placed there only for legacy reasons +# as some extensions expect them to be included in that macro. + +# -Op improves float consistency. Note only needed for older compilers +# Newer compilers do not need or support this option. +!if [nmakehlp -c -Op] +FPOPTS = -Op +!endif + +# Strict floating point semantics - present in newer compilers in lieu of -Op +!if [nmakehlp -c -fp:strict] +FPOPTS = $(FPOPTS) -fp:strict +!endif + +!if "$(MACHINE)" == "IX86" +### test for pentium errata +!if [nmakehlp -c -QI0f] +!message *** Compiler has 'Pentium 0x0f fix' +FPOPTS = $(FPOPTS) -QI0f +!else +!message *** Compiler does not have 'Pentium 0x0f fix' +!endif +!endif + +### test for optimizations +# /O2 optimization includes /Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy as per +# documentation. Note we do NOT want /Gs as that inserts a _chkstk +# stack probe at *every* function entry, not just those with more than +# a page of stack allocation resulting in a performance hit. However, +# /O2 documentation is misleading as its stack probes are simply the +# default page size locals allocation probes and not what is implied +# by an explicit /Gs option. + +OPTIMIZATIONS = $(FPOPTS) + +!if [nmakehlp -c -O2] +OPTIMIZING = 1 +OPTIMIZATIONS = $(OPTIMIZATIONS) -O2 +!else +# Legacy, really. All modern compilers support this +!message *** Compiler does not have 'Optimizations' +OPTIMIZING = 0 +!endif + +# Checks for buffer overflows in local arrays +!if [nmakehlp -c -GS] +OPTIMIZATIONS = $(OPTIMIZATIONS) -GS +!endif + +# Link time optimization. Note that this option (potentially) makes +# generated libraries only usable by the specific VC++ version that +# created it. Requires /LTCG linker option +!if [nmakehlp -c -GL] +OPTIMIZATIONS = $(OPTIMIZATIONS) -GL +CC_GL_OPT_ENABLED = 1 +!else +# In newer compilers -GL and -YX are incompatible. +!if [nmakehlp -c -YX] +OPTIMIZATIONS = $(OPTIMIZATIONS) -YX +!endif +!endif # [nmakehlp -c -GL] + +DEBUGFLAGS = $(FPOPTS) + +# Run time error checks. Not available or valid in a release, non-debug build +# RTC is for modern compilers, -GZ is legacy +!if [nmakehlp -c -RTC1] +DEBUGFLAGS = $(DEBUGFLAGS) -RTC1 +!elseif [nmakehlp -c -GZ] +DEBUGFLAGS = $(DEBUGFLAGS) -GZ +!endif + +#---------------------------------------------------------------- +# Linker flags + +# LINKER_TESTFLAGS are for internal use when we call nmakehlp to test +# if the linker supports a specific option. Without these flags link will +# return "LNK1561: entry point must be defined" error compiling from VS-IDE: +# They are not passed through to the actual application / extension +# link rules. +!ifndef LINKER_TESTFLAGS +LINKER_TESTFLAGS = /DLL /NOENTRY /OUT:nmakehlp.out +!endif + +LINKERFLAGS = + +# If compiler has enabled link time optimization, linker must too with -ltcg +!ifdef CC_GL_OPT_ENABLED +!if [nmakehlp -l -ltcg $(LINKER_TESTFLAGS)] +LINKERFLAGS = $(LINKERFLAGS) -ltcg +!endif +!endif + + +################################################################ +# 6. Extract various version numbers from headers +# For Tcl and Tk, version numbers are extracted from tcl.h and tk.h +# respectively. For extensions, versions are extracted from the +# configure.in or configure.ac from the TEA configuration if it +# exists, and unset otherwise. +# Sets the following macros: +# TCL_MAJOR_VERSION +# TCL_MINOR_VERSION +# TCL_RELEASE_SERIAL +# TCL_PATCH_LEVEL +# TCL_PATCH_LETTER +# TCL_VERSION +# TK_MAJOR_VERSION +# TK_MINOR_VERSION +# TK_RELEASE_SERIAL +# TK_PATCH_LEVEL +# TK_PATCH_LETTER +# TK_VERSION +# DOTVERSION - set as (for example) 2.5 +# VERSION - set as (for example 25) +#-------------------------------------------------------------- + +!if [echo REM = This file is generated from rules.vc > versions.vc] +!endif +!if [echo TCL_MAJOR_VERSION = \>> versions.vc] \ + && [nmakehlp -V "$(_TCL_H)" "define TCL_MAJOR_VERSION" >> versions.vc] +!endif +!if [echo TCL_MINOR_VERSION = \>> versions.vc] \ + && [nmakehlp -V "$(_TCL_H)" TCL_MINOR_VERSION >> versions.vc] +!endif +!if [echo TCL_RELEASE_SERIAL = \>> versions.vc] \ + && [nmakehlp -V "$(_TCL_H)" TCL_RELEASE_SERIAL >> versions.vc] +!endif +!if [echo TCL_PATCH_LEVEL = \>> versions.vc] \ + && [nmakehlp -V "$(_TCL_H)" TCL_PATCH_LEVEL >> versions.vc] +!endif + +!if defined(_TK_H) +!if [echo TK_MAJOR_VERSION = \>> versions.vc] \ + && [nmakehlp -V $(_TK_H) "define TK_MAJOR_VERSION" >> versions.vc] +!endif +!if [echo TK_MINOR_VERSION = \>> versions.vc] \ + && [nmakehlp -V $(_TK_H) TK_MINOR_VERSION >> versions.vc] +!endif +!if [echo TK_RELEASE_SERIAL = \>> versions.vc] \ + && [nmakehlp -V "$(_TK_H)" TK_RELEASE_SERIAL >> versions.vc] +!endif +!if [echo TK_PATCH_LEVEL = \>> versions.vc] \ + && [nmakehlp -V $(_TK_H) TK_PATCH_LEVEL >> versions.vc] +!endif +!endif # _TK_H + +!include versions.vc + +TCL_VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION) +TCL_DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION) +!if [nmakehlp -f $(TCL_PATCH_LEVEL) "a"] +TCL_PATCH_LETTER = a +!elseif [nmakehlp -f $(TCL_PATCH_LEVEL) "b"] +TCL_PATCH_LETTER = b +!else +TCL_PATCH_LETTER = . +!endif + +!if defined(_TK_H) + +TK_VERSION = $(TK_MAJOR_VERSION)$(TK_MINOR_VERSION) +TK_DOTVERSION = $(TK_MAJOR_VERSION).$(TK_MINOR_VERSION) +!if [nmakehlp -f $(TK_PATCH_LEVEL) "a"] +TK_PATCH_LETTER = a +!elseif [nmakehlp -f $(TK_PATCH_LEVEL) "b"] +TK_PATCH_LETTER = b +!else +TK_PATCH_LETTER = . +!endif + +!endif + +# Set DOTVERSION and VERSION +!if $(DOING_TCL) + +DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION) +VERSION = $(TCL_VERSION) + +!elseif $(DOING_TK) + +DOTVERSION = $(TK_DOTVERSION) +VERSION = $(TK_VERSION) + +!else # Doing a non-Tk extension + +# If parent makefile has not defined DOTVERSION, try to get it from TEA +# first from a configure.in file, and then from configure.ac +!ifndef DOTVERSION +!if [echo DOTVERSION = \> versions.vc] \ + || [nmakehlp -V $(ROOT)\configure.in ^[$(PROJECT)^] >> versions.vc] +!if [echo DOTVERSION = \> versions.vc] \ + || [nmakehlp -V $(ROOT)\configure.ac ^[$(PROJECT)^] >> versions.vc] +!error *** Could not figure out extension version. Please define DOTVERSION in parent makefile before including rules.vc. +!endif +!endif +!include versions.vc +!endif # DOTVERSION +VERSION = $(DOTVERSION:.=) + +!endif # $(DOING_TCL) ... etc. + +# Windows RC files have 3 version components. Ensure this irrespective +# of how many components the package has specified. Basically, ensure +# minimum 4 components by appending 4 0's and then pick out the first 4. +# Also take care of the fact that DOTVERSION may have "a" or "b" instead +# of "." separating the version components. +DOTSEPARATED=$(DOTVERSION:a=.) +DOTSEPARATED=$(DOTSEPARATED:b=.) +!if [echo RCCOMMAVERSION = \> versions.vc] \ + || [for /f "tokens=1,2,3,4,5* delims=." %a in ("$(DOTSEPARATED).0.0.0.0") do echo %a,%b,%c,%d >> versions.vc] +!error *** Could not generate RCCOMMAVERSION *** +!endif +!include versions.vc + +######################################################################## +# 7. Parse the OPTS macro to work out the requested build configuration. +# Based on this, we will construct the actual switches to be passed to the +# compiler and linker using the macros defined in the previous section. +# The following macros are defined by this section based on OPTS +# STATIC_BUILD - 0 -> Tcl is to be built as a shared library +# 1 -> build as a static library and shell +# TCL_THREADS - legacy but always 1 on Windows since winsock requires it. +# DEBUG - 1 -> debug build, 0 -> release builds +# SYMBOLS - 1 -> generate PDB's, 0 -> no PDB's +# PROFILE - 1 -> generate profiling info, 0 -> no profiling +# PGO - 1 -> profile based optimization, 0 -> no +# MSVCRT - 1 -> link to dynamic C runtime even when building static Tcl build +# 0 -> link to static C runtime for static Tcl build. +# Does not impact shared Tcl builds (STATIC_BUILD == 0) +# Default: 1 for Tcl 8.7 and up, 0 otherwise. +# TCL_USE_STATIC_PACKAGES - 1 -> statically link the registry and dde extensions +# in the Tcl and Wish shell. 0 -> keep them as shared libraries. Does +# not impact shared Tcl builds. Implied by STATIC_BUILD since Tcl 8.7. +# USE_THREAD_ALLOC - 1 -> Use a shared global free pool for allocation. +# 0 -> Use the non-thread allocator. +# UNCHECKED - 1 -> when doing a debug build with symbols, use the release +# C runtime, 0 -> use the debug C runtime. +# USE_STUBS - 1 -> compile to use stubs interfaces, 0 -> direct linking +# CONFIG_CHECK - 1 -> check current build configuration against Tcl +# configuration (ignored for Tcl itself) +# _USE_64BIT_TIME_T - forces a build using 64-bit time_t for 32-bit build +# (CRT library should support this, not needed for Tcl 9.x) +# TCL_UTF_MAX=3 - forces a build using UTF-16 internally (not recommended). +# Further, LINKERFLAGS are modified based on above. + +# Default values for all the above +STATIC_BUILD = 0 +TCL_THREADS = 1 +DEBUG = 0 +SYMBOLS = 0 +PROFILE = 0 +PGO = 0 +MSVCRT = 1 +TCL_USE_STATIC_PACKAGES = 0 +USE_THREAD_ALLOC = 1 +UNCHECKED = 0 +CONFIG_CHECK = 1 +!if $(DOING_TCL) +USE_STUBS = 0 +!else +USE_STUBS = 1 +!endif + +# If OPTS is not empty AND does not contain "none" which turns off all OPTS +# set the above macros based on OPTS content +!if "$(OPTS)" != "" && ![nmakehlp -f "$(OPTS)" "none"] + +# OPTS are specified, parse them + +!if [nmakehlp -f $(OPTS) "static"] +!message *** Doing static +STATIC_BUILD = 1 +!endif + +!if [nmakehlp -f $(OPTS) "nostubs"] +!message *** Not using stubs +USE_STUBS = 0 +!endif + +!if [nmakehlp -f $(OPTS) "nomsvcrt"] +!message *** Doing nomsvcrt +MSVCRT = 0 +!else +!if [nmakehlp -f $(OPTS) "msvcrt"] +!message *** Doing msvcrt +!else +!if $(TCL_MAJOR_VERSION) == 8 && $(TCL_MINOR_VERSION) < 7 && $(STATIC_BUILD) +MSVCRT = 0 +!endif +!endif +!endif # [nmakehlp -f $(OPTS) "nomsvcrt"] + +!if [nmakehlp -f $(OPTS) "staticpkg"] && $(STATIC_BUILD) +!message *** Doing staticpkg +TCL_USE_STATIC_PACKAGES = 1 +!endif + +!if [nmakehlp -f $(OPTS) "nothreads"] +!message *** Compile explicitly for non-threaded tcl +TCL_THREADS = 0 +USE_THREAD_ALLOC= 0 +!endif + +!if [nmakehlp -f $(OPTS) "tcl8"] +!message *** Build for Tcl8 +TCL_BUILD_FOR = 8 +!endif + +!if $(TCL_MAJOR_VERSION) == 8 +!if [nmakehlp -f $(OPTS) "time64bit"] +!message *** Force 64-bit time_t +_USE_64BIT_TIME_T = 1 +!endif + +!if [nmakehlp -f $(OPTS) "utf16"] +!message *** Force UTF-16 internally +TCL_UTF_MAX = 3 +!endif +!endif + +# Yes, it's weird that the "symbols" option controls DEBUG and +# the "pdbs" option controls SYMBOLS. That's historical. +!if [nmakehlp -f $(OPTS) "symbols"] +!message *** Doing symbols +DEBUG = 1 +!else +DEBUG = 0 +!endif + +!if [nmakehlp -f $(OPTS) "pdbs"] +!message *** Doing pdbs +SYMBOLS = 1 +!else +SYMBOLS = 0 +!endif + +!if [nmakehlp -f $(OPTS) "profile"] +!message *** Doing profile +PROFILE = 1 +!else +PROFILE = 0 +!endif + +!if [nmakehlp -f $(OPTS) "pgi"] +!message *** Doing profile guided optimization instrumentation +PGO = 1 +!elseif [nmakehlp -f $(OPTS) "pgo"] +!message *** Doing profile guided optimization +PGO = 2 +!else +PGO = 0 +!endif + +!if [nmakehlp -f $(OPTS) "loimpact"] +!message *** Warning: ignoring option "loimpact" - deprecated on modern Windows. +!endif + +# TBD - should get rid of this option +!if [nmakehlp -f $(OPTS) "thrdalloc"] +!message *** Doing thrdalloc +USE_THREAD_ALLOC = 1 +!endif + +!if [nmakehlp -f $(OPTS) "tclalloc"] +USE_THREAD_ALLOC = 0 +!endif + +!if [nmakehlp -f $(OPTS) "unchecked"] +!message *** Doing unchecked +UNCHECKED = 1 +!else +UNCHECKED = 0 +!endif + +!if [nmakehlp -f $(OPTS) "noconfigcheck"] +CONFIG_CHECK = 1 +!else +CONFIG_CHECK = 0 +!endif + +!endif # "$(OPTS)" != "" && ... parsing of OPTS + +# Set linker flags based on above + +!if $(PGO) > 1 +!if [nmakehlp -l -ltcg:pgoptimize $(LINKER_TESTFLAGS)] +LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pgoptimize +!else +MSG=^ +This compiler does not support profile guided optimization. +!error $(MSG) +!endif +!elseif $(PGO) > 0 +!if [nmakehlp -l -ltcg:pginstrument $(LINKER_TESTFLAGS)] +LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pginstrument +!else +MSG=^ +This compiler does not support profile guided optimization. +!error $(MSG) +!endif +!endif + +################################################################ +# 8. Parse the STATS macro to configure code instrumentation +# The following macros are set by this section: +# TCL_MEM_DEBUG - 1 -> enables memory allocation instrumentation +# 0 -> disables +# TCL_COMPILE_DEBUG - 1 -> enables byte compiler logging +# 0 -> disables + +# Default both are off +TCL_MEM_DEBUG = 0 +TCL_COMPILE_DEBUG = 0 + +!if "$(STATS)" != "" && ![nmakehlp -f "$(STATS)" "none"] + +!if [nmakehlp -f $(STATS) "memdbg"] +!message *** Doing memdbg +TCL_MEM_DEBUG = 1 +!else +TCL_MEM_DEBUG = 0 +!endif + +!if [nmakehlp -f $(STATS) "compdbg"] +!message *** Doing compdbg +TCL_COMPILE_DEBUG = 1 +!else +TCL_COMPILE_DEBUG = 0 +!endif + +!endif + +#################################################################### +# 9. Parse the CHECKS macro to configure additional compiler checks +# The following macros are set by this section: +# WARNINGS - compiler switches that control the warnings level +# TCL_NO_DEPRECATED - 1 -> disable support for deprecated functions +# 0 -> enable deprecated functions + +# Defaults - Permit deprecated functions and warning level 3 +TCL_NO_DEPRECATED = 0 +WARNINGS = -W3 + +!if "$(CHECKS)" != "" && ![nmakehlp -f "$(CHECKS)" "none"] + +!if [nmakehlp -f $(CHECKS) "nodep"] +!message *** Doing nodep check +TCL_NO_DEPRECATED = 1 +!endif + +!if [nmakehlp -f $(CHECKS) "fullwarn"] +!message *** Doing full warnings check +WARNINGS = -W4 +!if [nmakehlp -l -warn:3 $(LINKER_TESTFLAGS)] +LINKERFLAGS = $(LINKERFLAGS) -warn:3 +!endif +!endif + +!if [nmakehlp -f $(CHECKS) "64bit"] && [nmakehlp -c -Wp64] +!message *** Doing 64bit portability warnings +WARNINGS = $(WARNINGS) -Wp64 +!endif + +!endif + + +################################################################ +# 10. Construct output directory and file paths +# Figure-out how to name our intermediate and output directories. +# In order to avoid inadvertent mixing of object files built using +# different compilers, build configurations etc., +# +# Naming convention (suffixes): +# t = full thread support. (Not used for Tcl >= 8.7) +# s = static library (as opposed to an import library) +# g = linked to the debug enabled C run-time. +# x = special static build when it links to the dynamic C run-time. +# +# The following macros are set in this section: +# SUFX - the suffix to use for binaries based on above naming convention +# BUILDDIRTOP - the toplevel default output directory +# is of the form {Release,Debug}[_AMD64][_COMPILERVERSION] +# TMP_DIR - directory where object files are created +# OUT_DIR - directory where output executables are created +# Both TMP_DIR and OUT_DIR are defaulted only if not defined by the +# parent makefile (or command line). The default values are +# based on BUILDDIRTOP. +# STUBPREFIX - name of the stubs library for this project +# PRJIMPLIB - output path of the generated project import library +# PRJLIBNAME - name of generated project library +# PRJLIB - output path of generated project library +# PRJSTUBLIBNAME - name of the generated project stubs library +# PRJSTUBLIB - output path of the generated project stubs library +# RESFILE - output resource file (only if not static build) + +SUFX = tsgx + +!if $(DEBUG) +BUILDDIRTOP = Debug +!else +BUILDDIRTOP = Release +!endif + +!if "$(MACHINE)" != "IX86" +BUILDDIRTOP =$(BUILDDIRTOP)_$(MACHINE) +!endif +!if $(VCVER) > 6 +BUILDDIRTOP =$(BUILDDIRTOP)_VC$(VCVER) +!endif + +!if !$(DEBUG) || $(TCL_VERSION) > 86 || $(DEBUG) && $(UNCHECKED) +SUFX = $(SUFX:g=) +!endif + +TMP_DIRFULL = .\$(BUILDDIRTOP)\$(PROJECT)_ThreadedDynamicStaticX + +!if !$(STATIC_BUILD) +TMP_DIRFULL = $(TMP_DIRFULL:Static=) +SUFX = $(SUFX:s=) +EXT = dll +TMP_DIRFULL = $(TMP_DIRFULL:X=) +SUFX = $(SUFX:x=) +!else +TMP_DIRFULL = $(TMP_DIRFULL:Dynamic=) +EXT = lib +!if !$(MSVCRT) +TMP_DIRFULL = $(TMP_DIRFULL:X=) +SUFX = $(SUFX:x=) +!endif +!endif + +!if !$(TCL_THREADS) || $(TCL_VERSION) > 86 +TMP_DIRFULL = $(TMP_DIRFULL:Threaded=) +SUFX = $(SUFX:t=) +!endif + +!ifndef TMP_DIR +TMP_DIR = $(TMP_DIRFULL) +!ifndef OUT_DIR +OUT_DIR = .\$(BUILDDIRTOP) +!endif +!else +!ifndef OUT_DIR +OUT_DIR = $(TMP_DIR) +!endif +!endif + +# Relative paths -> absolute +!if [echo OUT_DIR = \> nmakehlp.out] \ + || [nmakehlp -Q "$(OUT_DIR)" >> nmakehlp.out] +!error *** Could not fully qualify path OUT_DIR=$(OUT_DIR) +!endif +!if [echo TMP_DIR = \>> nmakehlp.out] \ + || [nmakehlp -Q "$(TMP_DIR)" >> nmakehlp.out] +!error *** Could not fully qualify path TMP_DIR=$(TMP_DIR) +!endif +!include nmakehlp.out + +# The name of the stubs library for the project being built +STUBPREFIX = $(PROJECT)stub + +# +# Set up paths to various Tcl executables and libraries needed by extensions +# + +# TIP 430. Unused for 8.6 but no harm defining it to allow a common rules.vc +TCLSCRIPTZIPNAME = libtcl$(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)$(TCL_PATCH_LETTER)$(TCL_RELEASE_SERIAL).zip +TKSCRIPTZIPNAME = libtk$(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)$(TK_PATCH_LETTER)$(TK_RELEASE_SERIAL).zip + +!if $(DOING_TCL) +TCLSHNAME = $(PROJECT)sh$(VERSION)$(SUFX).exe +TCLSH = $(OUT_DIR)\$(TCLSHNAME) +TCLIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib +TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT) +TCLLIB = $(OUT_DIR)\$(TCLLIBNAME) +TCLSCRIPTZIP = $(OUT_DIR)\$(TCLSCRIPTZIPNAME) + +!if $(TCL_MAJOR_VERSION) == 8 +TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib +!else +TCLSTUBLIBNAME = $(STUBPREFIX).lib +!endif +TCLSTUBLIB = $(OUT_DIR)\$(TCLSTUBLIBNAME) +TCL_INCLUDES = -I"$(WIN_DIR)" -I"$(GENERICDIR)" + +!else # !$(DOING_TCL) + +!if $(TCLINSTALL) # Building against an installed Tcl + +# When building extensions, we need to locate tclsh. Depending on version +# of Tcl we are building against, this may or may not have a "t" suffix. +# Try various possibilities in turn. +TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX:t=).exe +!if !exist("$(TCLSH)") +TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX:t=).exe +!endif + +!if $(TCL_MAJOR_VERSION) == 8 +TCLSTUBLIB = $(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib +!else +TCLSTUBLIB = $(_TCLDIR)\lib\tclstub.lib +!endif +TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:t=).lib +# When building extensions, may be linking against Tcl that does not add +# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. +!if !exist("$(TCLIMPLIB)") +TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)t$(SUFX:t=).lib +!endif +TCL_LIBRARY = $(_TCLDIR)\lib +TCLREGLIB = $(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib +TCLDDELIB = $(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib +TCLSCRIPTZIP = $(_TCLDIR)\lib\$(TCLSCRIPTZIPNAME) +TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target +TCL_INCLUDES = -I"$(_TCLDIR)\include" + +!else # Building against Tcl sources + +TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX:t=).exe +!if !exist($(TCLSH)) +TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX:t=).exe +!endif +!if $(TCL_MAJOR_VERSION) == 8 +TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib +!else +TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub.lib +!endif +TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:t=).lib +# When building extensions, may be linking against Tcl that does not add +# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. +!if !exist("$(TCLIMPLIB)") +TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)t$(SUFX:t=).lib +!endif +TCL_LIBRARY = $(_TCLDIR)\library +TCLREGLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib +TCLDDELIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib +TCLSCRIPTZIP = $(_TCLDIR)\win\$(BUILDDIRTOP)\$(TCLSCRIPTZIPNAME) +TCLTOOLSDIR = $(_TCLDIR)\tools +TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win" + +!endif # TCLINSTALL + +!if !$(STATIC_BUILD) && "$(TCL_BUILD_FOR)" == "8" +tcllibs = "$(TCLSTUBLIB)" +!else +tcllibs = "$(TCLSTUBLIB)" "$(TCLIMPLIB)" +!endif + +!endif # $(DOING_TCL) + +# We need a tclsh that will run on the host machine as part of the build. +# IX86 runs on all architectures. +!ifndef TCLSH_NATIVE +!if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)" +TCLSH_NATIVE = $(TCLSH) +!else +!error You must explicitly set TCLSH_NATIVE for cross-compilation +!endif +!endif + +# Do the same for Tk and Tk extensions that require the Tk libraries +!if $(DOING_TK) || $(NEED_TK) +WISHNAMEPREFIX = wish +WISHNAME = $(WISHNAMEPREFIX)$(TK_VERSION)$(SUFX).exe +TKLIBNAME = tk$(TK_VERSION)$(SUFX).$(EXT) +TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX).lib +TKSTUBLIBNAME = tkstub$(TK_VERSION).lib + +!if $(DOING_TK) +WISH = $(OUT_DIR)\$(WISHNAME) +TKSTUBLIB = $(OUT_DIR)\$(TKSTUBLIBNAME) +TKIMPLIB = $(OUT_DIR)\$(TKIMPLIBNAME) +TKLIB = $(OUT_DIR)\$(TKLIBNAME) +TK_INCLUDES = -I"$(WIN_DIR)" -I"$(GENERICDIR)" +TKSCRIPTZIP = $(OUT_DIR)\$(TKSCRIPTZIPNAME) + +!else # effectively NEED_TK + +!if $(TKINSTALL) # Building against installed Tk +WISH = $(_TKDIR)\bin\$(WISHNAME) +TKSTUBLIB = $(_TKDIR)\lib\$(TKSTUBLIBNAME) +TKIMPLIB = $(_TKDIR)\lib\$(TKIMPLIBNAME) +# When building extensions, may be linking against Tk that does not add +# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. +!if !exist("$(TKIMPLIB)") +TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX:t=).lib +TKIMPLIB = $(_TKDIR)\lib\$(TKIMPLIBNAME) +!endif +TK_INCLUDES = -I"$(_TKDIR)\include" +TKSCRIPTZIP = $(_TKDIR)\lib\$(TKSCRIPTZIPNAME) + +!else # Building against Tk sources + +WISH = $(_TKDIR)\win\$(BUILDDIRTOP)\$(WISHNAME) +TKSTUBLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKSTUBLIBNAME) +TKIMPLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKIMPLIBNAME) +# When building extensions, may be linking against Tk that does not add +# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. +!if !exist("$(TKIMPLIB)") +TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX:t=).lib +TKIMPLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKIMPLIBNAME) +!endif +TK_INCLUDES = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib" +TKSCRIPTZIP = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKSCRIPTZIPNAME) + +!endif # TKINSTALL + +tklibs = "$(TKSTUBLIB)" "$(TKIMPLIB)" + +!endif # $(DOING_TK) +!endif # $(DOING_TK) || $(NEED_TK) + +# Various output paths +PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib +PRJLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT) +PRJLIB = $(OUT_DIR)\$(PRJLIBNAME) +PRJSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib +PRJSTUBLIB = $(OUT_DIR)\$(PRJSTUBLIBNAME) + +# If extension parent makefile has not defined a resource definition file, +# we will generate one from standard template. +!if !$(DOING_TCL) && !$(DOING_TK) && !$(STATIC_BUILD) +!ifdef RCFILE +RESFILE = $(TMP_DIR)\$(RCFILE:.rc=.res) +!else +RESFILE = $(TMP_DIR)\$(PROJECT).res +!endif +!endif + +################################################################### +# 11. Construct the paths for the installation directories +# The following macros get defined in this section: +# LIB_INSTALL_DIR - where libraries should be installed +# BIN_INSTALL_DIR - where the executables should be installed +# DOC_INSTALL_DIR - where documentation should be installed +# SCRIPT_INSTALL_DIR - where scripts should be installed +# INCLUDE_INSTALL_DIR - where C include files should be installed +# DEMO_INSTALL_DIR - where demos should be installed +# PRJ_INSTALL_DIR - where package will be installed (not set for Tcl and Tk) + +!if $(DOING_TCL) || $(DOING_TK) +LIB_INSTALL_DIR = $(_INSTALLDIR)\lib +BIN_INSTALL_DIR = $(_INSTALLDIR)\bin +DOC_INSTALL_DIR = $(_INSTALLDIR)\doc +!if $(DOING_TCL) +SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\$(PROJECT)$(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION) +MODULE_INSTALL_DIR = $(_INSTALLDIR)\lib\tcl$(TCL_MAJOR_VERSION) +!else # DOING_TK +SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\$(PROJECT)$(TK_MAJOR_VERSION).$(TK_MINOR_VERSION) +!endif +DEMO_INSTALL_DIR = $(SCRIPT_INSTALL_DIR)\demos +INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include + +!else # extension other than Tk + +PRJ_INSTALL_DIR = $(_INSTALLDIR)\$(PROJECT)$(DOTVERSION) +!if $(MULTIPLATFORM_INSTALL) +LIB_INSTALL_DIR = $(PRJ_INSTALL_DIR)\$(PLATFORM_IDENTIFY) +BIN_INSTALL_DIR = $(PRJ_INSTALL_DIR)\$(PLATFORM_IDENTIFY) +!else +LIB_INSTALL_DIR = $(PRJ_INSTALL_DIR) +BIN_INSTALL_DIR = $(PRJ_INSTALL_DIR) +!endif +DOC_INSTALL_DIR = $(PRJ_INSTALL_DIR) +SCRIPT_INSTALL_DIR = $(PRJ_INSTALL_DIR) +DEMO_INSTALL_DIR = $(PRJ_INSTALL_DIR)\demos +INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\..\include + +!endif + +################################################################### +# 12. Set up actual options to be passed to the compiler and linker +# Now we have all the information we need, set up the actual flags and +# options that we will pass to the compiler and linker. The main +# makefile should use these in combination with whatever other flags +# and switches are specific to it. +# The following macros are defined, names are for historical compatibility: +# OPTDEFINES - /Dxxx C macro flags based on user-specified OPTS +# COMPILERFLAGS - /Dxxx C macro flags independent of any configuration opttions +# crt - Compiler switch that selects the appropriate C runtime +# cdebug - Compiler switches related to debug AND optimizations +# cwarn - Compiler switches that set warning levels +# cflags - complete compiler switches (subsumes cdebug and cwarn) +# ldebug - Linker switches controlling debug information and optimization +# lflags - complete linker switches (subsumes ldebug) except subsystem type +# dlllflags - complete linker switches to build DLLs (subsumes lflags) +# conlflags - complete linker switches for console program (subsumes lflags) +# guilflags - complete linker switches for GUI program (subsumes lflags) +# baselibs - minimum Windows libraries required. Parent makefile can +# define PRJ_LIBS before including rules.rc if additional libs are needed + +OPTDEFINES = /DSTDC_HEADERS /DUSE_NMAKE=1 +!if $(VCVERSION) > 1600 +OPTDEFINES = $(OPTDEFINES) /DHAVE_STDINT_H=1 +!else +OPTDEFINES = $(OPTDEFINES) /DMP_NO_STDINT=1 +!endif +!if $(VCVERSION) >= 1800 +OPTDEFINES = $(OPTDEFINES) /DHAVE_INTTYPES_H=1 /DHAVE_STDBOOL_H=1 +!endif + +!if $(TCL_MEM_DEBUG) +OPTDEFINES = $(OPTDEFINES) /DTCL_MEM_DEBUG +!endif +!if $(TCL_COMPILE_DEBUG) +OPTDEFINES = $(OPTDEFINES) /DTCL_COMPILE_DEBUG /DTCL_COMPILE_STATS +!endif +!if $(TCL_THREADS) && $(TCL_VERSION) < 87 +OPTDEFINES = $(OPTDEFINES) /DTCL_THREADS=1 +!if $(USE_THREAD_ALLOC) && $(TCL_VERSION) < 87 +OPTDEFINES = $(OPTDEFINES) /DUSE_THREAD_ALLOC=1 +!endif +!endif +!if $(STATIC_BUILD) +OPTDEFINES = $(OPTDEFINES) /DSTATIC_BUILD +!elseif $(TCL_VERSION) > 86 +OPTDEFINES = $(OPTDEFINES) /DTCL_WITH_EXTERNAL_TOMMATH +!if "$(MACHINE)" == "AMD64" || "$(MACHINE)" == "ARM64" +OPTDEFINES = $(OPTDEFINES) /DMP_64BIT +!endif +!endif +!if $(TCL_NO_DEPRECATED) +OPTDEFINES = $(OPTDEFINES) /DTCL_NO_DEPRECATED +!endif + +!if $(USE_STUBS) +# Note we do not define USE_TCL_STUBS even when building tk since some +# test targets in tk do not use stubs +!if !$(DOING_TCL) +USE_STUBS_DEFS = /DUSE_TCL_STUBS /DUSE_TCLOO_STUBS +!if $(NEED_TK) +USE_STUBS_DEFS = $(USE_STUBS_DEFS) /DUSE_TK_STUBS +!endif +!endif +!endif # USE_STUBS + +!if !$(DEBUG) +OPTDEFINES = $(OPTDEFINES) /DNDEBUG +!if $(OPTIMIZING) +OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_OPTIMIZED +!endif +!endif +!if $(PROFILE) +OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_PROFILED +!endif +!if "$(MACHINE)" == "AMD64" || "$(MACHINE)" == "ARM64" +OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_DO64BIT +!endif +!if $(VCVERSION) < 1300 +OPTDEFINES = $(OPTDEFINES) /DNO_STRTOI64=1 +!endif + +!if $(TCL_MAJOR_VERSION) == 8 +!if "$(_USE_64BIT_TIME_T)" == "1" +OPTDEFINES = $(OPTDEFINES) /D_USE_64BIT_TIME_T=1 +!endif + +# _ATL_XP_TARGETING - Newer SDK's need this to build for XP +COMPILERFLAGS = /D_ATL_XP_TARGETING +!endif +!if "$(TCL_UTF_MAX)" == "3" +OPTDEFINES = $(OPTDEFINES) /DTCL_UTF_MAX=3 +!endif +!if "$(TCL_BUILD_FOR)" == "8" +OPTDEFINES = $(OPTDEFINES) /DTCL_MAJOR_VERSION=8 +!endif + +# Like the TEA system only set this non empty for non-Tk extensions +# Note: some extensions use PACKAGE_NAME and others use PACKAGE_TCLNAME +# so we pass both +!if !$(DOING_TCL) && !$(DOING_TK) +PKGNAMEFLAGS = /DPACKAGE_NAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \ + /DPACKAGE_TCLNAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \ + /DPACKAGE_VERSION="\"$(DOTVERSION)\"" \ + /DMODULE_SCOPE=extern +!endif + +# crt picks the C run time based on selected OPTS +!if $(MSVCRT) +!if $(DEBUG) && !$(UNCHECKED) +crt = -MDd +!else +crt = -MD +!endif +!else +!if $(DEBUG) && !$(UNCHECKED) +crt = -MTd +!else +crt = -MT +!endif +!endif + +# cdebug includes compiler options for debugging as well as optimization. +!if $(DEBUG) + +# In debugging mode, optimizations need to be disabled +cdebug = -Zi -Od $(DEBUGFLAGS) + +!else + +cdebug = $(OPTIMIZATIONS) +!if $(SYMBOLS) +cdebug = $(cdebug) -Zi +!endif + +!endif # $(DEBUG) + +# cwarn includes default warning levels, also C4090 (buggy) and C4146 is useless. +cwarn = $(WARNINGS) -wd4090 -wd4146 + +!if "$(MACHINE)" == "AMD64" || "$(MACHINE)" == "ARM64" +# Disable pointer<->int warnings related to cast between different sizes +# There are a gadzillion of these due to use of ClientData and +# clutter up compiler +# output increasing chance of a real warning getting lost. So disable them. +# Eventually some day, Tcl will be 64-bit clean. +cwarn = $(cwarn) -wd4311 -wd4312 +!endif + +### Common compiler options that are architecture specific +!if "$(MACHINE)" == "ARM" +carch = /D_ARM_WINAPI_PARTITION_DESKTOP_SDK_AVAILABLE +!else +carch = +!endif + +# cpuid is only available on intel machines +!if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "AMD64" +carch = $(carch) /DHAVE_CPUID=1 +!endif + +!if $(DEBUG) +# Turn warnings into errors +cwarn = $(cwarn) -WX +!endif + +INCLUDES = $(TCL_INCLUDES) $(TK_INCLUDES) $(PRJ_INCLUDES) +!if !$(DOING_TCL) && !$(DOING_TK) +INCLUDES = $(INCLUDES) -I"$(GENERICDIR)" -I"$(WIN_DIR)" -I"$(COMPATDIR)" +!endif + +# These flags are defined roughly in the order of the pre-reform +# rules.vc/makefile.vc to help visually compare that the pre- and +# post-reform build logs + +# cflags contains generic flags used for building practically all object files +cflags = -nologo -c $(COMPILERFLAGS) $(carch) $(cwarn) -Fp$(TMP_DIR)^\ $(cdebug) + +# appcflags contains $(cflags) and flags for building the application +# object files (e.g. tclsh, or wish) pkgcflags contains $(cflags) plus +# flags used for building shared object files The two differ in the +# BUILD_$(PROJECT) macro which should be defined only for the shared +# library *implementation* and not for its caller interface + +appcflags_nostubs = $(cflags) $(crt) $(INCLUDES) $(TCL_DEFINES) $(PRJ_DEFINES) $(OPTDEFINES) +appcflags = $(appcflags_nostubs) $(USE_STUBS_DEFS) +pkgcflags = $(appcflags) $(PKGNAMEFLAGS) /DBUILD_$(PROJECT) +pkgcflags_nostubs = $(appcflags_nostubs) $(PKGNAMEFLAGS) /DBUILD_$(PROJECT) + +# stubscflags contains $(cflags) plus flags used for building a stubs +# library for the package. Note: /DSTATIC_BUILD is defined in +# $(OPTDEFINES) only if the OPTS configuration indicates a static +# library. However the stubs library is ALWAYS static hence included +# here irrespective of the OPTS setting. +# +# TBD - tclvfs has a comment that stubs libs should not be compiled with -GL +# without stating why. Tcl itself compiled stubs libs with this flag. +# so we do not remove it from cflags. -GL may prevent extensions +# compiled with one VC version to fail to link against stubs library +# compiled with another VC version. Check for this and fix accordingly. +stubscflags = $(cflags) $(PKGNAMEFLAGS) $(PRJ_DEFINES) $(OPTDEFINES) /Zl /GL- /DSTATIC_BUILD $(INCLUDES) $(USE_STUBS_DEFS) + +# Link flags + +!if $(DEBUG) +ldebug = -debug -debugtype:cv +!else +ldebug = -release -opt:ref -opt:icf,3 +!if $(SYMBOLS) +ldebug = $(ldebug) -debug -debugtype:cv +!endif +!endif + +# Note: Profiling is currently only possible with the Visual Studio Enterprise +!if $(PROFILE) +ldebug= $(ldebug) -profile +!endif + +### Declarations common to all linker versions +lflags = -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug) + +!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900 +lflags = $(lflags) -nodefaultlib:libucrt.lib +!endif + +dlllflags = $(lflags) -dll +conlflags = $(lflags) -subsystem:console +guilflags = $(lflags) -subsystem:windows + +# Libraries that are required for every image. +# Extensions should define any additional libraries with $(PRJ_LIBS) +winlibs = kernel32.lib advapi32.lib + +!if $(NEED_TK) +winlibs = $(winlibs) gdi32.lib user32.lib uxtheme.lib +!endif + +# Avoid 'unresolved external symbol __security_cookie' errors. +# c.f. http://support.microsoft.com/?id=894573 +!if "$(MACHINE)" == "AMD64" +!if $(VCVERSION) > 1399 && $(VCVERSION) < 1500 +winlibs = $(winlibs) bufferoverflowU.lib +!endif +!endif + +baselibs = $(winlibs) $(PRJ_LIBS) + +!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900 +baselibs = $(baselibs) ucrt.lib +!endif + +################################################################ +# 13. Define standard commands, common make targets and implicit rules + +CCPKGCMD = $(cc32) $(pkgcflags) -Fo$(TMP_DIR)^\ +CCAPPCMD = $(cc32) $(appcflags) -Fo$(TMP_DIR)^\ +CCSTUBSCMD = $(cc32) $(stubscflags) -Fo$(TMP_DIR)^\ + +LIBCMD = $(lib32) -nologo $(LINKERFLAGS) -out:$@ +DLLCMD = $(link32) $(dlllflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs) + +CONEXECMD = $(link32) $(conlflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs) +GUIEXECMD = $(link32) $(guilflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs) +RESCMD = $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \ + $(TCL_INCLUDES) \ + /DDEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \ + /DCOMMAVERSION=$(RCCOMMAVERSION) \ + /DDOTVERSION=\"$(DOTVERSION)\" \ + /DVERSION=\"$(VERSION)\" \ + /DSUFX=\"$(SUFX)\" \ + /DPROJECT=\"$(PROJECT)\" \ + /DPRJLIBNAME=\"$(PRJLIBNAME)\" + +!ifndef DEFAULT_BUILD_TARGET +DEFAULT_BUILD_TARGET = $(PROJECT) +!endif + +default-target: $(DEFAULT_BUILD_TARGET) + +!if $(MULTIPLATFORM_INSTALL) +default-pkgindex: + @echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \ + [list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME)]] > $(OUT_DIR)\pkgIndex.tcl +!else +default-pkgindex: + @echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \ + [list load [file join $$dir $(PRJLIBNAME)]] > $(OUT_DIR)\pkgIndex.tcl +!endif + +default-pkgindex-tea: + @if exist $(ROOT)\pkgIndex.tcl.in nmakehlp -s << $(ROOT)\pkgIndex.tcl.in > $(OUT_DIR)\pkgIndex.tcl +@PACKAGE_VERSION@ $(DOTVERSION) +@PACKAGE_NAME@ $(PRJ_PACKAGE_TCLNAME) +@PACKAGE_TCLNAME@ $(PRJ_PACKAGE_TCLNAME) +@PKG_LIB_FILE@ $(PRJLIBNAME) +<< + +default-install: default-install-binaries default-install-libraries +!if $(SYMBOLS) +default-install: default-install-pdbs +!endif + +# Again to deal with historical brokenness, there is some confusion +# in terminlogy. For extensions, the "install-binaries" was used to +# locate target directory for *binary shared libraries* and thus +# the appropriate macro is LIB_INSTALL_DIR since BIN_INSTALL_DIR is +# for executables (exes). On the other hand the "install-libraries" +# target is for *scripts* and should have been called "install-scripts". +default-install-binaries: $(PRJLIB) + @echo Installing binaries to '$(LIB_INSTALL_DIR)' + @if not exist "$(LIB_INSTALL_DIR)" mkdir "$(LIB_INSTALL_DIR)" + @$(CPY) $(PRJLIB) "$(LIB_INSTALL_DIR)" >NUL + +# Alias for default-install-scripts +default-install-libraries: default-install-scripts + +default-install-scripts: $(OUT_DIR)\pkgIndex.tcl + @echo Installing libraries to '$(SCRIPT_INSTALL_DIR)' + @if exist $(LIBDIR) $(CPY) $(LIBDIR)\*.tcl "$(SCRIPT_INSTALL_DIR)" + @echo Installing package index in '$(SCRIPT_INSTALL_DIR)' + @$(CPY) $(OUT_DIR)\pkgIndex.tcl $(SCRIPT_INSTALL_DIR) + +default-install-stubs: + @echo Installing stubs library to '$(SCRIPT_INSTALL_DIR)' + @if not exist "$(SCRIPT_INSTALL_DIR)" mkdir "$(SCRIPT_INSTALL_DIR)" + @$(CPY) $(PRJSTUBLIB) "$(SCRIPT_INSTALL_DIR)" >NUL + +default-install-pdbs: + @echo Installing PDBs to '$(LIB_INSTALL_DIR)' + @if not exist "$(LIB_INSTALL_DIR)" mkdir "$(LIB_INSTALL_DIR)" + @$(CPY) "$(OUT_DIR)\*.pdb" "$(LIB_INSTALL_DIR)\" + +# "emacs font-lock highlighting fix + +default-install-docs-html: + @echo Installing documentation files to '$(DOC_INSTALL_DIR)' + @if not exist "$(DOC_INSTALL_DIR)" mkdir "$(DOC_INSTALL_DIR)" + @if exist $(DOCDIR) for %f in ("$(DOCDIR)\*.html" "$(DOCDIR)\*.css" "$(DOCDIR)\*.png") do @$(COPY) %f "$(DOC_INSTALL_DIR)" + +default-install-docs-n: + @echo Installing documentation files to '$(DOC_INSTALL_DIR)' + @if not exist "$(DOC_INSTALL_DIR)" mkdir "$(DOC_INSTALL_DIR)" + @if exist $(DOCDIR) for %f in ("$(DOCDIR)\*.n") do @$(COPY) %f "$(DOC_INSTALL_DIR)" + +default-install-demos: + @echo Installing demos to '$(DEMO_INSTALL_DIR)' + @if not exist "$(DEMO_INSTALL_DIR)" mkdir "$(DEMO_INSTALL_DIR)" + @if exist $(DEMODIR) $(CPYDIR) "$(DEMODIR)" "$(DEMO_INSTALL_DIR)" + +default-clean: + @echo Cleaning $(TMP_DIR)\* ... + @if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR) + @echo Cleaning $(WIN_DIR)\nmakehlp.obj, nmakehlp.exe ... + @if exist $(WIN_DIR)\nmakehlp.obj del $(WIN_DIR)\nmakehlp.obj + @if exist $(WIN_DIR)\nmakehlp.exe del $(WIN_DIR)\nmakehlp.exe + @if exist $(WIN_DIR)\nmakehlp.out del $(WIN_DIR)\nmakehlp.out + @echo Cleaning $(WIN_DIR)\nmhlp-out.txt ... + @if exist $(WIN_DIR)\nmhlp-out.txt del $(WIN_DIR)\nmhlp-out.txt + @echo Cleaning $(WIN_DIR)\_junk.pch ... + @if exist $(WIN_DIR)\_junk.pch del $(WIN_DIR)\_junk.pch + @echo Cleaning $(WIN_DIR)\vercl.x, vercl.i ... + @if exist $(WIN_DIR)\vercl.x del $(WIN_DIR)\vercl.x + @if exist $(WIN_DIR)\vercl.i del $(WIN_DIR)\vercl.i + @echo Cleaning $(WIN_DIR)\versions.vc, version.vc ... + @if exist $(WIN_DIR)\versions.vc del $(WIN_DIR)\versions.vc + @if exist $(WIN_DIR)\version.vc del $(WIN_DIR)\version.vc + +default-hose: default-clean + @echo Hosing $(OUT_DIR)\* ... + @if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR) + +# Only for backward compatibility +default-distclean: default-hose + +default-setup: + @if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR) + @if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR) + +!if "$(TESTPAT)" != "" +TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT) +!endif + +default-test: default-setup $(PROJECT) + @set TCLLIBPATH=$(OUT_DIR:\=/) + @if exist $(LIBDIR) for %f in ("$(LIBDIR)\*.tcl") do @$(COPY) %f "$(OUT_DIR)" + cd "$(TESTDIR)" && $(DEBUGGER) $(TCLSH) all.tcl $(TESTFLAGS) + +default-shell: default-setup $(PROJECT) + @set TCLLIBPATH=$(OUT_DIR:\=/) + @if exist $(LIBDIR) for %f in ("$(LIBDIR)\*.tcl") do @$(COPY) %f "$(OUT_DIR)" + $(DEBUGGER) $(TCLSH) + +# Generation of Windows version resource +!ifdef RCFILE + +# Note: don't use $** in below rule because there may be other dependencies +# and only the "main" rc must be passed to the resource compiler +$(TMP_DIR)\$(PROJECT).res: $(RCDIR)\$(PROJECT).rc + $(RESCMD) $(RCDIR)\$(PROJECT).rc + +!else + +# If parent makefile has not defined a resource definition file, +# we will generate one from standard template. +$(TMP_DIR)\$(PROJECT).res: $(TMP_DIR)\$(PROJECT).rc + +$(TMP_DIR)\$(PROJECT).rc: + @$(COPY) << $(TMP_DIR)\$(PROJECT).rc +#include + +VS_VERSION_INFO VERSIONINFO + FILEVERSION COMMAVERSION + PRODUCTVERSION COMMAVERSION + FILEFLAGSMASK 0x3fL +#ifdef DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS_NT_WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904b0" + BEGIN + VALUE "FileDescription", "Tcl extension " PROJECT + VALUE "OriginalFilename", PRJLIBNAME + VALUE "FileVersion", DOTVERSION + VALUE "ProductName", "Package " PROJECT " for Tcl" + VALUE "ProductVersion", DOTVERSION + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x409, 1200 + END +END + +<< + +!endif # ifdef RCFILE + +!ifndef DISABLE_IMPLICIT_RULES +DISABLE_IMPLICIT_RULES = 0 +!endif + +!if !$(DISABLE_IMPLICIT_RULES) +# Implicit rule definitions - only for building library objects. For stubs and +# main application, the makefile should define explicit rules. + +{$(ROOT)}.c{$(TMP_DIR)}.obj:: + $(CCPKGCMD) @<< +$< +<< + +{$(WIN_DIR)}.c{$(TMP_DIR)}.obj:: + $(CCPKGCMD) @<< +$< +<< + +{$(GENERICDIR)}.c{$(TMP_DIR)}.obj:: + $(CCPKGCMD) @<< +$< +<< + +{$(COMPATDIR)}.c{$(TMP_DIR)}.obj:: + $(CCPKGCMD) @<< +$< +<< + +{$(RCDIR)}.rc{$(TMP_DIR)}.res: + $(RESCMD) $< + +{$(WIN_DIR)}.rc{$(TMP_DIR)}.res: + $(RESCMD) $< + +{$(TMP_DIR)}.rc{$(TMP_DIR)}.res: + $(RESCMD) $< + +.SUFFIXES: +.SUFFIXES:.c .rc + +!endif + +################################################################ +# 14. Sanity check selected options against Tcl build options +# When building an extension, certain configuration options should +# match the ones used when Tcl was built. Here we check and +# warn on a mismatch. +!if !$(DOING_TCL) + +!if $(TCLINSTALL) # Building against an installed Tcl +!if exist("$(_TCLDIR)\lib\nmake\tcl.nmake") +TCLNMAKECONFIG = "$(_TCLDIR)\lib\nmake\tcl.nmake" +!endif +!else # !$(TCLINSTALL) - building against Tcl source +!if exist("$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl.nmake") +TCLNMAKECONFIG = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl.nmake" +!endif +!endif # TCLINSTALL + +!if $(CONFIG_CHECK) +!ifdef TCLNMAKECONFIG +!include $(TCLNMAKECONFIG) + +!if defined(CORE_MACHINE) && "$(CORE_MACHINE)" != "$(MACHINE)" +!error ERROR: Build target ($(MACHINE)) does not match the Tcl library architecture ($(CORE_MACHINE)). +!endif +!if $(TCL_VERSION) < 87 && defined(CORE_USE_THREAD_ALLOC) && $(CORE_USE_THREAD_ALLOC) != $(USE_THREAD_ALLOC) +!message WARNING: Value of USE_THREAD_ALLOC ($(USE_THREAD_ALLOC)) does not match its Tcl core value ($(CORE_USE_THREAD_ALLOC)). +!endif +!if defined(CORE_DEBUG) && $(CORE_DEBUG) != $(DEBUG) +!message WARNING: Value of DEBUG ($(DEBUG)) does not match its Tcl library configuration ($(DEBUG)). +!endif +!endif + +!endif # TCLNMAKECONFIG + +!endif # !$(DOING_TCL) + + +#---------------------------------------------------------- +# Display stats being used. +#---------------------------------------------------------- + +!if !$(DOING_TCL) +!message *** Building against Tcl at '$(_TCLDIR)' +!endif +!if !$(DOING_TK) && $(NEED_TK) +!message *** Building against Tk at '$(_TKDIR)' +!endif +!message *** Intermediate directory will be '$(TMP_DIR)' +!message *** Output directory will be '$(OUT_DIR)' +!message *** Installation, if selected, will be in '$(_INSTALLDIR)' +!message *** Suffix for binaries will be '$(SUFX)' +!message *** Compiler version $(VCVER). Target $(MACHINE), host $(NATIVE_ARCH). + +!endif # ifdef _RULES_VC Index: win/targets.vc ================================================================== --- win/targets.vc +++ win/targets.vc @@ -2,11 +2,11 @@ # targets.vc -- # # Part of the nmake based build system for Tcl and its extensions. # This file defines some standard targets for the convenience of extensions # and can be optionally included by the extension makefile. -# See TIP 477 (https://core.tcl-lang.org/tips/doc/trunk/tip/477.md) for docs. +# See TIP 477 (https://core.tcl-lang.org/tips/doc/main/tip/477.md) for docs. $(PROJECT): setup pkgindex $(PRJLIB) !ifdef PRJ_STUBOBJS $(PROJECT): $(PRJSTUBLIB)