summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMathieu Othacehe <othacehe@gnu.org>2020-08-12 12:16:24 +0200
committerMathieu Othacehe <othacehe@gnu.org>2020-09-02 17:05:22 +0200
commit22827396baea149f193f6e9558b522e6d9c89a44 (patch)
treea7eb9dea66cd1f28fffae75bad66970f11c1db2f
parent573489fbcd68e3a89cc5c9c66693d3689b1b88bf (diff)
install: Factorize cow-store procedure.
Move the cow-store procedure from the service declaration in (gnu system install) to (gnu build install), so that it can be called from within a different context than Shepherd. * gnu/build/install.scm (mount-cow-store, unmount-cow-store): New procedures. * gnu/system/install.scm (make-cow-store): Remove it, (cow-store-service-type): adapt it accordingly.
-rw-r--r--gnu/build/install.scm44
-rw-r--r--gnu/system/install.scm52
2 files changed, 55 insertions, 41 deletions
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 87aa5d68da..63995e1d09 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -18,6 +18,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu build install)
+ #:use-module (guix build syscalls)
#:use-module (guix build utils)
#:use-module (guix build store-copy)
#:use-module (srfi srfi-26)
@@ -26,7 +27,9 @@
evaluate-populate-directive
populate-root-file-system
install-database-and-gc-roots
- populate-single-profile-directory))
+ populate-single-profile-directory
+ mount-cow-store
+ unmount-cow-store))
;;; Commentary:
;;;
@@ -229,4 +232,43 @@ This is used to create the self-contained tarballs with 'guix pack'."
(_
#t)))
+(define (mount-cow-store target backing-directory)
+ "Make the store copy-on-write, using TARGET as the backing store. This is
+useful when TARGET is on a hard disk, whereas the current store is on a RAM
+disk."
+ (define (set-store-permissions directory)
+ "Set the right perms on DIRECTORY to use it as the store."
+ (chown directory 0 30000) ;use the fixed 'guixbuild' GID
+ (chmod directory #o1775))
+
+ (let ((tmpdir (string-append target "/tmp")))
+ (mkdir-p tmpdir)
+ (mount tmpdir "/tmp" "none" MS_BIND))
+
+ (let* ((rw-dir (string-append target backing-directory))
+ (work-dir (string-append rw-dir "/../.overlayfs-workdir")))
+ (mkdir-p rw-dir)
+ (mkdir-p work-dir)
+ (mkdir-p "/.rw-store")
+ (set-store-permissions rw-dir)
+ (set-store-permissions "/.rw-store")
+
+ ;; Mount the overlay, then atomically make it the store.
+ (mount "none" "/.rw-store" "overlay" 0
+ (string-append "lowerdir=" (%store-directory) ","
+ "upperdir=" rw-dir ","
+ "workdir=" work-dir))
+ (mount "/.rw-store" (%store-directory) "" MS_MOVE)
+ (rmdir "/.rw-store")))
+
+(define (unmount-cow-store target backing-directory)
+ "Unmount copy-on-write store."
+ (let ((tmp-dir "/remove"))
+ (mkdir-p tmp-dir)
+ (mount (%store-directory) tmp-dir "" MS_MOVE)
+ (umount tmp-dir)
+ (rmdir tmp-dir)
+ (delete-file-recursively
+ (string-append target backing-directory))))
+
;;; install.scm ends here
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index a87c2f4207..be5a678cec 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -175,39 +175,6 @@ manual."
;; Sub-directory used as the backing store for copy-on-write.
"/tmp/guix-inst")
-(define (make-cow-store target)
- "Return a gexp that makes the store copy-on-write, using TARGET as the
-backing store. This is useful when TARGET is on a hard disk, whereas the
-current store is on a RAM disk."
-
- (define (set-store-permissions directory)
- ;; Set the right perms on DIRECTORY to use it as the store.
- #~(begin
- (chown #$directory 0 30000) ;use the fixed 'guixbuild' GID
- (chmod #$directory #o1775)))
-
- #~(begin
- ;; Bind-mount TARGET's /tmp in case we need space to build things.
- (let ((tmpdir (string-append #$target "/tmp")))
- (mkdir-p tmpdir)
- (mount tmpdir "/tmp" "none" MS_BIND))
-
- (let* ((rw-dir (string-append target #$%backing-directory))
- (work-dir (string-append rw-dir "/../.overlayfs-workdir")))
- (mkdir-p rw-dir)
- (mkdir-p work-dir)
- (mkdir-p "/.rw-store")
- #$(set-store-permissions #~rw-dir)
- #$(set-store-permissions "/.rw-store")
-
- ;; Mount the overlay, then atomically make it the store.
- (mount "none" "/.rw-store" "overlay" 0
- (string-append "lowerdir=" #$(%store-prefix) ","
- "upperdir=" rw-dir ","
- "workdir=" work-dir))
- (mount "/.rw-store" #$(%store-prefix) "" MS_MOVE)
- (rmdir "/.rw-store"))))
-
(define cow-store-service-type
(shepherd-service-type
'cow-store
@@ -222,13 +189,18 @@ the given target.")
;; This is meant to be explicitly started by the user.
(auto-start? #f)
- (start #~(case-lambda
- ((target)
- #$(make-cow-store #~target)
- target)
- (else
- ;; Do nothing, and mark the service as stopped.
- #f)))
+ (modules `((gnu build install)
+ ,@%default-modules))
+ (start
+ (with-imported-modules (source-module-closure
+ '((gnu build install)))
+ #~(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