Browse Source
services: Add 'gc-root-service-type'.
* gnu/services.scm (gc-roots->system-entry): New procedure.
(gc-root-service-type): New variable.
version-0.11.0
Ludovic Courtès
6 years ago
No known key found for this signature in database
GPG Key ID: 90B11993D9AEBB5
1 changed files with
28 additions and
0 deletions
-
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. |
|
|
|