diff options
Diffstat (limited to 'gnu/system')
| -rw-r--r-- | gnu/system/file-systems.scm | 6 | ||||
| -rw-r--r-- | gnu/system/linux-initrd.scm | 13 | ||||
| -rw-r--r-- | gnu/system/uuid.scm | 13 | ||||
| -rw-r--r-- | gnu/system/vm.scm | 22 |
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 |