gnu/build/vm.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
   4 ;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
   5 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
   6 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
   7 ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
   8 ;;;
   9 ;;; This file is part of GNU Guix.
  10 ;;;
  11 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  12 ;;; under the terms of the GNU General Public License as published by
  13 ;;; the Free Software Foundation; either version 3 of the License, or (at
  14 ;;; your option) any later version.
  15 ;;;
  16 ;;; GNU Guix is distributed in the hope that it will be useful, but
  17 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;;; GNU General Public License for more details.
  20 ;;;
  21 ;;; You should have received a copy of the GNU General Public License
  22 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 (define-module (gnu build vm)
  25   #:use-module (guix build utils)
  26   #:use-module (guix build store-copy)
  27   #:use-module (guix build syscalls)
  28   #:use-module (guix store database)
  29   #:use-module (gnu build linux-boot)
  30   #:use-module (gnu build install)
  31   #:use-module (gnu system uuid)
  32   #:use-module (guix records)
  33   #:use-module ((guix combinators) #:select (fold2))
  34   #:use-module (ice-9 format)
  35   #:use-module (ice-9 match)
  36   #:use-module (ice-9 regex)
  37   #:use-module (ice-9 popen)
  38   #:use-module (srfi srfi-1)
  39   #:use-module (srfi srfi-9)
  40   #:use-module (srfi srfi-19)
  41   #:use-module (srfi srfi-26)
  42   #:export (qemu-command
  43             load-in-linux-vm
  44             format-partition
  45
  46             partition
  47             partition?
  48             partition-device
  49             partition-size
  50             partition-file-system
  51             partition-label
  52             partition-flags
  53             partition-initializer
  54
  55             estimated-partition-size
  56             root-partition-initializer
  57             initialize-partition-table
  58             initialize-hard-disk
  59             make-iso9660-image))
  60
  61 ;;; Commentary:
  62 ;;;
  63 ;;; This module provides supporting code to run virtual machines and build
  64 ;;; virtual machine images using QEMU.
  65 ;;;
  66 ;;; Code:
  67
  68 (define* (qemu-command #:optional (system %host-type))
  69   "Return the default name of the QEMU command for SYSTEM."
  70   (let ((cpu (substring system 0
  71                         (string-index system #\-))))
  72     (string-append "qemu-system-"
  73                    (if (string-match "^i[3456]86$" cpu)
  74                        "i386"
  75                        cpu))))
  76
  77 (define* (load-in-linux-vm builder
  78                            #:key
  79                            output
  80                            (qemu (qemu-command)) (memory-size 512)
  81                            linux initrd
  82                            make-disk-image?
  83                            single-file-output?
  84                            target-arm32?
  85                            (disk-image-size (* 100 (expt 2 20)))
  86                            (disk-image-format "qcow2")
  87                            (references-graphs '()))
  88   "Run BUILDER, a Scheme file, into a VM running LINUX with INITRD, and copy
  89 the result to OUTPUT.  If SINGLE-FILE-OUTPUT? is true, copy a single file from
  90 /xchg to OUTPUT.  Otherwise, copy the contents of /xchg to a new directory
  91 OUTPUT.
  92
  93 When MAKE-DISK-IMAGE? is true, OUTPUT will contain a VM image of
  94 DISK-IMAGE-SIZE bytes resulting from the execution of BUILDER, which may
  95 access it via /dev/hda.
  96
  97 REFERENCES-GRAPHS can specify a list of reference-graph files as produced by
  98 the #:references-graphs parameter of 'derivation'."
  99
 100   (define arch-specific-flags
 101     `(;; On ARM, a machine has to be specified. Use "virt" machine to avoid
 102       ;; hardware limits imposed by other machines.
 103       ,@(if target-arm32? '("-M" "virt") '())
 104
 105       ;; Only enable kvm if we see /dev/kvm exists.  This allows users without
 106       ;; hardware virtualization to still use these commands.  KVM support is
 107       ;; still buggy on some ARM32 boards. Do not use it even if available.
 108       ,@(if (and (file-exists? "/dev/kvm")
 109                  (not target-arm32?))
 110             '("-enable-kvm")
 111             '())
 112
 113       ;; Pass "panic=1" so that the guest dies upon error.
 114       "-append"
 115       ,(string-append "panic=1 --load=" builder
 116
 117                       ;; The serial port name differs between emulated
 118                       ;; architectures/machines.
 119                       " console="
 120                       (if target-arm32? "ttyAMA0" "ttyS0"))
 121
 122       ;; NIC is not supported on ARM "virt" machine, so use a user mode
 123       ;; network stack instead.
 124       ,@(if target-arm32?
 125             '("-device" "virtio-net-pci,netdev=mynet"
 126               "-netdev" "user,id=mynet")
 127             '("-net" "nic,model=virtio"))))
 128
 129   (when make-disk-image?
 130     (format #t "creating ~a image of ~,2f MiB...~%"
 131             disk-image-format (/ disk-image-size (expt 2 20)))
 132     (force-output)
 133     (invoke "qemu-img" "create" "-f" disk-image-format output
 134              (number->string disk-image-size)))
 135
 136   (mkdir "xchg")
 137   (mkdir "tmp")
 138
 139   (match references-graphs
 140     ((graph-files ...)
 141      ;; Copy the reference-graph files under xchg/ so EXP can access it.
 142      (map (lambda (file)
 143             (copy-file file (string-append "xchg/" file)))
 144           graph-files))
 145     (_ #f))
 146
 147   (apply invoke qemu "-nographic" "-no-reboot"
 148          "-smp" (number->string (parallel-job-count))
 149          "-m" (number->string memory-size)
 150          "-object" "rng-random,filename=/dev/urandom,id=guixsd-vm-rng"
 151          "-device" "virtio-rng-pci,rng=guixsd-vm-rng"
 152          "-virtfs"
 153          (string-append "local,id=store_dev,path="
 154                         (%store-directory)
 155                         ",security_model=none,mount_tag=store")
 156          "-virtfs"
 157          (string-append "local,id=xchg_dev,path=xchg"
 158                         ",security_model=none,mount_tag=xchg")
 159          "-virtfs"
 160          ;; Some programs require more space in /tmp than is normally
 161          ;; available in the guest.  Accommodate such programs by sharing a
 162          ;; temporary directory.
 163          (string-append "local,id=tmp_dev,path=tmp"
 164                         ",security_model=none,mount_tag=tmp")
 165          "-kernel" linux
 166          "-initrd" initrd
 167          (append
 168           (if make-disk-image?
 169               `("-device" "virtio-blk,drive=myhd"
 170                 "-drive" ,(string-append "if=none,file=" output
 171                                          ",format=" disk-image-format
 172                                          ",id=myhd"))
 173               '())
 174           arch-specific-flags))
 175
 176   ;; When MAKE-DISK-IMAGE? is true, the image is in OUTPUT already.
 177   (unless make-disk-image?
 178     (if single-file-output?
 179         (let ((graph? (lambda (name stat)
 180                         (member (basename name) references-graphs))))
 181           (match (find-files "xchg" (negate graph?))
 182             ((result)
 183              (copy-file result output))
 184             (x
 185              (error "did not find a single result file" x))))
 186         (begin
 187           (mkdir output)
 188           (copy-recursively "xchg" output)))))
 189
 190 (define* (register-closure prefix closure
 191                            #:key
 192                            (deduplicate? #t) (reset-timestamps? #t)
 193                            (schema (sql-schema)))
 194   "Register CLOSURE in PREFIX, where PREFIX is the directory name of the
 195 target store and CLOSURE is the name of a file containing a reference graph as
 196 produced by #:references-graphs..  As a side effect, if RESET-TIMESTAMPS? is
 197 true, reset timestamps on store files and, if DEDUPLICATE? is true,
 198 deduplicates files common to CLOSURE and the rest of PREFIX."
 199   (let ((items (call-with-input-file closure read-reference-graph)))
 200     (register-items items
 201                     #:prefix prefix
 202                     #:deduplicate? deduplicate?
 203                     #:reset-timestamps? reset-timestamps?
 204                     #:registration-time %epoch
 205                     #:schema schema)))
 206
 207 \f
 208 ;;;
 209 ;;; Partitions.
 210 ;;;
 211
 212 (define-record-type* <partition> partition make-partition
 213   partition?
 214   (device      partition-device (default #f))
 215   (size        partition-size)
 216   (file-system partition-file-system (default "ext4"))
 217   (label       partition-label (default #f))
 218   (uuid        partition-uuid (default #f))
 219   (flags       partition-flags (default '()))
 220   (initializer partition-initializer (default (const #t))))
 221
 222 (define (estimated-partition-size graphs)
 223   "Return the estimated size of a partition that can store the store items
 224 given by GRAPHS, a list of file names produced by #:references-graphs."
 225   ;; Simply add a 25% overhead.
 226   (round (* 1.25 (closure-size graphs))))
 227
 228 (define* (initialize-partition-table device partitions
 229                                      #:key
 230                                      (label-type "msdos")
 231                                      (offset (expt 2 20)))
 232   "Create on DEVICE a partition table of type LABEL-TYPE, containing the given
 233 PARTITIONS (a list of <partition> objects), starting at OFFSET bytes.  On
 234 success, return PARTITIONS with their 'device' field changed to reflect their
 235 actual /dev name based on DEVICE."
 236   (define (partition-options part offset index)
 237     (cons* "mkpart" "primary" "ext2"
 238            (format #f "~aB" offset)
 239            (format #f "~aB" (+ offset (partition-size part)))
 240            (append-map (lambda (flag)
 241                          (list "set" (number->string index)
 242                                (symbol->string flag) "on"))
 243                        (partition-flags part))))
 244
 245   (define (options partitions offset)
 246     (let loop ((partitions partitions)
 247                (offset     offset)
 248                (index      1)
 249                (result     '()))
 250       (match partitions
 251         (()
 252          (concatenate (reverse result)))
 253         ((head tail ...)
 254          (loop tail
 255                ;; Leave one sector (512B) between partitions to placate
 256                ;; Parted.
 257                (+ offset 512 (partition-size head))
 258                (+ 1 index)
 259                (cons (partition-options head offset index)
 260                      result))))))
 261
 262   (format #t "creating partition table with ~a partitions (~a)...\n"
 263           (length partitions)
 264           (string-join (map (compose (cut string-append <> " MiB")
 265                                      number->string
 266                                      (lambda (size)
 267                                        (round (/ size (expt 2. 20))))
 268                                      partition-size)
 269                             partitions)
 270                        ", "))
 271   (apply invoke "parted" "--script"
 272          device "mklabel" label-type
 273          (options partitions offset))
 274
 275   ;; Set the 'device' field of each partition.
 276   (reverse
 277    (fold2 (lambda (part result index)
 278             (values (cons  (partition
 279                             (inherit part)
 280                             (device (string-append device
 281                                                    (number->string index))))
 282                            result)
 283                     (+ 1 index)))
 284           '()
 285           1
 286           partitions)))
 287
 288 (define MS_BIND 4096)                             ; <sys/mounts.h> again!
 289
 290 (define* (create-ext-file-system partition type
 291                                  #:key label uuid)
 292   "Create an ext-family file system of TYPE on PARTITION.  If LABEL is true,
 293 use that as the volume name.  If UUID is true, use it as the partition UUID."
 294   (format #t "creating ~a partition... ~@[label: ~s~] ~@[uuid: ~s~]\n"
 295           type label (and uuid (uuid->string uuid)))
 296   (apply invoke (string-append "mkfs." type)
 297          "-F" partition
 298          `(,@(if label
 299                  `("-L" ,label)
 300                  '())
 301            ,@(if uuid
 302                  `("-U" ,(uuid->string uuid))
 303                  '()))))
 304
 305 (define* (create-fat-file-system partition
 306                                  #:key label uuid)
 307   "Create a FAT file system on PARTITION.  The number of File Allocation Tables
 308 will be determined based on file system size.  If LABEL is true, use that as the
 309 volume name."
 310   ;; FIXME: UUID is ignored!
 311   (format #t "creating FAT partition...\n")
 312   (apply invoke "mkfs.fat" partition
 313          (if label `("-n" ,label) '())))
 314
 315 (define* (format-partition partition type
 316                            #:key label uuid)
 317   "Create a file system TYPE on PARTITION.  If LABEL is true, use that as the
 318 volume name."
 319   (cond ((string-prefix? "ext" type)
 320          (create-ext-file-system partition type #:label label #:uuid uuid))
 321         ((or (string-prefix? "fat" type) (string= "vfat" type))
 322          (create-fat-file-system partition #:label label #:uuid uuid))
 323         (else (error "Unsupported file system."))))
 324
 325 (define (initialize-partition partition)
 326   "Format PARTITION, a <partition> object with a non-#f 'device' field, mount
 327 it, run its initializer, and unmount it."
 328   (let ((target "/fs"))
 329    (format-partition (partition-device partition)
 330                      (partition-file-system partition)
 331                      #:label (partition-label partition)
 332                      #:uuid (partition-uuid partition))
 333    (mkdir-p target)
 334    (mount (partition-device partition) target
 335           (partition-file-system partition))
 336
 337    ((partition-initializer partition) target)
 338
 339    (umount target)
 340    partition))
 341
 342 (define* (root-partition-initializer #:key (closures '())
 343                                      copy-closures?
 344                                      (register-closures? #t)
 345                                      system-directory
 346                                      (deduplicate? #t))
 347   "Return a procedure to initialize a root partition.
 348
 349 If REGISTER-CLOSURES? is true, register all of CLOSURES in the partition's
 350 store.  If DEDUPLICATE? is true, then also deduplicate files common to
 351 CLOSURES and the rest of the store when registering the closures.  If
 352 COPY-CLOSURES? is true, copy all of CLOSURES to the partition.
 353 SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
 354   (lambda (target)
 355     (define target-store
 356       (string-append target (%store-directory)))
 357
 358     (when copy-closures?
 359       ;; Populate the store.
 360       (populate-store (map (cut string-append "/xchg/" <>) closures)
 361                       target))
 362
 363     ;; Populate /dev.
 364     (make-essential-device-nodes #:root target)
 365
 366     ;; Optionally, register the inputs in the image's store.
 367     (when register-closures?
 368       (unless copy-closures?
 369         ;; XXX: 'register-closure' wants to palpate the things it registers, so
 370         ;; bind-mount the store on the target.
 371         (mkdir-p target-store)
 372         (mount (%store-directory) target-store "" MS_BIND))
 373
 374       (display "registering closures...\n")
 375       (for-each (lambda (closure)
 376                   (register-closure target
 377                                     (string-append "/xchg/" closure)
 378                                     #:reset-timestamps? copy-closures?
 379                                     #:deduplicate? deduplicate?))
 380                 closures)
 381       (unless copy-closures?
 382         (umount target-store)))
 383
 384     ;; Add the non-store directories and files.
 385     (display "populating...\n")
 386     (populate-root-file-system system-directory target)
 387
 388     ;; 'register-closure' resets timestamps and everything, so no need to do it
 389     ;; once more in that case.
 390     (unless register-closures?
 391       (reset-timestamps target))))
 392
 393 (define (register-bootcfg-root target bootcfg)
 394   "On file system TARGET, register BOOTCFG as a GC root."
 395   (let ((directory (string-append target "/var/guix/gcroots")))
 396     (mkdir-p directory)
 397     (symlink bootcfg (string-append directory "/bootcfg"))))
 398
 399 (define (install-efi grub esp config-file)
 400   "Write a self-contained GRUB EFI loader to the mounted ESP using CONFIG-FILE."
 401   (let* ((system %host-type)
 402          ;; Hard code the output location to a well-known path recognized by
 403          ;; compliant firmware. See "3.5.1.1 Removable Media Boot Behaviour":
 404          ;; http://www.uefi.org/sites/default/files/resources/UEFI%20Spec%202_6.pdf
 405          (grub-mkstandalone (string-append grub "/bin/grub-mkstandalone"))
 406          (efi-directory (string-append esp "/EFI/BOOT"))
 407          ;; Map grub target names to boot file names.
 408          (efi-targets (cond ((string-prefix? "x86_64" system)
 409                              '("x86_64-efi" . "BOOTX64.EFI"))
 410                             ((string-prefix? "i686" system)
 411                              '("i386-efi" . "BOOTIA32.EFI"))
 412                             ((string-prefix? "armhf" system)
 413                              '("arm-efi" . "BOOTARM.EFI"))
 414                             ((string-prefix? "aarch64" system)
 415                              '("arm64-efi" . "BOOTAA64.EFI")))))
 416     ;; grub-mkstandalone requires a TMPDIR to prepare the firmware image.
 417     (setenv "TMPDIR" esp)
 418
 419     (mkdir-p efi-directory)
 420     (invoke grub-mkstandalone "-O" (car efi-targets)
 421             "-o" (string-append efi-directory "/"
 422                                 (cdr efi-targets))
 423             ;; Graft the configuration file onto the image.
 424             (string-append "boot/grub/grub.cfg=" config-file))))
 425
 426 (define* (make-iso9660-image xorriso grub-mkrescue-environment
 427                              grub config-file os-drv target
 428                              #:key (volume-id "Guix_image") (volume-uuid #f)
 429                              register-closures? (closures '()))
 430   "Given a GRUB package, creates an iso image as TARGET, using CONFIG-FILE as
 431 GRUB configuration and OS-DRV as the stuff in it."
 432   (define grub-mkrescue
 433     (string-append grub "/bin/grub-mkrescue"))
 434
 435   (define grub-mkrescue-sed.sh
 436     (string-append xorriso "/bin/grub-mkrescue-sed.sh"))
 437
 438   (define target-store
 439     (string-append "/tmp/root" (%store-directory)))
 440
 441   (define items
 442     ;; The store items to add to the image.
 443     (delete-duplicates
 444      (append-map (lambda (closure)
 445                    (map store-info-item
 446                         (call-with-input-file (string-append "/xchg/" closure)
 447                           read-reference-graph)))
 448                  closures)))
 449
 450   (populate-root-file-system os-drv "/tmp/root")
 451   (mount (%store-directory) target-store "" MS_BIND)
 452
 453   (when register-closures?
 454     (display "registering closures...\n")
 455     (for-each (lambda (closure)
 456                 (register-closure
 457                  "/tmp/root"
 458                  (string-append "/xchg/" closure)
 459
 460                  ;; TARGET-STORE is a read-only bind-mount so we shouldn't try
 461                  ;; to modify it.
 462                  #:deduplicate? #f
 463                  #:reset-timestamps? #f))
 464               closures)
 465     (register-bootcfg-root "/tmp/root" config-file))
 466
 467   ;; 'grub-mkrescue' calls out to mtools programs to create 'efi.img', a FAT
 468   ;; file system image, and mtools honors SOURCE_DATE_EPOCH for the mtime of
 469   ;; those files.  The epoch for FAT is Jan. 1st 1980, not 1970, so choose
 470   ;; that.
 471   (setenv "SOURCE_DATE_EPOCH"
 472           (number->string
 473            (time-second
 474             (date->time-utc (make-date 0 0 0 0 1 1 1980 0)))))
 475
 476   ;; Our patched 'grub-mkrescue' honors this environment variable and passes
 477   ;; it to 'mformat', which makes it the serial number of 'efi.img'.  This
 478   ;; allows for deterministic builds.
 479   (setenv "GRUB_FAT_SERIAL_NUMBER"
 480           (number->string (if volume-uuid
 481
 482                               ;; On 32-bit systems the 2nd argument must be
 483                               ;; lower than 2^32.
 484                               (string-hash (iso9660-uuid->string volume-uuid)
 485                                            (- (expt 2 32) 1))
 486
 487                               #x77777777)
 488                           16))
 489
 490   (setenv "MKRESCUE_SED_MODE" "original")
 491   (setenv "MKRESCUE_SED_XORRISO" (string-append xorriso
 492                                                 "/bin/xorriso"))
 493   (setenv "MKRESCUE_SED_IN_EFI_NO_PT" "yes")
 494   (for-each (match-lambda
 495              ((name . value) (setenv name value)))
 496             grub-mkrescue-environment)
 497
 498   (let ((pipe
 499          (apply open-pipe* OPEN_WRITE
 500                 grub-mkrescue
 501                 (string-append "--xorriso=" grub-mkrescue-sed.sh)
 502                 "-o" target
 503                 (string-append "boot/grub/grub.cfg=" config-file)
 504                 "etc=/tmp/root/etc"
 505                 "var=/tmp/root/var"
 506                 "run=/tmp/root/run"
 507                 ;; /mnt is used as part of the installation
 508                 ;; process, as the mount point for the target
 509                 ;; file system, so create it.
 510                 "mnt=/tmp/root/mnt"
 511                 "-path-list" "-"
 512                 "--"
 513
 514                 ;; Set all timestamps to 1.
 515                 "-volume_date" "all_file_dates" "=1"
 516
 517                 "-volid" (string-upcase volume-id)
 518                 (if volume-uuid
 519                     `("-volume_date" "uuid"
 520                       ,(string-filter (lambda (value)
 521                                         (not (char=? #\- value)))
 522                                       (iso9660-uuid->string
 523                                        volume-uuid)))
 524                     `()))))
 525     ;; Pass lines like 'gnu/store/…-x=/gnu/store/…-x' corresponding to the
 526     ;; '-path-list -' option.
 527     (for-each (lambda (item)
 528                 (format pipe "~a=~a~%"
 529                         (string-drop item 1) item))
 530               items)
 531     (unless (zero? (close-pipe pipe))
 532       (error "oh, my! grub-mkrescue failed" grub-mkrescue))))
 533
 534 (define* (initialize-hard-disk device
 535                                #:key
 536                                bootloader-package
 537                                bootcfg
 538                                bootcfg-location
 539                                bootloader-installer
 540                                (grub-efi #f)
 541                                (partitions '()))
 542   "Initialize DEVICE as a disk containing all the <partition> objects listed
 543 in PARTITIONS, and using BOOTCFG as its bootloader configuration file.
 544
 545 Each partition is initialized by calling its 'initializer' procedure,
 546 passing it a directory name where it is mounted."
 547
 548   (define (partition-bootable? partition)
 549     "Return the first partition found with the boot flag set."
 550     (member 'boot (partition-flags partition)))
 551
 552   (define (partition-esp? partition)
 553     "Return the first EFI System Partition."
 554     (member 'esp (partition-flags partition)))
 555
 556   (let* ((partitions (initialize-partition-table device partitions))
 557          (root       (find partition-bootable? partitions))
 558          (esp        (find partition-esp? partitions))
 559          (target     "/fs"))
 560     (unless root
 561       (error "no bootable partition specified" partitions))
 562
 563     (for-each initialize-partition partitions)
 564
 565     (display "mounting root partition...\n")
 566     (mkdir-p target)
 567     (mount (partition-device root) target (partition-file-system root))
 568     (install-boot-config bootcfg bootcfg-location target)
 569     (when bootloader-installer
 570       (display "installing bootloader...\n")
 571       (bootloader-installer bootloader-package device target))
 572
 573     (when esp
 574       ;; Mount the ESP somewhere and install GRUB UEFI image.
 575       (let ((mount-point (string-append target "/boot/efi"))
 576             (grub-config (string-append target "/tmp/grub-standalone.cfg")))
 577         (display "mounting EFI system partition...\n")
 578         (mkdir-p mount-point)
 579         (mount (partition-device esp) mount-point
 580                (partition-file-system esp))
 581
 582         ;; Create a tiny configuration file telling the embedded grub
 583         ;; where to load the real thing.
 584         ;; XXX This is quite fragile, and can prevent the image from booting
 585         ;; when there's more than one volume with this label present.
 586         ;; Reproducible almost-UUIDs could reduce the risk (not eliminate it).
 587         (call-with-output-file grub-config
 588           (lambda (port)
 589             (format port
 590                     "insmod part_msdos~@
 591                     search --set=root --label Guix_image~@
 592                     configfile /boot/grub/grub.cfg~%")))
 593
 594         (display "creating EFI firmware image...")
 595         (install-efi grub-efi mount-point grub-config)
 596         (display "done.\n")
 597
 598         (delete-file grub-config)
 599         (umount mount-point)))
 600
 601     ;; Register BOOTCFG as a GC root.
 602     (register-bootcfg-root target bootcfg)
 603
 604     (umount target)))
 605
 606 ;;; vm.scm ends here