Check-in [08e1cd7d4f]
Overview
Comment:Fixed issue where some non-error conditions triggered a call to Tls_Error
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk | main
Files: files | file ages | folders
SHA3-256: 08e1cd7d4f01f50ebe341e797575f98c370e460446f46a411b7542ca8bf47f57
User & Date: bohagan on 2024-12-09 00:17:44
Other Links: branch diff | manifest | tags
Context
2024-12-09
04:29
Optimized make documentation on Windows check-in: 7e7d5ef01b user: bohagan tags: trunk, main
00:17
Fixed issue where some non-error conditions triggered a call to Tls_Error check-in: 08e1cd7d4f user: bohagan tags: trunk, main
2024-12-08
22:20
Fixed PasswordCallback when using default tls::password callback to pass all parameters check-in: af42842c6e user: bohagan tags: trunk, main
Changes
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
 *-------------------------------------------------------------------
 *
 * Tls_Error --
 *
 *	Calls callback with error message.
 *
 * Side effects:
 *	The err field of the currently operative State is set
 *	  to a string describing the SSL negotiation failure reason
 *
 *-------------------------------------------------------------------
 */
void
Tls_Error(
    State *statePtr,		/* Client state for TLS socket */
    const char *msg)		/* Error message */







|
|







423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
 *-------------------------------------------------------------------
 *
 * Tls_Error --
 *
 *	Calls callback with error message.
 *
 * Side effects:
 *	The err field of the currently operative State is set to a
 *	string describing the SSL negotiation failure reason
 *
 *-------------------------------------------------------------------
 */
void
Tls_Error(
    State *statePtr,		/* Client state for TLS socket */
    const char *msg)		/* Error message */
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
    chan = Tcl_GetTopChannel(chan);
    parent = Tcl_GetStackedChannel(chan);

    /* Verify is a stacked channel */
    if (parent == NULL) {
	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;







|







1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
    chan = Tcl_GetTopChannel(chan);
    parent = Tcl_GetStackedChannel(chan);

    /* Verify is a stacked channel */
    if (parent == NULL) {
	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;
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
	    goto cleanup;
	}
    }

    /* Where the CA names go */
    certNames = sk_X509_NAME_new_null();
    if (!certNames) {
        goto cleanup;
    }

    /* Attempt to load all certs from the PEM file */
    while ((cert = PEM_read_bio_X509(bio, NULL, 0, NULL)) != NULL) {
        if (X509_STORE_add_cert(store, cert) == 0) {
            X509_free(cert);
            ret = 0;
            goto cleanup;
        }
        /* Copy name to stack before certificate gets freed */
	name = X509_get_subject_name(cert);
        if (name) {
            X509_NAME *name_copy = X509_NAME_dup(name);
            if (!name_copy || !sk_X509_NAME_push(certNames, name_copy)) {
                X509_free(cert);
		ret = 0;
                goto cleanup;
            }
        }
        X509_free(cert);
        ret ++;
    }

    /* At least one cert was added so retain the store and CA list */
    if (ret) {
	if (SSL_CTX_get_cert_store(ctx) == NULL) {
	    SSL_CTX_set_cert_store(ctx, store);
	}







|




|
|
|
|
|
|

|
|
|
|

|
|
|
|
|







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
	    goto cleanup;
	}
    }

    /* Where the CA names go */
    certNames = sk_X509_NAME_new_null();
    if (!certNames) {
	goto cleanup;
    }

    /* Attempt to load all certs from the PEM file */
    while ((cert = PEM_read_bio_X509(bio, NULL, 0, NULL)) != NULL) {
	if (X509_STORE_add_cert(store, cert) == 0) {
	    X509_free(cert);
	    ret = 0;
	    goto cleanup;
	}
	/* Copy name to stack before certificate gets freed */
	name = X509_get_subject_name(cert);
	if (name) {
	    X509_NAME *name_copy = X509_NAME_dup(name);
	    if (!name_copy || !sk_X509_NAME_push(certNames, name_copy)) {
		X509_free(cert);
		ret = 0;
		goto cleanup;
	    }
	}
	X509_free(cert);
	ret ++;
    }

    /* At least one cert was added so retain the store and CA list */
    if (ret) {
	if (SSL_CTX_get_cert_store(ctx) == NULL) {
	    SSL_CTX_set_cert_store(ctx, store);
	}
2173
2174
2175
2176
2177
2178
2179
2180

2181
2182
2183
2184
2185
2186
2187
	    }
	    SSL_CTX_set_tmp_dh(ctx, dh);
	    DH_free(dh);

	} else {
	    /* Use well known DH parameters that have built-in support in OpenSSL */
	    if (!SSL_CTX_set_dh_auto(ctx, 1)) {
		Tcl_AppendResult(interp, "Could not enable set DH auto: ", GET_ERR_REASON(), (char *)NULL);

		SSL_CTX_free(ctx);
		return NULL;
	    }
	}
    }
