Index: ChangeLog ================================================================== --- ChangeLog +++ ChangeLog @@ -1,6 +1,34 @@ +2002-02-04 Jeff Hobbs + + * 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 + + TLS 1.4.1 RELEASE * configure: added configure to CVS * configure.in: moved to patchlevel 1.4.1 * Makefile.in: corrected 'dist' target Index: tls.c ================================================================== --- tls.c +++ tls.c @@ -1,10 +1,12 @@ /* * Copyright (C) 1997-1999 Matt Newman - * Copyright (C) 2000 Ajuba Solutions + * some modifications: + * 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 @@ -378,11 +380,11 @@ 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; } @@ -410,21 +412,15 @@ ClientData clientData; /* Not used. */ Tcl_Interp *interp; int objc; Tcl_Obj *CONST objv[]; { - static char *protocols[] = { - "ssl2", - "ssl3", - "tls1", - NULL + static CONST char *protocols[] = { + "ssl2", "ssl3", "tls1", NULL }; enum protocol { - TLS_SSL2, - TLS_SSL3, - TLS_TLS1, - TLS_NONE + TLS_SSL2, TLS_SSL3, TLS_TLS1, TLS_NONE }; Tcl_Obj *objPtr; SSL_CTX *ctx = NULL; SSL *ssl = NULL; STACK_OF(SSL_CIPHER) *sk; @@ -563,11 +559,11 @@ 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); @@ -824,11 +820,12 @@ 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; } /* *------------------------------------------------------------------- @@ -1011,15 +1008,25 @@ 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; } @@ -1033,16 +1040,23 @@ Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan), "\": not a TLS channel", NULL); return TCL_ERROR; } statePtr = (State *) Tcl_GetChannelInstanceData(chan); - peer = SSL_get_peer_certificate(statePtr->ssl); + if (objc == 2) + 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)); Index: tls.htm ================================================================== --- tls.htm +++ tls.htm @@ -26,11 +26,11 @@
tls::init ?options?
tls::socket ?options? host port
tls::socket ?-server command? ?options? port
tls::handshake channel
-
tls::status channel
+
tls::status ?-local? channel
tls::import channel ?options?
tls::ciphers protocol ?verbose?
COMMANDS
@@ -54,11 +54,11 @@
tls::init ?options?
tls::socket ?options? host port
tls::socket ?-server command? ?options? port
-tls::status channel
+tls::status ?-local? channel
tls::handshake channel

tls::import channel ?options?
tls::ciphers protocol ?verbose?

@@ -108,15 +108,18 @@
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.
 
-
tls::status channel
+
tls::status + ?-local? channel
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.
+ SSL handshake has not yet completed. + If -local is given, then the certificate information + is the one used locally.
issuer dn
@@ -132,10 +135,12 @@
serial n
The serial number of the certificate.
cipher cipher
The current cipher in use between the client and server channels.
+
sbits n
+
The number of bits used for the session key.
tls::import channel Index: tlsBIO.c ================================================================== --- tlsBIO.c +++ tlsBIO.c @@ -1,9 +1,9 @@ /* * Copyright (C) 1997-2000 Matt Newman * - * $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" @@ -10,14 +10,14 @@ /* * 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 = { @@ -53,11 +53,11 @@ } 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; @@ -125,21 +125,21 @@ } 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; Index: tlsIO.c ================================================================== --- tlsIO.c +++ tlsIO.c @@ -1,10 +1,10 @@ /* * Copyright (C) 1997-2000 Matt Newman * 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 @@ -30,13 +30,13 @@ 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, @@ -401,11 +401,11 @@ *------------------------------------------------------------------- */ 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; @@ -505,11 +505,11 @@ *------------------------------------------------------------------- */ 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. */