Check-in [e3d4330c95]
Overview
Comment:Made updates to enhance event processing, I/O operations, etc. to address reports of stalled connections, etc.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tls-1.8
Files: files | file ages | folders
SHA3-256: e3d4330c955bd097a4378c2057010f4b5910bdbbc2fc77a4fbfb76828459fdd7
User & Date: bohagan on 2024-07-06 04:17:38
Other Links: branch diff | manifest | tags
Context
2024-07-07
15:23
Changed to use Tcl_PkgRequireEx, only call if not using stubs. check-in: 57cd9143b5 user: bohagan tags: tls-1.8
2024-07-06
04:17
Made updates to enhance event processing, I/O operations, etc. to address reports of stalled connections, etc. check-in: e3d4330c95 user: bohagan tags: tls-1.8
2024-07-05
18:03
Updated callback handlers in tls.tcl to be backwards compatible for earlier TCLTLS versions check-in: 2c0be4cb7f user: bohagan tags: tls-1.8
Changes
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
	ret = 1;
    }

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

/*
 *-------------------------------------------------------------------
 *
 * ImportObjCmd --
 *
 *	This procedure is invoked to process the "ssl" command
 *







|







1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
	ret = 1;
    }

    dprintf("Returning TCL_OK with data \"%i\"", ret);
    Tcl_SetObjResult(interp, Tcl_NewIntObj(ret));
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * ImportObjCmd --
 *
 *	This procedure is invoked to process the "ssl" command
 *
1376
1377
1378
1379
1380
1381
1382

1383
1384
1385
1386
1387
1388
1389

    /* new SSL state */
    statePtr		= (State *) ckalloc((unsigned) sizeof(State));
    memset(statePtr, 0, sizeof(State));

    statePtr->flags	= flags;
    statePtr->interp	= interp;

    statePtr->vflags	= verify;
    statePtr->err	= "";

    /* allocate script */
    if (script) {
	(void) Tcl_GetStringFromObj(script, &len);
	if (len) {







>







1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390

    /* new SSL state */
    statePtr		= (State *) ckalloc((unsigned) sizeof(State));
    memset(statePtr, 0, sizeof(State));

    statePtr->flags	= flags;
    statePtr->interp	= interp;
    statePtr->want	= 0;
    statePtr->vflags	= verify;
    statePtr->err	= "";

    /* allocate script */
    if (script) {
	(void) Tcl_GetStringFromObj(script, &len);
	if (len) {
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
    Tcl_GetChannelOption(interp, chan, "-encoding", &upperChannelEncoding);
    Tcl_GetChannelOption(interp, chan, "-translation", &upperChannelTranslation);
    Tcl_GetChannelOption(interp, chan, "-blocking", &upperChannelBlocking);

    /* Ensure the channel works in binary mode (for the encryption not to get goofed up). */
    Tcl_SetChannelOption(interp, chan, "-translation", "binary");
    Tcl_SetChannelOption(interp, chan, "-blocking", "true");
    
    /* Create stacked channel */
    dprintf("Consuming Tcl channel %s", Tcl_GetChannelName(chan));
    statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(), (ClientData) statePtr,
	(TCL_READABLE | TCL_WRITABLE), chan);
    dprintf("Created channel named %s", Tcl_GetChannelName(statePtr->self));
    if (statePtr->self == (Tcl_Channel) NULL) {
	/*







|







1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
    Tcl_GetChannelOption(interp, chan, "-encoding", &upperChannelEncoding);
    Tcl_GetChannelOption(interp, chan, "-translation", &upperChannelTranslation);
    Tcl_GetChannelOption(interp, chan, "-blocking", &upperChannelBlocking);

    /* Ensure the channel works in binary mode (for the encryption not to get goofed up). */
    Tcl_SetChannelOption(interp, chan, "-translation", "binary");
    Tcl_SetChannelOption(interp, chan, "-blocking", "true");

    /* Create stacked channel */
    dprintf("Consuming Tcl channel %s", Tcl_GetChannelName(chan));
    statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(), (ClientData) statePtr,
	(TCL_READABLE | TCL_WRITABLE), chan);
    dprintf("Created channel named %s", Tcl_GetChannelName(statePtr->self));
    if (statePtr->self == (Tcl_Channel) NULL) {
	/*
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
	/* Enable server to send cert request after handshake (TLS 1.3 only) */
	/* A write operation must take place for the Certificate Request to be
	   sent to the client, this can be done with SSL_do_handshake(). */
	if (request && post_handshake && tls1_3) {
	    SSL_verify_client_post_handshake(statePtr->ssl);
	}

	/* set automatic curve selection */
	SSL_set_ecdh_auto(statePtr->ssl, 1);

	/* Set server mode */
	statePtr->flags |= TLS_TCL_SERVER;
	SSL_set_accept_state(statePtr->ssl);
    } else {
	/* Client callbacks */
#ifdef USE_NPN
	if (statePtr->protos != NULL && tls1_2 == 0 && tls1_3 == 0) {







<
<
<







1620
1621
1622
1623
1624
1625
1626



1627
1628
1629
1630
1631
1632
1633
	/* Enable server to send cert request after handshake (TLS 1.3 only) */
	/* A write operation must take place for the Certificate Request to be
	   sent to the client, this can be done with SSL_do_handshake(). */
	if (request && post_handshake && tls1_3) {
	    SSL_verify_client_post_handshake(statePtr->ssl);
	}




	/* Set server mode */
	statePtr->flags |= TLS_TCL_SERVER;
	SSL_set_accept_state(statePtr->ssl);
    } else {
	/* Client callbacks */
#ifdef USE_NPN
	if (statePtr->protos != NULL && tls1_2 == 0 && tls1_3 == 0) {
1649
1650
1651
1652
1653
1654
1655

1656
1657
1658
1659
1660
1661
1662
	/* Set client mode */
	SSL_set_connect_state(statePtr->ssl);
    }

    /* Set BIO for read and write operations on SSL object */
    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_VOLATILE);








>







1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
	/* Set client mode */
	SSL_set_connect_state(statePtr->ssl);
    }

    /* Set BIO for read and write operations on SSL object */
    SSL_set_bio(statePtr->ssl, statePtr->p_bio, statePtr->p_bio);
    BIO_set_ssl(statePtr->bio, statePtr->ssl, BIO_NOCLOSE);
    BIO_set_ssl_mode(statePtr->bio, (long) !server);

    /*
     * End of SSL Init
     */
    dprintf("Returning %s", Tcl_GetChannelName(statePtr->self));
    Tcl_SetResult(interp, (char *) Tcl_GetChannelName(statePtr->self), TCL_VOLATILE);

1707
1708
1709
1710
1711
1712
1713
1714

1715
1716
1717
1718
1719
1720
1721
	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
		"\": not a stacked channel", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TLS", "UNIMPORT", "CHANNEL", "INVALID", (char *) NULL);
	return TCL_ERROR;
    }

    /* Flush any pending data */
    if (Tcl_Flush(chan) != TCL_OK) {

	return TCL_ERROR;
    }

    /* Init storage */
    Tcl_DStringInit(&upperChannelTranslation);
    Tcl_DStringInit(&upperChannelBlocking);
    Tcl_DStringInit(&upperChannelEOFChar);







|
>







1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
		"\": not a stacked channel", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TLS", "UNIMPORT", "CHANNEL", "INVALID", (char *) NULL);
	return TCL_ERROR;
    }

    /* Flush any pending data */
    if (Tcl_OutputBuffered(chan) > 0 && Tcl_Flush(chan) != TCL_OK) {
	Tcl_AppendResult(interp, "can't flush channel", (char *) NULL);
	return TCL_ERROR;
    }

    /* Init storage */
    Tcl_DStringInit(&upperChannelTranslation);
    Tcl_DStringInit(&upperChannelBlocking);
    Tcl_DStringInit(&upperChannelEOFChar);
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931



1932
1933
1934
1935
1936
1937
1938
    SSL_CTX_set_options(ctx, off);		/* Disable specified protocol versions */

    /* Allow writes to report success when less than all records have been written */
    SSL_CTX_set_mode(ctx, SSL_MODE_ENABLE_PARTIAL_WRITE);

    /* Disable attempts to try to process the next record instead of returning after a
       non-app record. Avoids hangs in blocking mode, when using SSL_read() and a
       non-application record was sent and no application data was sent. */
    SSL_CTX_clear_mode(ctx, SSL_MODE_AUTO_RETRY);

    SSL_CTX_sess_set_cache_size(ctx, 128);

    /* Set user defined ciphers, cipher suites, and security level */
    if ((ciphers != NULL) && !SSL_CTX_set_cipher_list(ctx, ciphers)) {
	Tcl_AppendResult(interp, "Set ciphers failed: No valid ciphers", (char *) NULL);
	SSL_CTX_free(ctx);
	return NULL;
    }
    if ((ciphersuites != NULL) && !SSL_CTX_set_ciphersuites(ctx, ciphersuites)) {
	Tcl_AppendResult(interp, "Set cipher suites failed: No valid ciphers", (char *) NULL);
	SSL_CTX_free(ctx);
	return NULL;
    }




    /* Set security level */
    if (level > -1 && level < 6) {
	/* SSL_set_security_level */
	SSL_CTX_set_security_level(ctx, level);
    }








|
|














>
>
>







1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
    SSL_CTX_set_options(ctx, off);		/* Disable specified protocol versions */

    /* Allow writes to report success when less than all records have been written */
    SSL_CTX_set_mode(ctx, SSL_MODE_ENABLE_PARTIAL_WRITE);

    /* Disable attempts to try to process the next record instead of returning after a
       non-app record. Avoids hangs in blocking mode, when using SSL_read() and a
       non-application record was sent without any application data. */
    /*SSL_CTX_clear_mode(ctx, SSL_MODE_AUTO_RETRY);*/

    SSL_CTX_sess_set_cache_size(ctx, 128);

    /* Set user defined ciphers, cipher suites, and security level */
    if ((ciphers != NULL) && !SSL_CTX_set_cipher_list(ctx, ciphers)) {
	Tcl_AppendResult(interp, "Set ciphers failed: No valid ciphers", (char *) NULL);
	SSL_CTX_free(ctx);
	return NULL;
    }
    if ((ciphersuites != NULL) && !SSL_CTX_set_ciphersuites(ctx, ciphersuites)) {
	Tcl_AppendResult(interp, "Set cipher suites failed: No valid ciphers", (char *) NULL);
	SSL_CTX_free(ctx);
	return NULL;
    }

    /* set automatic curve selection */
    SSL_CTX_set_ecdh_auto(ctx, 1);

    /* Set security level */
    if (level > -1 && level < 6) {
	/* SSL_set_security_level */
	SSL_CTX_set_security_level(ctx, level);
    }

2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
	/* Set directory containing CA certificates in PEM format. */
	if (CApath != NULL) {
	    if (!SSL_CTX_load_verify_dir(ctx, F2N(CApath, &ds))) {
		abort++;
	    }
	    Tcl_DStringFree(&ds);
	}
	
	/* Set URI for to a store, which may be a single container or a catalog of containers. */
	if (CAstore != NULL) {
	    if (!SSL_CTX_load_verify_store(ctx, F2N(CAstore, &ds))) {
		abort++;
	    }
	    Tcl_DStringFree(&ds);
	}
	
	/* Set file of CA certificates in PEM format.  */
	if (CAfile != NULL) {
	    if (!SSL_CTX_load_verify_file(ctx, F2N(CAfile, &ds))) {
		abort++;
	    }
	    Tcl_DStringFree(&ds);

	    /* Set list of CAs to send to client when requesting a client certificate */
	    STACK_OF(X509_NAME) *certNames = SSL_load_client_CA_file(F2N(CAfile, &ds));
	    if (certNames != NULL) {
		SSL_CTX_set_client_CA_list(ctx, certNames);
	    }
	    Tcl_DStringFree(&ds);
	}
#endif
    }

    return ctx;
}

