From 9c9acfa593033652b236282d8e06c7e05c84eea8 Mon Sep 17 00:00:00 2001 From: EuAndreh 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:; 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-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-https) (,@certs "/var/run/untls/https.socket" "/var/run/glaze/glaze.socket")) -- cgit v1.2.3