Check-in [c34385bbcd]
Overview
Comment: * tls.htm: * tls.c: added support for local certificate status check, as well as returning the # of bits in the session key. [Patch #505698] (rose) * tls.c: * tlsIO.c: * tlsBIO.c: added CONSTs to satisfy Tcl 8.4 sources. This may give warnings when compiled against 8.3, but they can be ignored.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: c34385bbcd069ecd4f2a8eeae072ebab4d66fd79
User & Date: hobbs on 2002-02-04 22:46:31
Other Links: manifest | tags
Context
2003-05-15
20:44
*** empty log message *** check-in: 3631274d64 user: razzell tags: trunk
2002-02-04
22:46
* tls.htm: * tls.c: added support for local certificate status check, as well as returning the # of bits in the session key. [Patch #505698] (rose) * tls.c: * tlsIO.c: * tlsBIO.c: added CONSTs to satisfy Tcl 8.4 sources. This may give warnings when compiled against 8.3, but they can be ignored. check-in: c34385bbcd user: hobbs tags: trunk
22:46
* configure: regen'ed. * configure.in: updated to 1.5.0 for next release. Changed default openssl location to /usr/local/ssl (this is where openssl 0.9.6c installs by default). Changed to use public Tcl headers (private not needed). check-in: 83ee7c76db user: hobbs tags: trunk
Changes

Modified ChangeLog from [d1a7a7f0bf] to [714f578cf0].



























1


2
3
4
5
6
7
8
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+







2002-02-04  Jeff Hobbs  <[email protected]>

	* tls.htm:
	* tls.c: added support for local certificate status check, as well
	as returning the # of bits in the session key. [Patch #505698] (rose)

	* tls.c:
	* tlsIO.c:
	* tlsBIO.c: added CONSTs to satisfy Tcl 8.4 sources.  This may
	give warnings when compiled against 8.3, but they can be ignored.

	* tests/simpleClient.tcl:
	* tests/simpleServer.tcl: point to updated client/server key files.

	* tests/tlsIO.test:
	* tests/ciphers.test: updated to load tls from build dir.

	* Makefile.in: removed strncasecmp from default object set.  This
	is only needed on the Mac, and Tcl stubs provides it.

	* configure: regen'ed.
	* configure.in: updated to 1.5.0 for next release.
	Changed default openssl location to /usr/local/ssl (this is where
	openssl 0.9.6c installs by default).
	Changed to use public Tcl headers (private not needed).

2001-06-21  Jeff Hobbs  <[email protected]>

	TLS 1.4.1 RELEASE

	* configure: added configure to CVS
	* configure.in: moved to patchlevel 1.4.1

	* Makefile.in: corrected 'dist' target

	* tests/certs/file.srl:

Modified tls.c from [7a7ec2f3d3] to [1f1f2854e3].

1
2

3


4
5

6
7
8
9
10
11
12
1
2
3

4
5
6

7
8
9
10
11
12
13
14


+
-
+
+

-
+