/*
 *-------------------------------------------------------------------
 *
 * StatusObjCmd -- return certificate for connected peer info.







|







|
















<







2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133

2134
2135
2136
2137
2138
2139
2140
	/* Set directory containing CA certificates in PEM format. */
	if (CApath != NULL) {
	    if (!SSL_CTX_load_verify_dir(ctx, F2N(CApath, &ds))) {
		abort++;
	    }
	    Tcl_DStringFree(&ds);
	}

	/* Set URI for to a store, which may be a single container or a catalog of containers. */
	if (CAstore != NULL) {
	    if (!SSL_CTX_load_verify_store(ctx, F2N(CAstore, &ds))) {
		abort++;
	    }
	    Tcl_DStringFree(&ds);
	}

	/* Set file of CA certificates in PEM format.  */
	if (CAfile != NULL) {
	    if (!SSL_CTX_load_verify_file(ctx, F2N(CAfile, &ds))) {
		abort++;
	    }
	    Tcl_DStringFree(&ds);

	    /* Set list of CAs to send to client when requesting a client certificate */
	    STACK_OF(X509_NAME) *certNames = SSL_load_client_CA_file(F2N(CAfile, &ds));
	    if (certNames != NULL) {
		SSL_CTX_set_client_CA_list(ctx, certNames);
	    }
	    Tcl_DStringFree(&ds);
	}
#endif
    }

    return ctx;
}

/*
 *-------------------------------------------------------------------
 *
 * StatusObjCmd -- return certificate for connected peer info.
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
    ssl = statePtr->ssl;
    if (ssl != NULL) {
	const unsigned char *proto;
	unsigned int ulen;

	/* Initialization finished */
	LAPPEND_BOOL(interp, objPtr, "init_finished", SSL_is_init_finished(ssl));
	
	/* connection state */
	LAPPEND_STR(interp, objPtr, "state", SSL_state_string_long(ssl), -1);

	/* Get SNI requested server name */
	LAPPEND_STR(interp, objPtr, "servername", SSL_get_servername(ssl, TLSEXT_NAMETYPE_host_name), -1);

	/* Report the selected protocol as a result of the negotiation */







|







2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
    ssl = statePtr->ssl;
    if (ssl != NULL) {
	const unsigned char *proto;
	unsigned int ulen;

	/* Initialization finished */
	LAPPEND_BOOL(interp, objPtr, "init_finished", SSL_is_init_finished(ssl));

	/* connection state */
	LAPPEND_STR(interp, objPtr, "state", SSL_state_string_long(ssl), -1);

	/* Get SNI requested server name */
	LAPPEND_STR(interp, objPtr, "servername", SSL_get_servername(ssl, TLSEXT_NAMETYPE_host_name), -1);

	/* Report the selected protocol as a result of the negotiation */
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
	    | OPENSSL_INIT_ADD_ALL_CIPHERS | OPENSSL_INIT_ADD_ALL_DIGESTS
	    | OPENSSL_INIT_LOAD_CONFIG | OPENSSL_INIT_ASYNC, NULL)) {
	    return TCL_ERROR;
	}

	/* Create BIO handlers */
	BIO_new_tcl(NULL, 0);
	
	/* Create exit handler */
	Tcl_CreateExitHandler(TlsLibShutdown, NULL);
	initialized = 1;
    }
    return TCL_OK;
}








|







3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
	    | OPENSSL_INIT_ADD_ALL_CIPHERS | OPENSSL_INIT_ADD_ALL_DIGESTS
	    | OPENSSL_INIT_LOAD_CONFIG | OPENSSL_INIT_ASYNC, NULL)) {
	    return TCL_ERROR;
	}

	/* Create BIO handlers */
	BIO_new_tcl(NULL, 0);

	/* Create exit handler */
	Tcl_CreateExitHandler(TlsLibShutdown, NULL);
	initialized = 1;
    }
    return TCL_OK;
}

1
2
3
4
5
6
7
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
/*
 * Provides Custom BIO layer to interface OpenSSL with TCL. These
 * functions directly interface between the IO channel and BIO buffers.
 *
 * Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com>
 * Copyright (C) 2024 Brian O'Hagan
 *
 */










#include "tlsInt.h"
#include <openssl/bio.h>

/* Define BIO methods structure */
static BIO_METHOD *BioMethods = NULL;





































/*
 *-----------------------------------------------------------------------------
 *
 * BioWrite --
 *
 *	This function is used to read encrypted data from the BIO and write it
 *	into the socket. This function will be called in response to the
 *	application calling BIO_write_ex() or BIO_write().
 *
 * Results:
 *	Returns the number of bytes written to channel, 0 for EOF, or
 *	-1 for error.
 *
 * Side effects:
 *	Writes BIO data to channel.
 *
 *-----------------------------------------------------------------------------
 */

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

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

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


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



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

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

    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 (tclErrno == EAGAIN) {
	    dprintf("It's EAGAIN");
	} else {
	    dprintf("It's an unexpected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno);
	}

    } else {
	dprintf("Successfully wrote %" TCL_SIZE_MODIFIER "d bytes of data", ret);
    }

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

	    BIO_set_retry_read(bio);
	}
    }

    return (int) ret;
}

/*
 *-----------------------------------------------------------------------------
 *
 * BioRead --
 *
 *	This function is used to read encrypted data from the socket
 *	and write it into the BIO. This function will be called in response to
 *	the application calling BIO_read_ex() or BIO_read().
 *
 * Results:
 *	Returns the number of bytes read from channel, 0 for EOF, or -1 for
 *	error.
 *
 * Side effects:
 *	Reads channel data into BIO.







 *
 *-----------------------------------------------------------------------------
 */

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

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

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

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





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

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


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

    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 (tclErrno == EAGAIN) {
	    dprintf("It's EAGAIN");
	} else {

	    dprintf("It's an unexpected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno);

	}

    } else {
	dprintf("Successfully read %" TCL_SIZE_MODIFIER "d bytes of data", ret);
    }

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

	    BIO_set_retry_write(bio);
	}


    }

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


    return (int) ret;
}

/*
 *-----------------------------------------------------------------------------
 *
 * BioPuts --
 *
 *	This function is used to read a NULL terminated string from the BIO and
 *	write it to the channel. This function will be called in response to
 *	the application calling BIO_puts().
 *
 * Results:
 *	Returns the number of bytes written to channel or 0 for error.
 *
 * Side effects:
 *	Writes data to channel.
 *
 *-----------------------------------------------------------------------------
 */

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

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

/*
 *-----------------------------------------------------------------------------
 *
 * BioCtrl --
 *
 *	This function is used to process control messages in the BIO. This
 *	function will be called in response to the application calling BIO_ctrl().

 *
 * Results:
 *	Function dependent
 *
 * Side effects:
 *	Function dependent
 *
 *-----------------------------------------------------------------------------
 */

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

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

    dprintf("BioCtrl(%p, 0x%x, 0x%lx, %p)", (void *) 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 = ((chan) ? Tcl_Eof(chan) : 1);
		break;
	case BIO_CTRL_PENDING:
		dprintf("Got BIO_CTRL_PENDING");
		ret = ((chan) ? ((Tcl_InputBuffered(chan) ? 1 : 0)) : 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 = ((chan) && (Tcl_WriteRaw(chan, "", 0) >= 0) ? 1 : -1);
		dprintf("BIO_CTRL_FLUSH returning value %li", ret);
		break;
	case BIO_CTRL_PUSH:

		dprintf("Got BIO_CTRL_PUSH");
		ret = 0;
		break;
	case BIO_CTRL_POP:

		dprintf("Got BIO_CTRL_POP");
		ret = 0;
		break;
	case BIO_CTRL_SET:

		dprintf("Got BIO_CTRL_SET");








		ret = 0;
		break;
	case BIO_CTRL_GET :

		dprintf("Got BIO_CTRL_GET ");
























		ret = 0;
		break;
#ifdef BIO_CTRL_GET_KTLS_SEND


























	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;
#endif
	default:
		dprintf("Got unknown control command (%i)", cmd);
		ret = 0;
		break;
    }

    return ret;
}

