63 lines
2.3 KiB
Scheme
63 lines
2.3 KiB
Scheme
(define-module (sakura services cow)
|
|
#:use-module (gnu services shepherd)
|
|
#:use-module (guix modules)
|
|
#:use-module (gnu))
|
|
|
|
; repackage the cow store from guix since
|
|
; guix doesnt export it
|
|
; >:(
|
|
|
|
(define %backing-directory
|
|
;; Sub-directory used as the backing store for copy-on-write.
|
|
"/tmp/guix-inst")
|
|
|
|
(define cow-store-service-type
|
|
(shepherd-service-type
|
|
'cow-store
|
|
(lambda _
|
|
(define (import-module? module)
|
|
;; Since we don't use deduplication support in 'populate-store', don't
|
|
;; import (guix store deduplication) and its dependencies, which
|
|
;; includes Guile-Gcrypt.
|
|
(and (guix-module-name? module)
|
|
(not (equal? module '(guix store deduplication)))))
|
|
|
|
(shepherd-service
|
|
(requirement '(root-file-system user-processes))
|
|
(provision '(cow-store))
|
|
(documentation
|
|
"Make the store copy-on-write, with writes going to \
|
|
the given target.")
|
|
|
|
;; This is meant to be explicitly started by the user.
|
|
(auto-start? #f)
|
|
|
|
(modules `((gnu build install)
|
|
,@%default-modules))
|
|
(start
|
|
(with-imported-modules (source-module-closure
|
|
'((gnu build install))
|
|
#:select? import-module?)
|
|
#~(case-lambda
|
|
((target)
|
|
(mount-cow-store target #$%backing-directory)
|
|
target)
|
|
(else
|
|
;; Do nothing, and mark the service as stopped.
|
|
#f))))
|
|
(stop #~(lambda (target)
|
|
;; Delete the temporary directory, but leave everything
|
|
;; mounted as there may still be processes using it since
|
|
;; 'user-processes' doesn't depend on us. The 'user-file-systems'
|
|
;; service will unmount TARGET eventually.
|
|
(delete-file-recursively
|
|
(string-append target #$%backing-directory))))))
|
|
(description "Make the store copy-on-write, with writes going to \
|
|
the given target.")))
|
|
|
|
(define-public (cow-store-service)
|
|
"Return a service that makes the store copy-on-write, such that writes go to
|
|
the user's target storage device rather than on the RAM disk."
|
|
;; See <http://bugs.gnu.org/18061> for the initial report.
|
|
(service cow-store-service-type 'mooooh!))
|
|
|