[shepherd] 03/06: system: Add 'getpgid'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit 1b3172ae1fae91614431947fa759d497dbccdd65
Author: Ludovic Courtès <address@hidden>
AuthorDate: Sat Apr 18 16:28:29 2020 +0200

    system: Add 'getpgid'.
    
    * modules/shepherd/system.scm.in (getpgid): New procedure.
---
 modules/shepherd/system.scm.in | 17 +++++++++++++++--
 1 file changed, 15 insertions(+), 2 deletions(-)

diff --git a/modules/shepherd/system.scm.in b/modules/shepherd/system.scm.in
index 0b2cc9d..c715231 100644
--- a/modules/shepherd/system.scm.in
+++ b/modules/shepherd/system.scm.in
@@ -1,5 +1,5 @@
 ;; system.scm -- Low-level operating system interface.
-;; Copyright (C) 2013, 2014, 2016, 2018 Ludovic Courtès <address@hidden>
+;; Copyright (C) 2013, 2014, 2016, 2018, 2020 Ludovic Courtès <address@hidden>
 ;; Copyright (C) 2018 Carlo Zancanaro <address@hidden>
 ;; Copyright (C) 2020 Jan (janneke) Nieuwenhuizen <address@hidden>
 ;;
@@ -28,7 +28,8 @@
             power-off
             max-file-descriptors
             prctl
-            PR_SET_CHILD_SUBREAPER))
+            PR_SET_CHILD_SUBREAPER
+            getpgid))
 
 ;; The <sys/reboot.h> constants.
 (define RB_AUTOBOOT @RB_AUTOBOOT@)
@@ -164,3 +165,15 @@ ctrlaltdel(8) and see kernel/reboot.c in Linux."
 (define (max-file-descriptors)
   "Return the maximum number of open file descriptors allowed."
   (sysconf _SC_OPEN_MAX))
+
+(define getpgid
+  ;; Guile 3.0.2 and 2.2.7 lack 'getpgid'.
+  (let ((proc (syscall->procedure int "getpgid" (list int))))
+    (lambda (pid)
+      "Return the process group ID for process PID."
+      (let-values (((result err) (proc pid)))
+        (if (= 1 result)
+            (throw 'system-error "getpgid" "~A"
+                   (list (strerror err))
+                   (list err))
+            result)))))