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.

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