[shepherd] 02/05: shepherd: Protect against 'read' errors.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit 5bd7f45e48f30631b29357a83c6cfcfcf79c756b
Author: Ludovic Courtès <address@hidden>
Date:   Sat Jan 23 17:58:18 2016 +0100

    shepherd: Protect against 'read' errors.
    
    * modules/shepherd/comm.scm (read-command): Catch 'read-error'
    exceptions.  Return #f upon EOF.
    * modules/shepherd.scm (process-connection): Adjust accordingly.
    * tests/misbehaved-client.sh: Add test with invalid sexp.
---
 modules/shepherd.scm       |    2 +-
 modules/shepherd/comm.scm  |   30 ++++++++++++++++++------------
 tests/misbehaved-client.sh |   10 ++++++++++
 3 files changed, 29 insertions(+), 13 deletions(-)

diff --git a/modules/shepherd.scm b/modules/shepherd.scm
index e6a7a55..ce24513 100644
--- a/modules/shepherd.scm
+++ b/modules/shepherd.scm
@@ -215,7 +215,7 @@
       (match (read-command sock)
         ((? shepherd-command? command)
          (process-command command sock))
-        ((? eof-object?)
+        (#f                                    ;failed to read a valid command
          #f))
 
       ;; Currently we assume one command per connection.
diff --git a/modules/shepherd/comm.scm b/modules/shepherd/comm.scm
index 957e5b1..4e89ee4 100644
--- a/modules/shepherd/comm.scm
+++ b/modules/shepherd/comm.scm
@@ -88,18 +88,24 @@ return the socket."
       sock)))
 
 (define (read-command port)
-  "Receive a command from PORT; return the command the EOF object."
-  (match (read port)
-    (('shepherd-command ('version 0 _ ...)
-                        ('action action)
-                        ('service service)
-                        ('arguments args ...)
-                        ('directory directory))
-     (shepherd-command action service
-                       #:arguments args
-                       #:directory directory))
-    ((? eof-object? eof)
-     eof)))
+  "Receive a command from PORT; return the command of #f if something went
+wrong---premature end-of-file, invalid sexp, etc."
+  (catch 'read-error
+    (lambda ()
+      (match (read port)
+        (('shepherd-command ('version 0 _ ...)
+                            ('action action)
+                            ('service service)
+                            ('arguments args ...)
+                            ('directory directory))
+         (shepherd-command action service
+                           #:arguments args
+                           #:directory directory))
+        ((? eof-object? eof)
+         #f)))
+    (lambda _
+      ;; Invalid sexp.
+      #f)))
 
 (define (write-command command port)
   "Write COMMAND to PORT."
diff --git a/tests/misbehaved-client.sh b/tests/misbehaved-client.sh
index e473ad6..87d4505 100644
--- a/tests/misbehaved-client.sh
+++ b/tests/misbehaved-client.sh
@@ -48,6 +48,16 @@ $herd status                 # still here?
 "$GUILE" -c "
 (use-modules (shepherd comm))
 
+;; Send an unbalanced sexp, then quit.
+(let ((sock (open-connection \"$socket\")))
+  (display \"(ah ha!\" sock)
+  (close-port sock))"
+
+$herd status                   # still here?
+
+"$GUILE" -c "
+(use-modules (shepherd comm))
+
 (let ((sock (open-connection \"$socket\")))
   (setvbuf sock _IOFBF 5000)
   (write-command (shepherd-command 'status 'dmd) sock)