The package is also converted to gnu-build-system in order to take advantage
of already existing Makefile instead of reinventing (parts) of it in Guile.
* gnu/packages/virtualization.scm (skopeo)[version]: Update to 1.15.0.
[build-system]: Use gnu-build-system.
[native-inputs]: Add go-1.21, sort.
[inputs]: Add bash-minimal.
[arguments]<#:import-path, #:install-source?>: Delete.
<#:make-flags, #:test-target, #:imported-modules>: New arguments.
<#:phases>{'configure}: Delete.
{'set-env, 'cc-to-gcc, 'wrap-skopeo, 'remove-go-references}: New phases.
Change-Id: I1010e1f4fbdc093646c2879bdf30125ab2e88bdd
Signed-off-by: Christopher Baines <mail@cbaines.net>
		
	
			
		
			
				
	
	
		
			2861 lines
		
	
	
	
		
			123 KiB
		
	
	
	
		
			Scheme
		
	
	
	
	
	
			
		
		
	
	
			2861 lines
		
	
	
	
		
			123 KiB
		
	
	
	
		
			Scheme
		
	
	
	
	
	
;;; GNU Guix --- Functional package management for GNU
 | 
						||
;;; Copyright © 2013-2017, 2020-2022 Ludovic Courtès <ludo@gnu.org>
 | 
						||
;;; Copyright © 2015, 2016, 2017, 2018 Mark H Weaver <mhw@netris.org>
 | 
						||
;;; Copyright © 2016-2021, 2023 Efraim Flashner <efraim@flashner.co.il>
 | 
						||
;;; Copyright © 2016, 2017 Ricardo Wurmus <rekado@elephly.net>
 | 
						||
;;; Copyright © 2017 Alex Vong <alexvong1995@gmail.com>
 | 
						||
;;; Copyright © 2017 Andy Patterson <ajpatter@uwaterloo.ca>
 | 
						||
;;; Copyright © 2017, 2018, 2019 Rutger Helling <rhelling@mykolab.com>
 | 
						||
;;; Copyright © 2017–2021 Tobias Geerinckx-Rice <me@tobias.gr>
 | 
						||
;;; Copyright © 2018 Danny Milosavljevic <dannym@scratchpost.org>
 | 
						||
;;; Copyright © 2018 Sou Bunnbu <iyzsong@member.fsf.org>
 | 
						||
;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
 | 
						||
;;; Copyright © 2019 Guy Fleury Iteriteka <hoonandon@gmail.com>
 | 
						||
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 | 
						||
;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re>
 | 
						||
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 | 
						||
;;; Copyright © 2020, 2021, 2022 Marius Bakke <marius@gnu.org>
 | 
						||
;;; Copyright © 2020, 2021, 2022, 2023, 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 | 
						||
;;; Copyright © 2020 Brett Gilio <brettg@gnu.org>
 | 
						||
;;; Copyright © 2021 Leo Famulari <leo@famulari.name>
 | 
						||
;;; Copyright © 2021, 2022 Pierre Langlois <pierre.langlois@gmx.com>
 | 
						||
;;; Copyright © 2021 Dion Mendel <guix@dm9.info>
 | 
						||
;;; Copyright © 2021 Andrew Whatson <whatson@gmail.com>
 | 
						||
;;; Copyright © 2021 Vincent Legoll <vincent.legoll@gmail.com>
 | 
						||
;;; Copyright © 2021 Petr Hodina <phodina@protonmail.com>
 | 
						||
;;; Copyright © 2021 Raghav Gururajan <rg@raghavgururajan.name>
 | 
						||
;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>
 | 
						||
;;; Copyright © 2022, 2023 Ekaitz Zarraga <ekaitz@elenq.tech>
 | 
						||
;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
 | 
						||
;;; Copyright © 2022 Zhu Zihao <all_but_last@163.com>
 | 
						||
;;; Copyright © 2023 Juliana Sims <juli@incana.org>
 | 
						||
;;; Copyright © 2023 Ahmad Draidi <a.r.draidi@redscript.org>
 | 
						||
;;; Copyright © 2023 Sharlatan Hellseher <sharlatanus@gmail.com>
 | 
						||
;;; Copyright © 2023, 2024 Hartmut Goebel <h.goebel@crazy-compilers.com>
 | 
						||
;;;
 | 
						||
;;; This file is part of GNU Guix.
 | 
						||
;;;
 | 
						||
;;; GNU Guix is free software; you can redistribute it and/or modify it
 | 
						||
;;; under the terms of the GNU General Public License as published by
 | 
						||
;;; the Free Software Foundation; either version 3 of the License, or (at
 | 
						||
;;; your option) any later version.
 | 
						||
;;;
 | 
						||
;;; GNU Guix is distributed in the hope that it will be useful, but
 | 
						||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
 | 
						||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 | 
						||
;;; GNU General Public License for more details.
 | 
						||
;;;
 | 
						||
;;; You should have received a copy of the GNU General Public License
 | 
						||
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 | 
						||
 | 
						||
