Check-in [46ffe75283]
Overview
Comment:A lot of formatting, no change in functionality.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | nijtmans
Files: files | file ages | folders
SHA3-256: 46ffe75283eb807815a5240b6b3b692374828f0744f17758ceb2fb6fe8de6e24
User & Date: jan.nijtmans on 2024-02-22 13:49:32
Other Links: branch diff | manifest | tags
Context
2024-02-22
17:40
Fix [006bd0c74e]: PATCH: BIO_CTRL_PUSH not handled. Also add some changes from androwish: [https://www.androwish.org/home/info/982ebf9d31a60440] check-in: 1b8c76f783 user: jan.nijtmans tags: nijtmans
15:27
Merge trunk check-in: c61ea12657 user: jan.nijtmans tags: bohagan
13:49
A lot of formatting, no change in functionality. check-in: 46ffe75283 user: jan.nijtmans tags: nijtmans
07:56
Applied patch to add OpenSSL3 KTLS trivial processing. Description: Patch adds trivial processing for BIO_CTRL_GET_KTLS_SEND and BIO_CTRL_GET_KTLS_RECV control commands to make tcltls working with OpenSSL 3.0. See also: - https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=1006587 - https://bugzilla.redhat.com/show_bug.cgi?id=2088363 Source: https://sources.debian.org/src/tcltls/1.7.22-3/debian/patches/openssl3.patch check-in: 0f781794ab user: jan.nijtmans tags: nijtmans
Changes
23
24
25
26
27
28
29
30

31
32
33
34
35
36
37
38
39
40
41
42
43


44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60



61
62
63
64
65
66
67
23
24
25
26
27
28
29

30
31
32
33
34
35
36
37
38
39
40
41


42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57



58
59
60
61
62
63
64
65
66
67







-
+











-
-
+
+














-
-
-
+
+
+







 */

#include "tlsInt.h"
#include "tclOpts.h"
#include <stdlib.h>

/* Min OpenSSL version */
#if !defined(LIBRESSL_VERSION_NUMBER) && OPENSSL_VERSION_NUMBER < 0x10101000L
#if OPENSSL_VERSION_NUMBER < 0x10101000L
#error "Only OpenSSL v1.1.1 or later is supported"
#endif

/*
 * External functions
 */

/*
 * Forward declarations
 */

#define F2N( key, dsp) \
	(((key) == NULL) ? (char *) NULL : \
#define F2N(key, dsp) \
	(((key) == NULL) ? (char *)NULL : \
		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 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);
		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);

static int	TlsLibInit(int uninitialize);

#define TLS_PROTO_SSL2		0x01
#define TLS_PROTO_SSL3		0x02
#define TLS_PROTO_TLS1		0x04
#define TLS_PROTO_TLS1_1	0x08
152
153
154
155
156
157
158
159

160
161
162
163
164
165

166
167
168
169
170
171
172
152
153
154
155
156
157
158

159
160
161
162
163
164
165
166
167
168
169
170
171
172
173







-
+






+









/*
 *-------------------------------------------------------------------
 *
 * InfoCallback --
 *
 *	monitors SSL connection process
 *	Monitors SSL connection process
 *
 * Results:
 *	None
 *
 * Side effects:
 *	Calls callback (if defined)
 *
 *-------------------------------------------------------------------
 */
static void
InfoCallback(const SSL *ssl, int where, int ret)
{
    State *statePtr = (State*)SSL_get_app_data((SSL *)ssl);
    Tcl_Obj *cmdPtr;
257
258
259
260
261
262
263

264
265
266
267
268
269
270
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272







+







 *	    0			- the certificate is deemed invalid
 *	    1			- the certificate is deemed valid
 *	    empty string	- no change to certificate validation
 *
 * Side effects:
 *	The err field of the currently operative State is set
 *	  to a string describing the SSL negotiation failure reason
 *
 *-------------------------------------------------------------------
 */
static int
VerifyCallback(int ok, X509_STORE_CTX *ctx)
{
    Tcl_Obj *cmdPtr, *result;
    char *errStr, *string;
486
487
488
489
490
491
492







493
494
495
496
497
498
499
500
501
502
503
504
505
506

507
508
509

510

511
512
513
514
515

516
517
518
519

520
521
522
523
524

525
526
527
528
529
530


531
532
533
534


535
536

537
538
539
540
541


542
543

544
545
546
547
548


549
550

551
552
553
554


555
556

557
558
559
560


561
562
563
564



565
566
567
568
569
570

571
572
573
574
575

576
577
578
579
580
581
582
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508







509
510
511
512
513

514
515
516
517
518

519
520
521
522

523

524
525


526
527
528
529
530


531
532
533
534


535
536
537

538
539
540
541


542
543
544

545
546
547
548


549
550
551

552
553
554


555
556
557

558
559
560


561
562
563



564
565
566
567
568
569
570
571

572
573
574
575
576

577
578
579
580
581
582
583
584







+
+
+
+
+
+
+







-
-
-
-
-
-
-
+



+
-
+




-
+



-
+
-


-
-
+




-
-
+
+


-
-
+
+

-
+



-
-
+
+

-
+



-
-
+
+

-
+


-
-
+
+

-
+


-
-
+
+

-
-
-
+
+
+





-
+




-
+







 *	A standard Tcl result list.
 *
 * Side effects:
 *	constructs and destroys SSL context (CTX)
 *
 *-------------------------------------------------------------------
 */
static const char *protocols[] = {
    "ssl2", "ssl3", "tls1", "tls1.1", "tls1.2", "tls1.3", NULL
};
enum protocol {
    TLS_SSL2, TLS_SSL3, TLS_TLS1, TLS_TLS1_1, TLS_TLS1_2, TLS_TLS1_3, TLS_NONE
};

static int
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 {
	TLS_SSL2, TLS_SSL3, TLS_TLS1, TLS_TLS1_1, TLS_TLS1_2, TLS_TLS1_3, TLS_NONE
    };
    Tcl_Obj *objPtr;
    Tcl_Obj *objPtr = NULL;
    SSL_CTX *ctx = NULL;
    SSL *ssl = NULL;
    STACK_OF(SSL_CIPHER) *sk;
    const char *cp;
    char *cp, buf[BUFSIZ];
    char buf[BUFSIZ];
    int index, verbose = 0;

    dprintf("Called");

    if (objc < 2 || objc > 3) {
    if ((objc < 2) || (objc > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "protocol ?verbose?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj( interp, objv[1], protocols, "protocol", 0,
    if (Tcl_GetIndexFromObj(interp, objv[1], protocols, "protocol", 0, &index) != TCL_OK) {
	&index) != TCL_OK) {
	return TCL_ERROR;
    }
    if (objc > 2 && Tcl_GetBooleanFromObj( interp, objv[2],
	&verbose) != TCL_OK) {
    if ((objc > 2) && Tcl_GetBooleanFromObj(interp, objv[2], &verbose) != TCL_OK) {
	return TCL_ERROR;
    }
    switch ((enum protocol)index) {
    case TLS_SSL2:
		Tcl_AppendResult(interp, "protocol not supported", (char *)NULL);
		return TCL_ERROR;
	Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)NULL);
	return TCL_ERROR;
    case TLS_SSL3:
#if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3) || defined(OPENSSL_NO_SSL3_METHOD)
		Tcl_AppendResult(interp, "protocol not supported", (char *)NULL);
		return TCL_ERROR;
	Tcl_AppendResult(interp, "protocol not supported", (char *)NULL);
	return TCL_ERROR;
#else
		ctx = SSL_CTX_new(SSLv3_method()); break;
	ctx = SSL_CTX_new(SSLv3_method()); break;
#endif
    case TLS_TLS1:
#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1) || defined(OPENSSL_NO_TLS1_METHOD)
		Tcl_AppendResult(interp, "protocol not supported", (char *)NULL);
		return TCL_ERROR;
	Tcl_AppendResult(interp, "protocol not supported", (char *)NULL);
	return TCL_ERROR;
#else
		ctx = SSL_CTX_new(TLSv1_method()); break;
	ctx = SSL_CTX_new(TLSv1_method()); break;
#endif
    case TLS_TLS1_1:
#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1_METHOD)
		Tcl_AppendResult(interp, "protocol not supported", (char *)NULL);
		return TCL_ERROR;
	Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)NULL);
	return TCL_ERROR;
#else
		ctx = SSL_CTX_new(TLSv1_1_method()); break;
	ctx = SSL_CTX_new(TLSv1_1_method()); break;
#endif
#if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2_METHOD)
		Tcl_AppendResult(interp, "protocol not supported", (char *)NULL);
		return TCL_ERROR;
	Tcl_AppendResult(interp, "protocol not supported", (char *)NULL);
	return TCL_ERROR;
#else
		ctx = SSL_CTX_new(TLSv1_2_method()); break;
	ctx = SSL_CTX_new(TLSv1_2_method()); break;
#endif
#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3_METHOD)
		Tcl_AppendResult(interp, "protocol not supported", (char *)NULL);
		return TCL_ERROR;
	Tcl_AppendResult(interp, "protocol not supported", (char *)NULL);
	return TCL_ERROR;
#else
		ctx = SSL_CTX_new(TLS_method()); break;
		SSL_CTX_set_min_proto_version (ctx, TLS1_3_VERSION);
		SSL_CTX_set_max_proto_version (ctx, TLS1_3_VERSION);
	ctx = SSL_CTX_new(TLS_method()); break;
	SSL_CTX_set_min_proto_version (ctx, TLS1_3_VERSION);
	SSL_CTX_set_max_proto_version (ctx, TLS1_3_VERSION);
#endif
    default:
		break;
    }
    if (ctx == NULL) {
	Tcl_AppendResult(interp, REASON(), (char *) NULL);
	Tcl_AppendResult(interp, REASON(), (char *)NULL);
	return TCL_ERROR;
    }
    ssl = SSL_new(ctx);
    if (ssl == NULL) {
	Tcl_AppendResult(interp, REASON(), (char *) NULL);
	Tcl_AppendResult(interp, REASON(), (char *)NULL);
	SSL_CTX_free(ctx);
	return TCL_ERROR;
    }
    objPtr = Tcl_NewListObj( 0, NULL);

    if (!verbose) {
	for (index = 0; ; index++) {
603
604
605
606
607
608
609
610

611
612
613
614
615
616
617
605
606
607
608
609
610
611

612
613
614
615
616
617
618
619







-
+







	    Tcl_ListObjAppendElement( interp, objPtr,
		Tcl_NewStringObj( buf, -1) );
	}
    }
    SSL_free(ssl);
    SSL_CTX_free(ctx);

    Tcl_SetObjResult( interp, objPtr);
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * HandshakeObjCmd --
630
631
632
633
634
635
636
637
638
639
640
641





642
643

644
645
646
647
648




649
650
651
652
653




654
655
656

657
658
659
660
661
662
663







664
665
666
667



668
669
670
671

672
673
674
675
676
677
678






679
680
681
682



683
684
685
686
687
688
689
690







691
692
693


694
695
696
697



698
699
700
701
702
703
704
632
633
634
635
636
637
638





639
640
641
642
643
644

645
646




647
648
649
650
651




652
653
654
655
656


657







658
659
660
661
662
663
664
665



666
667
668
669



670







671
672
673
674
675
676
677



678
679
680
681







682
683
684
685
686
687
688



689
690
691



692
693
694
695
696
697
698
699
700
701







-
-
-
-
-
+
+
+
+
+

-
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

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

-
-
-
+
+
+

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

-
-
-
+
+
+

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

-
-
-
+
+
+








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

	dprintf("Called");
    dprintf("Called");

	if (objc != 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "channel");
		return(TCL_ERROR);
	}
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel");
	return(TCL_ERROR);
    }

	chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
	if (chan == (Tcl_Channel) NULL) {
		return(TCL_ERROR);
	}
    chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
    if (chan == (Tcl_Channel) NULL) {
	return(TCL_ERROR);
    }

	/*
	 * Make sure to operate on the topmost channel
    /* 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", (char *)NULL);
		return(TCL_ERROR);
	}
	statePtr = (State *)Tcl_GetChannelInstanceData(chan);
    chan = Tcl_GetTopChannel(chan);
    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
		"\": not a TLS channel", (char *)NULL);
	return(TCL_ERROR);
    }
    statePtr = (State *)Tcl_GetChannelInstanceData(chan);

	dprintf("Calling Tls_WaitForConnect");
	ret = Tls_WaitForConnect(statePtr, &err, 1);
	dprintf("Tls_WaitForConnect returned: %i", ret);
    dprintf("Calling Tls_WaitForConnect");
    ret = Tls_WaitForConnect(statePtr, &err, 1);
    dprintf("Tls_WaitForConnect returned: %i", ret);

	if (
	    ret < 0 && \
	    ((statePtr->flags & TLS_TCL_ASYNC) && err == EAGAIN)
    if (ret < 0 && ((statePtr->flags & TLS_TCL_ASYNC) && (err == EAGAIN))) {
	) {
		dprintf("Async set and err = EAGAIN");
		ret = 0;
	} else if (ret < 0) {
		errStr = statePtr->err;
		Tcl_ResetResult(interp);
		Tcl_SetErrno(err);
	dprintf("Async set and err = EAGAIN");
	ret = 0;
    } else if (ret < 0) {
	errStr = statePtr->err;
	Tcl_ResetResult(interp);
	Tcl_SetErrno(err);

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

		Tcl_AppendResult(interp, "handshake failed: ", errStr, (char *) NULL);
		dprintf("Returning TCL_ERROR with handshake failed: %s", errStr);
		return(TCL_ERROR);
	} else {
		if (err != 0) {
			dprintf("Got an error with a completed handshake: err = %i", err);
		}
	Tcl_AppendResult(interp, "handshake failed: ", errStr, (char *)NULL);
	dprintf("Returning TCL_ERROR with handshake failed: %s", errStr);
	return(TCL_ERROR);
    } else {
	if (err != 0) {
	    dprintf("Got an error with a completed handshake: err = %i", err);
	}

		ret = 1;
	}
	ret = 1;
    }

	dprintf("Returning TCL_OK with data \"%i\"", ret);
	Tcl_SetObjResult(interp, Tcl_NewIntObj(ret));
	return(TCL_OK);
    dprintf("Returning TCL_OK with data \"%i\"", ret);
    Tcl_SetObjResult(interp, Tcl_NewIntObj(ret));
    return(TCL_OK);
}

/*
 *-------------------------------------------------------------------
 *
 * ImportObjCmd --
 *
720
721
722
723
724
725
726
727
728
729



730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745













746
747

748
749
750
751
752
753
754
717
718
719
720
721
722
723



724
725
726
727
728
729













730
731
732
733
734
735
736
737
738
739
740
741
742
743

744
745
746
747
748
749
750
751







-
-
-
+
+
+



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

-
+







    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;
    SSL_CTX *ctx		= NULL;
    Tcl_Obj *script		= NULL;
    Tcl_Obj *password		= NULL;
    Tcl_DString upperChannelTranslation, upperChannelBlocking, upperChannelEncoding, upperChannelEOFChar;
    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;
    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;
    int flags			= TLS_TCL_INIT;
    int server			= 0;	/* is connection incoming or outgoing? */
    char *keyfile		= NULL;
    char *certfile		= NULL;
    unsigned char *key		= NULL;
    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;
