aboutsummaryrefslogtreecommitdiff
path: root/gnu/services.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-06-27 09:30:01 +0200
committerLudovic Courtès <ludo@gnu.org>2016-06-27 09:30:01 +0200
commit01497dfe6c0a2ce69287d0fd0008747965a000df (patch)
treef7f6f53baf6e81a8bce26144c550da3bf4b9df5c /gnu/services.scm
parent74c8b174e8015de753ba5cab44f76f944e6fd4ba (diff)
downloadguix-01497dfe6c0a2ce69287d0fd0008747965a000df.tar
guix-01497dfe6c0a2ce69287d0fd0008747965a000df.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'gnu/services.scm')
-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.