gnu/packages/virtualization.scm

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