Index: ChangeLog ================================================================== --- ChangeLog +++ ChangeLog @@ -1,5 +1,26 @@ +2003-05-15 Dan Razzell + + * tls.tcl: + * tlsInt.h: + * tls.c: add support for binding a password callback to the socket. + Now each socket can have its own command and password callbacks instead + of being forced to have all password management pass through a common + procedure. The common password procedure is retained for compatibility + but its use should be DEPRECATED. + Add version command to return OpenSSL version string. + Remove unstable workarounds needed for verify in obsolete versions of + OpenSSL. + Fix memory leak. [Request #640660] + More casts to eliminate compiler warnings. + + * tls.htm: document password callback. + Correct technical and typographic errors. + + * README.txt: identify versions of OpenSSL which fix known problems. + General warning of security problems in older versions of OpenSSL. + 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) Index: README.txt ================================================================== --- README.txt +++ README.txt @@ -1,9 +1,9 @@ Copyright (C) 1997-2000 Matt Newman TLS 1.4.1 Copyright (C) 2000 Ajuba Solutions -$Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/README.txt,v 1.3 2001/06/21 23:34:20 hobbs Exp $ +$Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/README.txt,v 1.4 2003/05/15 20:44:46 razzell Exp $ TLS (aka SSL) Channel - can be layered on any bi-directional Tcl_Channel. Both client and server-side sockets are possible, and this code should work on any platform as it uses a generic mechanism for layering on SSL and Tcl. @@ -19,11 +19,15 @@ . Full filevent sematics should also be intact - see tests directory for blocking and non-blocking examples. -This was built (almost) from scratch based upon observation of OpenSSL 0.9.2B +This was built (almost) from scratch based upon observation of OpenSSL 0.9.2b. +For correct functioning, use OpenSSL 0.9.6g or later. This release contains +important fixes to memory management, as well as incorporating the verify +callback correction which appeared in OpenSSL 0.9.6c. For best security, use +the latest official release of OpenSSL. Addition credit is due for Andreas Kupries (a.kupries@westend.com), for providing the Tcl_ReplaceChannel mechanism and working closely with me to enhance it to support full fileevent semantics. Index: tls.c ================================================================== --- tls.c +++ tls.c @@ -1,12 +1,13 @@ /* * Copyright (C) 1997-1999 Matt Newman * some modifications: * Copyright (C) 2000 Ajuba Solutions * Copyright (C) 2002 ActiveState Corporation + * Copyright (C) 2003 Starfish Systems * - * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.14 2002/02/04 22:46:31 hobbs Exp $ + * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.15 2003/05/15 20:44:46 razzell 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 @@ -48,11 +49,15 @@ static int ImportObjCmd _ANSI_ARGS_ ((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 SSL_CTX *CTX_Init _ANSI_ARGS_((Tcl_Interp *interp, int proto, char *key, + +static int VersionObjCmd _ANSI_ARGS_ ((ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); + +static SSL_CTX *CTX_Init _ANSI_ARGS_((State *statePtr, int proto, char *key, char *cert, char *CAdir, char *CAfile, char *ciphers)); #define TLS_PROTO_SSL2 0x01 #define TLS_PROTO_SSL3 0x02 #define TLS_PROTO_TLS1 0x04 @@ -170,11 +175,10 @@ else if (where & SSL_CB_LOOP) minor = "loop"; else if (where & SSL_CB_EXIT) minor = "exit"; else minor = "unknown"; } - Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, Tcl_NewStringObj( "info", -1)); Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, Tcl_NewStringObj( Tcl_GetChannelName(statePtr->self), -1) ); @@ -187,11 +191,11 @@ if (where & (SSL_CB_LOOP|SSL_CB_EXIT)) { Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, Tcl_NewStringObj( SSL_state_string_long(ssl), -1) ); } else if (where & SSL_CB_ALERT) { - char *cp = SSL_alert_desc_string_long(ret); + char *cp = (char *) SSL_alert_desc_string_long(ret); Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, Tcl_NewStringObj( cp, -1) ); } else { Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, @@ -358,13 +362,13 @@ /* *------------------------------------------------------------------- * * PasswordCallback -- * - * Called when a password is needed to unpack RSA and PEM keys - * Evals the tcl proc: tls::password and returns the result as - * the password + * Called when a password is needed to unpack RSA and PEM keys. + * Evals any bound password script and returns the result as + * the password string. *------------------------------------------------------------------- */ #ifdef PRE_OPENSSL_0_9_4 /* * No way to handle user-data therefore no way without a global @@ -377,14 +381,42 @@ } #else static int PasswordCallback(char *buf, int size, int verify, void *udata) { - Tcl_Interp *interp = (Tcl_Interp*)udata; + State *statePtr = (State *) udata; + Tcl_Interp *interp = statePtr->interp; + Tcl_Obj *cmdPtr; + int result; - if (Tcl_Eval(interp, "tls::password") == TCL_OK) { - CONST char *ret = Tcl_GetStringResult(interp); + if (statePtr->password == NULL) { + if (Tcl_Eval(interp, "tls::password") == TCL_OK) { + char *ret = (char *) Tcl_GetStringResult(interp); + strncpy(buf, ret, size); + return strlen(ret); + } else { + return -1; + } + } + + cmdPtr = Tcl_DuplicateObj(statePtr->password); + + Tcl_Preserve((ClientData) statePtr->interp); + Tcl_Preserve((ClientData) statePtr); + + Tcl_IncrRefCount(cmdPtr); + result = Tcl_GlobalEvalObj(interp, cmdPtr); + if (result != TCL_OK) { + Tcl_BackgroundError(statePtr->interp); + } + Tcl_DecrRefCount(cmdPtr); + + Tcl_Release((ClientData) statePtr); + Tcl_Release((ClientData) statePtr->interp); + + if (result == TCL_OK) { + char *ret = (char *) Tcl_GetStringResult(interp); strncpy(buf, ret, size); return strlen(ret); } else { return -1; } @@ -606,10 +638,11 @@ { Tcl_Channel chan; /* The channel to set a mode on. */ State *statePtr; /* client state for ssl socket */ SSL_CTX *ctx = NULL; Tcl_Obj *script = NULL; + Tcl_Obj *password = NULL; int idx; int flags = TLS_TCL_INIT; int server = 0; /* is connection incoming or outgoing? */ char *key = NULL; char *cert = NULL; @@ -655,26 +688,27 @@ char *opt = Tcl_GetStringFromObj(objv[idx], NULL); if (opt[0] != '-') break; - OPTSTR( "-cafile", CAfile); OPTSTR( "-cadir", CAdir); + OPTSTR( "-cafile", CAfile); OPTSTR( "-certfile", cert); OPTSTR( "-cipher", ciphers); OPTOBJ( "-command", script); OPTSTR( "-keyfile", key); OPTSTR( "-model", model); + OPTOBJ( "-password", password); OPTBOOL( "-require", require); OPTBOOL( "-request", request); OPTBOOL( "-server", server); OPTBOOL( "-ssl2", ssl2); OPTBOOL( "-ssl3", ssl3); OPTBOOL( "-tls1", tls1); - OPTBAD( "option", "-cafile, -cadir, -certfile, -cipher, -command, -keyfile, -model, -require, -request, -ssl2, -ssl3, -server, or -tls1"); + OPTBAD( "option", "-cadir, -cafile, -certfile, -cipher, -command, -keyfile, -model, -password, -require, -request, -server, -ssl2, -ssl3, or -tls1"); return TCL_ERROR; } if (request) verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER; if (request && require) verify |= SSL_VERIFY_FAIL_IF_NO_PEER_CERT; @@ -689,37 +723,10 @@ if (key && !*key) key = NULL; if (ciphers && !*ciphers) ciphers = NULL; if (CAfile && !*CAfile) CAfile = NULL; if (CAdir && !*CAdir) CAdir = NULL; - if (model != NULL) { - int mode; - /* Get the "model" context */ - chan = Tcl_GetChannel(interp, model, &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); - ctx = statePtr->ctx; - } else { - if ((ctx = CTX_Init(interp, proto, key, cert, CAdir, CAfile, ciphers)) - == (SSL_CTX*)0) { - return TCL_ERROR; - } - } - /* new SSL state */ statePtr = (State *) Tcl_Alloc((unsigned) sizeof(State)); statePtr->self = (Tcl_Channel)NULL; statePtr->timer = (Tcl_TimerToken)NULL; @@ -727,18 +734,68 @@ statePtr->watchMask = 0; statePtr->mode = 0; statePtr->interp = interp; statePtr->callback = (Tcl_Obj *)0; + statePtr->password = (Tcl_Obj *)0; statePtr->vflags = verify; statePtr->ssl = (SSL*)0; - statePtr->ctx = ctx; + statePtr->ctx = (SSL_CTX*)0; statePtr->bio = (BIO*)0; statePtr->p_bio = (BIO*)0; statePtr->err = ""; + + /* allocate script */ + if (script) { + char *tmp = Tcl_GetStringFromObj(script, NULL); + if (tmp && *tmp) { + statePtr->callback = Tcl_DuplicateObj(script); + Tcl_IncrRefCount(statePtr->callback); + } + } + + /* allocate password */ + if (password) { + char *tmp = Tcl_GetStringFromObj(password, NULL); + if (tmp && *tmp) { + statePtr->password = Tcl_DuplicateObj(password); + Tcl_IncrRefCount(statePtr->password); + } + } + + if (model != NULL) { + int mode; + /* Get the "model" context */ + chan = Tcl_GetChannel(interp, model, &mode); + if (chan == (Tcl_Channel) NULL) { + Tls_Free((char *) statePtr); + 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); + Tls_Free((char *) statePtr); + return TCL_ERROR; + } + ctx = ((State *)Tcl_GetChannelInstanceData(chan))->ctx; + } else { + if ((ctx = CTX_Init(statePtr, proto, key, cert, CAdir, CAfile, ciphers)) + == (SSL_CTX*)0) { + Tls_Free((char *) statePtr); + return TCL_ERROR; + } + } + + statePtr->ctx = ctx; /* * We need to make sure that the channel works in binary (for the * encryption not to get goofed up). * We only want to adjust the buffering in pre-v2 channels, where @@ -763,24 +820,10 @@ */ Tls_Free((char *) statePtr); return TCL_ERROR; } - /* allocate script */ - if (script) { - char *tmp = Tcl_GetStringFromObj(script, NULL); - if (tmp && *tmp) { - statePtr->callback = Tcl_DuplicateObj(script); - Tcl_IncrRefCount(statePtr->callback); - } - } - /* This is only needed because of a bug in OpenSSL, where the - * ssl->verify_callback is not referenced!!! (Must be done - * *before* SSL_new() is called! - */ - SSL_CTX_set_verify(statePtr->ctx, verify, VerifyCallback); - /* * SSL Initialization */ statePtr->ssl = SSL_new(statePtr->ctx); @@ -796,15 +839,11 @@ * SSL Callbacks */ SSL_set_app_data(statePtr->ssl, (VOID *)statePtr); /* point back to us */ - /* - * The following is broken - we need is to set the - * verify_mode, but the library ignores the verify_callback!!! - */ - /*SSL_set_verify(statePtr->ssl, verify, VerifyCallback);*/ + SSL_set_verify(statePtr->ssl, verify, VerifyCallback); SSL_CTX_set_info_callback(statePtr->ctx, InfoCallback); /* Create Tcl_Channel BIO Handler */ statePtr->p_bio = BIO_new_tcl(statePtr, BIO_CLOSE); @@ -840,19 +879,20 @@ * *------------------------------------------------------------------- */ static SSL_CTX * -CTX_Init(interp, proto, key, cert, CAdir, CAfile, ciphers) - Tcl_Interp *interp; +CTX_Init(statePtr, proto, key, cert, CAdir, CAfile, ciphers) + State *statePtr; int proto; char *key; char *cert; char *CAdir; char *CAfile; char *ciphers; { + Tcl_Interp *interp = statePtr->interp; SSL_CTX *ctx = NULL; Tcl_DString ds; Tcl_DString ds1; int off = 0; @@ -897,11 +937,11 @@ /* set some callbacks */ SSL_CTX_set_default_passwd_cb(ctx, PasswordCallback); #ifndef BSAFE - SSL_CTX_set_default_passwd_cb_userdata(ctx, (void *)interp); + SSL_CTX_set_default_passwd_cb_userdata(ctx, (void *)statePtr); #endif #ifndef NO_DH { DH* dh = get_dh512(); @@ -928,10 +968,12 @@ if (key == NULL) key=cert; if (SSL_CTX_use_PrivateKey_file(ctx, F2N( key, &ds), SSL_FILETYPE_PEM) <= 0) { Tcl_DStringFree(&ds); + /* flush the passphrase which might be left in the result */ + Tcl_SetResult(interp, NULL, TCL_STATIC); Tcl_AppendResult(interp, "unable to set public key file ", key, " ", REASON(), (char *) NULL); SSL_CTX_free(ctx); return (SSL_CTX *)0; @@ -1050,11 +1092,12 @@ objPtr = Tls_NewX509Obj(interp, peer); } else { objPtr = Tcl_NewListObj(0, NULL); } - Tcl_ListObjAppendElement (interp, objPtr, Tcl_NewStringObj ("sbits", -1)); + 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) { @@ -1064,10 +1107,38 @@ Tcl_NewStringObj(SSL_get_cipher(statePtr->ssl), -1)); } Tcl_SetObjResult( interp, objPtr); return TCL_OK; } + +/* + *------------------------------------------------------------------- + * + * VersionObjCmd -- return version string from OpenSSL. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *------------------------------------------------------------------- + */ +static int +VersionObjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Not used. */ + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + Tcl_Obj *objPtr; + + objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1); + + Tcl_SetObjResult(interp, objPtr); + return TCL_OK; +} /* *------------------------------------------------------------------- * * Tls_Free -- @@ -1124,14 +1195,22 @@ if (statePtr->ssl) { SSL_shutdown(statePtr->ssl); SSL_free(statePtr->ssl); statePtr->ssl = NULL; + } + if (statePtr->ctx) { + SSL_CTX_free(statePtr->ctx); + statePtr->ctx = NULL; } if (statePtr->callback) { Tcl_DecrRefCount(statePtr->callback); statePtr->callback = NULL; + } + if (statePtr->password) { + Tcl_DecrRefCount(statePtr->password); + statePtr->password = NULL; } } /* *------------------------------------------------------------------- @@ -1221,10 +1300,13 @@ Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd, (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); return Tcl_PkgProvide(interp, PACKAGE, VERSION); } /* Index: tls.htm ================================================================== --- tls.htm +++ tls.htm @@ -1,269 +1,309 @@ - - - - - - - -TLS (SSL) Tcl Commands - - - - -
-
NAME
-
tls - binding to OpenSSL - toolkit.
-
-
-
SYNOPSIS
-
-
package require Tcl ?8.2?
-
package require tls ?1.4?
-
 
-
tls::init ?options?
-
tls::socket ?options? host port
-
tls::socket ?-server command? - ?options? port
-
tls::handshake channel
-
tls::status ?-local? channel
-
tls::import channel ?options?
-
tls::ciphers protocol ?verbose?
-
-
-
COMMANDS
-
CONFIGURATION OPTIONS
-
HTTPS EXAMPLE
-
SPECIAL CONSIDERATIONS
-
SEE ALSO
-
- -
- -

NAME

- -

tls - binding to OpenSSL -toolkit.

- -

SYNOPSIS

- -

package require Tcl 8.2
-package require tls 1.4
-
-tls::init ?options?
-tls::socket ?options? host -port
-tls::socket ?-server command? ?options? port
-tls::status ?-local? channel
-tls::handshake channel
-
-tls::import channel ?options?
-tls::ciphers -protocol ?verbose?

- -

DESCRIPTION

- -

This extension provides a generic binding to OpenSSL, utilizing the -Tcl_StackChannel -API for Tcl 8.2 and higher. The sockets behave exactly the same -as channels created using Tcl's built-in socket -command with additional options for controlling the SSL session. -To use TLS with an earlier version of Tcl than 8.2, please obtain -TLS v1.3. Please note that there are known limitations with the -stacked channel implementation prior to 8.3.2, so it is recommended -that TLS is used with an 8.3.2+ interpreter. TLS v1.4 will work -with 8.2+, it is just more stable with 8.3.2+. -

- -

COMMANDS

- -

Typically one would use the tls::socket command -which provides compatibility with the native Tcl socket -command. In such cases tls::import should not be -used directly.

- -
-
tls::init ?options?
-
This routine sets the default options used by tls::socket - and is optional. If you call tls::import - directly this routine has no effect. Any of the options - that tls::socket accepts can be set - using this command, though you should limit your options - to only TLS related ones.
-
 
-
tls::socket ?options? - host port
-
tls::socket ?-server command? ?options? port
-
This is a helper function that utilizes the underlying - commands (tls::import). It behaves - exactly the same as the native Tcl socket - command except that the options can include any of the - applicable tls:import - options.
-
 
-
tls::handshake channel
-
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 - ?-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. - If -local is given, then the certificate information - is the one used locally.
-
- -
-
-
issuer dn
-
The distinguished name (DN) of the certificate - issuer.
-
subject dn
-
The distinguished name (DN) of the certificate - subject.
-
notBefore date
-
The begin date for the validity of the certificate.
-
notAfter date
-
The expiry date for the certificate.
-
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 - ?options?
-
SSL-enable a regular Tcl channel - it need not be a - socket, but must provide bi-directional flow. Also - setting session parameters for SSL handshake.
-
- -
-
-
-cafile filename
-
Provide the CA file.
-
-cadir dir
-
Provide the directory containing the CA certificates.
-
-certfile filename
-
Provide the certificate to use.
-
-cipher string
-
Provide the cipher suites to use. Syntax is as per - OpenSSL.
-
-command callback
-
This callback is invoked to pass errors, tracing - information and to allow Tcl scripts to perform - additional verification of the certificate, which can - override the default validation in OpenSSL.
-
-keyfile filename
-
Provide the private key file. (default: - value of -certfile)
-
-model channel
-
This will force this channel to share the same SSL_CTX - structure as the specified channel, and - therefore share callbacks etc.
-
-request bool
-
Request a certificate from peer during SSL handshake. - (default: true)
-
-require bool
-
Require a valid certificate from peer during SSL - handshake. If this is set to true then -request - must also be set to true. (default: false)
-
-server bool
-
Handshake as server if true, else handshake as - client.(default: false) [Not - available to tls::socket]
-
-ssl2 bool
-
Enable use of SSL v2. (default: true - unless -DNO_PATENTS was specified in build)
-
-ssl3 bool
-
Enable use of SSL v3. (default: true)
-
-tls1 bool
-
Enable use of TLS v1. (default: false)
-
-
- -
-
tls::ciphers - protocol ?verbose?
-
Returns list of supported ciphers based on the protocol - you supply, which must be one of ssl2, ssl3, or tls1. - If verbose is specified as true then a verbose, - semi-human readable list is returned providing additional - information on the nature of the cipher support. In each - case the result is a Tcl list.
-
- -

CONFIGURATION OPTIONS

- -

In addition to the options listed above you can set the tls::debug -flag to a non-zero value to see the output from the default -command callback (tls::callback) which shows the -progression of the SSL handshake. Setting this value to greated -than 1 will cause the default verify method in tls::callback -to always accept the certificate, even if it is invalid.

- -

In a real-world deployment you should substitute your own -callback in place of tls::callback, via the -command -option to tls::socket or tls::import.

- -

When the TLS layer needs to obtain a password, typically for a -certificate, the software will invoke a Tcl command called tls::password, -which should return a string which represents the password to be -used. A default implementation is provided, which simply returns -"secret" - you should redefine this procedure -after issuing the package require tls.

- -

HTTPS EXAMPLE

- -

This example requires a patch to the http -module that ships with Tcl - this patch has been submitted for -inclusion in Tcl 8.2.1, but is also provided in the tls directory -if needed. A sample server.pem is provided with the TLS release, -courtesy of the OpenSSL project.

- -
package require http
-package require tls
-
-http::register https 443 [list ::tls::socket -require 1 -cafile ./server.pem]
-
-set tok [http::geturl https://developer.netscape.com/]
-
- -

SPECIAL CONSIDERATIONS

- -

The capabilities of this package can vary enormously based -upon how your OpenSSL library was configured and built. At the -most macro-level OpenSSL supports a "no patents" build, -which disables RSA, IDEA, RC(2,4,5) and SSL2 - if your OpenSSL is -configured this way then you will need to build TLS with the --DNO_PATENTS option - and the resultant module will function -correctly and also support ADH certificate-less encryption, -however you will be unable to utilize this to speak to normal Web -Servers, which typically require RSA support. Please see http://www.openssl.org/ for -more information on the whole issue of patents and US export -restrictions.

- -

SEE ALSO

- -

socket, fileevent, OpenSSL

- -
- -
-Copyright © 1999 Matt Newman.
- - + + + + + + + + +TLS (SSL) Tcl Commands + + + + +
+
NAME
+
tls - binding to OpenSSL + toolkit.
+
+
+
SYNOPSIS
+
+
package require Tcl ?8.2?
+
package require tls ?1.4?
+
 
+
tls::init ?options?
+
tls::socket ?options? host port
+
tls::socket ?-server command? + ?options? port
+
tls::handshake channel
+
tls::status ?-local? channel
+
tls::import channel ?options?
+
tls::ciphers protocol ?verbose?
+
tls::version
+
+
+
COMMANDS
+
CALLBACK OPTIONS
+
HTTPS EXAMPLE
+
SPECIAL CONSIDERATIONS
+
SEE ALSO
+
+ +
+ +

NAME

+ +

tls - binding to OpenSSL +toolkit.

+ +

SYNOPSIS

+ +

package require Tcl 8.2
+package require tls 1.4
+
+tls::init ?options?
+tls::socket ?options? host +port
+tls::socket ?-server command? ?options? port
+tls::status ?-local? channel
+tls::handshake channel
+
+tls::import channel ?options?
+tls::ciphers +protocol ?verbose?
+tls::version +

+ +

DESCRIPTION

+ +

This extension provides a generic binding to OpenSSL, utilizing the +Tcl_StackChannel +API for Tcl 8.2 and higher. The sockets behave exactly the same +as channels created using Tcl's built-in socket +command with additional options for controlling the SSL session. +To use TLS with an earlier version of Tcl than 8.2, please obtain +TLS v1.3. Please note that there are known limitations with the +stacked channel implementation prior to 8.3.2, so it is recommended +that TLS is used with an 8.3.2+ interpreter. TLS v1.4 will work +with 8.2+, it is just more stable with 8.3.2+. +

+ +

COMMANDS

+ +

Typically one would use the tls::socket command +which provides compatibility with the native Tcl socket +command. In such cases tls::import should not be +used directly.

+ +
+
tls::init ?options?
+
This routine sets the default options used by tls::socket + and is optional. If you call tls::import + directly this routine has no effect. Any of the options + that tls::socket accepts can be set + using this command, though you should limit your options + to only TLS related ones.
+
 
+
tls::socket ?options? + host port
+
tls::socket ?-server command? ?options? port
+
This is a helper function that utilizes the underlying + commands (tls::import). It behaves + exactly the same as the native Tcl socket + command except that the options can include any of the + applicable tls:import + options.
+
 
+
tls::handshake channel
+
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 + ?-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. + If -local is given, then the certificate information + is the one used locally.
+
+ +
+
+
issuer dn
+
The distinguished name (DN) of the certificate + issuer.
+
subject dn
+
The distinguished name (DN) of the certificate + subject.
+
notBefore date
+
The begin date for the validity of the certificate.
+
notAfter date
+
The expiry date for the certificate.
+
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 + ?options?
+
SSL-enable a regular Tcl channel - it need not be a + socket, but must provide bi-directional flow. Also + setting session parameters for SSL handshake.
+
+ +
+
+
-cadir dir
+
Provide the directory containing the CA certificates.
+
-cafile filename
+
Provide the CA file.
+
-certfile filename
+
Provide the certificate to use.
+
-cipher string
+
Provide the cipher suites to use. Syntax is as per + OpenSSL.
+
-command callback
+
If specified, this callback will be invoked at several points + during the OpenSSL handshake. It can pass errors and tracing + information, and it can allow Tcl scripts to perform + their own validation of the certificate in place of the + default validation provided by OpenSSL. + The callback should return an integer whose interpretation + depends on context. +
+ See CALLBACK OPTIONS for + further discussion.
+
-keyfile filename
+
Provide the private key file. (default: + value of -certfile)
+
-model channel
+
This will force this channel to share the same SSL_CTX + structure as the specified channel, and + therefore share callbacks etc.
+
-password callback
+
If supplied, this callback will be invoked when OpenSSL needs + to obtain a password, typically for a certificate. + The callback should return a string which represents the + password to be used. +
+ See CALLBACK OPTIONS for + further discussion.
+
-request bool
+
Request a certificate from peer during SSL handshake. + (default: true)
+
-require bool
+
Require a valid certificate from peer during SSL + handshake. If this is set to true then -request + must also be set to true. (default: false)
+
-server bool
+
Handshake as server if true, else handshake as + client.(default: false)
+
-ssl2 bool
+
Enable use of SSL v2. (default: true + unless -DNO_PATENTS was specified in build)
+
-ssl3 bool
+
Enable use of SSL v3. (default: true)
+
-tls1 bool
+
Enable use of TLS v1. (default: false)
+
+
+ +
+
tls::ciphers + protocol ?verbose?
+
Returns list of supported ciphers based on the protocol + you supply, which must be one of ssl2, ssl3, or tls1. + If verbose is specified as true then a verbose, + semi-human readable list is returned providing additional + information on the nature of the cipher support. In each + case the result is a Tcl list.
+
+ +
+
tls::version
+
Returns the version string defined by OpenSSL.
+
+ +

CALLBACK OPTIONS

+ +

+As indicated above, individual channels can be given their own callbacks +to handle intermediate processing by the OpenSSL library, using the +-command and -password options passed to either of +tls::socket or tls::import. +

+ +

+Reference implementations of these callbacks are provided in the distribution +as tls::callback and tls::password. +Note that these are sample implementations only. In a more realistic +deployment you would substitute your own callbacks, typically by configuring +the -command and -password options on each channel with +scripts to be executed when the callbacks are invoked. +

+ +

+The default behavior when the -command option is not specified is for +TLS to process the associated library callbacks internally. +The default behavior when the -password option is not specified is for +TLS to process the associated library callbacks by attempting to call +tls::password. +The difference between these two behaviors is a consequence of maintaining +compatibility with earlier implementations. The use of implied callbacks +is not recommended. +

+ +

+The tls::debug variable provides some additional control +over the default commands. Its value is zero by default. Higher values +produce more diagnostic output. Setting this value greater than zero +will also force the default verify method in tls::callback +to accept the certificate, even if it is invalid. +

+ +

HTTPS EXAMPLE

+ +

This example requires a patch to the http +module that ships with Tcl - this patch has been submitted for +inclusion in Tcl 8.2.1, but is also provided in the tls directory +if needed. A sample server.pem is provided with the TLS release, +courtesy of the OpenSSL project.

+ +
package require http
+package require tls
+
+http::register https 443 [list ::tls::socket -require 1 -cafile ./server.pem]
+
+set tok [http::geturl https://developer.netscape.com/]
+
+ +

SPECIAL CONSIDERATIONS

+ +

The capabilities of this package can vary enormously based +upon how your OpenSSL library was configured and built. At the +most macro-level OpenSSL supports a "no patents" build, +which disables RSA, IDEA, RC(2,4,5) and SSL2 - if your OpenSSL is +configured this way then you will need to build TLS with the +-DNO_PATENTS option - and the resultant module will function +correctly and also support ADH certificate-less encryption, +however you will be unable to utilize this to speak to normal Web +Servers, which typically require RSA support. Please see http://www.openssl.org/ for +more information on the whole issue of patents and US export +restrictions.

+ +

SEE ALSO

+ +

socket, fileevent, OpenSSL

+ +
+ +
+Copyright © 1999 Matt Newman.
+
+ + Index: tls.tcl ================================================================== --- tls.tcl +++ tls.tcl @@ -1,9 +1,9 @@ # # Copyright (C) 1997-2000 Matt Newman # -# $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.tcl,v 1.3 2000/07/27 01:58:18 hobbs Exp $ +# $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.tcl,v 1.4 2003/05/15 20:44:46 razzell Exp $ # namespace eval tls { variable logcmd tclLog variable debug 0 @@ -32,33 +32,34 @@ set server 1 set callback [lindex $args [expr {$idx+1}]] set args [lreplace $args $idx [expr {$idx+1}]] set usage "wrong # args: should be \"tls::socket -server command ?options? port\"" - set options "-cadir, -cafile, -certfile, -cipher, -keyfile, -myaddr, -request, -require, -ssl2, -ssl3, or -tls1" + set options "-cadir, -cafile, -certfile, -cipher, -command, -keyfile, -myaddr, -password, -request, -require, -ssl2, -ssl3, or -tls1" } else { set server 0 set usage "wrong # args: should be \"tls::socket ?options? host port\"" - set options "-async, -cadir, -cafile, -certfile, -cipher, -keyfile, -myaddr, -myport, -request, -require, -ssl2, -ssl3, or -tls1" + set options "-async, -cadir, -cafile, -certfile, -cipher, -command, -keyfile, -myaddr, -myport, -password, -request, -require, -ssl2, -ssl3, or -tls1" } set argc [llength $args] set sopts {} set iopts [concat [list -server $server] ${tls::defaults}] ;# Import options for {set idx 0} {$idx < $argc} {incr idx} { set arg [lindex $args $idx] switch -glob -- $server,$arg { - 0,-myport - - *,-myaddr {lappend sopts $arg [lindex $args [incr idx]]} 0,-async {lappend sopts $arg} - *,-cipher - + 0,-myaddr - + *,-myport {lappend sopts $arg [lindex $args [incr idx]]} *,-cadir - *,-cafile - *,-certfile - - *,-keyfile - + *,-cipher - *,-command - + *,-keyfile - + *,-password - *,-request - *,-require - *,-ssl2 - *,-ssl3 - *,-tls1 {lappend iopts $arg [lindex $args [incr idx]]} @@ -135,13 +136,12 @@ } # # Sample callback for hooking: - # # error -# info -# password # verify +# info # proc tls::callback {option args} { variable debug #log 2 [concat $option $args] @@ -204,15 +204,17 @@ if {$cb(handshake) == "done"} { return 1 } } } + proc tls::password {} { log 0 "TLS/Password: did you forget to set your passwd!" # Return the worlds best kept secret password. return "secret" } + proc tls::log {level msg} { variable debug variable logcmd if {$level > $debug || $logcmd == ""} { Index: tlsInt.h ================================================================== --- tlsInt.h +++ tlsInt.h @@ -1,9 +1,9 @@ /* * Copyright (C) 1997-2000 Matt Newman * - * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsInt.h,v 1.8 2000/08/18 19:17:14 hobbs Exp $ + * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsInt.h,v 1.9 2003/05/15 20:44:46 razzell 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 @@ -93,10 +93,11 @@ int watchMask; /* current WatchProc mask */ int mode; /* current mode of parent channel */ Tcl_Interp *interp; /* interpreter in which this resides */ Tcl_Obj *callback; /* script called for tracing, verifying and errors */ + Tcl_Obj *password; /* script called for certificate password */ int vflags; /* verify flags */ SSL *ssl; /* Struct for SSL processing */ SSL_CTX *ctx; /* SSL Context */ BIO *bio; /* Struct for SSL processing */