/*
 *-----------------------------------------------------------------------------
 *
 * BioNew --
 *
 *	This function is used to create a new instance of the BIO. This
 *	function will be called in response to the application calling BIO_new().

 *
 * Results:
 *	Returns boolean success result (1=success, 0=failure)
 *
 * Side effects:
 *	Initializes BIO structure.
 *
 *-----------------------------------------------------------------------------
 */

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




    BIO_set_init(bio, 0);
    BIO_set_data(bio, NULL);

    BIO_clear_flags(bio, -1);
    return 1;
}

/*
 *-----------------------------------------------------------------------------
 *
 * BioFree --
 *
 *	This function is used to destroy an instance of a BIO. This function
 *	will be called in response to the application calling BIO_free().

 *
 * Results:
 *	Returns boolean success result
 *
 * Side effects:
 *	Initializes BIO structure.
 *
 *-----------------------------------------------------------------------------
 */

static int BioFree(BIO *bio) {


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

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

    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);
    }
    return 1;
}

/*








>
>
>
>
>
>
>
>
>








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







|


|
|








<

|
|
|

|

>
|

>
>
|


|
|

<
>
>

>
|
|

|

|

>
>


|
>
|


|
|
|
<
|
<
|
<
<
|
<
<
<
|
<
|
|
>








|
|
|







>
>
>
>
>
>
>





<

|
|
|

|

|



>
>
>
>


|

>

|
|

<
<
<
<
<
|
|
<
<
<
<

|
>
|
>
>

<
<
|
>
|
>



|
|
|
<
<
<
|
|
|
>
>
|
|
<
<

>










|











|










|
>











<

|
|





>

<
<
|
<


|
>
|
>
|


>

|

<
<
<
<
<
<
<
<
|
<
|
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<


|
|
<
<
|
|
<


>




>



|
>
|
>
>
>
>
>
>
>
>
|

|
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

>

>



|

>

>








>









|
>













>
>
>
|

>










|
>











>
>




<
|

<
<
<
<
|







1
2
3
4
5
6
7
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
/*
 * Provides Custom BIO layer to interface OpenSSL with TCL. These
 * functions directly interface between the IO channel and BIO buffers.
 *
 * Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com>
 * Copyright (C) 2024 Brian O'Hagan
 *
 */

/*
		tlsBIO.c				tlsIO.c
  +------+                         +-----+                                     +------+
  |      |Tcl_WriteRaw <-- BioWrite| SSL |BIO_write <-- TlsOutputProc <-- Write|      |
  |socket|      <encrypted>        | BIO |            <unencrypted>            | App  | 
  |      |Tcl_ReadRaw  -->  BioRead|     |BIO_Read  --> TlsInputProc  -->  Read|      |
  +------+                         +-----+                                     +------+
*/

#include "tlsInt.h"
#include <openssl/bio.h>

/* Define BIO methods structure */
static BIO_METHOD *BioMethods = NULL;



/*
 *-----------------------------------------------------------------------------
 *
 * BIOShouldRetry --
 *
 *	Determine if should retry operation based on error code. Same
 *	conditions as BIO_sock_should_retry function.
 *
 * Results:
 *	1 = retry, 0 = no retry
 *
 * Side effects:
 *	None
 *
 *-----------------------------------------------------------------------------
 */

static int BIOShouldRetry(int code) {
    int res = 0;
    dprintf("BIOShouldRetry %d=%s", code, Tcl_ErrnoMsg(code));

    if (code == EAGAIN || code == EWOULDBLOCK || code == ENOTCONN || code == EPROTO ||
#ifdef _WIN32
	code == WSAEWOULDBLOCK ||
#endif
	code == EINTR || code == EINPROGRESS || code == EALREADY) {
	res = 1;
    }

    dprintf("BIOShouldRetry %d=%s, res=%d", code, Tcl_ErrnoMsg(code), res);

    return res;
}

/*
 *-----------------------------------------------------------------------------
 *
 * BioWrite --
 *
 *	This function is used to read encrypted data from the BIO and write it
 *	into the socket. This function will be called in response to the
 *	application calling the BIO_write_ex() or BIO_write() functions.
 *
 * Results:
 *	Returns the number of bytes written to channel, 0 for EOF, or -1 for
 *	error.
 *
 * Side effects:
 *	Writes BIO data to channel.
 *
 *-----------------------------------------------------------------------------
 */

static int BioWrite(BIO *bio, const char *buf, int bufLen) {

    Tcl_Size ret;
    int is_eof, tclErrno;
    State *statePtr = (State *) BIO_get_data(bio);
    Tcl_Channel chan = Tls_GetParent(statePtr, 0);

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

    BIO_clear_retry_flags(bio);
    Tcl_SetErrno(0);

    /* Write data to underlying channel */
    ret = Tcl_WriteRaw(chan, buf, (Tcl_Size) bufLen);
    is_eof = Tcl_Eof(chan);
    tclErrno = Tcl_GetErrno();

    dprintf("[chan=%p] BioWrite(%d) -> %" TCL_SIZE_MODIFIER "d [tclEof=%d; tclErrno=%d: %s]",
	(void *) chan, bufLen, ret, is_eof, tclErrno, Tcl_ErrnoMsg(tclErrno));


    if (ret > 0) {
	dprintf("Successfully wrote %" TCL_SIZE_MODIFIER "d bytes of data", ret);

    } else if (ret == 0) {
	if (is_eof) {
	    dprintf("Got EOF while writing, returning a Connection Reset error which maps to Soft EOF");
	Tcl_SetErrno(ECONNRESET);
	    BIO_set_flags(bio, BIO_FLAGS_IN_EOF);

	} else {
	dprintf("Got 0 from Tcl_WriteRaw, and EOF is not set; ret = 0");
	    BIO_set_retry_write(bio);

	dprintf("Setting retry read flag");
	BIO_set_retry_read(bio);
	}

    } else {
	dprintf("We got some kind of I/O error");

	if (BIOShouldRetry(tclErrno)) {
	    dprintf("Try again for: %i=%s", tclErrno, Tcl_ErrnoMsg(tclErrno));
	    BIO_set_retry_write(bio);



	} else {


	    dprintf("Unexpected error: %i=%s", tclErrno, Tcl_ErrnoMsg(tclErrno));



	}

    }

    dprintf("BioWrite returning %" TCL_SIZE_MODIFIER "d", ret);
    return (int) ret;
}

/*
 *-----------------------------------------------------------------------------
 *
 * BioRead --
 *
 *	This function is used to read encrypted data from the socket and
 *	write it into the BIO. This function will be called in response to the
 *	application calling the BIO_read_ex() or BIO_read() functions.
 *
 * Results:
 *	Returns the number of bytes read from channel, 0 for EOF, or -1 for
 *	error.
 *
 * Side effects:
 *	Reads channel data into BIO.
 *
 * Data is received in whole blocks known as records from the peer. A whole
 * record is processed (e.g. decrypted) in one go and is buffered by OpenSSL
 * until it is read by the application via a call to SSL_read. SSL_pending()
 * returns the number of bytes which have been processed, buffered, and are
 * available inside ssl for immediate read. SSL_has_pending() returns 1 if
 * data is buffered (whether processed or unprocessed) and 0 otherwise.
 *
 *-----------------------------------------------------------------------------
 */

static int BioRead(BIO *bio, char *buf, int bufLen) {

    Tcl_Size ret = 0;
    int is_eof, tclErrno, is_blocked;
    State *statePtr = (State *) BIO_get_data(bio);
    Tcl_Channel chan = Tls_GetParent(statePtr, 0);

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

    if (buf == NULL || bufLen <= 0) {
	return 0;
    }

    BIO_clear_retry_flags(bio);
    Tcl_SetErrno(0);

    /* Read data from underlying channel */
    ret = Tcl_ReadRaw(chan, buf, (Tcl_Size) bufLen);

    is_eof = Tcl_Eof(chan);
    tclErrno = Tcl_GetErrno();
    is_blocked = Tcl_InputBlocked(chan);

    dprintf("[chan=%p] BioRead(%d) -> %" TCL_SIZE_MODIFIER "d [tclEof=%d; blocked=%d; tclErrno=%d: %s]",
	(void *) chan, bufLen, ret, is_eof, is_blocked, tclErrno, Tcl_ErrnoMsg(tclErrno));






    if (ret > 0) {
	dprintf("Successfully read %" TCL_SIZE_MODIFIER "d bytes of data", ret);





    } else if (ret == 0) {
	if (is_eof) {
	    dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
	   Tcl_SetErrno(ECONNRESET);
	    BIO_set_flags(bio, BIO_FLAGS_IN_EOF);



	} else if (is_blocked) {
	    dprintf("Got input blocked from Tcl_ReadRaw");
	    dprintf("Setting retry read flag");
	    BIO_set_retry_read(bio);
	}

    } else {
	dprintf("We got some kind of I/O error");

	if (BIOShouldRetry(tclErrno)) {



	    dprintf("Try again for: %i=%s", tclErrno, Tcl_ErrnoMsg(tclErrno));
	    BIO_set_retry_read(bio);

	} else {
	    dprintf("Unexpected error: %i=%s", tclErrno, Tcl_ErrnoMsg(tclErrno));
	}
    }



    dprintf("BioRead returning %" TCL_SIZE_MODIFIER "d", ret);
    return (int) ret;
}