#ifndef OPENSSL_NO_TLSEXT
    char *servername	        = NULL;	/* hostname for Server Name Indication */
    char *servername		= NULL;	/* hostname for Server Name Indication */
#endif
    int ssl2 = 0, ssl3 = 0;
    int tls1 = 1, tls1_1 = 1, tls1_2 = 1, tls1_3 = 1;
    int proto = 0;
    int verify = 0, require = 0, request = 1;

    dprintf("Called");
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804












805
806

807
808
809
810
811
812
813
814






815
816
817
818

819
820
821
822
823
824
825
783
784
785
786
787
788
789












790
791
792
793
794
795
796
797
798
799
800
801
802

803
804
805






806
807
808
809
810
811
812
813
814

815
816
817
818
819
820
821
822







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

-
+


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



-
+








    for (idx = 2; idx < objc; idx++) {
	char *opt = Tcl_GetString(objv[idx]);

	if (opt[0] != '-')
	    break;

	OPTSTR( "-cadir", CAdir);
	OPTSTR( "-cafile", CAfile);
	OPTSTR( "-certfile", certfile);
	OPTSTR( "-cipher", ciphers);
	OPTOBJ( "-command", script);
	OPTSTR( "-dhparams", DHparams);
	OPTSTR( "-keyfile", keyfile);
	OPTSTR( "-model", model);
	OPTOBJ( "-password", password);
	OPTBOOL( "-require", require);
	OPTBOOL( "-request", request);
	OPTBOOL( "-server", server);
	OPTSTR("-cadir", CAdir);
	OPTSTR("-cafile", CAfile);
	OPTSTR("-certfile", certfile);
	OPTSTR("-cipher", ciphers);
	OPTOBJ("-command", script);
	OPTSTR("-dhparams", DHparams);
	OPTSTR("-keyfile", keyfile);
	OPTSTR("-model", model);
	OPTOBJ("-password", password);
	OPTBOOL("-require", require);
	OPTBOOL("-request", request);
	OPTBOOL("-server", server);
#ifndef OPENSSL_NO_TLSEXT
        OPTSTR( "-servername", servername);
	OPTSTR( "-servername", servername);
#endif

	OPTBOOL( "-ssl2", ssl2);
	OPTBOOL( "-ssl3", ssl3);
	OPTBOOL( "-tls1", tls1);
	OPTBOOL( "-tls1.1", tls1_1);
	OPTBOOL( "-tls1.2", tls1_2);
	OPTBOOL( "-tls1.3", tls1_3)
	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);

	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");
	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;
    }
    if (request)	    verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER;
    if (request && require) verify |= SSL_VERIFY_FAIL_IF_NO_PEER_CERT;
    if (verify == 0)	verify = SSL_VERIFY_NONE;

872
873
874
875
876
877
878
879
880
881
882




883
884
885


886
887
888
889
890
891
892
893


894
895
896
897
898
899
900
869
870
871
872
873
874
875




876
877
878
879
880


881
882
883
884
885
886
887
888


889
890
891
892
893
894
895
896
897







-
-
-
-
+
+
+
+

-
-
+
+






-
-
+
+







	/* Get the "model" context */
	chan = Tcl_GetChannel(interp, model, &mode);
	if (chan == (Tcl_Channel) NULL) {
	    Tls_Free((void *)statePtr);
	    return TCL_ERROR;
	}

        /*
         * Make sure to operate on the topmost channel
         */
        chan = Tcl_GetTopChannel(chan);
	/*
	 * 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", (char *)NULL);
	    Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
		    "\": not a TLS channel", (char *)NULL);
	    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) {
		cert, key_len, cert_len, CAdir, CAfile, ciphers,
		DHparams)) == NULL) {
	    Tls_Free((void *)statePtr);
	    return TCL_ERROR;
	}
    }

    statePtr->ctx = ctx;

933
934
935
936
937
938
939
940

941
942
943
944
945
946
947
948
949


950
951
952
953



954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984

985
986
987
988
989
990
991
992
930
931
932
933
934
935
936

937

938
939
940
941
942
943


944
945




946
947
948
949
950
951
952
953
954

955

956

957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975

976

977
978
979
980
981
982
983







-
+
-






-
-
+
+
-
-
-
-
+
+
+






-

-

-



















-
+
-







    /*
     * SSL Initialization
     */

    statePtr->ssl = SSL_new(statePtr->ctx);
    if (!statePtr->ssl) {
	/* SSL library error */
	Tcl_AppendResult(interp, "couldn't construct ssl session: ", REASON(),
	Tcl_AppendResult(interp, "couldn't construct ssl session: ", REASON(), (char *)NULL);
		(char *) NULL);
	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",
	if (!SSL_set_tlsext_host_name(statePtr->ssl, servername) && require) {
	    Tcl_AppendResult(interp, "setting TLS host name extension failed", (char *)NULL);
                (char *) NULL);
            Tls_Free((void *)statePtr);
            return TCL_ERROR;
        }
	    Tls_Free((void *)statePtr);
	    return TCL_ERROR;
	}
    }
#endif

    /*
     * SSL Callbacks
     */

    SSL_set_app_data(statePtr->ssl, (void *)statePtr);	/* point back to us */

    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_NOCLOSE);
    statePtr->bio	= BIO_new(BIO_f_ssl());

    if (server) {
	statePtr->flags |= TLS_TCL_SERVER;
	SSL_set_accept_state(statePtr->ssl);
    } else {
	SSL_set_connect_state(statePtr->ssl);
    }
    SSL_set_bio(statePtr->ssl, statePtr->p_bio, statePtr->p_bio);
    BIO_set_ssl(statePtr->bio, statePtr->ssl, BIO_NOCLOSE);

    /*
     * End of SSL Init
     */
    dprintf("Returning %s", Tcl_GetChannelName(statePtr->self));
    Tcl_SetResult(interp, (char *) Tcl_GetChannelName(statePtr->self),
    Tcl_SetResult(interp, (char *) Tcl_GetChannelName(statePtr->self), TCL_VOLATILE);
	    TCL_VOLATILE);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * UnimportObjCmd --
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151

1152
1153
1154
1155
1156
1157
1158
1159
1132
1133
1134
1135
1136
1137
1138




1139

1140
1141
1142
1143
1144
1145
1146







-
-
-
-
+
-







#if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2_METHOD)
    case TLS_PROTO_TLS1_2:
	method = TLSv1_2_method ();
	break;
#endif
#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3_METHOD)
    case TLS_PROTO_TLS1_3:
        /*
         * The version range is constrained below,
         * after the context is created.  Use the
         * generic method here.
	/* Use the generic method and constraint range after context is created */
         */
	method = TLS_method ();
	break;
#endif
    default:
#ifdef HAVE_TLS_METHOD
        method = TLS_method ();
#else
1176
1177
1178
1179
1180
1181
1182
1183

1184
1185
1186

1187
1188
1189


1190
1191
1192
1193
1194
1195
1196




1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212

1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226

1227
1228
1229
1230
1231
1232
1233
1234
1235
1236

1237
1238
1239
1240
1241
1242
1243
1163
1164
1165
1166
1167
1168
1169

1170
1171
1172

1173
1174


1175
1176
1177
1178
1179




1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198

1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212

1213
1214
1215
1216
1217
1218
1219
1220
1221
1222

1223
1224
1225
1226
1227
1228
1229
1230







-
+


-
+

-
-
+
+



-
-
-
-
+
+
+
+















-
+













-
+









-
+







#endif
	break;
    }

    ctx = SSL_CTX_new (method);

    if (!ctx) {
        return(NULL);
	return(NULL);
    }

#if !defined(NO_TLS1_3)
#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3)
    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);
	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);
    SSL_CTX_set_app_data(ctx, 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);

    if (ciphers != NULL)
	SSL_CTX_set_cipher_list(ctx, ciphers);

    /* set some callbacks */
    SSL_CTX_set_default_passwd_cb(ctx, PasswordCallback);

#ifndef BSAFE
    SSL_CTX_set_default_passwd_cb_userdata(ctx, (void *)statePtr);
#endif

    /* read a Diffie-Hellman parameters file, or use the built-in one */
#ifdef OPENSSL_NO_DH
    if (DHparams != NULL) {
	Tcl_AppendResult(interp,
	    "DH parameter support not available", (char *) NULL);
		"DH parameter support not available", (char *)NULL);
	SSL_CTX_free(ctx);
	return NULL;
    }
#else
    {
	DH* dh;
	if (DHparams != NULL) {
	    BIO *bio;
	    Tcl_DStringInit(&ds);
	    bio = BIO_new_file(F2N(DHparams, &ds), "r");
	    if (!bio) {
		Tcl_DStringFree(&ds);
		Tcl_AppendResult(interp,
		    "Could not find DH parameters file", (char *) NULL);
		    "Could not find DH parameters file", (char *)NULL);
		SSL_CTX_free(ctx);
		return NULL;
	    }

	    dh = PEM_read_bio_DHparams(bio, NULL, NULL, NULL);
	    BIO_free(bio);
	    Tcl_DStringFree(&ds);
	    if (!dh) {
		Tcl_AppendResult(interp,
		    "Could not read DH parameters from file", (char *) NULL);
		    "Could not read DH parameters from file", (char *)NULL);
		SSL_CTX_free(ctx);
		return NULL;
	    }
	} else {
	    dh = get_dhParams();
	}
	SSL_CTX_set_tmp_dh(ctx, dh);
1253
1254
1255
1256
1257
1258
1259
1260

1261
1262
1263
1264
1265
1266
1267
1268
1269
1270

1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283

1284
1285
1286
1287
1288
1289
1290
1240
1241
1242
1243
1244
1245
1246

1247
1248
1249
1250
1251
1252
1253
1254
1255
1256

1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269

1270
1271
1272
1273
1274
1275
1276
1277







-
+









-
+












-
+







	Tcl_DStringInit(&ds);

	if (SSL_CTX_use_certificate_file(ctx, F2N( certfile, &ds),
					SSL_FILETYPE_PEM) <= 0) {
	    Tcl_DStringFree(&ds);
	    Tcl_AppendResult(interp,
			     "unable to set certificate file ", certfile, ": ",
			     REASON(), (char *) NULL);
			     REASON(), (char *)NULL);
	    SSL_CTX_free(ctx);
	    return NULL;
	}
    } else if (cert != NULL) {
	load_private_key = 1;
	if (SSL_CTX_use_certificate_ASN1(ctx, cert_len, cert) <= 0) {
	    Tcl_DStringFree(&ds);
	    Tcl_AppendResult(interp,
			     "unable to set certificate: ",
			     REASON(), (char *) NULL);
			     REASON(), (char *)NULL);
	    SSL_CTX_free(ctx);
	    return NULL;
	}
    } else {
	certfile = (char*)X509_get_default_cert_file();

	if (SSL_CTX_use_certificate_file(ctx, certfile,
					SSL_FILETYPE_PEM) <= 0) {
#if 0
	    Tcl_DStringFree(&ds);
	    Tcl_AppendResult(interp,
			     "unable to use default certificate file ", certfile, ": ",
			     REASON(), (char *) NULL);
			     REASON(), (char *)NULL);
	    SSL_CTX_free(ctx);
	    return NULL;
#endif
	}
    }

    /* set our private key */
1301
1302
1303
1304
1305
1306
1307
1308

1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319

1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331

1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347

1348
1349
1350
1351
1352
1353
1354
1288
1289
1290
1291
1292
1293
1294

1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305

1306


1307
1308
1309
1310
1311
1312
1313
1314
1315

1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331

1332
1333
1334
1335
1336
1337
1338
1339







-
+










-
+
-
-









-
+















-
+








	    if (SSL_CTX_use_PrivateKey_file(ctx, F2N( keyfile, &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 ", keyfile, " ",
			         REASON(), (char *) NULL);
			         REASON(), (char *)NULL);
		SSL_CTX_free(ctx);
		return NULL;
	    }

	    Tcl_DStringFree(&ds);
	} else if (key != NULL) {
	    if (SSL_CTX_use_PrivateKey_ASN1(EVP_PKEY_RSA, ctx, key,key_len) <= 0) {
		Tcl_DStringFree(&ds);
		/* flush the passphrase which might be left in the result */
		Tcl_SetResult(interp, NULL, TCL_STATIC);
		Tcl_AppendResult(interp,
		Tcl_AppendResult(interp, "unable to set public key: ", REASON(), (char *)NULL);
		                 "unable to set public key: ",
		                 REASON(), (char *) NULL);
		SSL_CTX_free(ctx);
		return NULL;
	    }
	}
	/* Now we know that a key and cert have been set against
	 * the SSL context */
	if (!SSL_CTX_check_private_key(ctx)) {
	    Tcl_AppendResult(interp,
			     "private key does not match the certificate public key",
			     (char *) NULL);
			     (char *)NULL);
	    SSL_CTX_free(ctx);
	    return NULL;
	}
    }

    /* Set verification CAs */
    Tcl_DStringInit(&ds);
    Tcl_DStringInit(&ds1);
    if (!SSL_CTX_load_verify_locations(ctx, F2N(CAfile, &ds), F2N(CAdir, &ds1)) ||
	!SSL_CTX_set_default_verify_paths(ctx)) {
#if 0
	Tcl_DStringFree(&ds);
	Tcl_DStringFree(&ds1);
	/* Don't currently care if this fails */
	Tcl_AppendResult(interp, "SSL default verify paths: ",
		REASON(), (char *) NULL);
		REASON(), (char *)NULL);
	SSL_CTX_free(ctx);
	return NULL;
#endif
    }

    /* https://sourceforge.net/p/tls/bugs/57/ */
    /* XXX:TODO: Let the user supply values here instead of something that exists on the filesystem */
1750
1751
1752
1753
1754
1755
1756
1757
1758




1759
1760
1761


1762
1763

1764
1765
1766
1767
1768
1769
1770

1771
1772
1773
1774
1775
1776


1777
1778
1779
1780
1781




1782
1783
1784
1785
1786
1787
1788
1789







1790
1791
1792
1793



1794
1795

1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808

1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819


1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832

1833
1834
1835
1836
1837
1838
1839
1840
1841


1842
1843

1844
1845
1846
1847
1848



1849
1850
1851


1852
1853

1854
1855
1856

1857
1858
1859


1860
1861
1862
1863
1864
1865





1866
1867

1868
1869
1870

1871
1872
1873
1874


1875
1876
1877
1878
1879




1880
1881

1882
1883
1884

1885
1886

1887
1888
1889
1890
1891
1892




1893
1894
1895


1896
1897
1898
1899
1900
1901




1902
1903
1904


1905
1906

1907
1908
1909
1910

1911
1912
1913

1914
1735
1736
1737
1738
1739
1740
1741


1742
1743
1744
1745
1746


1747
1748
1749

1750
1751
1752
1753
1754



1755






1756
1757
1758




1759
1760
1761
1762
1763







