diff --git a/modules/freya/services/cow.scm b/modules/freya/services/cow.scm new file mode 100644 index 0000000..e233db7 --- /dev/null +++ b/modules/freya/services/cow.scm @@ -0,0 +1,62 @@ +(define-module (freya services cow) + #:use-module (gnu services shepherd) + #:use-module (guix modules) + #:use-module (gnu)) + +; guix doesnt export the cow store +; bruch >:( + +(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 for the initial report. + (service cow-store-service-type 'mooooh!)) +