install: Add a service to back the store with the target disk.

Fixes <http://bugs.gnu.org/18061>.
Reported by Adam Pribyl <pribyl@lowlevel.cz>.

* gnu/services/dmd.scm (dmd-configuration-file)[config]: Import (guix
  build utils).
* gnu/system/install.scm (make-cow-store, cow-store-service): New
  procedures.
  (installation-services): Use it.
  (%backing-directory): New variable.
* doc/guix.texi (System Installation): Add the 'deco start cow-store
  /mnt' phase.
This commit is contained in:
Ludovic Courtès 2014-07-22 22:12:05 +02:00
parent 5383fb5bd4
commit 83a17b6236
3 changed files with 88 additions and 1 deletions

View File

@ -2799,9 +2799,18 @@ The installation image includes Parted (@pxref{Overview,,, parted, GNU
Parted User Manual}), @command{fdisk}, and e2fsprogs, the suite of tools
to manipulate ext2/ext3/ext4 file systems.
@item
Once that is done, mount the target root partition under @file{/mnt}.
@item
Lastly, run @code{deco start cow-store /mnt}.
This will make @file{/gnu/store} copy-on-write, such that packages added
to it during the installation phase will be written to the target disk
rather than kept in memory.
@end enumerate
Once that is done, mount the target root partition under @file{/mnt}.
@subsection Proceeding with the Installation

View File

@ -49,6 +49,7 @@
(use-modules (ice-9 ftw)
(guix build syscalls)
(guix build utils)
((guix build linux-initrd)
#:select (check-file-system canonicalize-device-spec)))

View File

@ -20,6 +20,7 @@
#:use-module (gnu)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module ((guix store) #:select (%store-prefix))
#:use-module (gnu packages linux)
#:use-module (gnu packages package-management)
#:use-module (gnu packages disk)
@ -42,6 +43,78 @@ manual."
"-f" (string-append #$guix "/share/info/guix.info")
"-n" "System Installation")))
(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 (unionfs read-only read-write mount-point)
;; Make MOUNT-POINT the union of READ-ONLY and READ-WRITE.
;; Note: in the command below, READ-WRITE appears before READ-ONLY so that
;; it is considered a "higher-level branch", as per unionfs-fuse(8),
;; thereby allowing files existing on READ-ONLY to be copied over to
;; READ-WRITE.
#~(fork+exec-command
(list (string-append #$unionfs-fuse "/bin/unionfs")
"-o"
"cow,allow_other,use_ino,max_files=65536,nonempty"
(string-append #$read-write "=RW:" #$read-only "=RO")
#$mount-point)))
(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
(unless (file-exists? "/.ro-store")
(mkdir "/.ro-store")
(mount #$(%store-prefix) "/.ro-store" "none"
(logior MS_BIND MS_RDONLY)))
(let ((rw-dir (string-append target #$%backing-directory)))
(mkdir-p rw-dir)
(mkdir-p "/.rw-store")
#$(set-store-permissions #~rw-dir)
#$(set-store-permissions "/.rw-store")
;; Mount the union, then atomically make it the store.
(and #$(unionfs "/.ro-store" #~rw-dir "/.rw-store")
(begin
(sleep 1) ;XXX: wait for unionfs to be ready
(mount "/.rw-store" #$(%store-prefix) "" MS_MOVE)
(rmdir "/.rw-store"))))))
(define (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.
(with-monad %store-monad
(return (service
(requirement '(root-file-system user-processes))
(provision '(cow-store))
(documentation
"Make the store copy-on-write, with writes going to \
the given target.")
(start #~(case-lambda
((target)
#$(make-cow-store #~target)
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.
(delete-file-recursively
(string-append target #$%backing-directory))))))))
(define (installation-services)
"Return the list services for the installation image."
(let ((motd (text-file "motd" "
@ -88,6 +161,10 @@ You have been warned. Thanks for being so brave.
;; Start udev so that useful device nodes are available.
(udev-service)
;; Add the 'cow-store' service, which users have to start manually
;; since it takes the installation directory as an argument.
(cow-store-service)
;; Install Unicode support and a suitable font.
(console-font-service "tty1")
(console-font-service "tty2")