From 9c9acfa593033652b236282d8e06c7e05c84eea8 Mon Sep 17 00:00:00 2001
From: EuAndreh <eu@euandre.org>
Date: Mon, 19 Aug 2024 07:14:38 -0300
Subject: system.scm: Get (pkg:with-services-from-args ...) from upstream
 packages repository

---
 src/guix/system.scm | 45 +++------------------------------------------
 1 file changed, 3 insertions(+), 42 deletions(-)

(limited to 'src')

diff --git a/src/guix/system.scm b/src/guix/system.scm
index 4f7f389..673f70c 100644
--- a/src/guix/system.scm
+++ b/src/guix/system.scm
@@ -57,48 +57,9 @@
    #;
    packages:papo.im))  ;; FIXME: move to "website" repository
 
-(define (without-shepherd-services lst)
-  (filter (lambda (extension)
-            (not (eq? shepherd-root-service-type
-                      (service-extension-target extension))))
-          lst))
-
-(define (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 (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 '())
-                   (start
-                     #~(make-forkexec-constructor
-                        (list #$(pkg:cmd-for config-type config)
-                              #$@args)
-                        #:user      #$user
-                        #:group     #$group
-                        #:log-file  #$log-file
-                        #:directory #$data-directory))
-                   (stop #~(make-kill-destructor SIGKILL)))))
-             args))))))
 
 (define binder-service-type
-  (with-services-from-args
+  (pkg:with-services-from-args
    pkg:binder-service-type
    pkg:<binder-configuration>; FIXME: /var/run/glaze/redirect/glaze.socket, etc
    '(((binder-http)  ("0.0.0.0:80"   "/var/run/glaze/redirect.socket"))
@@ -106,7 +67,7 @@
      ((binder-ircs)  ("0.0.0.0:6697" "/var/run/untls/ircs.socket")))))
 
 (define glaze-service-type
-  (with-services-from-args
+  (pkg:with-services-from-args
    pkg:glaze-service-type
    pkg:<glaze-configuration>
    '(((glaze-http)  ("-X" "/var/run/glaze/redirect.socket"))
@@ -117,7 +78,7 @@
 
 (define certs (list +cert.pem+ +privkey.pem+))
 (define untls-service-type
-  (with-services-from-args
+  (pkg:with-services-from-args
    pkg:untls-service-type
    pkg:<untls-configuration>
    `(((untls-https) (,@certs "/var/run/untls/https.socket" "/var/run/glaze/glaze.socket"))
-- 
cgit v1.2.3