vm: Allow a volume name to be specified for the root partition.
* guix/build/vm.scm (format-partition): Add #:label parameter, and honor it. (initialize-hard-disk): Add #:file-system-label parameter, and pass it to 'format-partition'. * gnu/system/vm.scm (qemu-image): Add #:file-system-label parameter and pass it to 'initialize-hard-disk'.
This commit is contained in:
		
							parent
							
								
									ff0bf0aca5
								
							
						
					
					
						commit
						ef9fc40dda
					
				
					 2 changed files with 25 additions and 13 deletions
				
			
		| 
						 | 
				
			
			@ -196,15 +196,17 @@ made available under the /xchg CIFS share."
 | 
			
		|||
                     (disk-image-size (* 100 (expt 2 20)))
 | 
			
		||||
                     (disk-image-format "qcow2")
 | 
			
		||||
                     (file-system-type "ext4")
 | 
			
		||||
                     file-system-label
 | 
			
		||||
                     grub-configuration
 | 
			
		||||
                     (register-closures? #t)
 | 
			
		||||
                     (inputs '())
 | 
			
		||||
                     copy-inputs?)
 | 
			
		||||
  "Return a bootable, stand-alone QEMU image of type DISK-IMAGE-FORMAT (e.g.,
 | 
			
		||||
'qcow2' or 'raw'), with a root partition of type FILE-SYSTEM-TYPE.  The
 | 
			
		||||
returned image is a full disk image, with a GRUB installation that uses
 | 
			
		||||
GRUB-CONFIGURATION as its configuration file (GRUB-CONFIGURATION must be the
 | 
			
		||||
name of a file in the VM.)
 | 
			
		||||
'qcow2' or 'raw'), with a root partition of type FILE-SYSTEM-TYPE.
 | 
			
		||||
Optionally, FILE-SYSTEM-LABEL can be specified as the volume name for the root
 | 
			
		||||
partition.  The returned image is a full disk image, with a GRUB installation
 | 
			
		||||
that uses GRUB-CONFIGURATION as its configuration file (GRUB-CONFIGURATION
 | 
			
		||||
must be the name of a file in the VM.)
 | 
			
		||||
 | 
			
		||||
INPUTS is a list of inputs (as for packages).  When COPY-INPUTS? is true, copy
 | 
			
		||||
all of INPUTS into the image being built.  When REGISTER-CLOSURES? is true,
 | 
			
		||||
| 
						 | 
				
			
			@ -243,7 +245,8 @@ the image."
 | 
			
		|||
                                  #:copy-closures? #$copy-inputs?
 | 
			
		||||
                                  #:register-closures? #$register-closures?
 | 
			
		||||
                                  #:disk-image-size #$disk-image-size
 | 
			
		||||
                                  #:file-system-type #$file-system-type)
 | 
			
		||||
                                  #:file-system-type #$file-system-type
 | 
			
		||||
                                  #:file-system-label #$file-system-label)
 | 
			
		||||
            (reboot))))
 | 
			
		||||
    #:system system
 | 
			
		||||
    #:make-disk-image? #t
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -158,10 +158,16 @@ REFERENCE-GRAPHS, a list of reference-graph files."
 | 
			
		|||
 | 
			
		||||
(define MS_BIND 4096)                             ; <sys/mounts.h> again!
 | 
			
		||||
 | 
			
		||||
(define (format-partition partition type)
 | 
			
		||||
  "Create a file system TYPE on PARTITION."
 | 
			
		||||
(define* (format-partition partition type
 | 
			
		||||
                           #:key label)
 | 
			
		||||
  "Create a file system TYPE on PARTITION.  If LABEL is true, use that as the
 | 
			
		||||
volume name."
 | 
			
		||||
  (format #t "creating ~a partition...\n" type)
 | 
			
		||||
  (unless (zero? (system* (string-append "mkfs." type) "-F" partition))
 | 
			
		||||
  (unless (zero? (apply system* (string-append "mkfs." type)
 | 
			
		||||
                        "-F" partition
 | 
			
		||||
                        (if label
 | 
			
		||||
                            `("-L" ,label)
 | 
			
		||||
                            '())))
 | 
			
		||||
    (error "failed to create partition")))
 | 
			
		||||
 | 
			
		||||
(define* (initialize-root-partition target-directory
 | 
			
		||||
| 
						 | 
				
			
			@ -204,13 +210,15 @@ REFERENCE-GRAPHS, a list of reference-graph files."
 | 
			
		|||
                               grub.cfg
 | 
			
		||||
                               disk-image-size
 | 
			
		||||
                               (file-system-type "ext4")
 | 
			
		||||
                               file-system-label
 | 
			
		||||
                               (closures '())
 | 
			
		||||
                               copy-closures?
 | 
			
		||||
                               (register-closures? #t))
 | 
			
		||||
  "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."
 | 
			
		||||
  "Initialize DEVICE, a disk of DISK-IMAGE-SIZE bytes, with a FILE-SYSTEM-TYPE
 | 
			
		||||
partition with (optionally) FILE-SYSTEM-LABEL as its volume name, 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."
 | 
			
		||||
  (define target-directory
 | 
			
		||||
    "/fs")
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -220,7 +228,8 @@ true, copy all of CLOSURES to the partition."
 | 
			
		|||
  (initialize-partition-table device
 | 
			
		||||
                              (- disk-image-size (* 5 (expt 2 20))))
 | 
			
		||||
 | 
			
		||||
  (format-partition partition file-system-type)
 | 
			
		||||
  (format-partition partition file-system-type
 | 
			
		||||
                    #:label file-system-label)
 | 
			
		||||
 | 
			
		||||
  (display "mounting partition...\n")
 | 
			
		||||
  (mkdir target-directory)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Reference in a new issue