#endif








|
>







2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
	    }
	    SSL_CTX_set_tmp_dh(ctx, dh);
	    DH_free(dh);

	} else {
	    /* Use well known DH parameters that have built-in support in OpenSSL */
	    if (!SSL_CTX_set_dh_auto(ctx, 1)) {
		Tcl_AppendResult(interp, "Could not enable set DH auto: ", GET_ERR_REASON(),
			(char *)NULL);
		SSL_CTX_free(ctx);
		return NULL;
	    }
	}
    }
#endif

2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
		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);
	    SSL_CTX_free(ctx);
	    return NULL;
	}
    }

    /* Set to use the default location and file for Certificate Authority (CA) certificates.
     * The default CA certificates directory is called certs in the default OpenSSL







|







2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
		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);
	    SSL_CTX_free(ctx);
	    return NULL;
	}
    }

    /* Set to use the default location and file for Certificate Authority (CA) certificates.
     * The default CA certificates directory is called certs in the default OpenSSL
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
	return TCL_ERROR;
    }

    /* 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_SetErrorCode(interp, "TLS", "CONNECTION", "CHANNEL", "INVALID", (char *)NULL);
	return TCL_ERROR;
    }

    objPtr = Tcl_NewListObj(0, NULL);

    /* Connection info */







|







2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
	return TCL_ERROR;
    }

    /* 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_SetErrorCode(interp, "TLS", "CONNECTION", "CHANNEL", "INVALID", (char *)NULL);
	return TCL_ERROR;
    }

    objPtr = Tcl_NewListObj(0, NULL);

    /* Connection info */
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237

    BIO_cleanup();
}

/*
 *------------------------------------------------------*
 *
 *	TlsLibInit --
 *
 *	Initializes SSL library once per application
 *
 * Results:
 *	A standard Tcl result
 *
 * Side effects:







|







3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238

    BIO_cleanup();
}

/*
 *------------------------------------------------------*
 *
 * TlsLibInit --
 *
 *	Initializes SSL library once per application
 *
 * Results:
 *	A standard Tcl result
 *
 * Side effects:
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344

    return Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION);
}

/*
 *-------------------------------------------------------------------
 *
 *	Tls_SafeInit --
 *
 *	This is a package initialization procedure for safe interps.
 *
 * Results:
 *	Same as of 'Tls_Init'
 *
 * Side effects:







|







3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345

    return Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION);
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_SafeInit --
 *
 *	This is a package initialization procedure for safe interps.
 *
 * Results:
 *	Same as of 'Tls_Init'
 *
 * Side effects:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
/*
 * Provides IO functions to interface between the BIO buffers and TCL
 * applications when using stacked channels.
 *
 * Copyright (C) 1997-2000 Matt Newman <[email protected]>
 * Copyright (C) 2000 Ajuba Solutions
 * Copyright (C) 2024 Brian O'Hagan
 *
 * Additional credit is due for Andreas Kupries ([email protected]), 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)
 *
 */

