tcl daemons: Fix reentrancy hazard in chan-read

If the callback called by chan-read sets up a different read handler,
and the data for that other read handler arrives before chan-read
returns, chan-read would go round its loop again and eat and process
the new data.  This is wrong.

Instead, return from chan-read after processing one result from
`gets'.  If there is more to do, with this handler, the filevent will
arrange for us to be reentered.

This is most easily done by changing the `while' into an `if', and all
of the `continue's into `return's.  (There are no `break's.)

Signed-off-by: Ian Jackson <Ian.Jackson@eu.citrix.com>

diff --git a/tcl/daemonlib.tcl b/tcl/daemonlib.tcl
index b76ff12c8cca0d3278ee48b3d28fc39ea0b7d569..1e86d5f466f082fca6070a53cf2142d8a1de2867 100644 (file)
--- a/tcl/daemonlib.tcl
+++ b/tcl/daemonlib.tcl
@@ -56,15 +56,15 @@ proc for-chan {chan script} {
 proc chan-read {chan} {
     upvar #0 chandesc($chan) desc
     for-chan $chan {
-        while {[gets $chan l] > 0} {
+        if {[gets $chan l] > 0} {
             log "$desc << $l"
             if {![regexp {^([-0-9a-z]+)(?:\s+(.*))?$} $l dummy cmd rhs]} {
                 chan-error $chan "bad cli cmd syntax"
-                continue
+                return
             }
             if {[catch { set al [info args cmd/$cmd] } emsg]} {
                 chan-error $chan "unknown command $emsg"
-                continue
+                return
             }
             set basel [list cmd/$cmd $chan $desc]
             if {[llength $al]==2} {
@@ -76,23 +76,23 @@ proc chan-read {chan} {
             } else {
                 if {[catch { set all [llength $rhs] } emsg]} {
                     chan-error $chan "bad list syntax $emsg"
-                    continue
+                    return
                 }
                 set alexp [lrange $al 2 end]
                 if {![string compare [lindex $al end] args]} {
                     if {$all+2 < [llength $al]-1} {
                         chan-error $chan "too few args ($alexp)"
-                        continue
+                        return
                     }
                 } else {
                     if {$all+2 != [llength $al]} {
                         chan-error $chan "wrong number of args ($alexp)"
-                        continue
+                        return
                     }
                 }
                 eval $basel [lreplace $rhs -1 -1]
             }
-            if {![info exists desc]} return
+            return
         }
         if {[eof $chan]} {
             puts-chan-desc $chan {$$}