me
/
guix
Archived
1
0
Fork 0
Code

vm: Make root file system type a parameter, and default to ext4. 

* gnu/system/vm.scm (qemu-image): Add #:file-system-type parameter.
  Pass it to 'initialize-hard-disk'.
* guix/build/linux-initrd.scm (mount-root-file-system): Always honor
  TYPE.
  (boot-system): Change #:root-fs-type to default to "ext4".  Update
  docstring.
* guix/build/vm.scm (initialize-hard-disk): Remove #:mkfs parameter; add
  #:file-system-type.  Adjust 'mkfs' invocation and 'mount' call to
  honor #:file-system-type.
master
Ludovic Courtès 2014-05-03 12:16:10 +02:00
parent e20fd1bf80
commit 03ddfaf5fb
3 changed files with 17 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gnu/system/vm.scm
View File

@ -188,13 +188,15 @@ made available under the /xchg CIFS share."
(system (%current-system)) (system (%current-system))
(qemu qemu-headless) (qemu qemu-headless)
(disk-image-size (* 100 (expt 2 20))) (disk-image-size (* 100 (expt 2 20)))
(file-system-type "ext4")
grub-configuration grub-configuration
(initialize-store? #f) (initialize-store? #f)
(populate #f) (populate #f)
(inputs-to-copy '())) (inputs-to-copy '()))
"Return a bootable, stand-alone QEMU image. The returned image is a full "Return a bootable, stand-alone QEMU image, with a root partition of type
disk image, with a GRUB installation that uses GRUB-CONFIGURATION as its FILE-SYSTEM-TYPE. The returned image is a full disk image, with a GRUB
configuration file (GRUB-CONFIGURATION must be the name of a file in the VM.) installation that uses GRUB-CONFIGURATION as its configuration
file (GRUB-CONFIGURATION must be the name of a file in the VM.)
INPUTS-TO-COPY is a list of inputs (as for packages) whose closure is copied INPUTS-TO-COPY is a list of inputs (as for packages) whose closure is copied
into the image being built. When INITIALIZE-STORE? is true, initialize the into the image being built. When INITIALIZE-STORE? is true, initialize the
@ -235,6 +237,7 @@ such as /etc files."
(initialize-hard-disk #:grub.cfg #$grub-configuration (initialize-hard-disk #:grub.cfg #$grub-configuration
#:closures-to-copy graphs #:closures-to-copy graphs
#:disk-image-size #$disk-image-size #:disk-image-size #$disk-image-size
#:file-system-type #$file-system-type
#:initialize-store? #$initialize-store? #:initialize-store? #$initialize-store?
#:directives '#$populate) #:directives '#$populate)
(reboot)))) (reboot))))
@ -315,7 +318,7 @@ environment with the store shared with the host."
(file-systems (list (file-system (file-systems (list (file-system
(mount-point "/") (mount-point "/")
(device "/dev/vda1") (device "/dev/vda1")
(type "ext3")) (type "ext4"))
(file-system (file-system
(mount-point (%store-prefix)) (mount-point (%store-prefix))
(device "store") (device "store")

7
guix/build/linux-initrd.scm
View File

@ -212,7 +212,7 @@ UNIONFS."
"/rw-root=RW:/real-root=RO" "/rw-root=RW:/real-root=RO"
"/root")) "/root"))
(error "unionfs failed"))) (error "unionfs failed")))
(mount root "/root" "ext3"))) (mount root "/root" type)))
(lambda args (lambda args
(format (current-error-port) "exception while mounting '~a': ~s~%" (format (current-error-port) "exception while mounting '~a': ~s~%"
root args) root args)
@ -249,7 +249,7 @@ FLAGS must be a list of symbols."
qemu-guest-networking? qemu-guest-networking?
guile-modules-in-chroot? guile-modules-in-chroot?
volatile-root? unionfs volatile-root? unionfs
(root-fs-type "ext3") (root-fs-type "ext4")
(mounts '())) (mounts '()))
"This procedure is meant to be called from an initrd. Boot a system by "This procedure is meant to be called from an initrd. Boot a system by
first loading LINUX-MODULES, then setting up QEMU guest networking if first loading LINUX-MODULES, then setting up QEMU guest networking if
@ -257,6 +257,9 @@ QEMU-GUEST-NETWORKING? is true, mounting the file systems specified in MOUNTS,
and finally booting into the new root if any. The initrd supports kernel and finally booting into the new root if any. The initrd supports kernel
command-line options '--load', '--root', and '--repl'. command-line options '--load', '--root', and '--repl'.
Mount the root file system, of type ROOT-FS-TYPE, specified by the '--root'
command-line argument, if any.
MOUNTS must be a list suitable for 'mount-file-system'. MOUNTS must be a list suitable for 'mount-file-system'.
When GUILE-MODULES-IN-CHROOT? is true, make core Guile modules available in When GUILE-MODULES-IN-CHROOT? is true, make core Guile modules available in

9
guix/build/vm.scm
View File

@ -183,7 +183,7 @@ as created and modified at the Epoch."
(define* (initialize-hard-disk #:key (define* (initialize-hard-disk #:key
grub.cfg grub.cfg
disk-image-size disk-image-size
(mkfs "mkfs.ext3") (file-system-type "ext4")
initialize-store? initialize-store?
(closures-to-copy '()) (closures-to-copy '())
(directives '())) (directives '()))
@ -192,13 +192,14 @@ as created and modified at the Epoch."
(- disk-image-size (* 5 (expt 2 20)))) (- disk-image-size (* 5 (expt 2 20))))
(error "failed to create partition table")) (error "failed to create partition table"))
(display "creating ext3 partition...\n") (format #t "creating ~a partition...\n" file-system-type)
(unless (zero? (system* mkfs "-F" "/dev/sda1")) (unless (zero? (system* (string-append "mkfs." file-system-type)
"-F" "/dev/sda1"))
(error "failed to create partition")) (error "failed to create partition"))
(display "mounting partition...\n") (display "mounting partition...\n")
(mkdir "/fs") (mkdir "/fs")
(mount "/dev/sda1" "/fs" "ext3") (mount "/dev/sda1" "/fs" file-system-type)
(when (pair? closures-to-copy) (when (pair? closures-to-copy)
;; Populate the store. ;; Populate the store.