Index: ChangeLog ================================================================== --- ChangeLog +++ ChangeLog @@ -30,21 +30,21 @@ * win/makefile.vc: * configure: regen with ac-2.59 * tls.c (MiscObjCmd): Fixed non-static string array used in call of Tcl_GetIndexFromObj(). Memory smash waiting to happen. Thanks - to Brian Griffin for alerting us all to the problem. + to Brian Griffin for alerting us all to the problem. 2012-06-01 Andreas Kupries * tls.c: Applied Jeff's patch from http://www.mail-archive.com/aolserver@listserv.aol.com/msg12356.html * configure.in: Bump to version 1.6.2. * win/makefile.vc: * configure: regen with ac-2.59 - + 2010-08-11 Jeff Hobbs *** TLS 1.6.1 TAGGED *** * configure: regen with ac-2.59 @@ -108,11 +108,11 @@ * win/makefile.vc: with MSVC8 * win/rules.vc: 2007-06-22 Jeff Hobbs - * tlsIO.c (TlsInputProc, TlsOutputProc, TlsWatchProc): + * tlsIO.c (TlsInputProc, TlsOutputProc, TlsWatchProc): * tls.c (VerifyCallback): add an state flag in the verify callback that prevents possibly recursion (on 'update'). [Bug 1652380] * tests/ciphers.test: reworked to make test output cleaner to understand missing ciphers (if any) @@ -120,11 +120,11 @@ * Makefile.in, tclconfig/tcl.m4: update to TEA 3.6 * configure, configure.in: using autoconf-2.59 2007-02-28 Pat Thoyts - * win/makefile.vc: Rebase the DLL sensibly. Additional libs for + * win/makefile.vc: Rebase the DLL sensibly. Additional libs for static link of openssl. * tls.tcl: bug #1579837 - TIP 278 bug (possibly) - fixed. 2006-03-30 Pat Thoyts @@ -142,19 +142,19 @@ build directory. 2004-12-22 Pat Thoyts * configure.in: Incremented minor version to 1.5.1 - * configure: + * configure: 2004-12-17 Pat Thoyts * win/makefile.vc: Added the MSVC build system (from the Tcl * win/rules.vc: sampleextension). * win/nmakehlp.c: * win/tls.rc Added Windows resource file. - + * tls.tcl: From patch #948155, added support for alternate socket commands. * tls.c: Quieten some MSVC warnings. Prefer ckalloc over Tcl_Alloc. (David Graveraux). @@ -187,11 +187,11 @@ * tclconfig/README.txt, tclconfig/install-sh, tclconfig/tcl.m4: 2004-03-17 Dan Razzell * tlsX509.c: Add support for long serial numbers per RFC 3280. - Format is now hexadecimal. + Format is now hexadecimal. [Request #915313] Correctly convert certificate Distinguished Names to Tcl string representation. Eliminates use of deprecated OpenSSL function. Format is now compliant with RFC 2253. [Request #915315] @@ -238,11 +238,11 @@ * tls.c (Tls_Init): added tls::misc command provided by * tlsX509.c: Wojciech Kocjan (wojciech kocjan.org) * tests/keytest1.tcl: to expose more low-level SSL commands * tests/keytest2.tcl: -2003-05-15 Dan Razzell +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 @@ -377,11 +377,11 @@ loaded into. TLS will fail the test suite with Tcl 8.2-8.3.1. * tests/all.tcl: added catch around ::tcltest::normalizePath because it doesn't exist in pre-8.3 tcltest. - * tests/simpleClient.tcl: + * tests/simpleClient.tcl: * tests/simpleServer.tcl: added simple client/server test scripts that use test certs and can do simple stress tests. 2000-08-14 Jeff Hobbs @@ -480,11 +480,11 @@ 2000-06-05 Scott Stanton * Makefile.in: Fixed broken test target. - * tlsInt.h: + * tlsInt.h: * tls.c: Cleaned up declarations of Tls_Clean to avoid errors on Windows (lint). 2000-06-05 Brent Welch Index: aclocal/shobj.m4 ================================================================== --- aclocal/shobj.m4 +++ aclocal/shobj.m4 @@ -226,11 +226,11 @@ AC_DEFUN([SHOBJ_DO_STATIC_LINK_LIB], [ ifelse($3, [], [ define([VAR_TO_UPDATE], [LIBS]) ], [ define([VAR_TO_UPDATE], [$3]) - ]) + ]) AC_MSG_CHECKING([for how to statically link to $1]) trylink_ADD_LDFLAGS='' Index: build/makearch.info ================================================================== --- build/makearch.info +++ build/makearch.info @@ -1,9 +1,9 @@ # This is the name of the utility, it will be prefixed to the tarball name UTIL="tcltls" -# This is the name of output files that should exist after configure +# This is the name of output files that should exist after configure # procedures. BINS="tcltls.so" # This lists the name of files that are required to exist REQS="" Index: license.terms ================================================================== --- license.terms +++ license.terms @@ -25,14 +25,14 @@ NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. GOVERNMENT USE: If you are acquiring this software on behalf of the U.S. government, the Government shall have only "Restricted Rights" -in the software and related documentation as defined in the Federal +in the software and related documentation as defined in the Federal Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you are acquiring the software on behalf of the Department of Defense, the software shall be classified as "Commercial Computer Software" and the Government shall have only "Restricted Rights" as defined in Clause 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the authors grant the U.S. Government and others acting in its behalf permission to use and distribute the software in accordance with the -terms specified in this license. +terms specified in this license. Index: pkgIndex.tcl.in ================================================================== --- pkgIndex.tcl.in +++ pkgIndex.tcl.in @@ -1,6 +1,6 @@ -if {[package vsatisfies [package present Tcl] 8.5-]} { +if {[package vsatisfies [package present Tcl] 8.6-]} { package ifneeded tls @PACKAGE_VERSION@ [list apply {{dir} { if {{@TCLEXT_BUILD@} eq "static"} { load {} Tls } else { load [file join $dir @EXTENSION_TARGET@] Tls @@ -9,8 +9,6 @@ set tlsTclInitScript [file join $dir tls.tcl] if {[file exists $tlsTclInitScript]} { source $tlsTclInitScript } }} $dir] -} elseif {[package vsatisfies [package present Tcl] 8.4]} { - package ifneeded tls @PACKAGE_VERSION@ [list load [file join $dir @EXTENSION_TARGET@] Tls] } Index: tclOpts.h ================================================================== --- tclOpts.h +++ tclOpts.h @@ -24,11 +24,11 @@ var = objv[idx]; \ OPT_POSTLOG() #define OPTSTR(option, var) \ OPT_PROLOG(option) \ - var = Tcl_GetStringFromObj(objv[idx], (Tcl_Size *)NULL);\ + var = Tcl_GetString(objv[idx]);\ OPT_POSTLOG() #define OPTINT(option, var) \ OPT_PROLOG(option) \ if (Tcl_GetIntFromObj(interp, objv[idx], \ Index: tests/all.tcl ================================================================== --- tests/all.tcl +++ tests/all.tcl @@ -4,21 +4,20 @@ # tests. Execute it by invoking "source all.test" when running tcltest # in this directory. # # Copyright (c) 1998-2000 by Ajuba Solutions. # All rights reserved. -# +# # RCS: @(#) $Id: all.tcl,v 1.5 2000/08/15 18:45:01 hobbs Exp $ #set auto_path [linsert $auto_path 0 [file normalize [file join [file dirname [info script]] ..]]] set auto_path [linsert $auto_path 0 [file normalize [pwd]]] if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import ::tcltest::* } - set ::tcltest::testSingleFile false set ::tcltest::testsDirectory [file dir [info script]] # We should ensure that the testsDirectory is absolute. Index: tests/oldTests/server.pem ================================================================== --- tests/oldTests/server.pem +++ tests/oldTests/server.pem @@ -269,11 +269,11 @@ cmlzYmFuZTEaMBgGA1UEChMRQ3J5cHRTb2Z0IFB0eSBMdGQxFDASBgNVBAsTC2Rl dmVsb3BtZW50MRkwFwYDVQQDExBDcnlwdFNvZnQgRGV2IENBMFwwDQYJKoZIhvcN AQEBBQADSwAwSAJBAOAOAqogG5QwAmLhzyO4CoRnx/wVy4NZP4dxJy83O1EnL0rw OdsamJKvPOLHgSXo3gDu9uVyvCf/QJmZAmC5ml8CAwEAATANBgkqhkiG9w0BAQQF AANBADRRS/GVdd7rAqRW6SdmgLJduOU2yq3avBu99kRqbp9A/dLu6r6jU+eP4oOA -TfdbFZtAAD2Hx9jUtY3tfdrJOb8= +TfdbFZtAAD2Hx9jUtY3tfdrJOb8= -----END CERTIFICATE----- -----BEGIN CERTIFICATE----- MIICVjCCAgACAQAwDQYJKoZIhvcNAQEEBQAwgbUxCzAJBgNVBAYTAkFVMRMwEQYD VQQIEwpRdWVlbnNsYW5kMREwDwYDVQQHEwhCcmlzYmFuZTEaMBgGA1UEChMRQ3J5 Index: tests/oldTests/tlsHttp.tcl ================================================================== --- tests/oldTests/tlsHttp.tcl +++ tests/oldTests/tlsHttp.tcl @@ -10,11 +10,11 @@ # # Initialize context # #tls::init -certfile client.pem -cafile server.pem -ssl2 1 -ssl3 1 -tls1 0 ;#-cipher RC4-MD5 -tls::init -cafile server.pem +tls::init -cafile server.pem # # Register with http module # http::register https 443 [list ::tls::socket -require 1] Index: tests/oldTests/tlsSrv.tcl ================================================================== --- tests/oldTests/tlsSrv.tcl +++ tests/oldTests/tlsSrv.tcl @@ -17,11 +17,11 @@ if {[catch {read $chan 1024} data]} { puts stderr "EOF ($data)" catch {close $chan} return } - + if {$verbose && $data != ""} { puts -nonewline stderr $data } if {[eof $chan]} { ;# client gone or finished puts stderr "EOF" @@ -42,13 +42,13 @@ puts [tls::status $chan] fconfigure $chan -buffering none -blocking 0 fileevent $chan readable [list reflectCB $chan 1] } -#tls::init -cafile server.pem -certfile server.pem +#tls::init -cafile server.pem -certfile server.pem tls::init -cafile server.pem -#tls::init +#tls::init set chan [tls::socket -server acceptCB \ -request 1 -require 0 1234] # -require 1 -command tls::callback 1234] Index: tests/oldTests/tlsSrv2.tcl ================================================================== --- tests/oldTests/tlsSrv2.tcl +++ tests/oldTests/tlsSrv2.tcl @@ -16,11 +16,11 @@ if {[catch {read $chan 1024} data]} { puts stderr "EOF ($data)" catch {close $chan} return } - + if {$verbose && $data != ""} { puts -nonewline stderr $data } if {[eof $chan]} { ;# client gone or finished puts stderr "EOF" Index: tests/tlsIO.test ================================================================== --- tests/tlsIO.test +++ tests/tlsIO.test @@ -3,59 +3,59 @@ # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1994-1996 Sun Microsystems, Inc. -# Copyright (c) 1998-2000 Ajuba Solutions. +# Copyright (c) 1998-2000 Ajuba Solutions. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: tlsIO.test,v 1.24 2015/06/06 09:07:08 apnadkarni Exp $ # Running socket tests with a remote server: # ------------------------------------------ -# +# # Some tests in socket.test depend on the existence of a remote server to # which they connect. The remote server must be an instance of tcltest and it # must run the script found in the file "remote.tcl" in this directory. You # can start the remote server on any machine reachable from the machine on # which you want to run the socket tests, by issuing: -# +# # tcltest remote.tcl -port 8048 # Or choose another port number. -# +# # If the machine you are running the remote server on has several IP # interfaces, you can choose which interface the server listens on for # connections by specifying the -address command line flag, so: -# +# # tcltest remote.tcl -address your.machine.com -# +# # These options can also be set by environment variables. On Unix, you can # type these commands to the shell from which the remote server is started: -# +# # shell% setenv serverPort 8048 # shell% setenv serverAddress your.machine.com -# +# # and subsequently you can start the remote server with: -# +# # tcltest remote.tcl -# +# # to have it listen on port 8048 on the interface your.machine.com. -# +# # When the server starts, it prints out a detailed message containing its # configuration information, and it will block until killed with a Ctrl-C. # Once the remote server exists, you can run the tests in socket.test with # the server by setting two Tcl variables: -# +# # % set remoteServerIP # % set remoteServerPort 8048 -# +# # These variables are also settable from the environment. On Unix, you can: -# +# # shell% setenv remoteServerIP machine.where.server.runs # shell% setenv remoteServerPort 8048 -# +# # The preamble of the socket.test file checks to see if the variables are set # either in Tcl or in the environment; if they are, it attempts to connect to # the server. If the connection is successful, the tests using the remote # server will be performed; otherwise, it will attempt to start the remote # server (via exec) on platforms that support this, on the local host, @@ -566,11 +566,11 @@ set l [gets $s] if {[eof $s]} { global x close $s set x done - } else { + } else { incr i puts $s $l } } set i 0 @@ -1228,11 +1228,11 @@ proc timerproc {} { global done count c set done true set count {timer went off, eof is not sticky} close $c - } + } set count 0 set done false proc write_then_close {s} { puts $s bye close $s @@ -1463,11 +1463,11 @@ close $s1 close $s2 close $s3 sendCommand {close $socket10_9_test_server} set i -} 100 +} 100 test tlsIO-11.8 {client with several servers} {socket doTestsWithRemoteServer} { sendCertValues sendCommand { tls::init -certfile $serverCert -cafile $caCert -keyfile $serverKey @@ -1940,11 +1940,11 @@ set l [gets $s] if {[eof $s]} { global x close $s set x done - } else { + } else { incr i puts $s $l } } set i 0 @@ -1952,15 +1952,15 @@ close $f # thread cleans itself up. testthread exit } script - + # create a thread set serverthread [testthread create { source script } ] update - + after 1000 set s [tls::socket 127.0.0.1 8828] fconfigure $s -buffering line catch { @@ -1970,11 +1970,11 @@ close $s update after 2000 lappend result [threadReap] - + set result } {hello 1} test tlsIO-14.1 {test tls::unimport} {socket} { @@ -2030,16 +2030,16 @@ # Following code is based on what was reported in bug #58. Prior # to fix the program would crash with a segfault. proc Accept {sock args} { fconfigure $sock -blocking 0; fileevent $sock readable [list Handshake $sock] - } + } proc Handshake {sock} { set ::done HAND catch {tls::handshake $sock} msg set ::done $msg - } + } # NOTE: when doing an in-process client/server test, both sides need # to be non-blocking for the TLS handshake # Server - Only accept TLS 1.2 set s [tls::socket \ Index: tls.c ================================================================== --- tls.c +++ tls.c @@ -1,11 +1,11 @@ /* * Copyright (C) 1997-1999 Matt Newman * some modifications: * Copyright (C) 2000 Ajuba Solutions * Copyright (C) 2002 ActiveState Corporation - * Copyright (C) 2004 Starfish Systems + * Copyright (C) 2004 Starfish Systems * * 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 @@ -23,14 +23,10 @@ #include "tlsInt.h" #include "tclOpts.h" #include -#if TCL_MAJOR_VERSION < 9 - typedef int Tcl_Size; -#endif - /* * External functions */ /* @@ -42,30 +38,17 @@ Tcl_TranslateFileName(interp, (key), (dsp))) #define REASON() ERR_reason_error_string(ERR_get_error()) static void InfoCallback(const SSL *ssl, int where, int ret); -static int CiphersObjCmd(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(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(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(ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static Tcl_ObjCmdProc CiphersObjCmd; +static Tcl_ObjCmdProc HandshakeObjCmd; +static Tcl_ObjCmdProc ImportObjCmd; +static Tcl_ObjCmdProc StatusObjCmd; +static Tcl_ObjCmdProc VersionObjCmd; +static Tcl_ObjCmdProc MiscObjCmd; +static Tcl_ObjCmdProc UnimportObjCmd; static SSL_CTX *CTX_Init(State *statePtr, int isServer, int proto, char *key, char *certfile, unsigned char *key_asn1, unsigned char *cert_asn1, int key_asn1_len, int cert_asn1_len, char *CAdir, char *CAfile, char *ciphers, char *DHparams); @@ -177,11 +160,11 @@ static void InfoCallback(const SSL *ssl, int where, int ret) { State *statePtr = (State*)SSL_get_app_data((SSL *)ssl); Tcl_Obj *cmdPtr; - char *major; char *minor; + const char *major, *minor; dprintf("Called"); if (statePtr->callback == (Tcl_Obj*)NULL) return; @@ -214,14 +197,14 @@ 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_ListObjAppendElement( statePtr->interp, cmdPtr, Tcl_NewStringObj( "info", -1)); - Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, + Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, Tcl_NewStringObj( Tcl_GetChannelName(statePtr->self), -1) ); Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, Tcl_NewStringObj( major, -1) ); @@ -299,14 +282,14 @@ return 1; } } cmdPtr = Tcl_DuplicateObj(statePtr->callback); - Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, + Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, Tcl_NewStringObj( "verify", -1)); - Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, + Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, Tcl_NewStringObj( Tcl_GetChannelName(statePtr->self), -1) ); Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, Tcl_NewIntObj( depth) ); @@ -385,14 +368,14 @@ Tcl_BackgroundError( statePtr->interp); return; } cmdPtr = Tcl_DuplicateObj(statePtr->callback); - Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, + Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj("error", -1)); - Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, + Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1)); Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj(msg, -1)); @@ -410,11 +393,11 @@ } /* *------------------------------------------------------------------- * - * PasswordCallback -- + * PasswordCallback -- * * 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. *------------------------------------------------------------------- @@ -495,15 +478,15 @@ * constructs and destroys SSL context (CTX) * *------------------------------------------------------------------- */ static int -CiphersObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; - int objc; - Tcl_Obj *const objv[]; +CiphersObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) { static const char *protocols[] = { "ssl2", "ssl3", "tls1", "tls1.1", "tls1.2", "tls1.3", NULL }; enum protocol { @@ -599,11 +582,11 @@ } } else { sk = SSL_get_ciphers(ssl); for (index = 0; index < sk_SSL_CIPHER_num(sk); index++) { - register size_t i; + size_t i; SSL_CIPHER_description( sk_SSL_CIPHER_value( sk, index), buf, sizeof(buf)); for (i = strlen(buf) - 1; i ; i--) { if (buf[i] == ' ' || buf[i] == '\n' || buf[i] == '\r' || buf[i] == '\t') { @@ -619,11 +602,10 @@ SSL_free(ssl); SSL_CTX_free(ctx); Tcl_SetObjResult( interp, objPtr); return TCL_OK; - clientData = clientData; } /* *------------------------------------------------------------------- * @@ -639,11 +621,16 @@ * May force SSL negotiation to take place. * *------------------------------------------------------------------- */ -static int HandshakeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { +static int HandshakeObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ Tcl_Channel chan; /* The channel to set a mode on. */ State *statePtr; /* client state for ssl socket */ const char *errStr = NULL; int ret = 1; int err = 0; @@ -701,12 +688,10 @@ } dprintf("Returning TCL_OK with data \"%i\"", ret); Tcl_SetObjResult(interp, Tcl_NewIntObj(ret)); return(TCL_OK); - - clientData = clientData; } /* *------------------------------------------------------------------- * @@ -724,31 +709,32 @@ * *------------------------------------------------------------------- */ static int -ImportObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; - int objc; - Tcl_Obj *const objv[]; +ImportObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) { 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; Tcl_DString upperChannelTranslation, upperChannelBlocking, upperChannelEncoding, upperChannelEOFChar; - int idx, len; + int idx; + Tcl_Size len; int flags = TLS_TCL_INIT; int server = 0; /* is connection incoming or outgoing? */ char *keyfile = NULL; char *certfile = NULL; unsigned char *key = NULL; - int key_len = 0; - unsigned char *cert = NULL; - int cert_len = 0; + Tcl_Size key_len = 0; + unsigned char *cert = NULL; + Tcl_Size cert_len = 0; char *ciphers = NULL; char *CAfile = NULL; char *CAdir = NULL; char *DHparams = NULL; char *model = NULL; @@ -821,13 +807,13 @@ OPTBOOL( "-ssl2", ssl2); OPTBOOL( "-ssl3", ssl3); OPTBOOL( "-tls1", tls1); OPTBOOL( "-tls1.1", tls1_1); OPTBOOL( "-tls1.2", tls1_2); - OPTBOOL( "-tls1.3", tls1_3); - OPTBYTE("-cert", cert, cert_len); - OPTBYTE("-key", key, key_len); + OPTBOOL( "-tls1.3", tls1_3) + OPTBYTE("-cert", cert, cert_len); + OPTBYTE("-key", key, key_len); OPTBAD( "option", "-cadir, -cafile, -cert, -certfile, -cipher, -command, -dhparams, -key, -keyfile, -model, -password, -require, -request, -server, -servername, -ssl2, -ssl3, -tls1, -tls1.1, -tls1.2, or tls1.3"); return TCL_ERROR; } @@ -882,11 +868,11 @@ if (model != NULL) { int mode; /* Get the "model" context */ chan = Tcl_GetChannel(interp, model, &mode); if (chan == (Tcl_Channel) NULL) { - Tls_Free((char *) statePtr); + Tls_Free((void *)statePtr); return TCL_ERROR; } /* * Make sure to operate on the topmost channel @@ -893,19 +879,19 @@ */ 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); + Tls_Free((void *)statePtr); return TCL_ERROR; } ctx = ((State *)Tcl_GetChannelInstanceData(chan))->ctx; } else { if ((ctx = CTX_Init(statePtr, server, proto, keyfile, certfile, key, cert, key_len, cert_len, CAdir, CAfile, ciphers, DHparams)) == (SSL_CTX*)0) { - Tls_Free((char *) statePtr); + Tls_Free((void *)statePtr); return TCL_ERROR; } } statePtr->ctx = ctx; @@ -925,17 +911,17 @@ Tcl_GetChannelOption(interp, chan, "-translation", &upperChannelTranslation); Tcl_GetChannelOption(interp, chan, "-blocking", &upperChannelBlocking); Tcl_SetChannelOption(interp, chan, "-translation", "binary"); Tcl_SetChannelOption(interp, chan, "-blocking", "true"); dprintf("Consuming Tcl channel %s", Tcl_GetChannelName(chan)); - statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(), (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE), chan); + statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(), statePtr, (TCL_READABLE | TCL_WRITABLE), chan); dprintf("Created channel named %s", Tcl_GetChannelName(statePtr->self)); if (statePtr->self == (Tcl_Channel) NULL) { /* * No use of Tcl_EventuallyFree because no possible Tcl_Preserve. */ - Tls_Free((char *) statePtr); + Tls_Free((void *)statePtr); return TCL_ERROR; } Tcl_SetChannelOption(interp, statePtr->self, "-translation", Tcl_DStringValue(&upperChannelTranslation)); Tcl_SetChannelOption(interp, statePtr->self, "-encoding", Tcl_DStringValue(&upperChannelEncoding)); @@ -949,20 +935,20 @@ statePtr->ssl = SSL_new(statePtr->ctx); if (!statePtr->ssl) { /* SSL library error */ Tcl_AppendResult(interp, "couldn't construct ssl session: ", REASON(), (char *) NULL); - Tls_Free((char *) statePtr); + Tls_Free((void *)statePtr); return TCL_ERROR; } #ifndef OPENSSL_NO_TLSEXT if (servername) { if (!SSL_set_tlsext_host_name(statePtr->ssl, servername) && require) { Tcl_AppendResult(interp, "setting TLS host name extension failed", (char *) NULL); - Tls_Free((char *) statePtr); + Tls_Free((void *)statePtr); return TCL_ERROR; } } #endif @@ -994,11 +980,10 @@ */ dprintf("Returning %s", Tcl_GetChannelName(statePtr->self)); Tcl_SetResult(interp, (char *) Tcl_GetChannelName(statePtr->self), TCL_VOLATILE); return TCL_OK; - clientData = clientData; } /* *------------------------------------------------------------------- * @@ -1014,15 +999,15 @@ * *------------------------------------------------------------------- */ static int -UnimportObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; - int objc; - Tcl_Obj *const objv[]; +UnimportObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) { Tcl_Channel chan; /* The channel to set a mode on. */ dprintf("Called"); @@ -1050,11 +1035,10 @@ if (Tcl_UnstackChannel(interp, chan) == TCL_ERROR) { return TCL_ERROR; } return TCL_OK; - clientData = clientData; } /* *------------------------------------------------------------------- * @@ -1068,25 +1052,24 @@ * *------------------------------------------------------------------- */ static SSL_CTX * -CTX_Init(statePtr, isServer, proto, keyfile, certfile, key, cert, - key_len, cert_len, CAdir, CAfile, ciphers, DHparams) - State *statePtr; - int isServer; - int proto; - char *keyfile; - char *certfile; - unsigned char *key; - unsigned char *cert; - int key_len; - int cert_len; - char *CAdir; - char *CAfile; - char *ciphers; - char *DHparams; +CTX_Init( + State *statePtr, + TCL_UNUSED(int) /* isServer */, + int proto, + char *keyfile, + char *certfile, + unsigned char *key, + unsigned char *cert, + int key_len, + int cert_len, + char *CAdir, + char *CAfile, + char *ciphers, + char *DHparams) { Tcl_Interp *interp = statePtr->interp; SSL_CTX *ctx = NULL; Tcl_DString ds; Tcl_DString ds1; @@ -1199,11 +1182,11 @@ #if !defined(NO_TLS1_3) off |= (ENABLED(proto, TLS_PROTO_TLS1_3) ? 0 : SSL_OP_NO_TLSv1_3); #endif break; } - + ctx = SSL_CTX_new (method); if (!ctx) { return(NULL); } @@ -1212,11 +1195,11 @@ if (proto == TLS_PROTO_TLS1_3) { SSL_CTX_set_min_proto_version (ctx, TLS1_3_VERSION); SSL_CTX_set_max_proto_version (ctx, TLS1_3_VERSION); } #endif - + SSL_CTX_set_app_data( ctx, (void*)interp); /* remember the interpreter */ SSL_CTX_set_options( ctx, SSL_OP_ALL); /* all SSL bug workarounds */ SSL_CTX_set_options( ctx, off); /* all SSL bug workarounds */ SSL_CTX_sess_set_cache_size( ctx, 128); @@ -1250,11 +1233,11 @@ Tcl_AppendResult(interp, "Could not find DH parameters file", (char *) NULL); SSL_CTX_free(ctx); return (SSL_CTX *)0; } - + dh = PEM_read_bio_DHparams(bio, NULL, NULL, NULL); BIO_free(bio); Tcl_DStringFree(&ds); if (!dh) { Tcl_AppendResult(interp, @@ -1377,11 +1360,11 @@ /* https://sourceforge.net/p/tls/bugs/57/ */ /* XXX:TODO: Let the user supply values here instead of something that exists on the filesystem */ if ( CAfile != NULL ) { STACK_OF(X509_NAME) *certNames = SSL_load_client_CA_file( F2N(CAfile, &ds) ); - if ( certNames != NULL ) { + if ( certNames != NULL ) { SSL_CTX_set_client_CA_list(ctx, certNames ); } } Tcl_DStringFree(&ds); @@ -1401,15 +1384,15 @@ * None. * *------------------------------------------------------------------- */ static int -StatusObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; - int objc; - Tcl_Obj *const objv[]; +StatusObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) { State *statePtr; X509 *peer; Tcl_Obj *objPtr; Tcl_Channel chan; @@ -1426,11 +1409,11 @@ case 3: if (!strcmp (Tcl_GetString (objv[1]), "-local")) { channelName = Tcl_GetString(objv[2]); break; } - /* else fall... */ + /* fallthrough */ default: Tcl_WrongNumArgs(interp, 1, objv, "?-local? channel"); return TCL_ERROR; } @@ -1478,11 +1461,10 @@ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_version(statePtr->ssl), -1)); Tcl_SetObjResult( interp, objPtr); return TCL_OK; - clientData = clientData; } /* *------------------------------------------------------------------- * @@ -1495,27 +1477,24 @@ * None. * *------------------------------------------------------------------- */ static int -VersionObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; - int objc; - Tcl_Obj *const objv[]; +VersionObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, + TCL_UNUSED(int) /* objc */, + TCL_UNUSED(Tcl_Obj *const *) /* objv */) { Tcl_Obj *objPtr; dprintf("Called"); objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1); Tcl_SetObjResult(interp, objPtr); return TCL_OK; - clientData = clientData; - objc = objc; - objv = objv; } /* *------------------------------------------------------------------- * @@ -1528,15 +1507,15 @@ * None. * *------------------------------------------------------------------- */ static int -MiscObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; - int objc; - Tcl_Obj *const objv[]; +MiscObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) { static const char *commands [] = { "req", NULL }; enum command { C_REQ, C_DUMMY }; int cmd; @@ -1555,18 +1534,18 @@ case C_REQ: { EVP_PKEY *pkey=NULL; X509 *cert=NULL; X509_NAME *name=NULL; Tcl_Obj **listv; - int listc,i; + Tcl_Size listc,i; BIO *out=NULL; - char *k_C="",*k_ST="",*k_L="",*k_O="",*k_OU="",*k_CN="",*k_Email=""; + const char *k_C="",*k_ST="",*k_L="",*k_O="",*k_OU="",*k_CN="",*k_Email=""; char *keyout,*pemout,*str; int keysize,serial=0,days=365; - + if ((objc<5) || (objc>6)) { Tcl_WrongNumArgs(interp, 2, objv, "keysize keyfile certfile ?info?"); return TCL_ERROR; } @@ -1638,11 +1617,11 @@ X509_set_version(cert,2); ASN1_INTEGER_set(X509_get_serialNumber(cert),serial); X509_gmtime_adj(X509_get_notBefore(cert),0); X509_gmtime_adj(X509_get_notAfter(cert),(long)60*60*24*days); X509_set_pubkey(cert,pkey); - + name=X509_get_subject_name(cert); X509_NAME_add_entry_by_txt(name,"C", MBSTRING_ASC, (unsigned char *) k_C, -1, -1, 0); X509_NAME_add_entry_by_txt(name,"ST", MBSTRING_ASC, (unsigned char *) k_ST, -1, -1, 0); X509_NAME_add_entry_by_txt(name,"L", MBSTRING_ASC, (unsigned char *) k_L, -1, -1, 0); @@ -1676,11 +1655,10 @@ break; default: break; } return TCL_OK; - clientData = clientData; } /* *------------------------------------------------------------------- * @@ -1696,11 +1674,15 @@ * Frees all the state * *------------------------------------------------------------------- */ void +#if TCL_MAJOR_VERSION > 8 +Tls_Free( void *blockPtr ) +#else Tls_Free( char *blockPtr ) +#endif { State *statePtr = (State *)blockPtr; dprintf("Called"); @@ -1825,11 +1807,11 @@ *------------------------------------------------------* * * Tls_SafeInit -- * * ------------------------------------------------* - * Standard procedure required by 'load'. + * Standard procedure required by 'load'. * Initializes this extension for a safe interpreter. * ------------------------------------------------* * * Sideeffects: * As of 'Tls_Init' @@ -1940,11 +1922,11 @@ /* * 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 + * 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)); Index: tls.htm ================================================================== --- tls.htm +++ tls.htm @@ -1,6 +1,6 @@ - + +# Copyright (C) 1997-2000 Matt Newman # namespace eval tls { variable logcmd tclLog variable debug 0 - + # Default flags passed to tls::import variable defaults {} # Maps UID to Server Socket variable srvmap @@ -97,11 +97,11 @@ switch -- $ruleVarArgsToConsume { 0 { set argToExecute { lappend @VAR@ $arg set argsArray($arg) true - } + } } 1 { set argToExecute { incr idx if {$idx >= [llength $args]} { Index: tlsBIO.c ================================================================== --- tlsBIO.c +++ tlsBIO.c @@ -76,13 +76,13 @@ parentChannel = Tls_GetParent(statePtr, 0); parentChannelType = Tcl_GetChannelType(parentChannel); validParentChannelFd = 0; if (strcmp(parentChannelType->typeName, "tcp") == 0) { - tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_READABLE, (ClientData) &parentChannelFdIn_p); + tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_READABLE, &parentChannelFdIn_p); if (tclGetChannelHandleRet == TCL_OK) { - tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_WRITABLE, (ClientData) &parentChannelFdOut_p); + tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_WRITABLE, &parentChannelFdOut_p); if (tclGetChannelHandleRet == TCL_OK) { parentChannelFdIn = PTR2INT(parentChannelFdIn_p); parentChannelFdOut = PTR2INT(parentChannelFdOut_p); if (parentChannelFdIn == parentChannelFdOut) { parentChannelFd = parentChannelFdIn; @@ -224,18 +224,22 @@ Tcl_Channel chan; long ret = 1; chan = Tls_GetParent((State *) BIO_get_data(bio), 0); - dprintf("BioCtrl(%p, 0x%x, 0x%x, %p)", (void *) bio, (unsigned int) cmd, (unsigned int) num, (void *) ptr); + dprintf("BioCtrl(%p, 0x%x, 0x%lx, %p)", bio, cmd, num, ptr); switch (cmd) { case BIO_CTRL_RESET: dprintf("Got BIO_CTRL_RESET"); num = 0; + ret = 0; + break; case BIO_C_FILE_SEEK: dprintf("Got BIO_C_FILE_SEEK"); + ret = 0; + break; case BIO_C_FILE_TELL: dprintf("Got BIO_C_FILE_TELL"); ret = 0; break; case BIO_CTRL_INFO: Index: tlsIO.c ================================================================== --- tlsIO.c +++ tlsIO.c @@ -20,31 +20,44 @@ #include "tlsInt.h" /* * Forward declarations */ -static int TlsBlockModeProc (ClientData instanceData, int mode); -#if TCL_MAJOR_VERSION < 9 -static int TlsCloseProc (ClientData instanceData, Tcl_Interp *interp); -#else -static int TlsClose2Proc (ClientData instanceData, Tcl_Interp *interp, int flags); -#endif -static int TlsInputProc (ClientData instanceData, char *buf, int bufSize, int *errorCodePtr); -static int TlsOutputProc (ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr); -static int TlsGetOptionProc (ClientData instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); -static void TlsWatchProc (ClientData instanceData, int mask); -static int TlsGetHandleProc (ClientData instanceData, int direction, ClientData *handlePtr); -static int TlsNotifyProc (ClientData instanceData, int mask); -#if 0 -static void TlsChannelHandler (ClientData clientData, int mask); -#endif -static void TlsChannelHandlerTimer (ClientData clientData); +static int TlsBlockModeProc (void *instanceData, int mode); +static int TlsCloseProc (void *instanceData, Tcl_Interp *interp); +static int TlsClose2Proc (void *instanceData, Tcl_Interp *interp, int flags); +static int TlsInputProc (void *instanceData, char *buf, int bufSize, int *errorCodePtr); +static int TlsOutputProc (void *instanceData, const char *buf, int toWrite, int *errorCodePtr); +static int TlsGetOptionProc (void *instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); +static void TlsWatchProc (void *instanceData, int mask); +static int TlsGetHandleProc (void *instanceData, int direction, void **handlePtr); +static int TlsNotifyProc (void *instanceData, int mask); +static void TlsChannelHandlerTimer (void *clientData); /* * TLS Channel Type */ -static Tcl_ChannelType *tlsChannelType = NULL; +static const Tcl_ChannelType tlsChannelType = { + "tls", /* typeName */ + TCL_CHANNEL_VERSION_5, /* version */ + TlsCloseProc, /* closeProc */ + TlsInputProc, /* inputProc */ + TlsOutputProc, /* outputProc */ + 0, /* seekProc */ + 0, /* setOptionProc */ + TlsGetOptionProc, /* getOptionProc */ + TlsWatchProc, /* watchProc */ + TlsGetHandleProc, /* getHandleProc */ + TlsClose2Proc, /* close2Proc */ + TlsBlockModeProc, /* blockModeProc */ + 0, /* flushProc */ + TlsNotifyProc, /* handlerProc */ + 0, /* wideSeekProc */ + 0, /* threadActionProc */ + 0 /* truncateProc */ +}; + /* *------------------------------------------------------------------- * * Tls_ChannelType -- @@ -57,71 +70,12 @@ * Side effects: * None. * *------------------------------------------------------------------- */ -Tcl_ChannelType *Tls_ChannelType(void) { - unsigned int size; - - /* - * Initialize the channel type if necessary - */ - if (tlsChannelType == NULL) { - /* - * Allocation of a new channeltype structure is not easy, because of - * the various verson of the core and subsequent changes to the - * structure. The main challenge is to allocate enough memory for - * modern versions even if this extsension is compiled against one - * of the older variant! - * - * (1) Versions before stubs (8.0.x) are simple, because they are - * supported only if the extension is compiled against exactly - * that version of the core. - * - * (2) With stubs we just determine the difference between the older - * and modern variant and overallocate accordingly if compiled - * against an older variant. - */ - size = sizeof(Tcl_ChannelType); /* Base size */ - - tlsChannelType = (Tcl_ChannelType *) ckalloc(size); - memset(tlsChannelType, 0, size); - - /* - * Common elements of the structure (no changes in location or name) - * close2Proc, seekProc, setOptionProc stay NULL. - */ - - tlsChannelType->typeName = "tls"; -#if TCL_MAJOR_VERSION < 9 - tlsChannelType->closeProc = TlsCloseProc; -#else - tlsChannelType->close2Proc = TlsClose2Proc; -#endif - tlsChannelType->inputProc = TlsInputProc; - tlsChannelType->outputProc = TlsOutputProc; - tlsChannelType->getOptionProc = TlsGetOptionProc; - tlsChannelType->watchProc = TlsWatchProc; - tlsChannelType->getHandleProc = TlsGetHandleProc; - - /* - * Compiled against 8.3.2+. Direct access to all elements possible. Use - * channelTypeVersion information to select the values to use. - */ - - /* - * For the 8.3.2 core we present ourselves as a version 2 - * driver. This means a special value in version (ex - * blockModeProc), blockModeProc in a different place and of - * course usage of the handlerProc. - */ - tlsChannelType->version = TCL_CHANNEL_VERSION_5; - tlsChannelType->blockModeProc = TlsBlockModeProc; - tlsChannelType->handlerProc = TlsNotifyProc; - } - - return(tlsChannelType); +const Tcl_ChannelType *Tls_ChannelType(void) { + return &tlsChannelType; } /* *------------------------------------------------------------------- * @@ -135,11 +89,11 @@ * Side effects: * Sets the device into blocking or nonblocking mode. * *------------------------------------------------------------------- */ -static int TlsBlockModeProc(ClientData instanceData, int mode) { +static int TlsBlockModeProc(void *instanceData, int mode) { State *statePtr = (State *) instanceData; if (mode == TCL_MODE_NONBLOCKING) { statePtr->flags |= TLS_TCL_ASYNC; } else { @@ -166,42 +120,28 @@ * Side effects: * Closes the socket of the channel. * *------------------------------------------------------------------- */ -static int TlsCloseProc(ClientData instanceData, Tcl_Interp *interp) { - State *statePtr = (State *) instanceData; - - dprintf("TlsCloseProc(%p)", (void *) statePtr); - - Tls_Clean(statePtr); - Tcl_EventuallyFree((ClientData)statePtr, Tls_Free); - - dprintf("Returning TCL_OK"); - - return(TCL_OK); - - /* Interp is unused. */ - interp = interp; -} - -static int TlsClose2Proc(ClientData instanceData, Tcl_Interp *interp, int flags) { - if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) { - State *statePtr = (State *) instanceData; - - dprintf("TlsCloseProc(%p)", (void *) statePtr); - - Tls_Clean(statePtr); - Tcl_EventuallyFree((ClientData)statePtr, Tls_Free); - - dprintf("Returning TCL_OK"); - - return(TCL_OK); - } - - /* Interp is unused. */ - interp = interp; +static int TlsCloseProc(void *instanceData, TCL_UNUSED(Tcl_Interp *)) { + State *statePtr = (State *) instanceData; + + dprintf("TlsCloseProc(%p)", statePtr); + + Tls_Clean(statePtr); + Tcl_EventuallyFree(statePtr, Tls_Free); + + dprintf("Returning TCL_OK"); + + return(TCL_OK); +} + +static int TlsClose2Proc(void *instanceData, Tcl_Interp *interp, int flags) { + if (!(flags&(TCL_CLOSE_READ|TCL_CLOSE_WRITE))) { + return TlsCloseProc(instanceData, interp); + } + return EINVAL; } /* *------------------------------------------------------* * @@ -218,11 +158,11 @@ int Tls_WaitForConnect(State *statePtr, int *errorCodePtr, int handshakeFailureIsPermanent) { unsigned long backingError; int err, rc; int bioShouldRetry; - dprintf("WaitForConnect(%p)", (void *) statePtr); + dprintf("WaitForConnect(%p)", statePtr); dprintFlags(statePtr); if (!(statePtr->flags & TLS_TCL_INIT)) { dprintf("Tls_WaitForConnect called on already initialized channel -- returning with immediate success"); *errorCodePtr = 0; @@ -397,11 +337,11 @@ * Reads input from the input device of the channel. * *------------------------------------------------------------------- */ -static int TlsInputProc(ClientData instanceData, char *buf, int bufSize, int *errorCodePtr) { +static int TlsInputProc(void *instanceData, char *buf, int bufSize, int *errorCodePtr) { unsigned long backingError; State *statePtr = (State *) instanceData; int bytesRead; int tlsConnect; int err; @@ -525,11 +465,11 @@ * Writes output on the output device of the channel. * *------------------------------------------------------------------- */ -static int TlsOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr) { +static int TlsOutputProc(void *instanceData, const char *buf, int toWrite, int *errorCodePtr) { unsigned long backingError; State *statePtr = (State *) instanceData; int written, err; int tlsConnect; @@ -665,11 +605,11 @@ * None. * *------------------------------------------------------------------- */ static int -TlsGetOptionProc(ClientData instanceData, /* Socket state. */ +TlsGetOptionProc(void *instanceData, /* Socket state. */ Tcl_Interp *interp, /* For errors - can be NULL. */ const char *optionName, /* Name of the option to * retrieve the value for, or * NULL to get all options and * their values. */ @@ -712,21 +652,21 @@ * *------------------------------------------------------------------- */ static void -TlsWatchProc(ClientData instanceData, /* The socket state. */ +TlsWatchProc(void *instanceData, /* The socket state. */ int mask) /* Events of interest; an OR-ed * combination of TCL_READABLE, * TCL_WRITABLE and TCL_EXCEPTION. */ { Tcl_Channel downChan; State *statePtr = (State *) instanceData; dprintf("TlsWatchProc(0x%x)", mask); - /* Pretend to be dead as long as the verify callback is running. + /* Pretend to be dead as long as the verify callback is running. * Otherwise that callback could be invoked recursively. */ if (statePtr->flags & TLS_TCL_CALLBACK) { dprintf("Callback is on-going, doing nothing"); return; } @@ -776,11 +716,11 @@ /* * There is interest in readable events and we actually have * data waiting, so generate a timer to flush that. */ dprintf("Creating a new timer since data appears to be waiting"); - statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, (ClientData) statePtr); + statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, statePtr); } } } /* @@ -790,18 +730,18 @@ * * Called from Tcl_GetChannelFile to retrieve o/s file handler * from the SSL socket based channel. * * Results: - * The appropriate Tcl_File or NULL if not present. + * The appropriate Tcl_File or NULL if not present. * * Side effects: * None. * *------------------------------------------------------------------- */ -static int TlsGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr) { +static int TlsGetHandleProc(void *instanceData, int direction, void **handlePtr) { State *statePtr = (State *) instanceData; return(Tcl_GetChannelHandle(Tls_GetParent(statePtr, TLS_TCL_FASTPATH), direction, handlePtr)); } @@ -820,11 +760,11 @@ * May process the incoming event by itself. * *------------------------------------------------------------------- */ -static int TlsNotifyProc(ClientData instanceData, int mask) { +static int TlsNotifyProc(void *instanceData, int mask) { State *statePtr = (State *) instanceData; int errorCode; /* * An event occured in the underlying channel. This @@ -887,17 +827,17 @@ *------------------------------------------------------* */ static void TlsChannelHandler (clientData, mask) - ClientData clientData; + void * clientData; int mask; { State *statePtr = (State *) clientData; dprintf("HANDLER(0x%x)", mask); - Tcl_Preserve( (ClientData)statePtr); + Tcl_Preserve(statePtr); if (mask & TCL_READABLE) { BIO_set_flags(statePtr->p_bio, BIO_FLAGS_READ); } else { BIO_clear_flags(statePtr->p_bio, BIO_FLAGS_READ); @@ -927,25 +867,25 @@ * * stanton: It looks like this could result in an infinite loop if * the upper channel doesn't cause ChannelHandler to be removed * before Tcl_NotifyChannel calls channel handlers on the lower channel. */ - + Tcl_NotifyChannel(statePtr->self, mask); - + if (statePtr->timer != (Tcl_TimerToken)NULL) { Tcl_DeleteTimerHandler(statePtr->timer); statePtr->timer = (Tcl_TimerToken)NULL; } if ((mask & TCL_READABLE) && Tcl_InputBuffered(statePtr->self) > 0) { /* * Data is waiting, flush it out in short time */ statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, - TlsChannelHandlerTimer, (ClientData) statePtr); + TlsChannelHandlerTimer, statePtr); } - Tcl_Release( (ClientData)statePtr); + Tcl_Release(statePtr); } #endif /* *------------------------------------------------------* @@ -964,11 +904,11 @@ * None. * *------------------------------------------------------* */ -static void TlsChannelHandlerTimer(ClientData clientData) { +static void TlsChannelHandlerTimer(void *clientData) { State *statePtr = (State *) clientData; int mask = 0; dprintf("Called"); Index: tlsInt.h ================================================================== --- tlsInt.h +++ tlsInt.h @@ -137,36 +137,59 @@ 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 */ + 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 */ BIO *p_bio; /* Parent BIO (that is layered on Tcl_Channel) */ - char *err; + const char *err; } State; #ifdef USE_TCL_STUBS #ifndef Tcl_StackChannel #error "Unable to compile on this version of Tcl" #endif /* Tcl_GetStackedChannel */ #endif /* USE_TCL_STUBS */ +#ifndef JOIN +# define JOIN(a,b) JOIN1(a,b) +# define JOIN1(a,b) a##b +#endif + +#ifndef TCL_UNUSED +# if defined(__cplusplus) +# define TCL_UNUSED(T) T +# elif defined(__GNUC__) && (__GNUC__ > 2) +# define TCL_UNUSED(T) T JOIN(dummy, __LINE__) __attribute__((unused)) +# else +# define TCL_UNUSED(T) T JOIN(dummy, __LINE__) +# endif +#endif + +#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7) && !defined(Tcl_Size) +# define Tcl_Size int +#endif + /* * Forward declarations */ -Tcl_ChannelType *Tls_ChannelType(void); +const Tcl_ChannelType *Tls_ChannelType(void); Tcl_Channel Tls_GetParent(State *statePtr, int maskFlags); Tcl_Obj *Tls_NewX509Obj(Tcl_Interp *interp, X509 *cert); void Tls_Error(State *statePtr, char *msg); +#if TCL_MAJOR_VERSION > 8 +void Tls_Free(void *blockPtr); +#else void Tls_Free(char *blockPtr); +#endif void Tls_Clean(State *statePtr); int Tls_WaitForConnect(State *statePtr, int *errorCodePtr, int handshakeFailureIsPermanent); BIO *BIO_new_tcl(State* statePtr, int flags); Index: tlsX509.c ================================================================== --- tlsX509.c +++ tlsX509.c @@ -3,11 +3,11 @@ * Matt Newman */ #include "tlsInt.h" /* - * Ensure these are not macros - known to be defined on Win32 + * Ensure these are not macros - known to be defined on Win32 */ #ifdef min #undef min #endif @@ -37,14 +37,14 @@ static char *mon[12]={ "Jan","Feb","Mar","Apr","May","Jun", "Jul","Aug","Sep","Oct","Nov","Dec"}; int i; int y=0,M=0,d=0,h=0,m=0,s=0; - + i=tm->length; v=(char *)tm->data; - + if (i < 10) goto err; if (v[i-1] == 'Z') gmt=1; for (i=0; i<10; i++) if ((v[i] > '9') || (v[i] < '0')) goto err; y= (v[0]-'0')*10+(v[1]-'0'); @@ -55,11 +55,11 @@ h= (v[6]-'0')*10+(v[7]-'0'); m= (v[8]-'0')*10+(v[9]-'0'); if ( (v[10] >= '0') && (v[10] <= '9') && (v[11] >= '0') && (v[11] <= '9')) s= (v[10]-'0')*10+(v[11]-'0'); - + sprintf(bp,"%s %2d %02d:%02d:%02d %d%s", mon[M-1],d,h,m,s,y+1900,(gmt)?" GMT":""); return bp; err: return "Bad time value"; @@ -118,11 +118,11 @@ serial[0] = 0; } else { flags = XN_FLAG_RFC2253 | ASN1_STRFLGS_UTF8_CONVERT; flags &= ~ASN1_STRFLGS_ESC_MSB; - X509_NAME_print_ex(bio, X509_get_subject_name(cert), 0, flags); + X509_NAME_print_ex(bio, X509_get_subject_name(cert), 0, flags); n = BIO_read(bio, subject, min(BIO_pending(bio), BUFSIZ - 1)); n = max(n, 0); subject[n] = 0; (void)BIO_flush(bio);