/*
 *-----------------------------------------------------------------------------
 *
 * BioPuts --
 *
 *	This function is used to read a NULL terminated string from the BIO and
 *	write it to the channel. This function will be called in response to
 *	the application calling the BIO_puts() function.
 *
 * Results:
 *	Returns the number of bytes written to channel or 0 for error.
 *
 * Side effects:
 *	Writes data to channel.
 *
 *-----------------------------------------------------------------------------
 */

static int BioPuts(BIO *bio, const char *str) {
    dprintf("BioPuts(%p) \"%s\"", bio, str);

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

/*
 *-----------------------------------------------------------------------------
 *
 * BioCtrl --
 *
 *	This function is used to process control messages in the BIO. This
 *	function will be called in response to the application calling the
 *	BIO_ctrl() function.
 *
 * Results:
 *	Function dependent
 *
 * Side effects:
 *	Function dependent
 *
 *-----------------------------------------------------------------------------
 */

static long BioCtrl(BIO *bio, int cmd, long num, void *ptr) {

    long ret = 1;
    State *statePtr = (State *) BIO_get_data(bio);
    Tcl_Channel chan = Tls_GetParent(statePtr, 0);

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

    switch (cmd) {
	case BIO_CTRL_RESET:
		/* opt - Resets BIO to initial state. Implements BIO_reset. */
		dprintf("Got BIO_CTRL_RESET");


		/* Return 1 for success (0 for file BIOs) and -1 for failure */

		ret = 0;
		break;
	case BIO_CTRL_EOF:
		/* opt - Returns whether EOF has been reached. Implements BIO_eof. */
		dprintf("Got BIO_CTRL_EOF");
		/* Returns 1 if EOF has been reached, 0 if not, or <0 for failure */
		ret = ((chan) ? (Tcl_Eof(chan) || BIO_test_flags(bio, BIO_FLAGS_IN_EOF)) : 1);
		break;
	case BIO_CTRL_INFO:
		/* opt - extra info on BIO. Implements BIO_get_mem_data */
		dprintf("Got BIO_CTRL_INFO");
		ret = 0;
		break;








	case BIO_CTRL_SET:

		/* man - set the 'IO' parameter */






		dprintf("Got BIO_CTRL_SET");









		ret = 0;
		break;
	case BIO_CTRL_GET:
		/* man - get the 'IO' parameter */


		dprintf("Got BIO_CTRL_GET ");
		ret = 0;

		break;
	case BIO_CTRL_PUSH:
		/* opt - internal, used to signify change. Implements BIO_push */
		dprintf("Got BIO_CTRL_PUSH");
		ret = 0;
		break;
	case BIO_CTRL_POP:
		/* opt - internal, used to signify change. Implements BIO_pop */
		dprintf("Got BIO_CTRL_POP");
		ret = 0;
		break;
	case BIO_CTRL_GET_CLOSE:
		/* man - Get the close on BIO_free() flag set by BIO_CTRL_SET_CLOSE. Implements BIO_get_close */
		dprintf("Got BIO_CTRL_CLOSE");
		/* Returns BIO_CLOSE, BIO_NOCLOSE, or <0 for failure */
		ret = BIO_get_shutdown(bio);
		break;
	case BIO_CTRL_SET_CLOSE:
		/* man - Set the close on BIO_free() flag. Implements BIO_set_close */
		dprintf("Got BIO_SET_CLOSE");
		BIO_set_shutdown(bio, num);
		/* Returns 1 on success or <=0 for failure */
		ret = 1;
		break;
	case BIO_CTRL_PENDING:
		/* opt - Return number of bytes in BIO waiting to be read. Implements BIO_pending. */
		dprintf("Got BIO_CTRL_PENDING");
		/* Return the amount of pending data or 0 for error */
		ret = ((chan) ? Tcl_InputBuffered(chan) : 0);
		break;
	case BIO_CTRL_FLUSH:
		/* opt - Flush any buffered output. Implements BIO_flush. */
		dprintf("Got BIO_CTRL_FLUSH");
		/* Use Tcl_WriteRaw instead of Tcl_Flush to operate on right chan in stack */
		/* Returns 1 for success, <=0 for error/retry. */
		ret = ((chan) && (Tcl_WriteRaw(chan, "", 0) >= 0) ? 1 : -1);
		/*ret = BioWrite(bio, NULL, 0);*/
		break;
	case BIO_CTRL_DUP:
		/* man - extra stuff for 'duped' BIO. Implements BIO_dup_state */
		dprintf("Got BIO_CTRL_DUP");
		ret = 1;
		break;
	case BIO_CTRL_WPENDING:
		/* opt - Return number of bytes in BIO still to be written. Implements BIO_wpending. */
		dprintf("Got BIO_CTRL_WPENDING");
		/* Return the amount of pending data or 0 for error */
		ret = ((chan) ? Tcl_OutputBuffered(chan) : 0);
		break;
	case BIO_CTRL_SET_CALLBACK:
		/* opt - Sets an informational callback. Implements BIO_set_info_callback */
		ret = 0;
		break;
	case BIO_CTRL_GET_CALLBACK:
		/* opt - Get and return the info callback. Implements BIO_get_info_callback */
		ret = 0;
		break;

	case BIO_C_FILE_SEEK:
		/* Not used for sockets. Tcl_Seek only works on top chan. Implements BIO_seek() */
		dprintf("Got BIO_C_FILE_SEEK");
		ret = 0; /* Return 0 success and -1 for failure */
		break;
	case BIO_C_FILE_TELL:
		/* Not used for sockets. Tcl_Tell only works on top chan. Implements BIO_tell() */
		dprintf("Got BIO_C_FILE_TELL");
		ret = 0; /* Return 0 success and -1 for failure */
		break;
	case BIO_C_SET_FD:
		/* Implements BIO_set_fd */
		dprintf("Unsupported call: BIO_C_SET_FD");
		ret = -1;
		break;
	case BIO_C_GET_FD:
		/* Implements BIO_get_fd() */
		dprintf("Unsupported call: BIO_C_GET_FD");
		ret = -1;
		break;

#if OPENSSL_VERSION_NUMBER >= 0x30000000L && defined(BIO_CTRL_GET_KTLS_SEND)
	case BIO_CTRL_GET_KTLS_SEND:
		/* Implements BIO_get_ktls_send */
		dprintf("Got BIO_CTRL_GET_KTLS_SEND");
		/* Returns 1 if the BIO is using the Kernel TLS data-path for sending, 0 if not */
		ret = 0;
		break;
#endif
#if OPENSSL_VERSION_NUMBER >= 0x30000000L && defined(BIO_CTRL_GET_KTLS_RECV)
	case BIO_CTRL_GET_KTLS_RECV:
		/* Implements BIO_get_ktls_recv */
		dprintf("Got BIO_CTRL_GET_KTLS_RECV");
		/* Returns 1 if the BIO is using the Kernel TLS data-path for receiving, 0 if not */
		ret = 0;
		break;
#endif
	default:
		dprintf("Got unknown control command (%i)", cmd);
		ret = 0;
		break;
    }
    dprintf("BioCtrl return value %li", ret);
    return ret;
}

/*
 *-----------------------------------------------------------------------------
 *
 * BioNew --
 *
 *	This function is used to create a new instance of the BIO. This
 *	function will be called in response to the application calling the
 *	BIO_new() function.
 *
 * Results:
 *	Returns boolean success result (1=success, 0=failure)
 *
 * Side effects:
 *	Initializes BIO structure.
 *
 *-----------------------------------------------------------------------------
 */

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

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

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

/*
 *-----------------------------------------------------------------------------
 *
 * BioFree --
 *
 *	This function is used to destroy an instance of a BIO. This function
 *	will be called in response to the application calling the BIO_free()
 *	function.
 *
 * Results:
 *	Returns boolean success result
 *
 * Side effects:
 *	Initializes BIO structure.
 *
 *-----------------------------------------------------------------------------
 */

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

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


    /* Clear flags if set to BIO_CLOSE (close I/O stream when the BIO is freed) */
    if (BIO_get_shutdown(bio)) {




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

/*
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
 */

BIO *BIO_new_tcl(State *statePtr, int flags) {
    BIO *bio;
#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;
#endif

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








|


<




>

>
>
>
|
>
>
>
>
>
>

>







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
 */

BIO *BIO_new_tcl(State *statePtr, int flags) {
    BIO *bio;
#ifdef TCLTLS_SSL_USE_FASTPATH
    Tcl_Channel parentChannel;
    const Tcl_ChannelType *parentChannelType;
    
    int parentChannelFdIn, parentChannelFdOut, parentChannelFd;
    int validParentChannelFd;

#endif

    dprintf("BIO_new_tcl() called");

    /* Create custom BIO method */
    if (BioMethods == NULL) {
	/* BIO_TYPE_BIO = (19|BIO_TYPE_SOURCE_SINK) -- half a BIO pair */
	/* BIO_TYPE_CONNECT = (12|BIO_TYPE_SOURCE_SINK|BIO_TYPE_DESCRIPTOR) */
	/* BIO_TYPE_ACCEPT  = (13|BIO_TYPE_SOURCE_SINK|BIO_TYPE_DESCRIPTOR) */
	BioMethods = BIO_meth_new(BIO_TYPE_BIO, "tcl");
	if (BioMethods == NULL) {
	    dprintf("Memory allocation error");

	    return NULL;
	}
	/* Not used BIO_meth_set_write_ex */
	BIO_meth_set_write(BioMethods, BioWrite);
	/* Not used BIO_meth_set_read_ex */
	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);
    }

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
     * 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, (ClientData) &parentChannelFdIn_p);
	if (tclGetChannelHandleRet == TCL_OK) {
	    tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_WRITABLE, (ClientData) &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;
    }


    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);
    return bio;
}

