Check-in [c34385bbcd]
Bounty program for improvements to Tcl and certain Tcl packages.
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  +2002-02-04  Jeff Hobbs  <[email protected]>
            2  +
            3  +	* tls.htm:
            4  +	* tls.c: added support for local certificate status check, as well
            5  +	as returning the # of bits in the session key. [Patch #505698] (rose)
            6  +
            7  +	* tls.c:
            8  +	* tlsIO.c:
            9  +	* tlsBIO.c: added CONSTs to satisfy Tcl 8.4 sources.  This may
           10  +	give warnings when compiled against 8.3, but they can be ignored.
           11  +
           12  +	* tests/simpleClient.tcl:
           13  +	* tests/simpleServer.tcl: point to updated client/server key files.
           14  +
           15  +	* tests/tlsIO.test:
           16  +	* tests/ciphers.test: updated to load tls from build dir.
           17  +
           18  +	* Makefile.in: removed strncasecmp from default object set.  This
           19  +	is only needed on the Mac, and Tcl stubs provides it.
           20  +
           21  +	* configure: regen'ed.
           22  +	* configure.in: updated to 1.5.0 for next release.
           23  +	Changed default openssl location to /usr/local/ssl (this is where
           24  +	openssl 0.9.6c installs by default).
           25  +	Changed to use public Tcl headers (private not needed).
           26  +
     1     27   2001-06-21  Jeff Hobbs  <[email protected]>
           28  +
           29  +	TLS 1.4.1 RELEASE
     2     30   
     3     31   	* configure: added configure to CVS
     4     32   	* configure.in: moved to patchlevel 1.4.1
     5     33   
     6     34   	* Makefile.in: corrected 'dist' target
     7     35   
     8     36   	* tests/certs/file.srl:

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

     1      1   /*
     2      2    * Copyright (C) 1997-1999 Matt Newman <[email protected]>
     3         - * Copyright (C) 2000 Ajuba Solutions
            3  + * some modifications:
            4  + *	Copyright (C) 2000 Ajuba Solutions
            5  + *	Copyright (C) 2002 ActiveState Corporation
     4      6    *
     5         - * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.13 2001/03/14 22:04:35 hobbs Exp $
            7  + * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.14 2002/02/04 22:46:31 hobbs Exp $
     6      8    *
     7      9    * TLS (aka SSL) Channel - can be layered on any bi-directional
     8     10    * Tcl_Channel (Note: Requires Trf Core Patch)
     9     11    *
    10     12    * This was built (almost) from scratch based upon observation of
    11     13    * OpenSSL 0.9.2B
    12     14    *
................................................................................
   376    378   #else
   377    379   static int
   378    380   PasswordCallback(char *buf, int size, int verify, void *udata)
   379    381   {
   380    382       Tcl_Interp *interp = (Tcl_Interp*)udata;
   381    383   
   382    384       if (Tcl_Eval(interp, "tls::password") == TCL_OK) {
   383         -	char *ret = Tcl_GetStringResult(interp);
          385  +	CONST char *ret = Tcl_GetStringResult(interp);
   384    386           strncpy(buf, ret, size);
   385    387   	return strlen(ret);
   386    388       } else {
   387    389   	return -1;
   388    390       }
   389    391   }
   390    392   #endif
................................................................................
   408    410   static int
   409    411   CiphersObjCmd(clientData, interp, objc, objv)
   410    412       ClientData clientData;	/* Not used. */
   411    413       Tcl_Interp *interp;
   412    414       int objc;
   413    415       Tcl_Obj	*CONST objv[];
   414    416   {
   415         -    static char *protocols[] = {
   416         -	"ssl2",
   417         -	"ssl3",
   418         -	"tls1",
   419         -	NULL
          417  +    static CONST char *protocols[] = {
          418  +	"ssl2",	"ssl3",	"tls1",	NULL
   420    419       };
   421    420       enum protocol {
   422         -	TLS_SSL2,
   423         -	TLS_SSL3,
   424         -	TLS_TLS1,
   425         -	TLS_NONE
          421  +	TLS_SSL2, TLS_SSL3, TLS_TLS1, TLS_NONE
   426    422       };
   427    423       Tcl_Obj *objPtr;
   428    424       SSL_CTX *ctx = NULL;
   429    425       SSL *ssl = NULL;
   430    426       STACK_OF(SSL_CIPHER) *sk;
   431    427       char *cp, buf[BUFSIZ];
   432    428       int index, verbose = 0;
................................................................................
   561    557       }
   562    558       statePtr = (State *)Tcl_GetChannelInstanceData(chan);
   563    559   
   564    560       if (!SSL_is_init_finished(statePtr->ssl)) {
   565    561   	int err;
   566    562   	ret = Tls_WaitForConnect(statePtr, &err);
   567    563   	if (ret < 0) {
   568         -	    char *errStr = statePtr->err;
          564  +	    CONST char *errStr = statePtr->err;
   569    565   	    Tcl_ResetResult(interp);
   570    566   	    Tcl_SetErrno(err);
   571    567   
   572    568   	    if (!errStr || *errStr == 0) {
   573    569   	        errStr = Tcl_PosixError(interp);
   574    570   	    }
   575    571   
................................................................................
   822    818       }
   823    819       SSL_set_bio(statePtr->ssl, statePtr->p_bio, statePtr->p_bio);
   824    820       BIO_set_ssl(statePtr->bio, statePtr->ssl, BIO_CLOSE);
   825    821   
   826    822       /*
   827    823        * End of SSL Init
   828    824        */
   829         -    Tcl_SetResult(interp, Tcl_GetChannelName(statePtr->self), TCL_VOLATILE);
          825  +    Tcl_SetResult(interp, (char *) Tcl_GetChannelName(statePtr->self),
          826  +	    TCL_VOLATILE);
   830    827       return TCL_OK;
   831    828   }
   832    829   
   833    830   /*
   834    831    *-------------------------------------------------------------------
   835    832    *
   836    833    * CTX_Init -- construct a SSL_CTX instance
................................................................................
  1009   1006       State *statePtr;
  1010   1007       X509 *peer;
  1011   1008       Tcl_Obj *objPtr;
  1012   1009       Tcl_Channel chan;
  1013   1010       char *channelName, *ciphers;
  1014   1011       int mode;
  1015   1012   
  1016         -    if (objc != 2) {
  1017         -        Tcl_WrongNumArgs(interp, 1, objv, "channel");
  1018         -        return TCL_ERROR;
         1013  +    switch (objc) {
         1014  +	case 2:
         1015  +	    channelName = Tcl_GetStringFromObj(objv[1], NULL);
         1016  +	    break;
         1017  +
         1018  +	case 3:
         1019  +	    if (!strcmp (Tcl_GetString (objv[1]), "-local")) {
         1020  +		channelName = Tcl_GetStringFromObj(objv[2], NULL);
         1021  +		break;
         1022  +	    }
         1023  +	    /* else fall... */
         1024  +	default:
         1025  +	    Tcl_WrongNumArgs(interp, 1, objv, "?-local? channel");
         1026  +	    return TCL_ERROR;
  1019   1027       }
  1020         -    channelName = Tcl_GetStringFromObj(objv[1], NULL);
  1021   1028   
  1022   1029       chan = Tcl_GetChannel(interp, channelName, &mode);
  1023   1030       if (chan == (Tcl_Channel) NULL) {
  1024   1031   	return TCL_ERROR;
  1025   1032       }
  1026   1033       if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
  1027   1034   	/*
................................................................................
  1031   1038       }
  1032   1039       if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
  1033   1040           Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
  1034   1041                   "\": not a TLS channel", NULL);
  1035   1042           return TCL_ERROR;
  1036   1043       }
  1037   1044       statePtr	= (State *) Tcl_GetChannelInstanceData(chan);
  1038         -    peer	= SSL_get_peer_certificate(statePtr->ssl);
         1045  +    if (objc == 2)
         1046  +	peer	= SSL_get_peer_certificate(statePtr->ssl);
         1047  +    else
         1048  +	peer	= SSL_get_certificate(statePtr->ssl);
  1039   1049       if (peer) {
  1040   1050   	objPtr = Tls_NewX509Obj(interp, peer);
  1041   1051       } else {
  1042   1052   	objPtr = Tcl_NewListObj(0, NULL);
  1043   1053       }
         1054  +
         1055  +    Tcl_ListObjAppendElement (interp, objPtr, Tcl_NewStringObj ("sbits", -1));
         1056  +    Tcl_ListObjAppendElement (interp, objPtr,
         1057  +	    Tcl_NewIntObj (SSL_get_cipher_bits (statePtr->ssl, NULL)));
  1044   1058   
  1045   1059       ciphers = (char*)SSL_get_cipher(statePtr->ssl);
  1046   1060       if (ciphers != NULL && strcmp(ciphers, "(NONE)")!=0) {
  1047   1061   	Tcl_ListObjAppendElement(interp, objPtr,
  1048   1062   		Tcl_NewStringObj("cipher", -1));
  1049   1063   	Tcl_ListObjAppendElement(interp, objPtr,
  1050   1064   		Tcl_NewStringObj(SSL_get_cipher(statePtr->ssl), -1));

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

    24     24               <dd><b>package require tls </b><em>?1.4?</em></dd>
    25     25               <dt>&nbsp;</dt>
    26     26               <dd><b>tls::init </b><i>?options?</i> </dd>
    27     27               <dd><b>tls::socket </b><em>?options? host port</em></dd>
    28     28               <dd><b>tls::socket</b><em> ?-server command?
    29     29                   ?options? port</em></dd>
    30     30               <dd><b>tls::handshake</b><em> channel</em></dd>
    31         -            <dd><b>tls::status </b><em>channel</em></dd>
           31  +            <dd><b>tls::status </b><em>?-local? channel</em></dd>
    32     32               <dd><b>tls::import</b><em> channel ?options?</em></dd>
    33     33               <dd><b>tls::ciphers </b><em>protocol ?verbose?</em></dd>
    34     34           </dl>
    35     35       </dd>
    36     36       <dd><a href="#COMMANDS">COMMANDS</a></dd>
    37     37       <dd><a href="#CONFIGURATION OPTIONS">CONFIGURATION OPTIONS</a></dd>
    38     38       <dd><a href="#HTTPS EXAMPLE">HTTPS EXAMPLE</a></dd>
................................................................................
    52     52   <p><b>package require Tcl 8.2</b><br>
    53     53   <b>package require tls 1.4</b><br>
    54     54   <br>
    55     55   <a href="#tls::init"><b>tls::init </b><i>?options?</i><br>
    56     56   </a><a href="#tls::socket"><b>tls::socket </b><em>?options? host
    57     57   port</em><br>
    58     58   <b>tls::socket</b><em> ?-server command? ?options? port</em><br>
    59         -</a><a href="#tls::status"><b>tls::status </b><em>channel</em><br>
           59  +</a><a href="#tls::status"><b>tls::status </b><em>?-local? channel</em><br>
    60     60   </a><a href="#tls::handshake"><b>tls::handshake</b><em> channel</em></a><br>
    61     61   <br>
    62     62   <a href="#tls::import"><b>tls::import </b><i>channel ?options?</i></a><br>
    63     63   <a href="#tls::ciphers protocol ?verbose?"><strong>tls::ciphers</strong>
    64     64   <em>protocol ?verbose?</em></a></p>
    65     65   
    66     66   <h3><a name="DESCRIPTION">DESCRIPTION</a></h3>
................................................................................
   106    106       <dt>&nbsp;</dt>
   107    107       <dt><a name="tls::handshake"><strong>tls::handshake</strong> <em>channel</em></a></dt>
   108    108       <dd>Forces handshake to take place, and returns 0 if
   109    109           handshake is still in progress (non-blocking), or 1 if
   110    110           the handshake was successful. If the handshake failed
   111    111           this routine will throw an error.</dd>
   112    112       <dt>&nbsp;</dt>
   113         -    <dt><a name="tls::status"><strong>tls::status</strong> <em>channel</em></a></dt>
          113  +    <dt><a name="tls::status"><strong>tls::status</strong>
          114  +    <em>?-local? channel</em></a></dt>
   114    115       <dd>Returns the current security status of a SSL channel. The
   115    116           result is a list of key value pairs describing the
   116    117           connected peer. If the result is an empty list then the
   117         -        SSL handshake has not yet completed.</dd>
          118  +        SSL handshake has not yet completed.
          119  +        If <em>-local</em> is given, then the certificate information
          120  +        is the one used locally.</dd>
   118    121   </dl>
   119    122   
   120    123   <blockquote>
   121    124       <dl>
   122    125           <dt><strong>issuer</strong> <em>dn</em></dt>
   123    126           <dd>The distinguished name (DN) of the certificate
   124    127               issuer.</dd>
................................................................................
   130    133           <dt><strong>notAfter</strong> <em>date</em></dt>
   131    134           <dd>The expiry date for the certificate.</dd>
   132    135           <dt><strong>serial</strong> <em>n</em></dt>
   133    136           <dd>The serial number of the certificate.</dd>
   134    137           <dt><strong>cipher</strong> <em>cipher</em></dt>
   135    138           <dd>The current cipher in use between the client and
   136    139               server channels.</dd>
          140  +        <dt><strong>sbits</strong> <em>n</em></dt>
          141  +        <dd>The number of bits used for the session key.</dd>
   137    142       </dl>
   138    143   </blockquote>
   139    144   
   140    145   <dl>
   141    146       <dt><a name="tls::import"><b>tls::import </b><i>channel
   142    147           ?options?</i></a></dt>
   143    148       <dd>SSL-enable a regular Tcl channel - it need not be a

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

     1      1   /*
     2      2    * Copyright (C) 1997-2000 Matt Newman <[email protected]>
     3      3    *
     4         - * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsBIO.c,v 1.5 2000/08/18 19:17:36 hobbs Exp $
            4  + * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsBIO.c,v 1.6 2002/02/04 22:46:31 hobbs Exp $
     5      5    *
     6      6    * Provides BIO layer to interface openssl to Tcl.
     7      7    */
     8      8   
     9      9   #include "tlsInt.h"
    10     10   
    11     11   /*
    12     12    * Forward declarations
    13     13    */
    14     14   
    15         -static int BioWrite	_ANSI_ARGS_ ((BIO *h, char *buf, int num));
           15  +static int BioWrite	_ANSI_ARGS_ ((BIO *h, CONST char *buf, int num));
    16     16   static int BioRead	_ANSI_ARGS_ ((BIO *h, char *buf, int num));
    17         -static int BioPuts	_ANSI_ARGS_ ((BIO *h, char *str));
    18         -static long BioCtrl	_ANSI_ARGS_ ((BIO *h, int cmd, long arg1, char *ptr));
           17  +static int BioPuts	_ANSI_ARGS_ ((BIO *h, CONST char *str));
           18  +static long BioCtrl	_ANSI_ARGS_ ((BIO *h, int cmd, long arg1, CONST char *ptr));
    19     19   static int BioNew	_ANSI_ARGS_ ((BIO *h));
    20     20   static int BioFree	_ANSI_ARGS_ ((BIO *h));
    21     21   
    22     22   
    23     23   static BIO_METHOD BioMethods = {
    24     24       BIO_TYPE_TCL, "tcl",
    25     25       BioWrite,
................................................................................
    51     51   {
    52     52       return &BioMethods;
    53     53   }
    54     54   
    55     55   static int
    56     56   BioWrite (bio, buf, bufLen)
    57     57       BIO *bio;
    58         -    char *buf;
           58  +    CONST char *buf;
    59     59       int bufLen;
    60     60   {
    61     61       Tcl_Channel chan = Tls_GetParent((State*)(bio->ptr));
    62     62       int ret;
    63     63   
    64     64       dprintf(stderr,"\nBioWrite(0x%x, <buf>, %d) [0x%x]",
    65     65   	    (unsigned int) bio, bufLen, (unsigned int) chan);
................................................................................
   123    123       }
   124    124       return ret;
   125    125   }
   126    126   
   127    127   static int
   128    128   BioPuts	(bio, str)
   129    129       BIO *bio;
   130         -    char *str;
          130  +    CONST char *str;
   131    131   {
   132    132       return BioWrite(bio, str, strlen(str));
   133    133   }
   134    134   
   135    135   static long
   136    136   BioCtrl	(bio, cmd, num, ptr)
   137    137       BIO *bio;
   138    138       int cmd;
   139    139       long num;
   140         -    char *ptr;
          140  +    CONST char *ptr;
   141    141   {
   142    142       Tcl_Channel chan = Tls_GetParent((State*)bio->ptr);
   143    143       long ret = 1;
   144    144       int *ip;
   145    145   
   146    146       dprintf(stderr,"\nBioCtrl(0x%x, 0x%x, 0x%x, 0x%x)",
   147    147   	    (unsigned int) bio, (unsigned int) cmd, (unsigned int) num,

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

     1      1   /*
     2      2    * Copyright (C) 1997-2000 Matt Newman <[email protected]>
     3      3    * Copyright (C) 2000 Ajuba Solutions
     4      4    *
     5         - * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsIO.c,v 1.12 2000/09/07 21:16:19 hobbs Exp $
            5  + * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsIO.c,v 1.13 2002/02/04 22:46:31 hobbs Exp $
     6      6    *
     7      7    * TLS (aka SSL) Channel - can be layered on any bi-directional
     8      8    * Tcl_Channel (Note: Requires Trf Core Patch)
     9      9    *
    10     10    * This was built from scratch based upon observation of OpenSSL 0.9.2B
    11     11    *
    12     12    * Addition credit is due for Andreas Kupries ([email protected]), for
................................................................................
    28     28   static int	TlsBlockModeProc _ANSI_ARGS_((ClientData instanceData,
    29     29   			int mode));
    30     30   static int	TlsCloseProc _ANSI_ARGS_ ((ClientData instanceData,
    31     31   			Tcl_Interp *interp));
    32     32   static int	TlsInputProc _ANSI_ARGS_((ClientData instanceData,
    33     33   			char *buf, int bufSize, int *errorCodePtr));
    34     34   static int	TlsOutputProc _ANSI_ARGS_((ClientData instanceData,
    35         -			char *buf, int toWrite, int *errorCodePtr));
           35  +			CONST char *buf, int toWrite, int *errorCodePtr));
    36     36   static int	TlsGetOptionProc _ANSI_ARGS_ ((ClientData instanceData,
    37         -			Tcl_Interp *interp, char *optionName,
           37  +			Tcl_Interp *interp, CONST char *optionName,
    38     38   			Tcl_DString *dsPtr));
    39     39   static void	TlsWatchProc _ANSI_ARGS_((ClientData instanceData, int mask));
    40     40   static int	TlsGetHandleProc _ANSI_ARGS_ ((ClientData instanceData,
    41     41   			int direction, ClientData *handlePtr));
    42     42   static int	TlsNotifyProc _ANSI_ARGS_ ((ClientData instanceData,
    43     43   			int mask));
    44     44   static void	TlsChannelHandler _ANSI_ARGS_ ((ClientData clientData,
................................................................................
   399    399    *	Writes output on the output device of the channel.
   400    400    *
   401    401    *-------------------------------------------------------------------
   402    402    */
   403    403   
   404    404   static int
   405    405   TlsOutputProc(ClientData instanceData,	/* Socket state. */
   406         -              char *buf,		/* The data buffer. */
          406  +              CONST char *buf,		/* The data buffer. */
   407    407                 int toWrite,		/* How many bytes to write? */
   408    408                 int *errorCodePtr)	/* Where to store error code. */
   409    409   {
   410    410       State *statePtr = (State *) instanceData;
   411    411       int written, err;
   412    412   
   413    413       *errorCodePtr = 0;
................................................................................
   503    503    *	None.
   504    504    *
   505    505    *-------------------------------------------------------------------
   506    506    */
   507    507   static int
   508    508   TlsGetOptionProc(ClientData instanceData,	/* Socket state. */
   509    509   	Tcl_Interp *interp,		/* For errors - can be NULL. */
   510         -	char *optionName,		/* Name of the option to
          510  +	CONST char *optionName,		/* Name of the option to
   511    511   					 * retrieve the value for, or
   512    512   					 * NULL to get all options and
   513    513   					 * their values. */
   514    514   	Tcl_DString *dsPtr)		/* Where to store the computed value
   515    515   					 * initialized by caller. */
   516    516   {
   517    517       State *statePtr = (State *) instanceData;