~ruther/guix-local

03119da21172c0c969b23596bec72b8383f7584e — Marius Bakke 8 years ago fd5a30a
vm: Support creating FAT partitions.

* gnu/build/vm.scm (create-ext-file-system, create-fat-file-system): New procedures.
(format-partition): Use them. Error for unknown file systems.
* gnu/system/vm.scm (qemu-image): Include DOSFSTOOLS.
* gnu/system/linux-initrd.scm (base-initrd): Always add nls_is8859-1.ko.
3 files changed, 28 insertions(+), 8 deletions(-)

M gnu/build/vm.scm
M gnu/system/linux-initrd.scm
M gnu/system/vm.scm
M gnu/build/vm.scm => gnu/build/vm.scm +26 -4
@@ 213,10 213,10 @@ actual /dev name based on DEVICE."

(define MS_BIND 4096)                             ; <sys/mounts.h> again!

(define* (format-partition partition type
                           #:key label)
  "Create a file system TYPE on PARTITION.  If LABEL is true, use that as the
volume name."
(define* (create-ext-file-system partition type
                                 #:key label)
  "Create an ext-family filesystem of TYPE on PARTITION.  If LABEL is true,
use that as the volume name."
  (format #t "creating ~a partition...\n" type)
  (unless (zero? (apply system* (string-append "mkfs." type)
                        "-F" partition


@@ 225,6 225,28 @@ volume name."
                            '())))
    (error "failed to create partition")))

(define* (create-fat-file-system partition
                                 #:key label)
  "Create a FAT filesystem on PARTITION.  The number of File Allocation Tables
will be determined based on filesystem size.  If LABEL is true, use that as the
volume name."
  (format #t "creating FAT partition...\n")
  (unless (zero? (apply system* "mkfs.fat" partition
                        (if label
                            `("-n" ,label)
                            '())))
    (error "failed to create FAT 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."
  (cond ((string-prefix? "ext" type)
         (create-ext-file-system partition type #:label label))
        ((or (string-prefix? "fat" type) (string= "vfat" type))
         (create-fat-file-system partition #:label label))
        (else (error "Unsupported file system."))))

(define (initialize-partition partition)
  "Format PARTITION, a <partition> object with a non-#f 'device' field, mount
it, run its initializer, and unmount it."

M gnu/system/linux-initrd.scm => gnu/system/linux-initrd.scm +1 -3
@@ 268,6 268,7 @@ loaded at boot time in the order in which they appear."
      "usbhid" "hid-generic" "hid-apple"      ;keyboards during early boot
      "dm-crypt" "xts" "serpent_generic" "wp512" ;for encrypted root partitions
      "nvme"                                     ;for new SSD NVMe devices
      "nls_iso8859-1"                            ;for `mkfs.fat`, et.al
      ,@(if (string-match "^(x86_64|i[3-6]86)-" (%current-system))
            '("pata_acpi" "pata_atiixp"    ;for ATA controllers
              "isci")                      ;for SAS controllers like Intel C602


@@ 281,9 282,6 @@ loaded at boot time in the order in which they appear."
      ,@(if (find (file-system-type-predicate "9p") file-systems)
            virtio-9p-modules
            '())
      ,@(if (find (file-system-type-predicate "vfat") file-systems)
            '("nls_iso8859-1")
            '())
      ,@(if (find (file-system-type-predicate "btrfs") file-systems)
            '("btrfs")
            '())

M gnu/system/vm.scm => gnu/system/vm.scm +1 -1
@@ 201,7 201,7 @@ the image."
                      (guix build utils))

         (let ((inputs
                '#$(append (list qemu parted grub e2fsprogs)
                '#$(append (list qemu parted grub e2fsprogs dosfstools)
                           (map canonical-package
                                (list sed grep coreutils findutils gawk))
                           (if register-closures? (list guix) '())))