/*
		tlsBIO.c				tlsIO.c
  +------+                         +-----+                                     +------+
  |      |Tcl_WriteRaw <-- BioWrite| SSL |BIO_write <-- TlsOutputProc <-- Write|      |













|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
/*
 * Provides IO functions to interface between the BIO buffers and TCL
 * applications when using stacked channels.
 *
 * Copyright (C) 1997-2000 Matt Newman <[email protected]>
 * Copyright (C) 2000 Ajuba Solutions
 * Copyright (C) 2024 Brian O'Hagan
 *
 * Additional credit is due for Andreas Kupries ([email protected]), 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)
 *
 */

/*
		tlsBIO.c				tlsIO.c
  +------+                         +-----+                                     +------+
  |      |Tcl_WriteRaw <-- BioWrite| SSL |BIO_write <-- TlsOutputProc <-- Write|      |
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
 * TlsBlockModeProc --
 *
 *	This procedure is invoked by the generic IO level to set channel to
 *	blocking or nonblocking mode. Called by the generic I/O layer whenever
 *	the Tcl_SetChannelOption() function is used with option -blocking.
 *
 * Results:
 *    0 if successful or POSIX error code if failed.
 *
 * Side effects:
 *    Sets the device into blocking or nonblocking mode.
 *
 *-----------------------------------------------------------------------------
 */
static int TlsBlockModeProc(ClientData instanceData, int mode) {
    State *statePtr = (State *) instanceData;

    if (mode == TCL_MODE_NONBLOCKING) {







|


|







34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
 * TlsBlockModeProc --
 *
 *	This procedure is invoked by the generic IO level to set channel to
 *	blocking or nonblocking mode. Called by the generic I/O layer whenever
 *	the Tcl_SetChannelOption() function is used with option -blocking.
 *
 * Results:
 *	0 if successful or POSIX error code if failed.
 *
 * Side effects:
 *	Sets the device into blocking or nonblocking mode.
 *
 *-----------------------------------------------------------------------------
 */
static int TlsBlockModeProc(ClientData instanceData, int mode) {
    State *statePtr = (State *) instanceData;

    if (mode == TCL_MODE_NONBLOCKING) {
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
 *
 *	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);







|


|







63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
 *
 *	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);
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
 *
 * Tls_WaitForConnect --
 *
 *	Perform connect (client) or accept (server) function. Also performs
 *	equivalent of handshake function.
 *
 * Result:
 *    0 if successful, -1 if failed.
 *
 * Side effects:
 *    Issues SSL_accept or SSL_connect
 *
 *-----------------------------------------------------------------------------
 */
int Tls_WaitForConnect(State *statePtr, int *errorCodePtr, int handshakeFailureIsPermanent) {
    unsigned long backingError;
    int err, rc = 0;
    int bioShouldRetry;
    *errorCodePtr = 0;

    dprintf("WaitForConnect(%p)", (void *) statePtr);
    dprintFlags(statePtr);

    /* Can also check SSL_is_init_finished(ssl) */
    if (!(statePtr->flags & TLS_TCL_INIT)) {
	dprintf("Tls_WaitForConnect called on already initialized channel -- returning with immediate success");
	return 0;
    }

    if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) {
	/*
	 * Different types of operations have different requirements
	 * SSL being established
	 */







|


|















|







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
 *
 * Tls_WaitForConnect --
 *
 *	Perform connect (client) or accept (server) function. Also performs
 *	equivalent of handshake function.
 *
 * Result:
 *    1 if successful, 0 if wait for connect, and -1 if failed.
 *
 * Side effects:
 *	Issues SSL_accept or SSL_connect
 *
 *-----------------------------------------------------------------------------
 */
int Tls_WaitForConnect(State *statePtr, int *errorCodePtr, int handshakeFailureIsPermanent) {
    unsigned long backingError;
    int err, rc = 0;
    int bioShouldRetry;
    *errorCodePtr = 0;

    dprintf("WaitForConnect(%p)", (void *) statePtr);
    dprintFlags(statePtr);

    /* Can also check SSL_is_init_finished(ssl) */
    if (!(statePtr->flags & TLS_TCL_INIT)) {
	dprintf("Tls_WaitForConnect called on already initialized channel -- returning with immediate success");
	return 1;
    }

    if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) {
	/*
	 * Different types of operations have different requirements
	 * SSL being established
	 */
196
197
198
199
200
201
202

203
204
205
206
207
208
209
	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;







>







196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
	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);
	dprintf("bioShouldRetry = %d", bioShouldRetry);

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

	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");
		*errorCodePtr = EAGAIN;
		Tls_Error(statePtr, "Handshake not complete, will retry later");
		return -1;
	    } else {
		dprintf("Doing so now");
		continue;
	    }
	}

	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");
	    if (SSL_get_verify_result(statePtr->ssl) != X509_V_OK) {
		Tls_Error(statePtr, X509_verify_cert_error_string(SSL_get_verify_result(statePtr->ssl)));
	    }
	    if (backingError != 0) {
		Tls_Error(statePtr, ERR_reason_error_string(backingError));
	    }







<
|



















>







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

	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");
		*errorCodePtr = EAGAIN;

		return 0;
	    } else {
		dprintf("Doing so now");
		continue;
	    }
	}

	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 */
	    /* This includes certificate validation errors */
	    dprintf("SSL_ERROR_SSL: Got permanent fatal SSL error, aborting immediately");
	    if (SSL_get_verify_result(statePtr->ssl) != X509_V_OK) {
		Tls_Error(statePtr, X509_verify_cert_error_string(SSL_get_verify_result(statePtr->ssl)));
	    }
	    if (backingError != 0) {
		Tls_Error(statePtr, ERR_reason_error_string(backingError));
	    }
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
	    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");
	    return -1;
    }

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

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

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







