qemu: add 7.2.4 package temporarily

1 files changed, 455 insertions, 0 deletions

diff --git a/qemu.scm b/qemu.scm
new file mode 100644
index 0000000..c0e5e7a
--- /dev/null
+++ b/qemu.scm
@@ -0,0 +1,455 @@
+; We need this because we have issues with 8.1.X:
+; https://gitlab.com/qemu-project/qemu/-/issues/1908
+(define-module (qemu)
+  #:use-module (gnu packages)
+  #:use-module (gnu packages acl)
+  #:use-module (gnu packages admin)
+  #:use-module (gnu packages assembly)
+  #:use-module (gnu packages attr)
+  #:use-module (gnu packages autotools)
+  #:use-module (gnu packages backup)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages bash)
+  #:use-module (gnu packages bison)
+  #:use-module (gnu packages bootloaders)
+  #:use-module (gnu packages build-tools)
+  #:use-module (gnu packages check)
+  #:use-module (gnu packages cluster)
+  #:use-module (gnu packages cmake)
+  #:use-module (gnu packages compression)
+  #:use-module (gnu packages containers)
+  #:use-module (gnu packages cross-base)
+  #:use-module (gnu packages cryptsetup)
+  #:use-module (gnu packages curl)
+  #:use-module (gnu packages cyrus-sasl)
+  #:use-module (gnu packages debian)
+  #:use-module (gnu packages disk)
+  #:use-module (gnu packages dns)
+  #:use-module (gnu packages docbook)
+  #:use-module (gnu packages documentation)
+  #:use-module (gnu packages figlet)
+  #:use-module (gnu packages firmware)
+  #:use-module (gnu packages flex)
+  #:use-module (gnu packages fonts)
+  #:use-module (gnu packages fontutils)
+  #:use-module (gnu packages freedesktop)
+  #:use-module (gnu packages gettext)
+  #:use-module (gnu packages gcc)
+  #:use-module (gnu packages gl)
+  #:use-module (gnu packages glib)
+  #:use-module (gnu packages gnome)
+  #:use-module (gnu packages gnupg)
+  #:use-module (gnu packages golang)
+  #:use-module (gnu packages graphviz)
+  #:use-module (gnu packages gtk)
+  #:use-module (gnu packages haskell)
+  #:use-module (gnu packages haskell-apps)
+  #:use-module (gnu packages haskell-check)
+  #:use-module (gnu packages haskell-crypto)
+  #:use-module (gnu packages haskell-web)
+  #:use-module (gnu packages haskell-xyz)
+  #:use-module (gnu packages image)
+  #:use-module (gnu packages libbsd)
+  #:use-module (gnu packages libusb)
+  #:use-module (gnu packages linux)
+  #:use-module (gnu packages m4)
+  #:use-module (gnu packages man)
+  #:use-module (gnu packages multiprecision)
+  #:use-module (gnu packages ncurses)
+  #:use-module (gnu packages nettle)
+  #:use-module (gnu packages networking)
+  #:use-module (gnu packages ninja)
+  #:use-module (gnu packages onc-rpc)
+  #:use-module (gnu packages package-management)
+  #:use-module (gnu packages pciutils)
+  #:use-module (gnu packages pcre)
+  #:use-module (gnu packages perl)
+  #:use-module (gnu packages pkg-config)
+  #:use-module (gnu packages polkit)
+  #:use-module (gnu packages protobuf)
+  #:use-module (gnu packages python)
+  #:use-module (gnu packages python-build)
+  #:use-module (gnu packages python-check)
+  #:use-module (gnu packages python-crypto)
+  #:use-module (gnu packages python-web)
+  #:use-module (gnu packages python-xyz)
+  #:use-module (gnu packages pulseaudio)
+  #:use-module (gnu packages readline)
+  #:use-module (gnu packages rsync)
+  #:use-module (gnu packages selinux)
+  #:use-module (gnu packages sdl)
+  #:use-module (gnu packages sphinx)
+  #:use-module (gnu packages spice)
+  #:use-module (gnu packages ssh)
+  #:use-module (gnu packages texinfo)
+  #:use-module (gnu packages textutils)
+  #:use-module (gnu packages tls)
+  #:use-module (gnu packages web)
+  #:use-module (gnu packages wget)
+  #:use-module (gnu packages xdisorg)
+  #:use-module (gnu packages xml)
+  #:use-module (gnu packages xorg)
+  #:use-module (guix build-system cmake)
+  #:use-module (guix build-system gnu)
+  #:use-module (guix build-system go)
+  #:use-module (guix build-system meson)
+  #:use-module (guix build-system python)
+  #:use-module (guix build-system trivial)
+  #:use-module (guix download)
+  #:use-module (guix git-download)
+  #:use-module (guix gexp)
+  #:use-module ((guix licenses) #:prefix license:)
+  #:use-module (guix packages)
+  #:use-module (guix utils)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match))
+
+(define-public qemu
+  (package
+    (name "qemu")
+    (version "7.2.4")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "https://download.qemu.org/qemu-"
+                           version ".tar.xz"))
+       (sha256
+        (base32 "0795l8xsy67fnh4mbdz40jm880iisd7q6d7ly6nfzpac3gjr8zyf"))
+       (patches (search-patches "qemu-build-info-manual.patch"
+                                "qemu-disable-aarch64-migration-test.patch"
+                                "qemu-fix-agent-paths.patch"))
+       (modules '((guix build utils)))
+       (snippet
+        '(begin
+           ;; TODO: Scrub all firmwares from this directory!
+           (with-directory-excursion "pc-bios"
+             ;; Delete firmwares provided by SeaBIOS.
+             (for-each delete-file (find-files "." "^(bios|vgabios).*\\.bin$"))
+             ;; Delete SGABIOS.
+             (delete-file "sgabios.bin")
+             ;; Delete ppc64 OpenBIOS.  TODO: Remove sparc32 and sparc64 too
+             ;; once they are supported in Guix.
+             (delete-file "openbios-ppc")
+             ;; Delete riscv64 OpenSBI.  TODO: Remove riscv32 when supported
+             ;; in Guix.
+             (delete-file "opensbi-riscv64-generic-fw_dynamic.bin")
+             ;; Delete iPXE firmwares.
+             (for-each delete-file (find-files "." "^(efi|pxe)-.*\\.rom$")))
+           ;; Delete bundled code that we provide externally.
+           (for-each delete-file-recursively
+                     '("dtc" "meson"
+                       "roms/ipxe"
+                       "roms/openbios"
+                       "roms/opensbi"
+                       "roms/seabios"
+                       "roms/sgabios"))))))
+    (outputs '("out" "static" "doc"))   ;5.3 MiB of HTML docs
+    (build-system gnu-build-system)
+    (arguments
+     (list
+      ;; FIXME: Disable tests on i686 to work around
+      ;; <https://bugs.gnu.org/40527>.
+      #:tests? (or (%current-target-system)
+                   (not (string=? "i686-linux" (%current-system))))
+      #:configure-flags
+      #~(let ((gcc (search-input-file %build-inputs "/bin/gcc"))
+              (meson (search-input-file %build-inputs "bin/meson"))
+              (openbios (search-input-file %build-inputs
+                                           "share/qemu/openbios-ppc"))
+              (opensbi (search-input-file
+                        %build-inputs
+                        "share/qemu/opensbi-riscv64-generic-fw_dynamic.bin"))
+              (seabios (search-input-file %build-inputs
+                                          "share/qemu/bios.bin"))
+              (sgabios (search-input-file %build-inputs
+                                          "/share/qemu/sgabios.bin"))
+              (ipxe (search-input-file %build-inputs
+                                       "share/qemu/pxe-virtio.rom"))
+              (out #$output))
+          (list (string-append "--cc=" gcc)
+                ;; Some architectures insist on using HOST_CC.
+                (string-append "--host-cc=" gcc)
+                (string-append "--meson=" meson)
+                (string-append "--prefix=" out)
+
+                "--sysconfdir=/etc"
+                "--enable-fdt=system"
+                (string-append "--firmwarepath=" out "/share/qemu:"
+                               (dirname seabios) ":"
+                               (dirname ipxe) ":"
+                               (dirname openbios) ":"
+                               (dirname opensbi) ":"
+                               (dirname sgabios))
+                (string-append "--smbd=" out "/libexec/samba-wrapper")
+                "--disable-debug-info"  ;for space considerations
+                ;; The binaries need to be linked against -lrt.
+                (string-append "--extra-ldflags=-lrt")))
+      ;; Make build and test output verbose to facilitate investigation upon failure.
+      #:make-flags #~'("V=1")
+      #:modules `((srfi srfi-1)
+                  (srfi srfi-26)
+                  (ice-9 ftw)
+                  (ice-9 match)
+                  ,@%gnu-build-system-modules)
+      #:phases
+      #~(modify-phases %standard-phases
+          ;; Since we removed the bundled firmwares above, many tests
+          ;; can't work.  Re-add them here.
+          (add-after 'unpack 'replace-firmwares
+            (lambda* (#:key inputs #:allow-other-keys)
+              (let* ((seabios (dirname (search-input-file
+                                        inputs "share/qemu/bios.bin")))
+                     (seabios-firmwares (find-files seabios "\\.bin$"))
+                     (sgabios (search-input-file inputs "share/qemu/sgabios.bin"))
+                     (ipxe (dirname (search-input-file
+                                     inputs "share/qemu/pxe-virtio.rom")))
+                     (ipxe-firmwares (find-files ipxe "\\.rom$"))
+                     (openbios (search-input-file
+                                inputs "share/qemu/openbios-ppc"))
+                     (opensbi-riscv64
+                      (search-input-file
+                       inputs
+                       "share/qemu/opensbi-riscv64-generic-fw_dynamic.bin"))
+                     (allowed-differences
+                      ;; Ignore minor differences (addresses etc) in the firmware
+                      ;; data tables compared to what the test suite expects.
+                      '("tests/data/acpi/pc/SSDT.dimmpxm"
+                        "tests/data/acpi/pc/DSDT.dimmpxm"
+                        "tests/data/acpi/pc/ERST.acpierst"
+                        "tests/data/acpi/q35/ERST.acpierst"
+                        "tests/data/acpi/q35/DSDT.cxl"))
+                     (allowed-differences-whitelist
+                      (open-file "tests/qtest/bios-tables-test-allowed-diff.h"
+                                 "a")))
+                (with-directory-excursion "pc-bios"
+                  (for-each (lambda (file)
+                              (symlink file (basename file)))
+                            (append seabios-firmwares ipxe-firmwares
+                                    (list openbios opensbi-riscv64 sgabios))))
+                (for-each (lambda (file)
+                            (format allowed-differences-whitelist
+                                    "\"~a\",~%" file))
+                          allowed-differences)
+                (close-port allowed-differences-whitelist))))
+          (add-after 'unpack 'extend-test-time-outs
+            (lambda _
+              ;; These tests can time out on heavily-loaded and/or slow storage.
+              (substitute* (cons* "tests/qemu-iotests/common.qemu"
+                                  (find-files "tests/qemu-iotests" "^[0-9]+$"))
+                (("QEMU_COMM_TIMEOUT=[0-9]+" match)
+                 (string-append match "9")))))
+          (add-after 'unpack 'disable-unusable-tests
+            (lambda _
+              (substitute* "tests/unit/meson.build"
+                ;; Comment out the test-qga test, which needs /sys and
+                ;; fails within the build environment.
+                (("tests.*test-qga.*$" all)
+                 (string-append "# " all))
+                ;; Comment out the test-char test, which needs networking and
+                ;; fails within the build environment.
+                ((".*'test-char':.*" all)
+                 (string-append "# " all)))
+              (substitute* "tests/qtest/meson.build"
+                ;; These tests fail to get the expected number of tests
+                ;; on arm platforms.
+                (("'arm-cpu-features',") ""))))
+          #$@(if (target-riscv64?)
+                 '((add-after 'unpack 'disable-some-tests
+                     (lambda _
+                       ;; qemu.qmp.QMPConnectError:
+                       ;; Unexpected empty reply from server
+                       (delete-file "tests/qemu-iotests/040")
+                       (delete-file "tests/qemu-iotests/041")
+                       (delete-file "tests/qemu-iotests/256")
+
+                       ;; No 'PCI' bus found for device 'virtio-scsi-pci'
+                       (delete-file "tests/qemu-iotests/127")
+                       (delete-file "tests/qemu-iotests/267"))))
+                 '())
+          (add-after 'patch-source-shebangs 'patch-embedded-shebangs
+            (lambda* (#:key native-inputs inputs #:allow-other-keys)
+              ;; Ensure the executables created by these source files reference
+              ;; /bin/sh from the store so they work inside the build container.
+              (substitute* '("block/cloop.c" "migration/exec.c"
+                             "net/tap.c" "tests/qtest/libqtest.c"
+                             "tests/qtest/vhost-user-blk-test.c")
+                (("/bin/sh") (search-input-file inputs "/bin/sh")))
+              (substitute* "tests/qemu-iotests/testenv.py"
+                (("#!/usr/bin/env python3")
+                 (string-append "#!" (search-input-file (or native-inputs inputs)
+                                                        "/bin/python3"))))))
+          (add-before 'configure 'fix-optionrom-makefile
+            (lambda _
+              ;; Work around the inability of the rules defined in this
+              ;; Makefile to locate the firmware files (e.g.: No rule to make
+              ;; target 'multiboot.bin') by extending the VPATH.
+              (substitute* "pc-bios/optionrom/Makefile"
+                (("^VPATH = \\$\\(SRC_DIR\\)")
+                 "VPATH = $(SRC_DIR):$(TOPSRC_DIR)/pc-bios"))))
+          ;; XXX ./configure is being re-run at beginning of build phase...
+          (replace 'configure
+            (lambda* (#:key inputs configure-flags #:allow-other-keys)
+              ;; The `configure' script doesn't understand some of the
+              ;; GNU options.  Thus, add a new phase that's compatible.
+              (setenv "SHELL" (which "bash"))
+              ;; Ensure config.status gets the correct shebang off the bat.
+              ;; The build system gets confused if we change it later and
+              ;; attempts to re-run the whole configuration, and fails.
+              (substitute* "configure"
+                (("#!/bin/sh")
+                 (string-append "#!" (which "sh"))))
+              (mkdir-p "b/qemu")
+              (chdir "b/qemu")
+              (apply invoke "../../configure" configure-flags)))
+
+          ;; Configure, build and install QEMU user-emulation static binaries.
+          (add-after 'configure 'configure-user-static
+            (lambda* (#:key inputs outputs #:allow-other-keys)
+              (let* ((static (assoc-ref outputs "static"))
+                     (gcc (search-input-file inputs "/bin/gcc"))
+                     ;; This is the common set of configure flags; it is
+                     ;; duplicated here to isolate this phase from manipulations
+                     ;; to the #:configure-flags build argument, as done in
+                     ;; derived packages such as qemu-minimal.
+                     (configure-flags (list (string-append "--cc=" gcc)
+                                            (string-append "--host-cc=" gcc)
+                                            "--sysconfdir=/etc"
+                                            "--disable-debug-info")))
+              (mkdir-p "../user-static")
+              (with-directory-excursion "../user-static"
+                (apply invoke "../../configure"
+                       "--static"
+                       "--disable-docs" ;already built
+                       "--disable-system"
+                       "--enable-linux-user"
+                       (string-append "--prefix=" static)
+                       configure-flags)))))
+          (add-after 'build 'build-user-static
+            (lambda args
+              (with-directory-excursion "../user-static"
+                (apply (assoc-ref %standard-phases 'build) args))))
+          (add-after 'install 'install-user-static
+            (lambda* (#:key outputs #:allow-other-keys)
+              (let* ((static (assoc-ref outputs "static"))
+                     (bin (string-append static "/bin")))
+                (with-directory-excursion "../user-static"
+                  (for-each (cut install-file <> bin)
+                            (append-map (cut find-files <> "^qemu-" #:stat stat)
+                                        (scandir "."
+                                                 (cut string-suffix?
+                                                      "-linux-user" <>))))))))
+
+          (add-after 'install 'delete-firmwares
+            (lambda _
+              ;; Delete firmares that are accessible on --firmwarepath.
+              ;; For some reason tests fail if we simply remove them from
+              ;; pc-bios/meson.build, hence this roundabout way.
+              (with-directory-excursion (string-append #$output "/share/qemu")
+                (for-each delete-file
+                          (append
+                           '("openbios-ppc"
+                             "opensbi-riscv64-generic-fw_dynamic.bin"
+                             "sgabios.bin")
+                           (find-files "." "^(vga)?bios(-[a-z0-9-]+)?\\.bin$")
+                           (find-files "." "^(efi|pxe)-.*\\.rom$"))))))
+          ;; Create a wrapper for Samba. This allows QEMU to use Samba without
+          ;; pulling it in as an input. Note that you need to explicitly install
+          ;; Samba in your Guix profile for Samba support.
+          (add-after 'install 'create-samba-wrapper
+            (lambda* (#:key inputs #:allow-other-keys)
+              (let ((libexec (string-append #$output "/libexec")))
+                (call-with-output-file "samba-wrapper"
+                  (lambda (port)
+                    (format port "#!/bin/sh
+exec smbd $@")))
+                (chmod "samba-wrapper" #o755)
+                (install-file "samba-wrapper" libexec))))
+          (add-after 'install 'move-html-doc
+            (lambda* (#:key inputs outputs #:allow-other-keys)
+              (let* ((out #$output)
+                     (doc #$output:doc)
+                     (qemu-doc (string-append doc "/share/doc/qemu-"
+                                              #$(package-version this-package))))
+                (mkdir-p qemu-doc)
+                (rename-file (string-append out "/share/doc/qemu")
+                             (string-append qemu-doc "/html"))))))))
+    (inputs
+     (list alsa-lib
+           bash-minimal
+           dtc
+           glib
+           gtk+
+           ipxe-qemu
+           libaio
+           libcacard                    ;smartcard support
+           attr libcap-ng               ;VirtFS support
+           libdrm
+           libepoxy
+           libjpeg-turbo
+           libpng
+           libseccomp
+           libslirp
+           liburing
+           libusb                       ;USB pass-through support
+           mesa
+           ncurses
+           openbios-qemu-ppc
+           opensbi-qemu
+           ;; ("pciutils" ,pciutils)
+           pixman
+           pulseaudio
+           sdl2
+           seabios-qemu
+           sgabios
+           spice
+           usbredir
+           util-linux
+           vde2
+           virglrenderer
+
+           ;; Formats to support for .qcow2 (and possibly other) compression.
+           zlib
+           `(,zstd "lib")))
+    (native-inputs
+     ;; Note: acpica is here only to pretty-print firmware differences with IASL
+     ;; (see the replace-firmwares phase above).
+     (list acpica
+           bison
+           flex
+           gettext-minimal
+           `(,glib "bin")               ;gtester, etc.
+           meson
+           ninja
+           perl
+           pkg-config
+           python-wrapper
+           python-sphinx
+           python-sphinx-rtd-theme
+           texinfo
+           ;; The following static libraries are required to build
+           ;; the static output of QEMU.
+           `(,glib "static")
+           `(,pcre "static")
+           `(,zlib "static")))
+    (home-page "https://www.qemu.org")
+    (synopsis "Machine emulator and virtualizer")
+    (description
+     "QEMU is a generic machine emulator and virtualizer.
+
+When used as a machine emulator, QEMU can run OSes and programs made for one
+machine (e.g. an ARM board) on a different machine---e.g., your own PC.  By
+using dynamic translation, it achieves very good performance.
+
+When used as a virtualizer, QEMU achieves near native performances by
+executing the guest code directly on the host CPU.  QEMU supports
+virtualization when executing under the Xen hypervisor or using
+the KVM kernel module in Linux.  When using KVM, QEMU can virtualize x86,
+server and embedded PowerPC, and S390 guests.")
+
+    ;; Many files are GPLv2+, but some are GPLv2-only---e.g., `memory.c'.
+    (license license:gpl2)
+
+    ;; Several tests fail on MIPS; see <http://hydra.gnu.org/build/117914>.
+    (supported-systems (fold delete %supported-systems
+                             '("mips64el-linux" "i586-gnu")))))