vm: Remove obsolete procedures.
* gnu/build/vm.scm (install-efi, make-iso9660-image): Remove those procedures that are now implemented in (gnu build image) module, (initialize-hard-disk): remove efi support. * gnu/system/vm.scm (iso9660-image): Remove it, (qemu-image): adapt it to remove ISO9660 support.
This commit is contained in:
Mathieu Othacehe
parent
f19cf27c2b
commit
77f5296236
156
gnu/build/vm.scm
156
gnu/build/vm.scm
|
|
@ -57,8 +57,7 @@ (define-module (gnu build vm)
|
|||
estimated-partition-size
|
||||
root-partition-initializer
|
||||
initialize-partition-table
|
||||
initialize-hard-disk
|
||||
make-iso9660-image))
|
||||
initialize-hard-disk))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
|
|
@ -417,159 +416,6 @@ (define (register-bootcfg-root target bootcfg)
|
|||
(mkdir-p directory)
|
||||
(symlink bootcfg (string-append directory "/bootcfg"))))
|
||||
|
||||
(define (install-efi grub esp config-file)
|
||||
"Write a self-contained GRUB EFI loader to the mounted ESP using CONFIG-FILE."
|
||||
(let* ((system %host-type)
|
||||
;; Hard code the output location to a well-known path recognized by
|
||||
;; compliant firmware. See "3.5.1.1 Removable Media Boot Behaviour":
|
||||
;; http://www.uefi.org/sites/default/files/resources/UEFI%20Spec%202_6.pdf
|
||||
(grub-mkstandalone (string-append grub "/bin/grub-mkstandalone"))
|
||||
(efi-directory (string-append esp "/EFI/BOOT"))
|
||||
;; Map grub target names to boot file names.
|
||||
(efi-targets (cond ((string-prefix? "x86_64" system)
|
||||
'("x86_64-efi" . "BOOTX64.EFI"))
|
||||
((string-prefix? "i686" system)
|
||||
'("i386-efi" . "BOOTIA32.EFI"))
|
||||
((string-prefix? "armhf" system)
|
||||
'("arm-efi" . "BOOTARM.EFI"))
|
||||
((string-prefix? "aarch64" system)
|
||||
'("arm64-efi" . "BOOTAA64.EFI")))))
|
||||
;; grub-mkstandalone requires a TMPDIR to prepare the firmware image.
|
||||
(setenv "TMPDIR" esp)
|
||||
|
||||
(mkdir-p efi-directory)
|
||||
(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 xorriso grub-mkrescue-environment
|
||||
grub config-file os-drv target
|
||||
#:key (volume-id "Guix_image") (volume-uuid #f)
|
||||
register-closures? (closures '()))
|
||||
"Given a GRUB package, creates an iso image as TARGET, using CONFIG-FILE as
|
||||
GRUB configuration and OS-DRV as the stuff in it."
|
||||
(define grub-mkrescue
|
||||
(string-append grub "/bin/grub-mkrescue"))
|
||||
|
||||
(define grub-mkrescue-sed.sh
|
||||
(string-append xorriso "/bin/grub-mkrescue-sed.sh"))
|
||||
|
||||
(define target-store
|
||||
(string-append "/tmp/root" (%store-directory)))
|
||||
|
||||
(define items
|
||||
;; The store items to add to the image.
|
||||
(delete-duplicates
|
||||
(append-map (lambda (closure)
|
||||
(map store-info-item
|
||||
(call-with-input-file (string-append "/xchg/" closure)
|
||||
read-reference-graph)))
|
||||
closures)))
|
||||
|
||||
(populate-root-file-system os-drv "/tmp/root")
|
||||
(mount (%store-directory) target-store "" MS_BIND)
|
||||
|
||||
(when register-closures?
|
||||
(display "registering closures...\n")
|
||||
(for-each (lambda (closure)
|
||||
(register-closure
|
||||
"/tmp/root"
|
||||
(string-append "/xchg/" closure)
|
||||
|
||||
;; TARGET-STORE is a read-only bind-mount so we shouldn't try
|
||||
;; to modify it.
|
||||
#:deduplicate? #f
|
||||
#:reset-timestamps? #f))
|
||||
closures)
|
||||
(register-bootcfg-root "/tmp/root" config-file))
|
||||
|
||||
;; 'grub-mkrescue' calls out to mtools programs to create 'efi.img', a FAT
|
||||
;; file system image, and mtools honors SOURCE_DATE_EPOCH for the mtime of
|
||||
;; those files. The epoch for FAT is Jan. 1st 1980, not 1970, so choose
|
||||
;; that.
|
||||
(setenv "SOURCE_DATE_EPOCH"
|
||||
(number->string
|
||||
(time-second
|
||||
(date->time-utc (make-date 0 0 0 0 1 1 1980 0)))))
|
||||
|
||||
;; Our patched 'grub-mkrescue' honors this environment variable and passes
|
||||
;; it to 'mformat', which makes it the serial number of 'efi.img'. This
|
||||
;; allows for deterministic builds.
|
||||
(setenv "GRUB_FAT_SERIAL_NUMBER"
|
||||
(number->string (if volume-uuid
|
||||
|
||||
;; On 32-bit systems the 2nd argument must be
|
||||
;; lower than 2^32.
|
||||
(string-hash (iso9660-uuid->string volume-uuid)
|
||||
(- (expt 2 32) 1))
|
||||
|
||||
#x77777777)
|
||||
16))
|
||||
|
||||
(setenv "MKRESCUE_SED_MODE" "original")
|
||||
(setenv "MKRESCUE_SED_XORRISO" (string-append xorriso
|
||||
"/bin/xorriso"))
|
||||
(setenv "MKRESCUE_SED_IN_EFI_NO_PT" "yes")
|
||||
(for-each (match-lambda
|
||||
((name . value) (setenv name value)))
|
||||
grub-mkrescue-environment)
|
||||
|
||||
(let ((pipe
|
||||
(apply open-pipe* OPEN_WRITE
|
||||
grub-mkrescue
|
||||
(string-append "--xorriso=" grub-mkrescue-sed.sh)
|
||||
"-o" target
|
||||
(string-append "boot/grub/grub.cfg=" config-file)
|
||||
"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
|
||||
;; file system, so create it.
|
||||
"mnt=/tmp/root/mnt"
|
||||
"-path-list" "-"
|
||||
"--"
|
||||
|
||||
;; Set all timestamps to 1.
|
||||
"-volume_date" "all_file_dates" "=1"
|
||||
|
||||
;; ‘zisofs’ compression reduces the total image size by ~60%.
|
||||
"-zisofs" "level=9:block_size=128k" ; highest compression
|
||||
;; It's transparent to our Linux-Libre kernel but not to GRUB.
|
||||
;; Don't compress the kernel, initrd, and other files read by
|
||||
;; grub.cfg, as well as common already-compressed file names.
|
||||
"-find" "/" "-type" "f"
|
||||
;; XXX Even after "--" above, and despite documentation claiming
|
||||
;; otherwise, "-or" is stolen by grub-mkrescue which then chokes
|
||||
;; on it (as ‘-o …’) and dies. Don't use "-or".
|
||||
"-not" "-wholename" "/boot/*"
|
||||
"-not" "-wholename" "/System/*"
|
||||
"-not" "-name" "unicode.pf2"
|
||||
"-not" "-name" "bzImage"
|
||||
"-not" "-name" "*.gz" ; initrd & all man pages
|
||||
"-not" "-name" "*.png" ; includes grub-image.png
|
||||
"-exec" "set_filter" "--zisofs"
|
||||
"--"
|
||||
|
||||
"-volid" (string-upcase volume-id)
|
||||
(if volume-uuid
|
||||
`("-volume_date" "uuid"
|
||||
,(string-filter (lambda (value)
|
||||
(not (char=? #\- value)))
|
||||
(iso9660-uuid->string
|
||||
volume-uuid)))
|
||||
`()))))
|
||||
;; Pass lines like 'gnu/store/…-x=/gnu/store/…-x' corresponding to the
|
||||
;; '-path-list -' option.
|
||||
(for-each (lambda (item)
|
||||
(format pipe "~a=~a~%"
|
||||
(string-drop item 1) item))
|
||||
items)
|
||||
(unless (zero? (close-pipe pipe))
|
||||
(error "oh, my! grub-mkrescue failed" grub-mkrescue))))
|
||||
|
||||
(define* (initialize-hard-disk device
|
||||
#:key
|
||||
bootloader-package
|
||||
|
|
|
|||
|
|
@ -269,95 +269,6 @@ (define (has-guix-service-type? os)
|
|||
(eq? (service-kind service) guix-service-type))
|
||||
(operating-system-services os)))))
|
||||
|
||||
(define* (iso9660-image #:key
|
||||
(name "iso9660-image")
|
||||
file-system-label
|
||||
file-system-uuid
|
||||
(system (%current-system))
|
||||
(target (%current-target-system))
|
||||
(qemu qemu-minimal)
|
||||
os
|
||||
bootcfg-drv
|
||||
bootloader
|
||||
(register-closures? (has-guix-service-type? os))
|
||||
(inputs '())
|
||||
(grub-mkrescue-environment '())
|
||||
(substitutable? #t))
|
||||
"Return a bootable, stand-alone iso9660 image.
|
||||
|
||||
INPUTS is a list of inputs (as for packages)."
|
||||
(define schema
|
||||
(and register-closures?
|
||||
(local-file (search-path %load-path
|
||||
"guix/store/schema.sql"))))
|
||||
|
||||
(expression->derivation-in-linux-vm
|
||||
name
|
||||
(with-extensions gcrypt-sqlite3&co
|
||||
(with-imported-modules `(,@(source-module-closure '((gnu build vm)
|
||||
(guix store database)
|
||||
(guix build utils))
|
||||
#:select? not-config?)
|
||||
((guix config) => ,(make-config.scm)))
|
||||
#~(begin
|
||||
(use-modules (gnu build vm)
|
||||
(guix store database)
|
||||
(guix build utils))
|
||||
|
||||
(sql-schema #$schema)
|
||||
|
||||
;; Allow non-ASCII file names--e.g., 'nss-certs'--to be decoded.
|
||||
(setenv "GUIX_LOCPATH"
|
||||
#+(file-append glibc-utf8-locales "/lib/locale"))
|
||||
(setlocale LC_ALL "en_US.utf8")
|
||||
|
||||
(let ((inputs
|
||||
'#$(append (list parted e2fsprogs dosfstools xorriso)
|
||||
(map canonical-package
|
||||
(list sed grep coreutils findutils gawk))))
|
||||
|
||||
|
||||
(graphs '#$(match inputs
|
||||
(((names . _) ...)
|
||||
names)))
|
||||
;; This variable is unused but allows us to add INPUTS-TO-COPY
|
||||
;; as inputs.
|
||||
(to-register
|
||||
'#$(map (match-lambda
|
||||
((name thing) thing)
|
||||
((name thing output) `(,thing ,output)))
|
||||
inputs)))
|
||||
|
||||
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)
|
||||
(make-iso9660-image #$xorriso
|
||||
'#$grub-mkrescue-environment
|
||||
#$(bootloader-package bootloader)
|
||||
#$bootcfg-drv
|
||||
#$os
|
||||
"/xchg/guixsd.iso"
|
||||
#:register-closures? #$register-closures?
|
||||
#:closures graphs
|
||||
#:volume-id #$file-system-label
|
||||
#:volume-uuid #$(and=> file-system-uuid
|
||||
uuid-bytevector))))))
|
||||
#:system system
|
||||
#:target target
|
||||
|
||||
;; Keep a local file system for /tmp so that we can populate it directly as
|
||||
;; root and have files owned by root. See <https://bugs.gnu.org/31752>.
|
||||
#:file-systems (remove (lambda (file-system)
|
||||
(string=? (file-system-mount-point file-system)
|
||||
"/tmp"))
|
||||
%linux-vm-file-systems)
|
||||
|
||||
#:make-disk-image? #f
|
||||
#:single-file-output? #t
|
||||
#:references-graphs inputs
|
||||
#:substitutable? substitutable?
|
||||
|
||||
;; Xorriso seems to be quite memory-hungry, so increase the VM's RAM size.
|
||||
#:memory-size 512))
|
||||
|
||||
(define* (qemu-image #:key
|
||||
(name "qemu-image")
|
||||
(system (%current-system))
|
||||
|
|
@ -618,25 +529,14 @@ (define* (system-disk-image-in-vm os
|
|||
|
||||
SUBSTITUTABLE? determines whether the returned derivation should be marked as
|
||||
substitutable."
|
||||
(define normalize-label
|
||||
;; ISO labels are all-caps (case-insensitive), but since
|
||||
;; 'find-partition-by-label' is case-sensitive, make it all-caps here.
|
||||
(if (string=? "iso9660" file-system-type)
|
||||
string-upcase
|
||||
identity))
|
||||
|
||||
(define root-label
|
||||
;; Volume name of the root file system.
|
||||
(normalize-label "Guix_image"))
|
||||
"Guix_image")
|
||||
|
||||
(define (root-uuid os)
|
||||
;; UUID of the root file system, computed in a deterministic fashion.
|
||||
;; This is what we use to locate the root file system so it has to be
|
||||
;; different from the user's own file system UUIDs.
|
||||
(operating-system-uuid os
|
||||
(if (string=? file-system-type "iso9660")
|
||||
'iso9660
|
||||
'dce)))
|
||||
(operating-system-uuid os 'dce))
|
||||
|
||||
(define file-systems-to-keep
|
||||
(remove (lambda (fs)
|
||||
|
|
@ -653,11 +553,7 @@ (define file-systems-to-keep
|
|||
#:volatile-root? volatile?
|
||||
rest)))
|
||||
|
||||
(bootloader (if (string=? "iso9660" file-system-type)
|
||||
(bootloader-configuration
|
||||
(inherit (operating-system-bootloader os))
|
||||
(bootloader grub-mkrescue-bootloader))
|
||||
(operating-system-bootloader os)))
|
||||
(bootloader (operating-system-bootloader os))
|
||||
|
||||
;; Force our own root file system. (We need a "/" file system
|
||||
;; to call 'root-uuid'.)
|
||||
|
|
@ -675,33 +571,20 @@ (define file-systems-to-keep
|
|||
(type file-system-type))
|
||||
file-systems-to-keep))))
|
||||
(bootcfg (operating-system-bootcfg os)))
|
||||
(if (string=? "iso9660" file-system-type)
|
||||
(iso9660-image #:name name
|
||||
#:file-system-label root-label
|
||||
#:file-system-uuid uuid
|
||||
#:os os
|
||||
#:bootcfg-drv bootcfg
|
||||
#:bootloader (bootloader-configuration-bootloader
|
||||
(operating-system-bootloader os))
|
||||
#:inputs `(("system" ,os)
|
||||
("bootcfg" ,bootcfg))
|
||||
#:grub-mkrescue-environment
|
||||
'(("MKRESCUE_SED_MODE" . "mbr_hfs"))
|
||||
#:substitutable? substitutable?)
|
||||
(qemu-image #:name name
|
||||
#:os os
|
||||
#:bootcfg-drv bootcfg
|
||||
#:bootloader (bootloader-configuration-bootloader
|
||||
(operating-system-bootloader os))
|
||||
#:disk-image-size disk-image-size
|
||||
#:disk-image-format "raw"
|
||||
#:file-system-type file-system-type
|
||||
#:file-system-label root-label
|
||||
#:file-system-uuid uuid
|
||||
#:copy-inputs? #t
|
||||
#:inputs `(("system" ,os)
|
||||
("bootcfg" ,bootcfg))
|
||||
#:substitutable? substitutable?))))
|
||||
(qemu-image #:name name
|
||||
#:os os
|
||||
#:bootcfg-drv bootcfg
|
||||
#:bootloader (bootloader-configuration-bootloader
|
||||
(operating-system-bootloader os))
|
||||
#:disk-image-size disk-image-size
|
||||
#:disk-image-format "raw"
|
||||
#:file-system-type file-system-type
|
||||
#:file-system-label root-label
|
||||
#:file-system-uuid uuid
|
||||
#:copy-inputs? #t
|
||||
#:inputs `(("system" ,os)
|
||||
("bootcfg" ,bootcfg))
|
||||
#:substitutable? substitutable?)))
|
||||
|
||||
(define* (system-qemu-image os
|
||||
#:key
|
||||
|
|
|
|||
Loading…
Reference in a new issue