aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-06-19 21:29:01 +0200
committerLudovic Courtès <ludo@gnu.org>2016-06-20 00:52:53 +0200
commite0b47290a704c954d00d86e0c120fe44946f29f9 (patch)
tree1cfaa4c46d04bd0cef1b37a01efa5ef7085d403f
parent3ebba94d45e4cc9c5242f812b29c826904506b02 (diff)
downloadguix-e0b47290a704c954d00d86e0c120fe44946f29f9.tar
guix-e0b47290a704c954d00d86e0c120fe44946f29f9.tar.gz
services: Add 'gc-root-service-type'.
* gnu/services.scm (gc-roots->system-entry): New procedure. (gc-root-service-type): New variable.
-rw-r--r--gnu/services.scm28
1 files changed, 28 insertions, 0 deletions
diff --git a/gnu/services.scm b/gnu/services.scm
index 9268c51dd8..50e76df818 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -73,6 +73,7 @@
setuid-program-service-type
profile-service-type
firmware-service-type
+ gc-root-service-type
%boot-service
%activation-service
@@ -489,6 +490,33 @@ kernel."
(compose concatenate)
(extend append)))
+(define (gc-roots->system-entry roots)
+ "Return an entry in the system's output containing symlinks to ROOTS."
+ (mlet %store-monad ((entry (gexp->derivation
+ "gc-roots"
+ #~(let ((roots '#$roots))
+ (mkdir #$output)
+ (chdir #$output)
+ (for-each symlink
+ roots
+ (map number->string
+ (iota (length roots))))))))
+ (return (if (null? roots)
+ '()
+ `(("gc-roots" ,entry))))))
+
+(define gc-root-service-type
+ ;; A service to associate extra garbage-collector roots to the system. This
+ ;; is a simple hack that guarantees that the system retains references to
+ ;; the given list of roots. Roots must be "lowerable" objects like
+ ;; packages, or derivations.
+ (service-type (name 'gc-roots)
+ (extensions
+ (list (service-extension system-service-type
+ gc-roots->system-entry)))
+ (compose concatenate)
+ (extend append)))
+
;;;
;;; Service folding.