summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gnu/build/vm.scm156
-rw-r--r--gnu/system/vm.scm151
2 files changed, 18 insertions, 289 deletions
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index bc6071daa9..1a888b1a51 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -57,8 +57,7 @@
estimated-partition-size
root-partition-initializer
initialize-partition-table
- initialize-hard-disk
- make-iso9660-image))
+ initialize-hard-disk))
;;; Commentary:
;;;
@@ -417,159 +416,6 @@ SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
(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
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 37840ce355..1cab8997b4 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -269,95 +269,6 @@ substitutable."
(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 @@ to USB sticks meant to be read-only.
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 @@ substitutable."
#: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 @@ substitutable."
(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
generated by cgit v1.2.3 (git 2.46.2) at 2024-11-10 09:24:01 +0000