Author: Sergei Golovan <sgolovan@debian.org>
Author: Jeremy Sowden <a3a3el@users.sf.net>
Description: Patch ports the tcltls to the new OpenSSL 1.1 API.
Last-Modified: Fri, 11 Nov 2016 11:38:10 +0300
Bug-Debian: https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=828566
Bug-Upstream: https://sourceforge.net/p/tls/bugs/66/
Forwarded: yes

--- a/tls.c
+++ b/tls.c
@@ -115,15 +115,29 @@
 static DH *get_dh2048()
 {
     DH *dh=NULL;
+    BIGNUM *p=NULL, *g=NULL;
 
-    if ((dh=DH_new()) == NULL) return(NULL);
+    p=BN_bin2bn(dh2048_p,sizeof(dh2048_p),NULL);
+    if (p == NULL) goto err;
 
-    dh->p=BN_bin2bn(dh2048_p,sizeof(dh2048_p),NULL);
-    dh->g=BN_bin2bn(dh2048_g,sizeof(dh2048_g),NULL);
+    g=BN_bin2bn(dh2048_g,sizeof(dh2048_g),NULL);
+    if (g == NULL) goto err;
 
-    if ((dh->p == NULL) || (dh->g == NULL))
-	return(NULL);
+    if ((dh=DH_new()) == NULL) goto err;
+
+#if OPENSSL_VERSION_NUMBER < 0x10100000L
+    dh->p=p;
+    dh->g=g;
+#else
+    if (!DH_set0_pqg(dh, p, NULL, g)) goto err;
+#endif
     return(dh);
+
+err:
+    if (p) BN_free(p);
+    if (g) BN_free(g);
+    if (dh) DH_free(dh);
+    return(NULL);
 }
 #endif
 
@@ -160,7 +174,10 @@
 #define OPENSSL_THREAD_DEFINES
 #include <openssl/opensslconf.h>
 
-#ifdef OPENSSL_THREADS
+static Tcl_Mutex init_mx;
+static int initialized;
+
+#if defined(OPENSSL_THREADS) && OPENSSL_VERSION_NUMBER < 0x10100000L
 #include <openssl/crypto.h>
 
 /*
@@ -169,8 +186,6 @@
  */
 
 static Tcl_Mutex locks[CRYPTO_NUM_LOCKS];
-static Tcl_Mutex init_mx;
-static int initialized;
 
 static void          CryptoThreadLockCallback (int mode, int n, const char *file, int line);
 static unsigned long CryptoThreadIdCallback   (void);
@@ -310,7 +325,7 @@
     Tcl_Obj *cmdPtr, *result;
     char *errStr, *string;
     int length;
-    SSL   *ssl		= (SSL*)X509_STORE_CTX_get_app_data(ctx);
+    SSL   *ssl		= (SSL*)X509_STORE_CTX_get_ex_data(ctx, SSL_get_ex_data_X509_STORE_CTX_idx());
     X509  *cert		= X509_STORE_CTX_get_current_cert(ctx);
     State *statePtr	= (State*)SSL_get_app_data(ssl);
     int depth		= X509_STORE_CTX_get_error_depth(ctx);
@@ -554,14 +569,14 @@
     }
     switch ((enum protocol)index) {
     case TLS_SSL2:
-#if defined(NO_SSL2)
+#if defined(NO_SSL2) || OPENSSL_VERSION_NUMBER >= 0x10100000L
 		Tcl_AppendResult(interp, "protocol not supported", NULL);
 		return TCL_ERROR;
 #else
 		ctx = SSL_CTX_new(SSLv2_method()); break;
 #endif
     case TLS_SSL3:
-#if defined(NO_SSL3)
+#if defined(NO_SSL3) || OPENSSL_VERSION_NUMBER >= 0x10100000L
 		Tcl_AppendResult(interp, "protocol not supported", NULL);
 		return TCL_ERROR;
 #else
@@ -754,12 +769,12 @@
 #ifndef OPENSSL_NO_TLSEXT
     char *servername	= NULL;	/* hostname for Server Name Indication */
 #endif
-#if defined(NO_SSL2)
+#if defined(NO_SSL2) || OPENSSL_VERSION_NUMBER >= 0x10100000L
     int ssl2 = 0;
 #else
     int ssl2 = 1;
 #endif
-#if defined(NO_SSL3)
+#if defined(NO_SSL3) || OPENSSL_VERSION_NUMBER >= 0x10100000L
     int ssl3 = 0;
 #else
     int ssl3 = 1;
@@ -1069,13 +1084,13 @@
     }
 
     /* create SSL context */