1764
1765
1766
1767
1768
1769
1770
1771



1772
1773
1774
1775

1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788

1789
1790
1791
1792
1793
1794
1795
1796
1797
1798


1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812

1813
1814
1815
1816
1817
1818
1819
1820


1821
1822
1823

1824
1825
1826



1827
1828
1829
1830


1831
1832
1833

1834
1835
1836

1837
1838


1839
1840
1841





1842
1843
1844
1845
1846
1847

1848
1849
1850

1851
1852
1853


1854
1855
1856




1857
1858
1859
1860
1861

1862
1863
1864

1865
1866

1867
1868
1869




1870
1871
1872
1873
1874


1875
1876
1877
1878




1879
1880
1881
1882
1883


1884
1885
1886

1887
1888
1889
1890

1891
1892
1893

1894
1895







-
-
+
+
+
+

-
-
+
+

-
+




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

-
-
-
-
+
+
+
+

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

-
-
-
+
+
+

-
+












-
+









-
-
+
+












-
+







-
-
+
+

-
+


-
-
-
+
+
+

-
-
+
+

-
+


-
+

-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
+


-
+


-
-
+
+

-
-
-
-
+
+
+
+

-
+


-
+

-
+


-
-
-
-
+
+
+
+

-
-
+
+


-
-
-
-
+
+
+
+

-
-
+
+

-
+



-
+


-
+

 *
 * Side effects:
 *	 create the ssl command, initialise ssl context
 *
 *-------------------------------------------------------------------
 */

DLLEXPORT int Tls_Init(Tcl_Interp *interp) {
	const char tlsTclInitScript[] = {
DLLEXPORT int Tls_Init(
    Tcl_Interp *interp)
{
    const char tlsTclInitScript[] = {
#include "tls.tcl.h"
            0x00
	};
	    0x00
    };

        dprintf("Called");
    dprintf("Called");

	/*
	 * We only support Tcl 8.6 or newer
	 */
	if (
#ifdef USE_TCL_STUBS
	    Tcl_InitStubs(interp, "8.6-", 0)
    if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) {
#else
	    Tcl_PkgRequire(interp, "Tcl", "8.6-", 0)
#endif
	     == NULL) {
		return TCL_ERROR;
	}
	return TCL_ERROR;
    }

	if (TlsLibInit(0) != TCL_OK) {
		Tcl_AppendResult(interp, "could not initialize SSL library", (char *)NULL);
		return TCL_ERROR;
	}
    if (TlsLibInit(0) != TCL_OK) {
	Tcl_AppendResult(interp, "could not initialize SSL library", (char *)NULL);
	return TCL_ERROR;
    }

	Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, NULL, 0);
	Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd, NULL, 0);
	Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd, NULL, 0);
	Tcl_CreateObjCommand(interp, "tls::unimport", UnimportObjCmd, NULL, 0);
	Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, NULL, 0);
	Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, NULL, 0);
	Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, NULL, 0);
    Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, NULL, 0);
    Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd, NULL, 0);
    Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd, NULL, 0);
    Tcl_CreateObjCommand(interp, "tls::unimport", UnimportObjCmd, NULL, 0);
    Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, NULL, 0);
    Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, NULL, 0);
    Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, NULL, 0);

	if (interp) {
		Tcl_Eval(interp, tlsTclInitScript);
	}
    if (interp) {
	Tcl_Eval(interp, tlsTclInitScript);
    }

	return(Tcl_PkgProvide(interp, "tls", PACKAGE_VERSION));
    return(Tcl_PkgProvide(interp, "tls", PACKAGE_VERSION));
}

/*
 *------------------------------------------------------*
 *
 *	Tls_SafeInit --
 *
 *	------------------------------------------------*
 *	Standard procedure required by 'load'.
 *	Initializes this extension for a safe interpreter.
 *	------------------------------------------------*
 *
 *	Sideeffects:
 *	Side effects:
 *		As of 'Tls_Init'
 *
 *	Result:
 *		A standard Tcl error code.
 *
 *------------------------------------------------------*
 */

DLLEXPORT int Tls_SafeInit(Tcl_Interp *interp) {
	dprintf("Called");
	return(Tls_Init(interp));
    dprintf("Called");
    return(Tls_Init(interp));
}

/*
 *------------------------------------------------------*
 *
 *	TlsLibInit --
 *
 *	------------------------------------------------*
 *	Initializes SSL library once per application
 *	------------------------------------------------*
 *
 *	Side effects:
 *		initilizes SSL library
 *		initializes SSL library
 *
 *	Result:
 *		none
 *
 *------------------------------------------------------*
 */
static int TlsLibInit(int uninitialize) {
	static int initialized = 0;
	int status = TCL_OK;
    static int initialized = 0;
    int status = TCL_OK;
#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
	size_t num_locks;
    size_t num_locks;
#endif

	if (uninitialize) {
		if (!initialized) {
			dprintf("Asked to uninitialize, but we are not initialized");
    if (uninitialize) {
	if (!initialized) {
	    dprintf("Asked to uninitialize, but we are not initialized");

			return(TCL_OK);
		}
	    return(TCL_OK);
	}

		dprintf("Asked to uninitialize");
	dprintf("Asked to uninitialize");

#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
		Tcl_MutexLock(&init_mx);
	Tcl_MutexLock(&init_mx);

		CRYPTO_set_locking_callback(NULL);
		CRYPTO_set_id_callback(NULL);
	CRYPTO_set_locking_callback(NULL);
	CRYPTO_set_id_callback(NULL);

		if (locks) {
			free(locks);
			locks = NULL;
			locksCount = 0;
		}
	if (locks) {
	    free(locks);
	    locks = NULL;
	    locksCount = 0;
	}
#endif
		initialized = 0;
	initialized = 0;

#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
		Tcl_MutexUnlock(&init_mx);
	Tcl_MutexUnlock(&init_mx);
#endif

		return(TCL_OK);
	}
	return(TCL_OK);
    }

	if (initialized) {
		dprintf("Called, but using cached value");
		return(status);
	}
    if (initialized) {
	dprintf("Called, but using cached value");
	return(status);
    }

	dprintf("Called");
    dprintf("Called");

#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
	Tcl_MutexLock(&init_mx);
    Tcl_MutexLock(&init_mx);
#endif
	initialized = 1;
    initialized = 1;

#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
	num_locks = CRYPTO_num_locks();
	locksCount = num_locks;
	locks = malloc(sizeof(*locks) * num_locks);
	memset(locks, 0, sizeof(*locks) * num_locks);
    num_locks = CRYPTO_num_locks();
    locksCount = num_locks;
    locks = malloc(sizeof(*locks) * num_locks);
    memset(locks, 0, sizeof(*locks) * num_locks);

	CRYPTO_set_locking_callback(CryptoThreadLockCallback);
	CRYPTO_set_id_callback(CryptoThreadIdCallback);
    CRYPTO_set_locking_callback(CryptoThreadLockCallback);
    CRYPTO_set_id_callback(CryptoThreadIdCallback);
#endif

	if (SSL_library_init() != 1) {
		status = TCL_ERROR;
		goto done;
	}
    if (SSL_library_init() != 1) {
	status = TCL_ERROR;
	goto done;
    }

	SSL_load_error_strings();
	ERR_load_crypto_strings();
    SSL_load_error_strings();
    ERR_load_crypto_strings();

	BIO_new_tcl(NULL, 0);
    BIO_new_tcl(NULL, 0);

done:
#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
	Tcl_MutexUnlock(&init_mx);
    Tcl_MutexUnlock(&init_mx);
#endif

	return(status);
    return(status);
}
11
12
13
14
15
16
17

18
19
20
21
22
23
24
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25







+







 * to enhance it to support full fileevent semantics.
 *
 * Also work done by the follow people provided the impetus to do this "right":-
 *	tclSSL (Colin McCormack, Shared Technology)
 *	SSLtcl (Peter Antman)
 *
 */

#ifndef _TLS_H
#define _TLS_H

#include <tcl.h>

/*
 * Initialization routines -- our entire public C API.
1
2
3
4

5
6
7
8
9
10
11
1
2
3

4
5
6
7
8
9
10
11



-
+







/*
 * Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com>
 *
 * Provides BIO layer to interface openssl to Tcl.
 * Provides BIO layer to interface OpenSSL to Tcl.
 */

#include "tlsInt.h"

#ifdef TCLTLS_OPENSSL_PRE_1_1_API
#define BIO_get_data(bio)                ((bio)->ptr)
#define BIO_get_init(bio)                ((bio)->init)
34
35
36
37
38
39
40
41
42
43






44
45
46
47
48
49
50






51
52
53

54
55
56
57
58
59
60
61
62
63









64
65
66


67
68
69


70
71
72
73
74
75
76
77






78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93















94
95
96
97
98
99
100






101
102

103
104
105
106
107
108




109
110

111
112
113
114
115
116



117
118

119
120

121
122

123
124
125


126
127

128
129

130
131
132
133
134
135
136
137
138
139
140










141
142
143
144
145
146
147
148
149








150
151
152
153



154
155
156
157



158
159

160
161

162
163
164
165



166
167

168
169

170
171
172
173



174
175

176
177
178


179
180

181
182

183
184
185
186
187
188
189
190
191
192
193










194
195
196
197
198
199
200
201
202








203
204
205
206



207
208
209
210



211
212

213
214

215
216
217
218

219
220

221
222
223
224
225


226
227

228
229

230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284






















































285
286
287
288
289




290
291
292
293
294
295




296
297
298
299
300
301





302
303

304
305
306
307

308
309
310
311



312
313

314
315
316
317
318
319



320
321

322
323
324
325
326
327





328
329
330
331



332
333

334
34
35
36
37
38
39
40



41
42
43
44
45
46
47






48
49
50
51
52
53
54
55

56
57









58
59
60
61
62
63
64
65
66
67


68
69
70


71
72
73
74






75
76
77
78
79
80
81















82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97






98
99
100
101
102
103
104

105
106
107




108
109
110
111


112
113
114
115



116
117
118
119

120
121

122
123

124
125


126
127
128

129
130

131
132










133
134
135
136
137
138
139
140
141
142
143








144
145
146
147
148
149
150
151
152



153
154
155
156



157
158
159


160
161
162
163
164



165
166
167
168

169
170

171
172



173
174
175
176

177
178


179
180
181

182
183

184
185










186
187
188
189
190
191
192
193
194
195
196








197
198
199
200
201
202
203
204
205



206
207
208
209



210
211
212
213

214
215

216
217
218
219

220
221

222
223
224
225


226
227
228

229
230

231
232






















































233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287




288
289
290
291
292
293




294
295
296
297
298





299
300
301
302
303
304

305
306
307
308

309
310



311
312
313
314

315
316
317
318



319
320
321
322

323
324





325
326
327
328
329
330



331
332
333
334

335
336







-
-
-
+
+
+
+
+
+

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


-
+

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

-
-
+
+

-
-
+
+


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

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

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

-
+


-
-
-
-
+
+
+
+
-
-
+



-
-
-
+
+
+

-
+

-
+

-
+

-
-
+
+

-
+

-
+

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

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

-
-
-
+
+
+

-
-
-
+
+
+
-
-
+


+

-
-
-
+
+
+

-
+

-
+

-
-
-
+
+
+

-
+

-
-
+
+

-
+

-
+

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

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

-
-
-
+
+
+

-
-
-
+
+
+

-
+

-
+



-
+

-
+



-
-
+
+

-
+

-
+

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

-
-
-
-
+
+
+
+


-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
+



-
+

-
-
-
+
+
+

-
+



-
-
-
+
+
+

-
+

-
-
-
-
-
+
+
+
+
+

-
-
-
+
+
+

-
+

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

BIO *BIO_new_tcl(State *statePtr, int flags) {
	BIO *bio;
	static BIO_METHOD *BioMethods = NULL;
BIO *BIO_new_tcl(
    State *statePtr,
    int flags)
{
    BIO *bio;
    static BIO_METHOD *BioMethods = NULL;
#ifdef TCLTLS_SSL_USE_FASTPATH
	Tcl_Channel parentChannel;
	const Tcl_ChannelType *parentChannelType;
	void *parentChannelFdIn_p, *parentChannelFdOut_p;
	int parentChannelFdIn, parentChannelFdOut, parentChannelFd;
	int validParentChannelFd;
	int tclGetChannelHandleRet;
    Tcl_Channel parentChannel;
    const Tcl_ChannelType *parentChannelType;
    void *parentChannelFdIn_p, *parentChannelFdOut_p;
    int parentChannelFdIn, parentChannelFdOut, parentChannelFd;
    int validParentChannelFd;
    int tclGetChannelHandleRet;
#endif

	dprintf("BIO_new_tcl() called");
    dprintf("BIO_new_tcl() called");

	if (BioMethods == NULL) {
		BioMethods = BIO_meth_new(BIO_TYPE_TCL, "tcl");
		BIO_meth_set_write(BioMethods, BioWrite);
		BIO_meth_set_read(BioMethods, BioRead);
		BIO_meth_set_puts(BioMethods, BioPuts);
		BIO_meth_set_ctrl(BioMethods, BioCtrl);
		BIO_meth_set_create(BioMethods, BioNew);
		BIO_meth_set_destroy(BioMethods, BioFree);
	}
    if (BioMethods == NULL) {
	BioMethods = BIO_meth_new(BIO_TYPE_TCL, "tcl");
	BIO_meth_set_write(BioMethods, BioWrite);
	BIO_meth_set_read(BioMethods, BioRead);
	BIO_meth_set_puts(BioMethods, BioPuts);
	BIO_meth_set_ctrl(BioMethods, BioCtrl);
	BIO_meth_set_create(BioMethods, BioNew);
	BIO_meth_set_destroy(BioMethods, BioFree);
    }

	if (statePtr == NULL) {
		dprintf("Asked to setup a NULL state, just creating the initial configuration");
    if (statePtr == NULL) {
	dprintf("Asked to setup a NULL state, just creating the initial configuration");

		return(NULL);
	}
	return(NULL);
    }

#ifdef TCLTLS_SSL_USE_FASTPATH
	/*
	 * If the channel can be mapped back to a file descriptor, just use the file descriptor
	 * with the SSL library since it will likely be optimized for this.
	 */
	parentChannel = Tls_GetParent(statePtr, 0);
	parentChannelType = Tcl_GetChannelType(parentChannel);
    /*
     * If the channel can be mapped back to a file descriptor, just use the file descriptor
     * with the SSL library since it will likely be optimized for this.
     */
    parentChannel = Tls_GetParent(statePtr, 0);
    parentChannelType = Tcl_GetChannelType(parentChannel);

	validParentChannelFd = 0;
	if (strcmp(parentChannelType->typeName, "tcp") == 0) {
		tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_READABLE, &parentChannelFdIn_p);
		if (tclGetChannelHandleRet == TCL_OK) {
			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;
					validParentChannelFd = 1;
				}
			}
		}
	}
    validParentChannelFd = 0;
    if (strcmp(parentChannelType->typeName, "tcp") == 0) {
	tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_READABLE, &parentChannelFdIn_p);
	if (tclGetChannelHandleRet == TCL_OK) {
	    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;
		    validParentChannelFd = 1;
		}
	    }
	}
    }

	if (validParentChannelFd) {
		dprintf("We found a shortcut, this channel is backed by a socket: %i", parentChannelFdIn);
		bio = BIO_new_socket(parentChannelFd, flags);
		statePtr->flags |= TLS_TCL_FASTPATH;
		return(bio);
	}
    if (validParentChannelFd) {
	dprintf("We found a shortcut, this channel is backed by a socket: %i", parentChannelFdIn);
	bio = BIO_new_socket(parentChannelFd, flags);
	statePtr->flags |= TLS_TCL_FASTPATH;
	return(bio);
    }

	dprintf("Falling back to Tcl I/O for this channel");
    dprintf("Falling back to Tcl I/O for this channel");
