;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
-;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
+;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;;
linux initrd
make-disk-image?
single-file-output?
+ target-arm32?
(disk-image-size (* 100 (expt 2 20)))
(disk-image-format "qcow2")
(references-graphs '()))
REFERENCES-GRAPHS can specify a list of reference-graph files as produced by
the #:references-graphs parameter of 'derivation'."
+
+ (define arch-specific-flags
+ `(;; On ARM, a machine has to be specified. Use "virt" machine to avoid
+ ;; hardware limits imposed by other machines.
+ ,@(if target-arm32? '("-M" "virt") '())
+
+ ;; Only enable kvm if we see /dev/kvm exists. This allows users without
+ ;; hardware virtualization to still use these commands. KVM support is
+ ;; still buggy on some ARM32 boards. Do not use it even if available.
+ ,@(if (and (file-exists? "/dev/kvm")
+ (not target-arm32?))
+ '("-enable-kvm")
+ '())
+ "-append"
+ ;; The serial port name differs between emulated architectures/machines.
+ ,@(if target-arm32?
+ `(,(string-append "console=ttyAMA0 --load=" builder))
+ `(,(string-append "console=ttyS0 --load=" builder)))
+ ;; NIC is not supported on ARM "virt" machine, so use a user mode
+ ;; network stack instead.
+ ,@(if target-arm32?
+ '("-device" "virtio-net-pci,netdev=mynet"
+ "-netdev" "user,id=mynet")
+ '("-net" "nic,model=virtio"))))
+
(when make-disk-image?
(format #t "creating ~a image of ~,2f MiB...~%"
disk-image-format (/ disk-image-size (expt 2 20)))
(force-output)
- (unless (zero? (system* "qemu-img" "create" "-f" disk-image-format
- output
- (number->string disk-image-size)))
- (error "qemu-img failed")))
+ (invoke "qemu-img" "create" "-f" disk-image-format output
+ (number->string disk-image-size)))
(mkdir "xchg")
graph-files))
(_ #f))
- (unless (zero?
- (apply system* qemu "-nographic" "-no-reboot"
- "-m" (number->string memory-size)
- "-net" "nic,model=virtio"
- "-virtfs"
- (string-append "local,id=store_dev,path="
- (%store-directory)
- ",security_model=none,mount_tag=store")
- "-virtfs"
- (string-append "local,id=xchg_dev,path=xchg"
- ",security_model=none,mount_tag=xchg")
- "-kernel" linux
- "-initrd" initrd
- "-append" (string-append "console=ttyS0 --load="
- builder)
- (append
- (if make-disk-image?
- `("-drive" ,(string-append "file=" output
- ",if=virtio"))
- '())
- ;; Only enable kvm if we see /dev/kvm exists.
- ;; This allows users without hardware virtualization to still
- ;; use these commands.
- (if (file-exists? "/dev/kvm")
- '("-enable-kvm")
- '()))))
- (error "qemu failed" qemu))
+ (apply invoke qemu "-nographic" "-no-reboot"
+ "-m" (number->string memory-size)
+ "-object" "rng-random,filename=/dev/urandom,id=guixsd-vm-rng"
+ "-device" "virtio-rng-pci,rng=guixsd-vm-rng"
+ "-virtfs"
+ (string-append "local,id=store_dev,path="
+ (%store-directory)
+ ",security_model=none,mount_tag=store")
+ "-virtfs"
+ (string-append "local,id=xchg_dev,path=xchg"
+ ",security_model=none,mount_tag=xchg")
+ "-kernel" linux
+ "-initrd" initrd
+ (append
+ (if make-disk-image?
+ `("-device" "virtio-blk,drive=myhd"
+ "-drive" ,(string-append "if=none,file=" output
+ ",format=" disk-image-format
+ ",id=myhd"))
+ '())
+ arch-specific-flags))
;; When MAKE-DISK-IMAGE? is true, the image is in OUTPUT already.
(unless make-disk-image?
partition-size)
partitions)
", "))
- (unless (zero? (apply system* "parted" "--script"
- device "mklabel" label-type
- (options partitions offset)))
- (error "failed to create partition table"))
+ (apply invoke "parted" "--script"
+ device "mklabel" label-type
+ (options partitions offset))
;; Set the 'device' field of each partition.
(reverse
(define* (create-ext-file-system partition type
#:key label uuid)
- "Create an ext-family filesystem of TYPE on PARTITION. If LABEL is true,
+ "Create an ext-family file system of TYPE on PARTITION. If LABEL is true,
use that as the volume name. If UUID is true, use it as the partition UUID."
(format #t "creating ~a partition...\n" type)
- (unless (zero? (apply system* (string-append "mkfs." type)
- "-F" partition
- `(,@(if label
- `("-L" ,label)
- '())
- ,@(if uuid
- `("-U" ,(uuid->string uuid))
- '()))))
- (error "failed to create partition")))
+ (apply invoke (string-append "mkfs." type)
+ "-F" partition
+ `(,@(if label
+ `("-L" ,label)
+ '())
+ ,@(if uuid
+ `("-U" ,(uuid->string uuid))
+ '()))))
(define* (create-fat-file-system partition
#:key label uuid)
- "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
+ "Create a FAT file system on PARTITION. The number of File Allocation Tables
+will be determined based on file system size. If LABEL is true, use that as the
volume name."
;; FIXME: UUID is ignored!
(format #t "creating FAT partition...\n")
- (unless (zero? (apply system* "mkfs.fat" partition
- (if label
- `("-n" ,label)
- '())))
- (error "failed to create FAT partition")))
+ (apply invoke "mkfs.fat" partition
+ (if label `("-n" ,label) '())))
(define* (format-partition partition type
#:key label uuid)
(setenv "TMPDIR" esp)
(mkdir-p efi-directory)
- (unless (zero? (system* grub-mkstandalone "-O" (car efi-targets)
- "-o" (string-append efi-directory "/"
- (cdr efi-targets))
- ;; Graft the configuration file onto the image.
- (string-append "boot/grub/grub.cfg=" config-file)))
- (error "failed to create GRUB EFI image"))))
+ (invoke grub-mkstandalone "-O" (car efi-targets)
+ "-o" (string-append efi-directory "/"
+ (cdr efi-targets))
+ ;; Graft the configuration file onto the image.
+ (string-append "boot/grub/grub.cfg=" config-file))))
(define* (make-iso9660-image grub config-file os-drv target
#:key (volume-id "GuixSD_image") (volume-uuid #f)
GRUB configuration and OS-DRV as the stuff in it."
(let ((grub-mkrescue (string-append grub "/bin/grub-mkrescue"))
(target-store (string-append "/tmp/root" (%store-directory))))
- (mkdir-p "/tmp/root/var/run")
- (mkdir-p "/tmp/root/run")
- (mkdir-p "/tmp/root/mnt")
+ (populate-root-file-system os-drv "/tmp/root")
- (mkdir-p target-store)
(mount (%store-directory) target-store "" MS_BIND)
(when register-closures?
#:deduplicate? #f))
closures))
- (unless (zero? (apply system*
- `(,grub-mkrescue "-o" ,target
+ (apply invoke
+ `(,grub-mkrescue "-o" ,target
,(string-append "boot/grub/grub.cfg=" config-file)
,(string-append "gnu/store=" os-drv "/..")
+ "etc=/tmp/root/etc"
"var=/tmp/root/var"
"run=/tmp/root/run"
;; /mnt is used as part of the installation
;; process, as the mount point for the target
- ;; filesystem, so create it.
+ ;; file system, so create it.
"mnt=/tmp/root/mnt"
"--"
"-volid" ,(string-upcase volume-id)
(not (char=? #\- value)))
(iso9660-uuid->string
volume-uuid)))
- `()))))
- (error "failed to create ISO9660 image"))))
+ `())))))
(define* (initialize-hard-disk device
#:key
HCoop / jackhill / guix / guix.git / blobdiff