gnu/packages/virtualization.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013-2017, 2020-2022 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2015, 2016, 2017, 2018 Mark H Weaver <mhw@netris.org>
   4 ;;; Copyright © 2016, 2017, 2018. 2019, 2020, 2021 Efraim Flashner <efraim@flashner.co.il>
   5 ;;; Copyright © 2016, 2017 Ricardo Wurmus <rekado@elephly.net>
   6 ;;; Copyright © 2017 Alex Vong <alexvong1995@gmail.com>
   7 ;;; Copyright © 2017 Andy Patterson <ajpatter@uwaterloo.ca>
   8 ;;; Copyright © 2017, 2018, 2019 Rutger Helling <rhelling@mykolab.com>
   9 ;;; Copyright © 2017–2021 Tobias Geerinckx-Rice <me@tobias.gr>
  10 ;;; Copyright © 2018 Danny Milosavljevic <dannym@scratchpost.org>
  11 ;;; Copyright © 2018 Sou Bunnbu <iyzsong@member.fsf.org>
  12 ;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
  13 ;;; Copyright © 2019 Guy Fleury Iteriteka <hoonandon@gmail.com>
  14 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
  15 ;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re>
  16 ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
  17 ;;; Copyright © 2020, 2021, 2022 Marius Bakke <marius@gnu.org>
  18 ;;; Copyright © 2020, 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
  19 ;;; Copyright © 2020 Brett Gilio <brettg@gnu.org>
  20 ;;; Copyright © 2021 Leo Famulari <leo@famulari.name>
  21 ;;; Copyright © 2021, 2022 Pierre Langlois <pierre.langlois@gmx.com>
  22 ;;; Copyright © 2021 Dion Mendel <guix@dm9.info>
  23 ;;; Copyright © 2021 Andrew Whatson <whatson@gmail.com>
  24 ;;; Copyright © 2021 Vincent Legoll <vincent.legoll@gmail.com>
  25 ;;; Copyright © 2021 Petr Hodina <phodina@protonmail.com>
  26 ;;; Copyright © 2021 Raghav Gururajan <rg@raghavgururajan.name>
  27 ;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>
  28 ;;; Copyright © 2022 Ekaitz Zarraga <ekaitz@elenq.tech>
  29 ;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
  30 ;;; Copyright © 2022 Zhu Zihao <all_but_last@163.com>
  31 ;;;
  32 ;;; This file is part of GNU Guix.
  33 ;;;
  34 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  35 ;;; under the terms of the GNU General Public License as published by
  36 ;;; the Free Software Foundation; either version 3 of the License, or (at
  37 ;;; your option) any later version.
  38 ;;;
  39 ;;; GNU Guix is distributed in the hope that it will be useful, but
  40 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  41 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  42 ;;; GNU General Public License for more details.
  43 ;;;
  44 ;;; You should have received a copy of the GNU General Public License
  45 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  46
  47 (define-module (gnu packages virtualization)
  48   #:use-module (gnu packages)
  49   #:use-module (gnu packages acl)
  50   #:use-module (gnu packages admin)
  51   #:use-module (gnu packages assembly)
  52   #:use-module (gnu packages attr)
  53   #:use-module (gnu packages autotools)
  54   #:use-module (gnu packages backup)
  55   #:use-module (gnu packages base)
  56   #:use-module (gnu packages bash)
  57   #:use-module (gnu packages bison)
  58   #:use-module (gnu packages bootloaders)
  59   #:use-module (gnu packages build-tools)
  60   #:use-module (gnu packages check)
  61   #:use-module (gnu packages cluster)
  62   #:use-module (gnu packages cmake)
  63   #:use-module (gnu packages compression)
  64   #:use-module (gnu packages cross-base)
  65   #:use-module (gnu packages curl)
  66   #:use-module (gnu packages cyrus-sasl)
  67   #:use-module (gnu packages debian)
  68   #:use-module (gnu packages disk)
  69   #:use-module (gnu packages dns)
  70   #:use-module (gnu packages docbook)
  71   #:use-module (gnu packages documentation)
  72   #:use-module (gnu packages figlet)
  73   #:use-module (gnu packages firmware)
  74   #:use-module (gnu packages flex)
  75   #:use-module (gnu packages fontutils)
  76   #:use-module (gnu packages freedesktop)
  77   #:use-module (gnu packages gettext)
  78   #:use-module (gnu packages gcc)
  79   #:use-module (gnu packages gl)
  80   #:use-module (gnu packages glib)
  81   #:use-module (gnu packages gnome)
  82   #:use-module (gnu packages gnupg)
  83   #:use-module (gnu packages golang)
  84   #:use-module (gnu packages graphviz)
  85   #:use-module (gnu packages gtk)
  86   #:use-module (gnu packages haskell)
  87   #:use-module (gnu packages haskell-apps)
  88   #:use-module (gnu packages haskell-check)
  89   #:use-module (gnu packages haskell-crypto)
  90   #:use-module (gnu packages haskell-web)
  91   #:use-module (gnu packages haskell-xyz)
  92   #:use-module (gnu packages image)
  93   #:use-module (gnu packages libbsd)
  94   #:use-module (gnu packages libusb)
  95   #:use-module (gnu packages linux)
  96   #:use-module (gnu packages m4)
  97   #:use-module (gnu packages multiprecision)
  98   #:use-module (gnu packages ncurses)
  99   #:use-module (gnu packages nettle)
 100   #:use-module (gnu packages networking)
 101   #:use-module (gnu packages ninja)
 102   #:use-module (gnu packages onc-rpc)
 103   #:use-module (gnu packages package-management)
 104   #:use-module (gnu packages pciutils)
 105   #:use-module (gnu packages pcre)
 106   #:use-module (gnu packages perl)
 107   #:use-module (gnu packages pkg-config)
 108   #:use-module (gnu packages polkit)
 109   #:use-module (gnu packages protobuf)
 110   #:use-module (gnu packages python)
 111   #:use-module (gnu packages python-build)
 112   #:use-module (gnu packages python-check)
 113   #:use-module (gnu packages python-crypto)
 114   #:use-module (gnu packages python-web)
 115   #:use-module (gnu packages python-xyz)
 116   #:use-module (gnu packages pulseaudio)
 117   #:use-module (gnu packages readline)
 118   #:use-module (gnu packages rsync)
 119   #:use-module (gnu packages selinux)
 120   #:use-module (gnu packages sdl)
 121   #:use-module (gnu packages sphinx)
 122   #:use-module (gnu packages spice)
 123   #:use-module (gnu packages ssh)
 124   #:use-module (gnu packages texinfo)
 125   #:use-module (gnu packages textutils)
 126   #:use-module (gnu packages tls)
 127   #:use-module (gnu packages web)
 128   #:use-module (gnu packages wget)
 129   #:use-module (gnu packages xdisorg)
 130   #:use-module (gnu packages xml)
 131   #:use-module (gnu packages xorg)
 132   #:use-module (guix build-system cmake)
 133   #:use-module (guix build-system gnu)
 134   #:use-module (guix build-system go)
 135   #:use-module (guix build-system meson)
 136   #:use-module (guix build-system python)
 137   #:use-module (guix build-system trivial)
 138   #:use-module (guix download)
 139   #:use-module (guix git-download)
 140   #:use-module (guix gexp)
 141   #:use-module ((guix licenses) #:prefix license:)
 142   #:use-module (guix packages)
 143   #:use-module (guix utils)
 144   #:use-module (srfi srfi-1)
 145   #:use-module (srfi srfi-26)
 146   #:use-module (ice-9 match))
 147
 148 (define (qemu-patch commit file-name sha256-bv)
 149   "Return an origin for COMMIT."
 150   (origin
 151     (method url-fetch)
 152     (uri (string-append
 153           "http://git.qemu.org/?p=qemu.git;a=commitdiff_plain;h="
 154           commit))
 155     (hash (content-hash sha256-bv sha256))
 156     (file-name file-name)))
 157
 158 (define-public qemu
 159   (package
 160     (name "qemu")
 161     (version "7.1.0")
 162     (source
 163      (origin
 164        (method url-fetch)
 165        (uri (string-append "https://download.qemu.org/qemu-"
 166                            version ".tar.xz"))
 167        (sha256
 168         (base32
 169          "1rmvrgqjhrvcmchnz170dxvrrf14n6nm39y8ivrprmfydd9lwqx0"))
 170        (patches (search-patches "qemu-build-info-manual.patch"
 171                                 "qemu-fix-agent-paths.patch"))
 172        (modules '((guix build utils)))
 173        (snippet
 174         '(begin
 175            ;; Delete the bundled meson copy.
 176            (delete-file-recursively "meson")))))
 177     (outputs '("out" "static" "doc"))   ;5.3 MiB of HTML docs
 178     (build-system gnu-build-system)
 179     (arguments
 180      (list
 181       ;; FIXME: Disable tests on i686 to work around
 182       ;; <https://bugs.gnu.org/40527>.
 183       #:tests? (or (%current-target-system)
 184                    (not (string=? "i686-linux" (%current-system))))
 185       #:configure-flags
 186       #~(let ((gcc (search-input-file %build-inputs "/bin/gcc"))
 187               (out #$output))
 188           (list (string-append "--cc=" gcc)
 189                 ;; Some architectures insist on using HOST_CC.
 190                 (string-append "--host-cc=" gcc)
 191                 (string-append "--prefix=" out)
 192                 "--sysconfdir=/etc"
 193                 (string-append "--smbd=" out "/libexec/samba-wrapper")
 194                 "--disable-debug-info"  ;for space considerations
 195                 ;; The binaries need to be linked against -lrt.
 196                 (string-append "--extra-ldflags=-lrt")))
 197       ;; Make build and test output verbose to facilitate investigation upon failure.
 198       #:make-flags #~'("V=1")
 199       #:modules `((srfi srfi-1)
 200                   (srfi srfi-26)
 201                   (ice-9 ftw)
 202                   (ice-9 match)
 203                   ,@%gnu-build-system-modules)
 204       #:phases
 205       #~(modify-phases %standard-phases
 206           (add-after 'unpack 'extend-test-time-outs
 207             (lambda _
 208               ;; These tests can time out on heavily-loaded and/or slow storage.
 209               (substitute* (cons* "tests/qemu-iotests/common.qemu"
 210                                   (find-files "tests/qemu-iotests" "^[0-9]+$"))
 211                 (("QEMU_COMM_TIMEOUT=[0-9]+" match)
 212                  (string-append match "9")))))
 213           (add-after 'unpack 'disable-unusable-tests
 214             (lambda _
 215               (substitute* "tests/unit/meson.build"
 216                 ;; Comment out the test-qga test, which needs /sys and
 217                 ;; fails within the build environment.
 218                 (("tests.*test-qga.*$" all)
 219                  (string-append "# " all))
 220                 ;; Comment out the test-char test, which needs networking and
 221                 ;; fails within the build environment.
 222                 ((".*'test-char':.*" all)
 223                  (string-append "# " all)))))
 224           #$@(if (target-riscv64?)
 225                  '((add-after 'unpack 'disable-some-tests
 226                      (lambda _
 227                        ;; qemu.qmp.QMPConnectError:
 228                        ;; Unexpected empty reply from server
 229                        (delete-file "tests/qemu-iotests/040")
 230                        (delete-file "tests/qemu-iotests/041")
 231                        (delete-file "tests/qemu-iotests/256")
 232
 233                        ;; No 'PCI' bus found for device 'virtio-scsi-pci'
 234                        (delete-file "tests/qemu-iotests/127")
 235                        (delete-file "tests/qemu-iotests/267"))))
 236                  '())
 237           (add-after 'patch-source-shebangs 'patch-embedded-shebangs
 238             (lambda* (#:key native-inputs inputs #:allow-other-keys)
 239               ;; Ensure the executables created by these source files reference
 240               ;; /bin/sh from the store so they work inside the build container.
 241               (substitute* '("block/cloop.c" "migration/exec.c"
 242                              "net/tap.c" "tests/qtest/libqtest.c"
 243                              "tests/qtest/vhost-user-blk-test.c")
 244                 (("/bin/sh") (search-input-file inputs "/bin/sh")))
 245               (substitute* "tests/qemu-iotests/testenv.py"
 246                 (("#!/usr/bin/env python3")
 247                  (string-append "#!" (search-input-file (or native-inputs inputs)
 248                                                         "/bin/python3"))))))
 249           (add-before 'configure 'fix-optionrom-makefile
 250             (lambda _
 251               ;; Work around the inability of the rules defined in this
 252               ;; Makefile to locate the firmware files (e.g.: No rule to make
 253               ;; target 'multiboot.bin') by extending the VPATH.
 254               (substitute* "pc-bios/optionrom/Makefile"
 255                 (("^VPATH = \\$\\(SRC_DIR\\)")
 256                  "VPATH = $(SRC_DIR):$(TOPSRC_DIR)/pc-bios"))))
 257           ;; XXX ./configure is being re-run at beginning of build phase...
 258           (replace 'configure
 259             (lambda* (#:key inputs configure-flags #:allow-other-keys)
 260               ;; The `configure' script doesn't understand some of the
 261               ;; GNU options.  Thus, add a new phase that's compatible.
 262               (setenv "SHELL" (which "bash"))
 263               ;; Ensure config.status gets the correct shebang off the bat.
 264               ;; The build system gets confused if we change it later and
 265               ;; attempts to re-run the whole configuration, and fails.
 266               (substitute* "configure"
 267                 (("#!/bin/sh")
 268                  (string-append "#!" (which "sh"))))
 269               (mkdir-p "b/qemu")
 270               (chdir "b/qemu")
 271               (apply invoke "../../configure" configure-flags)))
 272           ;; Configure, build and install QEMU user-emulation static binaries.
 273           (add-after 'configure 'configure-user-static
 274             (lambda* (#:key inputs outputs #:allow-other-keys)
 275               (let* ((static (assoc-ref outputs "static"))
 276                      (gcc (search-input-file inputs "/bin/gcc"))
 277                      ;; This is the common set of configure flags; it is
 278                      ;; duplicated here to isolate this phase from manipulations
 279                      ;; to the #:configure-flags build argument, as done in
 280                      ;; derived packages such as qemu-minimal.
 281                      (configure-flags (list (string-append "--cc=" gcc)
 282                                             (string-append "--host-cc=" gcc)
 283                                             "--sysconfdir=/etc"
 284                                             "--disable-debug-info")))
 285               (mkdir-p "../user-static")
 286               (with-directory-excursion "../user-static"
 287                 (apply invoke "../../configure"
 288                        "--static"
 289                        "--disable-docs" ;already built
 290                        "--disable-system"
 291                        "--enable-linux-user"
 292                        (string-append "--prefix=" static)
 293                        configure-flags)))))
 294           (add-after 'build 'build-user-static
 295             (lambda args
 296               (with-directory-excursion "../user-static"
 297                 (apply (assoc-ref %standard-phases 'build) args))))
 298           (add-after 'install 'install-user-static
 299             (lambda* (#:key outputs #:allow-other-keys)
 300               (let* ((static (assoc-ref outputs "static"))
 301                      (bin (string-append static "/bin")))
 302                 (with-directory-excursion "../user-static"
 303                   (for-each (cut install-file <> bin)
 304                             (append-map (cut find-files <> "^qemu-" #:stat stat)
 305                                         (scandir "."
 306                                                  (cut string-suffix?
 307                                                       "-linux-user" <>))))))))
 308           ;; Create a wrapper for Samba. This allows QEMU to use Samba without
 309           ;; pulling it in as an input. Note that you need to explicitly install
 310           ;; Samba in your Guix profile for Samba support.
 311           (add-after 'install 'create-samba-wrapper
 312             (lambda* (#:key inputs #:allow-other-keys)
 313               (let ((libexec (string-append #$output "/libexec")))
 314                 (call-with-output-file "samba-wrapper"
 315                   (lambda (port)
 316                     (format port "#!/bin/sh
 317 exec smbd $@")))
 318                 (chmod "samba-wrapper" #o755)
 319                 (install-file "samba-wrapper" libexec))))
 320           (add-after 'install 'move-html-doc
 321             (lambda* (#:key inputs outputs #:allow-other-keys)
 322               (let* ((out #$output)
 323                      (doc #$output:doc)
 324                      (qemu-doc (string-append doc "/share/doc/qemu-"
 325                                               #$(package-version this-package))))
 326                 (mkdir-p qemu-doc)
 327                 (rename-file (string-append out "/share/doc/qemu")
 328                              (string-append qemu-doc "/html"))))))))
 329     (inputs
 330      (list alsa-lib
 331            bash-minimal
 332            glib
 333            gtk+
 334            libaio
 335            libcacard                    ;smartcard support
 336            attr libcap-ng               ;VirtFS support
 337            libdrm
 338            libepoxy
 339            libjpeg-turbo
 340            libpng
 341            libseccomp
 342            liburing
 343            libusb                       ;USB pass-through support
 344            mesa
 345            ncurses
 346            ;; ("pciutils" ,pciutils)
 347            pixman
 348            pulseaudio
 349            sdl2
 350            spice
 351            usbredir
 352            util-linux
 353            vde2
 354            virglrenderer
 355
 356            ;; Formats to support for .qcow2 (and possibly other) compression.
 357            zlib
 358            `(,zstd "lib")))
 359     (native-inputs
 360      (list gettext-minimal
 361            `(,glib "bin")               ;gtester, etc.
 362            perl
 363            flex
 364            bison
 365            meson
 366            ninja
 367            pkg-config
 368            python-wrapper
 369            python-sphinx
 370            python-sphinx-rtd-theme
 371            texinfo
 372            ;; The following static libraries are required to build
 373            ;; the static output of QEMU.
 374            `(,glib "static")
 375            `(,pcre "static")
 376            `(,zlib "static")))
 377     (home-page "https://www.qemu.org")
 378     (synopsis "Machine emulator and virtualizer")
 379     (description
 380      "QEMU is a generic machine emulator and virtualizer.
 381
 382 When used as a machine emulator, QEMU can run OSes and programs made for one
 383 machine (e.g. an ARM board) on a different machine---e.g., your own PC.  By
 384 using dynamic translation, it achieves very good performance.
 385
 386 When used as a virtualizer, QEMU achieves near native performances by
 387 executing the guest code directly on the host CPU.  QEMU supports
 388 virtualization when executing under the Xen hypervisor or using
 389 the KVM kernel module in Linux.  When using KVM, QEMU can virtualize x86,
 390 server and embedded PowerPC, and S390 guests.")
 391
 392     ;; Many files are GPLv2+, but some are GPLv2-only---e.g., `memory.c'.
 393     (license license:gpl2)
 394
 395     ;; Several tests fail on MIPS; see <http://hydra.gnu.org/build/117914>.
 396     (supported-systems (fold delete %supported-systems
 397                              '("mips64el-linux" "i586-gnu")))))
 398
 399 (define-public qemu-minimal
 400   ;; QEMU without GUI support, only supporting the host's architecture
 401   (package
 402     (inherit qemu)
 403     (name "qemu-minimal")
 404     (outputs '("out" "doc"))
 405     (synopsis
 406      "Machine emulator and virtualizer (without GUI) for the host architecture")
 407     (arguments
 408      (substitute-keyword-arguments (package-arguments qemu)
 409        ((#:configure-flags configure-flags #~'())
 410         ;; Restrict to the host's architecture.
 411         (let* ((system (or (%current-target-system)
 412                            (%current-system)))
 413                (target-list-arg
 414                 (match system
 415                   ((? (cut string-prefix? "i686" <>))
 416                    "--target-list=i386-softmmu")
 417                   ((? (cut string-prefix? "x86_64" <>))
 418                    "--target-list=i386-softmmu,x86_64-softmmu")
 419                   ((? (cut string-prefix? "mips64" <>))
 420                    (string-append "--target-list=mips-softmmu,mipsel-softmmu,"
 421                                   "mips64-softmmu,mips64el-softmmu"))
 422                   ((? (cut string-prefix? "mips" <>))
 423                    "--target-list=mips-softmmu,mipsel-softmmu")
 424                   ((? (cut string-prefix? "aarch64" <>))
 425                    "--target-list=arm-softmmu,aarch64-softmmu")
 426                   ((? (cut string-prefix? "arm" <>))
 427                    "--target-list=arm-softmmu")
 428                   ((? (cut string-prefix? "alpha" <>))
 429                    "--target-list=alpha-softmmu")
 430                   ((? (cut string-prefix? "powerpc64" <>))
 431                    "--target-list=ppc-softmmu,ppc64-softmmu")
 432                   ((? (cut string-prefix? "powerpc" <>))
 433                    "--target-list=ppc-softmmu")
 434                   ((? (cut string-prefix? "s390" <>))
 435                    "--target-list=s390x-softmmu")
 436                   ((? (cut string-prefix? "riscv" <>))
 437                    "--target-list=riscv32-softmmu,riscv64-softmmu")
 438                   (else       ; An empty list actually builds all the targets.
 439                    '()))))
 440           #~(cons #$target-list-arg #$configure-flags)))
 441        ((#:phases phases)
 442         #~(modify-phases #$phases
 443             (delete 'configure-user-static)
 444             (delete 'build-user-static)
 445             (delete 'install-user-static)))))
 446
 447     ;; Remove dependencies on optional libraries, notably GUI libraries.
 448     (native-inputs (filter (lambda (input)
 449                              (match input
 450                                ;; Work around the fact that modify-inputs can not
 451                                ;; delete specific outputs; i.e. here we should keep
 452                                ;; `(,glib "bin"), but not `(,glib "static").
 453                                ((label package output)
 454                                 (not (string=? "static" output)))
 455                                (_ input)))
 456                            (modify-inputs (package-native-inputs qemu)
 457                              (delete "gettext-minimal"))))
 458     (inputs (modify-inputs (package-inputs qemu)
 459               (delete "libusb"
 460                       "mesa"
 461                       "sdl2"
 462                       "spice"
 463                       "virglrenderer"
 464                       "gtk+"
 465                       "usbredir"
 466                       "libdrm"
 467                       "libepoxy"
 468                       "pulseaudio"
 469                       "vde2"
 470                       "libcacard")))))
 471
 472 (define (system->qemu-target system)
 473   (cond
 474    ((string-prefix? "i686" system)
 475     "qemu-system-i386")
 476    ((string-prefix? "arm" system)
 477     "qemu-system-arm")
 478    (else
 479     (string-append "qemu-system-" (match (string-split system #\-)
 480                                     ((arch kernel) arch)
 481                                     (_ system))))))
 482
 483 (define-public libx86emu
 484   (package
 485     (name "libx86emu")
 486     (version "3.5")
 487     (home-page "https://github.com/wfeldt/libx86emu")
 488     (source
 489      (origin
 490        (method git-fetch)
 491        (uri
 492         (git-reference
 493          (url home-page)
 494          (commit version)))
 495        (file-name (git-file-name name version))
 496        (sha256
 497         (base32 "11nj3y7maz9ch15b1c2b69gd8d7mpaha377zpdbvfsmg5w9zz93l"))
 498        (modules
 499         '((guix build utils)))
 500        (snippet
 501         `(begin
 502            ;; Remove git2log program file.
 503            (delete-file "git2log")
 504            ;; Remove variables that depends on git2log.
 505            (substitute* "Makefile"
 506              (("GIT2LOG.*=.*$") "")
 507              (("GITDEPS.*=.*$") "")
 508              (("BRANCH.*=.*$") ""))))))
 509     (build-system gnu-build-system)
 510     (arguments
 511      `(#:test-target "test"
 512        #:phases
 513        (modify-phases %standard-phases
 514          (add-after 'unpack 'patch
 515            (lambda* (#:key outputs #:allow-other-keys)
 516              (let* ((out (assoc-ref outputs "out"))
 517                     (include (string-append out "/include"))
 518                     (lib (string-append out "/lib")))
 519                ;; Correct the values of version and install directories.
 520                (substitute* "Makefile"
 521                  (("VERSION.*=.*$")
 522                   (string-append "VERSION := "
 523                                  ,version "\n"))
 524                  (("PREFIX.*=.*$")
 525                   (string-append "PREFIX := " out "\n"))
 526                  (("MAJOR_VERSION.*=.*$")
 527                   (string-append "MAJOR_VERSION := "
 528                                  ,(version-major version) "\n"))
 529                  (("LIBDIR.*=.*$")
 530                   (string-append "LIBDIR = " lib "\n"))
 531                  (("/usr/include") include)))))
 532          (delete 'configure))))         ; no configure script
 533     (native-inputs
 534      (list nasm perl))
 535     (synopsis "Library for x86 emulation")
 536     (description "Libx86emu is a small library to emulate x86 instructions.  The
 537 focus here is not a complete emulation but to cover enough for typical
 538 firmware blobs.  You can
 539 @enumerate
 540 @item intercept any memory access or directly map real memory ranges
 541 @item intercept any i/o access, map real i/o ports, or block any real i/o
 542 @item intercept any interrupt
 543 @item add a hook to run after each instruction
 544 @item recognize a special x86 instruction that can trigger logging
 545 @item use integrated logging
 546 @end enumerate")
 547     (license (license:x11-style "file://LICENSE"))))
 548
 549 (define-public ganeti
 550   (package
 551     (name "ganeti")
 552     (version "3.0.2")
 553     (source (origin
 554               (method git-fetch)
 555               (uri (git-reference
 556                     (url "https://github.com/ganeti/ganeti")
 557                     (commit (string-append "v" version))))
 558               (sha256
 559                (base32 "1xw7rm0k411aj0a4hrxz9drn7827bihp6bwizbapfx8k4c3125k4"))
 560               (file-name (git-file-name name version))
 561               (patches (search-patches "ganeti-shepherd-support.patch"
 562                                        "ganeti-shepherd-master-failover.patch"
 563                                        "ganeti-haskell-pythondir.patch"
 564                                        "ganeti-pyyaml-compat.patch"
 565                                        "ganeti-disable-version-symlinks.patch"))))
 566     (build-system gnu-build-system)
 567     (arguments
 568      `(#:imported-modules (,@%gnu-build-system-modules
 569                            (guix build haskell-build-system)
 570                            (guix build python-build-system))
 571        #:modules (,@%gnu-build-system-modules
 572                   ((guix build haskell-build-system) #:prefix haskell:)
 573                   ((guix build python-build-system) #:select (site-packages))
 574                   (srfi srfi-1)
 575                   (srfi srfi-26)
 576                   (ice-9 match)
 577                   (ice-9 rdelim))
 578
 579        ;; The default test target includes a lot of checks that are only really
 580        ;; relevant for developers such as NEWS file checking, line lengths, etc.
 581        ;; We are only interested in the "py-tests" and "hs-tests" targets: this
 582        ;; is the closest we've got even though it includes a little more.
 583        #:test-target "check-TESTS"
 584
 585        #:configure-flags
 586        (list "--localstatedir=/var"
 587              "--sharedstatedir=/var"
 588              "--sysconfdir=/etc"
 589              "--enable-haskell-tests"
 590
 591              ;; By default, the build system installs everything to versioned
 592              ;; directories such as $libdir/3.0 and relies on a $libdir/default
 593              ;; symlink pointed from /etc/ganeti/{lib,share} to actually function.
 594              ;; This is done to accommodate installing multiple versions in
 595              ;; parallel, but is of little use to us as Guix users can just
 596              ;; roll back and forth.  Thus, disable it for simplicity.
 597              "--disable-version-links"
 598
 599              ;; Ganeti can optionally take control over SSH host keys and
 600              ;; distribute them to nodes as they are added, and also rotate keys
 601              ;; with 'gnt-cluster renew-crypto --new-ssh-keys'.  Thus it needs to
 602              ;; know how to restart the SSH daemon.
 603              "--with-sshd-restart-command='herd restart ssh-daemon'"
 604
 605              ;; Look for OS definitions in this directory by default.  It can
 606              ;; be changed in the cluster configuration.
 607              "--with-os-search-path=/run/current-system/profile/share/ganeti/os"
 608
 609              ;; The default QEMU executable to use.  We don't use the package
 610              ;; here because this entry is stored in the cluster configuration.
 611              (string-append "--with-kvm-path=/run/current-system/profile/bin/"
 612                             ,(system->qemu-target (%current-system))))
 613        #:phases
 614        (modify-phases %standard-phases
 615          (add-after 'unpack 'create-vcs-version
 616            (lambda _
 617              ;; If we are building from a git checkout, we need to create a
 618              ;; 'vcs-version' file manually because the build system does
 619              ;; not have access to the git repository information.
 620              (unless (file-exists? "vcs-version")
 621                (call-with-output-file "vcs-version"
 622                  (lambda (port)
 623                    (format port "v~a~%" ,version))))))
 624          (add-after 'unpack 'patch-absolute-file-names
 625            (lambda* (#:key inputs #:allow-other-keys)
 626              (substitute* '("lib/utils/process.py"
 627                             "lib/utils/text.py"
 628                             "src/Ganeti/Constants.hs"
 629                             "src/Ganeti/HTools/CLI.hs"
 630                             "test/py/ganeti.config_unittest.py"
 631                             "test/py/ganeti.hooks_unittest.py"
 632                             "test/py/ganeti.utils.process_unittest.py"
 633                             "test/py/ganeti.utils.text_unittest.py"
 634                             "test/py/ganeti.utils.wrapper_unittest.py")
 635                (("/bin/sh") (search-input-file inputs "/bin/sh"))
 636                (("/bin/bash") (search-input-file inputs "/bin/bash"))
 637                (("/usr/bin/env") (search-input-file inputs "/bin/env"))
 638                (("/bin/true") (search-input-file inputs "/bin/true")))
 639
 640              ;; This script is called by the node daemon at startup to perform
 641              ;; sanity checks on the cluster IP addresses, and it is also used
 642              ;; in a master-failover scenario.  Add absolute references to
 643              ;; avoid propagating these executables.
 644              (substitute* "tools/master-ip-setup"
 645                (("arping") (search-input-file inputs "/bin/arping"))
 646                (("ndisc6") (search-input-file inputs "/bin/ndisc6"))
 647                (("fping") (search-input-file inputs "/sbin/fping"))
 648                (("grep") (search-input-file inputs "/bin/grep"))
 649                (("ip addr") (string-append (search-input-file inputs "/sbin/ip")
 650                                            " addr")))))
 651          (add-after 'unpack 'override-builtin-PATH
 652            (lambda _
 653              ;; Ganeti runs OS install scripts and similar with a built-in
 654              ;; hard coded PATH.  Patch so it works on Guix System.
 655              (substitute* "src/Ganeti/Constants.hs"
 656                (("/sbin:/bin:/usr/sbin:/usr/bin")
 657                 "/run/setuid-programs:/run/current-system/profile/sbin:\
 658 /run/current-system/profile/bin"))))
 659          (add-after 'bootstrap 'patch-sphinx-version-detection
 660            (lambda _
 661              ;; The build system runs 'sphinx-build --version' to verify that
 662              ;; the Sphinx is recent enough, but does not expect the
 663              ;; .sphinx-build-real executable name created by the Sphinx wrapper.
 664              (substitute* "configure"
 665                (("\\$SPHINX --version 2>&1")
 666                 "$SPHINX --version 2>&1 \
 667 | sed 's/.sphinx-build-real/sphinx-build/g'"))))
 668
 669          ;; The build system invokes Cabal and GHC, which do not work with
 670          ;; GHC_PACKAGE_PATH: <https://github.com/haskell/cabal/issues/3728>.
 671          ;; Tweak the build system to do roughly what haskell-build-system does.
 672          (add-before 'configure 'configure-haskell
 673            (assoc-ref haskell:%standard-phases 'setup-compiler))
 674          (add-after 'configure 'do-not-use-GHC_PACKAGE_PATH
 675            (lambda _
 676              (unsetenv "GHC_PACKAGE_PATH")
 677              (substitute* "Makefile"
 678                (("\\$\\(CABAL\\)")
 679                 "$(CABAL) --package-db=../package.conf.d")
 680                (("\\$\\(GHC\\)")
 681                 "$(GHC) -package-db=../package.conf.d"))))
 682          (add-after 'configure 'make-ghc-use-shared-libraries
 683            (lambda _
 684              (substitute* "Makefile"
 685                (("HFLAGS =") "HFLAGS = -dynamic -fPIC"))))
 686          (add-after 'configure 'fix-installation-directories
 687            (lambda _
 688              (substitute* "Makefile"
 689                ;; Do not attempt to create /var during install.
 690                (("\\$\\(DESTDIR\\)\\$\\{localstatedir\\}")
 691                 "$(DESTDIR)${prefix}${localstatedir}")
 692                ;; Similarly, do not attempt to install the sample ifup scripts
 693                ;; to /etc/ganeti.
 694                (("\\$\\(DESTDIR\\)\\$\\(ifupdir\\)")
 695                 "$(DESTDIR)${prefix}$(ifupdir)"))))
 696          (add-before 'build 'adjust-tests
 697            (lambda _
 698              ;; Disable tests that can not run.  Do it early to prevent
 699              ;; touching the Makefile later and triggering a needless rebuild.
 700              (substitute* "Makefile"
 701                ;; These tests expect the presence of a 'root' user (via
 702                ;; ganeti/runtime.py), which fails in the build environment.
 703                (("test/py/ganeti\\.asyncnotifier_unittest\\.py") "")
 704                (("test/py/ganeti\\.backend_unittest\\.py") "")
 705                (("test/py/ganeti\\.daemon_unittest\\.py") "")
 706                (("test/py/ganeti\\.hypervisor\\.hv_kvm_unittest\\.py") "")
 707                (("test/py/ganeti\\.tools\\.ensure_dirs_unittest\\.py") "")
 708                (("test/py/ganeti\\.utils\\.io_unittest-runasroot\\.py") "")
 709                ;; Disable the bash_completion test, as it requires the full
 710                ;; bash instead of bash-minimal.
 711                (("test/py/bash_completion\\.bash")
 712                 "")
 713                ;; This test requires networking.
 714                (("test/py/import-export_unittest\\.bash")
 715                 ""))))
 716          (add-after 'build 'build-bash-completions
 717            (lambda _
 718              (setenv "PYTHONPATH" ".")
 719              (invoke "./autotools/build-bash-completion")
 720              (unsetenv "PYTHONPATH")))
 721          (add-before 'check 'pre-check
 722            (lambda* (#:key inputs #:allow-other-keys)
 723              ;; Set TZDIR so that time zones are found.
 724              (setenv "TZDIR" (search-input-directory inputs "share/zoneinfo"))
 725
 726              (substitute* "test/py/ganeti.utils.process_unittest.py"
 727                ;; This test attempts to run an executable with
 728                ;; RunCmd(..., reset_env=True), which fails because the default
 729                ;; PATH from Constants.hs does not exist in the build container.
 730                ((".*def testResetEnv.*" all)
 731                 (string-append "  @unittest.skipIf(True, "
 732                                "\"cannot reset env in the build container\")\n"
 733                                all))
 734
 735                ;; XXX: Somehow this test fails in the build container, but
 736                ;; works in 'guix environment -C', even without /bin/sh?
 737                ((".*def testPidFile.*" all)
 738                 (string-append "  @unittest.skipIf(True, "
 739                                "\"testPidFile fails in the build container\")\n"
 740                                all)))
 741
 742              ;; XXX: Why are these links not added automatically.
 743              (with-directory-excursion "test/hs"
 744                (for-each (lambda (file)
 745                            (symlink "../../src/htools" file))
 746                          '("hspace" "hscan" "hinfo" "hbal" "hroller"
 747                            "hcheck" "hail" "hsqueeze")))))
 748          (add-after 'install 'install-bash-completions
 749            (lambda* (#:key outputs #:allow-other-keys)
 750              (let* ((out (assoc-ref outputs "out"))
 751                     (compdir (string-append out "/etc/bash_completion.d")))
 752                (mkdir-p compdir)
 753                (copy-file "doc/examples/bash_completion"
 754                           (string-append compdir "/ganeti"))
 755                ;; The one file contains completions for many different
 756                ;; executables.  Create symlinks for found completions.
 757                (with-directory-excursion compdir
 758                  (for-each
 759                   (lambda (prog) (symlink "ganeti" prog))
 760                   (call-with-input-file "ganeti"
 761                     (lambda (port)
 762                       (let loop ((line (read-line port))
 763                                  (progs '()))
 764                         (if (eof-object? line)
 765                             progs
 766                             (if (string-prefix? "complete" line)
 767                                 (loop (read-line port)
 768                                       ;; Extract "prog" from lines of the form:
 769                                       ;; "complete -F _prog -o filenames prog".
 770                                       ;; Note that 'burnin' is listed with the
 771                                       ;; absolute file name, which is why we
 772                                       ;; run everything through 'basename'.
 773                                       (match (string-split line #\ )
 774                                         ((commands ... prog)
 775                                          (cons (basename prog) progs))))
 776                                 (loop (read-line port) progs)))))))))))
 777          ;; Wrap all executables with GUIX_PYTHONPATH.  We can't borrow
 778          ;; the phase from python-build-system because we also need to wrap
 779          ;; the scripts in $out/lib/ganeti such as "node-daemon-setup".
 780          (add-after 'install 'wrap
 781            (lambda* (#:key inputs outputs #:allow-other-keys)
 782              (let* ((out (assoc-ref outputs "out"))
 783                     (sbin (string-append out "/sbin"))
 784                     (lib (string-append out "/lib"))
 785                     (PYTHONPATH (string-append (site-packages inputs outputs)
 786                                                ":" (getenv "GUIX_PYTHONPATH"))))
 787                (define (shell-script? file)
 788                  (call-with-ascii-input-file file
 789                    (lambda (port)
 790                      (let ((shebang (false-if-exception (read-line port))))
 791                        (and shebang
 792                             (string-prefix? "#!" shebang)
 793                             (or (string-contains shebang "/bin/bash")
 794                                 (string-contains shebang "/bin/sh")))))))
 795
 796                (define* (wrap? file #:rest _)
 797                  ;; Do not wrap shell scripts because some are meant to be
 798                  ;; sourced, which breaks if they are wrapped.  We do wrap
 799                  ;; the Haskell executables because some call out to Python
 800                  ;; directly.
 801                  (and (executable-file? file)
 802                       (not (symbolic-link? file))
 803                       (not (shell-script? file))))
 804
 805                (for-each (lambda (file)
 806                            (wrap-program file
 807                              `("GUIX_PYTHONPATH" ":" prefix
 808                                (,PYTHONPATH))))
 809                          (append-map (cut find-files <> wrap?)
 810                                      (list (string-append lib "/ganeti")
 811                                            sbin)))))))))
 812     (native-inputs
 813      `(("haskell" ,ghc)
 814        ("cabal" ,cabal-install)
 815        ("m4" ,m4)
 816
 817        ;; These inputs are necessary to bootstrap the package, because we
 818        ;; have patched the build system.
 819        ("autoconf" ,autoconf)
 820        ("automake" ,automake)
 821
 822        ;; For the documentation.
 823        ("python-docutils" ,python-docutils)
 824        ("sphinx" ,python-sphinx)
 825        ("pandoc" ,pandoc)
 826        ("dot" ,graphviz)
 827
 828        ;; Test dependencies.
 829        ("fakeroot" ,fakeroot)
 830        ("ghc-temporary" ,ghc-temporary)
 831        ("ghc-test-framework" ,ghc-test-framework)
 832        ("ghc-test-framework-hunit" ,ghc-test-framework-hunit)
 833        ("ghc-test-framework-quickcheck2" ,ghc-test-framework-quickcheck2)
 834        ("python-mock" ,python-mock)
 835        ("python-pyyaml" ,python-pyyaml)
 836        ("openssh" ,openssh)
 837        ("procps" ,procps)
 838        ("shelltestrunner" ,shelltestrunner)
 839        ("tzdata" ,tzdata-for-tests)))
 840     (inputs
 841      (list iputils                      ;for 'arping'
 842            curl
 843            fping
 844            iproute
 845            ndisc6
 846            socat
 847            qemu-minimal                 ;for qemu-img
 848            ghc-attoparsec
 849            ghc-base64-bytestring
 850            ghc-cryptonite
 851            ghc-curl
 852            ghc-hinotify
 853            ghc-hslogger
 854            ghc-json
 855            ghc-lens
 856            ghc-lifted-base
 857            ghc-network
 858            ghc-old-time
 859            ghc-psqueue
 860            ghc-regex-pcre
 861            ghc-utf8-string
 862            ghc-zlib
 863            ;; For the optional metadata daemon.
 864            ghc-snap-core
 865            ghc-snap-server
 866            python
 867            python-pyopenssl
 868            python-simplejson
 869            python-pyparsing
 870            python-pyinotify
 871            python-pycurl
 872            python-bitarray
 873            python-paramiko
 874            python-psutil))
 875     (home-page "https://www.ganeti.org/")
 876     (synopsis "Cluster-based virtual machine management system")
 877     (description
 878      "Ganeti is a virtual machine management tool built on top of existing
 879 virtualization technologies such as Xen or KVM.  Ganeti controls:
 880
 881 @itemize @bullet
 882 @item Disk creation management;
 883 @item Operating system installation for instances (in co-operation with
 884 OS-specific install scripts); and
 885 @item Startup, shutdown, and failover between physical systems.
 886 @end itemize
 887
 888 Ganeti is designed to facilitate cluster management of virtual servers and
 889 to provide fast and simple recovery after physical failures, using
 890 commodity hardware.")
 891     (license license:bsd-2)))
 892
 893 (define-public ganeti-instance-guix
 894   (package
 895     (name "ganeti-instance-guix")
 896     (version "0.6.1")
 897     (home-page "https://github.com/mbakke/ganeti-instance-guix")
 898     (source (origin
 899               (method git-fetch)
 900               (uri (git-reference (url home-page) (commit version)))
 901               (file-name (git-file-name name version))
 902               (sha256
 903                (base32
 904                 "18h8hdd38h1l89si8122v3ylzvvirs8hiypayklk1nr2wnfgbvff"))))
 905     (build-system gnu-build-system)
 906     (arguments
 907      '(#:configure-flags '("--sysconfdir=/etc" "--localstatedir=/var")))
 908     (native-inputs
 909      (list autoconf automake))
 910     (inputs
 911      (list util-linux qemu-minimal))
 912     (synopsis "Guix OS integration for Ganeti")
 913     (description
 914      "This package provides a guest OS definition for Ganeti that uses
 915 Guix to build virtual machines.")
 916     (license license:gpl3+)))
 917
 918 (define-public ganeti-instance-debootstrap
 919   (package
 920     (name "ganeti-instance-debootstrap")
 921     ;; We need two commits on top of the latest release for compatibility
 922     ;; with newer sfdisk, as well as gnt-network integration.
 923     (version "0.16-2-ge145396")
 924     (home-page "https://github.com/ganeti/instance-debootstrap")
 925     (source (origin
 926               (method git-fetch)
 927               (uri (git-reference (url home-page) (commit version)))
 928               (file-name (git-file-name name version))
 929               (sha256
 930                (base32
 931                 "0f2isw9d8lawzj21rrq1q9xhq8xfa65rqbhqmrn59z201x9q1336"))))
 932     (build-system gnu-build-system)
 933     (arguments
 934      '(#:configure-flags '("--sysconfdir=/etc" "--localstatedir=/var")
 935        #:phases (modify-phases %standard-phases
 936                   (add-after 'unpack 'add-absolute-references
 937                     (lambda _
 938                       (substitute* "common.sh.in"
 939                         (("/sbin/blkid") (which "blkid"))
 940                         (("kpartx -")
 941                          (string-append (which "kpartx") " -")))
 942                       (substitute* "import"
 943                         (("restore -r")
 944                          (string-append (which "restore") " -r")))
 945                       (substitute* "export"
 946                         (("dump -0")
 947                          (string-append (which "dump") " -0")))
 948                       (substitute* "create"
 949                         (("debootstrap") (which "debootstrap"))
 950                         (("`which run-parts`") (which "run-parts"))
 951                         ;; Here we actually need to hard code /bin/passwd
 952                         ;; because it's called via chroot, which fails if
 953                         ;; "/bin" is not in PATH.
 954                         (("passwd") "/bin/passwd"))
 955                       #t))
 956                   (add-after 'unpack 'set-dpkg-arch
 957                     (lambda* (#:key system #:allow-other-keys)
 958                       ;; The create script passes --arch to debootstrap,
 959                       ;; and defaults to `dpkg --print-architecture` when
 960                       ;; ARCH is not set in variant.conf.  Hard code the
 961                       ;; build-time architecture to avoid the dpkg dependency.
 962                       (let ((dpkg-arch
 963                              (cond ((string-prefix? "x86_64" system)
 964                                     "amd64")
 965                                    ((string-prefix? "i686" system)
 966                                     "i386")
 967                                    ((string-prefix? "aarch64" system)
 968                                     "arm64")
 969                                    (else (car (string-split system #\-))))))
 970                         (substitute* "create"
 971                           (("`dpkg --print-architecture`")
 972                            dpkg-arch))
 973                         #t)))
 974                   (add-after 'configure 'adjust-Makefile
 975                     (lambda _
 976                       ;; Do not attempt to create /etc/ganeti/instance-debootstrap
 977                       ;; and /etc/default/ganeti-instance-debootstrap during install.
 978                       ;; They are created by the Ganeti service.
 979                       (substitute* "Makefile"
 980                         (("\\$\\(variantsdir\\)")
 981                          "$(prefix)/etc/ganeti/instance-debootstrap/variants")
 982                         (("\\$\\(defaultsdir\\)")
 983                          "$(prefix)/etc/default/ganeti-instance-debootstrap"))
 984                       #t))
 985                   (add-after 'install 'make-variants.list-symlink
 986                     (lambda* (#:key outputs #:allow-other-keys)
 987                       ;; The Ganeti OS API mandates a variants.list file that
 988                       ;; describes all supported "variants" of this OS.
 989                       ;; Guix generates this file, so make the original file
 990                       ;; a symlink to it.
 991                       (with-directory-excursion (string-append
 992                                                  (assoc-ref outputs "out")
 993                                                  "/share/ganeti/os/debootstrap")
 994                         (delete-file "variants.list")
 995                         (symlink "/etc/ganeti/instance-debootstrap/variants/variants.list"
 996                                  "variants.list"))
 997                       #t)))))
 998     (native-inputs
 999      (list autoconf automake))
1000     (inputs
1001      `(("debianutils" ,debianutils)
1002        ("debootstrap" ,debootstrap)
1003        ("dump" ,dump)
1004        ("kpartx" ,multipath-tools)
1005        ("util-linux" ,util-linux)))
1006     (synopsis "Debian OS integration for Ganeti")
1007     (description
1008      "This package provides a guest OS definition for Ganeti.  It installs
1009 Debian or a derivative using @command{debootstrap}.")
1010     (license license:gpl2+)))
1011
1012 (define-public spike
1013   (package
1014     (name "spike")
1015     (version "1.1.0")
1016     (source (origin
1017               (method git-fetch)
1018               (uri (git-reference
1019                      (url "https://github.com/riscv-software-src/riscv-isa-sim")
1020                      (commit (string-append "v" version))))
1021               (file-name (git-file-name name version))
1022               (sha256
1023                (base32 "0cik2m0byfp9ppq0hpg3xyrlp5ag1i4dww7a7872mlm36xxqagg0"))))
1024     (build-system gnu-build-system)
1025     (arguments
1026      (list
1027        #:phases
1028        #~(modify-phases %standard-phases
1029            (add-before 'configure 'configure-dtc-path
1030              (lambda* (#:key inputs #:allow-other-keys)
1031                ;; Reference dtc by its absolute store path.
1032                (substitute* "riscv/dts.cc"
1033                  (("DTC")
1034                   (string-append "\"" (search-input-file inputs "/bin/dtc") "\""))))))))
1035     (inputs
1036      (list bash-minimal dtc))
1037     (native-inputs
1038      (list python-wrapper))
1039     (home-page "https://github.com/riscv-software-src/riscv-isa-sim")
1040     (synopsis "RISC-V ISA Simulator")
1041     (description "Spike, the RISC-V ISA Simulator, implements a functional model
1042 of one or more RISC-V harts.")
1043     (license license:bsd-3)))
1044
1045 (define-public libosinfo
1046   (package
1047     (name "libosinfo")
1048     (version "1.10.0")
1049     (source
1050      (origin
1051        (method url-fetch)
1052        (uri (string-append "https://releases.pagure.org/libosinfo/libosinfo-"
1053                            version ".tar.xz"))
1054        (sha256
1055         (base32
1056          "0193sdvv9yj3h6wwhj441d2fhccc7fh0m36sl0fv5pl0ql7y0lm2"))))
1057     (build-system meson-build-system)
1058     (arguments
1059      (list
1060       #:configure-flags
1061       #~(list (string-append "-Dwith-usb-ids-path="
1062                              (search-input-file %build-inputs
1063                                                 "share/hwdata/usb.ids"))
1064               (string-append "-Dwith-pci-ids-path="
1065                              (search-input-file %build-inputs
1066                                                 "share/hwdata/pci.ids")))
1067       #:phases
1068       #~(modify-phases %standard-phases
1069           (add-after 'unpack 'patch-osinfo-path
1070             (lambda* (#:key native-inputs inputs #:allow-other-keys)
1071               (substitute* "osinfo/osinfo_loader.c"
1072                 (("path = DATA_DIR.*")
1073                  (format #f "path = ~s;"
1074                          (search-input-directory (or native-inputs inputs)
1075                                                  "share/osinfo")))))))))
1076     (inputs (list libsoup-minimal-2 libxml2 libxslt osinfo-db))
1077     (native-inputs
1078      (list `(,glib "bin")                ;glib-mkenums, etc.
1079            gobject-introspection
1080            gtk-doc/stable
1081            `(,hwdata "pci")
1082            `(,hwdata "usb")
1083            vala
1084            intltool
1085            pkg-config))
1086     (home-page "https://libosinfo.org/")
1087     (synopsis "Operating system information database")
1088     (description "libosinfo is a GObject based library API for managing
1089 information about operating systems, hypervisors and the (virtual) hardware
1090 devices they can support.  It includes a database containing device metadata
1091 and provides APIs to match/identify optimal devices for deploying an operating
1092 system on a hypervisor.  Via GObject Introspection, the API is available in
1093 all common programming languages.  Vala bindings are also provided.")
1094     ;; The library files are released under LGPLv2.1 or later; the source
1095     ;; files in the "tools" directory are released under GPLv2+.
1096     (license (list license:lgpl2.1+ license:gpl2+))))
1097
1098 (define-public lxc
1099   (package
1100     (name "lxc")
1101     (version "4.0.12")
1102     (source (origin
1103               (method url-fetch)
1104               (uri (string-append
1105                     "https://linuxcontainers.org/downloads/lxc/lxc-"
1106                     version ".tar.gz"))
1107               (sha256
1108                (base32
1109                 "1vyk2j5w9gfyh23w3ar09cycyws16mxh3clbb33yhqzwcs1jy96v"))))
1110     (build-system gnu-build-system)
1111     (native-inputs
1112      (list pkg-config docbook2x))
1113     (inputs
1114      (list gnutls libcap libseccomp libselinux))
1115     (arguments
1116      (list #:configure-flags
1117            #~(list (string-append "--docdir=" #$output "/share/doc/"
1118                                   #$name "-" #$version)
1119                    "--sysconfdir=/etc"
1120                    "--localstatedir=/var")
1121            #:phases
1122            #~(modify-phases %standard-phases
1123                (replace 'install
1124                  (lambda _
1125                    (invoke "make" "install"
1126                            (string-append "bashcompdir=" #$output
1127                                           "/etc/bash_completion.d")
1128                            ;; Don't install files into /var and /etc.
1129                            "LXCPATH=/tmp/var/lib/lxc"
1130                            "localstatedir=/tmp/var"
1131                            "sysconfdir=/tmp/etc"
1132                            "sysconfigdir=/tmp/etc/default"))))))
1133     (synopsis "Linux container tools")
1134     (home-page "https://linuxcontainers.org/")
1135     (description
1136      "LXC is a userspace interface for the Linux kernel containment features.
1137 Through a powerful API and simple tools, it lets Linux users easily create and
1138 manage system or application containers.")
1139     (license license:lgpl2.1+)))
1140
1141 (define-public lxcfs
1142   (package
1143     (name "lxcfs")
1144     (version "4.0.11")
1145     (home-page "https://github.com/lxc/lxcfs")
1146     (source (origin
1147               (method git-fetch)
1148               (uri (git-reference (url home-page)
1149                                   (commit (string-append "lxcfs-" version))))
1150               (file-name (git-file-name name version))
1151               (sha256
1152                (base32
1153                 "02cgzh97cgxh9iyf7gkn5ikdc0sfzqfjj6al0hikdf9rbwcscqwd"))))
1154     (arguments
1155      '(#:configure-flags '("--localstatedir=/var")))
1156     (native-inputs
1157      (list autoconf automake libtool pkg-config))
1158     (inputs
1159      (list fuse))
1160     (build-system gnu-build-system)
1161     (synopsis "FUSE-based file system for LXC")
1162     (description "LXCFS is a small FUSE file system written with the intention
1163 of making Linux containers feel more like a virtual machine.
1164 It started as a side project of LXC but can be used by any run-time.")
1165     (license license:lgpl2.1+)))
1166
1167 (define-public lxd
1168   (package
1169     (name "lxd")
1170     (version "4.24")
1171     (source (origin
1172               (method url-fetch)
1173               (uri (string-append
1174                     "https://github.com/lxc/lxd/releases/download/"
1175                     "lxd-" version "/lxd-" version ".tar.gz"))
1176               (sha256
1177                (base32
1178                 "0lmjmvm98m6yjxcqlfw690i71nazfzgrm3mzbjj77g1631df3ylp"))))
1179     (build-system go-build-system)
1180     (arguments
1181      `(#:import-path "github.com/lxc/lxd"
1182        #:tests? #f ;; tests fail due to missing /var, cgroups, etc.
1183        #:modules ((guix build go-build-system)
1184                   (guix build union)
1185                   (guix build utils)
1186                   (srfi srfi-1))
1187        #:phases
1188        (modify-phases %standard-phases
1189          (add-after 'unpack 'unpack-dist
1190            (lambda* (#:key import-path #:allow-other-keys)
1191              (with-directory-excursion (string-append "src/" import-path)
1192                ;; Move all the dependencies into the src directory.
1193                (copy-recursively "_dist/src" "../../.."))))
1194          (replace 'build
1195            (lambda* (#:key import-path #:allow-other-keys)
1196              (with-directory-excursion (string-append "src/" import-path)
1197                (invoke "make" "build" "CC=gcc" "TAG_SQLITE3=libsqlite3"))))
1198          (replace 'check
1199            (lambda* (#:key tests? import-path #:allow-other-keys)
1200              (when tests?
1201                (with-directory-excursion (string-append "src/" import-path)
1202                  (invoke "make" "check" "CC=gcc" "TAG_SQLITE3=libsqlite3")))))
1203          (replace 'install
1204            (lambda* (#:key inputs outputs import-path #:allow-other-keys)
1205              (let* ((out (assoc-ref outputs "out"))
1206                     (bin-dir
1207                      (string-append out "/bin/"))
1208                     (doc-dir
1209                      (string-append out "/share/doc/lxd-" ,version))
1210                     (completions-dir
1211                      (string-append out "/share/bash-completion/completions")))
1212                (with-directory-excursion (string-append "src/" import-path)
1213                  ;; Wrap lxd with run-time dependencies.
1214                  (wrap-program (string-append bin-dir "lxd")
1215                    `("PATH" ":" prefix
1216                      ,(fold (lambda (input paths)
1217                               ;; TODO: Use 'search-input-directory' rather
1218                               ;; than look up inputs by name.
1219                               (let* ((in (assoc-ref inputs input))
1220                                      (bin (string-append in "/bin"))
1221                                      (sbin (string-append in "/sbin")))
1222                                 (append (filter file-exists?
1223                                                 (list bin sbin)) paths)))
1224                             '()
1225                             '("bash-minimal" "acl" "rsync" "tar" "xz" "btrfs-progs"
1226                               "gzip" "dnsmasq" "squashfs-tools" "iproute2"
1227                               "criu" "iptables" "attr"))))
1228                  ;; Remove unwanted binaries.
1229                  (for-each (lambda (prog)
1230                              (delete-file (string-append bin-dir prog)))
1231                            '("deps" "macaroon-identity" "generate"))
1232                  ;; Install documentation.
1233                  (for-each (lambda (file)
1234                              (install-file file doc-dir))
1235                            (find-files "doc"))
1236                  ;; Install bash completion.
1237                  (rename-file "scripts/bash/lxd-client" "scripts/bash/lxd")
1238                  (install-file "scripts/bash/lxd" completions-dir))))))))
1239     (native-inputs
1240      (list ;; Test dependencies:
1241            ;; ("go-github-com-rogpeppe-godeps" ,go-github-com-rogpeppe-godeps)
1242            ;; ("go-github-com-tsenart-deadcode" ,go-github-com-tsenart-deadcode)
1243            ;; ("go-golang-org-x-lint" ,go-golang-org-x-lint)
1244            pkg-config))
1245     (inputs
1246      (list acl
1247            eudev
1248            libdqlite
1249            libraft
1250            libcap
1251            lxc
1252            ;; Run-time dependencies.
1253            attr
1254            bash-minimal
1255            rsync
1256            tar
1257            xz
1258            btrfs-progs
1259            gzip
1260            dnsmasq
1261            squashfs-tools
1262            iproute
1263            criu
1264            iptables))
1265     (synopsis "Daemon based on liblxc offering a REST API to manage containers")
1266     (home-page "https://linuxcontainers.org/lxd/")
1267     (description "LXD is a next generation system container manager.  It
1268 offers a user experience similar to virtual machines but using Linux
1269 containers instead.  It's image based with pre-made images available for a
1270 wide number of Linux distributions and is built around a very powerful, yet
1271 pretty simple, REST API.")
1272     (license license:asl2.0)))
1273
1274 (define-public libvirt
1275   (package
1276     (name "libvirt")
1277     (version "8.6.0")
1278     (source
1279      (origin
1280        (method url-fetch)
1281        (uri (string-append "https://libvirt.org/sources/libvirt-"
1282                            version ".tar.xz"))
1283        (sha256
1284         (base32 "1qisvbshbcd5305mrb4vni559k52id7c8iw4dwdydbf97b24f658"))
1285        (patches (search-patches "libvirt-add-install-prefix.patch"))))
1286     (build-system meson-build-system)
1287     (arguments
1288      (list
1289       #:configure-flags
1290       #~(list "-Ddriver_qemu=enabled"
1291               "-Dqemu_user=nobody"
1292               "-Dqemu_group=kvm"
1293               "-Dstorage_disk=enabled"
1294               "-Dstorage_dir=enabled"
1295               "-Dpolkit=enabled"
1296               ;; XXX The default, but required to make -Dsasl ‘stick’.
1297               ;; See <https://gitlab.com/libvirt/libvirt/-/issues/185>
1298               "-Ddriver_remote=enabled"
1299               "-Dnls=enabled"           ;translations
1300               (string-append "-Ddocdir=" #$output "/share/doc/"
1301                              #$(package-name this-package) "-"
1302                              #$(package-version this-package))
1303               "-Dbash_completion=enabled"
1304               (string-append "-Dinstall_prefix=" #$output)
1305               "--sysconfdir=/etc"
1306               "--localstatedir=/var")
1307       #:phases
1308       #~(modify-phases %standard-phases
1309           (add-after 'unpack 'skip-directory-confusion
1310             (lambda _
1311               ;; Don't try to install an (unused) /var outside of the store.
1312               (substitute* "scripts/meson-install-dirs.py"
1313                 (("destdir = .*")
1314                  "destdir = '/tmp'"))))
1315           (add-after 'unpack 'use-absolute-dnsmasq
1316             (lambda* (#:key inputs #:allow-other-keys)
1317               (let ((dnsmasq (search-input-file inputs "sbin/dnsmasq")))
1318                 (substitute* "src/util/virdnsmasq.c"
1319                   (("#define DNSMASQ \"dnsmasq\"")
1320                    (string-append "#define DNSMASQ \"" dnsmasq "\""))))))
1321           (add-before 'configure 'disable-broken-tests
1322             (lambda _
1323               (let ((tests (list "commandtest"         ; hangs idly
1324                                  "networkxml2conftest" ; fails with absolute dnsmasq
1325                                  "qemuxml2argvtest"    ; fails
1326                                  "virnetsockettest"))) ; tries to network
1327                 (substitute* "tests/meson.build"
1328                   (((format #f ".*'name': '(~a)'.*" (string-join tests "|")))
1329                    ""))))))))
1330     (inputs
1331      (list acl
1332            attr
1333            fuse
1334            libxml2
1335            eudev
1336            libpciaccess
1337            gnutls
1338            dbus
1339            libpcap
1340            libnl
1341            libssh2                      ;optional
1342            libtirpc                     ;for <rpc/rpc.h>
1343            `(,util-linux "lib")
1344            lvm2                         ;for libdevmapper
1345            curl
1346            openssl
1347            readline
1348            cyrus-sasl
1349            libyajl
1350            audit
1351            dmidecode
1352            dnsmasq
1353            ebtables
1354            parted
1355            iproute
1356            iptables))
1357     (native-inputs
1358      (list bash-completion
1359            gettext-minimal
1360            libxslt
1361            perl
1362            pkg-config
1363            polkit
1364            python-wrapper
1365            python-docutils              ;for rst2html
1366            rpcsvc-proto))               ;for rpcgen
1367     (home-page "https://libvirt.org")
1368     (synopsis "Simple API for virtualization")
1369     (description "Libvirt is a C toolkit to interact with the virtualization
1370 capabilities of recent versions of Linux.  The library aims at providing long
1371 term stable C API initially for the Xen paravirtualization but should be able
1372 to integrate other virtualization mechanisms if needed.")
1373     (license license:lgpl2.1+)))
1374
1375 (define-public libvirt-glib
1376   (package
1377     (name "libvirt-glib")
1378     (version "4.0.0")
1379     (source (origin
1380               (method url-fetch)
1381               (uri (string-append "ftp://libvirt.org/libvirt/glib/"
1382                                   "libvirt-glib-" version ".tar.xz"))
1383               (sha256
1384                (base32
1385                 "1gdcvqz88qkp402zra9csc6391f2xki1270x683n6ixakl3gf8w4"))))
1386     (build-system meson-build-system)
1387     (inputs
1388      (list openssl cyrus-sasl lvm2 ; for libdevmapper
1389            libyajl))
1390     (native-inputs
1391      (list pkg-config intltool
1392            `(,glib "bin") vala))
1393     (propagated-inputs
1394      ;; ‘Required:’ by the installed .pc files.
1395      (list glib libvirt libxml2 gobject-introspection))
1396     (home-page "https://libvirt.org")
1397     (synopsis "GLib wrapper around libvirt")
1398     (description "libvirt-glib wraps the libvirt library to provide a
1399 high-level object-oriented API better suited for glib-based applications, via
1400 three libraries:
1401
1402 @enumerate
1403 @item libvirt-glib - GLib main loop integration & misc helper APIs
1404 @item libvirt-gconfig - GObjects for manipulating libvirt XML documents
1405 @item libvirt-gobject - GObjects for managing libvirt objects
1406 @end enumerate
1407 ")
1408     (license license:lgpl2.1+)))
1409
1410 (define-public python-libvirt
1411   (package
1412     (name "python-libvirt")
1413     (version "8.6.0")
1414     (source
1415      (origin
1416        (method url-fetch)
1417        (uri (string-append "https://libvirt.org/sources/python/libvirt-python-"
1418                            version ".tar.gz"))
1419        (sha256
1420         (base32 "0wa86jliq71x60dd4vyzsj4lcrb82i5qsgxz9azvwgsgi9j9mx41"))))
1421     (build-system python-build-system)
1422     (inputs
1423      (list libvirt))
1424     (propagated-inputs
1425      (list python-lxml))
1426     (native-inputs
1427      (list pkg-config python-pytest))
1428     (home-page "https://libvirt.org")
1429     (synopsis "Python bindings to libvirt")
1430     (description "This package provides Python bindings to the libvirt
1431 virtualization library.")
1432     (properties
1433      '((upstream-name . "libvirt-python")))
1434     (license license:lgpl2.1+)))
1435
1436 (define-public virt-manager
1437   (package
1438     (name "virt-manager")
1439     (version "3.2.0")
1440     (source (origin
1441               (method url-fetch)
1442               (uri (string-append "https://virt-manager.org/download/sources"
1443                                   "/virt-manager/virt-manager-"
1444                                   version ".tar.gz"))
1445               (sha256
1446                (base32
1447                 "11kvpzcmyir91qz0dsnk7748jbb4wr8mrc744w117qc91pcy6vrb"))))
1448     (build-system python-build-system)
1449     (arguments
1450      `(#:use-setuptools? #f          ; uses custom distutils 'install' command
1451        #:tests? #f                      ; TODO The tests currently fail
1452                                         ; RuntimeError: Loop condition wasn't
1453                                         ; met
1454        #:imported-modules ((guix build glib-or-gtk-build-system)
1455                            ,@%python-build-system-modules)
1456        #:modules ((ice-9 match)
1457                   (srfi srfi-26)
1458                   (guix build python-build-system)
1459                   ((guix build glib-or-gtk-build-system) #:prefix glib-or-gtk:)
1460                   (guix build utils))
1461        #:phases
1462        (modify-phases %standard-phases
1463          (add-after 'unpack 'fix-setup
1464            (lambda* (#:key outputs #:allow-other-keys)
1465              (substitute* "virtinst/buildconfig.py"
1466                (("/usr") (assoc-ref outputs "out")))
1467              #t))
1468          (add-after 'unpack 'fix-default-uri
1469            (lambda* (#:key inputs #:allow-other-keys)
1470              ;; Xen is not available for now - so only patch qemu.
1471              (substitute* "virtManager/createconn.py"
1472                (("/usr(/bin/qemu-system-[a-zA-Z0-9_-]+)" _ suffix)
1473                 (search-input-file inputs suffix)))
1474              #t))
1475          (add-before 'wrap 'wrap-with-GI_TYPELIB_PATH
1476            (lambda* (#:key inputs outputs #:allow-other-keys)
1477              (let* ((bin       (string-append (assoc-ref outputs "out") "/bin"))
1478                     (bin-files (find-files bin ".*"))
1479                     (paths     (map (match-lambda
1480                                       ((output . directory)
1481                                        (let* ((girepodir (string-append
1482                                                           directory
1483                                                           "/lib/girepository-1.0")))
1484                                          (if (file-exists? girepodir)
1485                                              girepodir #f))))
1486                                     inputs)))
1487                (for-each (lambda (file)
1488                            (format #t "wrapping ~a\n" file)
1489                            (wrap-program file
1490                              `("GI_TYPELIB_PATH" ":" prefix
1491                                ,(filter identity paths))))
1492                          bin-files))
1493              #t))
1494          (replace 'check
1495            (lambda* (#:key tests? #:allow-other-keys)
1496              (when tests?
1497                (setenv "HOME" "/tmp")
1498                (setenv "XDG_CACHE_HOME" "/tmp")
1499                (system "Xvfb :1 &")
1500                (setenv "DISPLAY" ":1")
1501                ;; Dogtail requires that Assistive Technology support be enabled
1502                (setenv "GTK_MODULES" "gail:atk-bridge")
1503                (invoke "dbus-run-session" "--" "pytest" "--uitests"))
1504              #t))
1505          (add-after 'install 'glib-or-gtk-compile-schemas
1506            (assoc-ref glib-or-gtk:%standard-phases 'glib-or-gtk-compile-schemas))
1507          (add-after 'wrap 'glib-or-gtk-wrap
1508            (assoc-ref glib-or-gtk:%standard-phases 'glib-or-gtk-wrap)))))
1509     (inputs
1510      (list dconf
1511            gtk+
1512            gtk-vnc
1513            gtksourceview
1514            libvirt
1515            libvirt-glib
1516            libosinfo
1517            vte
1518            python-libvirt
1519            python-requests
1520            python-pycairo
1521            python-pygobject
1522            python-libxml2
1523            spice-gtk))
1524     ;; virt-manager searches for qemu-img or kvm-img in the PATH.
1525     (propagated-inputs
1526      (list qemu))
1527     (native-inputs
1528      `(("glib" ,glib "bin")             ; glib-compile-schemas
1529        ("gobject-introspection" ,gobject-introspection)
1530        ("gtk+" ,gtk+ "bin")             ; gtk-update-icon-cache
1531        ("perl" ,perl)                   ; pod2man
1532        ("intltool" ,intltool)
1533        ("rst2man" ,python-docutils)
1534        ;; The following are required for running the tests
1535        ;; ("python-pytest" ,python-pytest)
1536        ;; ("python-dogtail" ,python-dogtail)
1537        ;; ("xvfb" ,xorg-server-for-tests)
1538        ;; ("dbus" ,dbus)
1539        ;; ("at-spi2-core" ,at-spi2-core)
1540        ;; ("gsettings-desktop-schemas" ,gsettings-desktop-schemas)
1541        ))
1542     (home-page "https://virt-manager.org/")
1543     (synopsis "Manage virtual machines")
1544     (description
1545      "The virt-manager application is a desktop user interface for managing
1546 virtual machines through libvirt.  It primarily targets KVM VMs, but also
1547 manages Xen and LXC (Linux containers).  It presents a summary view of running
1548 domains, their live performance and resource utilization statistics.")
1549     (license license:gpl2+)))
1550
1551 (define-public criu
1552   (package
1553     (name "criu")
1554     (version "3.17")
1555     (source
1556      (origin
1557        (method git-fetch)
1558        (uri (git-reference
1559              (url "https://github.com/checkpoint-restore/criu")
1560              (commit (string-append "v" version))))
1561        (file-name (git-file-name name version))
1562        (sha256
1563         (base32 "1qql1xp2zkkd7z50vp0nylx3rqrp8xa3c6x25c886d5i1j9pak5x"))))
1564     (build-system gnu-build-system)
1565     (arguments
1566      `(#:test-target "test"
1567        #:tests? #f ; tests require mounting as root
1568        #:make-flags
1569        (list (string-append "PREFIX=" (assoc-ref %outputs "out"))
1570              (string-append "LIBDIR=$(PREFIX)/lib")
1571              ;; Upstream mistakenly puts binaries in /var.  Now, in practice no
1572              ;; plugins are built, but the build system still fails otherwise.
1573              (string-append "PLUGINDIR=$(LIBDIR)/criu")
1574              (string-append "ASCIIDOC="
1575                             (search-input-file %build-inputs
1576                                                "/bin/asciidoc"))
1577              (string-append "PYTHON=python3")
1578              (string-append "XMLTO="
1579                             (search-input-file %build-inputs
1580                                                "/bin/xmlto")))
1581        #:phases
1582        (modify-phases %standard-phases
1583          (delete 'configure)            ; no configure script
1584          (add-after 'unpack 'fix-documentation
1585            (lambda* (#:key inputs outputs #:allow-other-keys)
1586              (substitute* "Documentation/Makefile"
1587                (("-m custom.xsl")
1588                 (string-append
1589                  "-m custom.xsl --skip-validation -x "
1590                  (assoc-ref inputs "docbook-xsl") "/xml/xsl/"
1591                  ,(package-name docbook-xsl) "-"
1592                  ,(package-version docbook-xsl)
1593                  "/manpages/docbook.xsl")))))
1594          (add-after 'unpack 'hardcode-variables
1595            (lambda* (#:key inputs outputs #:allow-other-keys)
1596              ;; Hardcode arm version detection
1597              (substitute* "Makefile"
1598                (("ARMV.*:=.*") "ARMV := 7\n"))
1599              ;; Hard-code the correct PLUGINDIR above.
1600              (substitute* "criu/include/plugin.h"
1601                (("/var") (string-append (assoc-ref outputs "out"))))
1602              ))
1603          (add-before 'build 'fix-symlink
1604            (lambda* (#:key inputs #:allow-other-keys)
1605              ;; The file 'images/google/protobuf/descriptor.proto' points to
1606              ;; /usr/include/..., which obviously does not exist.
1607              (let* ((file "google/protobuf/descriptor.proto")
1608                     (target (string-append "images/" file))
1609                     (source (search-input-file
1610                              inputs
1611                              (string-append "include/" file))))
1612                (delete-file target)
1613                (symlink source target))))
1614          (add-after 'install 'wrap
1615            (lambda* (#:key inputs outputs #:allow-other-keys)
1616              ;; Make sure 'crit' runs with the correct PYTHONPATH.
1617              (let* ((out  (assoc-ref outputs "out"))
1618                     (site (string-append out "/lib/python"
1619                                          ,(version-major+minor
1620                                            (package-version python))
1621                                          "/site-packages"))
1622                     (path (getenv "GUIX_PYTHONPATH")))
1623                (wrap-program (string-append out "/bin/crit")
1624                  `("GUIX_PYTHONPATH" ":" prefix (,site ,path))))))
1625          (add-after 'install 'delete-static-libraries
1626            ;; Not building/installing these at all doesn't seem to be supported.
1627            (lambda* (#:key outputs #:allow-other-keys)
1628              (let ((out (assoc-ref outputs "out")))
1629                (for-each delete-file (find-files out "\\.a$"))))))))
1630     (inputs
1631      `(("protobuf" ,protobuf)
1632        ("python" ,python)
1633        ("python-protobuf" ,python-protobuf)
1634        ("iproute" ,iproute)
1635        ("libaio" ,libaio)
1636        ("libcap" ,libcap)
1637        ("libnet" ,libnet)
1638        ("libnl" ,libnl)
1639        ("libbsd" ,libbsd)
1640        ("nftables" ,nftables)))
1641     (native-inputs
1642      (list pkg-config
1643            perl
1644            asciidoc
1645            xmlto
1646            docbook-xml
1647            docbook-xsl))
1648     (propagated-inputs
1649      ;; included by 'rpc.pb-c.h'
1650      (list protobuf-c))
1651     (home-page "https://criu.org")
1652     (synopsis "Checkpoint and restore in user space")
1653     (description "Using this tool, you can freeze a running application (or
1654 part of it) and checkpoint it to a hard drive as a collection of files.  You
1655 can then use the files to restore and run the application from the point it
1656 was frozen at.  The distinctive feature of the CRIU project is that it is
1657 mainly implemented in user space.")
1658     ;; The project is licensed under GPLv2; files in the lib/ directory are
1659     ;; LGPLv2.1.
1660     (license (list license:gpl2 license:lgpl2.1))))
1661
1662 (define-public python-qemu-qmp
1663   (package
1664     (name "python-qemu-qmp")
1665     (version "0.0.0a0")
1666     (source
1667      (origin
1668        (method url-fetch)
1669        (uri (pypi-uri "qemu.qmp" version))
1670        (sha256
1671         (base32 "1rpsbiwvngij6fjcc5cx1azcc4dxmm080crr31wc7jrm7i61p7c2"))))
1672     (build-system python-build-system)
1673     (arguments
1674      (list
1675       #:phases
1676       #~(modify-phases %standard-phases
1677           (replace 'check
1678             (lambda* (#:key tests? #:allow-other-keys)
1679               (when tests?
1680                 ;; The Avocado test runner insists on writing stuff to HOME.
1681                 (setenv "HOME" "/tmp")
1682                 ;; The mypy tests fail (see:
1683                 ;; https://gitlab.com/jsnow/qemu.qmp/-/issues/1).
1684                 (delete-file "tests/mypy.sh")
1685                 (invoke "avocado" "--show=all" "run" "tests")))))))
1686     (native-inputs
1687      (list python-avocado-framework
1688            python-setuptools-scm
1689            python-flake8
1690            python-isort
1691            python-pylint))
1692     (propagated-inputs
1693      (list python-pygments
1694            python-urwid
1695            python-urwid-readline))
1696     (home-page "https://gitlab.com/jsnow/qemu.qmp")
1697     (synopsis "QEMU Monitor Protocol Python library")
1698     (description "@code{emu.qmp} is a
1699 @url{https://gitlab.com/qemu-project/qemu/-/blob/master/docs/interop/qmp-intro.txt,
1700 QEMU Monitor Protocol (QMP)} library written in Python.  It is used to send
1701 QMP messages to running QEMU emulators.  It can be used to communicate with
1702 QEMU emulators, the QEMU Guest Agent (QGA), the QEMU Storage Daemon (QSD), or
1703 any other utility or application that speaks QMP.")
1704     (license license:gpl2+)))
1705
1706 (define-public qmpbackup
1707   (package
1708     (name "qmpbackup")
1709     (version "0.23")
1710     (source (origin
1711               (method git-fetch)
1712               (uri (git-reference
1713                     (url "https://github.com/abbbi/qmpbackup")
1714                     (commit (string-append "v" version))))
1715               (file-name (git-file-name name version))
1716               (sha256
1717                (base32
1718                 "0x9v81z0b2qr2y6m46rfnl4kl5jnixsdrl1c790iwl6pq9kzzvzg"))))
1719     (build-system python-build-system)
1720     ;; The test suite requires to download a 241 MiB QEMU image; skip it.
1721     (arguments (list #:tests? #f))
1722     (inputs (list python-qemu-qmp))
1723     (home-page "https://github.com/abbbi/qmpbackup")
1724     (synopsis "Backup and restore QEMU machines")
1725     (description "@command{qmpbackup} is designed to create and restore full
1726 and incremental backups of running QEMU virtual machines via QMP, the QEMU
1727 Machine Protocol.")
1728     (license license:gpl3+)))
1729
1730 (define-public looking-glass-client
1731   (package
1732     (name "looking-glass-client")
1733     (version "B5")
1734     (source
1735      (origin
1736        (method git-fetch)
1737        (uri (git-reference
1738              (url "https://github.com/gnif/LookingGlass")
1739              (commit version)
1740              (recursive? #t)))
1741        (file-name (git-file-name name version))
1742        (sha256
1743         (base32
1744          "09mn544x5hg1z31l92ksk7fi7yj9r8xdk0dcl9fk56ivcr452ylm"))))
1745     (build-system cmake-build-system)
1746     (inputs
1747      (list bash-minimal
1748            fontconfig
1749            freetype
1750            glu
1751            gmp
1752            libglvnd
1753            libiberty
1754            libx11
1755            libxcursor
1756            libxfixes
1757            libxi
1758            libxinerama
1759            libxkbcommon
1760            libxpresent
1761            libxrandr
1762            libxscrnsaver
1763            mesa
1764            openssl
1765            sdl2
1766            sdl2-ttf
1767            spice-protocol
1768            wayland
1769            wayland-protocols
1770            `(,zlib "static")))
1771     (native-inputs (list libconfig nettle pkg-config))
1772     (arguments
1773      `(#:tests? #f ;; No tests are available.
1774        #:make-flags '("CC=gcc")
1775        #:phases (modify-phases %standard-phases
1776                   (add-before 'configure 'chdir-to-client
1777                     (lambda* (#:key outputs #:allow-other-keys)
1778                       (chdir "client")
1779                       #t))
1780                   (replace 'install
1781                     (lambda* (#:key outputs #:allow-other-keys)
1782                       (install-file "looking-glass-client"
1783                                     (string-append (assoc-ref outputs "out")
1784                                                    "/bin"))
1785                       #t))
1786                   (add-after 'install 'wrapper
1787                     (lambda* (#:key inputs outputs #:allow-other-keys)
1788                       (wrap-program
1789                           (string-append (assoc-ref outputs "out")
1790                                          "/bin/looking-glass-client")
1791                         `("LD_LIBRARY_PATH" ":" prefix
1792                           ,(map (lambda (name)
1793                                   (let ((input (assoc-ref inputs name)))
1794                                     (string-append input "/lib")))
1795                                 '("gmp"
1796                                   "libxi"
1797                                   "nettle"
1798                                   "mesa"
1799                                   "wayland"
1800                                   "fontconfig-minimal"
1801                                   "freetype"
1802                                   "libx11"
1803                                   "libxfixes"
1804                                   "libxscrnsaver"
1805                                   "libxinerama"))))
1806                       #t)))))
1807     (home-page "https://looking-glass.io/")
1808     (synopsis "KVM Frame Relay (KVMFR) implementation")
1809     (description "Looking Glass allows the use of a KVM (Kernel-based Virtual
1810 Machine) configured for VGA PCI Pass-through without an attached physical
1811 monitor, keyboard or mouse.  It displays the VM's rendered contents on your
1812 main monitor/GPU.")
1813     ;; This package requires SSE instructions.
1814     (supported-systems '("i686-linux" "x86_64-linux"))
1815     (license license:gpl2+)))
1816
1817 (define-public runc
1818   (package
1819     (name "runc")
1820     (version "1.1.1")
1821     (source (origin
1822               (method url-fetch)
1823               (uri (string-append
1824                     "https://github.com/opencontainers/runc/releases/"
1825                     "download/v" version "/runc.tar.xz"))
1826               (file-name (string-append name "-" version ".tar.xz"))
1827               (sha256
1828                (base32
1829                 "0jx56x49dgkygdbrfb3pmxycy1n37arj97jra8n422dj36xz1hbm"))))
1830     (build-system go-build-system)
1831     (arguments
1832      '(#:import-path "github.com/opencontainers/runc"
1833        #:install-source? #f
1834        ;; XXX: 20/139 tests fail due to missing /var, cgroups and apparmor in
1835        ;; the build environment.
1836        #:tests? #f
1837        #:phases
1838        (modify-phases %standard-phases
1839          (replace 'build
1840            (lambda* (#:key import-path #:allow-other-keys)
1841              (with-directory-excursion (string-append "src/" import-path)
1842                (invoke "make" "all" "man"))))
1843          (replace 'check
1844            (lambda* (#:key tests? #:allow-other-keys)
1845              (when tests?
1846                (invoke "make" "localunittest"))))
1847          (replace 'install
1848            (lambda* (#:key import-path outputs #:allow-other-keys)
1849              (with-directory-excursion (string-append "src/" import-path)
1850                (let ((out (assoc-ref outputs "out")))
1851                  (invoke "make" "install" "install-bash" "install-man"
1852                          (string-append "PREFIX=" out)))))))))
1853     (native-inputs
1854      (list go-github-com-go-md2man pkg-config))
1855     (inputs
1856      (list libseccomp))
1857     (synopsis "Open container initiative runtime")
1858     (home-page "https://opencontainers.org/")
1859     (description
1860      "@command{runc} is a command line client for running applications
1861 packaged according to the
1862 @uref{https://github.com/opencontainers/runtime-spec/blob/master/spec.md, Open
1863 Container Initiative (OCI) format} and is a compliant implementation of the
1864 Open Container Initiative specification.")
1865     (license license:asl2.0)))
1866
1867 (define-public umoci
1868   (package
1869     (name "umoci")
1870     (version "0.4.7")
1871     (source
1872      (origin
1873        (method url-fetch)
1874        (uri (string-append
1875              "https://github.com/opencontainers/umoci/releases/download/v"
1876              version "/umoci.tar.xz"))
1877        (file-name (string-append "umoci-" version ".tar.xz"))
1878        (sha256
1879         (base32 "0fvljj9k4f83wbqzd8nbijz0p1zaq633f8yxyvl5sy3wjf03ffk9"))))
1880     (build-system go-build-system)
1881     (arguments
1882      '(#:import-path "github.com/opencontainers/umoci"
1883        #:install-source? #f
1884        #:phases
1885        (modify-phases %standard-phases
1886          (replace 'unpack
1887            (lambda* (#:key source import-path #:allow-other-keys)
1888              ;; Unpack the tarball into 'umoci' instead of "runc-${version}".
1889              (let ((dest (string-append "src/" import-path)))
1890                (mkdir-p dest)
1891                (invoke "tar" "-C" (string-append "src/" import-path)
1892                        "--strip-components=1"
1893                        "-xvf" source))))
1894          (replace 'build
1895            (lambda* (#:key import-path #:allow-other-keys)
1896              (with-directory-excursion (string-append "src/" import-path)
1897                ;; TODO: build manpages with 'go-md2man'.
1898                (invoke "make" "SHELL=bash"))))
1899          (replace 'install
1900            (lambda* (#:key import-path outputs #:allow-other-keys)
1901              (let* ((out (assoc-ref outputs "out"))
1902                     (bindir (string-append out "/bin")))
1903                (install-file (string-append "src/" import-path "/umoci")
1904                              bindir)
1905                #t))))))
1906     (home-page "https://umo.ci/")
1907     (synopsis "Tool for modifying Open Container images")
1908     (description
1909      "@command{umoci} is a tool that allows for high-level modification of an
1910 Open Container Initiative (OCI) image layout and its tagged images.")
1911     (license license:asl2.0)))
1912
1913 (define-public skopeo
1914   (package
1915     (name "skopeo")
1916     (version "1.2.3")
1917     (source (origin
1918               (method git-fetch)
1919               (uri (git-reference
1920                     (url "https://github.com/containers/skopeo")
1921                     (commit (string-append "v" version))))
1922               (file-name (git-file-name name version))
1923               (sha256
1924                (base32
1925                 "0n22sdif437ddg5ch0ipwim3fg0n6ihc9bfi52qkhy3r1grz04hs"))))
1926     (build-system go-build-system)
1927     (native-inputs
1928      (list pkg-config go-github-com-go-md2man))
1929     (inputs
1930      (list btrfs-progs
1931            eudev
1932            libassuan
1933            libselinux
1934            libostree
1935            lvm2
1936            glib
1937            gpgme))
1938     (arguments
1939      '(#:import-path "github.com/containers/skopeo"
1940        #:install-source? #f
1941        #:tests? #f                                ; The tests require Docker
1942        #:phases
1943        (modify-phases %standard-phases
1944          (replace 'build
1945            (lambda* (#:key import-path #:allow-other-keys)
1946              (with-directory-excursion (string-append "src/" import-path)
1947                (invoke "make" "bin/skopeo"))))
1948          (add-after 'build 'build-docs
1949            (lambda* (#:key import-path #:allow-other-keys)
1950              (with-directory-excursion (string-append "src/" import-path)
1951                (invoke "make" "docs"))))
1952          (replace 'install
1953            (lambda* (#:key import-path outputs #:allow-other-keys)
1954              (with-directory-excursion (string-append "src/" import-path)
1955                (let ((out (assoc-ref outputs "out")))
1956                  (install-file "default-policy.json"
1957                                (string-append out "/etc/containers"))
1958                  (invoke "make" "install-binary" "install-completions" "install-docs"
1959                          (string-append "PREFIX=" out)))))))))
1960     (home-page "https://github.com/containers/skopeo")
1961     (synopsis "Interact with container images and container image registries")
1962     (description
1963      "@command{skopeo} is a command line utility providing various operations
1964 with container images and container image registries.  It can:
1965 @enumerate
1966
1967 @item Copy container images between various containers image stores,
1968 converting them as necessary.
1969
1970 @item Convert a Docker schema 2 or schema 1 container image to an OCI image.
1971
1972 @item Inspect a repository on a container registry without needlessly pulling
1973 the image.
1974
1975 @item Sign and verify container images.
1976
1977 @item Delete container images from a remote container registry.
1978
1979 @end enumerate")
1980     (license license:asl2.0)))
1981
1982 (define-public python-vagrant
1983   (package
1984     (name "python-vagrant")
1985     (version "0.5.15")
1986     (source
1987       (origin
1988         (method url-fetch)
1989         (uri (pypi-uri "python-vagrant" version))
1990         (sha256
1991          (base32
1992           "1ikrh6canhcxg5y7pzmkcnnydikppv7s6sm9prfx90nk0ac8m6mg"))))
1993     (build-system python-build-system)
1994     (arguments
1995      '(#:tests? #f)) ; tests involve running vagrant.
1996     (home-page "https://github.com/todddeluca/python-vagrant")
1997     (synopsis "Python bindings for Vagrant")
1998     (description
1999      "Python-vagrant is a Python module that provides a thin wrapper around the
2000 @code{vagrant} command line executable, allowing programmatic control of Vagrant
2001 virtual machines.")
2002     (license license:expat)))
2003
2004 (define-public bubblewrap
2005   (package
2006     (name "bubblewrap")
2007     (version "0.6.1")
2008     (source (origin
2009               (method url-fetch)
2010               (uri (string-append "https://github.com/containers/bubblewrap/"
2011                                   "releases/download/v" version "/bubblewrap-"
2012                                   version ".tar.xz"))
2013               (sha256
2014                (base32
2015                 "10ij62jg7p2scwdx0pm141ss7p2gjdkbbymb56y8miib2vfcf2cn"))
2016                (patches (search-patches "bubblewrap-fix-locale-in-tests.patch"))))
2017     (build-system gnu-build-system)
2018     (arguments
2019      `(#:phases
2020        (modify-phases %standard-phases
2021          (add-after 'unpack 'fix-test
2022            (lambda* (#:key outputs #:allow-other-keys)
2023              ;; Tests try to access /var/tmp, which is not possible in our build
2024              ;; environment.  Let's give them another directory.
2025              ;; /tmp gets overriden in some tests, so we need another directory.
2026              ;; the only possibility is the output directory.
2027              (let ((tmp-dir (string-append (assoc-ref outputs "out") "/tmp")))
2028                (mkdir-p tmp-dir)
2029                (substitute* "tests/test-run.sh"
2030                  (("/var/tmp") tmp-dir)
2031                  ;; Tests create a temporary python script, so fix its shebang.
2032                  (("/usr/bin/env python3") (which "python3"))
2033                  ;; Tests call /usr/bin/env, so fix its path.
2034                  (("/usr/bin/env") (which "env"))
2035                  ;; Some tests try to access /usr, but that doesn't exist.
2036                  ;; Give them /gnu instead.
2037                  (("/usr") "/gnu")
2038                  (("--ro-bind /bin /bin") "--ro-bind /gnu /bin")
2039                  (("--ro-bind /sbin /sbin") "--ro-bind /gnu /sbin")
2040                  (("--ro-bind /lib /lib") "--ro-bind /gnu /lib")
2041                  (("  */bin/bash") (which "bash"))
2042                  (("/bin/sh") (which "sh"))
2043                  (("findmnt") (which "findmnt")))
2044                (substitute* "tests/libtest.sh"
2045                  (("/var/tmp") tmp-dir)
2046                  (("/usr") "/gnu")
2047                  (("--ro-bind /bin /bin") "--ro-bind /gnu /bin")
2048                  (("--ro-bind /sbin /sbin") "--ro-bind /gnu /sbin")
2049                  (("--ro-bind /lib /lib") "--ro-bind /gnu /lib")))
2050              #t))
2051          ;; Remove the directory we gave to tests to have a clean package.
2052          (add-after 'check 'remove-tmp-dir
2053            (lambda* (#:key outputs #:allow-other-keys)
2054              (delete-file-recursively (string-append (assoc-ref outputs "out") "/tmp"))
2055              #t)))))
2056     (inputs (list libcap))
2057     (native-inputs (list python-wrapper util-linux))
2058     (home-page "https://github.com/containers/bubblewrap")
2059     (synopsis "Unprivileged sandboxing tool")
2060     (description "Bubblewrap is aimed at running applications in a sandbox,
2061 restricting their access to parts of the operating system or user data such as
2062 the home directory.  Bubblewrap always creates a new mount namespace, and the
2063 user can specify exactly what parts of the file system should be made visible
2064 in the sandbox.  These directories are mounted with the @code{nodev} option
2065 by default and can be made read-only.")
2066     (license license:lgpl2.0+)))
2067
2068 (define-public bochs
2069   (package
2070     (name "bochs")
2071     (version "2.7")
2072     (source
2073      (origin
2074        (method url-fetch)
2075        (uri (string-append "https://sourceforge.net/projects/bochs/files/bochs/"
2076                            version "/bochs-" version ".tar.gz"))
2077        (sha256
2078         (base32 "0ymiwnfqg5npq2dk9ngidbbfn3qw8z6i491finhcaan7zldsn450"))))
2079     (build-system gnu-build-system)
2080     (arguments
2081      `(#:tests? #f))                    ; no tests exist
2082     (inputs
2083      (list libxrandr))
2084     (home-page "http://bochs.sourceforge.net/")
2085     (synopsis "Emulator for x86 PC")
2086     (description
2087      "Bochs is an emulator which can emulate Intel x86 CPU, common I/O
2088 devices, and a custom BIOS.  It can also be compiled to emulate many different
2089 x86 CPUs, from early 386 to the most recent x86-64 Intel and AMD processors.
2090 Bochs can run most Operating Systems inside the emulation including Linux,
2091 DOS or Microsoft Windows.")
2092     (license license:lgpl2.0+)))
2093
2094 (define-public xen
2095   (package
2096     (name "xen")
2097     (version "4.14.1")               ; please update the mini-os input as well
2098     (source (origin
2099               (method git-fetch)
2100               (uri (git-reference
2101                     (url "https://xenbits.xen.org/git-http/xen.git")
2102                     (commit (string-append "RELEASE-" version))))
2103               (file-name (git-file-name name version))
2104               (sha256
2105                (base32
2106                 "1r90rvypw76ya9clqw5p02gm1k8hxz73f7gr95ca778nnzvb7xjw"))))
2107     (build-system gnu-build-system)
2108     (arguments
2109      `(#:configure-flags
2110        (list "--enable-rpath"
2111              "--disable-qemu-traditional" ; It tries to do "git clone"
2112              "--disable-rombios" ; would try to "git clone" via etherboot.
2113              ;; TODO: Re-enable stubdom (it's "more secure" to use it).
2114              "--disable-stubdom" ; tries to "git clone" old patched newlib.
2115              (string-append "--with-initddir="
2116                             (assoc-ref %outputs "out")
2117                             "/etc/init.d")
2118              (string-append "--with-system-qemu="
2119                             (assoc-ref %build-inputs "qemu")
2120                             "/bin/qemu-system-i386")
2121              (string-append "--with-system-seabios="
2122                             (assoc-ref %build-inputs "seabios")
2123                             "/share/firmware/bios.bin")
2124              (string-append "--with-system-ovmf="
2125                             (assoc-ref %build-inputs "ovmf")
2126                             "/share/firmware/ovmf_ia32.bin"))
2127        #:make-flags (list "-j" "1"
2128                           "XEN_BUILD_DATE=Thu Jan  1 01:00:01 CET 1970"
2129                           "XEN_BUILD_TIME=01:00:01"
2130                           "XEN_BUILD_HOST="
2131                           "ETHERBOOT_NICS="
2132                           "SMBIOS_REL_DATE=01/01/1970"
2133                           "VGABIOS_REL_DATE=01 Jan 1970"
2134                           ; QEMU_TRADITIONAL_LOC
2135                           ; QEMU_UPSTREAM_LOC
2136                           "SYSCONFIG_DIR=/tmp/etc/default"
2137                           (string-append "BASH_COMPLETION_DIR="
2138                                          (assoc-ref %outputs "out")
2139                                          "/etc/bash_completion.d")
2140                           (string-append "BOOT_DIR="
2141                                          (assoc-ref %outputs "out")
2142                                          "/boot")
2143                           (string-append "DEBUG_DIR="
2144                                          (assoc-ref %outputs "out")
2145                                          "/lib/debug")
2146                           (string-append "EFI_DIR="
2147                                          (assoc-ref %outputs "out")
2148                                          "/lib/efi") ; TODO lib64 ?
2149                           "MINIOS_UPSTREAM_URL="
2150                           ;(string-append "DISTDIR="
2151                           ;               (assoc-ref %outputs "out"))
2152 )
2153        #:test-target "test"
2154        #:phases
2155        (modify-phases %standard-phases
2156         (add-after 'unpack 'unpack-mini-os
2157           (lambda* (#:key inputs #:allow-other-keys)
2158             (copy-recursively (assoc-ref inputs "mini-os") "extras/mini-os")
2159             #t))
2160         (add-after 'unpack-mini-os 'patch
2161           (lambda* (#:key inputs outputs #:allow-other-keys)
2162             (substitute* "tools/firmware/Rules.mk"
2163              (("override XEN_TARGET_ARCH = x86_32")
2164               (string-append "override XEN_TARGET_ARCH = x86_32
2165 override CC = " (assoc-ref inputs "cross-gcc") "/bin/i686-linux-gnu-gcc"))
2166              (("^CFLAGS =$")
2167               (string-append "CFLAGS=-I" (assoc-ref inputs "cross-libc")
2168                              "/include\n")))
2169             (substitute* "config/x86_32.mk"
2170              (("CFLAGS += -m32 -march=i686")
2171               (string-append "CFLAGS += -march=i686 -I"
2172                              (assoc-ref inputs "cross-libc")
2173                              "/include")))
2174             ;; /var is not in /gnu/store , so don't try to create it.
2175             (substitute* '("tools/Makefile"
2176                            "tools/xenstore/Makefile"
2177                            "tools/xenpaging/Makefile")
2178              (("\\$\\(INSTALL_DIR\\) .*XEN_(DUMP|LOG|RUN|LIB|PAGING)_DIR.*")
2179               "\n")
2180              (("\\$\\(INSTALL_DIR\\) .*XEN_(RUN|LIB)_STORED.*")
2181               "\n"))
2182             ;; Prevent xen from creating /etc .
2183             (substitute* "tools/examples/Makefile"
2184              ((" install-readmes") "")
2185              ((" install-configs") ""))
2186             ;; Set rpath.
2187             (substitute* "tools/pygrub/setup.py"
2188              (("library_dirs =")
2189               ; TODO: extra_link_args = ['-Wl,-rpath=/opt/foo'],
2190               (string-append "runtime_library_dirs = ['"
2191                              (assoc-ref outputs "out")
2192                              "/lib'],\nlibrary_dirs =")))
2193
2194             ;; This needs to be quoted:
2195             ;; <https://lists.gnu.org/archive/html/guix-devel/2022-03/msg00113.html>.
2196             (substitute* "xen/arch/x86/xen.lds.S"
2197               ((".note.gnu.build-id")
2198                "\".note.gnu.build-id\""))))
2199         (add-before 'configure 'patch-xen-script-directory
2200           (lambda* (#:key outputs #:allow-other-keys)
2201             (substitute* '("configure"
2202                            "tools/configure"
2203                            "docs/configure")
2204              (("XEN_SCRIPT_DIR=.*")
2205               (string-append "XEN_SCRIPT_DIR="
2206                              (assoc-ref outputs "out")
2207                              "/etc/xen/scripts")))
2208             #t))
2209         (add-before 'configure 'set-environment-up
2210           (lambda* (#:key make-flags #:allow-other-keys)
2211              (define (cross? x)
2212                (string-contains x "cross-i686-linux"))
2213              (define (filter-environment! filter-predicate
2214                                           environment-variable-names)
2215                (for-each
2216                 (lambda (env-name)
2217                   (let* ((env-value (getenv env-name))
2218                          (search-path (search-path-as-string->list env-value))
2219                          (new-search-path (filter filter-predicate
2220                                                   search-path))
2221                          (new-env-value (list->search-path-as-string
2222                                          new-search-path ":")))
2223                     (setenv env-name new-env-value)))
2224                 environment-variable-names))
2225              (setenv "CROSS_C_INCLUDE_PATH" (getenv "C_INCLUDE_PATH"))
2226              (setenv "CROSS_CPLUS_INCLUDE_PATH" (getenv "CPLUS_INCLUDE_PATH"))
2227              (setenv "CROSS_LIBRARY_PATH" (getenv "LIBRARY_PATH"))
2228              (filter-environment! cross?
2229               '("CROSS_C_INCLUDE_PATH" "CROSS_CPLUS_INCLUDE_PATH"
2230                 "CROSS_LIBRARY_PATH"))
2231              (filter-environment! (lambda (e) (not (cross? e)))
2232               '("C_INCLUDE_PATH" "CPLUS_INCLUDE_PATH"
2233                 "LIBRARY_PATH"))
2234              ;; Guix tries to be helpful and automatically adds
2235              ;; mini-os-git-checkout/include to the include path,
2236              ;; but actually we don't want it to be there (yet).
2237              (filter-environment! (lambda (e)
2238                                     (not
2239                                      (string-contains e
2240                                       "mini-os-git-checkout")))
2241               '("C_INCLUDE_PATH" "CPLUS_INCLUDE_PATH"
2242                 "LIBRARY_PATH"))
2243             (setenv "EFI_VENDOR" "guix")
2244              #t))
2245         (replace 'build
2246           (lambda* (#:key make-flags #:allow-other-keys)
2247             (apply invoke "make" "world" make-flags))))))
2248     (inputs
2249      `(("acpica" ,acpica) ; TODO: patch iasl invocation.
2250        ("bridge-utils" ,bridge-utils) ; TODO: patch invocations.
2251        ("glib" ,glib)
2252        ("iproute" ,iproute) ; TODO: patch invocations.
2253        ("libaio" ,libaio)
2254        ("libx11" ,libx11)
2255        ("libyajl" ,libyajl)
2256        ("ncurses" ,ncurses)
2257        ("openssl" ,openssl)
2258        ("ovmf" ,ovmf)
2259        ("pixman" ,pixman)
2260        ("qemu" ,qemu-minimal)
2261        ("seabios" ,seabios)
2262        ("util-linux" ,util-linux "lib") ; uuid
2263        ; TODO: ocaml-findlib, ocaml-nox.
2264        ("xz" ,xz) ; for liblzma
2265        ("zlib" ,zlib)))
2266     (native-inputs
2267      `(("dev86" ,dev86)
2268        ("bison" ,bison)
2269        ("cmake" ,cmake-minimal)
2270        ("figlet" ,figlet)
2271        ("flex" ,flex)
2272        ("gettext" ,gettext-minimal)
2273        ("libnl" ,libnl)
2274        ("mini-os"
2275        ,(origin
2276          (method git-fetch)
2277          (uri (git-reference
2278                (url "https://xenbits.xen.org/git-http/mini-os.git")
2279                ;; This corresponds to (string-append "xen-RELEASE-" version))
2280                ;; at time of packaging, but upstream has unfortunately modified
2281                ;; existing tags in the past.
2282                (commit "0b4b7897e08b967a09bed2028a79fabff82342dd")))
2283          (sha256
2284           (base32 "1i8pcl19n60i2m9vlg79q3nknpj209c9ic5x10wxaicx45kc107f"))
2285          (file-name "mini-os-git-checkout")))
2286        ("perl" ,perl)
2287        ; TODO: markdown
2288        ("pkg-config" ,pkg-config)
2289        ("python" ,python-2)
2290        ("wget" ,wget)
2291        ("cross-gcc" ,(cross-gcc "i686-linux-gnu"
2292                                 #:xbinutils (cross-binutils "i686-linux-gnu")
2293                                 #:libc (cross-libc "i686-linux-gnu")))
2294        ("cross-libc" ,(cross-libc "i686-linux-gnu")) ; header files
2295        ("cross-libc-static" ,(cross-libc "i686-linux-gnu") "static")))
2296     (home-page "https://xenproject.org/")
2297     (synopsis "Xen Virtual Machine Monitor")
2298     (description "This package provides the Xen Virtual Machine Monitor
2299 which is a hypervisor.")
2300     ;; TODO: Some files are licensed differently.  List those.
2301     (license license:gpl2)
2302     (supported-systems '("i686-linux" "x86_64-linux" "armhf-linux"))))
2303
2304 (define-public osinfo-db-tools
2305   (package
2306     (name "osinfo-db-tools")
2307     (version "1.9.0")
2308     (source (origin
2309               (method url-fetch)
2310               (uri (string-append "https://releases.pagure.org/libosinfo/osinfo-db-tools-"
2311                                   version ".tar.xz"))
2312
2313               (sha256
2314                (base32
2315                 "1h23a8nzdxjyvw44dwh903563n3b1z5skx8g0b1p1v5cif3iqpr5"))))
2316     (build-system meson-build-system)
2317     (inputs
2318      (list libsoup-minimal-2 libxml2 libxslt json-glib libarchive))
2319     (native-inputs
2320      (list perl
2321            gobject-introspection
2322            gettext-minimal
2323            pkg-config
2324            ;; Tests
2325            python
2326            python-pytest
2327            python-requests))
2328     (home-page "https://gitlab.com/libosinfo/osinfo-db-tools")
2329     (synopsis "Tools for managing the osinfo database")
2330     (description "This package contains a set of tools to assist
2331 administrators and developers in managing the database.")
2332     (license license:lgpl2.0+)))
2333
2334 (define-public osinfo-db
2335   (package
2336     (name "osinfo-db")
2337     (version "20220516")
2338     (source (origin
2339               (method url-fetch)
2340               (uri (string-append "https://releases.pagure.org/libosinfo/osinfo-db-"
2341                                   version ".tar.xz"))
2342               (sha256
2343                (base32
2344                 "0vfsdk3c6n6y04c5rf92m31zvl969kaniyx2fqywbp69mzc6j3yn"))))
2345     (build-system trivial-build-system)
2346     (arguments
2347      `(#:modules ((guix build utils))
2348        #:builder
2349        (begin
2350          (use-modules (guix build utils))
2351          (let* ((out (assoc-ref %outputs "out"))
2352                 (osinfo-dir (string-append out "/share/osinfo"))
2353                 (source (assoc-ref %build-inputs "source"))
2354                 (osinfo-db-import
2355                  (string-append (assoc-ref %build-inputs "osinfo-db-tools")
2356                                 "/bin/osinfo-db-import")))
2357            (mkdir-p osinfo-dir)
2358            (invoke osinfo-db-import "--dir" osinfo-dir source)))))
2359     (native-inputs
2360      (list intltool osinfo-db-tools))
2361     (home-page "https://gitlab.com/libosinfo/osinfo-db")
2362     (synopsis "Database of information about operating systems")
2363     (description "Osinfo-db provides the database files for use with the
2364 libosinfo library.  It provides information about guest operating systems for
2365 use with virtualization provisioning tools")
2366     (license license:lgpl2.0+)))
2367
2368 (define-public python-transient
2369   (package
2370     (name "python-transient")
2371     (version "0.12")
2372     (source
2373      (origin
2374        (method url-fetch)
2375        (uri (pypi-uri "transient" version))
2376        (sha256
2377         (base32
2378          "148yiqrmcscsi6787y0f27i1y9cf0gcw3mqfv5frhpmsmv62mv5z"))))
2379     (build-system python-build-system)
2380     (arguments
2381      `(#:tests? #f ; Requires behave
2382        #:phases (modify-phases %standard-phases
2383                   (add-after 'unpack 'fix-dependencies
2384                     (lambda _
2385                       (substitute* "setup.py"
2386                         (("==")
2387                          ">="))
2388                       #t)))))
2389     (propagated-inputs
2390      (list python-beautifultable
2391            python-click
2392            python-importlib-resources
2393            python-lark-parser
2394            python-marshmallow
2395            python-progressbar2
2396            python-requests
2397            python-toml))
2398     (native-inputs
2399      (list python-black python-mypy python-pyhamcrest python-twine))
2400     (home-page
2401      "https://github.com/ALSchwalm/transient")
2402     (synopsis
2403      "QEMU Wrapper written in Python")
2404     (description
2405      "@code{transient} is a wrapper for QEMU allowing the creation of virtual
2406 machines with shared folder, ssh, and disk creation support.")
2407     (license license:expat)))
2408
2409 (define-public riscv-pk
2410   (package
2411     (name "riscv-pk")
2412     (version "1.0.0")
2413     (source
2414      (origin
2415        (method git-fetch)
2416        (uri (git-reference
2417              (url "https://github.com/riscv-software-src/riscv-pk")
2418              (commit (string-append "v" version))))
2419        (file-name (git-file-name name version))
2420        (sha256
2421         (base32
2422          "1cc0rz4q3a1zw8756b8yysw8lb5g4xbjajh5lvqbjix41hbdx6xz"))))
2423     (build-system gnu-build-system)
2424     (arguments
2425      (list #:out-of-source? #t
2426            ;; riscv-pk can only be built for riscv64.
2427            #:target "riscv64-linux-gnu"
2428            #:make-flags #~(list (string-append "INSTALLDIR=" #$output))
2429            ;; Add flags to keep symbols fromhost and tohost. These symbols are
2430            ;; required for the correct functioning of pk.
2431            #:strip-flags #~(list "--strip-unneeded"
2432                                  "--keep-symbol=fromhost"
2433                                  "--keep-symbol=tohost"
2434                                  "--enable-deterministic-archives")))
2435     (home-page "https://github.com/riscv-software-src/riscv-pk")
2436     (synopsis "RISC-V Proxy Kernel")
2437     (description "The RISC-V Proxy Kernel, @command{pk}, is a lightweight
2438 application execution environment that can host statically-linked RISC-V ELF
2439 binaries.  It is designed to support tethered RISC-V implementations with
2440 limited I/O capability and thus handles I/O-related system calls by proxying
2441 them to a host computer.
2442
2443 This package also contains the Berkeley Boot Loader, @command{bbl}, which is a
2444 supervisor execution environment for tethered RISC-V systems.  It is designed
2445 to host the RISC-V Linux port.")
2446     (license license:bsd-3)))