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 @@ the image." | |||
|           (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 @@ The data at PORT is the format produced by #:references-graphs." | |||
|   "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 @@ REFERENCE-GRAPHS, a list of reference-graph files." | |||
| 
 | ||||
| (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 @@ REFERENCE-GRAPHS, a list of reference-graph files." | |||
|                                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 @@ further populate the partition." | |||
|   (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 @@ further populate the partition." | |||
|   (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 | ||||
|  |  | |||
		Reference in a new issue