/*
 *-----------------------------------------------------------------------------
 *
 * BIO_cleanup --







>
>
>


















>
>
>


>


<




|







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
     * 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) {
	void *parentChannelFdIn_p, *parentChannelFdOut_p;
	int tclGetChannelHandleRet;

	tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_READABLE, (ClientData) &parentChannelFdIn_p);
	if (tclGetChannelHandleRet == TCL_OK) {
	    tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_WRITABLE, (ClientData) &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;
	BIO_set_data(bio, statePtr);
	BIO_set_shutdown(bio, flags);
	BIO_set_init(bio, 1);
	return bio;
    }
#endif

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


    bio = BIO_new(BioMethods);
    BIO_set_data(bio, statePtr);
    BIO_set_shutdown(bio, flags);
    BIO_set_init(bio, 1); /* Enable read & write */
    return bio;
}

/*
 *-----------------------------------------------------------------------------
 *
 * BIO_cleanup --
16
17
18
19
20
21
22









23
24
25
26
27
28
29
 * 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)
 *
 */










#include "tlsInt.h"
#include <errno.h>

/*
 *-----------------------------------------------------------------------------
 *







>
>
>
>
>
>
>
>
>







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
 * 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)
 *
 */

/*
		tlsBIO.c				tlsIO.c
  +------+                         +-----+                                     +------+
  |      |Tcl_WriteRaw <-- BioWrite| SSL |BIO_write <-- TlsOutputProc <-- Write|      |
  |socket|      <encrypted>        | BIO |            <unencrypted>            | App  | 
  |      |Tcl_ReadRaw  -->  BioRead|     |BIO_Read  --> TlsInputProc  -->  Read|      |
  +------+                         +-----+                                     +------+
*/

#include "tlsInt.h"
#include <errno.h>

/*
 *-----------------------------------------------------------------------------
 *
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
/*
 *-----------------------------------------------------------------------------
 *
 * TlsCloseProc --
 *
 *	This procedure is invoked by the generic IO level to perform channel
 *	type specific cleanup when a SSL socket based channel is closed.


 *
 * Results:
 *    0 if successful or POSIX error code if failed.
 *
 * Side effects:
 *    Closes the socket of the channel.
 *
 *-----------------------------------------------------------------------------
 */
static int TlsCloseProc(ClientData instanceData, Tcl_Interp *interp) {
    State *statePtr = (State *) instanceData;

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

    /* Flush any pending data */
    
    /* Send shutdown notification. Will return 0 while in process, then 1 when complete. */
    /* Closes the write direction of the connection; the read direction is closed by the peer. */
    /* Does not affect socket state. */
    if (statePtr->ssl != NULL) {
	SSL_shutdown(statePtr->ssl);
    }

    /* Tls_Free calls Tls_Clean */
    Tcl_EventuallyFree((ClientData)statePtr, Tls_Free);
    return 0;
}







>
>















|


|
|







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
/*
 *-----------------------------------------------------------------------------
 *
 * TlsCloseProc --
 *
 *	This procedure is invoked by the generic IO level to perform channel
 *	type specific cleanup when a SSL socket based channel is closed.
 *	Called by the generic I/O layer whenever the Tcl_Close() function is
 *	used.
 *
 * Results:
 *    0 if successful or POSIX error code if failed.
 *
 * Side effects:
 *    Closes the socket of the channel.
 *
 *-----------------------------------------------------------------------------
 */
