[shepherd] 02/04: system: Add 'with-blocked-signals'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit ec3631115f8ef070c939f392bb316ad44360a83c
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sat May 30 19:28:35 2020 +0200

    system: Add 'with-blocked-signals'.
    
    * configure.ac: Compute and substitute 'SIG_SETMASK'.
    * modules/shepherd/system.scm.in (SIG_SETMASK): New variable.
    (set-blocked-signals, call-with-blocked-signals): New procedures.
    (with-blocked-signals): New macro.
---
 .dir-locals.el                 |  4 +++-
 configure.ac                   |  2 ++
 modules/shepherd/system.scm.in | 21 +++++++++++++++++++++
 3 files changed, 26 insertions(+), 1 deletion(-)

diff --git a/.dir-locals.el b/.dir-locals.el
index 8361cb6..3e64a3e 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -9,6 +9,8 @@
      (bug-reference-url-format . "http://bugs.gnu.org/%s";)
      (bug-reference-bug-regexp
       . "<https?://\\(debbugs\\|bugs\\)\\.gnu\\.org/\\([0-9]+\\)>")))
- (scheme-mode     . ((indent-tabs-mode . nil)))
+ (scheme-mode
+  . ((indent-tabs-mode . nil)
+     (eval . (put 'with-blocked-signals 'scheme-indent-function 1))))
  (texinfo-mode    . ((indent-tabs-mode . nil)
                      (fill-column . 72))))
diff --git a/configure.ac b/configure.ac
index 052a826..6c2c7b3 100644
--- a/configure.ac
+++ b/configure.ac
@@ -95,6 +95,7 @@ AC_MSG_CHECKING([<sys/signalfd.h> and <sys/signal.h> 
constants])
 AC_COMPUTE_INT([SFD_CLOEXEC], [SFD_CLOEXEC], [#include <sys/signalfd.h>])
 AC_COMPUTE_INT([SIG_BLOCK], [SIG_BLOCK], [#include <sys/signal.h>])
 AC_COMPUTE_INT([SIG_UNBLOCK], [SIG_UNBLOCK], [#include <sys/signal.h>])
+AC_COMPUTE_INT([SIG_SETMASK], [SIG_SETMASK], [#include <sys/signal.h>])
 AC_MSG_RESULT([done])
 
 SIZEOF_STRUCT_SIGNALFD_SIGINFO="$ac_cv_sizeof_struct_signalfd_siginfo"
@@ -104,6 +105,7 @@ AC_SUBST([SIZEOF_SIGSET_T])
 AC_SUBST([SFD_CLOEXEC])
 AC_SUBST([SIG_BLOCK])
 AC_SUBST([SIG_UNBLOCK])
+AC_SUBST([SIG_SETMASK])
 
 AC_MSG_CHECKING([whether to build crash handler])
 case "$host_os" in
diff --git a/modules/shepherd/system.scm.in b/modules/shepherd/system.scm.in
index 9c55c69..d606573 100644
--- a/modules/shepherd/system.scm.in
+++ b/modules/shepherd/system.scm.in
@@ -37,6 +37,8 @@
             consume-signalfd-siginfo
             block-signals
             unblock-signals
+            set-blocked-signals
+            with-blocked-signals
             without-automatic-finalization))
 
 ;; The <sys/reboot.h> constants.
@@ -200,6 +202,7 @@ number of the signal received."
 
 (define SIG_BLOCK @SIG_BLOCK@)
 (define SIG_UNBLOCK @SIG_UNBLOCK@)
+(define SIG_SETMASK @SIG_SETMASK@)
 
 (define sigprocmask
   (let ((proc (syscall->procedure int "pthread_sigmask" `(,int * *))))
@@ -225,6 +228,24 @@ set of blocked signals as a list of SIG* values."
   "Unblock SIGNALS, a list of SIG* values, in the current thread."
   (sigprocmask SIG_UNBLOCK signals))
 
+(define (set-blocked-signals signals)
+  "Block exactly the signals listed in SIGNALS, a list of SIG* values, in the
+current thread."
+  (sigprocmask SIG_SETMASK signals))
+
+(define (call-with-blocked-signals signals thunk)
+  (let ((previous-set #f))
+    (dynamic-wind
+      (lambda ()
+        (set! previous-set (block-signals signals)))
+      thunk
+      (lambda ()
+        (set-blocked-signals previous-set)))))
+
+(define-syntax-rule (with-blocked-signals signals exp ...)
+  "Evaluate EXP... in a context where SIGNALS are blocked."
+  (call-with-blocked-signals signals (lambda () exp ...)))
+
 
 ;;;
 ;;; Guile shenanigans.