Diff

Differences From Artifact [ae2cba46b1]:

To Artifact [788b6c9daa]:


34
35
36
37
38
39
40
41

42
43
44


45
46
47


48
49
50


51
52
53


54
55
56


57
58
59


60
61
62


63
64

65
66

67
68

69
70
71
72
73
74
75
34
35
36
37
38
39
40

41
42


43
44
45


46
47
48


49
50
51


52
53
54


55
56
57


58
59
60


61
62
63

64
65

66
67

68
69
70
71
72
73
74
75







-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
+

-
+







 */

#define F2N( key, dsp) \
	(((key) == NULL) ? (char *) NULL : \
		Tcl_TranslateFileName(interp, (key), (dsp)))
#define REASON()	ERR_reason_error_string(ERR_get_error())

static void	InfoCallback _ANSI_ARGS_ ((CONST SSL *ssl, int where, int ret));
static void	InfoCallback(CONST SSL *ssl, int where, int ret);

static int	CiphersObjCmd _ANSI_ARGS_ ((ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
static int	CiphersObjCmd(ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);

static int	HandshakeObjCmd _ANSI_ARGS_ ((ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
static int	HandshakeObjCmd(ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);

static int	ImportObjCmd _ANSI_ARGS_ ((ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
static int	ImportObjCmd(ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);

static int	StatusObjCmd _ANSI_ARGS_ ((ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
static int	StatusObjCmd(ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);

static int	VersionObjCmd _ANSI_ARGS_ ((ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
static int	VersionObjCmd(ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);

static int	MiscObjCmd _ANSI_ARGS_ ((ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
static int	MiscObjCmd(ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);

static int	UnimportObjCmd _ANSI_ARGS_ ((ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
static int	UnimportObjCmd(ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);

static SSL_CTX *CTX_Init _ANSI_ARGS_((State *statePtr, int proto, char *key,
static SSL_CTX *CTX_Init(State *statePtr, int proto, char *key,
			char *cert, char *CAdir, char *CAfile, char *ciphers,
			char *DHparams));
			char *DHparams);

static int	TlsLibInit _ANSI_ARGS_ ((void)) ;
static int	TlsLibInit(void);

#define TLS_PROTO_SSL2		0x01
#define TLS_PROTO_SSL3		0x02
#define TLS_PROTO_TLS1		0x04
#define TLS_PROTO_TLS1_1	0x08
#define TLS_PROTO_TLS1_2	0x10
#define ENABLED(flag, mask)	(((flag) & (mask)) == (mask))
1604
1605
1606
1607
1608
1609
1610
1611
1612

1613
1614
1615

1616
1617

1618
1619
1620
1621
1622
1623
1624




1625
1626

1627
1628

1629
1630
1631
1632



1633
1634
1635
1636
1637




1638
1639
1640
1641
1642
1643
1644
1645







1646
1647
1648
1649



1650
1651

1652
1653

1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674

1675
1676

1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698


1699
1700
1701

1702
1703
1704
1705
1706





1707
1708
1709

1710
1711

1712
1713
1714
1715
1716
1717
1718
1719
1720






1721
1722
1723


1724
1725
1726
1727
1728
1729
1730
1731







1732






1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750

1751

1752
1753

1754
1755
1756

1757
1604
1605
1606
1607
1608
1609
1610


1611



1612
1613

1614
1615






1616
1617
1618
1619
1620

1621
1622

1623
1624



1625
1626
1627
1628




1629
1630
1631
1632
1633







1634
1635
1636
1637
1638
1639
1640
1641



1642
1643
1644
1645

1646
1647

1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667


1668


1669
1670
1671

1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688


1689
1690



1691
1692




1693
1694
1695
1696
1697
1698
1699

1700
1701

1702
1703
1704
1705






1706
1707
1708
1709
1710
1711
1712


1713
1714
1715
1716






1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747

1748
1749
1750
1751

1752
1753
1754

1755
1756







-
-
+
-
-
-
+

-
+

-
-
-
-
-
-
+
+
+
+

-
+

-
+

-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
+
+
+

-
+

-
+



















-
-
+
-
-
+


-

















-
-
+
+
-
-
-
+

-
-
-
-
+
+
+
+
+


-
+

-
+



-
-
-
-
-
-
+
+
+
+
+
+

-
-
+
+


-
-
-
-
-
-
+
+
+
+
+
+
+

+
+
+
+
+
+

















-
+

+

-
+


-
+

 *
 * Side effects:
 *	 create the ssl command, initialise ssl context
 *
 *-------------------------------------------------------------------
 */

int
Tls_Init(Tcl_Interp *interp)		/* Interpreter in which the package is
int Tls_Init(Tcl_Interp *interp) {
					 * to be made available. */
{
    const char tlsTclInitScript[] = {
	const char tlsTclInitScript[] = {
#include "tls.tcl.h"
    };
	};

    int major, minor, patchlevel, release;

    /*
     * We only support Tcl 8.4 or newer
     */
    if (
	/*
	 * We only support Tcl 8.4 or newer
	 */
	if (
#ifdef USE_TCL_STUBS
	Tcl_InitStubs(interp, "8.4", 0)
	    Tcl_InitStubs(interp, "8.4", 0)
#else
	Tcl_PkgRequire(interp, "Tcl", "8.4", 0)
	    Tcl_PkgRequire(interp, "Tcl", "8.4", 0)
#endif
	== NULL) {
	return TCL_ERROR;
    }
	     == NULL) {
		return TCL_ERROR;
	}

    if (TlsLibInit() != TCL_OK) {
	Tcl_AppendResult(interp, "could not initialize SSL library", NULL);
	return TCL_ERROR;
    }
	if (TlsLibInit() != TCL_OK) {
		Tcl_AppendResult(interp, "could not initialize SSL library", NULL);
		return TCL_ERROR;
	}

    Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::unimport", UnimportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
	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);
    }
	if (interp) {
		Tcl_Eval(interp, tlsTclInitScript);
	}

    return Tcl_PkgProvide(interp, "tls", PACKAGE_VERSION);
	return(Tcl_PkgProvide(interp, "tls", PACKAGE_VERSION));
}


/*
 *------------------------------------------------------*
 *
 *	Tls_SafeInit --
 *
 *	------------------------------------------------*
 *	Standard procedure required by 'load'. 
 *	Initializes this extension for a safe interpreter.
 *	------------------------------------------------*
 *
 *	Sideeffects:
 *		As of 'Tls_Init'
 *
 *	Result:
 *		A standard Tcl error code.
 *
 *------------------------------------------------------*
 */

int
Tls_SafeInit (Tcl_Interp* interp)
int Tls_SafeInit(Tcl_Interp *interp) {
{
    return Tls_Init (interp);
	return(Tls_Init(interp));
}


/*
 *------------------------------------------------------*
 *
 *	TlsLibInit --
 *
 *	------------------------------------------------*
 *	Initializes SSL library once per application
 *	------------------------------------------------*
 *
 *	Side effects:
 *		initilizes SSL library
 *
 *	Result:
 *		none
 *
 *------------------------------------------------------*
 */
static int TlsLibInit (void) {
    static int initialized = 0;
static int TlsLibInit(void) {
	static int initialized = 0;
    int i;
    char rnd_seed[16] = "GrzSlplKqUdnnzP!";	/* 16 bytes */
    int status = TCL_OK;
	int status = TCL_OK;

    if (initialized) {
        return(status);
    }
    initialized = 1;
	if (initialized) {
		return(status);
	}

	initialized = 1;

#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
    size_t num_locks;
	size_t num_locks;

    Tcl_MutexLock(&init_mx);
	Tcl_MutexLock(&init_mx);
#endif

#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
    /* should we consider allocating mutexes? */
    num_locks = CRYPTO_num_locks();
    if (num_locks > CRYPTO_NUM_LOCKS) {
	status = TCL_ERROR;
	goto done;
    }
	/* should we consider allocating mutexes? */
	num_locks = CRYPTO_num_locks();
	if (num_locks > CRYPTO_NUM_LOCKS) {
		status = TCL_ERROR;
		goto done;
	}

    CRYPTO_set_locking_callback(CryptoThreadLockCallback);
    CRYPTO_set_id_callback(CryptoThreadIdCallback);
	CRYPTO_set_locking_callback(CryptoThreadLockCallback);
	CRYPTO_set_id_callback(CryptoThreadIdCallback);
#endif

    if (SSL_library_init() != 1) {
    	status = TCL_ERROR;
	goto done;
    }
    SSL_load_error_strings();
    ERR_load_crypto_strings();
	if (SSL_library_init() != 1) {
		status = TCL_ERROR;
		goto done;
	}

	SSL_load_error_strings();
	ERR_load_crypto_strings();

#if 0
	/*
	 * XXX:TODO: Remove this code and replace it with a check
	 * for enough entropy and do not try to create our own
	 * terrible entropy
	 */
    /*
     * Seed the random number generator in the SSL library,
     * using the do/while construct because of the bug note in the
     * OpenSSL FAQ at http://www.openssl.org/support/faq.html#USER1
     *
     * 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));
    do {
	for (i = 0; i < 16; i++) {
	    rnd_seed[i] = 1 + (char) (255.0 * rand()/(RAND_MAX+1.0));
	}
	RAND_seed(rnd_seed, sizeof(rnd_seed));
    } while (RAND_status() != 1);
done:
#endif

done:
#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
    Tcl_MutexUnlock(&init_mx);
	Tcl_MutexUnlock(&init_mx);
#endif

    return status;
	return(status);
}