#endif

	bio = BIO_new(BioMethods);
	BIO_set_data(bio, statePtr);
	BIO_set_shutdown(bio, flags);
	BIO_set_init(bio, 1);
    bio = BIO_new(BioMethods);
    BIO_set_data(bio, statePtr);
    BIO_set_shutdown(bio, flags);
    BIO_set_init(bio, 1);

	return(bio);
    return(bio);
}

static int BioWrite(BIO *bio, const char *buf, int bufLen) {
	Tcl_Channel chan;
	int ret;
	int tclEofChan, tclErrno;
    Tcl_Channel chan;
    int ret;
    int tclEofChan, tclErrno;

	chan = Tls_GetParent((State *) BIO_get_data(bio), 0);
    chan = Tls_GetParent((State *) BIO_get_data(bio), 0);

	dprintf("[chan=%p] BioWrite(%p, <buf>, %d)", (void *)chan, (void *) bio, bufLen);
    dprintf("[chan=%p] BioWrite(%p, <buf>, %d)", (void *)chan, (void *) bio, bufLen);

	ret = Tcl_WriteRaw(chan, buf, bufLen);
    ret = Tcl_WriteRaw(chan, buf, bufLen);

	tclEofChan = Tcl_Eof(chan);
	tclErrno = Tcl_GetErrno();
    tclEofChan = Tcl_Eof(chan);
    tclErrno = Tcl_GetErrno();

	dprintf("[chan=%p] BioWrite(%d) -> %d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, Tcl_GetErrno());
    dprintf("[chan=%p] BioWrite(%d) -> %d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, Tcl_GetErrno());

	BIO_clear_flags(bio, BIO_FLAGS_WRITE | BIO_FLAGS_SHOULD_RETRY);
    BIO_clear_flags(bio, BIO_FLAGS_WRITE | BIO_FLAGS_SHOULD_RETRY);

	if (tclEofChan && ret <= 0) {
		dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
		Tcl_SetErrno(ECONNRESET);
		ret = 0;
	} else if (ret == 0) {
		dprintf("Got 0 from Tcl_WriteRaw, and EOF is not set; ret = 0");
		dprintf("Setting retry read flag");
		BIO_set_retry_read(bio);
	} else if (ret < 0) {
		dprintf("We got some kind of I/O error");
    if (tclEofChan && ret <= 0) {
	dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
	Tcl_SetErrno(ECONNRESET);
	ret = 0;
    } else if (ret == 0) {
	dprintf("Got 0 from Tcl_WriteRaw, and EOF is not set; ret = 0");
	dprintf("Setting retry read flag");
	BIO_set_retry_read(bio);
    } else if (ret < 0) {
	dprintf("We got some kind of I/O error");

		if (tclErrno == EAGAIN) {
			dprintf("It's EAGAIN");
		} else {
			dprintf("It's an unepxected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno);
		}
	} else {
		dprintf("Successfully wrote some data");
	}
	if (tclErrno == EAGAIN) {
	    dprintf("It's EAGAIN");
	} else {
	    dprintf("It's an unexpected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno);
	}
    } else {
	dprintf("Successfully wrote some data");
    }

	if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) {
		if (BIO_should_read(bio)) {
			dprintf("Setting should retry read flag");
    if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) {
	if (BIO_should_read(bio)) {
	    dprintf("Setting should retry read flag");

			BIO_set_retry_read(bio);
		}
	}
	    BIO_set_retry_read(bio);
	}
    }

	return(ret);
    return(ret);
}

/* Called by SSL_read()*/
static int BioRead(BIO *bio, char *buf, int bufLen) {
	Tcl_Channel chan;
	int ret = 0;
	int tclEofChan, tclErrno;
    Tcl_Channel chan;
    int ret = 0;
    int tclEofChan, tclErrno;

	chan = Tls_GetParent((State *) BIO_get_data(bio), 0);
    chan = Tls_GetParent((State *) BIO_get_data(bio), 0);

	dprintf("[chan=%p] BioRead(%p, <buf>, %d)", (void *) chan, (void *) bio, bufLen);
    dprintf("[chan=%p] BioRead(%p, <buf>, %d)", (void *) chan, (void *) bio, bufLen);

	if (buf == NULL) {
		return 0;
	}
    if (buf == NULL) {
	return 0;
    }

	ret = Tcl_ReadRaw(chan, buf, bufLen);
    ret = Tcl_ReadRaw(chan, buf, bufLen);

	tclEofChan = Tcl_Eof(chan);
	tclErrno = Tcl_GetErrno();
    tclEofChan = Tcl_Eof(chan);
    tclErrno = Tcl_GetErrno();

	dprintf("[chan=%p] BioRead(%d) -> %d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, tclErrno);
    dprintf("[chan=%p] BioRead(%d) -> %d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, tclErrno);

	BIO_clear_flags(bio, BIO_FLAGS_READ | BIO_FLAGS_SHOULD_RETRY);
    BIO_clear_flags(bio, BIO_FLAGS_READ | BIO_FLAGS_SHOULD_RETRY);

	if (tclEofChan && ret <= 0) {
		dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
		Tcl_SetErrno(ECONNRESET);
		ret = 0;
	} else if (ret == 0) {
		dprintf("Got 0 from Tcl_Read or Tcl_ReadRaw, and EOF is not set; ret = 0");
		dprintf("Setting retry read flag");
		BIO_set_retry_read(bio);
	} else if (ret < 0) {
		dprintf("We got some kind of I/O error");
    if (tclEofChan && ret <= 0) {
	dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
	Tcl_SetErrno(ECONNRESET);
	ret = 0;
    } else if (ret == 0) {
	dprintf("Got 0 from Tcl_Read or Tcl_ReadRaw, and EOF is not set; ret = 0");
	dprintf("Setting retry read flag");
	BIO_set_retry_read(bio);
    } else if (ret < 0) {
	dprintf("We got some kind of I/O error");

		if (tclErrno == EAGAIN) {
			dprintf("It's EAGAIN");
		} else {
			dprintf("It's an unepxected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno);
		}
	} else {
		dprintf("Successfully read some data");
	}
	if (tclErrno == EAGAIN) {
	    dprintf("It's EAGAIN");
	} else {
	    dprintf("It's an unexpected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno);
	}
    } else {
	dprintf("Successfully read some data");
    }

	if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) {
		if (BIO_should_write(bio)) {
			dprintf("Setting should retry write flag");
    if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) {
	if (BIO_should_write(bio)) {
	    dprintf("Setting should retry write flag");

			BIO_set_retry_write(bio);
		}
	}
	    BIO_set_retry_write(bio);
	}
    }

	dprintf("BioRead(%p, <buf>, %d) [%p] returning %i", (void *) bio, bufLen, (void *) chan, ret);
    dprintf("BioRead(%p, <buf>, %d) [%p] returning %i", (void *) bio, bufLen, (void *) chan, ret);

	return(ret);
    return(ret);
}

static int BioPuts(BIO *bio, const char *str) {
	dprintf("BioPuts(%p, <string:%p>) called", bio, str);
    dprintf("BioPuts(%p, <string:%p>) called", bio, str);

	return BioWrite(bio, str, (int) strlen(str));
    return BioWrite(bio, str, (int) strlen(str));
}

static long BioCtrl(BIO *bio, int cmd, long num, void *ptr) {
	Tcl_Channel chan;
	long ret = 1;
    Tcl_Channel chan;
    long ret = 1;

	chan = Tls_GetParent((State *) BIO_get_data(bio), 0);
    chan = Tls_GetParent((State *) BIO_get_data(bio), 0);

	dprintf("BioCtrl(%p, 0x%x, 0x%lx, %p)", bio, cmd, num, ptr);
    dprintf("BioCtrl(%p, 0x%x, 0x%lx, %p)", bio, cmd, num, ptr);

	switch (cmd) {
		case BIO_CTRL_RESET:
			dprintf("Got BIO_CTRL_RESET");
			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:
			dprintf("Got BIO_CTRL_INFO");
			ret = 1;
			break;
		case BIO_C_SET_FD:
			dprintf("Unsupported call: BIO_C_SET_FD");
			ret = -1;
			break;
		case BIO_C_GET_FD:
			dprintf("Unsupported call: BIO_C_GET_FD");
			ret = -1;
			break;
		case BIO_CTRL_GET_CLOSE:
			dprintf("Got BIO_CTRL_CLOSE");
			ret = BIO_get_shutdown(bio);
			break;
		case BIO_CTRL_SET_CLOSE:
			dprintf("Got BIO_SET_CLOSE");
			BIO_set_shutdown(bio, num);
			break;
		case BIO_CTRL_EOF:
			dprintf("Got BIO_CTRL_EOF");
			ret = Tcl_Eof(chan);
			break;
		case BIO_CTRL_PENDING:
			dprintf("Got BIO_CTRL_PENDING");
			ret = ((chan) ? Tcl_InputBuffered(chan) : 0);
			dprintf("BIO_CTRL_PENDING(%d)", (int) ret);
			break;
		case BIO_CTRL_WPENDING:
			dprintf("Got BIO_CTRL_WPENDING");
			ret = 0;
			break;
		case BIO_CTRL_DUP:
			dprintf("Got BIO_CTRL_DUP");
			break;
		case BIO_CTRL_FLUSH:
			dprintf("Got BIO_CTRL_FLUSH");
			ret = ((Tcl_WriteRaw(chan, "", 0) >= 0) ? 1 : -1);
			dprintf("BIO_CTRL_FLUSH returning value %li", ret);
			break;
    switch (cmd) {
	case BIO_CTRL_RESET:
		dprintf("Got BIO_CTRL_RESET");
		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:
		dprintf("Got BIO_CTRL_INFO");
		ret = 1;
		break;
	case BIO_C_SET_FD:
		dprintf("Unsupported call: BIO_C_SET_FD");
		ret = -1;
		break;
	case BIO_C_GET_FD:
		dprintf("Unsupported call: BIO_C_GET_FD");
		ret = -1;
		break;
	case BIO_CTRL_GET_CLOSE:
		dprintf("Got BIO_CTRL_CLOSE");
		ret = BIO_get_shutdown(bio);
		break;
	case BIO_CTRL_SET_CLOSE:
		dprintf("Got BIO_SET_CLOSE");
		BIO_set_shutdown(bio, num);
		break;
	case BIO_CTRL_EOF:
		dprintf("Got BIO_CTRL_EOF");
		ret = Tcl_Eof(chan);
		break;
	case BIO_CTRL_PENDING:
		dprintf("Got BIO_CTRL_PENDING");
		ret = ((chan) ? Tcl_InputBuffered(chan) : 0);
		dprintf("BIO_CTRL_PENDING(%d)", (int) ret);
		break;
	case BIO_CTRL_WPENDING:
		dprintf("Got BIO_CTRL_WPENDING");
		ret = 0;
		break;
	case BIO_CTRL_DUP:
		dprintf("Got BIO_CTRL_DUP");
		break;
	case BIO_CTRL_FLUSH:
		dprintf("Got BIO_CTRL_FLUSH");
		ret = ((Tcl_WriteRaw(chan, "", 0) >= 0) ? 1 : -1);
		dprintf("BIO_CTRL_FLUSH returning value %li", ret);
		break;
#ifdef BIO_CTRL_GET_KTLS_SEND
		case BIO_CTRL_GET_KTLS_SEND:
			dprintf("Got BIO_CTRL_GET_KTLS_SEND");
			ret = 0;
			break;
	case BIO_CTRL_GET_KTLS_SEND:
		dprintf("Got BIO_CTRL_GET_KTLS_SEND");
		ret = 0;
		break;
#endif
#ifdef BIO_CTRL_GET_KTLS_RECV
		case BIO_CTRL_GET_KTLS_RECV:
			dprintf("Got BIO_CTRL_GET_KTLS_RECV");
			ret = 0;
			break;
	case BIO_CTRL_GET_KTLS_RECV:
		dprintf("Got BIO_CTRL_GET_KTLS_RECV");
		ret = 0;
		break;
#endif
		default:
			dprintf("Got unknown control command (%i)", cmd);
			ret = -2;
			break;
	}
	default:
		dprintf("Got unknown control command (%i)", cmd);
		ret = -2;
		break;
    }

	return(ret);
    return(ret);
}

static int BioNew(BIO *bio) {
	dprintf("BioNew(%p) called", bio);
    dprintf("BioNew(%p) called", bio);

	BIO_set_init(bio, 0);
	BIO_set_data(bio, NULL);
	BIO_clear_flags(bio, -1);
    BIO_set_init(bio, 0);
    BIO_set_data(bio, NULL);
    BIO_clear_flags(bio, -1);

	return(1);
    return(1);
}

static int BioFree(BIO *bio) {
	if (bio == NULL) {
		return(0);
	}
    if (bio == NULL) {
	return(0);
    }

	dprintf("BioFree(%p) called", bio);
    dprintf("BioFree(%p) called", bio);

	if (BIO_get_shutdown(bio)) {
		if (BIO_get_init(bio)) {
			/*shutdown(bio->num, 2) */
			/*closesocket(bio->num) */
		}
    if (BIO_get_shutdown(bio)) {
	if (BIO_get_init(bio)) {
	    /*shutdown(bio->num, 2) */
	    /*closesocket(bio->num) */
	}

		BIO_set_init(bio, 0);
		BIO_clear_flags(bio, -1);
	}
	BIO_set_init(bio, 0);
	BIO_clear_flags(bio, -1);
    }

	return(1);
    return(1);
}
8
9
10
11
12
13
14
15
16


17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84

85

86
87

88
89
90

91
92
93
94
95

96
97
98
99
100
101





102
103

104
105
106
107
108
109
110
111
112
113



114
115

116
117
118

119
120
121

122
123
124
125
126





127
128

129
130
131
132



133
134

135
136
137






138
139
140
141
142




143
144
145
146
147
148

149
150
151


152
153
154


155
156
157
158
159
160
161



162
163
164


165
166
167
168
169
170





171
172
173
174
175
176
177
178
179
180
181
182
183
184
185














186
187
188
189
190




191
192
193
194



195
196
197


198
199
200


201
202

203
204
205
206
207




208
209

210
211

212
213
214
215
216
217
218
219
220
221
222
223
224
225
226














227
228
229


230
231
232


233
234

235
236
237
238



239
240
241
242



243
244
245
246



247
248
249

250
251
252
253
254
255
256
257
258
259
260










261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
















278
279

280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
















297
298
299
300


301
302
303
304



305
306
307
308
309
310
311






312
313
314
315


316
317
318


319
320

321
322
323
324
325
326
327
328

329
330
331
332
333


334
335
336
337

338
339
340
341
342
343
344
345
346
347











348
349

350
351

352
353
354
355
356
357





358
359
360
361
362




363
364
365
366
367
368
369
370







371
372
373


374
375
376
377
378
379
380
381
382
383
384
385
386
387
388














389
390

391
392
393
394
395
396
397
398






399
400
401
402
403
404
405
406






407
408
409
410



411
412
413
414



415
416

417
418
419
420
421


422
423
424
425


426
427
428

429
430

431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446




447
448
449


450
451
452
453
454
455
456
457

458
459
460
461
462


463
464
465

466
467
468
469
470
471
472
473
474










475
476

477
478
479


480
481
482
483
484
485
486






487
488
489
490
491




492
493
494
495
496
497
498
499







500
501
502


503
504
505
506



507
508
509


510
511
512
513
514




515
516
517
518
519




520
521
522
523
524
525
526
527
528
529
530
531
532
533
534














535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560

























561
562
563
564
565
566
567
568
569
570
571
572
573
574













575
576
577
578
579
580
581
582
583
584
585










586
587
588


589
590
591
592
593
594
595
596
597


598
599
600
601
602



603
604
605

606
607
608
609

610
611
612



613
614

615
616

617
618
619
620
621
622


623
624
625
626

627
628
629
630
631




632
633
634
635
636
637
638
639
640
641
642
643
644

645
646
647

648
649
650
651


652
653
654
655
656
657
658



659
660

661
662
663
664
665
666
667
668
669
670
671


672
673
674
675
676
677
678
679

680
681
682
683

684
685
686

687
688
689

690
691
692
693
694
695
696
697







698
699
700
701


702
703
704
705
706



707
708
709
710
711
712





713
714
715
716
717
718
719
720
721
722









723
724
725
726
727
728
729
730
731
732


733
734
735

736
737
738

739
740
741
742
743






744
745

746
747
748
749
750
751
752
753
754


755
756
757

758
759
760

761
762
763
764
765
766
767







768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
















785
786
787
788
789




790
791
792
793
794
795





796
797
798


799
800
801


802
803

804
805

806
807
808
809
810
811
812
8
9
10
11
12
13
14


15
16
17
18
19
20
21
22
23
24










25
26
27
























28
29



















30
31

32
33
34
35

36
37
38

39
40
41
42
43

44
45





46
47
48
49
50


51
52
53
54
55
56
57
58



59
60
61
62

63
64
65

66
67
68

69
70
71
72


73
74
75
76
77
78

79
80



81
82
83


84



85
86
87
88
89
90





91
92
93
94
95
96
97
98
99

100
101


102
103
104


105
106
107
108
109
110



111
112
113
114


115
116
117





118
119
120
121
122
123














124
125
126
127
128
129
130
131
132
133
134
135
136
137
138




139
140
141
142
143



144
145
146



147
148
149


150
151
152

153





154
155
156
157
158

159
160

161
162














163
164
165
166
167
168
169
170
171
172
173
174
175
176
177


178
179
180


181
182


183




184
185
186




187
188
189
190



191
192
193
194
195

196
197










198
199
200
201
202
203
204
205
206
207
208
















209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225

226
227
















228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245


246
247
248



249
250
251
252






253
254
255
256
257
258
259
260


261
262
263


264
265


266
267
268
269
270
271
272
273

274
275
276
277


278
279

280
281

282
283
284
285
286






287
288
289
290
291
292
293
294
295
296
297
298

299
300

301
302





303
304
305
306
307
308




309
310
311
312
313







314
315
316
317
318
319
320



321
322
323














324
325
326
327
328
329
330
331
332
333
334
335
336
337
338

339
340
341






342
343
344
345
346
347
348
349






350
351
352
353
354
355
356



357
358
359
360



361
362
363
364

365
366
367
368


369
370
371
372


373
374
375
376

377
378

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




392
393
394
395
396


397
398
399
400
401
402
403
404
405

406
407
408
409


410
411
412
413

414
415
416
417
418





419
420
421
422
423
424
425
426
427
428
429

430
431


432
433
434






435
436
437
438
439
440
441




442
443
444
445
446







447
448
449
450
451
452
453



454
455
456



457
458
459
460


461
462
463




464
465
466
467
468




469
470
471
472
473














474
475
476
477
478
479
480
481
482
483
484
485
486
487
488

























489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514













515
516
517
518
519
520
521
522
523
524
525
526
527











528
529
530
531
532
533
534
535
536
537
538


539
540
541
542
543
544
545
546
547


548
549
550
551



552
553
554
555
556

557
558
559
560
561
562



563
564
565


566


567

568
569
570


571
572
573
574
575

576
577




578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593

594
595
596

597
598
599


600
601
602
603
604
605
606


607
608
609


610
611
612
613
614
615
616
617
618
619


620
621
622
623
624
625
626
627
628

629

630

631
632
633


634
635
636

637
638







639
640
641
642
643
644
645




646
647
648
649



650
651
652






653
654
655
656
657
658









659
660
661
662
663
664
665
666
667

668
669
670
671
672
673
674


675
676
677
678

679
680
681

682
683
684
685


686
687
688
689
690
691
692

693
694
695
696
697
698
699
700


701
702
703
704

705
706
707

708
709
710
711
712



713
714
715
716
717
718
719
720
















721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737




738
739
740
741
742





743
744
745
746
747
748


749
750
751


752
753
754

755
756

757
758
759
760
761
762
763
764







-
-
+
+








-
-
-
-
-
-
-
-
-
-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
+

+

-
+


-
+




-
+

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







-
-
-
+
+
+

-
+


-
+


-
+



-
-
+
+
+
+
+

-
+

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





-
+

-
-
+
+

-
-
+
+




-
-
-
+
+
+

-
-
+
+

-
-
-
-
-
+
+
+
+
+

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

-
-
-
-
+
+
+
+

-
-
-
+
+
+
-
-
-
+
+

-
-
+
+

-
+
-
-
-
-
-
+
+
+
+

-
+

-
+

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

-
-
+
+

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

-
-
-
+
+
+


-
+

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

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

-
+

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


-
-
+
+

-
-
-
+
+
+

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


-
-
+
+

-
-
+
+
-
-
+







-
+



-
-
+
+
-


-
+




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

-
+

-
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
+
+
+
+

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

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

-
+


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


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

-
-
-
+
+
+

-
-
-
+
+
+

-
+



-
-
+
+


-
-
+
+


-
+

-
+












-
-
-
-
+
+
+
+

-
-
+
+







-
+



-
-
+
+


-
+




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

-
+

-
-
+
+

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

-
-
-
-
+
+
+
+

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

-
-
-
+
+
+

-
-
+
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

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

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

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

-
-
+
+







-
-
+
+


-
-
-
+
+
+


-
+




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



-
-
+
+



-
+

-
-
-
-
+
+
+
+












-
+


-
+


-
-
+
+





-
-
+
+
+
-
-
+









-
-
+
+







-
+
-

-

+

-
-
+


-
+

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


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

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







-
-
+
+


-
+


-
+



-
-
+
+
+
+
+
+

-
+







-
-
+
+


-
+


-
+




-
-
-
+
+
+
+
+
+
+

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

-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
+
+

-
+

-
+







 * This was built from scratch based upon observation of OpenSSL 0.9.2B
 *
 * 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.
 *
 * Also work done by the follow people provided the impetus to do this "right":
 *	tclSSL (Colin McCormack, Shared Technology)
 *	SSLtcl (Peter Antman)
 *    tclSSL (Colin McCormack, Shared Technology)
 *    SSLtcl (Peter Antman)
 *
 */

#include "tlsInt.h"

/*
 * Forward declarations
 */
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);
static void TlsChannelHandlerTimer(void *clientData);

/*
 * TLS Channel Type
 */
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 --
 *
 *	Return the correct TLS channel driver info
 *
 * Results:
 *	The correct channel driver for the current version of Tcl.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
const Tcl_ChannelType *Tls_ChannelType(void) {
	return &tlsChannelType;
}

/*
 *-------------------------------------------------------------------
 *
 * TlsBlockModeProc --
 *
 *	This procedure is invoked by the generic IO level
 *    This procedure is invoked by the generic IO level
 *       to set blocking and nonblocking modes
 *
 * Results:
 *	0 if successful, errno when failed.
 *    0 if successful or POSIX error code if failed.
 *
 * Side effects:
 *	Sets the device into blocking or nonblocking mode.
 *    Sets the device into blocking or nonblocking mode.
 *
 *-------------------------------------------------------------------
 */
static int TlsBlockModeProc(void *instanceData, int mode) {
	State *statePtr = (State *) instanceData;
    State *statePtr = (State *) instanceData;

	if (mode == TCL_MODE_NONBLOCKING) {
		statePtr->flags |= TLS_TCL_ASYNC;
	} else {
		statePtr->flags &= ~(TLS_TCL_ASYNC);
	}
    if (mode == TCL_MODE_NONBLOCKING) {
	statePtr->flags |= TLS_TCL_ASYNC;
    } else {
	statePtr->flags &= ~(TLS_TCL_ASYNC);
    }

	return(0);
    return(0);
}

/*
 *-------------------------------------------------------------------
 *
 * TlsCloseProc --
 *
 *	This procedure is invoked by the generic IO level to perform
 *	channel-type-specific cleanup when a SSL socket based channel
 *	is closed.
 *    This procedure is invoked by the generic IO level to perform
 *    channel-type-specific cleanup when a SSL socket based channel
 *    is closed.
 *
 *	Note: we leave the underlying socket alone, is this right?
 *    Note: we leave the underlying socket alone, is this right?
 *
 * Results:
 *	0 if successful, the value of Tcl_GetErrno() if failed.
 *    0 if successful or POSIX error code if failed.
 *
 * Side effects:
 *	Closes the socket of the channel.
 *    Closes the socket of the channel.
 *
 *-------------------------------------------------------------------
 */
static int TlsCloseProc(void *instanceData, TCL_UNUSED(Tcl_Interp *)) {
	State *statePtr = (State *) instanceData;
static int TlsCloseProc(
    void *instanceData,
    TCL_UNUSED(Tcl_Interp *))
{
    State *statePtr = (State *) instanceData;

	dprintf("TlsCloseProc(%p)", statePtr);
    dprintf("TlsCloseProc(%p)", statePtr);

	Tls_Clean(statePtr);
	Tcl_EventuallyFree(statePtr, Tls_Free);

    Tls_Clean(statePtr);
    Tcl_EventuallyFree(statePtr, Tls_Free);
    return TCL_OK;
	dprintf("Returning TCL_OK");

}
	return(TCL_OK);
}


static int TlsClose2Proc(
    void *instanceData,    /* The socket state. */
    Tcl_Interp *interp,		/* For errors - can be NULL. */
    int flags)			/* Flags to close read and/or write side of channel */
{
static int TlsClose2Proc(void *instanceData, Tcl_Interp *interp, int flags) {
	if (!(flags&(TCL_CLOSE_READ|TCL_CLOSE_WRITE))) {
	    return TlsCloseProc(instanceData, interp);
	}
	return EINVAL;
    if (!(flags&(TCL_CLOSE_READ|TCL_CLOSE_WRITE))) {
	return TlsCloseProc(instanceData, interp);
    }
    return EINVAL;
}

/*
 *------------------------------------------------------*
 *
 *	Tls_WaitForConnect --
 * Tls_WaitForConnect --
 *
 *	Sideeffects:
 *		Issues SSL_accept or SSL_connect
 * Result:
 *    0 if successful, -1 if failed.
 *
 *	Result:
 *		None.
 * Side effects:
 *    Issues SSL_accept or SSL_connect
 *
 *------------------------------------------------------*
 */
int Tls_WaitForConnect(State *statePtr, int *errorCodePtr, int handshakeFailureIsPermanent) {
	unsigned long backingError;
	int err, rc;
	int bioShouldRetry;
    unsigned long backingError;
    int err, rc;
    int bioShouldRetry;

	dprintf("WaitForConnect(%p)", statePtr);
	dprintFlags(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;
		return(0);
	}
    if (!(statePtr->flags & TLS_TCL_INIT)) {
	dprintf("Tls_WaitForConnect called on already initialized channel -- returning with immediate success");
	*errorCodePtr = 0;
	return(0);
    }

	if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) {
		/*
		 * Different types of operations have different requirements
		 * SSL being established
		 */
		if (handshakeFailureIsPermanent) {
			dprintf("Asked to wait for a TLS handshake that has already failed.  Returning fatal error");
			*errorCodePtr = ECONNABORTED;
		} else {
			dprintf("Asked to wait for a TLS handshake that has already failed.  Returning soft error");
			*errorCodePtr = ECONNRESET;
		}
		return(-1);
	}
    if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) {
	/*
	 * Different types of operations have different requirements
	 * SSL being established
	 */
	if (handshakeFailureIsPermanent) {
	    dprintf("Asked to wait for a TLS handshake that has already failed.  Returning fatal error");
	    *errorCodePtr = ECONNABORTED;
	} else {
	    dprintf("Asked to wait for a TLS handshake that has already failed.  Returning soft error");
	    *errorCodePtr = ECONNRESET;
	}
	return(-1);
    }

	for (;;) {
		/* Not initialized yet! */
		if (statePtr->flags & TLS_TCL_SERVER) {
			dprintf("Calling SSL_accept()");
    for (;;) {
	/* Not initialized yet! */
	if (statePtr->flags & TLS_TCL_SERVER) {
	    dprintf("Calling SSL_accept()");

			err = SSL_accept(statePtr->ssl);
		} else {
			dprintf("Calling SSL_connect()");
		err = SSL_accept(statePtr->ssl);
	} else {
	    dprintf("Calling SSL_connect()");

			err = SSL_connect(statePtr->ssl);
		}
	    err = SSL_connect(statePtr->ssl);
	}

		if (err > 0) {
			dprintf("That seems to have gone okay");
	if (err > 0) {
	    dprintf("That seems to have gone okay");

			err = BIO_flush(statePtr->bio);
	    err = BIO_flush(statePtr->bio);

			if (err <= 0) {
				dprintf("Flushing the lower layers failed, this will probably terminate this session");
			}
		}
	    if (err <= 0) {
		dprintf("Flushing the lower layers failed, this will probably terminate this session");
	    }
	}

		rc = SSL_get_error(statePtr->ssl, err);
	rc = SSL_get_error(statePtr->ssl, err);

		dprintf("Got error: %i (rc = %i)", err, rc);
	dprintf("Got error: %i (rc = %i)", err, rc);

		bioShouldRetry = 0;
		if (err <= 0) {
			if (rc == SSL_ERROR_WANT_CONNECT || rc == SSL_ERROR_WANT_ACCEPT || rc == SSL_ERROR_WANT_READ || rc == SSL_ERROR_WANT_WRITE) {
				bioShouldRetry = 1;
			} else if (BIO_should_retry(statePtr->bio)) {
				bioShouldRetry = 1;
			} else if (rc == SSL_ERROR_SYSCALL && Tcl_GetErrno() == EAGAIN) {
				bioShouldRetry = 1;
			}
		} else {
			if (!SSL_is_init_finished(statePtr->ssl)) {
				bioShouldRetry = 1;
			}
		}
	bioShouldRetry = 0;
	if (err <= 0) {
	    if (rc == SSL_ERROR_WANT_CONNECT || rc == SSL_ERROR_WANT_ACCEPT || rc == SSL_ERROR_WANT_READ || rc == SSL_ERROR_WANT_WRITE) {
		bioShouldRetry = 1;
	    } else if (BIO_should_retry(statePtr->bio)) {
		bioShouldRetry = 1;
	    } else if (rc == SSL_ERROR_SYSCALL && Tcl_GetErrno() == EAGAIN) {
		bioShouldRetry = 1;
	    }
	} else {
	    if (!SSL_is_init_finished(statePtr->ssl)) {
		bioShouldRetry = 1;
	    }
	}

		if (bioShouldRetry) {
			dprintf("The I/O did not complete -- but we should try it again");
	if (bioShouldRetry) {
	    dprintf("The I/O did not complete -- but we should try it again");

			if (statePtr->flags & TLS_TCL_ASYNC) {
				dprintf("Returning EAGAIN so that it can be retried later");
	    if (statePtr->flags & TLS_TCL_ASYNC) {
		dprintf("Returning EAGAIN so that it can be retried later");

				*errorCodePtr = EAGAIN;
		*errorCodePtr = EAGAIN;

				return(-1);
			} else {
				dprintf("Doing so now");
		return(-1);
	    } else {
		dprintf("Doing so now");

				continue;
			}
		}
		continue;
	    }
	}

		dprintf("We have either completely established the session or completely failed it -- there is no more need to ever retry it though");
		break;
	}
	dprintf("We have either completely established the session or completely failed it -- there is no more need to ever retry it though");
	break;
    }


	*errorCodePtr = EINVAL;
    *errorCodePtr = EINVAL;

	switch (rc) {
		case SSL_ERROR_NONE:
			/* The connection is up, we are done here */
			dprintf("The connection is up");
			break;
		case SSL_ERROR_ZERO_RETURN:
			dprintf("SSL_ERROR_ZERO_RETURN: Connect returned an invalid value...")
			return(-1);
		case SSL_ERROR_SYSCALL:
			backingError = ERR_get_error();
    switch (rc) {
	case SSL_ERROR_NONE:
	    /* The connection is up, we are done here */
	    dprintf("The connection is up");
	    break;
	case SSL_ERROR_ZERO_RETURN:
	    dprintf("SSL_ERROR_ZERO_RETURN: Connect returned an invalid value...")
	    return(-1);
	case SSL_ERROR_SYSCALL:
	    backingError = ERR_get_error();

			if (backingError == 0 && err == 0) {
				dprintf("EOF reached")
				*errorCodePtr = ECONNRESET;
			} else if (backingError == 0 && err == -1) {
				dprintf("I/O error occured (errno = %lu)", (unsigned long) Tcl_GetErrno());
				*errorCodePtr = Tcl_GetErrno();
				if (*errorCodePtr == ECONNRESET) {
					*errorCodePtr = ECONNABORTED;
				}
			} else {
				dprintf("I/O error occured (backingError = %lu)", backingError);
				*errorCodePtr = backingError;
				if (*errorCodePtr == ECONNRESET) {
					*errorCodePtr = ECONNABORTED;
				}
			}
	    if (backingError == 0 && err == 0) {
		dprintf("EOF reached")
		*errorCodePtr = ECONNRESET;
	    } else if (backingError == 0 && err == -1) {
		dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno());
		*errorCodePtr = Tcl_GetErrno();
		if (*errorCodePtr == ECONNRESET) {
		    *errorCodePtr = ECONNABORTED;
		}
	    } else {
		dprintf("I/O error occurred (backingError = %lu)", backingError);
		*errorCodePtr = backingError;
		if (*errorCodePtr == ECONNRESET) {
		    *errorCodePtr = ECONNABORTED;
		}
		}

			statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
		statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;

			return(-1);
		case SSL_ERROR_SSL:
			dprintf("Got permanent fatal SSL error, aborting immediately");
			Tls_Error(statePtr, (char *)ERR_reason_error_string(ERR_get_error()));
			statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
			*errorCodePtr = ECONNABORTED;
			return(-1);
		case SSL_ERROR_WANT_CONNECT:
		case SSL_ERROR_WANT_ACCEPT:
		case SSL_ERROR_WANT_X509_LOOKUP:
		default:
			dprintf("We got a confusing reply: %i", rc);
			*errorCodePtr = Tcl_GetErrno();
			dprintf("ERR(%d, %d) ", rc, *errorCodePtr);
			return(-1);
	}
		return(-1);
	case SSL_ERROR_SSL:
	    dprintf("Got permanent fatal SSL error, aborting immediately");
		Tls_Error(statePtr, (char *)ERR_reason_error_string(ERR_get_error()));
	    statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
	    *errorCodePtr = ECONNABORTED;
	    return(-1);
	case SSL_ERROR_WANT_CONNECT:
	case SSL_ERROR_WANT_ACCEPT:
	case SSL_ERROR_WANT_X509_LOOKUP:
	default:
	    dprintf("We got a confusing reply: %i", rc);
	    *errorCodePtr = Tcl_GetErrno();
	    dprintf("ERR(%d, %d) ", rc, *errorCodePtr);
	    return(-1);
    }

#if 0
	if (statePtr->flags & TLS_TCL_SERVER) {
		dprintf("This is an TLS server, checking the certificate for the peer");
    if (statePtr->flags & TLS_TCL_SERVER) {
	dprintf("This is an TLS server, checking the certificate for the peer");

		err = SSL_get_verify_result(statePtr->ssl);
		if (err != X509_V_OK) {
			dprintf("Invalid certificate, returning in failure");
	err = SSL_get_verify_result(statePtr->ssl);
	if (err != X509_V_OK) {
		dprintf("Invalid certificate, returning in failure");

			Tls_Error(statePtr, (char *)X509_verify_cert_error_string(err));
			statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
			*errorCodePtr = ECONNABORTED;
			return(-1);
		}
	}
		Tls_Error(statePtr, (char *)X509_verify_cert_error_string(err));
		statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
		*errorCodePtr = ECONNABORTED;
		return(-1);
	}
    }
#endif

	dprintf("Removing the \"TLS_TCL_INIT\" flag since we have completed the handshake");
	statePtr->flags &= ~TLS_TCL_INIT;
    dprintf("Removing the \"TLS_TCL_INIT\" flag since we have completed the handshake");
    statePtr->flags &= ~TLS_TCL_INIT;

	dprintf("Returning in success");
	*errorCodePtr = 0;
    dprintf("Returning in success");
    *errorCodePtr = 0;

	return(0);
    return 0;
}

/*
 *-------------------------------------------------------------------
 *
 * TlsInputProc --
 *
 *	This procedure is invoked by the generic IO level
 *    This procedure is invoked by the generic IO level
 *       to read input from a SSL socket based channel.
 *
 * Results:
 *	The number of bytes read is returned or -1 on error. An output
 *	argument contains the POSIX error code on error, or zero if no
 *    Returns the number of bytes read or -1 on error. Sets errorCodePtr
 *    to a POSIX error code if an error occurred, or 0 if none.
 *	error occurred.
 *
 * Side effects:
 *	Reads input from the input device of the channel.
 *    Reads input from the input device of the channel.
 *
 *-------------------------------------------------------------------
 */

static int TlsInputProc(void *instanceData, char *buf, int bufSize, int *errorCodePtr) {
	unsigned long backingError;
	State *statePtr = (State *) instanceData;
	int bytesRead;
	int tlsConnect;
	int err;
static int TlsInputProc(
    void *instanceData,
    char *buf,
    int bufSize,
    int *errorCodePtr)
{
    unsigned long backingError;
    State *statePtr = (State *) instanceData;
    int bytesRead;
    int tlsConnect;
    int err;

	*errorCodePtr = 0;
    *errorCodePtr = 0;

	dprintf("BIO_read(%d)", bufSize);
    dprintf("BIO_read(%d)", bufSize);

	if (statePtr->flags & TLS_TCL_CALLBACK) {
		/* don't process any bytes while verify callback is running */
		dprintf("Callback is running, reading 0 bytes");
		return(0);
	}
    if (statePtr->flags & TLS_TCL_CALLBACK) {
	/* don't process any bytes while verify callback is running */
	dprintf("Callback is running, reading 0 bytes");
	return(0);
    }

	dprintf("Calling Tls_WaitForConnect");
	tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 0);
	if (tlsConnect < 0) {
		dprintf("Got an error waiting to connect (tlsConnect = %i, *errorCodePtr = %i)", tlsConnect, *errorCodePtr);
    dprintf("Calling Tls_WaitForConnect");
    tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 0);
    if (tlsConnect < 0) {
	dprintf("Got an error waiting to connect (tlsConnect = %i, *errorCodePtr = %i)", tlsConnect, *errorCodePtr);

		bytesRead = -1;
		if (*errorCodePtr == ECONNRESET) {
			dprintf("Got connection reset");
			/* Soft EOF */
			*errorCodePtr = 0;
			bytesRead = 0;
		}
	bytesRead = -1;
	if (*errorCodePtr == ECONNRESET) {
	    dprintf("Got connection reset");
	    /* Soft EOF */
	    *errorCodePtr = 0;
	    bytesRead = 0;
	}

		return(bytesRead);
	}
	return(bytesRead);
    }

	/*
	 * We need to clear the SSL error stack now because we sometimes reach
	 * this function with leftover errors in the stack.  If BIO_read
	 * returns -1 and intends EAGAIN, there is a leftover error, it will be
	 * misconstrued as an error, not EAGAIN.
	 *
	 * Alternatively, we may want to handle the <0 return codes from
	 * BIO_read specially (as advised in the RSA docs).  TLS's lower level BIO
	 * functions play with the retry flags though, and this seems to work
	 * correctly.  Similar fix in TlsOutputProc. - hobbs
	 */
	ERR_clear_error();
	bytesRead = BIO_read(statePtr->bio, buf, bufSize);
	dprintf("BIO_read -> %d", bytesRead);
    /*
     * We need to clear the SSL error stack now because we sometimes reach
     * this function with leftover errors in the stack.  If BIO_read
     * returns -1 and intends EAGAIN, there is a leftover error, it will be
     * misconstrued as an error, not EAGAIN.
     *
     * Alternatively, we may want to handle the <0 return codes from
     * BIO_read specially (as advised in the RSA docs).  TLS's lower level BIO
     * functions play with the retry flags though, and this seems to work
     * correctly.  Similar fix in TlsOutputProc. - hobbs
     */
    ERR_clear_error();
    bytesRead = BIO_read(statePtr->bio, buf, bufSize);
    dprintf("BIO_read -> %d", bytesRead);

	err = SSL_get_error(statePtr->ssl, bytesRead);
    err = SSL_get_error(statePtr->ssl, bytesRead);

#if 0
	if (bytesRead <= 0) {
		if (BIO_should_retry(statePtr->bio)) {
			dprintf("I/O failed, will retry based on EAGAIN");
			*errorCodePtr = EAGAIN;
		}
	}
    if (bytesRead <= 0) {
	if (BIO_should_retry(statePtr->bio)) {
	    dprintf("I/O failed, will retry based on EAGAIN");
	    *errorCodePtr = EAGAIN;
	}
    }
#endif

	switch (err) {
		case SSL_ERROR_NONE:
			dprintBuffer(buf, bytesRead);
			break;
		case SSL_ERROR_SSL:
			dprintf("SSL negotiation error, indicating that the connection has been aborted");
    switch (err) {
	case SSL_ERROR_NONE:
	    dprintBuffer(buf, bytesRead);
	    break;
	case SSL_ERROR_SSL:
	    dprintf("SSL negotiation error, indicating that the connection has been aborted");

			Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, bytesRead));
			*errorCodePtr = ECONNABORTED;
			bytesRead = -1;
	    Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, bytesRead));
	    *errorCodePtr = ECONNABORTED;
	    bytesRead = -1;

			break;
		case SSL_ERROR_SYSCALL:
			backingError = ERR_get_error();
	    break;
	case SSL_ERROR_SYSCALL:
		backingError = ERR_get_error();

			if (backingError == 0 && bytesRead == 0) {
		if (backingError == 0 && bytesRead == 0) {
				dprintf("EOF reached")
				*errorCodePtr = 0;
				bytesRead = 0;
			} else if (backingError == 0 && bytesRead == -1) {
				dprintf("I/O error occured (errno = %lu)", (unsigned long) Tcl_GetErrno());
		} else if (backingError == 0 && bytesRead == -1) {
				dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno());
				*errorCodePtr = Tcl_GetErrno();
				bytesRead = -1;
			} else {
				dprintf("I/O error occured (backingError = %lu)", backingError);
		} else {
				dprintf("I/O error occurred (backingError = %lu)", backingError);
				*errorCodePtr = backingError;
				bytesRead = -1;
			}
		}

			break;
		break;
		case SSL_ERROR_ZERO_RETURN:
			dprintf("Got SSL_ERROR_ZERO_RETURN, this means an EOF has been reached");
			bytesRead = 0;
			*errorCodePtr = 0;
			break;
		case SSL_ERROR_WANT_READ:
			dprintf("Got SSL_ERROR_WANT_READ, mapping this to EAGAIN");
			bytesRead = -1;
			*errorCodePtr = EAGAIN;
			break;
		default:
			dprintf("Unknown error (err = %i), mapping to EOF", err);
			*errorCodePtr = 0;
			bytesRead = 0;
			break;
	}
		*errorCodePtr = 0;
		bytesRead = 0;
		break;
    }

	dprintf("Input(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr);
	return(bytesRead);
    dprintf("Input(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr);
    return bytesRead;
}

/*
 *-------------------------------------------------------------------
 *
 * TlsOutputProc --
 *
 *	This procedure is invoked by the generic IO level
 *    This procedure is invoked by the generic IO level
 *       to write output to a SSL socket based channel.
 *
 * Results:
 *	The number of bytes written is returned. An output argument is
 *	set to a POSIX error code if an error occurred, or zero.
 *    Returns the number of bytes written or -1 on error. Sets errorCodePtr
 *    to a POSIX error code if an error occurred, or 0 if none.
 *
 * Side effects:
 *	Writes output on the output device of the channel.
 *    Writes output on the output device of the channel.
 *
 *-------------------------------------------------------------------
 */

static int TlsOutputProc(void *instanceData, const char *buf, int toWrite, int *errorCodePtr) {
	unsigned long backingError;
	State *statePtr = (State *) instanceData;
	int written, err;
	int tlsConnect;
static int TlsOutputProc(
    void *instanceData,
    const char *buf,
    int toWrite,
    int *errorCodePtr)
{
    unsigned long backingError;
    State *statePtr = (State *) instanceData;
    int written, err;
    int tlsConnect;

	*errorCodePtr = 0;
    *errorCodePtr = 0;

	dprintf("BIO_write(%p, %d)", (void *) statePtr, toWrite);
	dprintBuffer(buf, toWrite);
    dprintf("BIO_write(%p, %d)", (void *) statePtr, toWrite);
    dprintBuffer(buf, toWrite);

	if (statePtr->flags & TLS_TCL_CALLBACK) {
		dprintf("Don't process output while callbacks are running")
		written = -1;
		*errorCodePtr = EAGAIN;
		return(-1);
	}
    if (statePtr->flags & TLS_TCL_CALLBACK) {
	dprintf("Don't process output while callbacks are running");
	written = -1;
	*errorCodePtr = EAGAIN;
	return(-1);
    }

	dprintf("Calling Tls_WaitForConnect");
	tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 1);
	if (tlsConnect < 0) {
		dprintf("Got an error waiting to connect (tlsConnect = %i, *errorCodePtr = %i)", tlsConnect, *errorCodePtr);
    dprintf("Calling Tls_WaitForConnect");
    tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 1);
    if (tlsConnect < 0) {
	dprintf("Got an error waiting to connect (tlsConnect = %i, *errorCodePtr = %i)", tlsConnect, *errorCodePtr);

		written = -1;
		if (*errorCodePtr == ECONNRESET) {
			dprintf("Got connection reset");
			/* Soft EOF */
			*errorCodePtr = 0;
			written = 0;
		}
	written = -1;
	if (*errorCodePtr == ECONNRESET) {
	    dprintf("Got connection reset");
	    /* Soft EOF */
	    *errorCodePtr = 0;
	    written = 0;
	}

		return(written);
	}
	return(written);
    }

	if (toWrite == 0) {
		dprintf("zero-write");
		err = BIO_flush(statePtr->bio);
    if (toWrite == 0) {
	dprintf("zero-write");
	err = BIO_flush(statePtr->bio);

		if (err <= 0) {
			dprintf("Flushing failed");
	if (err <= 0) {
	    dprintf("Flushing failed");

			*errorCodePtr = EIO;
			written = 0;
			return(-1);
		}
	    *errorCodePtr = EIO;
	    written = 0;
	    return(-1);
	}

		written = 0;
		*errorCodePtr = 0;
		return(0);
	}
	written = 0;
	*errorCodePtr = 0;
	return(0);
    }

	/*
	 * We need to clear the SSL error stack now because we sometimes reach
	 * this function with leftover errors in the stack.  If BIO_write
	 * returns -1 and intends EAGAIN, there is a leftover error, it will be
	 * misconstrued as an error, not EAGAIN.
	 *
	 * Alternatively, we may want to handle the <0 return codes from
	 * BIO_write specially (as advised in the RSA docs).  TLS's lower level
	 * BIO functions play with the retry flags though, and this seems to
	 * work correctly.  Similar fix in TlsInputProc. - hobbs
	 */
	ERR_clear_error();
	written = BIO_write(statePtr->bio, buf, toWrite);
	dprintf("BIO_write(%p, %d) -> [%d]", (void *) statePtr, toWrite, written);
    /*
     * We need to clear the SSL error stack now because we sometimes reach
     * this function with leftover errors in the stack.  If BIO_write
     * returns -1 and intends EAGAIN, there is a leftover error, it will be
     * misconstrued as an error, not EAGAIN.
     *
     * Alternatively, we may want to handle the <0 return codes from
     * BIO_write specially (as advised in the RSA docs).  TLS's lower level
     * BIO functions play with the retry flags though, and this seems to
     * work correctly.  Similar fix in TlsInputProc. - hobbs
     */
    ERR_clear_error();
    written = BIO_write(statePtr->bio, buf, toWrite);
    dprintf("BIO_write(%p, %d) -> [%d]", (void *) statePtr, toWrite, written);

	err = SSL_get_error(statePtr->ssl, written);
	switch (err) {
		case SSL_ERROR_NONE:
			if (written < 0) {
				written = 0;
			}
			break;
		case SSL_ERROR_WANT_WRITE:
			dprintf("Got SSL_ERROR_WANT_WRITE, mapping it to EAGAIN");
			*errorCodePtr = EAGAIN;
			written = -1;
			break;
		case SSL_ERROR_WANT_READ:
			dprintf(" write R BLOCK");
			break;
		case SSL_ERROR_WANT_X509_LOOKUP:
			dprintf(" write X BLOCK");
			break;
		case SSL_ERROR_ZERO_RETURN:
			dprintf(" closed");
			written = 0;
			*errorCodePtr = 0;
			break;
		case SSL_ERROR_SYSCALL:
			backingError = ERR_get_error();
    err = SSL_get_error(statePtr->ssl, written);
    switch (err) {
	case SSL_ERROR_NONE:
	    if (written < 0) {
		written = 0;
	    }
	    break;
	case SSL_ERROR_WANT_WRITE:
	    dprintf("Got SSL_ERROR_WANT_WRITE, mapping it to EAGAIN");
	    *errorCodePtr = EAGAIN;
	    written = -1;
	    break;
	case SSL_ERROR_WANT_READ:
	    dprintf(" write R BLOCK");
	    break;
	case SSL_ERROR_WANT_X509_LOOKUP:
	    dprintf(" write X BLOCK");
	    break;
	case SSL_ERROR_ZERO_RETURN:
	    dprintf(" closed");
	    written = 0;
	    *errorCodePtr = 0;
	    break;
	case SSL_ERROR_SYSCALL:
	    backingError = ERR_get_error();

			if (backingError == 0 && written == 0) {
				dprintf("EOF reached")
				*errorCodePtr = 0;
				written = 0;
			} else if (backingError == 0 && written == -1) {
				dprintf("I/O error occured (errno = %lu)", (unsigned long) Tcl_GetErrno());
				*errorCodePtr = Tcl_GetErrno();
				written = -1;
			} else {
				dprintf("I/O error occured (backingError = %lu)", backingError);
				*errorCodePtr = backingError;
				written = -1;
			}
	    if (backingError == 0 && written == 0) {
		dprintf("EOF reached")
		*errorCodePtr = 0;
		written = 0;
	    } else if (backingError == 0 && written == -1) {
		dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno());
		*errorCodePtr = Tcl_GetErrno();
		written = -1;
	    } else {
		dprintf("I/O error occurred (backingError = %lu)", backingError);
		*errorCodePtr = backingError;
		written = -1;
	    }

			break;
		case SSL_ERROR_SSL:
			Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, written));
			*errorCodePtr = ECONNABORTED;
			written = -1;
			break;
		default:
			dprintf(" unknown err: %d", err);
			break;
	}
	    break;
	case SSL_ERROR_SSL:
	    Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, written));
	    *errorCodePtr = ECONNABORTED;
	    written = -1;
	    break;
	default:
	    dprintf(" unknown err: %d", err);
	    break;
    }

	dprintf("Output(%d) -> %d", toWrite, written);
	return(written);
    dprintf("Output(%d) -> %d", toWrite, written);
    return(written);
}