-#if defined(NO_SSL2)
+#if defined(NO_SSL2) || OPENSSL_VERSION_NUMBER >= 0x10100000L
     if (ENABLED(proto, TLS_PROTO_SSL2)) {
 	Tcl_AppendResult(interp, "protocol not supported", NULL);
 	return (SSL_CTX *)0;
     }
 #endif
-#if defined(NO_SSL3)
+#if defined(NO_SSL3) || OPENSSL_VERSION_NUMBER >= 0x10100000L
     if (ENABLED(proto, TLS_PROTO_SSL3)) {
 	Tcl_AppendResult(interp, "protocol not supported", NULL);
 	return (SSL_CTX *)0;
@@ -1101,12 +1116,12 @@
 #endif
 
     switch (proto) {
-#if !defined(NO_SSL2)
+#if !defined(NO_SSL2) && OPENSSL_VERSION_NUMBER < 0x10100000L
     case TLS_PROTO_SSL2:
 	method = SSLv2_method ();
 	break;
 #endif
-#if !defined(NO_SSL3)
+#if !defined(NO_SSL3) && OPENSSL_VERSION_NUMBER < 0x10100000L
     case TLS_PROTO_SSL3:
 	method = SSLv3_method ();
 	break;
@@ -1128,10 +1143,10 @@
 #endif
     default:
         method = SSLv23_method ();
-#if !defined(NO_SSL2)
+#if !defined(NO_SSL2) && OPENSSL_VERSION_NUMBER < 0x10100000L
 	off |= (ENABLED(proto, TLS_PROTO_SSL2)   ? 0 : SSL_OP_NO_SSLv2);
 #endif
-#if !defined(NO_SSL3)
+#if !defined(NO_SSL3) && OPENSSL_VERSION_NUMBER < 0x10100000L
 	off |= (ENABLED(proto, TLS_PROTO_SSL3)   ? 0 : SSL_OP_NO_SSLv3);
 #endif
 #if !defined(NO_TLS1)
@@ -1772,7 +1787,7 @@
 {
     int i;
     char rnd_seed[16] = "GrzSlplKqUdnnzP!";	/* 16 bytes */
-#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
+#if defined(OPENSSL_THREADS) && defined(TCL_THREADS) && OPENSSL_VERSION_NUMBER < 0x10100000L
     size_t num_locks;
 #endif
     int status=TCL_OK;
@@ -1788,7 +1803,7 @@
 	       /* Not using Tcl's mem functions ... not critical */
 	    }
 
-#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
+#if defined(OPENSSL_THREADS) && defined(TCL_THREADS) && OPENSSL_VERSION_NUMBER < 0x10100000L
 	    /* should we consider allocating mutexes? */
 	    num_locks = CRYPTO_num_locks();
 	    if (num_locks > CRYPTO_NUM_LOCKS) {
--- a/tlsBIO.c
+++ b/tlsBIO.c
@@ -8,6 +8,18 @@
 
 #include "tlsInt.h"
 
+#if OPENSSL_VERSION_NUMBER < 0x10100000L
+#define BIO_get_data(bio) ((bio)->ptr)
+#define BIO_get_init(bio) ((bio)->init)
+#define BIO_get_shutdown(bio) ((bio)->shutdown)
+#define BIO_set_data(bio, val) \
+    (bio)->ptr = (val)
+#define BIO_set_init(bio, val) \
+    (bio)->init = (val)
+#define BIO_set_shutdown(bio, val) \
+    (bio)->shutdown = (val)
+#endif
+
 /*
  * Forward declarations
  */
@@ -20,45 +32,58 @@
 static int BioFree	_ANSI_ARGS_ ((BIO *h));
 
 
-static BIO_METHOD BioMethods = {
-    BIO_TYPE_TCL, "tcl",
-    BioWrite,
-    BioRead,
-    BioPuts,
-    NULL,	/* BioGets */
-    BioCtrl,
-    BioNew,
-    BioFree,
-};
+static BIO_METHOD *BioMethods = NULL;
+
+BIO_METHOD *
+BIO_s_tcl()
+{
+    if (BioMethods == NULL) {
+#if OPENSSL_VERSION_NUMBER >= 0x10100000L
+    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);
+#else
+    BioMethods = (BIO_METHOD *)Tcl_Alloc(sizeof(BIO_METHOD));
+
+    BioMethods->type    = BIO_TYPE_TCL;
+    BioMethods->name    = "tcl";
+    BioMethods->bwrite  = BioWrite;
+    BioMethods->bread   = BioRead;
+    BioMethods->bputs   = BioPuts;
+    BioMethods->ctrl    = BioCtrl;
+    BioMethods->create  = BioNew;
+    BioMethods->destroy = BioFree;
+#endif
+    }
+    return BioMethods;
+}
 
 BIO *
 BIO_new_tcl(statePtr, flags)
     State *statePtr;
     int flags;
 {
-    BIO *bio;
+    BIO *bio = BIO_new(BIO_s_tcl());
 
-    bio			= BIO_new(&BioMethods);
-    bio->ptr		= (char*)statePtr;
-    bio->init		= 1;
-    bio->shutdown	= flags;
+    BIO_set_data(bio, statePtr);
+    BIO_set_init(bio, 1);
+    BIO_set_shutdown(bio, flags);
 
     return bio;
 }
 
-BIO_METHOD *
-BIO_s_tcl()
-{
-    return &BioMethods;
-}
-
 static int
 BioWrite (bio, buf, bufLen)
     BIO *bio;
     CONST char *buf;
     int bufLen;
 {
-    Tcl_Channel chan = Tls_GetParent((State*)(bio->ptr));
+    Tcl_Channel chan = Tls_GetParent((State*)BIO_get_data(bio));
     int ret;
 
     dprintf(stderr,"\nBioWrite(0x%x, <buf>, %d) [0x%x]",
@@ -93,7 +118,7 @@
     char *buf;
     int bufLen;
 {
-    Tcl_Channel chan = Tls_GetParent((State*)bio->ptr);
+    Tcl_Channel chan = Tls_GetParent((State*)BIO_get_data(bio));
     int ret = 0;
 
     dprintf(stderr,"\nBioRead(0x%x, <buf>, %d) [0x%x]",
@@ -139,9 +164,8 @@
     long num;
     void *ptr;
 {
-    Tcl_Channel chan = Tls_GetParent((State*)bio->ptr);
+    Tcl_Channel chan = Tls_GetParent((State*)BIO_get_data(bio));
     long ret = 1;
-    int *ip;
 
     dprintf(stderr,"\nBioCtrl(0x%x, 0x%x, 0x%x, 0x%x)",
 	    (unsigned int) bio, (unsigned int) cmd, (unsigned int) num,
@@ -157,29 +181,11 @@
     case BIO_CTRL_INFO:
 	ret = 1;
 	break;
-    case BIO_C_SET_FD:
-	BioFree(bio);
-	/* Sets State* */
-	bio->ptr	= *((char **)ptr);
-	bio->shutdown	= (int)num;
-	bio->init	= 1;
-	break;
-    case BIO_C_GET_FD:
-	if (bio->init) {
-	    ip = (int *)ptr;
-	    if (ip != NULL) {
-		*ip = bio->num;
-	    }
-	    ret = bio->num;
-	} else {
-	    ret = -1;
-	}
-	break;
     case BIO_CTRL_GET_CLOSE:
-	ret = bio->shutdown;
+	ret = BIO_get_shutdown(bio);
 	break;
     case BIO_CTRL_SET_CLOSE:
-	bio->shutdown = (int)num;
+	BIO_set_shutdown(bio, (int)num);
 	break;
     case BIO_CTRL_EOF:
 	dprintf(stderr, "BIO_CTRL_EOF\n");
@@ -213,11 +219,9 @@
 BioNew	(bio)
     BIO *bio;
 {
-    bio->init	= 0;
-    bio->num	= 0;
-    bio->ptr	= NULL;
-    bio->flags	= 0;
-
+    BIO_set_init(bio, 0);
+    BIO_set_data(bio, NULL);
+    BIO_clear_flags(bio, -1);
     return 1;
 }
 
@@ -229,14 +233,13 @@
 	return 0;
     }
 
-    if (bio->shutdown) {
-	if (bio->init) {
+    if (BIO_get_shutdown(bio)) {
+	if (BIO_get_init(bio)) {
 	    /*shutdown(bio->num, 2) */
 	    /*closesocket(bio->num) */
 	}
-	bio->init	= 0;
-	bio->flags	= 0;
-	bio->num	= 0;
+	BIO_set_init(bio, 0);
+	BIO_clear_flags(bio, -1);
     }
     return 1;
 }
--- a/tlsIO.c
+++ b/tlsIO.c
@@ -936,6 +936,12 @@
 		dprintf(stderr,"CR! ");
 		*errorCodePtr = ECONNRESET;
 		return -1;
+	    } else if (rc == SSL_ERROR_SYSCALL && Tcl_GetErrno() == 0) {
+		/* Without this clause test tlsIO-2.10 (close on accept,
+		   accepted socket lives) hangs with OpenSSL 1.1 */
+		dprintf(stderr,"Syscall error but zero error code from Tcl! ");
+		*errorCodePtr = ECONNRESET;
+		return -1;
 	    }
 	    if (statePtr->flags & TLS_TCL_SERVER) {
 		err = SSL_get_verify_result(statePtr->ssl);
--- a/tlsInt.h
+++ b/tlsInt.h
@@ -48,10 +48,12 @@
 #include <ssl.h>
 #include <err.h>
 #include <rand.h>
+#include <opensslv.h>
 #else
 #include <openssl/ssl.h>
 #include <openssl/err.h>
 #include <openssl/rand.h>
+#include <openssl/opensslv.h>
 #endif
 
 #ifndef SSL_OP_NO_TLSv1_1
--- a/tlsX509.c
+++ b/tlsX509.c
@@ -102,6 +102,7 @@
     char notAfter[BUFSIZ];
 #ifndef NO_SSL_SHA
     int shai;
+    unsigned char sha_hash0[SHA_DIGEST_LENGTH];
     char sha_hash[SHA_DIGEST_LENGTH*2];
     const char *shachars="0123456789ABCDEF";
 #endif
@@ -139,10 +140,11 @@
     strcpy( notAfter, ASN1_UTCTIME_tostr( X509_get_notAfter(cert) ));
 
 #ifndef NO_SSL_SHA
+    X509_digest(cert, EVP_sha1(), sha_hash0, NULL);
     for (shai=0;shai<SHA_DIGEST_LENGTH;shai++)
     {
-        sha_hash[shai * 2]=shachars[(cert->sha1_hash[shai] & 0xF0) >> 4];
-        sha_hash[shai * 2 + 1]=shachars[(cert->sha1_hash[shai] & 0x0F)];
+        sha_hash[shai * 2]=shachars[(sha_hash0[shai] & 0xF0) >> 4];
+        sha_hash[shai * 2 + 1]=shachars[(sha_hash0[shai] & 0x0F)];
     }
     Tcl_ListObjAppendElement( interp, certPtr,
 	    Tcl_NewStringObj( "sha1_hash", -1) );