Index: generic/tls.c ================================================================== --- generic/tls.c +++ generic/tls.c @@ -1224,11 +1224,11 @@ dprintf("Returning TCL_OK with data \"%i\"", ret); Tcl_SetObjResult(interp, Tcl_NewIntObj(ret)); return TCL_OK; } - + /* *------------------------------------------------------------------- * * ImportObjCmd -- * @@ -1378,10 +1378,11 @@ 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) { @@ -1452,11 +1453,11 @@ 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)); @@ -1621,13 +1622,10 @@ 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 */ @@ -1651,10 +1649,11 @@ } /* 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)); @@ -1709,11 +1708,12 @@ Tcl_SetErrorCode(interp, "TLS", "UNIMPORT", "CHANNEL", "INVALID", (char *) NULL); return TCL_ERROR; } /* Flush any pending data */ - if (Tcl_Flush(chan) != TCL_OK) { + 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); @@ -1911,12 +1911,12 @@ /* 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); + 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)) { @@ -1927,10 +1927,13 @@ 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); @@ -2101,19 +2104,19 @@ 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++; } @@ -2126,11 +2129,10 @@ } Tcl_DStringFree(&ds); } #endif } - return ctx; } /* *------------------------------------------------------------------- @@ -2314,11 +2316,11 @@ 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); @@ -3004,11 +3006,11 @@ return TCL_ERROR; } /* Create BIO handlers */ BIO_new_tcl(NULL, 0); - + /* Create exit handler */ Tcl_CreateExitHandler(TlsLibShutdown, NULL); initialized = 1; } return TCL_OK; Index: generic/tlsBIO.c ================================================================== --- generic/tlsBIO.c +++ generic/tlsBIO.c @@ -4,165 +4,212 @@ * * Copyright (C) 1997-2000 Matt Newman * Copyright (C) 2024 Brian O'Hagan * */ + +/* + tlsBIO.c tlsIO.c + +------+ +-----+ +------+ + | |Tcl_WriteRaw <-- BioWrite| SSL |BIO_write <-- TlsOutputProc <-- Write| | + |socket| | BIO | | App | + | |Tcl_ReadRaw --> BioRead| |BIO_Read --> TlsInputProc --> Read| | + +------+ +-----+ +------+ +*/ #include "tlsInt.h" #include /* 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 BIO_write_ex() or BIO_write(). + * 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. + * 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, , %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); - } - } + 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 BIO_read_ex() or BIO_read(). + * 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_Channel chan; - Tcl_Size ret = 0; - int tclEofChan, tclErrno; - - chan = Tls_GetParent((State *) BIO_get_data(bio), 0); - - dprintf("[chan=%p] BioRead(%p, , %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, , %d) [%p] returning %" TCL_SIZE_MODIFIER "d", (void *) bio, - bufLen, (void *) chan, ret); - + 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; } /* *----------------------------------------------------------------------------- @@ -169,11 +216,11 @@ * * 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(). + * the application calling the BIO_puts() function. * * Results: * Returns the number of bytes written to channel or 0 for error. * * Side effects: @@ -181,11 +228,11 @@ * *----------------------------------------------------------------------------- */ static int BioPuts(BIO *bio, const char *str) { - dprintf("BioPuts(%p, ) called", bio, str); + dprintf("BioPuts(%p) \"%s\"", bio, str); return BioWrite(bio, str, (int) strlen(str)); } /* @@ -192,11 +239,12 @@ *----------------------------------------------------------------------------- * * 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(). + * function will be called in response to the application calling the + * BIO_ctrl() function. * * Results: * Function dependent * * Side effects: @@ -204,114 +252,155 @@ * *----------------------------------------------------------------------------- */ 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); + 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_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; + 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 = 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_SET: + /* man - set the 'IO' parameter */ + dprintf("Got BIO_CTRL_SET"); 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); + 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_SET: - dprintf("Got BIO_CTRL_SET"); + 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 : - dprintf("Got BIO_CTRL_GET "); + case BIO_CTRL_GET_CALLBACK: + /* opt - Get and return the info callback. Implements BIO_get_info_callback */ ret = 0; break; -#ifdef BIO_CTRL_GET_KTLS_SEND + + 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 -#ifdef BIO_CTRL_GET_KTLS_RECV +#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 BIO_new(). + * 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: @@ -321,12 +410,16 @@ */ static int BioNew(BIO *bio) { dprintf("BioNew(%p) called", bio); - BIO_set_init(bio, 0); + if (bio == NULL) { + return 0; + } + BIO_set_data(bio, NULL); + BIO_set_init(bio, 0); BIO_clear_flags(bio, -1); return 1; } /* @@ -333,11 +426,12 @@ *----------------------------------------------------------------------------- * * 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(). + * will be called in response to the application calling the BIO_free() + * function. * * Results: * Returns boolean success result * * Side effects: @@ -345,22 +439,19 @@ * *----------------------------------------------------------------------------- */ static int BioFree(BIO *bio) { + dprintf("BioFree(%p) called", bio); + if (bio == NULL) { return 0; } - dprintf("BioFree(%p) called", bio); - + /* Clear flags if set to BIO_CLOSE (close I/O stream when the BIO is freed) */ if (BIO_get_shutdown(bio)) { - if (BIO_get_init(bio)) { - /*shutdown(bio->num, 2) */ - /*closesocket(bio->num) */ - } - + BIO_set_data(bio, NULL); BIO_set_init(bio, 0); BIO_clear_flags(bio, -1); } return 1; } @@ -384,21 +475,31 @@ 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"); + /* Create custom BIO method */ if (BioMethods == NULL) { - BioMethods = BIO_meth_new(BIO_TYPE_TCL, "tcl"); + /* 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); @@ -418,10 +519,13 @@ 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); @@ -436,20 +540,23 @@ 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"); -#endif bio = BIO_new(BioMethods); BIO_set_data(bio, statePtr); BIO_set_shutdown(bio, flags); - BIO_set_init(bio, 1); + BIO_set_init(bio, 1); /* Enable read & write */ return bio; } /* *----------------------------------------------------------------------------- Index: generic/tlsIO.c ================================================================== --- generic/tlsIO.c +++ generic/tlsIO.c @@ -18,10 +18,19 @@ * 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| | BIO | | App | + | |Tcl_ReadRaw --> BioRead| |BIO_Read --> TlsInputProc --> Read| | + +------+ +-----+ +------+ +*/ #include "tlsInt.h" #include /* @@ -57,10 +66,12 @@ * * 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: @@ -72,15 +83,15 @@ 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) { + /* 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); @@ -158,10 +169,11 @@ 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); @@ -169,10 +181,11 @@ } 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) { @@ -180,36 +193,35 @@ } } 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)); } - bioShouldRetry = 0; + /* 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; + statePtr->want |= TCL_READABLE; } else if (rc == SSL_ERROR_WANT_WRITE) { bioShouldRetry = 1; - statePtr->want = TCL_WRITABLE; + 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"); @@ -228,11 +240,11 @@ break; } switch (rc) { case SSL_ERROR_NONE: - /* The TLS/SSL I/O operation completed */ + /* The TLS/SSL I/O operation completed successfully */ dprintf("The connection is good"); *errorCodePtr = 0; break; case SSL_ERROR_SSL: @@ -276,26 +288,72 @@ 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 */ + /* 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 = EINVAL; + *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: - case SSL_ERROR_WANT_X509_LOOKUP: + /* 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; @@ -315,21 +373,24 @@ /* *----------------------------------------------------------------------------- * * 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. + * 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; @@ -344,10 +405,11 @@ 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"); @@ -377,32 +439,37 @@ * 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 */ + BIO_clear_retry_flags(statePtr->bio); bytesRead = BIO_read(statePtr->bio, buf, bufSize); dprintf("BIO_read -> %d", bytesRead); - /* Get error is more comprehensive than SSL_want */ + /* 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); } @@ -443,21 +510,23 @@ 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; + 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; + 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"); @@ -491,10 +560,11 @@ } 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; @@ -522,14 +592,13 @@ /* *----------------------------------------------------------------------------- * * 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. + * 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. * @@ -554,10 +623,11 @@ *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"); @@ -605,25 +675,26 @@ * 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 */ + BIO_clear_retry_flags(statePtr->bio); 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 */ + /* 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)) { @@ -665,21 +736,23 @@ 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; + 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; + 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"); @@ -712,10 +785,11 @@ } 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; @@ -787,10 +861,11 @@ 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); } /* @@ -829,10 +904,11 @@ 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) { /* @@ -883,11 +959,11 @@ dprintf("[chan=%p] BIO readable", statePtr->self); mask |= TCL_READABLE; } - /* Notify event subsystem that the channel is readable or writeable */ + /* 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"); @@ -920,10 +996,11 @@ * 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. @@ -956,28 +1033,29 @@ */ 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); + /* 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); + } } } /* *----------------------------------------------------------------------------- Index: generic/tlsInt.h ================================================================== --- generic/tlsInt.h +++ generic/tlsInt.h @@ -15,12 +15,14 @@ */ #ifndef _TLSINT_H #define _TLSINT_H /* Platform unique definitions */ -#ifdef _WIN32 +#if ((defined(_WIN32)) || (defined(__MINGW32__)) || (defined(__MINGW64__))) +#ifndef WIN32_LEAN_AND_MEAN #define WIN32_LEAN_AND_MEAN +#endif #include #include /* OpenSSL needs this on Windows */ #endif #include "tls.h" @@ -143,15 +145,10 @@ #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 */ @@ -158,11 +155,11 @@ #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. */ + * 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.