Merge remote-tracking branch 'origin/master' into core-updates

4 files changed, 33 insertions, 49 deletions

diff --git a/gnu/system/examples/lightweight-desktop.tmpl b/gnu/system/examples/lightweight-desktop.tmpl
index 20b122fe51..b4037d4f79 100644
--- a/gnu/system/examples/lightweight-desktop.tmpl
+++ b/gnu/system/examples/lightweight-desktop.tmpl
@@ -4,7 +4,6 @@
 
 (use-modules (gnu) (gnu system nss))
 (use-service-modules desktop)
-(use-package-modules bootloaders certs ratpoison suckless wm)
 (use-package-modules bootloaders certs ratpoison suckless wm xorg)
 
 (operating-system
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index c1a718d607..97c7021454 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -63,7 +63,8 @@
             iso9660-image
 
             find-image
-            system-image))
+            system-image
+            image-with-label))
 
 
 ;;;
@@ -266,8 +267,7 @@ used in the image."
                                        #$output
                                        image-root)))))
         (computed-file "partition.img" image-builder
-                       #:options `(#:local-build? #t ;typically large file
-                                   #:references-graphs ,inputs))))
+                       #:options `(#:references-graphs ,inputs))))
 
     (define (partition->config partition)
       ;; Return the genimage partition configuration for PARTITION.
@@ -325,8 +325,7 @@ image ~a {
                    #~(symlink
                       (string-append #$image-dir "/" #$genimage-name)
                       #$output)
-                   #:options `(#:local-build? #t ;typically large file
-                               #:substitutable? ,substitutable?))))
+                   #:options `(#:substitutable? ,substitutable?))))
 
 
 ;;
@@ -403,10 +402,23 @@ used in the image. "
                                  #:volume-id #$root-label
                                  #:volume-uuid #$root-uuid)))))
     (computed-file name builder
-                   #:options `(#:local-build? #t ;typically large file
-                               #:references-graphs ,inputs
+                   #:options `(#:references-graphs ,inputs
                                #:substitutable? ,substitutable?))))
 
+(define (image-with-label base-image label)
+  "The volume ID of an ISO is the label of the first partition.  This procedure
+returns an image record where the first partition's label is set to <label>."
+  (image
+    (inherit base-image)
+    (partitions
+      (match (image-partitions base-image)
+        ((boot others ...)
+         (cons
+           (partition
+             (inherit boot)
+             (label label))
+           others))))))
+
 
 ;;
 ;; Image creation.
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
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 861f2a427a..80a8618729 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -699,7 +699,8 @@ of the GNU system as described by OS."
        (device (file-system->mount-tag source))
        (type "9p")
        (flags (if writable? '() '(read-only)))
-       (options "trans=virtio,cache=loose")
+       (options (string-append "trans=virtio"
+                               (if writable? "" ",cache=loose")))
        (check? #f)
        (create-mount-point? #t)))))