(define-module (gnu packages virtualization)
 | 
						||
  #: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 crypto)
 | 
						||
  #: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 gcc)
 | 
						||
  #:use-module (gnu packages gettext)
 | 
						||
  #: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 pulseaudio)
 | 
						||
  #: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 readline)
 | 
						||
  #:use-module (gnu packages ruby)
 | 
						||
  #:use-module (gnu packages rsync)
 | 
						||
  #:use-module (gnu packages sdl)
 | 
						||
  #:use-module (gnu packages selinux)
 | 
						||
  #: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 licenses) #:prefix license:)
 | 
						||
  #: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 ruby)
 | 
						||
  #:use-module (guix build-system trivial)
 | 
						||
  #:use-module (guix download)
 | 
						||
  #:use-module (guix gexp)
 | 
						||
  #:use-module (guix git-download)
 | 
						||
  #:use-module (guix packages)
 | 
						||
  #:use-module (guix modules)
 | 
						||
  #:use-module (guix utils)
 | 
						||
  #:use-module (srfi srfi-1)
 | 
						||
  #:use-module (srfi srfi-26)
 | 
						||
  #:use-module (ice-9 match))
 | 
						||
 | 
						||
(define (qemu-patch commit file-name sha256-bv)
 | 
						||
  "Return an origin for COMMIT."
 | 
						||
  (origin
 | 
						||
    (method url-fetch)
 | 
						||
    (uri (string-append
 | 
						||
          "http://git.qemu.org/?p=qemu.git;a=commitdiff_plain;h="
 | 
						||
          commit))
 | 
						||
    (hash (content-hash sha256-bv sha256))
 | 
						||
    (file-name file-name)))
 | 
						||
 | 
						||
(define-public qemu
 | 
						||
  (package
 | 
						||
    (name "qemu")
 | 
						||
    (version "8.2.2")
 | 
						||
    (source
 | 
						||
     (origin
 | 
						||
       (method url-fetch)
 | 
						||
       (uri (string-append "https://download.qemu.org/qemu-"
 | 
						||
                           version ".tar.xz"))
 | 
						||
       (sha256
 | 
						||
        (base32 "1wy45fbf4816l4ylsz8b8cbypva9apcdnvlgqfr586icp30lcww4"))
 | 
						||
       (patches (search-patches "qemu-build-info-manual.patch"
 | 
						||
                                "qemu-disable-bios-tables-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 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
 | 
						||
                     '("roms/u-boot/scripts/dtc"
 | 
						||
                       "roms/ipxe"
 | 
						||
                       "roms/openbios"
 | 
						||
                       "roms/opensbi"
 | 
						||
                       "roms/seabios"))))))
 | 
						||
    (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"))
 | 
						||
              (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"))
 | 
						||
              (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 "--prefix=" out)
 | 
						||
                "--sysconfdir=/etc"
 | 
						||
                "--enable-fdt=system"
 | 
						||
                (string-append "--firmwarepath=" out "/share/qemu:"
 | 
						||
                               (dirname seabios) ":"
 | 
						||
                               (dirname ipxe) ":"
 | 
						||
                               (dirname openbios) ":"
 | 
						||
                               (dirname opensbi))
 | 
						||
                (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$"))
 | 
						||
                     (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))))
 | 
						||
                (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"
 | 
						||
                             "migration/migration.c"
 | 
						||
                             "net/tap.c"
 | 
						||
                             "util/envlist.c")
 | 
						||
                (("/bin/sh")
 | 
						||
                 (search-input-file inputs "/bin/sh")))
 | 
						||
              ;; For tests, use the native /bin/sh is available.
 | 
						||
              (substitute* '("tests/qtest/libqtest.c"
 | 
						||
                             "tests/qtest/vhost-user-blk-test.c")
 | 
						||
                (("/bin/sh")
 | 
						||
                 (search-input-file (or native-inputs 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-before 'check 'set-SOCK_DIR
 | 
						||
            (lambda _
 | 
						||
              ;; The default value for SOCK_DIR is TMPDIR, which can be long
 | 
						||
              ;; in the build chroot (e.g.:
 | 
						||
              ;; /tmp/guix-build-qemu-minimal-drv-0); set it to SOCK_DIR to
 | 
						||
              ;; avoid using more than 109 characters for socket files (the
 | 
						||
              ;; limit when using the kernel Linux).
 | 
						||
              (setenv "SOCK_DIR" "/tmp")))
 | 
						||
          (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")
 | 
						||
                           (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
 | 
						||
           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")
 | 
						||
           `(,pcre2 "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")))))
 | 
						||
 | 
						||
(define-public qemu-minimal
 | 
						||
  ;; QEMU without GUI support, only supporting the host's architecture
 | 
						||
  (package/inherit qemu
 | 
						||
    (name "qemu-minimal")
 | 
						||
    (outputs '("out" "doc"))
 | 
						||
    (synopsis
 | 
						||
     "Machine emulator and virtualizer (without GUI) for the host architecture")
 | 
						||
    (arguments
 | 
						||
     (substitute-keyword-arguments (package-arguments qemu)
 | 
						||
       ((#:configure-flags configure-flags #~'())
 | 
						||
        ;; Restrict to the host's architecture.
 | 
						||
        (let* ((system (or (%current-target-system)
 | 
						||
                           (%current-system)))
 | 
						||
               (target-list-arg
 | 
						||
                (match system
 | 
						||
                  ((? (cut string-prefix? "i686" <>))
 | 
						||
                   "--target-list=i386-softmmu")
 | 
						||
                  ((? (cut string-prefix? "x86_64" <>))
 | 
						||
                   "--target-list=i386-softmmu,x86_64-softmmu")
 | 
						||
                  ((? (cut string-prefix? "mips64" <>))
 | 
						||
                   (string-append "--target-list=mips-softmmu,mipsel-softmmu,"
 | 
						||
                                  "mips64-softmmu,mips64el-softmmu"))
 | 
						||
                  ((? (cut string-prefix? "mips" <>))
 | 
						||
                   "--target-list=mips-softmmu,mipsel-softmmu")
 | 
						||
                  ((? (cut string-prefix? "aarch64" <>))
 | 
						||
                   "--target-list=arm-softmmu,aarch64-softmmu")
 | 
						||
                  ((? (cut string-prefix? "arm" <>))
 | 
						||
                   "--target-list=arm-softmmu")
 | 
						||
                  ((? (cut string-prefix? "alpha" <>))
 | 
						||
                   "--target-list=alpha-softmmu")
 | 
						||
                  ((? (cut string-prefix? "powerpc64" <>))
 | 
						||
                   "--target-list=ppc-softmmu,ppc64-softmmu")
 | 
						||
                  ((? (cut string-prefix? "powerpc" <>))
 | 
						||
                   "--target-list=ppc-softmmu")
 | 
						||
                  ((? (cut string-prefix? "s390" <>))
 | 
						||
                   "--target-list=s390x-softmmu")
 | 
						||
                  ((? (cut string-prefix? "riscv" <>))
 | 
						||
                   "--target-list=riscv32-softmmu,riscv64-softmmu")
 | 
						||
                  (else       ; An empty list actually builds all the targets.
 | 
						||
                   '()))))
 | 
						||
          #~(cons #$target-list-arg #$configure-flags)))
 | 
						||
       ((#:phases phases)
 | 
						||
        #~(modify-phases #$phases
 | 
						||
            (delete 'configure-user-static)
 | 
						||
            (delete 'build-user-static)
 | 
						||
            (delete 'install-user-static)))))
 | 
						||
 | 
						||
    ;; Remove dependencies on optional libraries, notably GUI libraries.
 | 
						||
    (native-inputs (filter (lambda (input)
 | 
						||
                             (match input
 | 
						||
                               ;; Work around the fact that modify-inputs can not
 | 
						||
                               ;; delete specific outputs; i.e. here we should keep
 | 
						||
                               ;; `(,glib "bin"), but not `(,glib "static").
 | 
						||
                               ((label package output)
 | 
						||
                                (not (string=? "static" output)))
 | 
						||
                               (_ input)))
 | 
						||
                           (modify-inputs (package-native-inputs qemu)
 | 
						||
                             (delete "gettext-minimal"))))
 | 
						||
    (inputs (modify-inputs (package-inputs qemu)
 | 
						||
              (delete "libusb"
 | 
						||
                      "mesa"
 | 
						||
                      "sdl2"
 | 
						||
                      "spice"
 | 
						||
                      "virglrenderer"
 | 
						||
                      "gtk+"
 | 
						||
                      "usbredir"
 | 
						||
                      "libdrm"
 | 
						||
                      "libepoxy"
 | 
						||
                      "pulseaudio"
 | 
						||
                      "vde2"
 | 
						||
                      "libcacard")))))
 | 
						||
 | 
						||
(define (system->qemu-target system)
 | 
						||
  (cond
 | 
						||
   ((string-prefix? "i686" system)
 | 
						||
    "qemu-system-i386")
 | 
						||
   ((string-prefix? "arm" system)
 | 
						||
    "qemu-system-arm")
 | 
						||
   (else
 | 
						||
    (string-append "qemu-system-" (match (string-split system #\-)
 | 
						||
                                    ((arch kernel) arch)
 | 
						||
                                    (_ system))))))
 | 
						||
 | 
						||
(define-public libx86emu
 | 
						||
  (package
 | 
						||
    (name "libx86emu")
 | 
						||
    (version "3.5")
 | 
						||
    (home-page "https://github.com/wfeldt/libx86emu")
 | 
						||
    (source (origin
 | 
						||
              (method git-fetch)
 | 
						||
              (uri (git-reference
 | 
						||
                    (url home-page)
 | 
						||
                    (commit version)))
 | 
						||
              (file-name (git-file-name name version))
 | 
						||
              (sha256
 | 
						||
               (base32 "11nj3y7maz9ch15b1c2b69gd8d7mpaha377zpdbvfsmg5w9zz93l"))
 | 
						||
              (modules '((guix build utils)))
 | 
						||
              (snippet `(begin
 | 
						||
                          ;; Remove git2log program file.
 | 
						||
                          (delete-file "git2log")
 | 
						||
                          ;; Remove variables that depends on git2log.
 | 
						||
                          (substitute* "Makefile"
 | 
						||
                            (("GIT2LOG.*=.*$") "")
 | 
						||
                            (("GITDEPS.*=.*$") "")
 | 
						||
                            (("BRANCH.*=.*$") ""))))))
 | 
						||
    (build-system gnu-build-system)
 | 
						||
    (arguments
 | 
						||
     `(#:test-target "test"
 | 
						||
       ;; sys/io.h is not present from glibc on non-x86 systems.
 | 
						||
       #:tests? ,(and (target-x86?)
 | 
						||
                      (not (%current-target-system)))
 | 
						||
       #:phases (modify-phases %standard-phases
 | 
						||
                  (add-after 'unpack 'patch
 | 
						||
                    (lambda* (#:key outputs #:allow-other-keys)
 | 
						||
                      (let* ((out (assoc-ref outputs "out"))
 | 
						||
                             (include (string-append out "/include"))
 | 
						||
                             (lib (string-append out "/lib")))
 | 
						||
                        ;; Correct the values of version and install directories.
 | 
						||
                        (substitute* "Makefile"
 | 
						||
                          (("VERSION.*=.*$")
 | 
						||
                           (string-append "VERSION := "
 | 
						||
                                          ,version "\n"))
 | 
						||
                          (("PREFIX.*=.*$")
 | 
						||
                           (string-append "PREFIX := " out "\n"))
 | 
						||
                          (("MAJOR_VERSION.*=.*$")
 | 
						||
                           (string-append "MAJOR_VERSION := "
 | 
						||
                                          ,(version-major version) "\n"))
 | 
						||
                          (("LIBDIR.*=.*$")
 | 
						||
                           (string-append "LIBDIR = " lib "\n"))
 | 
						||
                          (("/usr/include")
 | 
						||
                           include)))))
 | 
						||
                  (delete 'configure)))) ;no configure script
 | 
						||
    (native-inputs (list nasm perl))
 | 
						||
    (synopsis "Library for x86 emulation")
 | 
						||
    (description
 | 
						||
     "Libx86emu is a small library to emulate x86 instructions.  The
 | 
						||
focus here is not a complete emulation but to cover enough for typical
 | 
						||
firmware blobs.  You can
 | 
						||
@enumerate
 | 
						||
@item intercept any memory access or directly map real memory ranges
 | 
						||
@item intercept any i/o access, map real i/o ports, or block any real i/o
 | 
						||
@item intercept any interrupt
 | 
						||
@item add a hook to run after each instruction
 | 
						||
@item recognize a special x86 instruction that can trigger logging
 | 
						||
@item use integrated logging
 | 
						||
@end enumerate")
 | 
						||
    (license (license:x11-style "file://LICENSE"))))
 | 
						||
 | 
						||
(define-public ganeti
 | 
						||
  (package
 | 
						||
    (name "ganeti")
 | 
						||
    (version "3.0.2")
 | 
						||
    (source (origin
 | 
						||
              (method git-fetch)
 | 
						||
              (uri (git-reference
 | 
						||
                    (url "https://github.com/ganeti/ganeti")
 | 
						||
                    (commit (string-append "v" version))))
 | 
						||
              (sha256
 | 
						||
               (base32 "1xw7rm0k411aj0a4hrxz9drn7827bihp6bwizbapfx8k4c3125k4"))
 | 
						||
              (file-name (git-file-name name version))
 | 
						||
              (patches (search-patches "ganeti-shepherd-support.patch"
 | 
						||
                                       "ganeti-shepherd-master-failover.patch"
 | 
						||
                                       "ganeti-haskell-pythondir.patch"
 | 
						||
                                       "ganeti-pyyaml-compat.patch"
 | 
						||
                                       "ganeti-procps-compat.patch"
 | 
						||
                                       "ganeti-disable-version-symlinks.patch"
 | 
						||
                                       "ganeti-lens-compat.patch"
 | 
						||
                                       "ganeti-template-haskell-2.17.patch"
 | 
						||
                                       "ganeti-template-haskell-2.18.patch"
 | 
						||
                                       "ganeti-reorder-arbitrary-definitions.patch"
 | 
						||
                                       "ganeti-relax-dependencies.patch"))))
 | 
						||
    (build-system gnu-build-system)
 | 
						||
    (arguments
 | 
						||
     `(#:imported-modules (,@%gnu-build-system-modules
 | 
						||
                           (guix build haskell-build-system)
 | 
						||
                           (guix build python-build-system))
 | 
						||
       #:modules (,@%gnu-build-system-modules
 | 
						||
                  ((guix build haskell-build-system) #:prefix haskell:)
 | 
						||
                  ((guix build python-build-system) #:select (site-packages))
 | 
						||
                  (srfi srfi-1)
 | 
						||
                  (srfi srfi-26)
 | 
						||
                  (ice-9 match)
 | 
						||
                  (ice-9 rdelim))
 | 
						||
 | 
						||
       ;; The default test target includes a lot of checks that are only really
 | 
						||
       ;; relevant for developers such as NEWS file checking, line lengths, etc.
 | 
						||
       ;; We are only interested in the "py-tests" and "hs-tests" targets: this
 | 
						||
       ;; is the closest we've got even though it includes a little more.
 | 
						||
       #:test-target "check-TESTS"
 | 
						||
 | 
						||
       #:configure-flags
 | 
						||
       (list "--localstatedir=/var"
 | 
						||
             "--sharedstatedir=/var"
 | 
						||
             "--sysconfdir=/etc"
 | 
						||
             "--enable-haskell-tests"
 | 
						||
 | 
						||
             ;; By default, the build system installs everything to versioned
 | 
						||
             ;; directories such as $libdir/3.0 and relies on a $libdir/default
 | 
						||
             ;; symlink pointed from /etc/ganeti/{lib,share} to actually function.
 | 
						||
             ;; This is done to accommodate installing multiple versions in
 | 
						||
             ;; parallel, but is of little use to us as Guix users can just
 | 
						||
             ;; roll back and forth.  Thus, disable it for simplicity.
 | 
						||
             "--disable-version-links"
 | 
						||
 | 
						||
             ;; Ganeti can optionally take control over SSH host keys and
 | 
						||
             ;; distribute them to nodes as they are added, and also rotate keys
 | 
						||
             ;; with 'gnt-cluster renew-crypto --new-ssh-keys'.  Thus it needs to
 | 
						||
             ;; know how to restart the SSH daemon.
 | 
						||
             "--with-sshd-restart-command='herd restart ssh-daemon'"
 | 
						||
 | 
						||
             ;; Look for OS definitions in this directory by default.  It can
 | 
						||
             ;; be changed in the cluster configuration.
 | 
						||
             "--with-os-search-path=/run/current-system/profile/share/ganeti/os"
 | 
						||
 | 
						||
             ;; The default QEMU executable to use.  We don't use the package
 | 
						||
             ;; here because this entry is stored in the cluster configuration.
 | 
						||
             (string-append "--with-kvm-path=/run/current-system/profile/bin/"
 | 
						||
                            ,(system->qemu-target (%current-system))))
 | 
						||
       #:phases
 | 
						||
       (modify-phases %standard-phases
 | 
						||
         (add-after 'unpack 'create-vcs-version
 | 
						||
           (lambda _
 | 
						||
             ;; If we are building from a git checkout, we need to create a
 | 
						||
             ;; 'vcs-version' file manually because the build system does
 | 
						||
             ;; not have access to the git repository information.
 | 
						||
             (unless (file-exists? "vcs-version")
 | 
						||
               (call-with-output-file "vcs-version"
 | 
						||
                 (lambda (port)
 | 
						||
                   (format port "v~a~%" ,version))))))
 | 
						||
         (add-after 'unpack 'patch-absolute-file-names
 | 
						||
           (lambda* (#:key inputs #:allow-other-keys)
 | 
						||
             (substitute* '("lib/utils/process.py"
 | 
						||
                            "lib/utils/text.py"
 | 
						||
                            "src/Ganeti/Constants.hs"
 | 
						||
                            "src/Ganeti/HTools/CLI.hs"
 | 
						||
                            "test/py/ganeti.config_unittest.py"
 | 
						||
                            "test/py/ganeti.hooks_unittest.py"
 | 
						||
                            "test/py/ganeti.utils.process_unittest.py"
 | 
						||
                            "test/py/ganeti.utils.text_unittest.py"
 | 
						||
                            "test/py/ganeti.utils.wrapper_unittest.py")
 | 
						||
               (("/bin/sh") (search-input-file inputs "/bin/sh"))
 | 
						||
               (("/bin/bash") (search-input-file inputs "/bin/bash"))
 | 
						||
               (("/usr/bin/env") (search-input-file inputs "/bin/env"))
 | 
						||
               (("/bin/true") (search-input-file inputs "/bin/true")))
 | 
						||
 | 
						||
             ;; This script is called by the node daemon at startup to perform
 | 
						||
             ;; sanity checks on the cluster IP addresses, and it is also used
 | 
						||
             ;; in a master-failover scenario.  Add absolute references to
 | 
						||
             ;; avoid propagating these executables.
 | 
						||
             (substitute* "tools/master-ip-setup"
 | 
						||
               (("arping") (search-input-file inputs "/bin/arping"))
 | 
						||
               (("ndisc6") (search-input-file inputs "/bin/ndisc6"))
 | 
						||
               (("fping") (search-input-file inputs "/sbin/fping"))
 | 
						||
               (("grep") (search-input-file inputs "/bin/grep"))
 | 
						||
               (("ip addr") (string-append (search-input-file inputs "/sbin/ip")
 | 
						||
                                           " addr")))))
 | 
						||
         (add-after 'unpack 'override-builtin-PATH
 | 
						||
           (lambda _
 | 
						||
             ;; Ganeti runs OS install scripts and similar with a built-in
 | 
						||
             ;; hard coded PATH.  Patch so it works on Guix System.
 | 
						||
             (substitute* "src/Ganeti/Constants.hs"
 | 
						||
               (("/sbin:/bin:/usr/sbin:/usr/bin")
 | 
						||
                "/run/setuid-programs:/run/current-system/profile/sbin:\
 | 
						||
/run/current-system/profile/bin"))))
 | 
						||
         (add-after 'bootstrap 'patch-sphinx-version-detection
 | 
						||
           (lambda _
 | 
						||
             ;; The build system runs 'sphinx-build --version' to verify that
 | 
						||
             ;; the Sphinx is recent enough, but does not expect the
 | 
						||
             ;; .sphinx-build-real executable name created by the Sphinx wrapper.
 | 
						||
             (substitute* "configure"
 | 
						||
               (("\\$SPHINX --version 2>&1")
 | 
						||
                "$SPHINX --version 2>&1 \
 | 
						||
| sed 's/.sphinx-build-real/sphinx-build/g'"))))
 | 
						||
 | 
						||
         ;; The build system invokes Cabal and GHC, which do not work with
 | 
						||
         ;; GHC_PACKAGE_PATH: <https://github.com/haskell/cabal/issues/3728>.
 | 
						||
         ;; Tweak the build system to do roughly what haskell-build-system does.
 | 
						||
         (add-before 'configure 'configure-haskell
 | 
						||
           (assoc-ref haskell:%standard-phases 'setup-compiler))
 | 
						||
         (add-after 'configure 'do-not-use-GHC_PACKAGE_PATH
 | 
						||
           (lambda _
 | 
						||
             (unsetenv "GHC_PACKAGE_PATH")
 | 
						||
             (substitute* "Makefile"
 | 
						||
               (("\\$\\(CABAL\\)")
 | 
						||
                "$(CABAL) --package-db=../package.conf.d")
 | 
						||
               (("\\$\\(GHC\\)")
 | 
						||
                "$(GHC) -package-db=../package.conf.d"))))
 | 
						||
         (add-after 'configure 'make-ghc-use-shared-libraries
 | 
						||
           (lambda _
 | 
						||
             (substitute* "Makefile"
 | 
						||
               (("HFLAGS =") "HFLAGS = -dynamic -fPIC"))))
 | 
						||
         (add-after 'configure 'fix-installation-directories
 | 
						||
           (lambda _
 | 
						||
             (substitute* "Makefile"
 | 
						||
               ;; Do not attempt to create /var during install.
 | 
						||
               (("\\$\\(DESTDIR\\)\\$\\{localstatedir\\}")
 | 
						||
                "$(DESTDIR)${prefix}${localstatedir}")
 | 
						||
               ;; Similarly, do not attempt to install the sample ifup scripts
 | 
						||
               ;; to /etc/ganeti.
 | 
						||
               (("\\$\\(DESTDIR\\)\\$\\(ifupdir\\)")
 | 
						||
                "$(DESTDIR)${prefix}$(ifupdir)"))))
 | 
						||
         (add-before 'build 'adjust-tests
 | 
						||
           (lambda _
 | 
						||
             ;; Disable tests that can not run.  Do it early to prevent
 | 
						||
             ;; touching the Makefile later and triggering a needless rebuild.
 | 
						||
             (substitute* "Makefile"
 | 
						||
               ;; These tests expect the presence of a 'root' user (via
 | 
						||
               ;; ganeti/runtime.py), which fails in the build environment.
 | 
						||
               (("test/py/ganeti\\.asyncnotifier_unittest\\.py") "")
 | 
						||
               (("test/py/ganeti\\.backend_unittest\\.py") "")
 | 
						||
               (("test/py/ganeti\\.daemon_unittest\\.py") "")
 | 
						||
               (("test/py/ganeti\\.hypervisor\\.hv_kvm_unittest\\.py") "")
 | 
						||
               (("test/py/ganeti\\.tools\\.ensure_dirs_unittest\\.py") "")
 | 
						||
               (("test/py/ganeti\\.utils\\.io_unittest-runasroot\\.py") "")
 | 
						||
               ;; Disable the bash_completion test, as it requires the full
 | 
						||
               ;; bash instead of bash-minimal.
 | 
						||
               (("test/py/bash_completion\\.bash")
 | 
						||
                "")
 | 
						||
               ;; This test requires networking.
 | 
						||
               (("test/py/import-export_unittest\\.bash")
 | 
						||
                ""))))
 | 
						||
         (add-after 'build 'build-bash-completions
 | 
						||
           (lambda _
 | 
						||
             (setenv "PYTHONPATH" ".")
 | 
						||
             (invoke "./autotools/build-bash-completion")
 | 
						||
             (unsetenv "PYTHONPATH")))
 | 
						||
         (add-before 'check 'pre-check
 | 
						||
           (lambda* (#:key inputs #:allow-other-keys)
 | 
						||
             ;; Set TZDIR so that time zones are found.
 | 
						||
             (setenv "TZDIR" (search-input-directory inputs "share/zoneinfo"))
 | 
						||
 | 
						||
             (substitute* "test/py/ganeti.utils.process_unittest.py"
 | 
						||
               ;; This test attempts to run an executable with
 | 
						||
               ;; RunCmd(..., reset_env=True), which fails because the default
 | 
						||
               ;; PATH from Constants.hs does not exist in the build container.
 | 
						||
               ((".*def testResetEnv.*" all)
 | 
						||
                (string-append "  @unittest.skipIf(True, "
 | 
						||
                               "\"cannot reset env in the build container\")\n"
 | 
						||
                               all))
 | 
						||
 | 
						||
               ;; XXX: Somehow this test fails in the build container, but
 | 
						||
               ;; works in 'guix environment -C', even without /bin/sh?
 | 
						||
               ((".*def testPidFile.*" all)
 | 
						||
                (string-append "  @unittest.skipIf(True, "
 | 
						||
                               "\"testPidFile fails in the build container\")\n"
 | 
						||
                               all)))
 | 
						||
 | 
						||
             ;; XXX: Why are these links not added automatically.
 | 
						||
             (with-directory-excursion "test/hs"
 | 
						||
               (for-each (lambda (file)
 | 
						||
                           (symlink "../../src/htools" file))
 | 
						||
                         '("hspace" "hscan" "hinfo" "hbal" "hroller"
 | 
						||
                           "hcheck" "hail" "hsqueeze")))))
 | 
						||
         (add-after 'install 'install-bash-completions
 | 
						||
           (lambda* (#:key outputs #:allow-other-keys)
 | 
						||
             (let* ((out (assoc-ref outputs "out"))
 | 
						||
                    (compdir (string-append out "/etc/bash_completion.d")))
 | 
						||
               (mkdir-p compdir)
 | 
						||
               (copy-file "doc/examples/bash_completion"
 | 
						||
                          (string-append compdir "/ganeti"))
 | 
						||
               ;; The one file contains completions for many different
 | 
						||
               ;; executables.  Create symlinks for found completions.
 | 
						||
               (with-directory-excursion compdir
 | 
						||
                 (for-each
 | 
						||
                  (lambda (prog) (symlink "ganeti" prog))
 | 
						||
                  (call-with-input-file "ganeti"
 | 
						||
                    (lambda (port)
 | 
						||
                      (let loop ((line (read-line port))
 | 
						||
                                 (progs '()))
 | 
						||
                        (if (eof-object? line)
 | 
						||
                            progs
 | 
						||
                            (if (string-prefix? "complete" line)
 | 
						||
                                (loop (read-line port)
 | 
						||
                                      ;; Extract "prog" from lines of the form:
 | 
						||
                                      ;; "complete -F _prog -o filenames prog".
 | 
						||
                                      ;; Note that 'burnin' is listed with the
 | 
						||
                                      ;; absolute file name, which is why we
 | 
						||
                                      ;; run everything through 'basename'.
 | 
						||
                                      (match (string-split line #\ )
 | 
						||
                                        ((commands ... prog)
 | 
						||
                                         (cons (basename prog) progs))))
 | 
						||
                                (loop (read-line port) progs)))))))))))
 | 
						||
         ;; Wrap all executables with GUIX_PYTHONPATH.  We can't borrow
 | 
						||
         ;; the phase from python-build-system because we also need to wrap
 | 
						||
         ;; the scripts in $out/lib/ganeti such as "node-daemon-setup".
 | 
						||
         (add-after 'install 'wrap
 | 
						||
           (lambda* (#:key inputs outputs #:allow-other-keys)
 | 
						||
             (let* ((out (assoc-ref outputs "out"))
 | 
						||
                    (sbin (string-append out "/sbin"))
 | 
						||
                    (lib (string-append out "/lib"))
 | 
						||
                    (PYTHONPATH (string-append (site-packages inputs outputs)
 | 
						||
                                               ":" (getenv "GUIX_PYTHONPATH"))))
 | 
						||
               (define (shell-script? file)
 | 
						||
                 (call-with-ascii-input-file file
 | 
						||
                   (lambda (port)
 | 
						||
                     (let ((shebang (false-if-exception (read-line port))))
 | 
						||
                       (and shebang
 | 
						||
                            (string-prefix? "#!" shebang)
 | 
						||
                            (or (string-contains shebang "/bin/bash")
 | 
						||
                                (string-contains shebang "/bin/sh")))))))
 | 
						||
 | 
						||
               (define* (wrap? file #:rest _)
 | 
						||
                 ;; Do not wrap shell scripts because some are meant to be
 | 
						||
                 ;; sourced, which breaks if they are wrapped.  We do wrap
 | 
						||
                 ;; the Haskell executables because some call out to Python
 | 
						||
                 ;; directly.
 | 
						||
                 (and (executable-file? file)
 | 
						||
                      (not (symbolic-link? file))
 | 
						||
                      (not (shell-script? file))))
 | 
						||
 | 
						||
               (for-each (lambda (file)
 | 
						||
                           (wrap-program file
 | 
						||
                             `("GUIX_PYTHONPATH" ":" prefix
 | 
						||
                               (,PYTHONPATH))))
 | 
						||
                         (append-map (cut find-files <> wrap?)
 | 
						||
                                     (list (string-append lib "/ganeti")
 | 
						||
                                           sbin)))))))))
 | 
						||
    (native-inputs
 | 
						||
     `(("haskell" ,ghc)
 | 
						||
       ("cabal" ,cabal-install)
 | 
						||
       ("m4" ,m4)
 | 
						||
 | 
						||
       ;; These inputs are necessary to bootstrap the package, because we
 | 
						||
       ;; have patched the build system.
 | 
						||
       ("autoconf" ,autoconf)
 | 
						||
       ("automake" ,automake)
 | 
						||
 | 
						||
       ;; For the documentation.
 | 
						||
       ("python-docutils" ,python-docutils)
 | 
						||
       ("sphinx" ,python-sphinx)
 | 
						||
       ("pandoc" ,pandoc)
 | 
						||
       ("dot" ,graphviz)
 | 
						||
 | 
						||
       ;; Test dependencies.
 | 
						||
       ("fakeroot" ,fakeroot)
 | 
						||
       ("ghc-temporary" ,ghc-temporary)
 | 
						||
       ("ghc-test-framework" ,ghc-test-framework)
 | 
						||
       ("ghc-test-framework-hunit" ,ghc-test-framework-hunit)
 | 
						||
       ("ghc-test-framework-quickcheck2" ,ghc-test-framework-quickcheck2)
 | 
						||
       ("python-mock" ,python-mock)
 | 
						||
       ("python-pyyaml" ,python-pyyaml)
 | 
						||
       ("openssh" ,openssh)
 | 
						||
       ("procps" ,procps)
 | 
						||
       ("shelltestrunner" ,shelltestrunner)
 | 
						||
       ("tzdata" ,tzdata-for-tests)))
 | 
						||
    (inputs
 | 
						||
     (list iputils                      ;for 'arping'
 | 
						||
           curl
 | 
						||
           fping
 | 
						||
           iproute
 | 
						||
           ndisc6
 | 
						||
           socat
 | 
						||
           qemu-minimal                 ;for qemu-img
 | 
						||
           ghc-attoparsec
 | 
						||
           ghc-base64-bytestring
 | 
						||
           ghc-cryptonite
 | 
						||
           ghc-curl
 | 
						||
           ghc-hinotify
 | 
						||
           ghc-hslogger
 | 
						||
           ghc-json
 | 
						||
           ghc-lens
 | 
						||
           ghc-lifted-base
 | 
						||
           ghc-network
 | 
						||
           ghc-old-time
 | 
						||
           ghc-psqueue
 | 
						||
           ghc-regex-pcre
 | 
						||
           ghc-utf8-string
 | 
						||
           ghc-zlib
 | 
						||
           ;; For the optional metadata daemon.
 | 
						||
           ghc-snap-core
 | 
						||
           ghc-snap-server
 | 
						||
           python
 | 
						||
           python-pyopenssl
 | 
						||
           python-simplejson
 | 
						||
           python-pyparsing
 | 
						||
           python-pyinotify
 | 
						||
           python-pycurl
 | 
						||
           python-bitarray
 | 
						||
           python-paramiko
 | 
						||
           python-psutil))
 | 
						||
    (home-page "https://www.ganeti.org/")
 | 
						||
    (synopsis "Cluster-based virtual machine management system")
 | 
						||
    (description
 | 
						||
     "Ganeti is a virtual machine management tool built on top of existing
 | 
						||
virtualization technologies such as Xen or KVM.  Ganeti controls:
 | 
						||
 | 
						||
@itemize @bullet
 | 
						||
@item Disk creation management;
 | 
						||
@item Operating system installation for instances (in co-operation with
 | 
						||
OS-specific install scripts); and
 | 
						||
@item Startup, shutdown, and failover between physical systems.
 | 
						||
@end itemize
 | 
						||
 | 
						||
Ganeti is designed to facilitate cluster management of virtual servers and
 | 
						||
to provide fast and simple recovery after physical failures, using
 | 
						||
commodity hardware.")
 | 
						||
    (license license:bsd-2)))
 | 
						||
 | 
						||
(define-public ganeti-instance-guix
 | 
						||
  (package
 | 
						||
    (name "ganeti-instance-guix")
 | 
						||
    (version "0.8")
 | 
						||
    (home-page "https://github.com/mbakke/ganeti-instance-guix")
 | 
						||
    (source (origin
 | 
						||
              (method git-fetch)
 | 
						||
              (uri (git-reference (url home-page) (commit version)))
 | 
						||
              (file-name (git-file-name name version))
 | 
						||
              (sha256
 | 
						||
               (base32
 | 
						||
                "0sw9ks3j3y33apdcghjxxjf09ld592z9skaa7bgn9d2lhplzjihr"))))
 | 
						||
    (build-system gnu-build-system)
 | 
						||
    (arguments
 | 
						||
     '(#:configure-flags '("--sysconfdir=/etc" "--localstatedir=/var")))
 | 
						||
    (native-inputs
 | 
						||
     (list autoconf automake jq))
 | 
						||
    (inputs
 | 
						||
     (list btrfs-progs
 | 
						||
           cryptsetup
 | 
						||
           e2fsprogs
 | 
						||
           f2fs-tools
 | 
						||
           lvm2
 | 
						||
           multipath-tools
 | 
						||
           util-linux
 | 
						||
           parted
 | 
						||
           xfsprogs))
 | 
						||
    (synopsis "Guix OS integration for Ganeti")
 | 
						||
    (description
 | 
						||
     "This package provides a guest OS definition for Ganeti that uses
 | 
						||
Guix to build virtual machines.")
 | 
						||
    (license license:gpl3+)))
 | 
						||
 | 
						||
(define-public ganeti-instance-debootstrap
 | 
						||
  (package
 | 
						||
    (name "ganeti-instance-debootstrap")
 | 
						||
    ;; We need two commits on top of the latest release for compatibility
 | 
						||
    ;; with newer sfdisk, as well as gnt-network integration.
 | 
						||
    (version "0.16-2-ge145396")
 | 
						||
    (home-page "https://github.com/ganeti/instance-debootstrap")
 | 
						||
    (source (origin
 | 
						||
              (method git-fetch)
 | 
						||
              (uri (git-reference (url home-page) (commit version)))
 | 
						||
              (file-name (git-file-name name version))
 | 
						||
              (sha256
 | 
						||
               (base32
 | 
						||
                "0f2isw9d8lawzj21rrq1q9xhq8xfa65rqbhqmrn59z201x9q1336"))))
 | 
						||
    (build-system gnu-build-system)
 | 
						||
    (arguments
 | 
						||
     '(#:configure-flags '("--sysconfdir=/etc" "--localstatedir=/var")
 | 
						||
       #:phases (modify-phases %standard-phases
 | 
						||
                  (add-after 'unpack 'add-absolute-references
 | 
						||
                    (lambda _
 | 
						||
                      (substitute* "common.sh.in"
 | 
						||
                        (("/sbin/blkid") (which "blkid"))
 | 
						||
                        (("kpartx -")
 | 
						||
                         (string-append (which "kpartx") " -")))
 | 
						||
                      (substitute* "import"
 | 
						||
                        (("restore -r")
 | 
						||
                         (string-append (which "restore") " -r")))
 | 
						||
                      (substitute* "export"
 | 
						||
                        (("dump -0")
 | 
						||
                         (string-append (which "dump") " -0")))
 | 
						||
                      (substitute* "create"
 | 
						||
                        (("debootstrap") (which "debootstrap"))
 | 
						||
                        (("`which run-parts`") (which "run-parts"))
 | 
						||
                        ;; Here we actually need to hard code /bin/passwd
 | 
						||
                        ;; because it's called via chroot, which fails if
 | 
						||
                        ;; "/bin" is not in PATH.
 | 
						||
                        (("passwd") "/bin/passwd"))
 | 
						||
                      #t))
 | 
						||
                  (add-after 'unpack 'set-dpkg-arch
 | 
						||
                    (lambda* (#:key system #:allow-other-keys)
 | 
						||
                      ;; The create script passes --arch to debootstrap,
 | 
						||
                      ;; and defaults to `dpkg --print-architecture` when
 | 
						||
                      ;; ARCH is not set in variant.conf.  Hard code the
 | 
						||
                      ;; build-time architecture to avoid the dpkg dependency.
 | 
						||
                      (let ((dpkg-arch
 | 
						||
                             (cond ((string-prefix? "x86_64" system)
 | 
						||
                                    "amd64")
 | 
						||
                                   ((string-prefix? "i686" system)
 | 
						||
                                    "i386")
 | 
						||
                                   ((string-prefix? "aarch64" system)
 | 
						||
                                    "arm64")
 | 
						||
                                   (else (car (string-split system #\-))))))
 | 
						||
                        (substitute* "create"
 | 
						||
                          (("`dpkg --print-architecture`")
 | 
						||
                           dpkg-arch))
 | 
						||
                        #t)))
 | 
						||
                  (add-after 'configure 'adjust-Makefile
 | 
						||
                    (lambda _
 | 
						||
                      ;; Do not attempt to create /etc/ganeti/instance-debootstrap
 | 
						||
                      ;; and /etc/default/ganeti-instance-debootstrap during install.
 | 
						||
                      ;; They are created by the Ganeti service.
 | 
						||
                      (substitute* "Makefile"
 | 
						||
                        (("\\$\\(variantsdir\\)")
 | 
						||
                         "$(prefix)/etc/ganeti/instance-debootstrap/variants")
 | 
						||
                        (("\\$\\(defaultsdir\\)")
 | 
						||
                         "$(prefix)/etc/default/ganeti-instance-debootstrap"))
 | 
						||
                      #t))
 | 
						||
                  (add-after 'install 'make-variants.list-symlink
 | 
						||
                    (lambda* (#:key outputs #:allow-other-keys)
 | 
						||
                      ;; The Ganeti OS API mandates a variants.list file that
 | 
						||
                      ;; describes all supported "variants" of this OS.
 | 
						||
                      ;; Guix generates this file, so make the original file
 | 
						||
                      ;; a symlink to it.
 | 
						||
                      (with-directory-excursion (string-append
 | 
						||
                                                 (assoc-ref outputs "out")
 | 
						||
                                                 "/share/ganeti/os/debootstrap")
 | 
						||
                        (delete-file "variants.list")
 | 
						||
                        (symlink "/etc/ganeti/instance-debootstrap/variants/variants.list"
 | 
						||
                                 "variants.list"))
 | 
						||
                      #t)))))
 | 
						||
    (native-inputs
 | 
						||
     (list autoconf automake))
 | 
						||
    (inputs
 | 
						||
     `(("debianutils" ,debianutils)
 | 
						||
       ("debootstrap" ,debootstrap)
 | 
						||
       ("dump" ,dump)
 | 
						||
       ("kpartx" ,multipath-tools)
 | 
						||
       ("util-linux" ,util-linux)))
 | 
						||
    (synopsis "Debian OS integration for Ganeti")
 | 
						||
    (description
 | 
						||
     "This package provides a guest OS definition for Ganeti.  It installs
 | 
						||
Debian or a derivative using @command{debootstrap}.")
 | 
						||
    (license license:gpl2+)))
 | 
						||
 | 
						||
(define-public rvvm
 | 
						||
  (package
 | 
						||
    (name "rvvm")
 | 
						||
    (version "0.5")
 | 
						||
    (source (origin
 | 
						||
              (method git-fetch)
 | 
						||
              (uri (git-reference
 | 
						||
                    (url "https://github.com/LekKit/RVVM")
 | 
						||
                    (commit (string-append "v" version))))
 | 
						||
              (file-name (git-file-name name version))
 | 
						||
              (sha256
 | 
						||
               (base32
 | 
						||
                "1ldabcrmpa044bahpqa6ymwbhhwy69slh77f0m3421sq6j50l06p"))))
 | 
						||
    (build-system cmake-build-system)
 | 
						||
    (arguments
 | 
						||
     (list
 | 
						||
       #:configure-flags
 | 
						||
       ;; See src/rvjit/rvjit.h for list of architectures.
 | 
						||
       #~(#$@(if (or (target-x86?)
 | 
						||
                     (target-arm?))
 | 
						||
               #~'()
 | 
						||
               #~(list "-DRVVM_USE_JIT=NO")))
 | 
						||
       #:modules `((srfi srfi-26)
 | 
						||
                  (guix build utils)
 | 
						||
                  (guix build cmake-build-system))
 | 
						||
       #:phases
 | 
						||
       #~(modify-phases %standard-phases
 | 
						||
           ;; Install phase inspired by the Makefile.
 | 
						||
           (replace 'install
 | 
						||
             (lambda _
 | 
						||
               (let ((src "../source/src/")
 | 
						||
                     (incl (string-append #$output "/include/rvvm/")))
 | 
						||
                 (install-file "rvvm" (string-append #$output "/bin"))
 | 
						||
                 (for-each
 | 
						||
                   (cut install-file <> (string-append #$output "/lib"))
 | 
						||
                   (find-files "." "\\.(so|a)$"))
 | 
						||
                 (install-file (string-append src "rvvmlib.h") incl)
 | 
						||
                 (for-each
 | 
						||
                   (cut install-file <> (string-append incl "devices"))
 | 
						||
                   (find-files (string-append src "devices") "\\.h$"))))))
 | 
						||
       #:tests? #f))    ; no tests
 | 
						||
    (home-page "https://github.com/LekKit/RVVM")
 | 
						||
    (synopsis "RISC-V virtual machine")
 | 
						||
    (description
 | 
						||
     "RVVM is a RISC-V CPU and system software implementation written in C.  It
 | 
						||
supports the entire RV64GC ISA, and it passes compliance tests for both RV64 and
 | 
						||
RV32.  OpenSBI, U-Boot, and custom firmwares boot and execute properly.  It is
 | 
						||
capable of running Linux, FreeBSD, OpenBSD, Haiku, and other OSes.  Furthermore,
 | 
						||
it emulates a variety of hardware and peripherals.")
 | 
						||
    (license (list license:gpl3+ license:mpl2.0))))
 | 
						||
 | 
						||
(define-public spike
 | 
						||
  (package
 | 
						||
    (name "spike")
 | 
						||
    (version "1.1.0")
 | 
						||
    (source (origin
 | 
						||
              (method git-fetch)
 | 
						||
              (uri (git-reference
 | 
						||
                     (url "https://github.com/riscv-software-src/riscv-isa-sim")
 | 
						||
                     (commit (string-append "v" version))))
 | 
						||
              (file-name (git-file-name name version))
 | 
						||
              (sha256
 | 
						||
               (base32 "0cik2m0byfp9ppq0hpg3xyrlp5ag1i4dww7a7872mlm36xxqagg0"))))
 | 
						||
    (build-system gnu-build-system)
 | 
						||
    (arguments
 | 
						||
     (list
 | 
						||
       #:phases
 | 
						||
       #~(modify-phases %standard-phases
 | 
						||
           (add-before 'configure 'configure-dtc-path
 | 
						||
             (lambda* (#:key inputs #:allow-other-keys)
 | 
						||
               ;; Reference dtc by its absolute store path.
 | 
						||
               (substitute* "riscv/dts.cc"
 | 
						||
                 (("DTC")
 | 
						||
                  (string-append "\"" (search-input-file inputs "/bin/dtc") "\""))))))))
 | 
						||
    (inputs
 | 
						||
     (list bash-minimal dtc))
 | 
						||
    (native-inputs
 | 
						||
     (list python-wrapper))
 | 
						||
    (home-page "https://github.com/riscv-software-src/riscv-isa-sim")
 | 
						||
    (synopsis "RISC-V ISA Simulator")
 | 
						||
    (description "Spike, the RISC-V ISA Simulator, implements a functional model
 | 
						||
of one or more RISC-V harts.")
 | 
						||
    (license license:bsd-3)))
 | 
						||
 | 
						||
(define-public libosinfo
 | 
						||
  (package
 | 
						||
    (name "libosinfo")
 | 
						||
    (version "1.10.0")
 | 
						||
    (source
 | 
						||
     (origin
 | 
						||
       (method url-fetch)
 | 
						||
       (uri (string-append "https://releases.pagure.org/libosinfo/libosinfo-"
 | 
						||
                           version ".tar.xz"))
 | 
						||
       (sha256
 | 
						||
        (base32
 | 
						||
         "0193sdvv9yj3h6wwhj441d2fhccc7fh0m36sl0fv5pl0ql7y0lm2"))))
 | 
						||
    (build-system meson-build-system)
 | 
						||
    (arguments
 | 
						||
     (list
 | 
						||
      #:configure-flags
 | 
						||
      #~(list (string-append "-Dwith-usb-ids-path="
 | 
						||
                             (search-input-file %build-inputs
 | 
						||
                                                "share/hwdata/usb.ids"))
 | 
						||
              (string-append "-Dwith-pci-ids-path="
 | 
						||
                             (search-input-file %build-inputs
 | 
						||
                                                "share/hwdata/pci.ids")))
 | 
						||
      #:phases
 | 
						||
      #~(modify-phases %standard-phases
 | 
						||
          (add-after 'unpack 'patch-osinfo-path
 | 
						||
            (lambda* (#:key native-inputs inputs #:allow-other-keys)
 | 
						||
              (substitute* "osinfo/osinfo_loader.c"
 | 
						||
                (("path = DATA_DIR.*")
 | 
						||
                 (format #f "path = ~s;"
 | 
						||
                         (search-input-directory (or native-inputs inputs)
 | 
						||
                                                 "share/osinfo")))))))))
 | 
						||
    (inputs (list libsoup libxml2 libxslt osinfo-db))
 | 
						||
    (native-inputs
 | 
						||
     (list `(,glib "bin")                ;glib-mkenums, etc.
 | 
						||
           gobject-introspection
 | 
						||
           gtk-doc/stable
 | 
						||
           `(,hwdata "pci")
 | 
						||
           `(,hwdata "usb")
 | 
						||
           vala
 | 
						||
           intltool
 | 
						||
           pkg-config))
 | 
						||
    (home-page "https://libosinfo.org/")
 | 
						||
    (synopsis "Operating system information database")
 | 
						||
    (description "libosinfo is a GObject based library API for managing
 | 
						||
information about operating systems, hypervisors and the (virtual) hardware
 | 
						||
devices they can support.  It includes a database containing device metadata
 | 
						||
and provides APIs to match/identify optimal devices for deploying an operating
 | 
						||
system on a hypervisor.  Via GObject Introspection, the API is available in
 | 
						||
all common programming languages.  Vala bindings are also provided.")
 | 
						||
    ;; The library files are released under LGPLv2.1 or later; the source
 | 
						||
    ;; files in the "tools" directory are released under GPLv2+.
 | 
						||
    (license (list license:lgpl2.1+ license:gpl2+))))
 | 
						||
 | 
						||
(define-public lxc
 | 
						||
  (package
 | 
						||
    (name "lxc")
 | 
						||
    (version "4.0.12")
 | 
						||
    (source (origin
 | 
						||
              (method url-fetch)
 | 
						||
              (uri (string-append
 | 
						||
                    "https://linuxcontainers.org/downloads/lxc/lxc-"
 | 
						||
                    version ".tar.gz"))
 | 
						||
              (sha256
 | 
						||
               (base32
 | 
						||
                "1vyk2j5w9gfyh23w3ar09cycyws16mxh3clbb33yhqzwcs1jy96v"))))
 | 
						||
    (build-system gnu-build-system)
 | 
						||
    (native-inputs
 | 
						||
     (list pkg-config docbook2x))
 | 
						||
    (inputs
 | 
						||
     (list gnutls libcap libseccomp libselinux))
 | 
						||
    (arguments
 | 
						||
     (list #:configure-flags
 | 
						||
           #~(list (string-append "--docdir=" #$output "/share/doc/"
 | 
						||
                                  #$name "-" #$version)
 | 
						||
                   "--sysconfdir=/etc"
 | 
						||
                   "--localstatedir=/var")
 | 
						||
           #:phases
 | 
						||
           #~(modify-phases %standard-phases
 | 
						||
               (replace 'install
 | 
						||
                 (lambda _
 | 
						||
                   (invoke "make" "install"
 | 
						||
                           (string-append "bashcompdir=" #$output
 | 
						||
                                          "/etc/bash_completion.d")
 | 
						||
                           ;; Don't install files into /var and /etc.
 | 
						||
                           "LXCPATH=/tmp/var/lib/lxc"
 | 
						||
                           "localstatedir=/tmp/var"
 | 
						||
                           "sysconfdir=/tmp/etc"
 | 
						||
                           "sysconfigdir=/tmp/etc/default"))))))
 | 
						||
    (synopsis "Linux container tools")
 | 
						||
    (home-page "https://linuxcontainers.org/")
 | 
						||
    (description
 | 
						||
     "LXC is a userspace interface for the Linux kernel containment features.
 | 
						||
Through a powerful API and simple tools, it lets Linux users easily create and
 | 
						||
manage system or application containers.")
 | 
						||
    (license license:lgpl2.1+)))
 | 
						||
 | 
						||
(define-public lxcfs
 | 
						||
  (package
 | 
						||
    (name "lxcfs")
 | 
						||
    (version "5.0.4")
 | 
						||
    (home-page "https://github.com/lxc/lxcfs")
 | 
						||
    (source
 | 
						||
     (origin
 | 
						||
       (method git-fetch)
 | 
						||
       (uri (git-reference (url home-page)
 | 
						||
                           (commit (string-append "lxcfs-" version))))
 | 
						||
       (file-name (git-file-name name version))
 | 
						||
       (sha256
 | 
						||
        (base32 "15cc7kvnln4qqlv22hprfzmq89jbkx7yra730hap8wkvamn33sxy"))))
 | 
						||
    (build-system meson-build-system)
 | 
						||
    (arguments
 | 
						||
     (list
 | 
						||
      #:configure-flags
 | 
						||
      #~(list "-Dinit-script=sysvinit"))) ; no ‘none’ option
 | 
						||
    (native-inputs
 | 
						||
     (list help2man pkg-config python python-jinja2))
 | 
						||
    (inputs
 | 
						||
     (list fuse))
 | 
						||
    (synopsis "FUSE-based file system for LXC")
 | 
						||
    (description "LXCFS is a small FUSE file system written with the intention
 | 
						||
of making Linux containers feel more like a virtual machine.
 | 
						||
It started as a side project of LXC but can be used by any run-time.")
 | 
						||
    (license license:lgpl2.1+)))
 | 
						||
 | 
						||
(define-public lxd
 | 
						||
  (package
 | 
						||
    (name "lxd")
 | 
						||
    (version "4.24")
 | 
						||
    (source (origin
 | 
						||
              (method url-fetch)
 | 
						||
              (uri (string-append
 | 
						||
                    "https://github.com/lxc/lxd/releases/download/"
 | 
						||
                    "lxd-" version "/lxd-" version ".tar.gz"))
 | 
						||
              (sha256
 | 
						||
               (base32
 | 
						||
                "0lmjmvm98m6yjxcqlfw690i71nazfzgrm3mzbjj77g1631df3ylp"))))
 | 
						||
    (build-system go-build-system)
 | 
						||
    (arguments
 | 
						||
     `(#:import-path "github.com/lxc/lxd"
 | 
						||
       #:tests? #f ;; tests fail due to missing /var, cgroups, etc.
 | 
						||
       #:modules ((guix build go-build-system)
 | 
						||
                  (guix build union)
 | 
						||
                  (guix build utils)
 | 
						||
                  (srfi srfi-1))
 | 
						||
       #:phases
 | 
						||
       (modify-phases %standard-phases
 | 
						||
         (add-after 'unpack 'unpack-dist
 | 
						||
           (lambda* (#:key import-path #:allow-other-keys)
 | 
						||
             (with-directory-excursion (string-append "src/" import-path)
 | 
						||
               ;; Move all the dependencies into the src directory.
 | 
						||
               (copy-recursively "_dist/src" "../../.."))))
 | 
						||
         (replace 'build
 | 
						||
           (lambda* (#:key import-path #:allow-other-keys)
 | 
						||
             (with-directory-excursion (string-append "src/" import-path)
 | 
						||
               (invoke "make" "build" "CC=gcc" "TAG_SQLITE3=libsqlite3"))))
 | 
						||
         (replace 'check
 | 
						||
           (lambda* (#:key tests? import-path #:allow-other-keys)
 | 
						||
             (when tests?
 | 
						||
               (with-directory-excursion (string-append "src/" import-path)
 | 
						||
                 (invoke "make" "check" "CC=gcc" "TAG_SQLITE3=libsqlite3")))))
 | 
						||
         (replace 'install
 | 
						||
           (lambda* (#:key inputs outputs import-path #:allow-other-keys)
 | 
						||
             (let* ((out (assoc-ref outputs "out"))
 | 
						||
                    (bin-dir
 | 
						||
                     (string-append out "/bin/"))
 | 
						||
                    (doc-dir
 | 
						||
                     (string-append out "/share/doc/lxd-" ,version))
 | 
						||
                    (completions-dir
 | 
						||
                     (string-append out "/share/bash-completion/completions")))
 | 
						||
               (with-directory-excursion (string-append "src/" import-path)
 | 
						||
                 ;; Wrap lxd with run-time dependencies.
 | 
						||
                 (wrap-program (string-append bin-dir "lxd")
 | 
						||
                   `("PATH" ":" prefix
 | 
						||
                     ,(fold (lambda (input paths)
 | 
						||
                              ;; TODO: Use 'search-input-directory' rather
 | 
						||
                              ;; than look up inputs by name.
 | 
						||
                              (let* ((in (assoc-ref inputs input))
 | 
						||
                                     (bin (string-append in "/bin"))
 | 
						||
                                     (sbin (string-append in "/sbin")))
 | 
						||
                                (append (filter file-exists?
 | 
						||
                                                (list bin sbin)) paths)))
 | 
						||
                            '()
 | 
						||
                            '("bash-minimal" "acl" "rsync" "tar" "xz" "btrfs-progs"
 | 
						||
                              "gzip" "dnsmasq" "squashfs-tools" "iproute2"
 | 
						||
                              "criu" "iptables" "attr"))))
 | 
						||
                 ;; Remove unwanted binaries.
 | 
						||
                 (for-each (lambda (prog)
 | 
						||
                             (delete-file (string-append bin-dir prog)))
 | 
						||
                           '("deps" "macaroon-identity" "generate"))
 | 
						||
                 ;; Install documentation.
 | 
						||
                 (for-each (lambda (file)
 | 
						||
                             (install-file file doc-dir))
 | 
						||
                           (find-files "doc"))
 | 
						||
                 ;; Install bash completion.
 | 
						||
                 (rename-file "scripts/bash/lxd-client" "scripts/bash/lxd")
 | 
						||
                 (install-file "scripts/bash/lxd" completions-dir))))))))
 | 
						||
    (native-inputs
 | 
						||
     (list ;; Test dependencies:
 | 
						||
           ;; ("go-github-com-rogpeppe-godeps" ,go-github-com-rogpeppe-godeps)
 | 
						||
           ;; ("go-github-com-tsenart-deadcode" ,go-github-com-tsenart-deadcode)
 | 
						||
           ;; ("go-golang-org-x-lint" ,go-golang-org-x-lint)
 | 
						||
           pkg-config))
 | 
						||
    (inputs
 | 
						||
     (list acl
 | 
						||
           eudev
 | 
						||
           libdqlite
 | 
						||
           libraft
 | 
						||
           libcap
 | 
						||
           lxc
 | 
						||
           ;; Run-time dependencies.
 | 
						||
           attr
 | 
						||
           bash-minimal
 | 
						||
           rsync
 | 
						||
           tar
 | 
						||
           xz
 | 
						||
           btrfs-progs
 | 
						||
           gzip
 | 
						||
           dnsmasq
 | 
						||
           squashfs-tools
 | 
						||
           iproute
 | 
						||
           criu
 | 
						||
           iptables))
 | 
						||
    (synopsis "Daemon based on liblxc offering a REST API to manage containers")
 | 
						||
    (home-page "https://linuxcontainers.org/lxd/")
 | 
						||
    (description "LXD is a next generation system container manager.  It
 | 
						||
offers a user experience similar to virtual machines but using Linux
 | 
						||
containers instead.  It's image based with pre-made images available for a
 | 
						||
wide number of Linux distributions and is built around a very powerful, yet
 | 
						||
pretty simple, REST API.")
 | 
						||
    (license license:asl2.0)))
 | 
						||
 | 
						||
(define-public libvirt
 | 
						||
  (package
 | 
						||
    (name "libvirt")
 | 
						||
    (version "8.6.0")
 | 
						||
    (source
 | 
						||
     (origin
 | 
						||
       (method url-fetch)
 | 
						||
       (uri (string-append "https://libvirt.org/sources/libvirt-"
 | 
						||
                           version ".tar.xz"))
 | 
						||
       (sha256
 | 
						||
        (base32 "1qisvbshbcd5305mrb4vni559k52id7c8iw4dwdydbf97b24f658"))
 | 
						||
       (patches (search-patches "libvirt-add-install-prefix.patch"))))
 | 
						||
    (build-system meson-build-system)
 | 
						||
    (arguments
 | 
						||
     (list
 | 
						||
      #:configure-flags
 | 
						||
      #~(list "-Ddriver_qemu=enabled"
 | 
						||
              "-Dqemu_user=nobody"
 | 
						||
              "-Dqemu_group=kvm"
 | 
						||
              "-Dstorage_disk=enabled"
 | 
						||
              "-Dstorage_dir=enabled"
 | 
						||
              "-Dpolkit=enabled"
 | 
						||
              ;; XXX The default, but required to make -Dsasl ‘stick’.
 | 
						||
              ;; See <https://gitlab.com/libvirt/libvirt/-/issues/185>
 | 
						||
              "-Ddriver_remote=enabled"
 | 
						||
              "-Dnls=enabled"           ;translations
 | 
						||
              (string-append "-Ddocdir=" #$output "/share/doc/"
 | 
						||
                             #$(package-name this-package) "-"
 | 
						||
                             #$(package-version this-package))
 | 
						||
              "-Dbash_completion=enabled"
 | 
						||
              (string-append "-Dinstall_prefix=" #$output)
 | 
						||
              "--sysconfdir=/etc"
 | 
						||
              "--localstatedir=/var")
 | 
						||
      #:phases
 | 
						||
      #~(modify-phases %standard-phases
 | 
						||
          (add-after 'unpack 'skip-directory-confusion
 | 
						||
            (lambda _
 | 
						||
              ;; Don't try to install an (unused) /var outside of the store.
 | 
						||
              (substitute* "scripts/meson-install-dirs.py"
 | 
						||
                (("destdir = .*")
 | 
						||
                 "destdir = '/tmp'"))))
 | 
						||
          (add-after 'unpack 'use-absolute-dnsmasq
 | 
						||
            (lambda* (#:key inputs #:allow-other-keys)
 | 
						||
              (let ((dnsmasq (search-input-file inputs "sbin/dnsmasq")))
 | 
						||
                (substitute* "src/util/virdnsmasq.c"
 | 
						||
                  (("#define DNSMASQ \"dnsmasq\"")
 | 
						||
                   (string-append "#define DNSMASQ \"" dnsmasq "\""))))))
 | 
						||
          (add-before 'configure 'disable-broken-tests
 | 
						||
            (lambda _
 | 
						||
              (let ((tests (list "commandtest"         ; hangs idly
 | 
						||
                                 "networkxml2conftest" ; fails with absolute dnsmasq
 | 
						||
                                 "qemuxml2argvtest"    ; fails
 | 
						||
                                 "virnetsockettest"))) ; tries to network
 | 
						||
                (substitute* "tests/meson.build"
 | 
						||
                  (((format #f ".*'name': '(~a)'.*" (string-join tests "|")))
 | 
						||
                   ""))))))))
 | 
						||
    (inputs
 | 
						||
     (list acl
 | 
						||
           attr
 | 
						||
           fuse-2
 | 
						||
           libxml2
 | 
						||
           eudev
 | 
						||
           libpciaccess
 | 
						||
           gnutls
 | 
						||
           dbus
 | 
						||
           libpcap
 | 
						||
           libnl
 | 
						||
           libssh2                      ;optional
 | 
						||
           libtirpc                     ;for <rpc/rpc.h>
 | 
						||
           `(,util-linux "lib")
 | 
						||
           lvm2                         ;for libdevmapper
 | 
						||
           curl
 | 
						||
           openssl
 | 
						||
           readline
 | 
						||
           cyrus-sasl
 | 
						||
           yajl
 | 
						||
           audit
 | 
						||
           dmidecode
 | 
						||
           dnsmasq
 | 
						||
           ebtables
 | 
						||
           parted
 | 
						||
           iproute
 | 
						||
           iptables))
 | 
						||
    (native-inputs
 | 
						||
     (list bash-completion
 | 
						||
           gettext-minimal
 | 
						||
           libxslt
 | 
						||
           perl
 | 
						||
           pkg-config
 | 
						||
           polkit
 | 
						||
           python-wrapper
 | 
						||
           python-docutils              ;for rst2html
 | 
						||
           rpcsvc-proto))               ;for rpcgen
 | 
						||
    (home-page "https://libvirt.org")
 | 
						||
    (synopsis "Simple API for virtualization")
 | 
						||
    (description "Libvirt is a C toolkit to interact with the virtualization
 | 
						||
capabilities of recent versions of Linux.  The library aims at providing long
 | 
						||
term stable C API initially for the Xen paravirtualization but should be able
 | 
						||
to integrate other virtualization mechanisms if needed.")
 | 
						||
    (license license:lgpl2.1+)))
 | 
						||
 | 
						||
(define-public libvirt-glib
 | 
						||
  (package
 | 
						||
    (name "libvirt-glib")
 | 
						||
    (version "4.0.0")
 | 
						||
    (source (origin
 | 
						||
              (method url-fetch)
 | 
						||
              (uri (string-append "ftp://libvirt.org/libvirt/glib/"
 | 
						||
                                  "libvirt-glib-" version ".tar.xz"))
 | 
						||
              (sha256
 | 
						||
               (base32
 | 
						||
                "1gdcvqz88qkp402zra9csc6391f2xki1270x683n6ixakl3gf8w4"))))
 | 
						||
    (build-system meson-build-system)
 | 
						||
    (inputs
 | 
						||
     (list openssl cyrus-sasl lvm2 ; for libdevmapper
 | 
						||
           yajl))
 | 
						||
    (native-inputs
 | 
						||
     (list pkg-config intltool
 | 
						||
           `(,glib "bin") vala))
 | 
						||
    (propagated-inputs
 | 
						||
     ;; ‘Required:’ by the installed .pc files.
 | 
						||
     (list glib libvirt libxml2 gobject-introspection))
 | 
						||
    (home-page "https://libvirt.org")
 | 
						||
    (synopsis "GLib wrapper around libvirt")
 | 
						||
    (description "libvirt-glib wraps the libvirt library to provide a
 | 
						||
high-level object-oriented API better suited for glib-based applications, via
 | 
						||
three libraries:
 | 
						||
 | 
						||
@enumerate
 | 
						||
@item libvirt-glib - GLib main loop integration & misc helper APIs
 | 
						||
@item libvirt-gconfig - GObjects for manipulating libvirt XML documents
 | 
						||
@item libvirt-gobject - GObjects for managing libvirt objects
 | 
						||
@end enumerate
 | 
						||
")
 | 
						||
    (license license:lgpl2.1+)))
 | 
						||
 | 
						||
(define-public python-libvirt
 | 
						||
  (package
 | 
						||
    (name "python-libvirt")
 | 
						||
    (version "8.6.0")
 | 
						||
    (source
 | 
						||
     (origin
 | 
						||
       (method url-fetch)
 | 
						||
       (uri (string-append "https://libvirt.org/sources/python/libvirt-python-"
 | 
						||
                           version ".tar.gz"))
 | 
						||
       (sha256
 | 
						||
        (base32 "0wa86jliq71x60dd4vyzsj4lcrb82i5qsgxz9azvwgsgi9j9mx41"))))
 | 
						||
    (build-system python-build-system)
 | 
						||
    (inputs
 | 
						||
     (list libvirt))
 | 
						||
    (propagated-inputs
 | 
						||
     (list python-lxml))
 | 
						||
    (native-inputs
 | 
						||
     (list pkg-config python-pytest))
 | 
						||
    (home-page "https://libvirt.org")
 | 
						||
    (synopsis "Python bindings to libvirt")
 | 
						||
    (description "This package provides Python bindings to the libvirt
 | 
						||
virtualization library.")
 | 
						||
    (properties
 | 
						||
     '((upstream-name . "libvirt-python")))
 | 
						||
    (license license:lgpl2.1+)))
 | 
						||
 | 
						||
(define-public virt-manager
 | 
						||
  (package
 | 
						||
    (name "virt-manager")
 | 
						||
    (version "4.1.0")
 | 
						||
    (source (origin
 | 
						||
              (method url-fetch)
 | 
						||
              (uri (string-append "https://virt-manager.org/download/sources"
 | 
						||
                                  "/virt-manager/virt-manager-"
 | 
						||
                                  version ".tar.gz"))
 | 
						||
              (sha256
 | 
						||
               (base32
 | 
						||
                "18lhlnd3gmyzhbnjc16gdyzhjcd33prlxnca4xlidiidngbq21lm"))))
 | 
						||
    (build-system python-build-system)
 | 
						||
    (arguments
 | 
						||
     (list #:use-setuptools? #f      ; uses custom distutils 'install' command
 | 
						||
           #:tests? #f               ; TODO: The tests currently fail
 | 
						||
                                     ; RuntimeError: Loop condition wasn't met
 | 
						||
           #:imported-modules
 | 
						||
           `((guix build glib-or-gtk-build-system)
 | 
						||
             ,@%python-build-system-modules)
 | 
						||
           #:modules
 | 
						||
           '((ice-9 match)
 | 
						||
             (srfi srfi-26)
 | 
						||
             (guix build python-build-system)
 | 
						||
             ((guix build glib-or-gtk-build-system) #:prefix glib-or-gtk:)
 | 
						||
             (guix build utils))
 | 
						||
           #:phases
 | 
						||
           #~(modify-phases %standard-phases
 | 
						||
               (add-after 'unpack 'fix-setup
 | 
						||
                 (lambda _
 | 
						||
                   (substitute* "virtinst/buildconfig.py"
 | 
						||
                     (("/usr") #$output))))
 | 
						||
               (add-after 'unpack 'fix-default-uri
 | 
						||
                 (lambda* (#:key inputs #:allow-other-keys)
 | 
						||
                   ;; Xen is not available for now - so only patch qemu.
 | 
						||
                   (substitute* "virtManager/createconn.py"
 | 
						||
                     (("/usr(/bin/qemu-system-\\*)" _ suffix)
 | 
						||
                      (string-append #$(this-package-input "qemu") suffix)))))
 | 
						||
               (add-before 'wrap 'wrap-with-GI_TYPELIB_PATH
 | 
						||
                 (lambda* (#:key inputs #:allow-other-keys)
 | 
						||
                   (let* ((bin       (string-append #$output "/bin"))
 | 
						||
                          (bin-files (find-files bin ".*"))
 | 
						||
                          (paths     (map (match-lambda
 | 
						||
                                            ((output . directory)
 | 
						||
                                             (let* ((girepodir (string-append
 | 
						||
                                                                directory
 | 
						||
                                                                "/lib/girepository-1.0")))
 | 
						||
                                               (if (file-exists? girepodir)
 | 
						||
                                                   girepodir #f))))
 | 
						||
                                          inputs)))
 | 
						||
                     (for-each (lambda (file)
 | 
						||
                                 (format #t "wrapping ~a\n" file)
 | 
						||
                                 (wrap-program file
 | 
						||
                                   `("GI_TYPELIB_PATH" ":" prefix
 | 
						||
                                     ,(filter identity paths))))
 | 
						||
                               bin-files))))
 | 
						||
               (replace 'check
 | 
						||
                 (lambda* (#:key tests? #:allow-other-keys)
 | 
						||
                   (when tests?
 | 
						||
                     (setenv "HOME" "/tmp")
 | 
						||
                     (setenv "XDG_CACHE_HOME" "/tmp")
 | 
						||
                     (system "Xvfb :1 &")
 | 
						||
                     (setenv "DISPLAY" ":1")
 | 
						||
                     ;; Dogtail requires that Assistive Technology support be enabled
 | 
						||
                     (setenv "GTK_MODULES" "gail:atk-bridge")
 | 
						||
                     (invoke "dbus-run-session" "--" "pytest" "--uitests"))))
 | 
						||
               (add-after 'install 'glib-or-gtk-compile-schemas
 | 
						||
                 (assoc-ref glib-or-gtk:%standard-phases 'glib-or-gtk-compile-schemas))
 | 
						||
               (add-after 'wrap 'glib-or-gtk-wrap
 | 
						||
                 (assoc-ref glib-or-gtk:%standard-phases 'glib-or-gtk-wrap)))))
 | 
						||
    (inputs
 | 
						||
     (list dconf
 | 
						||
           gtk+
 | 
						||
           gtk-vnc
 | 
						||
           gtksourceview-4
 | 
						||
           libosinfo
 | 
						||
           libvirt
 | 
						||
           libvirt-glib
 | 
						||
           python-libvirt
 | 
						||
           python-libxml2
 | 
						||
           python-pycairo
 | 
						||
           python-pygobject
 | 
						||
           python-requests
 | 
						||
           qemu
 | 
						||
           spice-gtk
 | 
						||
           vte))
 | 
						||
    (native-inputs
 | 
						||
     (list `(,glib "bin")               ; glib-compile-schemas
 | 
						||
           gobject-introspection
 | 
						||
           `(,gtk+ "bin")               ; gtk-update-icon-cache
 | 
						||
           intltool
 | 
						||
           perl                         ; pod2man
 | 
						||
           python-docutils              ; rst2man
 | 
						||
           ;; The following are required for running the tests
 | 
						||
           ;; at-spi2-core
 | 
						||
           ;; dbus
 | 
						||
           ;; gsettings-desktop-schemas
 | 
						||
           ;; python-dogtail
 | 
						||
           ;; python-pytest
 | 
						||
           ;; xorg-server-for-tests        ; xvfb
 | 
						||
           ))
 | 
						||
    (home-page "https://virt-manager.org/")
 | 
						||
    (synopsis "Manage virtual machines")
 | 
						||
    (description
 | 
						||
     "The virt-manager application is a desktop user interface for managing
 | 
						||
virtual machines through libvirt.  It primarily targets KVM VMs, but also
 | 
						||
manages Xen and LXC (Linux containers).  It presents a summary view of running
 | 
						||
domains, their live performance and resource utilization statistics.")
 | 
						||
    (license license:gpl2+)))
 | 
						||
 | 
						||
(define-public vmware-open-vm-tools
 | 
						||
  (package
 | 
						||
    (name "vmware-open-vm-tools")
 | 
						||
    (version "12.3.0")
 | 
						||
    (source
 | 
						||
     (origin
 | 
						||
       (method git-fetch)
 | 
						||
       (uri (git-reference
 | 
						||
             (url "https://github.com/vmware/open-vm-tools")
 | 
						||
             (commit (string-append "stable-" version))))
 | 
						||
       (file-name (git-file-name name version))
 | 
						||
       (sha256
 | 
						||
        (base32 "1hbimhady0v1kd45azknl1lgzgldhgdjd7bj540rn3y4cai5cnk1"))))
 | 
						||
    (build-system gnu-build-system)
 | 
						||
    (arguments
 | 
						||
     (list
 | 
						||
      #:configure-flags
 | 
						||
      #~(list "--with-fuse=fuse3"
 | 
						||
              "--without-kernel-modules"
 | 
						||
              "--without-x"
 | 
						||
              (string-append
 | 
						||
               "--with-udev-rules-dir=" #$output "/lib/udev/rules.d"))
 | 
						||
      ;; TODO: Add iproute2 dbus which commands wrap.
 | 
						||
      #:phases
 | 
						||
      #~(modify-phases %standard-phases
 | 
						||
          (add-after 'unpack 'chdir
 | 
						||
            (lambda _
 | 
						||
              (chdir "open-vm-tools")))
 | 
						||
          (replace 'bootstrap
 | 
						||
            (lambda _
 | 
						||
              (system* "autoreconf" "-if")))
 | 
						||
          (add-after 'bootstrap 'patch-paths
 | 
						||
            (lambda _
 | 
						||
              (substitute* "Makefile.am"
 | 
						||
                (("/etc/vmware-tools/")
 | 
						||
                 (string-append #$output "/etc/vmware-tools/")))
 | 
						||
              (substitute* "scripts/Makefile.am"
 | 
						||
                (("/etc/vmware-tools")
 | 
						||
                 (string-append #$output "/etc/vmware-tools"))
 | 
						||
                (("/usr/bin")
 | 
						||
                 (string-append #$output "/bin")))
 | 
						||
              (substitute* "services/vmtoolsd/Makefile.am"
 | 
						||
                (("/etc/vmware-tools")
 | 
						||
                 (string-append #$output "/etc/vmware-tools"))
 | 
						||
                (("\\$\\(PAM_PREFIX\\)")
 | 
						||
                 (string-append #$output "/$(PAM_PREFIX)")))
 | 
						||
              (substitute* "vgauth/service/Makefile.am"
 | 
						||
                (("/etc/vmware-tools/vgauth/schemas")
 | 
						||
                 (string-append #$output "/etc/vmware-tools/vgauth/schemas"))
 | 
						||
                (("etc/vmware-tools/vgauth.conf")
 | 
						||
                 (string-append #$output "/etc/vmware-tools/vgauth.conf")))
 | 
						||
              (substitute* "vmhgfs-fuse/config.c"
 | 
						||
                (("/bin/fusermount3")
 | 
						||
                 (string-append
 | 
						||
                  #$(this-package-input "fuse") "/bin/fusermount3")))
 | 
						||
              ;; XXX: This part might need more testing with shutdown and halt
 | 
						||
              ;; commands provided by Shepherd.
 | 
						||
              (substitute* "lib/system/systemLinux.c"
 | 
						||
                (("/sbin/shutdown")
 | 
						||
                 (string-append
 | 
						||
                  #$(this-package-input "shepherd") "/sbin/shutdown"))
 | 
						||
                (("/bin/reboot")
 | 
						||
                 (string-append
 | 
						||
                  #$(this-package-input "shepherd") "/sbin/reboot")))
 | 
						||
              (substitute* "services/plugins/vix/foundryToolsDaemon.c"
 | 
						||
                (("/bin/mount")
 | 
						||
                 (string-append
 | 
						||
                  #$(this-package-input "util-linux") "/bin/mount"))
 | 
						||
                (("/usr/bin/vmhgfs-fuse")
 | 
						||
                 (string-append #$output "/bin/vmhgfs-fuse"))))))))
 | 
						||
    (native-inputs
 | 
						||
     (list `(,glib "bin")               ; for glib-genmarshal
 | 
						||
           autoconf
 | 
						||
           automake
 | 
						||
           libltdl
 | 
						||
           libtool
 | 
						||
           pkg-config))
 | 
						||
    (inputs
 | 
						||
     (list eudev
 | 
						||
           fuse
 | 
						||
           glib
 | 
						||
           xmlsec
 | 
						||
           libmspack
 | 
						||
           ;; libdnet ; Not packed
 | 
						||
           libtirpc
 | 
						||
           libxcrypt
 | 
						||
           libxml2
 | 
						||
           linux-pam
 | 
						||
           openssl
 | 
						||
           procps
 | 
						||
           rpcsvc-proto
 | 
						||
           shepherd     ;for 'halt' and 'reboot', invoked from VMWare host.
 | 
						||
           util-linux
 | 
						||
           xmlsec))
 | 
						||
    (home-page "https://github.com/vmware/open-vm-tools")
 | 
						||
    (synopsis "Tools for VMWare guest VM to enhance host-guest integration")
 | 
						||
    (description
 | 
						||
     "@code{open-vm-tools} is a set of services and modules that enable several
 | 
						||
features in VMware products for better management of, and seamless user
 | 
						||
interactions with, guests.
 | 
						||
 | 
						||
@code{open-vm-tools} enables the following features in VMware products:
 | 
						||
 | 
						||
@itemize
 | 
						||
@item The ability to perform virtual machine power operations gracefully.
 | 
						||
@item Execution of VMware provided or user configured scripts in guests during
 | 
						||
various power operations.
 | 
						||
@item The ability to run programs, commands and file system operation in guests
 | 
						||
to enhance guest automation.
 | 
						||
@item Authentication for guest operations.
 | 
						||
@item Periodic collection of network, disk, and memory usage information from
 | 
						||
the guest.
 | 
						||
@item Generation of heartbeat from guests to hosts so VMware's HA solution can
 | 
						||
determine guests' availability.
 | 
						||
@item Clock synchronization between guests and hosts or client desktops.
 | 
						||
@item Quiescing guest file systems to allow hosts to capture
 | 
						||
file-system-consistent guest snapshots.
 | 
						||
@item Execution of pre-freeze and post-thaw scripts while quiescing guest file
 | 
						||
systems.
 | 
						||
@item The ability to customize guest operating systems immediately after
 | 
						||
powering on virtual machines.
 | 
						||
@item Enabling shared folders between host and guest file systems on VMware
 | 
						||
Workstation and VMware Fusion.
 | 
						||
@item Copying and pasting text, graphics, and files between guests and hosts or
 | 
						||
client desktops.
 | 
						||
@end itemize")
 | 
						||
    (license license:gpl2)))
 | 
						||
 | 
						||
(define-public vmware-open-vm-tools-gtk
 | 
						||
  (package/inherit vmware-open-vm-tools
 | 
						||
    (name "vmware-open-vm-tools-gtk")
 | 
						||
    (inputs
 | 
						||
     (modify-inputs (package-inputs vmware-open-vm-tools)
 | 
						||
       (prepend gdk-pixbuf-xlib
 | 
						||
                gtk+
 | 
						||
                gtkmm-3
 | 
						||
                libdrm
 | 
						||
                libx11
 | 
						||
                libxext
 | 
						||
                libxi
 | 
						||
                libxinerama
 | 
						||
                libxrandr
 | 
						||
                libxrender
 | 
						||
                libxtst)))
 | 
						||
    (arguments
 | 
						||
     (substitute-keyword-arguments (package-arguments vmware-open-vm-tools)
 | 
						||
       ((#:configure-flags flags)
 | 
						||
        #~(delete "--without-x" #$flags))))
 | 
						||
    (description "This package provides a GTK+ support for @code{open-vm-tools}.")))
 | 
						||
 | 
						||
(define-public criu
 | 
						||
  (package
 | 
						||
    (name "criu")
 | 
						||
    (version "3.17.1")
 | 
						||
    (source
 | 
						||
     (origin
 | 
						||
       (method git-fetch)
 | 
						||
       (uri (git-reference
 | 
						||
             (url "https://github.com/checkpoint-restore/criu")
 | 
						||
             (commit (string-append "v" version))))
 | 
						||
       (file-name (git-file-name name version))
 | 
						||
       (sha256
 | 
						||
        (base32 "0ff3xfcf0wfz02fc0qbj56mci1a0xdl8jzaihaw6qyjvgrsiq7fh"))))
 | 
						||
    (build-system gnu-build-system)
 | 
						||
    (arguments
 | 
						||
     `(#:test-target "test"
 | 
						||
       #:tests? #f ; tests require mounting as root
 | 
						||
       #:make-flags
 | 
						||
       (list (string-append "PREFIX=" (assoc-ref %outputs "out"))
 | 
						||
             (string-append "LIBDIR=$(PREFIX)/lib")
 | 
						||
             ;; Upstream mistakenly puts binaries in /var.  Now, in practice no
 | 
						||
             ;; plugins are built, but the build system still fails otherwise.
 | 
						||
             (string-append "PLUGINDIR=$(LIBDIR)/criu")
 | 
						||
             (string-append "ASCIIDOC="
 | 
						||
                            (search-input-file %build-inputs
 | 
						||
                                               "/bin/asciidoc"))
 | 
						||
             (string-append "PYTHON=python3")
 | 
						||
             (string-append "XMLTO="
 | 
						||
                            (search-input-file %build-inputs
 | 
						||
                                               "/bin/xmlto")))
 | 
						||
       #:modules ((ice-9 ftw)
 | 
						||
                  ,@%gnu-build-system-modules)
 | 
						||
       #:phases
 | 
						||
       (modify-phases %standard-phases
 | 
						||
         (delete 'configure)            ; no configure script
 | 
						||
         (add-after 'unpack 'fix-documentation
 | 
						||
           (lambda* (#:key inputs outputs #:allow-other-keys)
 | 
						||
             (substitute* "Documentation/Makefile"
 | 
						||
               (("-m custom.xsl")
 | 
						||
                (string-append
 | 
						||
                 "-m custom.xsl --skip-validation -x "
 | 
						||
                 (assoc-ref inputs "docbook-xsl") "/xml/xsl/"
 | 
						||
                 ,(package-name docbook-xsl) "-"
 | 
						||
                 ,(package-version docbook-xsl)
 | 
						||
                 "/manpages/docbook.xsl")))))
 | 
						||
         (add-after 'unpack 'hardcode-variables
 | 
						||
           (lambda* (#:key inputs outputs #:allow-other-keys)
 | 
						||
             ;; Hardcode arm version detection
 | 
						||
             (substitute* "Makefile"
 | 
						||
               (("ARMV.*:=.*") "ARMV := 7\n"))
 | 
						||
             ;; Hard-code the correct PLUGINDIR above.
 | 
						||
             (substitute* "criu/include/plugin.h"
 | 
						||
               (("/var") (string-append (assoc-ref outputs "out"))))
 | 
						||
             ))
 | 
						||
         ;; TODO: use
 | 
						||
         ;; (@@ (guix build python-build-system) ensure-no-mtimes-pre-1980)
 | 
						||
         ;; when it no longer throws due to trying to call UTIME on symlinks.
 | 
						||
         (add-after 'unpack 'ensure-no-mtimes-pre-1980
 | 
						||
           (lambda _
 | 
						||
             (let ((early-1980 315619200))  ; 1980-01-02 UTC
 | 
						||
               (ftw "." (lambda (file stat flag)
 | 
						||
                          (unless (or (<= early-1980 (stat:mtime stat))
 | 
						||
                                      (eq? (stat:type stat) 'symlink))
 | 
						||
                            (utime file early-1980 early-1980))
 | 
						||
                          #t)))))
 | 
						||
         (add-before 'build 'fix-symlink
 | 
						||
           (lambda* (#:key inputs #:allow-other-keys)
 | 
						||
             ;; The file 'images/google/protobuf/descriptor.proto' points to
 | 
						||
             ;; /usr/include/..., which obviously does not exist.
 | 
						||
             (let* ((file "google/protobuf/descriptor.proto")
 | 
						||
                    (target (string-append "images/" file))
 | 
						||
                    (source (search-input-file
 | 
						||
                             inputs
 | 
						||
                             (string-append "include/" file))))
 | 
						||
               (delete-file target)
 | 
						||
               (symlink source target))))
 | 
						||
         (add-after 'install 'wrap
 | 
						||
           (lambda* (#:key inputs outputs #:allow-other-keys)
 | 
						||
             ;; Make sure 'crit' runs with the correct PYTHONPATH.
 | 
						||
             (let* ((out  (assoc-ref outputs "out"))
 | 
						||
                    (site (string-append out "/lib/python"
 | 
						||
                                         ,(version-major+minor
 | 
						||
                                           (package-version python))
 | 
						||
                                         "/site-packages"))
 | 
						||
                    (path (getenv "GUIX_PYTHONPATH")))
 | 
						||
               (wrap-program (string-append out "/bin/crit")
 | 
						||
                 `("GUIX_PYTHONPATH" ":" prefix (,site ,path))))))
 | 
						||
         (add-after 'install 'delete-static-libraries
 | 
						||
           ;; Not building/installing these at all doesn't seem to be supported.
 | 
						||
           (lambda* (#:key outputs #:allow-other-keys)
 | 
						||
             (let ((out (assoc-ref outputs "out")))
 | 
						||
               (for-each delete-file (find-files out "\\.a$"))))))))
 | 
						||
    (inputs
 | 
						||
     `(("protobuf" ,protobuf)
 | 
						||
       ("python-protobuf" ,python-protobuf)
 | 
						||
       ("iproute" ,iproute)
 | 
						||
       ("libaio" ,libaio)
 | 
						||
       ("libcap" ,libcap)
 | 
						||
       ("libnet" ,libnet)
 | 
						||
       ("libnl" ,libnl)
 | 
						||
       ("libbsd" ,libbsd)
 | 
						||
       ("nftables" ,nftables)))
 | 
						||
    (native-inputs
 | 
						||
     (list pkg-config
 | 
						||
           perl
 | 
						||
           asciidoc
 | 
						||
           xmlto
 | 
						||
           docbook-xml
 | 
						||
           docbook-xsl
 | 
						||
           python-toolchain))
 | 
						||
    (propagated-inputs
 | 
						||
     ;; included by 'rpc.pb-c.h'
 | 
						||
     (list protobuf-c))
 | 
						||
    (home-page "https://criu.org")
 | 
						||
    (synopsis "Checkpoint and restore in user space")
 | 
						||
    (description "Using this tool, you can freeze a running application (or
 | 
						||
part of it) and checkpoint it to a hard drive as a collection of files.  You
 | 
						||
can then use the files to restore and run the application from the point it
 | 
						||
was frozen at.  The distinctive feature of the CRIU project is that it is
 | 
						||
mainly implemented in user space.")
 | 
						||
    ;; The project is licensed under GPLv2; files in the lib/ directory are
 | 
						||
    ;; LGPLv2.1.
 | 
						||
    (license (list license:gpl2 license:lgpl2.1))))
 | 
						||
 | 
						||
(define-public python-qemu-qmp
 | 
						||
  (package
 | 
						||
    (name "python-qemu-qmp")
 | 
						||
    (version "0.0.0a0")
 | 
						||
    (source
 | 
						||
     (origin
 | 
						||
       (method url-fetch)
 | 
						||
       (uri (pypi-uri "qemu.qmp" version))
 | 
						||
       (sha256
 | 
						||
        (base32 "1rpsbiwvngij6fjcc5cx1azcc4dxmm080crr31wc7jrm7i61p7c2"))))
 | 
						||
    (build-system python-build-system)
 | 
						||
    (arguments
 | 
						||
     (list
 | 
						||
      #:phases
 | 
						||
      #~(modify-phases %standard-phases
 | 
						||
          (replace 'check
 | 
						||
            (lambda* (#:key tests? #:allow-other-keys)
 | 
						||
              (when tests?
 | 
						||
                ;; The Avocado test runner insists on writing stuff to HOME.
 | 
						||
                (setenv "HOME" "/tmp")
 | 
						||
                ;; The mypy tests fail (see:
 | 
						||
                ;; https://gitlab.com/jsnow/qemu.qmp/-/issues/1).
 | 
						||
                (delete-file "tests/mypy.sh")
 | 
						||
                (invoke "avocado" "--show=all" "run" "tests")))))))
 | 
						||
    (native-inputs
 | 
						||
     (list python-avocado-framework
 | 
						||
           python-setuptools-scm
 | 
						||
           python-flake8
 | 
						||
           python-isort
 | 
						||
           python-pylint))
 | 
						||
    (propagated-inputs
 | 
						||
     (list python-pygments
 | 
						||
           python-urwid
 | 
						||
           python-urwid-readline))
 | 
						||
    (home-page "https://gitlab.com/jsnow/qemu.qmp")
 | 
						||
    (synopsis "QEMU Monitor Protocol Python library")
 | 
						||
    (description "@code{emu.qmp} is a
 | 
						||
@url{https://gitlab.com/qemu-project/qemu/-/blob/master/docs/interop/qmp-intro.txt,
 | 
						||
QEMU Monitor Protocol (QMP)} library written in Python.  It is used to send
 | 
						||
QMP messages to running QEMU emulators.  It can be used to communicate with
 | 
						||
QEMU emulators, the QEMU Guest Agent (QGA), the QEMU Storage Daemon (QSD), or
 | 
						||
any other utility or application that speaks QMP.")
 | 
						||
    (license license:gpl2+)))
 | 
						||
 | 
						||
(define-public qmpbackup
 | 
						||
  (package
 | 
						||
    (name "qmpbackup")
 | 
						||
    (version "0.23")
 | 
						||
    (source (origin
 | 
						||
              (method git-fetch)
 | 
						||
              (uri (git-reference
 | 
						||
                    (url "https://github.com/abbbi/qmpbackup")
 | 
						||
                    (commit (string-append "v" version))))
 | 
						||
              (file-name (git-file-name name version))
 | 
						||
              (sha256
 | 
						||
               (base32
 | 
						||
                "0x9v81z0b2qr2y6m46rfnl4kl5jnixsdrl1c790iwl6pq9kzzvzg"))))
 | 
						||
    (build-system python-build-system)
 | 
						||
    ;; The test suite requires to download a 241 MiB QEMU image; skip it.
 | 
						||
    (arguments (list #:tests? #f))
 | 
						||
    (inputs (list python-qemu-qmp))
 | 
						||
    (home-page "https://github.com/abbbi/qmpbackup")
 | 
						||
    (synopsis "Backup and restore QEMU machines")
 | 
						||
    (description "@command{qmpbackup} is designed to create and restore full
 | 
						||
and incremental backups of running QEMU virtual machines via QMP, the QEMU
 | 
						||
Machine Protocol.")
 | 
						||
    (license license:gpl3+)))
 | 
						||
 | 
						||
(define-public looking-glass-client
 | 
						||
  (package
 | 
						||
    (name "looking-glass-client")
 | 
						||
    (version "B6")
 | 
						||
    (source (origin
 | 
						||
              (method url-fetch)
 | 
						||
              (uri (string-append "https://looking-glass.io/artifact/" version
 | 
						||
                                  "/source"))
 | 
						||
              (file-name (string-append name "-" version ".tar.gz"))
 | 
						||
              (sha256
 | 
						||
               (base32
 | 
						||
                "15d7wwbzfw28yqbz451b6n33ixy50vv8acyzi8gig1mq5a8gzdib"))))
 | 
						||
    (build-system cmake-build-system)
 | 
						||
    (inputs (list bash-minimal
 | 
						||
                  font-dejavu
 | 
						||
                  fontconfig
 | 
						||
                  freetype
 | 
						||
                  glu
 | 
						||
                  gmp
 | 
						||
                  libglvnd
 | 
						||
                  libiberty
 | 
						||
                  libsamplerate
 | 
						||
                  libx11
 | 
						||
                  libxcursor
 | 
						||
                  libxfixes
 | 
						||
                  libxi
 | 
						||
                  libxinerama
 | 
						||
                  libxkbcommon
 | 
						||
                  libxpresent
 | 
						||
                  libxrandr
 | 
						||
                  libxscrnsaver
 | 
						||
                  mesa
 | 
						||
                  pipewire
 | 
						||
                  pulseaudio
 | 
						||
                  spice-protocol
 | 
						||
                  wayland
 | 
						||
                  wayland-protocols
 | 
						||
                  `(,zlib "static")))
 | 
						||
    (native-inputs (list nettle pkg-config))
 | 
						||
    (arguments
 | 
						||
     (list #:tests? #f ;No tests are available.
 | 
						||
           ;; Package uses "-march=native" by default. We disable that to build with the
 | 
						||
           ;; lowest supported architecture for reproducibility and CPU compatibility.
 | 
						||
           #:configure-flags #~'("-DOPTIMIZE_FOR_NATIVE=OFF")
 | 
						||
           #:make-flags #~'("CC=gcc")
 | 
						||
           #:phases #~(modify-phases %standard-phases
 | 
						||
                        (add-before 'configure 'chdir-to-client
 | 
						||
                          (lambda* (#:key outputs #:allow-other-keys)
 | 
						||
                            (chdir "client")))
 | 
						||
                        (replace 'install
 | 
						||
                          (lambda* (#:key outputs #:allow-other-keys)
 | 
						||
                            (install-file "looking-glass-client"
 | 
						||
                                          (string-append (assoc-ref outputs
 | 
						||
                                                                    "out")
 | 
						||
                                                         "/bin"))))
 | 
						||
                        (add-after 'install 'wrapper
 | 
						||
                          (lambda* (#:key inputs outputs #:allow-other-keys)
 | 
						||
                            (wrap-program (string-append (assoc-ref outputs
 | 
						||
                                                                    "out")
 | 
						||
                                           "/bin/looking-glass-client")
 | 
						||
                              `("LD_LIBRARY_PATH" ":" prefix
 | 
						||
                                ,(map (lambda (name)
 | 
						||
                                        (let ((input (assoc-ref inputs name)))
 | 
						||
                                          (string-append input "/lib")))
 | 
						||
                                      '("gmp" "libxi"
 | 
						||
                                        "nettle"
 | 
						||
                                        "mesa"
 | 
						||
                                        "wayland"
 | 
						||
                                        "fontconfig-minimal"
 | 
						||
                                        "freetype"
 | 
						||
                                        "libx11"
 | 
						||
                                        "libxfixes"
 | 
						||
                                        "libxscrnsaver"
 | 
						||
                                        "libxinerama")))))))))
 | 
						||
    (home-page "https://looking-glass.io/")
 | 
						||
    (synopsis "KVM Frame Relay (KVMFR) implementation")
 | 
						||
    (description
 | 
						||
     "Looking Glass allows the use of a KVM (Kernel-based Virtual
 | 
						||
Machine) configured for VGA PCI Pass-through without an attached physical
 | 
						||
monitor, keyboard or mouse.  It displays the VM's rendered contents on your
 | 
						||
main monitor/GPU.")
 | 
						||
    ;; This package requires SSE instructions.
 | 
						||
    (supported-systems '("i686-linux" "x86_64-linux"))
 | 
						||
    (license license:gpl2+)))
 | 
						||
 | 
						||
(define-public runc
 | 
						||
  (package
 | 
						||
    (name "runc")
 | 
						||
    (version "1.1.12")
 | 
						||
    (source (origin
 | 
						||
              (method url-fetch)
 | 
						||
              (uri (string-append
 | 
						||
                    "https://github.com/opencontainers/runc/releases/"
 | 
						||
                    "download/v" version "/runc.tar.xz"))
 | 
						||
              (file-name (string-append name "-" version ".tar.xz"))
 | 
						||
              (sha256
 | 
						||
               (base32
 | 
						||
                "1mx4iik1gx1am3d2s4ljhrirwjzf4ikn8frba5hdhy74012y7na7"))))
 | 
						||
    (build-system go-build-system)
 | 
						||
    (arguments
 | 
						||
     '(#:import-path "github.com/opencontainers/runc"
 | 
						||
       #:install-source? #f
 | 
						||
       ;; XXX: 20/139 tests fail due to missing /var, cgroups and apparmor in
 | 
						||
       ;; the build environment.
 | 
						||
       #:tests? #f
 | 
						||
       #:phases
 | 
						||
       (modify-phases %standard-phases
 | 
						||
         (replace 'build
 | 
						||
           (lambda* (#:key import-path #:allow-other-keys)
 | 
						||
             (with-directory-excursion (string-append "src/" import-path)
 | 
						||
               (invoke "make" "all" "man"))))
 | 
						||
         (replace 'check
 | 
						||
           (lambda* (#:key tests? #:allow-other-keys)
 | 
						||
             (when tests?
 | 
						||
               (invoke "make" "localunittest"))))
 | 
						||
         (replace 'install
 | 
						||
           (lambda* (#:key import-path outputs #:allow-other-keys)
 | 
						||
             (with-directory-excursion (string-append "src/" import-path)
 | 
						||
               (let ((out (assoc-ref outputs "out")))
 | 
						||
                 (invoke "make" "install" "install-bash" "install-man"
 | 
						||
                         (string-append "PREFIX=" out)))))))))
 | 
						||
    (native-inputs
 | 
						||
     (list go-github-com-go-md2man pkg-config))
 | 
						||
    (inputs
 | 
						||
     (list libseccomp))
 | 
						||
    (synopsis "Open container initiative runtime")
 | 
						||
    (home-page "https://opencontainers.org/")
 | 
						||
    (description
 | 
						||
     "@command{runc} is a command line client for running applications
 | 
						||
packaged according to the
 | 
						||
@uref{https://github.com/opencontainers/runtime-spec/blob/master/spec.md, Open
 | 
						||
Container Initiative (OCI) format} and is a compliant implementation of the
 | 
						||
Open Container Initiative specification.")
 | 
						||
    (license license:asl2.0)))
 | 
						||
 | 
						||
(define-public umoci
 | 
						||
  (package
 | 
						||
    (name "umoci")
 | 
						||
    (version "0.4.7")
 | 
						||
    (source
 | 
						||
     (origin
 | 
						||
       (method url-fetch)
 | 
						||
       (uri (string-append
 | 
						||
             "https://github.com/opencontainers/umoci/releases/download/v"
 | 
						||
             version "/umoci.tar.xz"))
 | 
						||
       (file-name (string-append "umoci-" version ".tar.xz"))
 | 
						||
       (sha256
 | 
						||
        (base32 "0fvljj9k4f83wbqzd8nbijz0p1zaq633f8yxyvl5sy3wjf03ffk9"))))
 | 
						||
    (build-system go-build-system)
 | 
						||
    (arguments
 | 
						||
     '(#:import-path "github.com/opencontainers/umoci"
 | 
						||
       #:install-source? #f
 | 
						||
       #:phases
 | 
						||
       (modify-phases %standard-phases
 | 
						||
         (replace 'unpack
 | 
						||
           (lambda* (#:key source import-path #:allow-other-keys)
 | 
						||
             ;; Unpack the tarball into 'umoci' instead of "runc-${version}".
 | 
						||
             (let ((dest (string-append "src/" import-path)))
 | 
						||
               (mkdir-p dest)
 | 
						||
               (invoke "tar" "-C" (string-append "src/" import-path)
 | 
						||
                       "--strip-components=1"
 | 
						||
                       "-xvf" source))))
 | 
						||
         (replace 'build
 | 
						||
           (lambda* (#:key import-path #:allow-other-keys)
 | 
						||
             (with-directory-excursion (string-append "src/" import-path)
 | 
						||
               ;; TODO: build manpages with 'go-md2man'.
 | 
						||
               (invoke "make" "SHELL=bash"))))
 | 
						||
         (replace 'install
 | 
						||
           (lambda* (#:key import-path outputs #:allow-other-keys)
 | 
						||
             (let* ((out (assoc-ref outputs "out"))
 | 
						||
                    (bindir (string-append out "/bin")))
 | 
						||
               (install-file (string-append "src/" import-path "/umoci")
 | 
						||
                             bindir)
 | 
						||
               #t))))))
 | 
						||
    (home-page "https://umo.ci/")
 | 
						||
    (synopsis "Tool for modifying Open Container images")
 | 
						||
    (description
 | 
						||
     "@command{umoci} is a tool that allows for high-level modification of an
 | 
						||
Open Container Initiative (OCI) image layout and its tagged images.")
 | 
						||
    (license license:asl2.0)))
 | 
						||
 | 
						||
(define-public skopeo
 | 
						||
  (package
 | 
						||
    (name "skopeo")
 | 
						||
    (version "1.15.0")
 | 
						||
    (source (origin
 | 
						||
              (method git-fetch)
 | 
						||
              (uri (git-reference
 | 
						||
                    (url "https://github.com/containers/skopeo")
 | 
						||
                    (commit (string-append "v" version))))
 | 
						||
              (file-name (git-file-name name version))
 | 
						||
              (sha256
 | 
						||
               (base32
 | 
						||
                "1f9n3ysdmll7vq8dmgpv03m8aqq3w9cfvbmxxpwmnv1nlfc67ihq"))))
 | 
						||
    (build-system gnu-build-system)
 | 
						||
    (native-inputs
 | 
						||
     (list go-1.21
 | 
						||
           go-github-com-go-md2man
 | 
						||
           pkg-config))
 | 
						||
    (inputs
 | 
						||
     (list bash-minimal
 | 
						||
           btrfs-progs
 | 
						||
           eudev
 | 
						||
           libassuan
 | 
						||
           libselinux
 | 
						||
           libostree
 | 
						||
           lvm2
 | 
						||
           glib
 | 
						||
           gpgme))
 | 
						||
    (arguments
 | 
						||
     (list
 | 
						||
      #:make-flags
 | 
						||
      #~(list (string-append "CC=" #$(cc-for-target))
 | 
						||
              "PREFIX="
 | 
						||
              (string-append "DESTDIR=" #$output)
 | 
						||
              (string-append "GOMD2MAN="
 | 
						||
                             #$go-github-com-go-md2man "/bin/go-md2man"))
 | 
						||
      #:tests? #f                       ; The tests require Docker
 | 
						||
      #:test-target "test-unit"
 | 
						||
      #:imported-modules
 | 
						||
      (source-module-closure `(,@%gnu-build-system-modules
 | 
						||
                               (guix build go-build-system)))
 | 
						||
      #:phases
 | 
						||
      #~(modify-phases %standard-phases
 | 
						||
          (delete 'configure)
 | 
						||
          (add-after 'unpack 'set-env
 | 
						||
            (lambda _
 | 
						||
              ;; When running go, things fail because HOME=/homeless-shelter.
 | 
						||
              (setenv "HOME" "/tmp")
 | 
						||
              ;; Required for detecting btrfs in hack/btrfs* due to bug in GNU
 | 
						||
              ;; Make <4.4 causing CC not to be propagated into $(shell ...)
 | 
						||
              ;; calls.  Can be removed once we update to >4.3.
 | 
						||
              ;;
 | 
						||
              ;; This techically does nothing *now*, but after upstream
 | 
						||
              ;; issue[1] is solved and 'cc-to-gcc phase is removed, it will
 | 
						||
              ;; start being required.
 | 
						||
              ;; 1: https://github.com/containers/skopeo/issues/2278
 | 
						||
              (setenv "CC" #$(cc-for-target))))
 | 
						||
          (add-after 'unpack 'cc-to-gcc
 | 
						||
            (lambda _
 | 
						||
              (for-each (lambda (file)
 | 
						||
                          (substitute* file
 | 
						||
                            (("^cc( -.*)" all rest)
 | 
						||
                             (string-append "\"$CC\"" rest))))
 | 
						||
                        '("hack/btrfs_tag.sh"
 | 
						||
                          "hack/btrfs_installed_tag.sh"
 | 
						||
                          "hack/libdm_tag.sh"
 | 
						||
                          "hack/libsubid_tag.sh"))))
 | 
						||
          (add-after 'install 'wrap-skopeo
 | 
						||
            (lambda _
 | 
						||
              (wrap-program (string-append #$output "/bin/skopeo")
 | 
						||
                `("PATH" suffix
 | 
						||
                  ;; We need at least newuidmap, newgidmap and mount.
 | 
						||
                  ("/run/setuid-programs")))))
 | 
						||
          (add-after 'install 'remove-go-references
 | 
						||
            (@@ (guix build go-build-system) remove-go-references)))))
 | 
						||
    (home-page "https://github.com/containers/skopeo")
 | 
						||
    (synopsis "Interact with container images and container image registries")
 | 
						||
    (description
 | 
						||
     "@command{skopeo} is a command line utility providing various operations
 | 
						||
with container images and container image registries.  It can:
 | 
						||
@enumerate
 | 
						||
 | 
						||
@item Copy container images between various containers image stores,
 | 
						||
converting them as necessary.
 | 
						||
 | 
						||
@item Convert a Docker schema 2 or schema 1 container image to an OCI image.
 | 
						||
 | 
						||
@item Inspect a repository on a container registry without needlessly pulling
 | 
						||
the image.
 | 
						||
 | 
						||
@item Sign and verify container images.
 | 
						||
 | 
						||
@item Delete container images from a remote container registry.
 | 
						||
 | 
						||
@end enumerate")
 | 
						||
    (license license:asl2.0)))
 | 
						||
 | 
						||
(define-public ruby-vagrant-spec-helper-basic
 | 
						||
  (package
 | 
						||
    (name "ruby-vagrant-spec-helper-basic")
 | 
						||
    (version "0.2.0")
 | 
						||
    (source (origin
 | 
						||
              (method url-fetch)
 | 
						||
              (uri (rubygems-uri "vagrant-spec-helper-basic" version))
 | 
						||
              (sha256
 | 
						||
               (base32
 | 
						||
                "1qhxxc07dhrma1s1x2g9sma7xxgwzs20s6v5pv9jrpz6bl4b527n"))))
 | 
						||
    (build-system ruby-build-system)
 | 
						||
    (arguments
 | 
						||
     (list #:tests? #f))  ;; has not tests
 | 
						||
    (synopsis "Helper for vagrant-spec")
 | 
						||
    (description "This package is an internal helper for vagrant-spec.  Don't
 | 
						||
use it.")
 | 
						||
    (home-page "https://github.com/hashicorp/vagrant-spec")
 | 
						||
    (license license:mpl2.0)))
 | 
						||
 | 
						||
(define-public ruby-vagrant-spec
 | 
						||
  (package
 | 
						||
    (name "ruby-vagrant-spec")
 | 
						||
    (version "0.0.6")
 | 
						||
    (source (origin
 | 
						||
              (method url-fetch)
 | 
						||
              (uri (rubygems-uri "vagrant_spec" version))
 | 
						||
              (sha256
 | 
						||
               (base32
 | 
						||
                "1bkzz3mj7kzsv6k0ii8w31cgkpiqw3wvmvv2c6rknsavqqnagb4g"))))
 | 
						||
    (build-system ruby-build-system)
 | 
						||
    ;; (native-inputs (list ruby-rubocop ruby-vagrant-spec-helper-basic))
 | 
						||
    (propagated-inputs (list ruby-coveralls ruby-serverspec ruby-dep))
 | 
						||
    (arguments
 | 
						||
     (list
 | 
						||
      #:tests? #f  ;; tests require vagrant
 | 
						||
      ;; target 'test' includes 'cops' and running some ansible-playbook
 | 
						||
      #:test-target "unit"
 | 
						||
      #:phases
 | 
						||
      #~(modify-phases %standard-phases
 | 
						||
          (add-after 'unpack 'patch
 | 
						||
            (lambda _
 | 
						||
              (substitute* "Rakefile"
 | 
						||
                (("Bundler::GemHelper") "require 'bundler'\nBundler::GemHelper"))))
 | 
						||
          (add-before 'check 'prepare-check
 | 
						||
            (lambda _
 | 
						||
              (setenv "HOME" "/tmp"))))))
 | 
						||
    (synopsis "Specification and tests for Vagrant")
 | 
						||
    (description "@code{vagrant-spec} is a both a specification of how Vagrant
 | 
						||
and its various components should behave as well as a library of testing
 | 
						||
helpers that let you write your own unit and acceptance tests for Vagrant.")
 | 
						||
    (home-page "https://github.com/hashicorp/vagrant-spec")
 | 
						||
    (license license:mpl2.0)))
 | 
						||
 | 
						||
(define-public python-vagrant
 | 
						||
  (package
 | 
						||
    (name "python-vagrant")
 | 
						||
    (version "0.5.15")
 | 
						||
    (source
 | 
						||
      (origin
 | 
						||
        (method url-fetch)
 | 
						||
        (uri (pypi-uri "python-vagrant" version))
 | 
						||
        (sha256
 | 
						||
         (base32
 | 
						||
          "1ikrh6canhcxg5y7pzmkcnnydikppv7s6sm9prfx90nk0ac8m6mg"))))
 | 
						||
    (build-system python-build-system)
 | 
						||
    (arguments
 | 
						||
     '(#:tests? #f)) ; tests involve running vagrant.
 | 
						||
    (home-page "https://github.com/todddeluca/python-vagrant")
 | 
						||
    (synopsis "Python bindings for Vagrant")
 | 
						||
    (description
 | 
						||
     "Python-vagrant is a Python module that provides a thin wrapper around the
 | 
						||
@code{vagrant} command line executable, allowing programmatic control of Vagrant
 | 
						||
virtual machines.")
 | 
						||
    (license license:expat)))
 | 
						||
 | 
						||
(define-public bubblewrap
 | 
						||
  (package
 | 
						||
    (name "bubblewrap")
 | 
						||
    (version "0.8.0")
 | 
						||
    (source (origin
 | 
						||
              (method url-fetch)
 | 
						||
              (uri (string-append "https://github.com/containers/bubblewrap/"
 | 
						||
                                  "releases/download/v" version "/bubblewrap-"
 | 
						||
                                  version ".tar.xz"))
 | 
						||
              (sha256
 | 
						||
               (base32
 | 
						||
                "0fik7l8rm4yjkasskj7gw52s8jg3xfy152wqisw3s0xrklad2ylm"))
 | 
						||
               (patches (search-patches "bubblewrap-fix-locale-in-tests.patch"))))
 | 
						||
    (build-system gnu-build-system)
 | 
						||
    (arguments
 | 
						||
     `(#:phases
 | 
						||
       (modify-phases %standard-phases
 | 
						||
         (add-after 'unpack 'fix-test
 | 
						||
           (lambda* (#:key outputs #:allow-other-keys)
 | 
						||
             ;; Tests try to access /var/tmp, which is not possible in our build
 | 
						||
             ;; environment.  Let's give them another directory.
 | 
						||
             ;; /tmp gets overriden in some tests, so we need another directory.
 | 
						||
             ;; the only possibility is the output directory.
 | 
						||
             (let ((tmp-dir (string-append (assoc-ref outputs "out") "/tmp")))
 | 
						||
               (mkdir-p tmp-dir)
 | 
						||
               (substitute* "tests/test-run.sh"
 | 
						||
                 (("/var/tmp") tmp-dir)
 | 
						||
                 ;; Tests create a temporary python script, so fix its shebang.
 | 
						||
                 (("/usr/bin/env python3") (which "python3"))
 | 
						||
                 ;; Tests call /usr/bin/env, so fix its path.
 | 
						||
                 (("/usr/bin/env") (which "env"))
 | 
						||
                 ;; Some tests try to access /usr, but that doesn't exist.
 | 
						||
                 ;; Give them /gnu instead.
 | 
						||
                 (("/usr") "/gnu")
 | 
						||
                 (("--ro-bind /bin /bin") "--ro-bind /gnu /bin")
 | 
						||
                 (("--ro-bind /sbin /sbin") "--ro-bind /gnu /sbin")
 | 
						||
                 (("--ro-bind /lib /lib") "--ro-bind /gnu /lib")
 | 
						||
                 (("  */bin/bash") (which "bash"))
 | 
						||
                 (("/bin/sh") (which "sh"))
 | 
						||
                 (("findmnt") (which "findmnt")))
 | 
						||
               (substitute* "tests/libtest.sh"
 | 
						||
                 (("/var/tmp") tmp-dir)
 | 
						||
                 (("/usr") "/gnu")
 | 
						||
                 (("--ro-bind /bin /bin") "--ro-bind /gnu /bin")
 | 
						||
                 (("--ro-bind /sbin /sbin") "--ro-bind /gnu /sbin")
 | 
						||
                 (("--ro-bind /lib /lib") "--ro-bind /gnu /lib")))
 | 
						||
             #t))
 | 
						||
         ;; Remove the directory we gave to tests to have a clean package.
 | 
						||
         (add-after 'check 'remove-tmp-dir
 | 
						||
           (lambda* (#:key outputs #:allow-other-keys)
 | 
						||
             (delete-file-recursively (string-append (assoc-ref outputs "out") "/tmp"))
 | 
						||
             #t)))))
 | 
						||
    (inputs (list libcap))
 | 
						||
    (native-inputs (list python-wrapper util-linux))
 | 
						||
    (home-page "https://github.com/containers/bubblewrap")
 | 
						||
    (synopsis "Unprivileged sandboxing tool")
 | 
						||
    (description "Bubblewrap is aimed at running applications in a sandbox,
 | 
						||
restricting their access to parts of the operating system or user data such as
 | 
						||
the home directory.  Bubblewrap always creates a new mount namespace, and the
 | 
						||
user can specify exactly what parts of the file system should be made visible
 | 
						||
in the sandbox.  These directories are mounted with the @code{nodev} option
 | 
						||
by default and can be made read-only.")
 | 
						||
    (license license:lgpl2.0+)))
 | 
						||
 | 
						||
(define-public bochs
 | 
						||
  (package
 | 
						||
    (name "bochs")
 | 
						||
    (version "2.7")
 | 
						||
    (source
 | 
						||
     (origin
 | 
						||
       (method url-fetch)
 | 
						||
       (uri (string-append "https://sourceforge.net/projects/bochs/files/bochs/"
 | 
						||
                           version "/bochs-" version ".tar.gz"))
 | 
						||
       (sha256
 | 
						||
        (base32 "0ymiwnfqg5npq2dk9ngidbbfn3qw8z6i491finhcaan7zldsn450"))))
 | 
						||
    (build-system gnu-build-system)
 | 
						||
    (arguments
 | 
						||
     `(#:tests? #f))                    ; no tests exist
 | 
						||
    (inputs
 | 
						||
     (list libxrandr))
 | 
						||
    (home-page "https://bochs.sourceforge.net/")
 | 
						||
    (synopsis "Emulator for x86 PC")
 | 
						||
    (description
 | 
						||
     "Bochs is an emulator which can emulate Intel x86 CPU, common I/O
 | 
						||
devices, and a custom BIOS.  It can also be compiled to emulate many different
 | 
						||
x86 CPUs, from early 386 to the most recent x86-64 Intel and AMD processors.
 | 
						||
Bochs can run most Operating Systems inside the emulation including Linux,
 | 
						||
DOS or Microsoft Windows.")
 | 
						||
    (license license:lgpl2.0+)))
 | 
						||
 | 
						||
(define-public xen
 | 
						||
  (package
 | 
						||
    (name "xen")
 | 
						||
    (version "4.14.6")               ; please update the mini-os input as well
 | 
						||
    (source (origin
 | 
						||
              (method git-fetch)
 | 
						||
              (uri (git-reference
 | 
						||
                    (url "https://xenbits.xen.org/git-http/xen.git")
 | 
						||
                    (commit (string-append "RELEASE-" version))))
 | 
						||
              (file-name (git-file-name name version))
 | 
						||
              (sha256
 | 
						||
               (base32
 | 
						||
                "1cdzpxbihkdn4za8ly0lgkbxrafjzbxjflhfn83kyg4bam1vv7mn"))
 | 
						||
              (patches
 | 
						||
               (search-patches "xen-docs-use-predictable-ordering.patch"
 | 
						||
                               "xen-remove-config.gz-timestamp.patch"))))
 | 
						||
    (build-system gnu-build-system)
 | 
						||
    (arguments
 | 
						||
     (list
 | 
						||
      #:configure-flags
 | 
						||
      #~(list "--enable-rpath"
 | 
						||
              "--disable-qemu-traditional" ; tries to "git clone"
 | 
						||
              "--disable-rombios"       ; tries to "git clone" via etherboot
 | 
						||
              ;; TODO: Re-enable stubdom (it's "more secure" to use it).
 | 
						||
              "--disable-stubdom"    ; tries to "git clone" old patched newlib
 | 
						||
              (string-append "--with-initddir=" #$output "/etc/init.d")
 | 
						||
              (string-append "--with-system-qemu="
 | 
						||
                             (search-input-file %build-inputs
 | 
						||
                                                "bin/qemu-system-i386"))
 | 
						||
              (string-append "--with-system-seabios="
 | 
						||
                             (search-input-file %build-inputs
 | 
						||
                                                "share/firmware/bios.bin"))
 | 
						||
              (string-append "--with-system-ovmf="
 | 
						||
                             (search-input-file %build-inputs
 | 
						||
                                                "share/firmware/ovmf_ia32.bin")))
 | 
						||
      #:make-flags
 | 
						||
      #~(list "XEN_BUILD_DATE=Thu Jan  1 01:00:01 CET 1970"
 | 
						||
              "XEN_BUILD_TIME=01:00:01"
 | 
						||
              "XEN_BUILD_HOST="
 | 
						||
              "ETHERBOOT_NICS="
 | 
						||
              "SMBIOS_REL_DATE=01/01/1970"
 | 
						||
              "VGABIOS_REL_DATE=01 Jan 1970"
 | 
						||
              ;; QEMU_TRADITIONAL_LOC
 | 
						||
              ;; QEMU_UPSTREAM_LOC
 | 
						||
              "SYSCONFIG_DIR=/tmp/etc/default"
 | 
						||
              (string-append "BASH_COMPLETION_DIR=" #$output
 | 
						||
                             "/etc/bash_completion.d")
 | 
						||
              (string-append "BOOT_DIR=" #$output "/boot")
 | 
						||
              (string-append "DEBUG_DIR=" #$output "/lib/debug")
 | 
						||
              (string-append "EFI_DIR=" #$output "/lib/efi")
 | 
						||
              "MINIOS_UPSTREAM_URL=")
 | 
						||
      #:test-target "test"
 | 
						||
      #:phases
 | 
						||
      #~(modify-phases %standard-phases
 | 
						||
          (add-after 'unpack 'unpack-mini-os
 | 
						||
            (lambda* (#:key inputs #:allow-other-keys)
 | 
						||
              (let ((mini-os (dirname (search-input-file inputs "minios.mk"))))
 | 
						||
                (copy-recursively mini-os "extras/mini-os"))))
 | 
						||
          (add-after 'unpack-mini-os 'patch
 | 
						||
            (lambda* (#:key inputs #:allow-other-keys)
 | 
						||
              (substitute* "tools/firmware/Rules.mk"
 | 
						||
                (("override XEN_TARGET_ARCH = x86_32" match)
 | 
						||
                 (string-append match "\noverride CC = "
 | 
						||
                                (search-input-file inputs
 | 
						||
                                                   "bin/i686-linux-gnu-gcc")))
 | 
						||
                (("^CFLAGS =$" match)
 | 
						||
                 (string-append match " -I" (assoc-ref inputs "cross-libc")
 | 
						||
                                "/include\n")))
 | 
						||
              (substitute* "config/x86_32.mk"
 | 
						||
                (("(CFLAGS += )-m32 -march=i686" _ match)
 | 
						||
                 (string-append match "-march=i686 -I"
 | 
						||
                                (assoc-ref inputs "cross-libc") "/include")))
 | 
						||
              ;; /var is not in /gnu/store, so don't try to create it.
 | 
						||
              (substitute* '("tools/Makefile"
 | 
						||
                             "tools/xenstore/Makefile"
 | 
						||
                             "tools/xenpaging/Makefile")
 | 
						||
                (("\\$\\(INSTALL_DIR\\) .*XEN_(DUMP|LOG|RUN|LIB|PAGING)_DIR.*")
 | 
						||
                 "\n")
 | 
						||
                (("\\$\\(INSTALL_DIR\\) .*XEN_(RUN|LIB)_STORED.*") "\n"))
 | 
						||
              ;; Prevent xen from creating /etc.
 | 
						||
              (substitute* "tools/examples/Makefile"
 | 
						||
                ((" install-(configs|readmes)") ""))
 | 
						||
              ;; Set rpath.
 | 
						||
              (substitute* "tools/pygrub/setup.py"
 | 
						||
                (("library_dirs =" match)
 | 
						||
                 ;; TODO: extra_link_args = ['-Wl,-rpath=/opt/foo'],
 | 
						||
                 (string-append "runtime_library_dirs = ['" #$output "/lib'],"
 | 
						||
                                "\n" match)))))
 | 
						||
          (add-before 'configure 'patch-xen-script-directory
 | 
						||
            (lambda _
 | 
						||
              (substitute* '("configure"
 | 
						||
                             "tools/configure"
 | 
						||
                             "docs/configure")
 | 
						||
                (("(XEN_SCRIPT_DIR=).*" _ match)
 | 
						||
                 (string-append match #$output "/etc/xen/scripts")))))
 | 
						||
          (add-before 'configure 'set-environment-up
 | 
						||
            (lambda* (#:key make-flags #:allow-other-keys)
 | 
						||
              (define (cross? x)
 | 
						||
                (string-contains x "cross-i686-linux"))
 | 
						||
              (define (filter-environment! filter-predicate
 | 
						||
                                           environment-variable-names)
 | 
						||
                (for-each
 | 
						||
                 (lambda (env-name)
 | 
						||
                   (let* ((env-value (getenv env-name))
 | 
						||
                          (search-path (search-path-as-string->list env-value))
 | 
						||
                          (new-search-path (filter filter-predicate
 | 
						||
                                                   search-path))
 | 
						||
                          (new-env-value (list->search-path-as-string
 | 
						||
                                          new-search-path ":")))
 | 
						||
                     (setenv env-name new-env-value)))
 | 
						||
                 environment-variable-names))
 | 
						||
              (setenv "CROSS_C_INCLUDE_PATH" (getenv "C_INCLUDE_PATH"))
 | 
						||
              (setenv "CROSS_CPLUS_INCLUDE_PATH" (getenv "CPLUS_INCLUDE_PATH"))
 | 
						||
              (setenv "CROSS_LIBRARY_PATH" (getenv "LIBRARY_PATH"))
 | 
						||
              (filter-environment! cross?
 | 
						||
                                   '("CROSS_C_INCLUDE_PATH"
 | 
						||
                                     "CROSS_CPLUS_INCLUDE_PATH"
 | 
						||
                                     "CROSS_LIBRARY_PATH"))
 | 
						||
              (filter-environment! (lambda (e) (not (cross? e)))
 | 
						||
                                   '("C_INCLUDE_PATH" "CPLUS_INCLUDE_PATH"
 | 
						||
                                     "LIBRARY_PATH"))
 | 
						||
              ;; Guix tries to be helpful and automatically adds
 | 
						||
              ;; mini-os-git-checkout/include to the include path,
 | 
						||
              ;; but actually we don't want it to be there (yet).
 | 
						||
              (filter-environment! (lambda (e)
 | 
						||
                                     (not
 | 
						||
                                      (string-contains e
 | 
						||
                                                       "mini-os-git-checkout")))
 | 
						||
                                   '("C_INCLUDE_PATH" "CPLUS_INCLUDE_PATH"
 | 
						||
                                     "LIBRARY_PATH"))
 | 
						||
              (setenv "EFI_VENDOR" "guix")))
 | 
						||
          (replace 'build
 | 
						||
            (lambda* (#:key make-flags parallel-build? #:allow-other-keys)
 | 
						||
              (apply invoke "make" "world"
 | 
						||
                     "-j" (number->string
 | 
						||
                           (if parallel-build? (parallel-job-count) 1))
 | 
						||
                     make-flags)))
 | 
						||
          (add-after 'install 'remove-cruft
 | 
						||
            (lambda _
 | 
						||
              (with-directory-excursion #$output
 | 
						||
                ;; Delete useless (and irreproducible) build-time left-overs.
 | 
						||
                (for-each delete-file
 | 
						||
                          (find-files "share/doc" "^\\.deps$"))))))))
 | 
						||
    (inputs
 | 
						||
     (list acpica                       ; TODO: patch iasl invocation
 | 
						||
           bridge-utils                 ; TODO: patch invocations
 | 
						||
           glib
 | 
						||
           iproute                      ; TODO: patch invocations
 | 
						||
           libaio
 | 
						||
           libx11
 | 
						||
           yajl
 | 
						||
           ncurses
 | 
						||
           openssl
 | 
						||
           ovmf
 | 
						||
           pixman
 | 
						||
           qemu-minimal
 | 
						||
           seabios
 | 
						||
           `(,util-linux "lib")         ; uuid
 | 
						||
           ;; TODO: ocaml-findlib, ocaml-nox.
 | 
						||
           xz                           ; for liblzma
 | 
						||
           zlib))
 | 
						||
    (native-inputs
 | 
						||
     (list dev86
 | 
						||
       bison
 | 
						||
       cmake-minimal
 | 
						||
       figlet
 | 
						||
       flex
 | 
						||
       gettext-minimal
 | 
						||
       libnl
 | 
						||
       (origin
 | 
						||
         (method git-fetch)
 | 
						||
         (uri (git-reference
 | 
						||
               (url "https://xenbits.xen.org/git-http/mini-os.git")
 | 
						||
               ;; This corresponds to (string-append "xen-RELEASE-" version))
 | 
						||
               ;; at time of packaging, but upstream has unfortunately modified
 | 
						||
               ;; existing tags in the past.  Also, not all Xen releases get a
 | 
						||
               ;; new tag.  See <https://xenbits.xen.org/gitweb/?p=mini-os.git>.
 | 
						||
               (commit "f57858b7e8ef8dd48394dd08cec2bef3c9fb92f5")))
 | 
						||
         (sha256
 | 
						||
          (base32 "04y7grxs47amvjcq1rq4jgk174rhid5m2z9w8wrv7rfd2xhazxy1"))
 | 
						||
         (file-name (string-append name "-" version "-mini-os-git-checkout")))
 | 
						||
       perl
 | 
						||
       ;; TODO: markdown.
 | 
						||
       pkg-config
 | 
						||
       python-2
 | 
						||
       wget
 | 
						||
       (cross-gcc "i686-linux-gnu"
 | 
						||
                  #:xbinutils (cross-binutils "i686-linux-gnu")
 | 
						||
                  #:libc (cross-libc "i686-linux-gnu"))
 | 
						||
       (cross-libc "i686-linux-gnu") ; header files
 | 
						||
       `(,(cross-libc "i686-linux-gnu") "static")))
 | 
						||
    (home-page "https://xenproject.org/")
 | 
						||
    (synopsis "Xen Virtual Machine Monitor")
 | 
						||
    (description "This package provides the Xen Virtual Machine Monitor
 | 
						||
which is a hypervisor.")
 | 
						||
    ;; TODO: Some files are licensed differently.  List those.
 | 
						||
    (license license:gpl2)
 | 
						||
    (supported-systems '("i686-linux" "x86_64-linux" "armhf-linux"))))
 | 
						||
 | 
						||
(define-public osinfo-db-tools
 | 
						||
  (package
 | 
						||
    (name "osinfo-db-tools")
 | 
						||
    (version "1.10.0")
 | 
						||
    (source (origin
 | 
						||
              (method url-fetch)
 | 
						||
              (uri (string-append "https://releases.pagure.org/libosinfo/osinfo-db-tools-"
 | 
						||
                                  version ".tar.xz"))
 | 
						||
 | 
						||
              (sha256
 | 
						||
               (base32
 | 
						||
                "0s6ah44wbay7kb3l1ydr0r4ip335zgf6s12ghjjnww0nni9xsb40"))))
 | 
						||
    (build-system meson-build-system)
 | 
						||
    (inputs
 | 
						||
     (list libsoup-minimal-2 libxml2 libxslt json-glib libarchive))
 | 
						||
    (native-inputs
 | 
						||
     (list perl
 | 
						||
           gobject-introspection
 | 
						||
           gettext-minimal
 | 
						||
           pkg-config
 | 
						||
           ;; Tests
 | 
						||
           python
 | 
						||
           python-pytest
 | 
						||
           python-requests))
 | 
						||
    (home-page "https://gitlab.com/libosinfo/osinfo-db-tools")
 | 
						||
    (synopsis "Tools for managing the osinfo database")
 | 
						||
    (description "This package contains a set of tools to assist
 | 
						||
administrators and developers in managing the database.")
 | 
						||
    (license license:lgpl2.0+)))
 | 
						||
 | 
						||
(define-public osinfo-db
 | 
						||
  (package
 | 
						||
    (name "osinfo-db")
 | 
						||
    (version "20230719")
 | 
						||
    (source
 | 
						||
     (origin
 | 
						||
       (method url-fetch)
 | 
						||
       (uri (string-append "https://releases.pagure.org/libosinfo/osinfo-db-"
 | 
						||
                           version ".tar.xz"))
 | 
						||
       (sha256
 | 
						||
        (base32 "0nl4wh8i9skcg1wx84p31x7rl1xv1267g5ycbn9kfwfnqxzwkl8k"))))
 | 
						||
    (build-system trivial-build-system)
 | 
						||
    (arguments
 | 
						||
     (list
 | 
						||
      #:modules '((guix build utils))
 | 
						||
      #:builder
 | 
						||
      #~(begin
 | 
						||
          (use-modules (guix build utils))
 | 
						||
          (let ((osinfo (string-append #$output "/share/osinfo"))
 | 
						||
                (source (assoc-ref %build-inputs "source"))
 | 
						||
                (import-osinfo-db
 | 
						||
                 (string-append #$(this-package-native-input "osinfo-db-tools")
 | 
						||
                                "/bin/osinfo-db-import")))
 | 
						||
            (mkdir-p osinfo)
 | 
						||
            (invoke import-osinfo-db "--dir" osinfo source)))))
 | 
						||
    (native-inputs
 | 
						||
     (list intltool osinfo-db-tools))
 | 
						||
    (home-page "https://gitlab.com/libosinfo/osinfo-db")
 | 
						||
    (synopsis "Database of information about operating systems")
 | 
						||
    (description "Osinfo-db provides the database files for use with the
 | 
						||
libosinfo library.  It provides information about guest operating systems for
 | 
						||
use with virtualization provisioning tools")
 | 
						||
    (license license:lgpl2.0+)))
 | 
						||
 | 
						||
(define-public python-transient
 | 
						||
  (package
 | 
						||
    (name "python-transient")
 | 
						||
    (version "0.12")
 | 
						||
    (source
 | 
						||
     (origin
 | 
						||
       (method url-fetch)
 | 
						||
       (uri (pypi-uri "transient" version))
 | 
						||
       (sha256
 | 
						||
        (base32
 | 
						||
         "148yiqrmcscsi6787y0f27i1y9cf0gcw3mqfv5frhpmsmv62mv5z"))))
 | 
						||
    (build-system python-build-system)
 | 
						||
    (arguments
 | 
						||
     `(#:tests? #f ; Requires behave
 | 
						||
       #:phases (modify-phases %standard-phases
 | 
						||
                  (add-after 'unpack 'fix-dependencies
 | 
						||
                    (lambda _
 | 
						||
                      (substitute* "setup.py"
 | 
						||
                        (("==")
 | 
						||
                         ">="))
 | 
						||
                      #t)))))
 | 
						||
    (propagated-inputs
 | 
						||
     (list python-beautifultable
 | 
						||
           python-click
 | 
						||
           python-importlib-resources
 | 
						||
           python-lark-parser
 | 
						||
           python-marshmallow
 | 
						||
           python-progressbar2
 | 
						||
           python-requests
 | 
						||
           python-toml))
 | 
						||
    (native-inputs
 | 
						||
     (list python-black python-mypy python-pyhamcrest python-twine))
 | 
						||
    (home-page
 | 
						||
     "https://github.com/ALSchwalm/transient")
 | 
						||
    (synopsis
 | 
						||
     "QEMU Wrapper written in Python")
 | 
						||
    (description
 | 
						||
     "@code{transient} is a wrapper for QEMU allowing the creation of virtual
 | 
						||
machines with shared folder, ssh, and disk creation support.")
 | 
						||
    (license license:expat)))
 | 
						||
 | 
						||
(define-public riscv-pk
 | 
						||
  (package
 | 
						||
    (name "riscv-pk")
 | 
						||
    (version "1.0.0")
 | 
						||
    (source
 | 
						||
     (origin
 | 
						||
       (method git-fetch)
 | 
						||
       (uri (git-reference
 | 
						||
             (url "https://github.com/riscv-software-src/riscv-pk")
 | 
						||
             (commit (string-append "v" version))))
 | 
						||
       (file-name (git-file-name name version))
 | 
						||
       (sha256
 | 
						||
        (base32
 | 
						||
         "1cc0rz4q3a1zw8756b8yysw8lb5g4xbjajh5lvqbjix41hbdx6xz"))))
 | 
						||
    (build-system gnu-build-system)
 | 
						||
    (arguments
 | 
						||
     (list #:out-of-source? #t
 | 
						||
           ;; riscv-pk can only be built for riscv64.
 | 
						||
           #:target "riscv64-linux-gnu"
 | 
						||
           #:make-flags #~(list (string-append "INSTALLDIR=" #$output))
 | 
						||
           ;; Add flags to keep symbols fromhost and tohost. These symbols are
 | 
						||
           ;; required for the correct functioning of pk.
 | 
						||
           #:strip-flags #~(list "--strip-unneeded"
 | 
						||
                                 "--keep-symbol=fromhost"
 | 
						||
                                 "--keep-symbol=tohost"
 | 
						||
                                 "--enable-deterministic-archives")))
 | 
						||
    (home-page "https://github.com/riscv-software-src/riscv-pk")
 | 
						||
    (synopsis "RISC-V Proxy Kernel")
 | 
						||
    (description "The RISC-V Proxy Kernel, @command{pk}, is a lightweight
 | 
						||
application execution environment that can host statically-linked RISC-V ELF
 | 
						||
binaries.  It is designed to support tethered RISC-V implementations with
 | 
						||
limited I/O capability and thus handles I/O-related system calls by proxying
 | 
						||
them to a host computer.
 | 
						||
 | 
						||
This package also contains the Berkeley Boot Loader, @command{bbl}, which is a
 | 
						||
supervisor execution environment for tethered RISC-V systems.  It is designed
 | 
						||
to host the RISC-V Linux port.")
 | 
						||
    (license license:bsd-3)))
 |