Merge branch 'master' into core-updates

4 files changed, 47 insertions, 7 deletions

diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 52f16676f5..92f040425d 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -38,6 +38,7 @@
             file-system-check?
             file-system-create-mount-point?
             file-system-dependencies
+            file-system-location
 
             file-system-type-predicate
 
@@ -101,7 +102,10 @@
   (create-mount-point? file-system-create-mount-point? ; Boolean
                        (default #f))
   (dependencies     file-system-dependencies      ; list of <file-system>
-                    (default '())))               ; or <mapped-device>
+                    (default '()))                ; or <mapped-device>
+  (location         file-system-location
+                    (default (current-source-location))
+                    (innate)))
 
 ;; Note: This module is used both on the build side and on the host side.
 ;; Arrange not to pull (guix store) and (guix config) because the latter
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 5a7aec5c87..969a89266c 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -78,6 +78,19 @@ the derivations referenced by EXP are automatically copied to the initrd."
           (use-modules (gnu build linux-initrd))
 
           (mkdir #$output)
+
+          ;; The guile used in the initrd must be present in the store, so
+          ;; that module loading works once the root is switched.
+          ;;
+          ;; To ensure that is the case, add an explicit reference to the
+          ;; guile package used in the initrd to the output.
+          ;;
+          ;; This fixes guix-patches bug #28399, "Fix mysql activation, and
+          ;; add a basic test".
+          (call-with-output-file (string-append #$ output "/references")
+            (lambda (port)
+              (simple-format port "~A\n" #$guile)))
+
           (build-initrd (string-append #$output "/initrd")
                         #:guile #$guile
                         #:init #$init
diff --git a/gnu/system/uuid.scm b/gnu/system/uuid.scm
index 6470abb8cc..e422e06a6d 100644
--- a/gnu/system/uuid.scm
+++ b/gnu/system/uuid.scm
@@ -29,6 +29,7 @@
             uuid?
             uuid-type
             uuid-bytevector
+            uuid=?
 
             bytevector->uuid
 
@@ -281,3 +282,15 @@ corresponding bytevector; otherwise return #f."
        ((_ . (? procedure? unparse)) (unparse bv))))
     (((? uuid? uuid))
      (uuid->string (uuid-bytevector uuid) (uuid-type uuid)))))
+
+(define uuid=?
+  ;; Return true if A is equal to B, comparing only the actual bits.
+  (match-lambda*
+    (((? bytevector? a) (? bytevector? b))
+     (bytevector=? a b))
+    (((? uuid? a) (? bytevector? b))
+     (bytevector=? (uuid-bytevector a) b))
+    (((? uuid? a) (? uuid? b))
+     (bytevector=? (uuid-bytevector a) (uuid-bytevector b)))
+    ((a b)
+     (uuid=? b a))))
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 78143e4f7a..273a895bef 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -304,9 +304,12 @@ the image."
                                #:register-closures? #$register-closures?
                                #:system-directory #$os-drv))
                   (root-size  #$(if (eq? 'guess disk-image-size)
-                                    #~(estimated-partition-size
-                                       (map (cut string-append "/xchg/" <>)
-                                            graphs))
+                                    #~(max
+                                       ;; Minimum 20 MiB root size
+                                       (* 20 (expt 2 20))
+                                       (estimated-partition-size
+                                        (map (cut string-append "/xchg/" <>)
+                                             graphs)))
                                     (- disk-image-size
                                        (* 50 (expt 2 20)))))
                   (partitions (list (partition
@@ -706,6 +709,8 @@ it is mostly useful when FULL-BOOT?  is true."
                     (default #f))
   (memory-size      virtual-machine-memory-size   ;integer (MiB)
                     (default 256))
+  (disk-image-size  virtual-machine-disk-image-size   ;integer (bytes)
+                    (default 'guess))
   (port-forwardings virtual-machine-port-forwardings ;list of integer pairs
                     (default '())))
 
@@ -734,12 +739,15 @@ FORWARDINGS is a list of host-port/guest-port pairs."
                                                 system target)
   ;; XXX: SYSTEM and TARGET are ignored.
   (match vm
-    (($ <virtual-machine> os qemu graphic? memory-size ())
+    (($ <virtual-machine> os qemu graphic? memory-size disk-image-size ())
      (system-qemu-image/shared-store-script os
                                             #:qemu qemu
                                             #:graphic? graphic?
-                                            #:memory-size memory-size))
-    (($ <virtual-machine> os qemu graphic? memory-size forwardings)
+                                            #:memory-size memory-size
+                                            #:disk-image-size
+                                            disk-image-size))
+    (($ <virtual-machine> os qemu graphic? memory-size disk-image-size
+                          forwardings)
      (let ((options
             `("-net" ,(string-append
                        "user,"
@@ -748,6 +756,8 @@ FORWARDINGS is a list of host-port/guest-port pairs."
                                               #:qemu qemu
                                               #:graphic? graphic?
                                               #:memory-size memory-size
+                                              #:disk-image-size
+                                              disk-image-size
                                               #:options options)))))
 
 ;;; vm.scm ends here