/*
 * Copyright (C) 1997-1999 Matt Newman <[email protected]>
 * some modifications:
 * Copyright (C) 2000 Ajuba Solutions
 *	Copyright (C) 2000 Ajuba Solutions
 *	Copyright (C) 2002 ActiveState Corporation
 *
 * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.13 2001/03/14 22:04:35 hobbs Exp $
 * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.14 2002/02/04 22:46:31 hobbs Exp $
 *
 * 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
 * OpenSSL 0.9.2B
 *
376
377
378
379
380
381
382
383

384
385
386
387
388
389
390
378
379
380
381
382
383
384

385
386
387
388
389
390
391
392







-
+







#else
static int
PasswordCallback(char *buf, int size, int verify, void *udata)
{
    Tcl_Interp *interp = (Tcl_Interp*)udata;

    if (Tcl_Eval(interp, "tls::password") == TCL_OK) {
	char *ret = Tcl_GetStringResult(interp);
	CONST char *ret = Tcl_GetStringResult(interp);
        strncpy(buf, ret, size);
	return strlen(ret);
    } else {
	return -1;
    }
}
#endif
408
409
410
411
412
413
414
415
416


417
418
419
420
421
422

423
424
425
426
427
428
429
430
431
432
410
411
412
413
414
415
416


417
418



419
420

421



422
423
424
425
426
427
428







-
-
+
+
-
-
-


-
+
-
-
-







static int
CiphersObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Not used. */
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj	*CONST objv[];
{
    static char *protocols[] = {
	"ssl2",
    static CONST char *protocols[] = {
	"ssl2",	"ssl3",	"tls1",	NULL
	"ssl3",
	"tls1",
	NULL
    };
    enum protocol {
	TLS_SSL2,
	TLS_SSL2, TLS_SSL3, TLS_TLS1, TLS_NONE
	TLS_SSL3,
	TLS_TLS1,
	TLS_NONE
    };
    Tcl_Obj *objPtr;
    SSL_CTX *ctx = NULL;
    SSL *ssl = NULL;
    STACK_OF(SSL_CIPHER) *sk;
    char *cp, buf[BUFSIZ];
    int index, verbose = 0;
561
562
563
564
565
566
567
568

569
570
571
572
573
574
575
557
558
559
560
561
562
563

564
565
566
567
568
569
570
571







-
+







    }
    statePtr = (State *)Tcl_GetChannelInstanceData(chan);

    if (!SSL_is_init_finished(statePtr->ssl)) {
	int err;
	ret = Tls_WaitForConnect(statePtr, &err);
	if (ret < 0) {
	    char *errStr = statePtr->err;
	    CONST char *errStr = statePtr->err;
	    Tcl_ResetResult(interp);
	    Tcl_SetErrno(err);

	    if (!errStr || *errStr == 0) {
	        errStr = Tcl_PosixError(interp);
	    }

822
823
824
825
826
827
828
829


830
831
832
833
834
835
836
818
819
820
821
822
823
824

825
826
827
828
829
830
831
832
833







-
+
+







    }
    SSL_set_bio(statePtr->ssl, statePtr->p_bio, statePtr->p_bio);
    BIO_set_ssl(statePtr->bio, statePtr->ssl, BIO_CLOSE);

    /*
     * End of SSL Init
     */
    Tcl_SetResult(interp, Tcl_GetChannelName(statePtr->self), TCL_VOLATILE);
    Tcl_SetResult(interp, (char *) Tcl_GetChannelName(statePtr->self),
	    TCL_VOLATILE);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * CTX_Init -- construct a SSL_CTX instance
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018














1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037

1038



1039
1040
1041
1042
1043




1044
1045
1046
1047
1048
1049
1050
1006
1007
1008
1009
1010
1011
1012



1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027

1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045

1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064







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

-

















+
-
+
+
+





+
+
+
+







    State *statePtr;
    X509 *peer;
    Tcl_Obj *objPtr;
    Tcl_Channel chan;
    char *channelName, *ciphers;
    int mode;

    if (objc != 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "channel");
        return TCL_ERROR;
    switch (objc) {
	case 2:
	    channelName = Tcl_GetStringFromObj(objv[1], NULL);
	    break;

	case 3:
	    if (!strcmp (Tcl_GetString (objv[1]), "-local")) {
		channelName = Tcl_GetStringFromObj(objv[2], NULL);
		break;
	    }
	    /* else fall... */
	default:
	    Tcl_WrongNumArgs(interp, 1, objv, "?-local? channel");
	    return TCL_ERROR;
    }
    channelName = Tcl_GetStringFromObj(objv[1], NULL);

    chan = Tcl_GetChannel(interp, channelName, &mode);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }
    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
	/*
	 * 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);
    if (objc == 2)
    peer	= SSL_get_peer_certificate(statePtr->ssl);
	peer	= SSL_get_peer_certificate(statePtr->ssl);
    else
	peer	= SSL_get_certificate(statePtr->ssl);
    if (peer) {
	objPtr = Tls_NewX509Obj(interp, 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)));

    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));

Modified tls.htm from [2c238dd973] to [dd76fd83fe].

24
25
26
27
28
29
30
31

32
33
34
35
36
37
38
24
25
26
27
28
29
30

31
32
33
34
35
36
37
38







-
+







            <dd><b>package require tls </b><em>?1.4?</em></dd>
            <dt>&nbsp;</dt>
            <dd><b>tls::init </b><i>?options?</i> </dd>
            <dd><b>tls::socket </b><em>?options? host port</em></dd>
            <dd><b>tls::socket</b><em> ?-server command?
                ?options? port</em></dd>
            <dd><b>tls::handshake</b><em> channel</em></dd>
            <dd><b>tls::status </b><em>channel</em></dd>
            <dd><b>tls::status </b><em>?-local? channel</em></dd>
            <dd><b>tls::import</b><em> channel ?options?</em></dd>
            <dd><b>tls::ciphers </b><em>protocol ?verbose?</em></dd>
        </dl>
    </dd>
    <dd><a href="#COMMANDS">COMMANDS</a></dd>
    <dd><a href="#CONFIGURATION OPTIONS">CONFIGURATION OPTIONS</a></dd>
    <dd><a href="#HTTPS EXAMPLE">HTTPS EXAMPLE</a></dd>
52
53
54
55
56
57
58
59

60
61
62
63
64
65
66
52
53
54
55
56
57
58

59
60
61
62
63
64
65
66







-
+







<p><b>package require Tcl 8.2</b><br>
<b>package require tls 1.4</b><br>
<br>
<a href="#tls::init"><b>tls::init </b><i>?options?</i><br>
</a><a href="#tls::socket"><b>tls::socket </b><em>?options? host
port</em><br>
<b>tls::socket</b><em> ?-server command? ?options? port</em><br>
</a><a href="#tls::status"><b>tls::status </b><em>channel</em><br>
</a><a href="#tls::status"><b>tls::status </b><em>?-local? channel</em><br>
</a><a href="#tls::handshake"><b>tls::handshake</b><em> channel</em></a><br>
<br>
<a href="#tls::import"><b>tls::import </b><i>channel ?options?</i></a><br>
<a href="#tls::ciphers protocol ?verbose?"><strong>tls::ciphers</strong>
<em>protocol ?verbose?</em></a></p>

<h3><a name="DESCRIPTION">DESCRIPTION</a></h3>
106
107
108
109
110
111
112
113


114
115
116
117



118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136


137
138
139
140
141
142
143
106
107
108
109
110
111
112

113
114
115
116
117

118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148







-
+
+



-
+
+
+



















+
+







    <dt>&nbsp;</dt>
    <dt><a name="tls::handshake"><strong>tls::handshake</strong> <em>channel</em></a></dt>
    <dd>Forces handshake to take place, and returns 0 if
        handshake is still in progress (non-blocking), or 1 if
        the handshake was successful. If the handshake failed
        this routine will throw an error.</dd>
    <dt>&nbsp;</dt>
    <dt><a name="tls::status"><strong>tls::status</strong> <em>channel</em></a></dt>
    <dt><a name="tls::status"><strong>tls::status</strong>
    <em>?-local? channel</em></a></dt>
    <dd>Returns the current security status of a SSL channel. The
        result is a list of key value pairs describing the
        connected peer. If the result is an empty list then the
        SSL handshake has not yet completed.</dd>
        SSL handshake has not yet completed.
        If <em>-local</em> is given, then the certificate information
        is the one used locally.</dd>
</dl>

<blockquote>
    <dl>
        <dt><strong>issuer</strong> <em>dn</em></dt>
        <dd>The distinguished name (DN) of the certificate
            issuer.</dd>
        <dt><strong>subject</strong> <em>dn</em></dt>
        <dd>The distinguished name (DN) of the certificate
            subject.</dd>
        <dt><strong>notBefore</strong> <em>date</em></dt>
        <dd>The begin date for the validity of the certificate.</dd>
        <dt><strong>notAfter</strong> <em>date</em></dt>
        <dd>The expiry date for the certificate.</dd>
        <dt><strong>serial</strong> <em>n</em></dt>
        <dd>The serial number of the certificate.</dd>
        <dt><strong>cipher</strong> <em>cipher</em></dt>
        <dd>The current cipher in use between the client and
            server channels.</dd>
        <dt><strong>sbits</strong> <em>n</em></dt>
        <dd>The number of bits used for the session key.</dd>
    </dl>
</blockquote>

<dl>
    <dt><a name="tls::import"><b>tls::import </b><i>channel
        ?options?</i></a></dt>
    <dd>SSL-enable a regular Tcl channel - it need not be a

Modified tlsBIO.c from [61828ed639] to [3e7555cac8].

1
2
3
4

5
6
7
8
9
10
11
12
13
14
15

16
17
18


19
20
21
22
23
24
25
1
2
3

4
5
6
7
8
9
10
11
12
13
14

15
16


17
18
19
20
21
22
23
24
25



-
+










-
+

-
-
+
+







/*
 * Copyright (C) 1997-2000 Matt Newman <[email protected]>
 *
 * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsBIO.c,v 1.5 2000/08/18 19:17:36 hobbs Exp $
 * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsBIO.c,v 1.6 2002/02/04 22:46:31 hobbs Exp $
 *
 * Provides BIO layer to interface openssl to Tcl.
 */

#include "tlsInt.h"

/*
 * Forward declarations
 */

static int BioWrite	_ANSI_ARGS_ ((BIO *h, char *buf, int num));
static int BioWrite	_ANSI_ARGS_ ((BIO *h, CONST char *buf, int num));
static int BioRead	_ANSI_ARGS_ ((BIO *h, char *buf, int num));
static int BioPuts	_ANSI_ARGS_ ((BIO *h, char *str));
static long BioCtrl	_ANSI_ARGS_ ((BIO *h, int cmd, long arg1, char *ptr));
static int BioPuts	_ANSI_ARGS_ ((BIO *h, CONST char *str));
static long BioCtrl	_ANSI_ARGS_ ((BIO *h, int cmd, long arg1, CONST char *ptr));
static int BioNew	_ANSI_ARGS_ ((BIO *h));
static int BioFree	_ANSI_ARGS_ ((BIO *h));


static BIO_METHOD BioMethods = {
    BIO_TYPE_TCL, "tcl",
    BioWrite,
51
52
53
54
55
56
57
58

59
60
61
62
63
64
65
51
52
53
54
55
56
57

58
59
60
61
62
63
64
65







-
+







{
    return &BioMethods;
}

static int
BioWrite (bio, buf, bufLen)
    BIO *bio;
    char *buf;
    CONST char *buf;
    int bufLen;
{
    Tcl_Channel chan = Tls_GetParent((State*)(bio->ptr));
    int ret;

    dprintf(stderr,"\nBioWrite(0x%x, <buf>, %d) [0x%x]",
	    (unsigned int) bio, bufLen, (unsigned int) chan);
123
124
125
126
127
128
129
130

131
132
133
134
135
136
137
138
139
140

141
142
143
144
145
146
147
123
124
125
126
127
128
129

130
131
132
133
134
135
136
137
138
139

140
141
142
143
144
145
146
147







-
+









-
+







    }
    return ret;
}

static int
BioPuts	(bio, str)
    BIO *bio;
    char *str;
    CONST char *str;
{
    return BioWrite(bio, str, strlen(str));
}

static long
BioCtrl	(bio, cmd, num, ptr)
    BIO *bio;
    int cmd;
    long num;
    char *ptr;
    CONST char *ptr;
{
    Tcl_Channel chan = Tls_GetParent((State*)bio->ptr);
    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,

Modified tlsIO.c from [31b270211d] to [40b688575b].

1
2
3
4
5

6
7
8
9
10
11
12
1
2
3
4

5
6
7
8
9
10
11
12




-
+







/*
 * Copyright (C) 1997-2000 Matt Newman <[email protected]>
 * Copyright (C) 2000 Ajuba Solutions
 *
 * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsIO.c,v 1.12 2000/09/07 21:16:19 hobbs Exp $
 * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsIO.c,v 1.13 2002/02/04 22:46:31 hobbs Exp $
 *
 * TLS (aka SSL) Channel - can be layered on any bi-directional
 * Tcl_Channel (Note: Requires Trf Core Patch)
 *
 * This was built from scratch based upon observation of OpenSSL 0.9.2B
 *
 * Addition credit is due for Andreas Kupries ([email protected]), for
28
29
30
31
32
33
34
35

36
37

38
39
40
41
42
43
44
28
29
30
31
32
33
34

35
36

37
38
39
40
41
42
43
44







-
+

-
+







static int	TlsBlockModeProc _ANSI_ARGS_((ClientData instanceData,
			int mode));
static int	TlsCloseProc _ANSI_ARGS_ ((ClientData instanceData,
			Tcl_Interp *interp));
static int	TlsInputProc _ANSI_ARGS_((ClientData instanceData,
			char *buf, int bufSize, int *errorCodePtr));
static int	TlsOutputProc _ANSI_ARGS_((ClientData instanceData,
			char *buf, int toWrite, int *errorCodePtr));
			CONST char *buf, int toWrite, int *errorCodePtr));
static int	TlsGetOptionProc _ANSI_ARGS_ ((ClientData instanceData,
			Tcl_Interp *interp, char *optionName,
			Tcl_Interp *interp, CONST char *optionName,
			Tcl_DString *dsPtr));
static void	TlsWatchProc _ANSI_ARGS_((ClientData instanceData, int mask));
static int	TlsGetHandleProc _ANSI_ARGS_ ((ClientData instanceData,
			int direction, ClientData *handlePtr));
static int	TlsNotifyProc _ANSI_ARGS_ ((ClientData instanceData,
			int mask));
static void	TlsChannelHandler _ANSI_ARGS_ ((ClientData clientData,
399
400
401
402
403
404
405
406

407
408
409
410
411
412
413
399
400
401
402
403
404
405

406
407
408
409
410
411
412
413







-
+







 *	Writes output on the output device of the channel.
 *
 *-------------------------------------------------------------------
 */

static int
TlsOutputProc(ClientData instanceData,	/* Socket state. */
              char *buf,		/* The data buffer. */
              CONST char *buf,		/* The data buffer. */
              int toWrite,		/* How many bytes to write? */
              int *errorCodePtr)	/* Where to store error code. */
{
    State *statePtr = (State *) instanceData;
    int written, err;

    *errorCodePtr = 0;
503
504
505
506
507
508
509
510

511
512
513
514
515
516
517
503
504
505
506
507
508
509

510
511
512
513
514
515
516
517







-
+







 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
TlsGetOptionProc(ClientData instanceData,	/* Socket state. */
	Tcl_Interp *interp,		/* For errors - can be NULL. */
	char *optionName,		/* Name of the option to
	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;