[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[shepherd] 04/08: Avoid uses of the _IO* constants on Guile >= 2.2.
From: |
Ludovic Courtès |
Subject: |
[shepherd] 04/08: Avoid uses of the _IO* constants on Guile >= 2.2. |
Date: |
Wed, 26 Sep 2018 08:57:56 -0400 (EDT) |
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.
- [shepherd] branch master updated (86b3ef0 -> ffb82c1), Ludovic Courtès, 2018/09/26
- [shepherd] 05/08: Fix bogus 'cond-expand'., Ludovic Courtès, 2018/09/26
- [shepherd] 06/08: build: Accept Guile 3.0., Ludovic Courtès, 2018/09/26
- [shepherd] 02/08: nls: Update sv translation., Ludovic Courtès, 2018/09/26
- [shepherd] 08/08: build: Bump to version 0.5.0., Ludovic Courtès, 2018/09/26
- [shepherd] 04/08: Avoid uses of the _IO* constants on Guile >= 2.2.,
Ludovic Courtès <=
- [shepherd] 03/08: nls: Update fr translation., Ludovic Courtès, 2018/09/26
- [shepherd] 07/08: Update 'NEWS'., Ludovic Courtès, 2018/09/26
- [shepherd] 01/08: nls: Update pt_BR translation., Ludovic Courtès, 2018/09/26