diff options
| -rw-r--r-- | src/org/euandre/packages.scm | 40 | ||||
| -rw-r--r-- | tests/internet/system.scm | 10 |
2 files changed, 49 insertions, 1 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 diff --git a/tests/internet/system.scm b/tests/internet/system.scm index 453f3fa..0173ddf 100644 --- a/tests/internet/system.scm +++ b/tests/internet/system.scm @@ -19,6 +19,14 @@ `(("user1" "I'm a user" ()) ("another" "Description" ("wheel") ,(path "tests/internet/key.txt")))) +(define glaze-service-type + (pkg:with-services-from-args + pkg:glaze-service-type + pkg:<glaze-configuration> + '(((glaze-http) ("-X" "/var/run/glaze/redirect.socket")) + ((glaze-https) ("-P/*:/var/lib/glaze" "/var/run/glaze/glaze.socket"))))) + + (operating-system (host-name "a-internet-test-host") (skeletons pkg:skeletons) @@ -30,7 +38,7 @@ (service dhcp-client-service-type) (service fail2ban-service-type) (service pkg:binder-service-type) - (service pkg:glaze-service-type) + (service glaze-service-type) (service pkg:untls-service-type) (service pkg:wscat-service-type) (service pkg:papod-service-type) |