aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/org/euandre/packages.scm40
-rw-r--r--tests/internet/system.scm10
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)