/*
 *-------------------------------------------------------------------
 *
 * TlsGetOptionProc --
 *
 *	Computes an option value for a SSL socket based channel, or a
 *	list of all options and their values.
 *    Gets an option value for a SSL socket based channel, or a
 *    list of all options and their values.
 *
 * Results:
 *	A standard Tcl result. The value of the specified option or a
 *	list of all options and	their values is returned in the
 *	supplied DString.
 *    A standard Tcl result. The value of the specified option or a
 *    list of all options and their values is returned in the
 *    supplied DString.
 *
 * Side effects:
 *	None.
 *    None.
 *
 *-------------------------------------------------------------------
 */
static int
TlsGetOptionProc(
TlsGetOptionProc(void *instanceData,	/* Socket state. */
	Tcl_Interp *interp,		/* For errors - can be NULL. */
	const char *optionName,		/* Name of the option to
    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
					 * retrieve the value for, or
					 * NULL to get all options and
				 * NULL to get all options and their values. */
					 * their values. */
	Tcl_DString *dsPtr)		/* Where to store the computed value
    Tcl_DString *dsPtr)	/* Where to store the computed value initialized by caller. */
					 * initialized by caller. */
{
    State *statePtr = (State *) instanceData;

   Tcl_Channel downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);
   Tcl_DriverGetOptionProc *getOptionProc;
    Tcl_Channel downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);
    Tcl_DriverGetOptionProc *getOptionProc;

    getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan));
    if (getOptionProc != NULL) {
        return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan), interp, optionName, dsPtr);
	return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan), interp, optionName, dsPtr);
    } else if (optionName == (char*) NULL) {
        /*
         * Request is query for all options, this is ok.
         */
         return TCL_OK;
	/*
	 * Request is query for all options, this is ok.
	 */
	return TCL_OK;
    }
    /*
     * Request for a specific option has to fail, we don't have any.
     */
    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------
 *
 * TlsWatchProc --
 *
 *	Initialize the notifier to watch Tcl_Files from this channel.
 *    Initialize the notifier to watch Tcl_Files from this channel.
 *
 * Results:
 *	None.
 *    None.
 *
 * Side effects:
 *	Sets up the notifier so that a future event on the channel
 *	will be seen by Tcl.
 *    Sets up the notifier so that a future event on the channel
 *    will be seen by Tcl.
 *
 *-------------------------------------------------------------------
 */

