[shepherd] 05/07: reboot, halt: Adjust to sexp replies.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit 41c9fc34bd382d29cb6007e3c3476877f55cb0d2
Author: Ludovic Courtès <address@hidden>
Date:   Fri Jan 22 23:33:54 2016 +0100

    reboot, halt: Adjust to sexp replies.
    
    * modules/reboot.scm (main): Read the reply in sexp format.
    * modules/halt.scm (main): Ditto.
---
 modules/halt.scm   |   19 ++++++++++++-------
 modules/reboot.scm |   19 ++++++++++++-------
 2 files changed, 24 insertions(+), 14 deletions(-)

diff --git a/modules/halt.scm b/modules/halt.scm
index 7b938bb..77dddbe 100644
--- a/modules/halt.scm
+++ b/modules/halt.scm
@@ -21,6 +21,7 @@
   #:use-module (shepherd args)
   #:use-module (shepherd comm)
   #:use-module (oop goops)
+  #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
   #:export (main))
 
@@ -50,10 +51,14 @@
          ;; Send the command without further ado.
          (write-command (dmd-command 'power-off 'dmd) sock)
 
-         ;; Receive output.
-         (setvbuf sock _IOLBF)
-         (let loop ((line (read-line sock)))
-           (unless (eof-object? line)
-             (display line)
-             (newline)
-             (loop (read-line sock)))))))))
+         ;; Receive output if we're not already dead.
+         (match (read sock)
+           (('reply ('version 0 _ ...)
+                    ('result _) ('error error)
+                    ('messages messages))
+            (for-each display-line messages)
+            (when error
+              (report-command-error error)
+              (exit 1)))
+           ((? eof-object?)
+            #t)))))))
diff --git a/modules/reboot.scm b/modules/reboot.scm
index 589f386..af05cc2 100644
--- a/modules/reboot.scm
+++ b/modules/reboot.scm
@@ -21,6 +21,7 @@
   #:use-module (shepherd args)
   #:use-module (shepherd comm)
   #:use-module (oop goops)
+  #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
   #:export (main))
 
@@ -50,10 +51,14 @@
          ;; Send the command without further ado.
          (write-command (dmd-command 'stop 'dmd) sock)
 
-         ;; Receive output.
-         (setvbuf sock _IOLBF)
-         (let loop ((line (read-line sock)))
-           (unless (eof-object? line)
-             (display line)
-             (newline)
-             (loop (read-line sock)))))))))
+         ;; Receive output if we're not already dead.
+         (match (read sock)
+           (('reply ('version 0 _ ...)
+                    ('result _) ('error error)
+                    ('messages messages))
+            (for-each display-line messages)
+            (when error
+              (report-command-error error)
+              (exit 1)))
+           ((? eof-object?)
+            #t)))))))