static int TlsCloseProc(ClientData instanceData, Tcl_Interp *interp) {
    State *statePtr = (State *) instanceData;

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

    /* Flush any pending data */

    /* Send shutdown notification. Will return 0 while in process, then 1 when complete. */
    /* Closes the write direction of the connection; the read direction is closed by the peer. */
    /* Does not affect socket state. Don't call after fatal error. */
    if (statePtr->ssl != NULL && !(statePtr->flags & TLS_TCL_HANDSHAKE_FAILED)) {
	SSL_shutdown(statePtr->ssl);
    }

    /* Tls_Free calls Tls_Clean */
    Tcl_EventuallyFree((ClientData)statePtr, Tls_Free);
    return 0;
}
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
	}
	Tls_Error(statePtr, "Wait for failed handshake");
	return -1;
    }

    for (;;) {
	ERR_clear_error();


	/* Not initialized yet! Also calls SSL_do_handshake(). */
	if (statePtr->flags & TLS_TCL_SERVER) {
	    dprintf("Calling SSL_accept()");
	    err = SSL_accept(statePtr->ssl);

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


	if (err > 0) {
	    dprintf("Accept or connect was successful");

	    err = BIO_flush(statePtr->bio);
	    if (err <= 0) {
		dprintf("Flushing the lower layers failed, this will probably terminate this session");
	    }
	} else {
	    dprintf("Accept or connect failed");
	}


	rc = SSL_get_error(statePtr->ssl, err);
	backingError = ERR_get_error();
	if (rc != SSL_ERROR_NONE) {
	    dprintf("Got error: %i (rc = %i)", err, rc);
	    dprintf("Got error: %s", ERR_reason_error_string(backingError));
	}


	bioShouldRetry = 0;

	if (err <= 0) {
	    if (rc == SSL_ERROR_WANT_CONNECT || rc == SSL_ERROR_WANT_ACCEPT) {
		bioShouldRetry = 1;
	    } else if (rc == SSL_ERROR_WANT_READ) {
		bioShouldRetry = 1;
		statePtr->want = TCL_READABLE;
	    } else if (rc == SSL_ERROR_WANT_WRITE) {
		bioShouldRetry = 1;
		statePtr->want = TCL_WRITABLE;
	    } 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 (statePtr->flags & TLS_TCL_ASYNC) {
		dprintf("Returning EAGAIN so that it can be retried later");







>











>











>







>
|
>





|


|





<
<
<
<







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
	}
	Tls_Error(statePtr, "Wait for failed handshake");
	return -1;
    }

    for (;;) {
	ERR_clear_error();
	BIO_clear_retry_flags(statePtr->bio);

	/* Not initialized yet! Also calls SSL_do_handshake(). */
	if (statePtr->flags & TLS_TCL_SERVER) {
	    dprintf("Calling SSL_accept()");
	    err = SSL_accept(statePtr->ssl);

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

	/* 1=successful, 0=not successful and shut down, <0=fatal error */
	if (err > 0) {
	    dprintf("Accept or connect was successful");

	    err = BIO_flush(statePtr->bio);
	    if (err <= 0) {
		dprintf("Flushing the lower layers failed, this will probably terminate this session");
	    }
	} else {
	    dprintf("Accept or connect failed");
	}

	/* Same as SSL_want, but also checks the error queue */
	rc = SSL_get_error(statePtr->ssl, err);
	backingError = ERR_get_error();
	if (rc != SSL_ERROR_NONE) {
	    dprintf("Got error: %i (rc = %i)", err, rc);
	    dprintf("Got error: %s", ERR_reason_error_string(backingError));
	}

	/* The retry flag is set by the BIO_set_retry_* functions */
	bioShouldRetry = BIO_should_retry(statePtr->bio);

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




	}

	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");
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240

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

    switch (rc) {
	case SSL_ERROR_NONE:
	    /* The TLS/SSL I/O operation completed */
	    dprintf("The connection is good");
	    *errorCodePtr = 0;
	    break;

	case SSL_ERROR_SSL:
	    /* A non-recoverable, fatal error in the SSL library occurred, usually a protocol error */
	    dprintf("SSL_ERROR_SSL: Got permanent fatal SSL error, aborting immediately");







|







238
239
240
241
242
243
244
245
246
247
248
249
250
251
252

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

    switch (rc) {
	case SSL_ERROR_NONE:
	    /* The TLS/SSL I/O operation completed successfully */
	    dprintf("The connection is good");
	    *errorCodePtr = 0;
	    break;

	case SSL_ERROR_SSL:
	    /* A non-recoverable, fatal error in the SSL library occurred, usually a protocol error */
	    dprintf("SSL_ERROR_SSL: Got permanent fatal SSL error, aborting immediately");
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
		Tls_Error(statePtr, ERR_reason_error_string(backingError));
	    }

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

	case SSL_ERROR_ZERO_RETURN:
	    /* The TLS/SSL peer has closed the connection for writing by sending the close_notify alert */

	    dprintf("SSL_ERROR_ZERO_RETURN: Connect returned an invalid value...");
	    *errorCodePtr = EINVAL;
	    Tls_Error(statePtr, "Peer has closed the connection for writing by sending the close_notify alert");
	    return -1;

	case SSL_ERROR_WANT_READ:








	case SSL_ERROR_WANT_WRITE:








	case SSL_ERROR_WANT_X509_LOOKUP:








	case SSL_ERROR_WANT_CONNECT:








	case SSL_ERROR_WANT_ACCEPT:









	case SSL_ERROR_WANT_ASYNC:

	case SSL_ERROR_WANT_ASYNC_JOB:

	case SSL_ERROR_WANT_CLIENT_HELLO_CB:

#if OPENSSL_VERSION_NUMBER >= 0x30000000L
	case SSL_ERROR_WANT_RETRY_VERIFY:

#endif
	default:
	    /* The operation did not complete and should be retried later. */
	    dprintf("Operation did not complete, call function again later: %i", rc);
	    *errorCodePtr = EAGAIN;
	    dprintf("ERR(%d, %d) ", rc, *errorCodePtr);
	    Tls_Error(statePtr, "Operation did not complete, call function again later");







|
>

|




>
>
>
>
>
>
>
>

>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>

>

>

>


>







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
		Tls_Error(statePtr, ERR_reason_error_string(backingError));
	    }

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

	case SSL_ERROR_ZERO_RETURN:
	    /* Peer has closed the connection by sending the close_notify alert. Can't read, but can write. */
	    /* Need to return an EOF, so channel is closed which will send an SSL_shutdown(). */
	    dprintf("SSL_ERROR_ZERO_RETURN: Connect returned an invalid value...");
	    *errorCodePtr = ECONNRESET;
	    Tls_Error(statePtr, "Peer has closed the connection for writing by sending the close_notify alert");
	    return -1;

	case SSL_ERROR_WANT_READ:
	    /* More data must be read from the underlying BIO layer in order to complete the actual SSL_*() operation.  */
	    dprintf("SSL_ERROR_WANT_READ");
	    BIO_set_retry_read(statePtr->bio);
	    *errorCodePtr = EAGAIN;
	    dprintf("ERR(%d, %d) ", rc, *errorCodePtr);
	    statePtr->want |= TCL_READABLE;
	    return -1;

	case SSL_ERROR_WANT_WRITE:
	    /* There is data in the SSL buffer that must be written to the underlying BIO in order to complete the SSL_*() operation. */
	    dprintf("SSL_ERROR_WANT_WRITE");
	    BIO_set_retry_write(statePtr->bio);
	    *errorCodePtr = EAGAIN;
	    dprintf("ERR(%d, %d) ", rc, *errorCodePtr);
	    statePtr->want |= TCL_WRITABLE;
	    return -1;

	case SSL_ERROR_WANT_CONNECT:
	    /* Connect would have blocked. */
	    dprintf("SSL_ERROR_WANT_CONNECT");
	    BIO_set_retry_special(statePtr->bio);
	    BIO_set_retry_reason(statePtr->bio, BIO_RR_CONNECT);
	    *errorCodePtr = EAGAIN;
	    dprintf("ERR(%d, %d) ", rc, *errorCodePtr);
	    return -1;

	case SSL_ERROR_WANT_ACCEPT:
	    /* Accept would have blocked */
	    dprintf("SSL_ERROR_WANT_ACCEPT");
	    BIO_set_retry_special(statePtr->bio);
	    BIO_set_retry_reason(statePtr->bio, BIO_RR_ACCEPT);
	    *errorCodePtr = EAGAIN;
	    dprintf("ERR(%d, %d) ", rc, *errorCodePtr);
	    return -1;

	case SSL_ERROR_WANT_X509_LOOKUP:
	    /* App callback set by SSL_CTX_set_client_cert_cb has asked to be called again */
	    /* The operation did not complete because an application callback set by SSL_CTX_set_client_cert_cb() has asked to be called again. */
	    dprintf("SSL_ERROR_WANT_X509_LOOKUP");
	    BIO_set_retry_special(statePtr->bio);
	    BIO_set_retry_reason(statePtr->bio, BIO_RR_SSL_X509_LOOKUP);
	    *errorCodePtr = EAGAIN;
	    dprintf("ERR(%d, %d) ", rc, *errorCodePtr);
	    return -1;

	case SSL_ERROR_WANT_ASYNC:
	    /* Used with flag SSL_MODE_ASYNC, op didn't complete because an async engine is still processing data */
	case SSL_ERROR_WANT_ASYNC_JOB:
	    /* The asynchronous job could not be started because there were no async jobs available in the pool. */
	case SSL_ERROR_WANT_CLIENT_HELLO_CB:
	    /* The operation did not complete because an application callback set by SSL_CTX_set_client_hello_cb() has asked to be called again. */
#if OPENSSL_VERSION_NUMBER >= 0x30000000L
	case SSL_ERROR_WANT_RETRY_VERIFY:
	    /* The operation did not complete because a certificate verification callback has asked to be called again via SSL_set_retry_verify(3). */
#endif
	default:
	    /* The operation did not complete and should be retried later. */
	    dprintf("Operation did not complete, call function again later: %i", rc);
	    *errorCodePtr = EAGAIN;
	    dprintf("ERR(%d, %d) ", rc, *errorCodePtr);
	    Tls_Error(statePtr, "Operation did not complete, call function again later");
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
}

/*
 *-----------------------------------------------------------------------------
 *
 * TlsInputProc --
 *
 *	This procedure is invoked by the generic IO level to read data from the
 *	BIo. Equivalent to SSL_read.
 *	Called by the generic I/O layer whenever the Tcl_Read(), Tcl_ReadChars,
 *	Tcl_Gets, and Tcl_GetsObj functions are used.
 *
 * Results:
 *	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.
 *
 * Side effects:
 *    Reads input from the input device of the channel.




 *
 *-----------------------------------------------------------------------------
 */
static int TlsInputProc(ClientData instanceData, char *buf, int bufSize, int *errorCodePtr) {
    unsigned long backingError;
    State *statePtr = (State *) instanceData;
    int bytesRead, err;
    *errorCodePtr = 0;

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

    /* Skip if user verify callback is still running */
    if (statePtr->flags & TLS_TCL_CALLBACK) {
	dprintf("Callback is running, reading 0 bytes");
	return 0;
    }

    /* If not initialized, do connect */

    if (statePtr->flags & TLS_TCL_INIT) {
	int tlsConnect;

	dprintf("Calling Tls_WaitForConnect");

	tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 0);
	if (tlsConnect < 0) {







|
<
|
|







>
>
>
>


















>







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
}

/*
 *-----------------------------------------------------------------------------
 *
 * TlsInputProc --
 *
 *	This procedure is invoked by the generic I/O layer to read data from

 *	the BIO whenever the Tcl_Read(), Tcl_ReadChars, Tcl_Gets, and
 *	Tcl_GetsObj functions are used. Equivalent to SSL_read_ex and SSL_read.
 *
 * Results:
 *	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.
 *
 * Side effects:
 *    Reads input from the input device of the channel.
 *
 * Data is received in whole blocks known as records from the peer. A whole
 * record is processed (e.g. decrypted) in one go and is buffered by OpenSSL
 * until it is read by the application via a call to SSL_read. 
 *
 *-----------------------------------------------------------------------------
 */
static int TlsInputProc(ClientData instanceData, char *buf, int bufSize, int *errorCodePtr) {
    unsigned long backingError;
    State *statePtr = (State *) instanceData;
    int bytesRead, err;
    *errorCodePtr = 0;

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

    /* Skip if user verify callback is still running */
    if (statePtr->flags & TLS_TCL_CALLBACK) {
	dprintf("Callback is running, reading 0 bytes");
	return 0;
    }

    /* If not initialized, do connect */
    /* Can also check SSL_is_init_finished(ssl) */
    if (statePtr->flags & TLS_TCL_INIT) {
	int tlsConnect;

	dprintf("Calling Tls_WaitForConnect");

	tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 0);
	if (tlsConnect < 0) {
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
     *
     * 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();
    /* BIO_read, where 0 means EOF and -1 means error */
    bytesRead = BIO_read(statePtr->bio, buf, bufSize);
    dprintf("BIO_read -> %d", bytesRead);

    /* Get error is more comprehensive than SSL_want */
    err = SSL_get_error(statePtr->ssl, bytesRead);
    backingError = ERR_get_error();

    if (bytesRead <= 0) {

	if (BIO_should_retry(statePtr->bio)) {
	    dprintf("Read failed with code=%d, bytes read=%d: should retry", err, bytesRead);
	    /* Some docs imply we should redo the BIO_read now */
	} else {
	    dprintf("Read failed with code=%d, bytes read=%d: error condition", err, bytesRead);
	}


	
	/* These are the same as BIO_retry_type */
	if (BIO_should_read(statePtr->bio)) {
	    dprintf("BIO has insufficient data to read and return");

	}
	if (BIO_should_write(statePtr->bio)) {
	    dprintf("BIO has pending data to write");

	}
	if (BIO_should_io_special(statePtr->bio)) {
	    int reason = BIO_get_retry_reason(statePtr->bio);
	    dprintf("BIO has some special condition other than read or write: code=%d", reason);
	}
	dprintf("BIO has pending data to write");
    }







|



|




>






>
>




>



>







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
     *
     * 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();
    BIO_clear_retry_flags(statePtr->bio);
    bytesRead = BIO_read(statePtr->bio, buf, bufSize);
    dprintf("BIO_read -> %d", bytesRead);

    /* Same as SSL_want, but also checks the error queue */
    err = SSL_get_error(statePtr->ssl, bytesRead);
    backingError = ERR_get_error();

    if (bytesRead <= 0) {
	/* The retry flag is set by the BIO_set_retry_* functions */
	if (BIO_should_retry(statePtr->bio)) {
	    dprintf("Read failed with code=%d, bytes read=%d: should retry", err, bytesRead);
	    /* Some docs imply we should redo the BIO_read now */
	} else {
	    dprintf("Read failed with code=%d, bytes read=%d: error condition", err, bytesRead);
	}

	dprintf("BIO is EOF %d", BIO_eof(statePtr->bio));
	
	/* These are the same as BIO_retry_type */
	if (BIO_should_read(statePtr->bio)) {
	    dprintf("BIO has insufficient data to read and return");
	    statePtr->want |= TCL_READABLE;
	}
	if (BIO_should_write(statePtr->bio)) {
	    dprintf("BIO has pending data to write");
	    statePtr->want |= TCL_WRITABLE;
	}
	if (BIO_should_io_special(statePtr->bio)) {
	    int reason = BIO_get_retry_reason(statePtr->bio);
	    dprintf("BIO has some special condition other than read or write: code=%d", reason);
	}
	dprintf("BIO has pending data to write");
    }
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
	    break;

	case SSL_ERROR_WANT_READ:
	    /* Op did not complete due to not enough data was available. Retry later. */
	    dprintf("Got SSL_ERROR_WANT_READ, mapping this to EAGAIN");
	    *errorCodePtr = EAGAIN;
	    bytesRead = -1;
	    statePtr->want = TCL_READABLE;
	    Tls_Error(statePtr, "SSL_ERROR_WANT_READ");

	    break;

	case SSL_ERROR_WANT_WRITE:
	    /* Op did not complete due to unable to sent all data to the BIO. Retry later. */
	    dprintf("Got SSL_ERROR_WANT_WRITE, mapping this to EAGAIN");
	    *errorCodePtr = EAGAIN;
	    bytesRead = -1;
	    statePtr->want = TCL_WRITABLE;
	    Tls_Error(statePtr, "SSL_ERROR_WANT_WRITE");

	    break;

	case SSL_ERROR_WANT_X509_LOOKUP:
	    /* Op didn't complete since callback set by SSL_CTX_set_client_cert_cb() asked to be called again */
	    dprintf("Got SSL_ERROR_WANT_X509_LOOKUP, mapping it to EAGAIN");
	    *errorCodePtr = EAGAIN;
	    bytesRead = -1;







|

>







|

>







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

	case SSL_ERROR_WANT_READ:
	    /* Op did not complete due to not enough data was available. Retry later. */
	    dprintf("Got SSL_ERROR_WANT_READ, mapping this to EAGAIN");
	    *errorCodePtr = EAGAIN;
	    bytesRead = -1;
	    statePtr->want |= TCL_READABLE;
	    Tls_Error(statePtr, "SSL_ERROR_WANT_READ");
	    BIO_set_retry_read(statePtr->bio);
	    break;

	case SSL_ERROR_WANT_WRITE:
	    /* Op did not complete due to unable to sent all data to the BIO. Retry later. */
	    dprintf("Got SSL_ERROR_WANT_WRITE, mapping this to EAGAIN");
	    *errorCodePtr = EAGAIN;
	    bytesRead = -1;
	    statePtr->want |= TCL_WRITABLE;
	    Tls_Error(statePtr, "SSL_ERROR_WANT_WRITE");
	    BIO_set_retry_write(statePtr->bio);
	    break;

	case SSL_ERROR_WANT_X509_LOOKUP:
	    /* Op didn't complete since callback set by SSL_CTX_set_client_cert_cb() asked to be called again */
	    dprintf("Got SSL_ERROR_WANT_X509_LOOKUP, mapping it to EAGAIN");
	    *errorCodePtr = EAGAIN;
	    bytesRead = -1;
489
490
491
492
493
494
495

496
497
498
499
500
501
502
		bytesRead = -1;
		Tls_Error(statePtr, ERR_reason_error_string(backingError));
	    }
	    break;

	case SSL_ERROR_ZERO_RETURN:
	    /* Peer has closed the connection by sending the close_notify alert. Can't read, but can write. */

	    dprintf("Got SSL_ERROR_ZERO_RETURN, this means an EOF has been reached");
	    bytesRead = 0;
	    *errorCodePtr = 0;
	    Tls_Error(statePtr, "Peer has closed the connection for writing by sending the close_notify alert");
	    break;

	case SSL_ERROR_WANT_ASYNC:







>







558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
		bytesRead = -1;
		Tls_Error(statePtr, ERR_reason_error_string(backingError));
	    }
	    break;

	case SSL_ERROR_ZERO_RETURN:
	    /* Peer has closed the connection by sending the close_notify alert. Can't read, but can write. */
	    /* Need to return an EOF, so channel is closed which will send an SSL_shutdown(). */
	    dprintf("Got SSL_ERROR_ZERO_RETURN, this means an EOF has been reached");
	    bytesRead = 0;
	    *errorCodePtr = 0;
	    Tls_Error(statePtr, "Peer has closed the connection for writing by sending the close_notify alert");
	    break;

	case SSL_ERROR_WANT_ASYNC:
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
}

/*
 *-----------------------------------------------------------------------------
 *
 * TlsOutputProc --
 *
 *	This procedure is invoked by the generic IO level to write data to
 *	the BIO. Equivalent to SSL_write. Called by the
 *	generic I/O layer whenever the Tcl_Write(), Tcl_WriteChars,
 *	TTcl_WriteObj functions are used.
 *
 * Results:
 *    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.







|
<
|
|







590
591
592
593
594
595
596
597

598
599
600
601
602
603
604
605
606
}

/*
 *-----------------------------------------------------------------------------
 *
 * TlsOutputProc --
 *
 *	This procedure is invoked by the generic I/O layer to write data to the

 *	BIO whenever the the Tcl_Write(), Tcl_WriteChars, and Tcl_WriteObj 
 *	functions are used. Equivalent to SSL_write_ex and SSL_write.
 *
 * Results:
 *    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.
552
553
554
555
556
557
558

559
560
561
562
563
564
565
	dprintf("Don't process output while callbacks are running");
	written = -1;
	*errorCodePtr = EAGAIN;
	return -1;
    }

    /* If not initialized, do connect */

    if (statePtr->flags & TLS_TCL_INIT) {
	int tlsConnect;

	dprintf("Calling Tls_WaitForConnect");

	tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 1);
	if (tlsConnect < 0) {







>







621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
	dprintf("Don't process output while callbacks are running");
	written = -1;
	*errorCodePtr = EAGAIN;
	return -1;
    }

    /* If not initialized, do connect */
    /* Can also check SSL_is_init_finished(ssl) */
    if (statePtr->flags & TLS_TCL_INIT) {
	int tlsConnect;

	dprintf("Calling Tls_WaitForConnect");

	tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 1);
	if (tlsConnect < 0) {
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
     *
     * 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();
    /* SSL_write will return 1 for success or 0 for failure */
    written = BIO_write(statePtr->bio, buf, toWrite);
    dprintf("BIO_write(%p, %d) -> [%d]", (void *) statePtr, toWrite, written);

    /* Get error is more comprehensive than SSL_want */
    err = SSL_get_error(statePtr->ssl, written);
    backingError = ERR_get_error();

    if (written <= 0) {

	if (BIO_should_retry(statePtr->bio)) {
	    dprintf("Write failed with code %d, bytes written=%d: should retry", err, written);
	} else {
	    dprintf("Write failed with code %d, bytes written=%d: error condition", err, written);
	}
	
	/* These are the same as BIO_retry_type */
	if (BIO_should_read(statePtr->bio)) {
	    dprintf("BIO has insufficient data to read and return");
	}
	if (BIO_should_write(statePtr->bio)) {
	    dprintf("BIO has pending data to write");
	}







|



|




>





|







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
     *
     * 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();
    BIO_clear_retry_flags(statePtr->bio);
    written = BIO_write(statePtr->bio, buf, toWrite);
    dprintf("BIO_write(%p, %d) -> [%d]", (void *) statePtr, toWrite, written);

    /* Same as SSL_want, but also checks the error queue */
    err = SSL_get_error(statePtr->ssl, written);
    backingError = ERR_get_error();

    if (written <= 0) {
	/* The retry flag is set by the BIO_set_retry_* functions */
	if (BIO_should_retry(statePtr->bio)) {
	    dprintf("Write failed with code %d, bytes written=%d: should retry", err, written);
	} else {
	    dprintf("Write failed with code %d, bytes written=%d: error condition", err, written);
	}

	/* These are the same as BIO_retry_type */
	if (BIO_should_read(statePtr->bio)) {
	    dprintf("BIO has insufficient data to read and return");
	}
	if (BIO_should_write(statePtr->bio)) {
	    dprintf("BIO has pending data to write");
	}
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
	    break;

	case SSL_ERROR_WANT_READ:
	    /* Op did not complete due to not enough data was available. Retry later. */
	    dprintf("Got SSL_ERROR_WANT_READ, mapping it to EAGAIN");
	    *errorCodePtr = EAGAIN;
	    written = -1;
	    statePtr->want = TCL_READABLE;
	    Tls_Error(statePtr, "SSL_ERROR_WANT_READ");

	    break;

	case SSL_ERROR_WANT_WRITE:
	    /* Op did not complete due to unable to sent all data to the BIO. Retry later. */
	    dprintf("Got SSL_ERROR_WANT_WRITE, mapping it to EAGAIN");
	    *errorCodePtr = EAGAIN;
	    written = -1;
	    statePtr->want = TCL_WRITABLE;
	    Tls_Error(statePtr, "SSL_ERROR_WANT_WRITE");

	    break;

	case SSL_ERROR_WANT_X509_LOOKUP:
	    /* Op didn't complete since callback set by SSL_CTX_set_client_cert_cb() asked to be called again */
	    dprintf("Got SSL_ERROR_WANT_X509_LOOKUP, mapping it to EAGAIN");
	    *errorCodePtr = EAGAIN;
	    written = -1;







|

>







|

>







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

	case SSL_ERROR_WANT_READ:
	    /* Op did not complete due to not enough data was available. Retry later. */
	    dprintf("Got SSL_ERROR_WANT_READ, mapping it to EAGAIN");
	    *errorCodePtr = EAGAIN;
	    written = -1;
	    statePtr->want |= TCL_READABLE;
	    Tls_Error(statePtr, "SSL_ERROR_WANT_READ");
	    BIO_set_retry_read(statePtr->bio);
	    break;

	case SSL_ERROR_WANT_WRITE:
	    /* Op did not complete due to unable to sent all data to the BIO. Retry later. */
	    dprintf("Got SSL_ERROR_WANT_WRITE, mapping it to EAGAIN");
	    *errorCodePtr = EAGAIN;
	    written = -1;
	    statePtr->want |= TCL_WRITABLE;
	    Tls_Error(statePtr, "SSL_ERROR_WANT_WRITE");
	    BIO_set_retry_write(statePtr->bio);
	    break;

	case SSL_ERROR_WANT_X509_LOOKUP:
	    /* Op didn't complete since callback set by SSL_CTX_set_client_cert_cb() asked to be called again */
	    dprintf("Got SSL_ERROR_WANT_X509_LOOKUP, mapping it to EAGAIN");
	    *errorCodePtr = EAGAIN;
	    written = -1;
710
711
712
713
714
715
716

717
718
719
720
721
722
723
		written = -1;
		Tls_Error(statePtr, ERR_reason_error_string(backingError));
	    }
	    break;

	case SSL_ERROR_ZERO_RETURN:
	    /* Peer has closed the connection by sending the close_notify alert. Can't read, but can write. */

	    dprintf("Got SSL_ERROR_ZERO_RETURN, this means an EOF has been reached");
	    written = 0;
	    *errorCodePtr = 0;
	    Tls_Error(statePtr, "Peer has closed the connection for writing by sending the close_notify alert");
	    break;

	case SSL_ERROR_WANT_ASYNC:







>







783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
		written = -1;
		Tls_Error(statePtr, ERR_reason_error_string(backingError));
	    }
	    break;

	case SSL_ERROR_ZERO_RETURN:
	    /* Peer has closed the connection by sending the close_notify alert. Can't read, but can write. */
	    /* Need to return an EOF, so channel is closed which will send an SSL_shutdown(). */
	    dprintf("Got SSL_ERROR_ZERO_RETURN, this means an EOF has been reached");
	    written = 0;
	    *errorCodePtr = 0;
	    Tls_Error(statePtr, "Peer has closed the connection for writing by sending the close_notify alert");
	    break;

	case SSL_ERROR_WANT_ASYNC:
785
786
787
788
789
790
791

792
793
794
795
796
797
798
{
    State *statePtr = (State *) instanceData;
    Tcl_Channel parent = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);
    Tcl_DriverSetOptionProc *setOptionProc;

    dprintf("Called");


    setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(parent));
    if (setOptionProc != NULL) {
	return (*setOptionProc)(Tcl_GetChannelInstanceData(parent), interp, optionName, optionValue);
    }
    /*
     * Request for a specific option has to fail, we don't have any.
     */







>







859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
{
    State *statePtr = (State *) instanceData;
    Tcl_Channel parent = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);
    Tcl_DriverSetOptionProc *setOptionProc;

    dprintf("Called");

    /* Pass to parent */
    setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(parent));
    if (setOptionProc != NULL) {
	return (*setOptionProc)(Tcl_GetChannelInstanceData(parent), interp, optionName, optionValue);
    }
    /*
     * Request for a specific option has to fail, we don't have any.
     */
827
828
829
830
831
832
833

834
835
836
837
838
839
840
{
    State *statePtr = (State *) instanceData;
    Tcl_Channel parent = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);
    Tcl_DriverGetOptionProc *getOptionProc;

    dprintf("Called");


    getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(parent));
    if (getOptionProc != NULL) {
	return (*getOptionProc)(Tcl_GetChannelInstanceData(parent), interp, optionName, optionValue);
    } else if (optionName == (char*) NULL) {
	/*
	 * Request is query for all options, this is ok.
	 */







>







902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
{
    State *statePtr = (State *) instanceData;
    Tcl_Channel parent = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);
    Tcl_DriverGetOptionProc *getOptionProc;

    dprintf("Called");

    /* Pass to parent */
    getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(parent));
    if (getOptionProc != NULL) {
	return (*getOptionProc)(Tcl_GetChannelInstanceData(parent), interp, optionName, optionValue);
    } else if (optionName == (char*) NULL) {
	/*
	 * Request is query for all options, this is ok.
	 */
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
    /* Check for amount of data pending in BIO read buffer */
    if (BIO_pending(statePtr->bio)) {
	dprintf("[chan=%p] BIO readable", statePtr->self);

	mask |= TCL_READABLE;
    }

    /* Notify event subsystem that the channel is readable or writeable */
    dprintf("Notifying ourselves");
    Tcl_NotifyChannel(statePtr->self, mask);
    statePtr->want = 0;

    dprintf("Returning");

    return;







|







957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
    /* Check for amount of data pending in BIO read buffer */
    if (BIO_pending(statePtr->bio)) {
	dprintf("[chan=%p] BIO readable", statePtr->self);

	mask |= TCL_READABLE;
    }

    /* Notify the generic IO layer that the mask events have occurred on the channel */
    dprintf("Notifying ourselves");
    Tcl_NotifyChannel(statePtr->self, mask);
    statePtr->want = 0;

    dprintf("Returning");

    return;
918
919
920
921
922
923
924

925
926
927
928
929
930
931
TlsWatchProc(ClientData instanceData,    /* The socket state. */
    int mask)			/* Events of interest; an OR-ed combination of
				 * TCL_READABLE, TCL_WRITABLE and TCL_EXCEPTION. */
{
    Tcl_Channel     parent;
    State *statePtr = (State *) instanceData;
    Tcl_DriverWatchProc *watchProc;


    dprintf("TlsWatchProc(0x%x)", mask);
    dprintFlags(statePtr);

    /* 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) {







>







994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
TlsWatchProc(ClientData instanceData,    /* The socket state. */
    int mask)			/* Events of interest; an OR-ed combination of
				 * TCL_READABLE, TCL_WRITABLE and TCL_EXCEPTION. */
{
    Tcl_Channel     parent;
    State *statePtr = (State *) instanceData;
    Tcl_DriverWatchProc *watchProc;
    int pending = 0;

    dprintf("TlsWatchProc(0x%x)", mask);
    dprintFlags(statePtr);

    /* 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) {
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
     * 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 *) parent);
    watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(parent));
    watchProc(Tcl_GetChannelInstanceData(parent), mask);






    /*

     * 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->want || ((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, (ClientData) statePtr);

    }
}

/*
 *-----------------------------------------------------------------------------
 *
 * TlsGetHandleProc --







>
>
>
>

<
>
|
<
|
|
|
|
|

>
>
|
<
<
<
<
<
|
|
>







1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042

1043
1044

1045
1046
1047
1048
1049
1050
1051
1052
1053





1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
     * 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 *) parent);
    watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(parent));
    watchProc(Tcl_GetChannelInstanceData(parent), mask);

    /* Do we have any pending events */
    pending = (statePtr->want || \
	((mask & TCL_READABLE) && ((Tcl_InputBuffered(statePtr->self) > 0) || (BIO_ctrl_pending(statePtr->bio) > 0))) ||
	((mask & TCL_WRITABLE) && ((Tcl_OutputBuffered(statePtr->self) > 0) || (BIO_ctrl_wpending(statePtr->bio) > 0))));


    if (!(mask & TCL_READABLE) || pending == 0) {
	/* Remove timer, if any */

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

    } else {
	/* Add timer, if none */
	if (statePtr->timer == (Tcl_TimerToken) NULL) {





	    dprintf("Creating a new timer since data appears to be waiting");
	    statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, (ClientData) statePtr);
	}
    }
}