static void
TlsWatchProc(void *instanceData,	/* The socket state. */
             int mask)			/* Events of interest; an OR-ed
TlsWatchProc(
    void *instanceData,    /* The socket state. */
    int mask)			/* Events of interest; an OR-ed combination of
                                         * combination of TCL_READABLE,
                                         * TCL_WRITABLE and TCL_EXCEPTION. */
				 * 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.
     * Otherwise that callback could be invoked recursively. */
    if (statePtr->flags & TLS_TCL_CALLBACK) {
        dprintf("Callback is on-going, doing nothing");
        return;
	dprintf("Callback is on-going, doing nothing");
	return;
    }

    dprintFlags(statePtr);

    downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);

    if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) {
        dprintf("Asked to watch a socket with a failed handshake -- nothing can happen here");
	dprintf("Asked to watch a socket with a failed handshake -- nothing can happen here");

	dprintf("Unregistering interest in the lower channel");
	(Tcl_GetChannelType(downChan))->watchProc(Tcl_GetChannelInstanceData(downChan), 0);

	(Tcl_GetChannelType(downChan))->watchProc(Tcl_GetChannelInstanceData(downChan), 0);
	statePtr->watchMask = 0;

        return;
	return;
    }

	statePtr->watchMask = mask;
    statePtr->watchMask = mask;

	/* No channel handlers any more. We will be notified automatically
	 * about events on the channel below via a call to our
	 * 'TransformNotifyProc'. But we have to pass the interest down now.
	 * We are allowed to add additional 'interest' to the mask if we want
	 * to. But this transformation has no such interest. It just passes
	 * the request down, unchanged.
	 */
    /* No channel handlers any more. We will be notified automatically
     * about events on the channel below via a call to our
     * 'TransformNotifyProc'. But we have to pass the interest down now.
     * We are allowed to add additional 'interest' to the mask if we want
     * to. But this transformation has no such interest. It just passes
     * the request down, unchanged.
     */


        dprintf("Registering our interest in the lower channel (chan=%p)", (void *) downChan);
	(Tcl_GetChannelType(downChan))
    dprintf("Registering our interest in the lower channel (chan=%p)", (void *) downChan);
    (Tcl_GetChannelType(downChan))
	    ->watchProc(Tcl_GetChannelInstanceData(downChan), mask);

	/*
	 * Management of the internal timer.
	 */
    /*
     * Management of the internal timer.
     */

	if (statePtr->timer != (Tcl_TimerToken) NULL) {
            dprintf("A timer was found, deleting it");
	    Tcl_DeleteTimerHandler(statePtr->timer);
	    statePtr->timer = (Tcl_TimerToken) NULL;
	}
    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	dprintf("A timer was found, deleting it");
	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = (Tcl_TimerToken) NULL;
    }

	if (mask & TCL_READABLE) {
		if (Tcl_InputBuffered(statePtr->self) > 0 || BIO_ctrl_pending(statePtr->bio) > 0) {
			/*
			 * 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, statePtr);
		}
    if ((mask & TCL_READABLE) &&
	((Tcl_InputBuffered(statePtr->self) > 0) || (BIO_ctrl_pending(statePtr->bio) > 0))) {
	/*
	 * 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, statePtr);
    }
	}
}

/*
 *-------------------------------------------------------------------
 *
 * TlsGetHandleProc --
 *
 *	Called from Tcl_GetChannelFile to retrieve o/s file handler
 *	from the SSL socket based channel.
 *    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 handle or NULL if none.
 *
 * Side effects:
 *	None.
 *    None.
 *
 *-------------------------------------------------------------------
 */
static int TlsGetHandleProc(void *instanceData, int direction, void **handlePtr) {
	State *statePtr = (State *) instanceData;
static int TlsGetHandleProc(
    void *instanceData,    /* Socket state. */
    int direction,		/* TCL_READABLE or TCL_WRITABLE */
    void **handlePtr)	/* Handle associated with the channel */
{
    State *statePtr = (State *)instanceData;

	return(Tcl_GetChannelHandle(Tls_GetParent(statePtr, TLS_TCL_FASTPATH), direction, handlePtr));
    return(Tcl_GetChannelHandle(Tls_GetParent(statePtr, TLS_TCL_FASTPATH), direction, handlePtr));
}

/*
 *-------------------------------------------------------------------
 *
 * TlsNotifyProc --
 *
 *	Handler called by Tcl to inform us of activity
 *	on the underlying channel.
 *    Handler called by Tcl to inform us of activity
 *    on the underlying channel.
 *
 * Results:
 *	None.
 *    Type of event or 0 if failed
 *
 * Side effects:
 *	May process the incoming event by itself.
 *    May process the incoming event by itself.
 *
 *-------------------------------------------------------------------
 */

static int TlsNotifyProc(void *instanceData, int mask) {
	State *statePtr = (State *) instanceData;
	int errorCode;
static int TlsNotifyProc(
    void *instanceData,    /* Socket state. */
    int mask)			/* type of event that occurred:
				 * OR-ed combination of TCL_READABLE or TCL_WRITABLE */
{
    State *statePtr = (State *)instanceData;
    int errorCode;

	/*
	 * An event occured in the underlying channel.  This
	 * transformation doesn't process such events thus returns the
	 * incoming mask unchanged.
	 */
	if (statePtr->timer != (Tcl_TimerToken) NULL) {
		/*
		 * Delete an existing timer. It was not fired, yet we are
		 * here, so the channel below generated such an event and we
		 * don't have to. The renewal of the interest after the
		 * execution of channel handlers will eventually cause us to
		 * recreate the timer (in WatchProc).
		 */
		Tcl_DeleteTimerHandler(statePtr->timer);
		statePtr->timer = (Tcl_TimerToken) NULL;
	}
    /*
     * An event occurred in the underlying channel.  This
     * transformation doesn't process such events thus returns the
     * incoming mask unchanged.
     */
    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	/*
	 * Delete an existing timer. It was not fired, yet we are
	 * here, so the channel below generated such an event and we
	 * don't have to. The renewal of the interest after the
	 * execution of channel handlers will eventually cause us to
	 * recreate the timer (in WatchProc).
	 */
	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = (Tcl_TimerToken) NULL;
    }

	if (statePtr->flags & TLS_TCL_CALLBACK) {
		dprintf("Returning 0 due to callback");
		return 0;
	}
    if (statePtr->flags & TLS_TCL_CALLBACK) {
	dprintf("Returning 0 due to callback");
	return 0;
    }

	dprintf("Calling Tls_WaitForConnect");
	errorCode = 0;
	if (Tls_WaitForConnect(statePtr, &errorCode, 1) < 0) {
		if (errorCode == EAGAIN) {
			dprintf("Async flag could be set (didn't check) and errorCode == EAGAIN:  Returning 0");
    dprintf("Calling Tls_WaitForConnect");
    errorCode = 0;
    if (Tls_WaitForConnect(statePtr, &errorCode, 1) < 0) {
	if (errorCode == EAGAIN) {
	    dprintf("Async flag could be set (didn't check) and errorCode == EAGAIN:  Returning 0");

			return 0;
		}
	    return 0;
	}

		dprintf("Tls_WaitForConnect returned an error");
	}
	dprintf("Tls_WaitForConnect returned an error");
    }

	dprintf("Returning %i", mask);
    dprintf("Returning %i", mask);

	return(mask);
    return(mask);
}

#if 0
/*
 *------------------------------------------------------*
 *
 *      TlsChannelHandler --
901
902
903
904
905
906
907









































908
909
910
911
912
913
914
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *		As of 'TlsChannelHandler'.
 *
 *	Result:
 *		None.
 *
 *------------------------------------------------------*
 */


/*
 *-------------------------------------------------------------------
 *
 * Tls_ChannelType --
 *
 *    Return the correct TLS channel driver info
 *
 * Results:
 *    The correct channel driver for the current version of Tcl.
 *
 * Side effects:
 *    None.
 *
 *-------------------------------------------------------------------
 */
static const Tcl_ChannelType tlsChannelType = {
    "tls",			/* Type name */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    TlsCloseProc,		/* Close proc */
    TlsInputProc,		/* Input proc */
    TlsOutputProc,		/* Output proc */
    0,			/* Seek proc */
    0,		/* Set option proc */
    TlsGetOptionProc,		/* Get option proc */
    TlsWatchProc,		/* Initialize notifier */
    TlsGetHandleProc,		/* Get OS handles out of channel */
    TlsClose2Proc,		/* close2proc */
    TlsBlockModeProc,		/* Set blocking/nonblocking mode*/
    0,			/* Flush proc */
    TlsNotifyProc,		/* Handling of events bubbling up */
    0,			/* Wide seek proc */
    NULL,			/* Thread action */
    NULL			/* Truncate */
};

const Tcl_ChannelType *Tls_ChannelType(void) {
    return &tlsChannelType;
}


static void TlsChannelHandlerTimer(void *clientData) {
	State *statePtr = (State *) clientData;
	int mask = 0;

	dprintf("Called");

19
20
21
22
23
24
25
26

27
28
29
30
31
32
33
19
20
21
22
23
24
25

26
27
28
29
30
31
32
33







-
+







#define _TLSINT_H

#include "tls.h"
#include <errno.h>
#include <string.h>
#include <stdint.h>

#ifdef __WIN32__
#ifdef _WIN32
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#include <wincrypt.h> /* OpenSSL needs this on Windows */
#endif

#ifdef NO_PATENTS
#  define NO_IDEA
56
57
58
59
60
61
62
63
64
65
66
67
68






69
70
71
72
73
74
75
76
77
78
79
80
81
82













83
84
85
86
87
88
89
90
91
92
93
94
95












96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114




115
116
117

118
119
120


121
122
123
124

125
126
127
128
129
130

131
132
133
134
135



136
137
138
139



140
141
142
143
144
145





146
147
148
149
150
151
152
56
57
58
59
60
61
62






63
64
65
66
67
68
69













70
71
72
73
74
75
76
77
78
79
80
81
82
83












84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110




111
112
113
114
115
116

117



118
119
120
121
122

123

124
125
126
127

128
129
130



131
132
133
134



135
136
137
138





139
140
141
142
143
144
145
146
147
148
149
150







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

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

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















-
-
-
-
+
+
+
+


-
+
-
-
-
+
+



-
+
-




-
+


-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
-
-
+
+
+
+
+







#ifndef ECONNRESET
#define ECONNRESET	131	/* Connection reset by peer */
#endif

#ifdef TCLEXT_TCLTLS_DEBUG
#include <ctype.h>
#define dprintf(...) { \
                       char dprintfBuffer[8192], *dprintfBuffer_p; \
                       dprintfBuffer_p = &dprintfBuffer[0]; \
                       dprintfBuffer_p += sprintf(dprintfBuffer_p, "%s:%i:%s():", __FILE__, __LINE__, __func__); \
                       dprintfBuffer_p += sprintf(dprintfBuffer_p, __VA_ARGS__); \
                       fprintf(stderr, "%s\n", dprintfBuffer); \
                     }
	char dprintfBuffer[8192], *dprintfBuffer_p; \
	dprintfBuffer_p = &dprintfBuffer[0]; \
	dprintfBuffer_p += sprintf(dprintfBuffer_p, "%s:%i:%s():", __FILE__, __LINE__, __func__); \
	dprintfBuffer_p += sprintf(dprintfBuffer_p, __VA_ARGS__); \
	fprintf(stderr, "%s\n", dprintfBuffer); \
}
#define dprintBuffer(bufferName, bufferLength) { \
                                                 int dprintBufferIdx; \
                                                 unsigned char dprintBufferChar; \
                                                 fprintf(stderr, "%s:%i:%s():%s[%llu]={", __FILE__, __LINE__, __func__, #bufferName, (unsigned long long) bufferLength); \
                                                 for (dprintBufferIdx = 0; dprintBufferIdx < bufferLength; dprintBufferIdx++) { \
                                                         dprintBufferChar = bufferName[dprintBufferIdx]; \
                                                         if (isalpha(dprintBufferChar) || isdigit(dprintBufferChar)) { \
                                                                 fprintf(stderr, "'%c' ", dprintBufferChar); \
                                                         } else { \
                                                                 fprintf(stderr, "%02x ", (unsigned int) dprintBufferChar); \
                                                         }; \
                                                 }; \
                                                 fprintf(stderr, "}\n"); \
                                               }
	int dprintBufferIdx; \
	unsigned char dprintBufferChar; \
	fprintf(stderr, "%s:%i:%s():%s[%llu]={", __FILE__, __LINE__, __func__, #bufferName, (unsigned long long) bufferLength); \
	for (dprintBufferIdx = 0; dprintBufferIdx < bufferLength; dprintBufferIdx++) { \
		dprintBufferChar = bufferName[dprintBufferIdx]; \
		if (isalpha(dprintBufferChar) || isdigit(dprintBufferChar)) { \
			fprintf(stderr, "'%c' ", dprintBufferChar); \
		} else { \
			fprintf(stderr, "%02x ", (unsigned int) dprintBufferChar); \
		}; \
	}; \
	fprintf(stderr, "}\n"); \
}
#define dprintFlags(statePtr) { \
                                char dprintfBuffer[8192], *dprintfBuffer_p; \
                                dprintfBuffer_p = &dprintfBuffer[0]; \
                                dprintfBuffer_p += sprintf(dprintfBuffer_p, "%s:%i:%s():%s->flags=0", __FILE__, __LINE__, __func__, #statePtr); \
                                if (((statePtr)->flags & TLS_TCL_ASYNC) == TLS_TCL_ASYNC) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_ASYNC"); }; \
                                if (((statePtr)->flags & TLS_TCL_SERVER) == TLS_TCL_SERVER) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_SERVER"); }; \
                                if (((statePtr)->flags & TLS_TCL_INIT) == TLS_TCL_INIT) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_INIT"); }; \
                                if (((statePtr)->flags & TLS_TCL_DEBUG) == TLS_TCL_DEBUG) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_DEBUG"); }; \
                                if (((statePtr)->flags & TLS_TCL_CALLBACK) == TLS_TCL_CALLBACK) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_CALLBACK"); }; \
                                if (((statePtr)->flags & TLS_TCL_HANDSHAKE_FAILED) == TLS_TCL_HANDSHAKE_FAILED) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_HANDSHAKE_FAILED"); }; \
                                if (((statePtr)->flags & TLS_TCL_FASTPATH) == TLS_TCL_FASTPATH) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_FASTPATH"); }; \
                                fprintf(stderr, "%s\n", dprintfBuffer); \
                              }
	char dprintfBuffer[8192], *dprintfBuffer_p; \
	dprintfBuffer_p = &dprintfBuffer[0]; \
	dprintfBuffer_p += sprintf(dprintfBuffer_p, "%s:%i:%s():%s->flags=0", __FILE__, __LINE__, __func__, #statePtr); \
	if (((statePtr)->flags & TLS_TCL_ASYNC) == TLS_TCL_ASYNC) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_ASYNC"); }; \
	if (((statePtr)->flags & TLS_TCL_SERVER) == TLS_TCL_SERVER) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_SERVER"); }; \
	if (((statePtr)->flags & TLS_TCL_INIT) == TLS_TCL_INIT) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_INIT"); }; \
	if (((statePtr)->flags & TLS_TCL_DEBUG) == TLS_TCL_DEBUG) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_DEBUG"); }; \
	if (((statePtr)->flags & TLS_TCL_CALLBACK) == TLS_TCL_CALLBACK) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_CALLBACK"); }; \
	if (((statePtr)->flags & TLS_TCL_HANDSHAKE_FAILED) == TLS_TCL_HANDSHAKE_FAILED) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_HANDSHAKE_FAILED"); }; \
	if (((statePtr)->flags & TLS_TCL_FASTPATH) == TLS_TCL_FASTPATH) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_FASTPATH"); }; \
	fprintf(stderr, "%s\n", dprintfBuffer); \
}
#else
#define dprintf(...) if (0) { fprintf(stderr, __VA_ARGS__); }
#define dprintBuffer(bufferName, bufferLength) /**/
#define dprintFlags(statePtr) /**/
#endif

