mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
vm: Make the device name a parameter.
* guix/build/vm.scm (initialize-partition-table): Honor 'device' parameter. (initialize-hard-disk): Add 'device' parameter and honor it. * gnu/system/vm.scm (qemu-image): Adjust accordingly.
This commit is contained in:
parent
a54aefead6
commit
e38e18ff01
2 changed files with 13 additions and 8 deletions
|
@ -230,7 +230,8 @@ (define* (qemu-image #:key
|
|||
(let ((graphs '#$(match inputs
|
||||
(((names . _) ...)
|
||||
names))))
|
||||
(initialize-hard-disk #:grub.cfg #$grub-configuration
|
||||
(initialize-hard-disk "/dev/sda"
|
||||
#:grub.cfg #$grub-configuration
|
||||
#:closures graphs
|
||||
#:copy-closures? #$copy-inputs?
|
||||
#:register-closures? #$register-closures?
|
||||
|
|
|
@ -121,7 +121,7 @@ (define* (initialize-partition-table device
|
|||
"Create on DEVICE a partition table of type LABEL-TYPE, with a single
|
||||
partition of PARTITION-SIZE MiB. Return #t on success."
|
||||
(display "creating partition table...\n")
|
||||
(zero? (system* "parted" "/dev/sda" "mklabel" label-type
|
||||
(zero? (system* "parted" device "mklabel" label-type
|
||||
"mkpart" "primary" "ext2" "1MiB"
|
||||
(format #f "~aB" partition-size))))
|
||||
|
||||
|
@ -147,7 +147,8 @@ (define (graph-from-file file)
|
|||
|
||||
(define MS_BIND 4096) ; <sys/mounts.h> again!
|
||||
|
||||
(define* (initialize-hard-disk #:key
|
||||
(define* (initialize-hard-disk device
|
||||
#:key
|
||||
grub.cfg
|
||||
disk-image-size
|
||||
(file-system-type "ext4")
|
||||
|
@ -155,7 +156,7 @@ (define* (initialize-hard-disk #:key
|
|||
copy-closures?
|
||||
(register-closures? #t)
|
||||
(directives '()))
|
||||
"Initialize /dev/sda, a disk of DISK-IMAGE-SIZE bytes, with a
|
||||
"Initialize DEVICE, a disk of DISK-IMAGE-SIZE bytes, with a
|
||||
FILE-SYSTEM-TYPE partition, and with GRUB installed. If REGISTER-CLOSURES? is
|
||||
true, register all of CLOSURES is the partition's store. If COPY-CLOSURES? is
|
||||
true, copy all of CLOSURES to the partition. Lastly, apply DIRECTIVES to
|
||||
|
@ -166,19 +167,22 @@ (define target-directory
|
|||
(define target-store
|
||||
(string-append target-directory (%store-directory)))
|
||||
|
||||
(unless (initialize-partition-table "/dev/sda"
|
||||
(define partition
|
||||
(string-append device 1))
|
||||
|
||||
(unless (initialize-partition-table device
|
||||
#:partition-size
|
||||
(- disk-image-size (* 5 (expt 2 20))))
|
||||
(error "failed to create partition table"))
|
||||
|
||||
(format #t "creating ~a partition...\n" file-system-type)
|
||||
(unless (zero? (system* (string-append "mkfs." file-system-type)
|
||||
"-F" "/dev/sda1"))
|
||||
"-F" partition))
|
||||
(error "failed to create partition"))
|
||||
|
||||
(display "mounting partition...\n")
|
||||
(mkdir target-directory)
|
||||
(mount "/dev/sda1" target-directory file-system-type)
|
||||
(mount partition target-directory file-system-type)
|
||||
|
||||
(when copy-closures?
|
||||
;; Populate the store.
|
||||
|
@ -208,7 +212,7 @@ (define target-store
|
|||
(display "populating...\n")
|
||||
(populate-root-file-system target-directory)
|
||||
|
||||
(unless (install-grub grub.cfg "/dev/sda" target-directory)
|
||||
(unless (install-grub grub.cfg device target-directory)
|
||||
(error "failed to install GRUB"))
|
||||
|
||||
;; 'guix-register' resets timestamps and everything, so no need to do it
|
||||
|
|
Loading…
Reference in a new issue