[shepherd] 01/02: Add prctl syscall wrapper along with with PR_SET_CHILD_SUBREAPER.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit a0166dbf333a5a7494829b12e5424eac3e9149b8
Author: Carlo Zancanaro <address@hidden>
Date:   Sun Mar 4 07:01:30 2018 +1100

    Add prctl syscall wrapper along with with PR_SET_CHILD_SUBREAPER.
    
    * configure.ac: Detect and substitute PR_SET_CHILD_SUBREAPER.
    * modules/shepherd/system.scm.in (PR_SET_CHILD_SUBREAPER): Add new variable
      and export it.
      (prctl): Add new procedure and export it.
    
    Signed-off-by: Ludovic Courtès <address@hidden>
---
 configure.ac                   |  4 ++++
 modules/shepherd/system.scm.in | 23 ++++++++++++++++++++++-
 2 files changed, 26 insertions(+), 1 deletion(-)

diff --git a/configure.ac b/configure.ac
index bb5058d..fbe16f4 100644
--- a/configure.ac
+++ b/configure.ac
@@ -72,7 +72,11 @@ esac
 AC_SUBST([RB_AUTOBOOT])
 AC_SUBST([RB_HALT_SYSTEM])
 AC_SUBST([RB_POWER_OFF])
+AC_MSG_RESULT([done])
 
+AC_MSG_CHECKING([<sys/prctl.h> constants])
+AC_COMPUTE_INT([PR_SET_CHILD_SUBREAPER], [PR_SET_CHILD_SUBREAPER], [#include 
<sys/prctl.h>])
+AC_SUBST([PR_SET_CHILD_SUBREAPER])
 AC_MSG_RESULT([done])
 
 dnl Manual pages.
diff --git a/modules/shepherd/system.scm.in b/modules/shepherd/system.scm.in
index a54dca7..79fff47 100644
--- a/modules/shepherd/system.scm.in
+++ b/modules/shepherd/system.scm.in
@@ -1,5 +1,6 @@
 ;; system.scm -- Low-level operating system interface.
 ;; Copyright (C) 2013, 2014, 2016 Ludovic Courtès <address@hidden>
+;; Copyright (C) 2018 Carlo Zancanaro <address@hidden>
 ;;
 ;; This file is part of the GNU Shepherd.
 ;;
@@ -23,7 +24,9 @@
   #:export (reboot
             halt
             power-off
-            max-file-descriptors))
+            max-file-descriptors
+            prctl
+            PR_SET_CHILD_SUBREAPER))
 
 ;; The <sys/reboot.h> constants.
 (define RB_AUTOBOOT @RB_AUTOBOOT@)
@@ -130,6 +133,24 @@ the returned procedure is called."
                    (list err))
             result)))))
 
+(define PR_SET_CHILD_SUBREAPER @PR_SET_CHILD_SUBREAPER@)
+
+(define prctl
+  (if (dynamic-func "prctl" (dynamic-link))
+      (let ((proc (syscall->procedure long "prctl" (list int int))))
+        (lambda (process operation)
+          "Perform an operation on the given process"
+          (let-values (((result err) (proc process operation)))
+            (if (= -1 result)
+                (throw 'system-error "prctl" "~A: ~S"
+                       (list (strerror err) name)
+                       (list err))
+                result))))
+      (lambda (process operation)
+        ;; Libc lacks 'prctl', as is the case on GNU/Hurd.
+        (throw 'system-error "prctl" "~A" (list strerror ENOSYS)
+               (list ENOSYS)))))
+
 (define (max-file-descriptors)
   "Return the maximum number of open file descriptors allowed."
   (sysconf _SC_OPEN_MAX))