|

|






|

|







|
|







|
|








|
|













|

|
<
|





|

|
















|







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
	    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(SSL_ERROR_ZERO_RETURN, EAGAIN) ");
	    statePtr->want |= TCL_READABLE;
	    return 0;

	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(SSL_ERROR_WANT_WRITE, EAGAIN) ");
	    statePtr->want |= TCL_WRITABLE;
	    return 0;

	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(SSL_ERROR_WANT_CONNECT, EAGAIN) ");
	    return 0;

	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(SSL_ERROR_WANT_ACCEPT, EAGAIN) ");
	    return 0;

	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(SSL_ERROR_WANT_X509_LOOKUP, EAGAIN) ");
	    return 0;

	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");
	    *errorCodePtr = EAGAIN;
	    dprintf("ERR(Other, EAGAIN) ");

	    return 0;
    }

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

    dprintf("Returning success");
    *errorCodePtr = 0;
    return 1;
}

/*
 *-----------------------------------------------------------------------------
 *
 * 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.
 *
 *-----------------------------------------------------------------------------
 */
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
	int tlsConnect;

	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);
	    Tls_Error(statePtr, strerror(*errorCodePtr));

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







<







407
408
409
410
411
412
413

414
415
416
417
418
419
420
	int tlsConnect;

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

	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 send 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;
	    Tls_Error(statePtr, "SSL_ERROR_WANT_X509_LOOKUP");
	    break;

	case SSL_ERROR_SYSCALL:
	    /* Some non-recoverable, fatal I/O error occurred */
	    dprintf("SSL_ERROR_SYSCALL");

	    if (backingError == 0 && bytesRead == 0) {







<









<








<







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

	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;

	    BIO_set_retry_read(statePtr->bio);
	    break;

	case SSL_ERROR_WANT_WRITE:
	    /* Op did not complete due to unable to send 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;

	    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;

	    break;

	case SSL_ERROR_SYSCALL:
	    /* Some non-recoverable, fatal I/O error occurred */
	    dprintf("SSL_ERROR_SYSCALL");

	    if (backingError == 0 && bytesRead == 0) {
563
564
565
566
567
568
569
570
571
572

573
574
575
576
577
578
579
	    *errorCodePtr = 0;
	    Tls_Error(statePtr, "Peer has closed the connection for writing by sending the close_notify alert");
	    break;

	case SSL_ERROR_WANT_ASYNC:
	    /* Used with flag SSL_MODE_ASYNC, op didn't complete because an async engine is still processing data */
	    dprintf("Got SSL_ERROR_WANT_ASYNC, mapping this to EAGAIN");
	    bytesRead = -1;
	    *errorCodePtr = EAGAIN;
	    Tls_Error(statePtr, "SSL_ERROR_WANT_ASYNC");

	    break;

	default:
	    dprintf("Unknown error (err = %i), mapping to EOF", err);
	    *errorCodePtr = 0;
	    bytesRead = 0;
	    Tls_Error(statePtr, "Unknown error");







<

<
>







559
560
561
562
563
564
565

566

567
568
569
570
571
572
573
574
	    *errorCodePtr = 0;
	    Tls_Error(statePtr, "Peer has closed the connection for writing by sending the close_notify alert");
	    break;

	case SSL_ERROR_WANT_ASYNC:
	    /* Used with flag SSL_MODE_ASYNC, op didn't complete because an async engine is still processing data */
	    dprintf("Got SSL_ERROR_WANT_ASYNC, mapping this to EAGAIN");

	    *errorCodePtr = EAGAIN;

	    bytesRead = -1;
	    break;

	default:
	    dprintf("Unknown error (err = %i), mapping to EOF", err);
	    *errorCodePtr = 0;
	    bytesRead = 0;
	    Tls_Error(statePtr, "Unknown error");
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
 * 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.
 *
 *-----------------------------------------------------------------------------
 */
static int TlsOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr) {
    unsigned long backingError;
    State *statePtr = (State *) instanceData;
    int written, err;







|
|


|







585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
 * 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.
 *
 *-----------------------------------------------------------------------------
 */
static int TlsOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr) {
    unsigned long backingError;
    State *statePtr = (State *) instanceData;
    int written, err;
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
	int tlsConnect;

	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);
	    Tls_Error(statePtr, strerror(*errorCodePtr));

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







<







620
621
622
623
624
625
626

627
628
629
630
631
632
633
	int tlsConnect;

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

	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 send 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;
	    Tls_Error(statePtr, "SSL_ERROR_WANT_X509_LOOKUP");
	    break;

	case SSL_ERROR_SYSCALL:
	    /* Some non-recoverable, fatal I/O error occurred */
	    dprintf("SSL_ERROR_SYSCALL");

	    if (backingError == 0 && written == 0) {







<









<








<







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

	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;

	    BIO_set_retry_read(statePtr->bio);
	    break;

	case SSL_ERROR_WANT_WRITE:
	    /* Op did not complete due to unable to send 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;

	    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;

	    break;

	case SSL_ERROR_SYSCALL:
	    /* Some non-recoverable, fatal I/O error occurred */
	    dprintf("SSL_ERROR_SYSCALL");

	    if (backingError == 0 && written == 0) {
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
813
814
815
816
817
818
819
820
821
822
823
824
825
	    }
	    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:
	    /* Used with flag SSL_MODE_ASYNC, op didn't complete because an async engine is still processing data */
	    dprintf("Got SSL_ERROR_WANT_ASYNC, mapping this to EAGAIN");
	    *errorCodePtr = EAGAIN;
	    written = -1;
	    Tls_Error(statePtr, "SSL_ERROR_WANT_ASYNC");
	    break;

	default:
	    dprintf("unknown error: %d", err);
	    Tls_Error(statePtr, "Unknown error");
	    break;
    }

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

/*
 *-----------------------------------------------------------------------------
 *
 * Tls_GetParent --
 *
 *    Get parent channel for a stacked channel.
 *
 * Results:
 *    Tcl_Channel or NULL if none.
 *
 *-----------------------------------------------------------------------------
 */
Tcl_Channel Tls_GetParent(State *statePtr, int maskFlags) {
    dprintf("Requested to get parent of channel %p", statePtr->self);

    if ((statePtr->flags & ~maskFlags) & TLS_TCL_FASTPATH) {







<

>








<

















|


|







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
813
814
815
	    }
	    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");

	    *errorCodePtr = 0;
	    written = 0;
	    Tls_Error(statePtr, "Peer has closed the connection for writing by sending the close_notify alert");
	    break;

	case SSL_ERROR_WANT_ASYNC:
	    /* Used with flag SSL_MODE_ASYNC, op didn't complete because an async engine is still processing data */
	    dprintf("Got SSL_ERROR_WANT_ASYNC, mapping this to EAGAIN");
	    *errorCodePtr = EAGAIN;
	    written = -1;

	    break;

	default:
	    dprintf("unknown error: %d", err);
	    Tls_Error(statePtr, "Unknown error");
	    break;
    }

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

/*
 *-----------------------------------------------------------------------------
 *
 * Tls_GetParent --
 *
 *	Get parent channel for a stacked channel.
 *
 * Results:
 *	Tcl_Channel or NULL if none.
 *
 *-----------------------------------------------------------------------------
 */
Tcl_Channel Tls_GetParent(State *statePtr, int maskFlags) {
    dprintf("Requested to get parent of channel %p", statePtr->self);

    if ((statePtr->flags & ~maskFlags) & TLS_TCL_FASTPATH) {
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
 *
 * TlsSetOptionProc --
 *
 *	Sets an option to value for a SSL socket based channel. Called by the
 *	generic I/O layer whenever the Tcl_SetChannelOption() function is used.
 *
 * Results:
 *    TCL_OK if successful or TCL_ERROR if failed.
 *
 * Side effects:
 *    Updates channel option to new value.
 *
 *-----------------------------------------------------------------------------
 */
static int
TlsSetOptionProc(ClientData instanceData,    /* Socket state. */
    Tcl_Interp *interp,		/* For errors - can be NULL. */
    const char *optionName,	/* Name of the option to set the value for, or







|


|







824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
 *
 * TlsSetOptionProc --
 *
 *	Sets an option to value for a SSL socket based channel. Called by the
 *	generic I/O layer whenever the Tcl_SetChannelOption() function is used.
 *
 * Results:
 *	TCL_OK if successful or TCL_ERROR if failed.
 *
 * Side effects:
 *	Updates channel option to new value.
 *
 *-----------------------------------------------------------------------------
 */
static int
TlsSetOptionProc(ClientData instanceData,    /* Socket state. */
    Tcl_Interp *interp,		/* For errors - can be NULL. */
    const char *optionName,	/* Name of the option to set the value for, or
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
 *
 *
 * 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.
 *
 * Side effects:
 *    None.
 *
 *-------------------------------------------------------------------
 */
static int
TlsGetOptionProc(ClientData instanceData,    /* Socket state. */
    Tcl_Interp *interp,		/* For errors - can be NULL. */
    const char *optionName,	/* Name of the option to retrieve the value for, or







|







870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
 *
 *
 * 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.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
TlsGetOptionProc(ClientData instanceData,    /* Socket state. */
    Tcl_Interp *interp,		/* For errors - can be NULL. */
    const char *optionName,	/* Name of the option to retrieve the value for, or
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
     */
    return Tcl_BadChannelOption(interp, optionName, "");
}

/*
 *-----------------------------------------------------------------------------
 *
 *    TlsChannelHandlerTimer --
 *
 *	Called by the notifier via a timer, to flush out data waiting in
 *	channel buffers. called by the generic I/O layer whenever the
 *	Tcl_GetChannelHandle() function is used.
 *
 * Results:
 *        None.
 *
 * Side effects:
 *	Creates notification event.
 *
 *-----------------------------------------------------------------------------
 */
static void TlsChannelHandlerTimer(ClientData clientData) {







|






|







906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
     */
    return Tcl_BadChannelOption(interp, optionName, "");
}

/*
 *-----------------------------------------------------------------------------
 *
 * TlsChannelHandlerTimer --
 *
 *	Called by the notifier via a timer, to flush out data waiting in
 *	channel buffers. called by the generic I/O layer whenever the
 *	Tcl_GetChannelHandle() function is used.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Creates notification event.
 *
 *-----------------------------------------------------------------------------
 */
static void TlsChannelHandlerTimer(ClientData clientData) {
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
 *
 *	Set up the event notifier to watch for events of interest from this
 *	channel. Called by the generic I/O layer whenever the user (or the
 *	system) announces its (dis)interest in events on the channel. This is
 *	called repeatedly.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *	Sets up the time-based notifier so that future events on the channel
 *	will be seen by TCL.
 *
 *-----------------------------------------------------------------------------
 */







|







963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
 *
 *	Set up the event notifier to watch for events of interest from this
 *	channel. Called by the generic I/O layer whenever the user (or the
 *	system) announces its (dis)interest in events on the channel. This is
 *	called repeatedly.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets up the time-based notifier so that future events on the channel
 *	will be seen by TCL.
 *
 *-----------------------------------------------------------------------------
 */
1031
1032
1033
1034
1035
1036
1037




1038
1039
1040
1041
1042
1043
1044
    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;
	}







>
>
>
>







1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
    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))));

    dprintf("IO Want=%d, input buffer=%d, output buffer=%d, BIO pending=%zd, BIO wpending=%zd", \
	statePtr->want, Tcl_InputBuffered(statePtr->self), Tcl_OutputBuffered(statePtr->self), \
	BIO_ctrl_pending(statePtr->bio), BIO_ctrl_wpending(statePtr->bio));

    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;
	}
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
 *
 * TlsGetHandleProc --
 *
 *	This procedure is invoked by the generic IO level to retrieve an OS
 *	specific handle associated with the channel. Not used for transforms.
 *
 * Results:
 *    The appropriate Tcl_File handle or NULL if none.
 *
 * Side effects:
 *    None.
 *
 *-----------------------------------------------------------------------------
 */
