[shepherd] 04/08: Avoid uses of the _IO* constants on Guile >= 2.2.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit 928aacc6cc5e1b7259619468a9dafe8cc78a66e2
Author: Ludovic Courtès <address@hidden>
Date:   Wed Sep 26 14:27:01 2018 +0200

    Avoid uses of the _IO* constants on Guile >= 2.2.
    
    * modules/shepherd/support.scm (if-2.0, buffering-mode): New macros.
    (initialize-cli): Use 'buffering-mode' instead of _IO*.
    * modules/shepherd/comm.scm (open-connection): Likewise.
    * modules/shepherd.scm (main): Likewise.
    * tests/misbehaved-client.sh: Likewise.
---
 modules/shepherd.scm         |  2 +-
 modules/shepherd/comm.scm    |  8 ++++----
 modules/shepherd/support.scm | 25 ++++++++++++++++++++++---
 tests/misbehaved-client.sh   |  6 +++---
 4 files changed, 30 insertions(+), 11 deletions(-)

diff --git a/modules/shepherd.scm b/modules/shepherd.scm
index 5aeda33..628267b 100644
--- a/modules/shepherd.scm
+++ b/modules/shepherd.scm
@@ -262,7 +262,7 @@
               (define (read-from sock)
                 (match (accept sock)
                   ((command-source . client-address)
-                   (setvbuf command-source _IOFBF 1024)
+                   (setvbuf command-source (buffering-mode block) 1024)
                    (process-connection command-source))
                   (_ #f)))
               (match (select (list sock) (list) (list) (if poll-services? 0.5 
#f))
diff --git a/modules/shepherd/comm.scm b/modules/shepherd/comm.scm
index c31bf02..25c1a7e 100644
--- a/modules/shepherd/comm.scm
+++ b/modules/shepherd/comm.scm
@@ -83,7 +83,7 @@ return the socket."
       (catch 'system-error
         (lambda ()
           (connect sock address)
-          (setvbuf sock _IOFBF 1024))
+          (setvbuf sock (buffering-mode block) 1024))
         (lambda (key proc format-string format-args errno . rest)
           ;; Guile's 'connect' throws an exception that doesn't specify
           ;; FILE.  Augment it with this information.
@@ -240,7 +240,7 @@ mechanism."
             (catch 'system-error
               (lambda ()
                 (connect sock AF_UNIX "/dev/log")
-                (setvbuf sock _IOLBF)
+                (setvbuf sock (buffering-mode line))
                 (set! port sock)
                 (call/syslog))
               (lambda args
@@ -251,14 +251,14 @@ mechanism."
                       (lambda ()
                         (call-with-output-file "/dev/kmsg"
                           (lambda (port)
-                            (setvbuf port _IOFBF)
+                            (setvbuf port (buffering-mode block))
                             (proc port))))
                       (lambda args
                         (if (memv (system-error-errno args)
                                   (list ENOENT EACCES EPERM))
                             (call-with-output-file "/dev/console"
                               (lambda (port)
-                                (setvbuf port _IONBF)
+                                (setvbuf port (buffering-mode none))
                                 (proc port)))
                             (apply throw args))))
                     (apply throw args)))))))))
diff --git a/modules/shepherd/support.scm b/modules/shepherd/support.scm
index 9b80b0f..9df9c36 100644
--- a/modules/shepherd/support.scm
+++ b/modules/shepherd/support.scm
@@ -23,7 +23,9 @@
 (define-module (shepherd support)
   #:use-module (shepherd config)
   #:use-module (ice-9 match)
-  #:export (call/ec
+  #:export (buffering-mode
+
+            call/ec
             caught-error
             assert
             label
@@ -61,6 +63,23 @@
 
             verify-dir))
 
+(define-syntax-rule (if-2.0 subsequent alternate)
+  "Expand to SUBSEQUENT when using Guile 2.0, and to ALTERNATE otherwise."
+  (cond-expand
+    ((and guile-2 (not guile-2.2)) subsequent)
+    (else alternate)))
+
+(define-syntax buffering-mode
+  (syntax-rules (line block none)
+    "Return the appropriate buffering mode depending on whether we're on Guile
+2.0 or later."
+    ((_ line)
+     (if-2.0 _IOLBF 'line))
+    ((_ block)
+     (if-2.0 _IOFBF 'block))
+    ((_ none)
+     (if-2.0 _IONBF 'none))))
+
 ;; Implement `call-with-escape-continuation' with `catch' and `throw'.
 ;; FIXME: Multiple return values.
 (define (call/ec proc)
@@ -206,8 +225,8 @@ output port, and PROC's result is returned."
 
   (bindtextdomain %gettext-domain %localedir)
   (textdomain %gettext-domain)
-  (setvbuf (current-output-port) _IOLBF)
-  (setvbuf (current-error-port) _IOLBF))
+  (setvbuf (current-output-port) (buffering-mode line))
+  (setvbuf (current-error-port) (buffering-mode line)))
 
 ;; Localized version of STR.
 (define l10n gettext)
diff --git a/tests/misbehaved-client.sh b/tests/misbehaved-client.sh
index edacc45..7c55e06 100644
--- a/tests/misbehaved-client.sh
+++ b/tests/misbehaved-client.sh
@@ -1,5 +1,5 @@
 # GNU Shepherd --- Make sure shepherd tolerates misbehaved clients.
-# Copyright © 2016 Ludovic Courtès <address@hidden>
+# Copyright © 2016, 2018 Ludovic Courtès <address@hidden>
 #
 # This file is part of the GNU Shepherd.
 #
@@ -65,10 +65,10 @@ $herd status                        # still here?
 $herd status                   # still here?
 
 "$GUILE" -c "
-(use-modules (shepherd comm))
+(use-modules (shepherd comm) (shepherd support))
 
 (let ((sock (open-connection \"$socket\")))
-  (setvbuf sock _IOFBF 5000)
+  (setvbuf sock (buffering-mode block) 5000)
   (write-command (shepherd-command 'status 'root) sock)
 
   ;; Close prematurely, right after sending the command.