packages.scm: Add (with-services-from-args ...)

1 files changed, 40 insertions, 0 deletions

diff --git a/src/org/euandre/packages.scm b/src/org/euandre/packages.scm
index 50db25c..c5e8287 100644
--- a/src/org/euandre/packages.scm
+++ b/src/org/euandre/packages.scm
@@ -843,6 +843,46 @@ It includes:
 The default configuration should provide sane values for all of these."
        name))))
 
+(define-public (without-shepherd-services lst)
+  (filter (lambda (extension)
+            (not (eq? shepherd-root-service-type
+                      (service-extension-target extension))))
+          lst))
+
+(define-public (replacing-shepherd-services service fn)
+  (service-type
+    (inherit service)
+    (extensions
+      (append
+       (without-shepherd-services
+        (service-type-extensions service))
+       (list
+        (service-extension shepherd-root-service-type
+                           fn))))))
+
+(define-public (with-services-from-args service config-type args)
+  (replacing-shepherd-services
+   service
+   (lambda (config)
+     (m:match config
+       (($ config-type _name _package user group log-file data-directory)
+        (map (lambda (tuple)
+               (let ((provision (s1:first  tuple))
+                     (args      (s1:second tuple)))
+                 (shepherd-service
+                   (provision provision)
+                   (requirement '(networking))
+                   (start
+                     #~(make-forkexec-constructor
+                        (list #$(cmd-for config-type config)
+                              #$@args)
+                        #:user      #$user
+                        #:group     #$group
+                        #:log-file  #$log-file
+                        #:directory #$data-directory))
+                   (stop #~(make-kill-destructor SIGKILL)))))
+             args))))))
+
 
 
 (define-public binder-service-type