static int TlsGetHandleProc(ClientData instanceData,    /* Socket state. */
    int direction,		/* TCL_READABLE or TCL_WRITABLE */
    ClientData *handlePtr)	/* Handle associated with the channel */
{







|


|







1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
 *
 * TlsGetHandleProc --
 *
 *	This procedure is invoked by the generic IO level to retrieve an OS
 *	specific handle associated with the channel. Not used for transforms.
 *
 * Results:
 *	The appropriate Tcl_File handle or NULL if none.
 *
 * Side effects:
 *	None.
 *
 *-----------------------------------------------------------------------------
 */
static int TlsGetHandleProc(ClientData instanceData,    /* Socket state. */
    int direction,		/* TCL_READABLE or TCL_WRITABLE */
    ClientData *handlePtr)	/* Handle associated with the channel */
{
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
 *
 *	This procedure is invoked by the generic IO level to notify the channel
 *	that an event has occurred on the underlying channel. It is used by stacked channel drivers that
 *	wish to be notified of events that occur on the underlying (stacked)
 *	channel.
 *
 * Results:
 *    Type of event or 0 if failed
 *
 * Side effects:
 *    May process the incoming event by itself.
 *
 *-----------------------------------------------------------------------------
 */
static int TlsNotifyProc(ClientData instanceData,    /* Socket state. */
    int mask)			/* type of event that occurred:
				 * OR-ed combination of TCL_READABLE or TCL_WRITABLE */
{







|


|







1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
 *
 *	This procedure is invoked by the generic IO level to notify the channel
 *	that an event has occurred on the underlying channel. It is used by stacked channel drivers that
 *	wish to be notified of events that occur on the underlying (stacked)
 *	channel.
 *
 * Results:
 *	Type of event or 0 if failed
 *
 * Side effects:
 *	May process the incoming event by itself.
 *
 *-----------------------------------------------------------------------------
 */
static int TlsNotifyProc(ClientData instanceData,    /* Socket state. */
    int mask)			/* type of event that occurred:
				 * OR-ed combination of TCL_READABLE or TCL_WRITABLE */
{
1120
1121
1122
1123
1124
1125
1126


1127

1128
1129


1130
1131
1132
1133
1134
1135
1136
    if (statePtr->flags & TLS_TCL_CALLBACK) {
	dprintf("Callback is on-going, returning failed");
	return 0;
    }

    /* If not initialized, do connect */
    if (statePtr->flags & TLS_TCL_INIT) {


	dprintf("Calling Tls_WaitForConnect");

	if (Tls_WaitForConnect(statePtr, &errorCode, 1) < 0) {
	    Tls_Error(statePtr, strerror(errorCode));


	    if (errorCode == EAGAIN) {
		dprintf("Async flag could be set (didn't check) and errorCode == EAGAIN:  Returning failed");

		return 0;
	    }

	    dprintf("Tls_WaitForConnect returned an error");







>
>

>
|
<
>
>







1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125

1126
1127
1128
1129
1130
1131
1132
1133
1134
    if (statePtr->flags & TLS_TCL_CALLBACK) {
	dprintf("Callback is on-going, returning failed");
	return 0;
    }

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

	dprintf("Calling Tls_WaitForConnect");

	tlsConnect = Tls_WaitForConnect(statePtr, &errorCode, 1);

	if (tlsConnect < 1) {
	    dprintf("Got an error waiting to connect (tlsConnect = %i, *errorCodePtr = %i)", tlsConnect, errorCode);
	    if (errorCode == EAGAIN) {
		dprintf("Async flag could be set (didn't check) and errorCode == EAGAIN:  Returning failed");

		return 0;
	    }

	    dprintf("Tls_WaitForConnect returned an error");
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
 *
 *	Defines the correct TLS channel driver handlers for this channel type.
 *
 * Results:
 *	Tcl_ChannelType structure.
 *
 * Side effects:
 *    None.
 *
 *-----------------------------------------------------------------------------
 */
static const Tcl_ChannelType tlsChannelType = {
    "tls",			/* Type name */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    TlsCloseProc,		/* Close proc */







|







1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
 *
 *	Defines the correct TLS channel driver handlers for this channel type.
 *
 * Results:
 *	Tcl_ChannelType structure.
 *
 * Side effects:
 *	None.
 *
 *-----------------------------------------------------------------------------
 */
static const Tcl_ChannelType tlsChannelType = {
    "tls",			/* Type name */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    TlsCloseProc,		/* Close proc */
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 * 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 _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







<







8
9
10
11
12
13
14

15
16
17
18
19
20
21
 * 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 _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
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
    typedef void tls_free_type;
#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, int all);
Tcl_Obj		*Tls_NewCAObj(Tcl_Interp *interp, const SSL *ssl, int peer);
void            Tls_Error(State *statePtr, const char *msg);
void            Tls_Free(tls_free_type *blockPtr);
void            Tls_Clean(State *statePtr);
int             Tls_WaitForConnect(State *statePtr, int *errorCodePtr, int handshakeFailureIsPermanent);

BIO             *BIO_new_tcl(State* statePtr, int flags);
int		BIO_cleanup();

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

#endif /* _TLSINT_H */







|

|

|
|
|
|

|





219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
    typedef void tls_free_type;
#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, int all);
Tcl_Obj		*Tls_NewCAObj(Tcl_Interp *interp, const SSL *ssl, int peer);
void		Tls_Error(State *statePtr, const char *msg);
void		Tls_Free(tls_free_type *blockPtr);
void		Tls_Clean(State *statePtr);
int		Tls_WaitForConnect(State *statePtr, int *errorCodePtr, int handshakeFailureIsPermanent);

BIO		*BIO_new_tcl(State* statePtr, int flags);
int		BIO_cleanup();

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

#endif /* _TLSINT_H */