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.
This commit is contained in:
Mathieu Othacehe 2020-08-12 12:16:24 +02:00
parent 573489fbcd
commit 22827396ba
No known key found for this signature in database
GPG key ID: 8354763531769CA6
2 changed files with 55 additions and 41 deletions

View file

@ -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 @@ (define-module (gnu build install)
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 @@ (define (symlink* old new)
(_
#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

View file

@ -175,39 +175,6 @@ (define %backing-directory
;; 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 @@ (define cow-store-service-type
;; 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