#define TCLTLS_SSL_ERROR(ssl,err) ((char*)ERR_reason_error_string((unsigned long)SSL_get_error((ssl),(err))))
/*
 * OpenSSL BIO Routines
 */
#define BIO_TYPE_TCL	(19|0x0400)

/*
 * Defines for State.flags
 */
#define TLS_TCL_ASYNC	(1<<0)	/* non-blocking mode */
#define TLS_TCL_SERVER	(1<<1)	/* Server-Side */
#define TLS_TCL_INIT	(1<<2)	/* Initializing connection */
#define TLS_TCL_DEBUG	(1<<3)	/* Show debug tracing */
#define TLS_TCL_ASYNC		(1<<0)	/* non-blocking mode */
#define TLS_TCL_SERVER		(1<<1)	/* Server-Side */
#define TLS_TCL_INIT		(1<<2)	/* Initializing connection */
#define TLS_TCL_DEBUG		(1<<3)	/* Show debug tracing */
#define TLS_TCL_CALLBACK	(1<<4)	/* In a callback, prevent update
					 * looping problem. [Bug 1652380] */
#define TLS_TCL_HANDSHAKE_FAILED (1<<5) /* Set on handshake failures and once
#define TLS_TCL_HANDSHAKE_FAILED (1<<5) /* Set on handshake failures and once set, all
                                         * set, all further I/O will result
                                         * in ECONNABORTED errors. */
