Diff
Bounty program for improvements to Tcl and certain Tcl packages.

Differences From Artifact [a22b43babb]:

To Artifact [2827fa68fa]:


280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
 */
static int
TlsCloseProc(ClientData instanceData,	/* The socket to close. */
             Tcl_Interp *interp)	/* For error reporting - unused. */
{
    State *statePtr = (State *) instanceData;

    dprintf(stderr,"\nTlsCloseProc(%p)", (void *) statePtr);

    if (channelTypeVersion == TLS_CHANNEL_VERSION_1) {
	/*
	 * Remove event handler to underlying channel, this could
	 * be because we are closing for real, or being "unstacked".
	 */







|







280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
 */
static int
TlsCloseProc(ClientData instanceData,	/* The socket to close. */
             Tcl_Interp *interp)	/* For error reporting - unused. */
{
    State *statePtr = (State *) instanceData;

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

    if (channelTypeVersion == TLS_CHANNEL_VERSION_1) {
	/*
	 * Remove event handler to underlying channel, this could
	 * be because we are closing for real, or being "unstacked".
	 */

328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
	int *errorCodePtr)		/* Where to store error code. */
{
    State *statePtr = (State *) instanceData;
    int bytesRead;			/* How many bytes were read? */

    *errorCodePtr = 0;

    dprintf(stderr,"\nBIO_read(%d)", bufSize);

    if (statePtr->flags & TLS_TCL_CALLBACK) {
       /* don't process any bytes while verify callback is running */
       bytesRead = 0;
       goto input;
    }







|







328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
	int *errorCodePtr)		/* Where to store error code. */
{
    State *statePtr = (State *) instanceData;
    int bytesRead;			/* How many bytes were read? */

    *errorCodePtr = 0;

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

    if (statePtr->flags & TLS_TCL_CALLBACK) {
       /* don't process any bytes while verify callback is running */
       bytesRead = 0;
       goto input;
    }

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
     * Alternatively, we may want to handle the <0 return codes from
     * BIO_read specially (as advised in the RSA docs).  TLS's lower level BIO
     * functions play with the retry flags though, and this seems to work
     * correctly.  Similar fix in TlsOutputProc. - hobbs
     */
    ERR_clear_error();
    bytesRead = BIO_read(statePtr->bio, buf, bufSize);
    dprintf(stderr,"\nBIO_read -> %d", bytesRead);

    if (bytesRead < 0) {
	int err = SSL_get_error(statePtr->ssl, bytesRead);

	if (err == SSL_ERROR_SSL) {
	    Tls_Error(statePtr, SSL_ERROR(statePtr->ssl, bytesRead));
	    *errorCodePtr = ECONNABORTED;
	} else if (BIO_should_retry(statePtr->bio)) {
	    dprintf(stderr,"RE! ");
	    *errorCodePtr = EAGAIN;
	} else {
	    *errorCodePtr = Tcl_GetErrno();
	    if (*errorCodePtr == ECONNRESET) {
		/* Soft EOF */
		*errorCodePtr = 0;
		bytesRead = 0;
	    }
	}
    }
    input:
    dprintf(stderr, "\nInput(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr);
    return bytesRead;
}

/*
 *-------------------------------------------------------------------
 *
 * TlsOutputProc --






|








|











|







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
     * Alternatively, we may want to handle the <0 return codes from
     * BIO_read specially (as advised in the RSA docs).  TLS's lower level BIO
     * functions play with the retry flags though, and this seems to work
     * correctly.  Similar fix in TlsOutputProc. - hobbs
     */
    ERR_clear_error();
    bytesRead = BIO_read(statePtr->bio, buf, bufSize);
    dprintf("BIO_read -> %d", bytesRead);

    if (bytesRead < 0) {
	int err = SSL_get_error(statePtr->ssl, bytesRead);

	if (err == SSL_ERROR_SSL) {
	    Tls_Error(statePtr, SSL_ERROR(statePtr->ssl, bytesRead));
	    *errorCodePtr = ECONNABORTED;
	} else if (BIO_should_retry(statePtr->bio)) {
	    dprintf("RE! ");
	    *errorCodePtr = EAGAIN;
	} else {
	    *errorCodePtr = Tcl_GetErrno();
	    if (*errorCodePtr == ECONNRESET) {
		/* Soft EOF */
		*errorCodePtr = 0;
		bytesRead = 0;
	    }
	}
    }
    input:
    dprintf("Input(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr);
    return bytesRead;
}

/*
 *-------------------------------------------------------------------
 *
 * TlsOutputProc --
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
              int *errorCodePtr)	/* Where to store error code. */
{
    State *statePtr = (State *) instanceData;
    int written, err;

    *errorCodePtr = 0;

    dprintf(stderr,"\nBIO_write(%p, %d)", (void *) statePtr, toWrite);

    if (statePtr->flags & TLS_TCL_CALLBACK) {
       /* don't process any bytes while verify callback is running */
       written = -1;
       *errorCodePtr = EAGAIN;
       goto output;
    }

    if (!SSL_is_init_finished(statePtr->ssl)) {
	written = Tls_WaitForConnect(statePtr, errorCodePtr);
	if (written <= 0) {
	    goto output;
	}
    }
    if (statePtr->flags & TLS_TCL_INIT) {
	statePtr->flags &= ~(TLS_TCL_INIT);
    }
    if (toWrite == 0) {
	dprintf(stderr, "zero-write\n");
	BIO_flush(statePtr->bio);
	written = 0;
	goto output;
    } else {
	/*
	 * We need to clear the SSL error stack now because we sometimes reach
	 * this function with leftover errors in the stack.  If BIO_write
	 * returns -1 and intends EAGAIN, there is a leftover error, it will be
	 * misconstrued as an error, not EAGAIN.
	 *
	 * Alternatively, we may want to handle the <0 return codes from
	 * BIO_write specially (as advised in the RSA docs).  TLS's lower level
	 * BIO functions play with the retry flags though, and this seems to
	 * work correctly.  Similar fix in TlsInputProc. - hobbs
	 */
	ERR_clear_error();
	written = BIO_write(statePtr->bio, buf, toWrite);
	dprintf(stderr,"\nBIO_write(%p, %d) -> [%d]",
		(void *) statePtr, toWrite, written);
    }
    if (written <= 0) {
	switch ((err = SSL_get_error(statePtr->ssl, written))) {
	    case SSL_ERROR_NONE:
		if (written < 0) {
		    written = 0;
		}
		break;
	    case SSL_ERROR_WANT_WRITE:
		dprintf(stderr," write W BLOCK");
		break;
	    case SSL_ERROR_WANT_READ:
		dprintf(stderr," write R BLOCK");
		break;
	    case SSL_ERROR_WANT_X509_LOOKUP:
		dprintf(stderr," write X BLOCK");
		break;
	    case SSL_ERROR_ZERO_RETURN:
		dprintf(stderr," closed\n");
		written = 0;
		break;
	    case SSL_ERROR_SYSCALL:
		*errorCodePtr = Tcl_GetErrno();
		dprintf(stderr," [%d] syscall errr: %d",
			written, *errorCodePtr);
		written = -1;
		break;
	    case SSL_ERROR_SSL:
		Tls_Error(statePtr, SSL_ERROR(statePtr->ssl, written));
		*errorCodePtr = ECONNABORTED;
		written = -1;
		break;
	    default:
		dprintf(stderr," unknown err: %d\n", err);
		break;
	}
    }
    output:
    dprintf(stderr, "\nOutput(%d) -> %d", toWrite, written);
    return written;
}

/*
 *-------------------------------------------------------------------
 *
 * TlsGetOptionProc --






|


















|

















|










|


|


|


|




|









|




|







417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
              int *errorCodePtr)	/* Where to store error code. */
{
    State *statePtr = (State *) instanceData;
    int written, err;

    *errorCodePtr = 0;

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

    if (statePtr->flags & TLS_TCL_CALLBACK) {
       /* don't process any bytes while verify callback is running */
       written = -1;
       *errorCodePtr = EAGAIN;
       goto output;
    }

    if (!SSL_is_init_finished(statePtr->ssl)) {
	written = Tls_WaitForConnect(statePtr, errorCodePtr);
	if (written <= 0) {
	    goto output;
	}
    }
    if (statePtr->flags & TLS_TCL_INIT) {
	statePtr->flags &= ~(TLS_TCL_INIT);
    }
    if (toWrite == 0) {
	dprintf("zero-write");
	BIO_flush(statePtr->bio);
	written = 0;
	goto output;
    } else {
	/*
	 * We need to clear the SSL error stack now because we sometimes reach
	 * this function with leftover errors in the stack.  If BIO_write
	 * returns -1 and intends EAGAIN, there is a leftover error, it will be
	 * misconstrued as an error, not EAGAIN.
	 *
	 * Alternatively, we may want to handle the <0 return codes from
	 * BIO_write specially (as advised in the RSA docs).  TLS's lower level
	 * BIO functions play with the retry flags though, and this seems to
	 * work correctly.  Similar fix in TlsInputProc. - hobbs
	 */
	ERR_clear_error();
	written = BIO_write(statePtr->bio, buf, toWrite);
	dprintf("BIO_write(%p, %d) -> [%d]",
		(void *) statePtr, toWrite, written);
    }
    if (written <= 0) {
	switch ((err = SSL_get_error(statePtr->ssl, written))) {
	    case SSL_ERROR_NONE:
		if (written < 0) {
		    written = 0;
		}
		break;
	    case SSL_ERROR_WANT_WRITE:
		dprintf(" write W BLOCK");
		break;
	    case SSL_ERROR_WANT_READ:
		dprintf(" write R BLOCK");
		break;
	    case SSL_ERROR_WANT_X509_LOOKUP:
		dprintf(" write X BLOCK");
		break;
	    case SSL_ERROR_ZERO_RETURN:
		dprintf(" closed");
		written = 0;
		break;
	    case SSL_ERROR_SYSCALL:
		*errorCodePtr = Tcl_GetErrno();
		dprintf(" [%d] syscall errr: %d",
			written, *errorCodePtr);
		written = -1;
		break;
	    case SSL_ERROR_SSL:
		Tls_Error(statePtr, SSL_ERROR(statePtr->ssl, written));
		*errorCodePtr = ECONNABORTED;
		written = -1;
		break;
	    default:
		dprintf(" unknown err: %d", err);
		break;
	}
    }
    output:
    dprintf("Output(%d) -> %d", toWrite, written);
    return written;
}

/*
 *-------------------------------------------------------------------
 *
 * TlsGetOptionProc --
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
TlsWatchProc(ClientData instanceData,	/* The socket state. */
             int mask)			/* Events of interest; an OR-ed
                                         * combination of TCL_READABLE,
                                         * TCL_WRITABLE and TCL_EXCEPTION. */
{
    State *statePtr = (State *) instanceData;

    dprintf(stderr, "TlsWatchProc(0x%x)\n", mask);

    /* Pretend to be dead as long as the verify callback is running. 
     * Otherwise that callback could be invoked recursively. */
    if (statePtr->flags & TLS_TCL_CALLBACK) { return; }

    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
	Tcl_Channel     downChan;






|







593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
TlsWatchProc(ClientData instanceData,	/* The socket state. */
             int mask)			/* Events of interest; an OR-ed
                                         * combination of TCL_READABLE,
                                         * TCL_WRITABLE and TCL_EXCEPTION. */
{
    State *statePtr = (State *) instanceData;

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

    /* Pretend to be dead as long as the verify callback is running. 
     * Otherwise that callback could be invoked recursively. */
    if (statePtr->flags & TLS_TCL_CALLBACK) { return; }

    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
	Tcl_Channel     downChan;
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
static void
TlsChannelHandler (clientData, mask)
    ClientData     clientData;
    int            mask;
{
    State *statePtr = (State *) clientData;

dprintf(stderr, "HANDLER(0x%x)\n", mask);
    Tcl_Preserve( (ClientData)statePtr);

    if (mask & TCL_READABLE) {
	BIO_set_flags(statePtr->p_bio, BIO_FLAGS_READ);
    } else {
	BIO_clear_flags(statePtr->p_bio, BIO_FLAGS_READ);
    }






|







772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
static void
TlsChannelHandler (clientData, mask)
    ClientData     clientData;
    int            mask;
{
    State *statePtr = (State *) clientData;

    dprintf("HANDLER(0x%x)", mask);
    Tcl_Preserve( (ClientData)statePtr);

    if (mask & TCL_READABLE) {
	BIO_set_flags(statePtr->p_bio, BIO_FLAGS_READ);
    } else {
	BIO_clear_flags(statePtr->p_bio, BIO_FLAGS_READ);
    }
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
int
Tls_WaitForConnect( statePtr, errorCodePtr)
    State *statePtr;
    int *errorCodePtr;		/* Where to store error code. */
{
    int err;

    dprintf(stderr,"\nWaitForConnect(%p)", (void *) statePtr);

    if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) {
        /*
         * We choose ECONNRESET over ECONNABORTED here because some server
         * side code, on the wiki for example, sets up a read handler that
         * does a read and if eof closes the channel. There is no catch/try
         * around the reads so exceptions will result in potentially many






|







881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
int
Tls_WaitForConnect( statePtr, errorCodePtr)
    State *statePtr;
    int *errorCodePtr;		/* Where to store error code. */
{
    int err;

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

    if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) {
        /*
         * We choose ECONNRESET over ECONNABORTED here because some server
         * side code, on the wiki for example, sets up a read handler that
         * does a read and if eof closes the channel. There is no catch/try
         * around the reads so exceptions will result in potentially many
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
		Tls_Error(statePtr,
			(char *)ERR_reason_error_string(ERR_get_error()));
                statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
		*errorCodePtr = ECONNABORTED;
		return -1;
	    } else if (BIO_should_retry(statePtr->bio)) {
		if (statePtr->flags & TLS_TCL_ASYNC) {
		    dprintf(stderr,"E! ");
		    *errorCodePtr = EAGAIN;
		    return -1;
		} else {
		    continue;
		}
	    } else if (err == 0) {
                if (Tcl_Eof(statePtr->self)) {
                    return 0;
                }
		dprintf(stderr,"CR! ");
		*errorCodePtr = ECONNRESET;
		return -1;
	    }
	    if (statePtr->flags & TLS_TCL_SERVER) {
		err = SSL_get_verify_result(statePtr->ssl);
		if (err != X509_V_OK) {
		    Tls_Error(statePtr,
			    (char *)X509_verify_cert_error_string(err));
                    statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
		    *errorCodePtr = ECONNABORTED;
		    return -1;
		}
	    }
	    *errorCodePtr = Tcl_GetErrno();
	    dprintf(stderr,"ERR(%d, %d) ", rc, *errorCodePtr);
	    return -1;
	}
	dprintf(stderr,"R0! ");
	return 1;
    }
}

Tcl_Channel
Tls_GetParent( statePtr )
    State *statePtr;






|









|














|


|







920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
		Tls_Error(statePtr,
			(char *)ERR_reason_error_string(ERR_get_error()));
                statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
		*errorCodePtr = ECONNABORTED;
		return -1;
	    } else if (BIO_should_retry(statePtr->bio)) {
		if (statePtr->flags & TLS_TCL_ASYNC) {
		    dprintf("E! ");
		    *errorCodePtr = EAGAIN;
		    return -1;
		} else {
		    continue;
		}
	    } else if (err == 0) {
                if (Tcl_Eof(statePtr->self)) {
                    return 0;
                }
		dprintf("CR! ");
		*errorCodePtr = ECONNRESET;
		return -1;
	    }
	    if (statePtr->flags & TLS_TCL_SERVER) {
		err = SSL_get_verify_result(statePtr->ssl);
		if (err != X509_V_OK) {
		    Tls_Error(statePtr,
			    (char *)X509_verify_cert_error_string(err));
                    statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
		    *errorCodePtr = ECONNABORTED;
		    return -1;
		}
	    }
	    *errorCodePtr = Tcl_GetErrno();
	    dprintf("ERR(%d, %d) ", rc, *errorCodePtr);
	    return -1;
	}
	dprintf("R0! ");
	return 1;
    }
}

Tcl_Channel
Tls_GetParent( statePtr )
    State *statePtr;