Index: generic/tlsDigest.c ================================================================== --- generic/tlsDigest.c +++ generic/tlsDigest.c @@ -19,10 +19,11 @@ /* Macros */ #define BUFFER_SIZE 65536 #define BIN_FORMAT 0 #define HEX_FORMAT 1 +#define CHAN_EOF 0x10 /* * This structure describes the per-instance state of an SSL channel. * * The SSL processing context is maintained here, in the ClientData @@ -235,33 +236,34 @@ *------------------------------------------------------------------- * * DigestCloseProc -- * * This procedure is invoked by the generic IO level to perform - * channel-type-specific cleanup when digest channel is closed. + * channel-type-specific cleanup when channel is closed. All + * queued output is flushed prior to calling this function. * * Returns: - * TCL_OK or TCL_ERROR + * 0 if successful or POSIX error code if failed. * * Side effects: - * Writes digest to output and closes the channel. + * Writes digest to output and closes the channel. Stores error + * messages in interp result. * *------------------------------------------------------------------- */ int DigestCloseProc(ClientData clientData, Tcl_Interp *interp) { DigestState *statePtr = (DigestState *) clientData; - int result = 0; /* Cancel active timer, if any */ if (statePtr->timer != (Tcl_TimerToken) NULL) { Tcl_DeleteTimerHandler(statePtr->timer); statePtr->timer = (Tcl_TimerToken) NULL; } /* Clean-up */ DigestFree(statePtr); - return result; + return 0; } /* * Same as DigestCloseProc but with individual read and write close control */ @@ -276,14 +278,16 @@ /* *---------------------------------------------------------------------- * * DigestInputProc -- * - * Called by the generic IO system to read data from transform. + * Called by the generic IO system to read data from transform and + * place in buf. * * Returns: - * Total bytes read + * Total bytes read or -1 for an error along with a POSIX error + * code in errorCodePtr. Use EAGAIN for nonblocking and no data. * * Side effects: * Read data from transform and write to buf * *---------------------------------------------------------------------- @@ -312,18 +316,19 @@ if (!res) { Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Digest update failed: %s", REASON())); *errorCodePtr = EINVAL; return -1; } - *errorCodePtr = EAGAIN; + /* This is correct */ read = -1; + *errorCodePtr = EAGAIN; } else if (read < 0) { /* Error */ *errorCodePtr = Tcl_GetErrno(); - } else if (!(statePtr->flags & 0x10)) { + } else if (!(statePtr->flags & CHAN_EOF)) { /* EOF */ *errorCodePtr = 0; unsigned char md_buf[EVP_MAX_MD_SIZE]; unsigned int md_len = 0; @@ -352,49 +357,64 @@ } read = md_len*2; memcpy(buf, hex_buf, read); } } - statePtr->flags |= 0x10; + statePtr->flags |= CHAN_EOF; } return read; } /* *---------------------------------------------------------------------- * * DigestOutputProc -- * - * Called by the generic IO system to write data to transform. + * Called by the generic IO system to write data in buf to transform. * * Returns: - * Total bytes written + * Total bytes written or -1 for an error along with a POSIX error + * code in errorCodePtr. Use EAGAIN for nonblocking and can't write data. * * Side effects: * Get data from buf and update digest * *---------------------------------------------------------------------- */ int DigestOutputProc(ClientData clientData, const char *buf, int toWrite, int *errorCodePtr) { DigestState *statePtr = (DigestState *) clientData; *errorCodePtr = 0; + int res; if (toWrite <= 0 || statePtr->self == (Tcl_Channel) NULL) { return 0; } + + /* Add to message digest */ + if (statePtr->ctx != NULL) { + res = EVP_DigestUpdate(statePtr->ctx, buf, (size_t) toWrite); + } else { + res = HMAC_Update(statePtr->hctx, buf, (size_t) toWrite); + } + if (!res) { + Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Digest update failed: %s", REASON())); + *errorCodePtr = EINVAL; + return -1; + } return toWrite; } /* *---------------------------------------------------------------------- * * DigestSetOptionProc -- * - * Called by the generic IO system to set channel option to value. + * Called by the generic IO system to set channel option name to value. * * Returns: - * TCL_OK if successful or TCL_ERROR if failed. + * TCL_OK if successful or TCL_ERROR if failed along with an error + * message in interp and Tcl_SetErrno. * * Side effects: * Updates channel option to new value. * *---------------------------------------------------------------------- @@ -413,23 +433,25 @@ parent = Tcl_GetStackedChannel(statePtr->self); setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(parent)); if (setOptionProc != NULL) { return (*setOptionProc)(Tcl_GetChannelInstanceData(parent), interp, optionName, optionValue); } else { - return TCL_ERROR; + Tcl_SetErrno(EINVAL); + return Tcl_BadChannelOption(interp, optionName, NULL); } } /* *---------------------------------------------------------------------- * * DigestGetOptionProc -- * - * Called by the generic IO system to get channel option's value. + * Called by the generic IO system to get channel option name's value. * * Returns: - * TCL_OK if successful or TCL_ERROR if failed. + * TCL_OK if successful or TCL_ERROR if failed along with an error + * message in interp and Tcl_SetErrno. * * Side effects: * Sets result to option's value * *---------------------------------------------------------------------- @@ -450,14 +472,14 @@ if (getOptionProc != NULL) { return (*getOptionProc)(Tcl_GetChannelInstanceData(parent), interp, optionName, optionValue); } else if (optionName == (char*) NULL) { /* Request is query for all options, this is ok. */ return TCL_OK; + } else { + Tcl_SetErrno(EINVAL); + return Tcl_BadChannelOption(interp, optionName, NULL); } - - /* Request for a specific option has to fail, we don't have any. */ - return Tcl_BadChannelOption(interp, optionName, ""); } /* *---------------------------------------------------------------------- * @@ -541,12 +563,13 @@ * * Called from Tcl_GetChannelHandle to retrieve OS specific file handle * from inside this channel. Not used for transformations? * * Returns: - * If direction is TCL_READABLE return the handle used for input, or if - * TCL_WRITABLE return the handle used for output. + * TCL_OK for success or TCL_ERROR for error or if not supported. If + * direction is TCL_READABLE, sets handlePtr to the handle used for + * input, or if TCL_WRITABLE sets to the handle used for output. * * Side effects: * None * *---------------------------------------------------------------------- Index: tests/ciphers.csv ================================================================== --- tests/ciphers.csv +++ tests/ciphers.csv @@ -15,11 +15,11 @@ command,proc exec_get {delim args} {return [split [exec openssl {*}$args] $delim]},,,,,,,,, command,"proc exec_get_ciphers {} {set list [list];set data [exec openssl list -cipher-algorithms];foreach line [split $data ""\n""] {foreach {cipher null alias} [split [string trim $line]] {lappend list [string tolower $cipher]}};return [lsort -unique $list]}",,,,,,,,, command,"proc exec_get_digests {} {set list [list];set data [exec openssl dgst -list];foreach line [split $data ""\n""] {foreach digest $line {if {[string match ""-*"" $digest]} {lappend list [string trimleft $digest ""-""]}}};return [lsort $list]}",,,,,,,,, command,proc exec_get_macs {} {return [list cmac hmac]},,,,,,,,, command,proc list_tolower {list} {set result [list];foreach element $list {lappend result [string tolower $element]};return $result},,,,,,,,, -command,proc read_chan {md filename args} {set ch [open $filename rb];fconfigure $ch -translation binary;set new [tls::digest $md {*}$args -chan $ch];while {![eof $new]} {set result [read $new]};close $new;return $result},,,,,,,,, +command,proc read_chan {md filename args} {set ch [open $filename rb];fconfigure $ch -translation binary;set bsize [fconfigure $ch -buffersize];set new [tls::digest $md {*}$args -chan $ch];while {![eof $new]} {set result [read $new $bsize]};close $new;return $result},,,,,,,,, ,,,,,,,,,, command,# Test list ciphers,,,,,,,,, Ciphers List,All,,,lcompare [lsort [exec_get_ciphers]] [list_tolower [lsort [::tls::ciphers]]],,,missing {rc5 rc5-cbc rc5-cfb rc5-ecb rc5-ofb} unexpected {aes-128-ccm aes-128-gcm aes-192-ccm aes-192-gcm aes-256-ccm aes-256-gcm},,, ,,,,,,,,,, command,# Test list ciphers for protocols,,,,,,,,, Index: tests/ciphers.test ================================================================== --- tests/ciphers.test +++ tests/ciphers.test @@ -22,11 +22,11 @@ proc lcompare {list1 list2} {set m "";set u "";foreach i $list1 {if {$i ni $list2} {lappend m $i}};foreach i $list2 {if {$i ni $list1} {lappend u $i}};return [list "missing" $m "unexpected" $u]} proc exec_get {delim args} {return [split [exec openssl {*}$args] $delim]} proc exec_get_ciphers {} {set list [list];set data [exec openssl list -cipher-algorithms];foreach line [split $data "\n"] {foreach {cipher null alias} [split [string trim $line]] {lappend list [string tolower $cipher]}};return [lsort -unique $list]} proc exec_get_digests {} {set list [list];set data [exec openssl dgst -list];foreach line [split $data "\n"] {foreach digest $line {if {[string match "-*" $digest]} {lappend list [string trimleft $digest "-"]}}};return [lsort $list]} command,proc exec_get_macs {} {return [list cmac hmac]},,,,,,,,, -proc read_chan {md filename args} {set ch [open $filename rb];fconfigure $ch -translation binary;set new [tls::digest $md {*}$args -chan $ch];while {![eof $new]} {set result [read $new]};close $new;return $result} +proc read_chan {md filename args} {set ch [open $filename rb];fconfigure $ch -translation binary;set bsize [fconfigure $ch -buffersize];set new [tls::digest $md {*}$args -chan $ch];while {![eof $new]} {set result [read $new $bsize]};close $new;return $result} # Test list ciphers test Ciphers_List-1.1 {All} -body { lcompare [lsort [exec_get_ciphers]] [list_tolower [lsort [::tls::ciphers]]]