me
/
guix
Archived
1
0
Fork 0

services: Add 'gc-root-service-type'.

* gnu/services.scm (gc-roots->system-entry): New procedure.
(gc-root-service-type): New variable.
master
Ludovic Courtès 2016-06-19 21:29:01 +02:00
parent 3ebba94d45
commit e0b47290a7
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 28 additions and 0 deletions

View File

@ -73,6 +73,7 @@
setuid-program-service-type setuid-program-service-type
profile-service-type profile-service-type
firmware-service-type firmware-service-type
gc-root-service-type
%boot-service %boot-service
%activation-service %activation-service
@ -489,6 +490,33 @@ kernel."
(compose concatenate) (compose concatenate)
(extend append))) (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. ;;; Service folding.