Check-in [d248bc5f5e]
Bounty program for improvements to Tcl and certain Tcl packages.
Overview
Comment:Ticket 47, applied patch with last suggested change by Jeff (moving setting of "initialization"-flag).
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: d248bc5f5ec13c7b414cbd39eb66d6c5e4159330
User & Date: andreas_kupries on 2014-04-16 18:33:03
Other Links: manifest | tags
Context
2014-12-08
19:09
Applied patches #12 and #13 for Server Name Indication (SNI) support, and TLS 1.1, 1.2 support. check-in: 54d14de805 user: andreas_kupries tags: trunk
2014-04-16
18:33
Ticket 47, applied patch with last suggested change by Jeff (moving setting of "initialization"-flag). check-in: d248bc5f5e user: andreas_kupries tags: trunk
2012-07-09
23:28
* configure.in: Bump to version 1.6.3. * win/makefile.vc: * configure: regen with ac-2.59 * tls.c (MiscObjCmd): Fixed non-static string array used in call of Tcl_GetIndexFromObj(). Memory smash waiting to happen. Thanks to Brian Griffin for alerting us all to the problem. check-in: c1eb553b32 user: andreas_kupries tags: trunk
Changes

Modified tls.c from [493d79f8dc] to [34519f36fc].

     1      1   /*
     2      2    * Copyright (C) 1997-1999 Matt Newman <[email protected]>
     3      3    * some modifications:
     4      4    *	Copyright (C) 2000 Ajuba Solutions
     5      5    *	Copyright (C) 2002 ActiveState Corporation
     6      6    *	Copyright (C) 2004 Starfish Systems 
     7      7    *
     8         - * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.33 2012/07/09 23:28:02 andreas_kupries Exp $
            8  + * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.34 2014/04/16 18:33:03 andreas_kupries Exp $
     9      9    *
    10     10    * TLS (aka SSL) Channel - can be layered on any bi-directional
    11     11    * Tcl_Channel (Note: Requires Trf Core Patch)
    12     12    *
    13     13    * This was built (almost) from scratch based upon observation of
    14     14    * OpenSSL 0.9.2B
    15     15    *
................................................................................
    61     61   			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
    62     62   
    63     63   static int	UnimportObjCmd _ANSI_ARGS_ ((ClientData clientData,
    64     64   			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
    65     65   
    66     66   static SSL_CTX *CTX_Init _ANSI_ARGS_((State *statePtr, int proto, char *key,
    67     67   			char *cert, char *CAdir, char *CAfile, char *ciphers));
           68  +
           69  +static int	TlsLibInit _ANSI_ARGS_ (()) ;
    68     70   
    69     71   #define TLS_PROTO_SSL2	0x01
    70     72   #define TLS_PROTO_SSL3	0x02
    71     73   #define TLS_PROTO_TLS1	0x04
    72     74   #define ENABLED(flag, mask)	(((flag) & (mask)) == (mask))
    73     75   
    74     76   /*
................................................................................
   143    145   
   144    146   /*
   145    147    * Threaded operation requires locking callbacks
   146    148    * Based from /crypto/cryptlib.c of OpenSSL and NSOpenSSL.
   147    149    */
   148    150   
   149    151   static Tcl_Mutex locks[CRYPTO_NUM_LOCKS];
          152  +static Tcl_Mutex init_mx;
          153  +static int initialized;
   150    154   
   151    155   static void          CryptoThreadLockCallback (int mode, int n, const char *file, int line);
   152    156   static unsigned long CryptoThreadIdCallback   (void);
   153    157   
   154    158   static void
   155    159   CryptoThreadLockCallback(int mode, int n, const char *file, int line)
   156    160   {
................................................................................
  1503   1507    *-------------------------------------------------------------------
  1504   1508    */
  1505   1509   
  1506   1510   int
  1507   1511   Tls_Init(Tcl_Interp *interp)		/* Interpreter in which the package is
  1508   1512   					 * to be made available. */
  1509   1513   {
  1510         -    int major, minor, patchlevel, release, i;
  1511         -    char rnd_seed[16] = "GrzSlplKqUdnnzP!";	/* 16 bytes */
  1512         -#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
  1513         -    size_t num_locks;
  1514         -#endif
         1514  +    int major, minor, patchlevel, release;
  1515   1515   
  1516   1516       /*
  1517   1517        * The original 8.2.0 stacked channel implementation (and the patch
  1518   1518        * that preceded it) had problems with scalability and robustness.
  1519   1519        * These were address in 8.3.2 / 8.4a2, so we now require that as a
  1520   1520        * minimum for TLS 1.4+.  We only support 8.2+ now (8.3.2+ preferred).
  1521   1521        */
................................................................................
  1540   1540   	/* 8.3.2+ */
  1541   1541   	channelTypeVersion = TLS_CHANNEL_VERSION_2;
  1542   1542       } else {
  1543   1543   	/* 8.2.0 - 8.3.1 */
  1544   1544   	channelTypeVersion = TLS_CHANNEL_VERSION_1;
  1545   1545       }
  1546   1546   
  1547         -    if (CRYPTO_set_mem_functions((void *(*)(size_t))Tcl_Alloc,
  1548         -				 (void *(*)(void *, size_t))Tcl_Realloc,
  1549         -				 (void(*)(void *))Tcl_Free) == 0) {
  1550         -       /* Not using Tcl's mem functions ... not critical */
  1551         -    }
  1552         -
  1553         -#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
  1554         -    /* should we consider allocating mutexes? */
  1555         -    num_locks = CRYPTO_num_locks();
  1556         -    if (num_locks > CRYPTO_NUM_LOCKS) {
  1557         -       Tcl_AppendResult(interp, "crypto num locks size error", NULL);
  1558         -       return TCL_ERROR;
  1559         -    }
  1560         -
  1561         -    CRYPTO_set_locking_callback(CryptoThreadLockCallback);
  1562         -    CRYPTO_set_id_callback(CryptoThreadIdCallback);
  1563         -#endif
  1564         -
  1565         -    if (SSL_library_init() != 1) {
         1547  +    if (TlsLibInit() != TCL_OK) {
  1566   1548   	Tcl_AppendResult(interp, "could not initialize SSL library", NULL);
  1567   1549   	return TCL_ERROR;
  1568   1550       }
  1569         -    SSL_load_error_strings();
  1570         -    ERR_load_crypto_strings();
  1571         -
  1572         -    /*
  1573         -     * Seed the random number generator in the SSL library,
  1574         -     * using the do/while construct because of the bug note in the
  1575         -     * OpenSSL FAQ at http://www.openssl.org/support/faq.html#USER1
  1576         -     *
  1577         -     * The crux of the problem is that Solaris 7 does not have a 
  1578         -     * /dev/random or /dev/urandom device so it cannot gather enough
  1579         -     * entropy from the RAND_seed() when TLS initializes and refuses
  1580         -     * to go further. Earlier versions of OpenSSL carried on regardless.
  1581         -     */
  1582         -    srand((unsigned int) time((time_t *) NULL));
  1583         -    do {
  1584         -	for (i = 0; i < 16; i++) {
  1585         -	    rnd_seed[i] = 1 + (char) (255.0 * rand()/(RAND_MAX+1.0));
  1586         -	}
  1587         -	RAND_seed(rnd_seed, sizeof(rnd_seed));
  1588         -    } while (RAND_status() != 1);
  1589   1551   
  1590   1552       Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd,
  1591   1553   	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  1592   1554   
  1593   1555       Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd,
  1594   1556   	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  1595   1557   
................................................................................
  1631   1593    */
  1632   1594   
  1633   1595   int
  1634   1596   Tls_SafeInit (Tcl_Interp* interp)
  1635   1597   {
  1636   1598       return Tls_Init (interp);
  1637   1599   }
         1600  +
         1601  +
         1602  +/*
         1603  + *------------------------------------------------------*
         1604  + *
         1605  + *	TlsLibInit --
         1606  + *
         1607  + *	------------------------------------------------*
         1608  + *	Initializes SSL library once per application
         1609  + *	------------------------------------------------*
         1610  + *
         1611  + *	Side effects:
         1612  + *		initilizes SSL library
         1613  + *
         1614  + *	Result:
         1615  + *		none
         1616  + *
         1617  + *------------------------------------------------------*
         1618  + */
         1619  +static int
         1620  +TlsLibInit ()
         1621  +{
         1622  +    int i;
         1623  +    char rnd_seed[16] = "GrzSlplKqUdnnzP!";	/* 16 bytes */
         1624  +#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
         1625  +    size_t num_locks;
         1626  +#endif
         1627  +    int status=TCL_OK;
         1628  +
         1629  +    if (!initialized) {
         1630  +	Tcl_MutexLock(&init_mx);
         1631  +	if (!initialized) {
         1632  +	    initialized = 1;
         1633  +
         1634  +	    if (CRYPTO_set_mem_functions((void *(*)(size_t))Tcl_Alloc,
         1635  +					 (void *(*)(void *, size_t))Tcl_Realloc,
         1636  +					 (void(*)(void *))Tcl_Free) == 0) {
         1637  +	       /* Not using Tcl's mem functions ... not critical */
         1638  +	    }
         1639  +
         1640  +#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
         1641  +	    /* should we consider allocating mutexes? */
         1642  +	    num_locks = CRYPTO_num_locks();
         1643  +	    if (num_locks > CRYPTO_NUM_LOCKS) {
         1644  +		status=TCL_ERROR;
         1645  +		goto done;
         1646  +	    }
         1647  +
         1648  +	    CRYPTO_set_locking_callback(CryptoThreadLockCallback);
         1649  +	    CRYPTO_set_id_callback(CryptoThreadIdCallback);
         1650  +#endif
         1651  +
         1652  +	    if (SSL_library_init() != 1) {
         1653  +	    	status=TCL_ERROR;
         1654  +		goto done;
         1655  +	    }
         1656  +	    SSL_load_error_strings();
         1657  +	    ERR_load_crypto_strings();
         1658  +
         1659  +	    /*
         1660  +	     * Seed the random number generator in the SSL library,
         1661  +	     * using the do/while construct because of the bug note in the
         1662  +	     * OpenSSL FAQ at http://www.openssl.org/support/faq.html#USER1
         1663  +	     *
         1664  +	     * The crux of the problem is that Solaris 7 does not have a 
         1665  +	     * /dev/random or /dev/urandom device so it cannot gather enough
         1666  +	     * entropy from the RAND_seed() when TLS initializes and refuses
         1667  +	     * to go further. Earlier versions of OpenSSL carried on regardless.
         1668  +	     */
         1669  +	    srand((unsigned int) time((time_t *) NULL));
         1670  +	    do {
         1671  +		for (i = 0; i < 16; i++) {
         1672  +		    rnd_seed[i] = 1 + (char) (255.0 * rand()/(RAND_MAX+1.0));
         1673  +		}
         1674  +		RAND_seed(rnd_seed, sizeof(rnd_seed));
         1675  +	    } while (RAND_status() != 1);
         1676  +	}
         1677  +    	done:
         1678  +
         1679  +	Tcl_MutexUnlock(&init_mx);
         1680  +    }
         1681  +    return status;
         1682  +}