#define TLS_TCL_FASTPATH (1<<6)         /* The parent channel is being used directly by the SSL library */
                                         * further I/O will result in ECONNABORTED errors. */
#define TLS_TCL_FASTPATH 	(1<<6)	/* The parent channel is being used directly by the SSL library */
#define TLS_TCL_DELAY (5)

/*
 * This structure describes the per-instance state
 * This structure describes the per-instance state of an SSL channel.
 * of an ssl channel.
 *
 * The SSL processing context is maintained here, in the ClientData
 */
typedef struct State {
	Tcl_Channel self;       /* this socket channel */
	Tcl_Channel self;	/* this socket channel */
	Tcl_TimerToken timer;

	int flags;              /* see State.flags above  */
	int watchMask;          /* current WatchProc mask */
	int mode;               /* current mode of parent channel */
	int flags;		/* see State.flags above  */
	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_Interp *interp;	/* interpreter in which this resides */
	Tcl_Obj *callback;	/* script called for tracing, info, 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 */
	BIO *p_bio;             /* Parent BIO (that is layered on Tcl_Channel) */
	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) */

	const char *err;
} State;

#ifdef USE_TCL_STUBS
#ifndef Tcl_StackChannel
#error "Unable to compile on this version of Tcl"
166
167
168
169
170
171
172

173
174
175
176
177
178
179
180
181

182
183
184
185
186
187
188
189
190
191

192
193
194
195
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179

180
181
182
183
184
185
186
187
188
189

190
191
192
193
194







+








-
+









-
+




# 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
#   define TCL_SIZE_MODIFIER ""
#endif

/*
 * Forward declarations
 */
const Tcl_ChannelType *Tls_ChannelType(void);
Tcl_Channel     Tls_GetParent(State *statePtr, int maskFlags);

Tcl_Obj         *Tls_NewX509Obj(Tcl_Interp *interp, X509 *cert);
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);
BIO            *BIO_new_tcl(State* statePtr, int flags);

#define PTR2INT(x) ((int) ((intptr_t) (x)))

#endif /* _TLSINT_H */
1
2
3
4
5
6
7
8
9
10
11

12
13
14
15
16
17
18
1
2
3
4
5
6
7
8
9
10

11
12
13
14
15
16
17
18










-
+







	Windows DLL Build instructions using nmake build system
	2020-10-15 Harald.Oehlmann@elmicron.de
	2023-08-22 Kevin Walzer (kw@codebykevin.com)

Properties:
- 64 bit DLL
- VisualStudio 2019
- WSL
- OpenSSL dynamically linked to TCLTLS DLL. We used a freely redistributable build of OpenSSL from https://www.firedaemon.com/firedaemon-openssl. Unzip and install OpenSSL in an accessible place (we used the lib subdirectory of our Tcl installation).

1. Visual Studio x64 native prompt. Update environmental variables for building Tcltls. Customize the below entries for your setup. 
1. Visual Studio x64 native prompt. Update environmental variables for building Tcltls. Customize the below entries for your setup.

set PATH=%PATH%;C:\tcl-trunk\lib\openssl-3\x64\bin
set INCLUDE=%INCLUDE%;C:\tcl-trunk\tcl\lib\openssl-3\x64\include\openssl
set LIB=%LIB%;C:\tcl-trunk\tcl\lib\openssl-3\x64\bin


2) Build TCLTLS