/*
 *-----------------------------------------------------------------------------
 *
 * TlsGetHandleProc --
13
14
15
16
17
18
19

20
21

22
23
24
25
26
27
28
 *	SSLtcl (Peter Antman)
 *----------------------------------------------------------------------
 */
#ifndef _TLSINT_H
#define _TLSINT_H

/* Platform unique definitions */

#ifdef _WIN32
#define WIN32_LEAN_AND_MEAN

#include <windows.h>
#include <wincrypt.h> /* OpenSSL needs this on Windows */
#endif

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







>
|

>







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
 *	SSLtcl (Peter Antman)
 *----------------------------------------------------------------------
 */
#ifndef _TLSINT_H
#define _TLSINT_H

/* Platform unique definitions */
#if ((defined(_WIN32)) || (defined(__MINGW32__)) || (defined(__MINGW64__)))
#ifndef WIN32_LEAN_AND_MEAN
#define WIN32_LEAN_AND_MEAN
#endif
#include <windows.h>
#include <wincrypt.h> /* OpenSSL needs this on Windows */
#endif

#include "tls.h"
#include <errno.h>
#include <string.h>
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
    Tcl_ListObjAppendElement(interp, obj, Tcl_NewBooleanObj(value)); \
}
#define LAPPEND_OBJ(interp, obj, text, tclObj) {\
    if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
    Tcl_ListObjAppendElement(interp, obj, (tclObj != NULL) ? tclObj : Tcl_NewStringObj("", 0)); \
}

/*
 * 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_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 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 */
#define TLS_TCL_DELAY (5)

/*
 * This structure describes the per-instance state of an SSL channel.
 *
 * The SSL processing context is maintained here, in the ClientData







<
<
<
<
<










|







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
    Tcl_ListObjAppendElement(interp, obj, Tcl_NewBooleanObj(value)); \
}
#define LAPPEND_OBJ(interp, obj, text, tclObj) {\
    if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
    Tcl_ListObjAppendElement(interp, obj, (tclObj != NULL) ? tclObj : Tcl_NewStringObj("", 0)); \
}






/*
 * 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_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 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 */
#define TLS_TCL_DELAY (5)

/*
 * This structure describes the per-instance state of an SSL channel.
 *
 * The SSL processing context is maintained here, in the ClientData