diff --git a/tests/support/redis.tcl b/tests/support/redis.tcl index a7a5b8a97..f22c7f1c5 100644 --- a/tests/support/redis.tcl +++ b/tests/support/redis.tcl @@ -65,6 +65,33 @@ proc redis {{server 127.0.0.1} {port 6379} {defer 0} {tls 0} {tlsoptions {}} {re interp alias {} ::redis::redisHandle$id {} ::redis::__dispatch__ $id } +# On recent versions of tcl-tls/OpenSSL, reading from a dropped connection +# results with an error we need to catch and mimic the old behavior. +proc ::redis::redis_safe_read {fd len} { + if {$len == -1} { + set err [catch {set val [read $fd]} msg] + } else { + set err [catch {set val [read $fd $len]} msg] + } + if {!$err} { + return $val + } + if {[string match "*connection abort*" $msg]} { + return {} + } + error $msg +} + +proc ::redis::redis_safe_gets {fd} { + if {[catch {set val [gets $fd]} msg]} { + if {[string match "*connection abort*" $msg]} { + return {} + } + error $msg + } + return $val +} + # This is a wrapper to the actual dispatching procedure that handles # reconnection if needed. proc ::redis::__dispatch__ {id method args} { @@ -144,6 +171,10 @@ proc ::redis::__method__read {id fd} { ::redis::redis_read_reply $id $fd } +proc ::redis::__method__rawread {id fd {len -1}} { + return [redis_safe_read $fd $len] +} + proc ::redis::__method__write {id fd buf} { ::redis::redis_write $fd $buf } @@ -189,8 +220,8 @@ proc ::redis::redis_writenl {fd buf} { } proc ::redis::redis_readnl {fd len} { - set buf [read $fd $len] - read $fd 2 ; # discard CR LF + set buf [redis_safe_read $fd $len] + redis_safe_read $fd 2 ; # discard CR LF return $buf } @@ -236,11 +267,11 @@ proc ::redis::redis_read_map {id fd} { } proc ::redis::redis_read_line fd { - string trim [gets $fd] + string trim [redis_safe_gets $fd] } proc ::redis::redis_read_null fd { - gets $fd + redis_safe_gets $fd return {} } @@ -257,7 +288,7 @@ proc ::redis::redis_read_reply {id fd} { } while {1} { - set type [read $fd 1] + set type [redis_safe_read $fd 1] switch -exact -- $type { _ {return [redis_read_null $fd]} : - diff --git a/tests/unit/obuf-limits.tcl b/tests/unit/obuf-limits.tcl index 52a23fd39..0e860c1f0 100644 --- a/tests/unit/obuf-limits.tcl +++ b/tests/unit/obuf-limits.tcl @@ -96,7 +96,7 @@ start_server {tags {"obuf-limits"}} { # Read nothing set fd [$rd channel] - assert_equal {} [read $fd] + assert_equal {} [$rd rawread] } # Note: This test assumes that what's written with one write, will be read by redis in one read. @@ -136,8 +136,7 @@ start_server {tags {"obuf-limits"}} { assert_equal "PONG" [r ping] set clients [r client list] assert_no_match "*name=multicommands*" $clients - set fd [$rd2 channel] - assert_equal {} [read $fd] + assert_equal {} [$rd2 rawread] } test {Execute transactions completely even if client output buffer limit is enforced} {