gnu/packages/virtualization.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2020 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 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, 2018, 2019, 2020 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 Brice Waegeneire <brice@waegenei.re>
  16 ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
  17 ;;; Copyright © 2020 Marius Bakke <mbakke@fastmail.com>
  18 ;;;
  19 ;;; This file is part of GNU Guix.
  20 ;;;
  21 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  22 ;;; under the terms of the GNU General Public License as published by
  23 ;;; the Free Software Foundation; either version 3 of the License, or (at
  24 ;;; your option) any later version.
  25 ;;;
  26 ;;; GNU Guix is distributed in the hope that it will be useful, but
  27 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  28 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  29 ;;; GNU General Public License for more details.
  30 ;;;
  31 ;;; You should have received a copy of the GNU General Public License
  32 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  33
  34 (define-module (gnu packages virtualization)
  35   #:use-module (gnu packages)
  36   #:use-module (gnu packages admin)
  37   #:use-module (gnu packages assembly)
  38   #:use-module (gnu packages attr)
  39   #:use-module (gnu packages autotools)
  40   #:use-module (gnu packages backup)
  41   #:use-module (gnu packages base)
  42   #:use-module (gnu packages bison)
  43   #:use-module (gnu packages check)
  44   #:use-module (gnu packages cmake)
  45   #:use-module (gnu packages compression)
  46   #:use-module (gnu packages cross-base)
  47   #:use-module (gnu packages curl)
  48   #:use-module (gnu packages cyrus-sasl)
  49   #:use-module (gnu packages disk)
  50   #:use-module (gnu packages dns)
  51   #:use-module (gnu packages docbook)
  52   #:use-module (gnu packages documentation)
  53   #:use-module (gnu packages figlet)
  54   #:use-module (gnu packages firmware)
  55   #:use-module (gnu packages flex)
  56   #:use-module (gnu packages fontutils)
  57   #:use-module (gnu packages freedesktop)
  58   #:use-module (gnu packages gettext)
  59   #:use-module (gnu packages gl)
  60   #:use-module (gnu packages glib)
  61   #:use-module (gnu packages gnome)
  62   #:use-module (gnu packages gnupg)
  63   #:use-module (gnu packages golang)
  64   #:use-module (gnu packages graphviz)
  65   #:use-module (gnu packages gtk)
  66   #:use-module (gnu packages haskell)
  67   #:use-module (gnu packages haskell-apps)
  68   #:use-module (gnu packages haskell-check)
  69   #:use-module (gnu packages haskell-crypto)
  70   #:use-module (gnu packages haskell-web)
  71   #:use-module (gnu packages haskell-xyz)
  72   #:use-module (gnu packages image)
  73   #:use-module (gnu packages libbsd)
  74   #:use-module (gnu packages libusb)
  75   #:use-module (gnu packages linux)
  76   #:use-module (gnu packages m4)
  77   #:use-module (gnu packages ncurses)
  78   #:use-module (gnu packages nettle)
  79   #:use-module (gnu packages networking)
  80   #:use-module (gnu packages onc-rpc)
  81   #:use-module (gnu packages package-management)
  82   #:use-module (gnu packages perl)
  83   #:use-module (gnu packages pkg-config)
  84   #:use-module (gnu packages polkit)
  85   #:use-module (gnu packages protobuf)
  86   #:use-module (gnu packages python)
  87   #:use-module (gnu packages python-crypto)
  88   #:use-module (gnu packages python-web)
  89   #:use-module (gnu packages python-xyz)
  90   #:use-module (gnu packages pulseaudio)
  91   #:use-module (gnu packages selinux)
  92   #:use-module (gnu packages sdl)
  93   #:use-module (gnu packages sphinx)
  94   #:use-module (gnu packages spice)
  95   #:use-module (gnu packages ssh)
  96   #:use-module (gnu packages texinfo)
  97   #:use-module (gnu packages textutils)
  98   #:use-module (gnu packages tls)
  99   #:use-module (gnu packages web)
 100   #:use-module (gnu packages wget)
 101   #:use-module (gnu packages xdisorg)
 102   #:use-module (gnu packages xml)
 103   #:use-module (gnu packages xorg)
 104   #:use-module (guix build-system cmake)
 105   #:use-module (guix build-system gnu)
 106   #:use-module (guix build-system go)
 107   #:use-module (guix build-system meson)
 108   #:use-module (guix build-system python)
 109   #:use-module (guix build-system trivial)
 110   #:use-module (guix download)
 111   #:use-module (guix git-download)
 112   #:use-module ((guix licenses) #:prefix license:)
 113   #:use-module (guix packages)
 114   #:use-module (guix utils)
 115   #:use-module (srfi srfi-1)
 116   #:use-module (ice-9 match))
 117
 118 (define (qemu-patch commit file-name sha256-bv)
 119   "Return an origin for COMMIT."
 120   (origin
 121     (method url-fetch)
 122     (uri (string-append
 123           "http://git.qemu.org/?p=qemu.git;a=commitdiff_plain;h="
 124           commit))
 125     (hash (content-hash sha256-bv sha256))
 126     (file-name file-name)))
 127
 128 (define-public qemu
 129   (package
 130     (name "qemu")
 131     (version "5.0.0")
 132     (source (origin
 133              (method url-fetch)
 134              (uri (string-append "https://download.qemu.org/qemu-"
 135                                  version ".tar.xz"))
 136              (sha256
 137               (base32
 138                "1dlcwyshdp94fwd30pddxf9bn2q8dfw5jsvry2gvdj551wmaj4rg"))))
 139     (build-system gnu-build-system)
 140     (arguments
 141      `(;; Running tests in parallel can occasionally lead to failures, like:
 142        ;; boot_sector_test: assertion failed (signature == SIGNATURE): (0x00000000 == 0x0000dead)
 143        #:parallel-tests? #f
 144
 145        ;; FIXME: Disable tests on i686 to work around
 146        ;; <https://bugs.gnu.org/40527>.
 147        #:tests? ,(or (%current-target-system)
 148                      (not (string=? "i686-linux" (%current-system))))
 149
 150        #:configure-flags (list "--enable-usb-redir" "--enable-opengl"
 151                                "--enable-docs"
 152                                (string-append "--smbd="
 153                                               (assoc-ref %outputs "out")
 154                                               "/libexec/samba-wrapper")
 155                                "--audio-drv-list=alsa,pa,sdl")
 156        ;; Make build and test output verbose to facilitate investigation upon failure.
 157        #:make-flags '("V=1")
 158        #:modules ((srfi srfi-1)
 159                   (ice-9 match)
 160                   ,@%gnu-build-system-modules)
 161        #:phases
 162        (modify-phases %standard-phases
 163          (add-after 'set-paths 'hide-glibc
 164            (lambda* (#:key inputs #:allow-other-keys)
 165              ;; Work around https://issues.guix.info/issue/36882.  We need to
 166              ;; remove glibc from C_INCLUDE_PATH so that the one hardcoded in GCC,
 167              ;; at the bottom of GCC include search-path is used.
 168              (let* ((filters '("libc"))
 169                     (input-directories
 170                      (filter-map (lambda (input)
 171                                    (match input
 172                                      ((name . dir)
 173                                       (and (not (member name filters))
 174                                            dir))))
 175                                  inputs)))
 176                (set-path-environment-variable "C_INCLUDE_PATH"
 177                                               '("include")
 178                                               input-directories)
 179                #t)))
 180          (add-after 'patch-source-shebangs 'patch-/bin/sh-references
 181            (lambda _
 182              ;; Ensure the executables created by these source files reference
 183              ;; /bin/sh from the store so they work inside the build container.
 184              (substitute* '("block/cloop.c" "migration/exec.c"
 185                             "net/tap.c" "tests/qtest/libqtest.c")
 186                (("/bin/sh") (which "sh")))
 187              #t))
 188          (replace 'configure
 189            (lambda* (#:key inputs outputs (configure-flags '())
 190                            #:allow-other-keys)
 191              ;; The `configure' script doesn't understand some of the
 192              ;; GNU options.  Thus, add a new phase that's compatible.
 193              (let ((out (assoc-ref outputs "out")))
 194                (setenv "SHELL" (which "bash"))
 195
 196                ;; While we're at it, patch for tests.
 197                (substitute* "tests/qemu-iotests/check"
 198                  (("#!/usr/bin/env python3")
 199                   (string-append "#!" (which "python3"))))
 200
 201                ;; Ensure config.status gets the correct shebang off the bat.
 202                ;; The build system gets confused if we change it later and
 203                ;; attempts to re-run the whole configury, and fails.
 204                (substitute* "configure"
 205                  (("#!/bin/sh")
 206                   (string-append "#!" (which "sh"))))
 207
 208                ;; The binaries need to be linked against -lrt.
 209                (setenv "LDFLAGS" "-lrt")
 210                (apply invoke
 211                       `("./configure"
 212                         ,(string-append "--cc=" (which "gcc"))
 213                         ;; Some architectures insist on using HOST_CC
 214                         ,(string-append "--host-cc=" (which "gcc"))
 215                         "--disable-debug-info" ; save build space
 216                         "--enable-virtfs"      ; just to be sure
 217                         ,(string-append "--prefix=" out)
 218                         ,(string-append "--sysconfdir=/etc")
 219                         ,@configure-flags)))))
 220          (add-after 'install 'install-info
 221            (lambda* (#:key inputs outputs #:allow-other-keys)
 222              ;; Install the Info manual, unless Texinfo is missing.
 223              (when (assoc-ref inputs "texinfo")
 224                (let* ((out  (assoc-ref outputs "out"))
 225                       (dir (string-append out "/share/info")))
 226                  (invoke "make" "info")
 227                  (for-each (lambda (info)
 228                              (install-file info dir))
 229                            (find-files "." "\\.info"))))
 230              #t))
 231          ;; Create a wrapper for Samba. This allows QEMU to use Samba without
 232          ;; pulling it in as an input. Note that you need to explicitly install
 233          ;; Samba in your Guix profile for Samba support.
 234          (add-after 'install-info 'create-samba-wrapper
 235            (lambda* (#:key inputs outputs #:allow-other-keys)
 236              (let* ((out    (assoc-ref %outputs "out"))
 237                     (libexec (string-append out "/libexec")))
 238                (call-with-output-file "samba-wrapper"
 239                  (lambda (port)
 240                    (format port "#!/bin/sh
 241 exec smbd $@")))
 242                (chmod "samba-wrapper" #o755)
 243                (install-file "samba-wrapper" libexec))
 244              #t))
 245          (add-before 'check 'disable-unusable-tests
 246            (lambda* (#:key inputs outputs #:allow-other-keys)
 247              (substitute* "tests/Makefile.include"
 248                ;; Comment out the test-qga test, which needs /sys and
 249                ;; fails within the build environment.
 250                (("check-unit-.* tests/test-qga" all)
 251                 (string-append "# " all)))
 252              (substitute* "tests/Makefile.include"
 253                ;; Comment out the test-char test, which needs networking and
 254                ;; fails within the build environment.
 255                (("check-unit-.* tests/test-char" all)
 256                 (string-append "# " all)))
 257              #t)))))
 258     (inputs                                       ; TODO: Add optional inputs.
 259      `(("alsa-lib" ,alsa-lib)
 260        ("attr" ,attr)
 261        ("glib" ,glib)
 262        ("gtk+" ,gtk+)
 263        ("libaio" ,libaio)
 264        ("libattr" ,attr)
 265        ("libcacard" ,libcacard)     ; smartcard support
 266        ("libcap-ng" ,libcap-ng)     ; virtfs support requires libcap-ng & libattr
 267        ("libdrm" ,libdrm)
 268        ("libepoxy" ,libepoxy)
 269        ("libjpeg" ,libjpeg-turbo)
 270        ("libpng" ,libpng)
 271        ("libseccomp" ,libseccomp)
 272        ("libusb" ,libusb)                         ;USB pass-through support
 273        ("mesa" ,mesa)
 274        ("ncurses" ,ncurses)
 275        ;; ("pciutils" ,pciutils)
 276        ("pixman" ,pixman)
 277        ("pulseaudio" ,pulseaudio)
 278        ("sdl2" ,sdl2)
 279        ("spice" ,spice)
 280        ("usbredir" ,usbredir)
 281        ("util-linux" ,util-linux)
 282        ("vde2" ,vde2)
 283        ("virglrenderer" ,virglrenderer)
 284        ("zlib" ,zlib)))
 285     (native-inputs `(("gettext" ,gettext-minimal)
 286                      ("glib:bin" ,glib "bin") ; gtester, etc.
 287                      ("perl" ,perl)
 288                      ("flex" ,flex)
 289                      ("bison" ,bison)
 290                      ("pkg-config" ,pkg-config)
 291                      ("python-wrapper" ,python-wrapper)
 292                      ("python-sphinx" ,python-sphinx)
 293                      ("texinfo" ,texinfo)))
 294     (home-page "https://www.qemu.org")
 295     (synopsis "Machine emulator and virtualizer")
 296     (description
 297      "QEMU is a generic machine emulator and virtualizer.
 298
 299 When used as a machine emulator, QEMU can run OSes and programs made for one
 300 machine (e.g. an ARM board) on a different machine---e.g., your own PC.  By
 301 using dynamic translation, it achieves very good performance.
 302
 303 When used as a virtualizer, QEMU achieves near native performances by
 304 executing the guest code directly on the host CPU.  QEMU supports
 305 virtualization when executing under the Xen hypervisor or using
 306 the KVM kernel module in Linux.  When using KVM, QEMU can virtualize x86,
 307 server and embedded PowerPC, and S390 guests.")
 308
 309     ;; Many files are GPLv2+, but some are GPLv2-only---e.g., `memory.c'.
 310     (license license:gpl2)
 311
 312     ;; Several tests fail on MIPS; see <http://hydra.gnu.org/build/117914>.
 313     (supported-systems (fold delete %supported-systems
 314                              '("mips64el-linux" "i586-gnu")))))
 315
 316 (define-public qemu-minimal
 317   ;; QEMU without GUI support, only supporting the host's architecture
 318   (package (inherit qemu)
 319     (name "qemu-minimal")
 320     (synopsis
 321      "Machine emulator and virtualizer (without GUI) for the host architecture")
 322     (arguments
 323      (substitute-keyword-arguments (package-arguments qemu)
 324        ((#:configure-flags _ '(list))
 325         ;; Restrict to the host's architecture.
 326         (match (car (string-split (or (%current-target-system)
 327                                       (%current-system))
 328                                   #\-))
 329           ("i686"
 330            '(list "--target-list=i386-softmmu"))
 331           ("x86_64"
 332            '(list "--target-list=i386-softmmu,x86_64-softmmu"))
 333           ("mips64"
 334            '(list (string-append "--target-list=mips-softmmu,mipsel-softmmu,"
 335                                  "mips64-softmmu,mips64el-softmmu")))
 336           ("mips"
 337            '(list "--target-list=mips-softmmu,mipsel-softmmu"))
 338           ("aarch64"
 339            '(list "--target-list=arm-softmmu,aarch64-softmmu"))
 340           ("arm"
 341            '(list "--target-list=arm-softmmu"))
 342           ("alpha"
 343            '(list "--target-list=alpha-softmmu"))
 344           ("powerpc64"
 345            '(list "--target-list=ppc-softmmu,ppc64-softmmu"))
 346           ("powerpc"
 347            '(list "--target-list=ppc-softmmu"))
 348           ("s390"
 349            '(list "--target-list=s390x-softmmu"))
 350           ("riscv"
 351            '(list "--target-list=riscv32-softmmu,riscv64-softmmu"))
 352           (else   ; An empty list actually builds all the targets.
 353             ''())))))
 354
 355     ;; Remove dependencies on optional libraries, notably GUI libraries.
 356     (native-inputs (fold alist-delete (package-native-inputs qemu)
 357                   '("gettext")))
 358     (inputs (fold alist-delete (package-inputs qemu)
 359                   '("libusb" "mesa" "sdl2" "spice" "virglrenderer" "gtk+"
 360                     "usbredir" "libdrm" "libepoxy" "pulseaudio" "vde2"
 361                     "libcacard")))))
 362
 363 (define (system->qemu-target system)
 364   (cond
 365    ((string-prefix? "i686" system)
 366     "qemu-system-i386")
 367    ((string-prefix? "arm" system)
 368     "qemu-system-arm")
 369    (else
 370     (string-append "qemu-system-" (match (string-split system #\-)
 371                                     ((arch kernel) arch)
 372                                     (_ system))))))
 373
 374 (define-public ganeti
 375   (package
 376     (name "ganeti")
 377     ;; Note: we use a pre-release for Python 3 compatibility as well as many
 378     ;; other fixes.
 379     (version "3.0.0beta1-24-g024cc9fa2")
 380     (source (origin
 381               (method git-fetch)
 382               (uri (git-reference
 383                     (url "https://github.com/ganeti/ganeti")
 384                     (commit (string-append "v" version))))
 385               (sha256
 386                (base32 "1ll34qd2mifni3bhg7cnir3xfnkafig8ch33qndqwrsby0y5ssia"))
 387               (file-name (git-file-name name version))
 388               (patches (search-patches "ganeti-shepherd-support.patch"
 389                                        "ganeti-shepherd-master-failover.patch"
 390                                        "ganeti-deterministic-manual.patch"
 391                                        "ganeti-drbd-compat.patch"
 392                                        "ganeti-os-disk-size.patch"
 393                                        "ganeti-haskell-pythondir.patch"
 394                                        "ganeti-disable-version-symlinks.patch"
 395                                        "ganeti-preserve-PYTHONPATH.patch"))))
 396     (build-system gnu-build-system)
 397     (arguments
 398      `(#:imported-modules (,@%gnu-build-system-modules
 399                            (guix build haskell-build-system)
 400                            (guix build python-build-system))
 401        #:modules (,@%gnu-build-system-modules
 402                   ((guix build haskell-build-system) #:prefix haskell:)
 403                   ((guix build python-build-system) #:select (python-version))
 404                   (ice-9 rdelim))
 405
 406        ;; The default test target includes a lot of checks that are only really
 407        ;; relevant for developers such as NEWS file checking, line lengths, etc.
 408        ;; We are only interested in the "py-tests" and "hs-tests" targets: this
 409        ;; is the closest we've got even though it includes a little more.
 410        #:test-target "check-TESTS"
 411
 412        #:configure-flags
 413        (list "--localstatedir=/var"
 414              "--sharedstatedir=/var"
 415              "--sysconfdir=/etc"
 416              "--enable-haskell-tests"
 417
 418              ;; By default, the build system installs everything to versioned
 419              ;; directories such as $libdir/3.0 and relies on a $libdir/default
 420              ;; symlink pointed from /etc/ganeti/{lib,share} to actually function.
 421              ;; This is done to accommodate installing multiple versions in
 422              ;; parallel, but is of little use to us as Guix users can just
 423              ;; roll back and forth.  Thus, disable it for simplicity.
 424              "--disable-version-links"
 425
 426              ;; Ganeti can optionally take control over SSH host keys and
 427              ;; distribute them to nodes as they are added, and also rotate keys
 428              ;; with 'gnt-cluster renew-crypto --new-ssh-keys'.  Thus it needs to
 429              ;; know how to restart the SSH daemon.
 430              "--with-sshd-restart-command='herd restart ssh-daemon'"
 431
 432              ;; Look for OS definitions in this directory by default.  It can
 433              ;; be changed in the cluster configuration.
 434              "--with-os-search-path=/run/current-system/profile/share/ganeti/os"
 435
 436              ;; The default QEMU executable to use.  We don't use the package
 437              ;; here because this entry is stored in the cluster configuration.
 438              (string-append "--with-kvm-path=/run/current-system/profile/bin/"
 439                             ,(system->qemu-target (%current-system))))
 440        #:phases
 441        (modify-phases %standard-phases
 442          (add-after 'unpack 'create-vcs-version
 443            (lambda _
 444              ;; If we are building from a git checkout, we need to create a
 445              ;; 'vcs-version' file manually because the build system does
 446              ;; not have access to the git repository information.
 447              (unless (file-exists? "vcs-version")
 448                (call-with-output-file "vcs-version"
 449                  (lambda (port)
 450                    (format port "v~a~%" ,version))))
 451              #t))
 452          (add-after 'unpack 'patch-absolute-file-names
 453            (lambda _
 454              (substitute* '("lib/utils/process.py"
 455                             "lib/utils/text.py"
 456                             "src/Ganeti/Constants.hs"
 457                             "src/Ganeti/HTools/CLI.hs"
 458                             "test/py/ganeti.config_unittest.py"
 459                             "test/py/ganeti.hooks_unittest.py"
 460                             "test/py/ganeti.utils.process_unittest.py"
 461                             "test/py/ganeti.utils.text_unittest.py"
 462                             "test/py/ganeti.utils.wrapper_unittest.py")
 463                (("/bin/sh") (which "sh"))
 464                (("/bin/bash") (which "bash"))
 465                (("/usr/bin/env") (which "env"))
 466                (("/bin/true") (which "true")))
 467
 468              ;; This script is called by the node daemon at startup to perform
 469              ;; sanity checks on the cluster IP addresses, and it is also used
 470              ;; in a master-failover scenario.  Add absolute references to
 471              ;; avoid propagating these executables.
 472              (substitute* "tools/master-ip-setup"
 473                (("arping") (which "arping"))
 474                (("ndisc6") (which "ndisc6"))
 475                (("fping") (which "fping"))
 476                (("grep") (which "grep"))
 477                (("ip addr") (string-append (which "ip") " addr")))
 478              #t))
 479          (add-after 'unpack 'override-builtin-PATH
 480            (lambda _
 481              ;; Ganeti runs OS install scripts and similar with a built-in
 482              ;; hard coded PATH.  Patch so it works on Guix System.
 483              (substitute* "src/Ganeti/Constants.hs"
 484                (("/sbin:/bin:/usr/sbin:/usr/bin")
 485                 "/run/setuid-programs:/run/current-system/profile/sbin:\
 486 /run/current-system/profile/bin"))
 487              #t))
 488          (add-after 'bootstrap 'patch-sphinx-version-detection
 489            (lambda _
 490              ;; The build system runs 'sphinx-build --version' to verify that
 491              ;; the Sphinx is recent enough, but does not expect the
 492              ;; .sphinx-build-real executable name created by the Sphinx wrapper.
 493              (substitute* "configure"
 494                (("\\$SPHINX --version 2>&1")
 495                 "$SPHINX --version 2>&1 | sed 's/.sphinx-build-real/sphinx-build/g'"))
 496              #t))
 497
 498          ;; The build system invokes Cabal and GHC, which do not work with
 499          ;; GHC_PACKAGE_PATH: <https://github.com/haskell/cabal/issues/3728>.
 500          ;; Tweak the build system to do roughly what haskell-build-system does.
 501          (add-before 'configure 'configure-haskell
 502            (assoc-ref haskell:%standard-phases 'setup-compiler))
 503          (add-after 'configure 'do-not-use-GHC_PACKAGE_PATH
 504            (lambda _
 505              (unsetenv "GHC_PACKAGE_PATH")
 506              (substitute* "Makefile"
 507                (("\\$\\(CABAL\\)")
 508                 "$(CABAL) --package-db=../package.conf.d")
 509                (("\\$\\(GHC\\)")
 510                 "$(GHC) -package-db=../package.conf.d"))
 511              #t))
 512
 513          (add-after 'configure 'fix-installation-directories
 514            (lambda _
 515              (substitute* "Makefile"
 516                ;; Do not attempt to create /var during install.
 517                (("\\$\\(DESTDIR\\)\\$\\{localstatedir\\}")
 518                 "$(DESTDIR)${prefix}${localstatedir}")
 519                ;; Similarly, do not attempt to install the sample ifup scripts
 520                ;; to /etc/ganeti.
 521                (("\\$\\(DESTDIR\\)\\$\\(ifupdir\\)")
 522                 "$(DESTDIR)${prefix}$(ifupdir)"))
 523              #t))
 524          (add-before 'build 'adjust-tests
 525            (lambda _
 526              ;; Disable tests that can not run.  Do it early to prevent
 527              ;; touching the Makefile later and triggering a needless rebuild.
 528              (substitute* "Makefile"
 529                ;; These tests expect the presence of a 'root' user (via
 530                ;; ganeti/runtime.py), which fails in the build environment.
 531                (("test/py/ganeti\\.asyncnotifier_unittest\\.py") "")
 532                (("test/py/ganeti\\.backend_unittest\\.py") "")
 533                (("test/py/ganeti\\.daemon_unittest\\.py") "")
 534                (("test/py/ganeti\\.tools\\.ensure_dirs_unittest\\.py") "")
 535                (("test/py/ganeti\\.utils\\.io_unittest-runasroot\\.py") "")
 536                ;; Disable the bash_completion test, as it requires the full
 537                ;; bash instead of bash-minimal.
 538                (("test/py/bash_completion\\.bash")
 539                 "")
 540                ;; This test requires networking.
 541                (("test/py/import-export_unittest\\.bash")
 542                 ""))
 543
 544              ;; Many of the Makefile targets reset PYTHONPATH before running
 545              ;; the Python interpreter, which does not work very well for us.
 546              (substitute* "Makefile"
 547                (("PYTHONPATH=")
 548                 (string-append "PYTHONPATH=" (getenv "PYTHONPATH") ":")))
 549              #t))
 550          (add-after 'build 'build-bash-completions
 551            (lambda _
 552              (let ((orig-pythonpath (getenv "PYTHONPATH")))
 553                (setenv "PYTHONPATH" (string-append ".:" orig-pythonpath))
 554                (invoke "./autotools/build-bash-completion")
 555                (setenv "PYTHONPATH" orig-pythonpath)
 556                #t)))
 557          (add-before 'check 'pre-check
 558            (lambda* (#:key inputs #:allow-other-keys)
 559              ;; Set TZDIR so that time zones are found.
 560              (setenv "TZDIR" (string-append (assoc-ref inputs "tzdata")
 561                                             "/share/zoneinfo"))
 562
 563              ;; This test checks whether PYTHONPATH is untouched, and extends
 564              ;; it to include test directories if so.  Add an else branch for
 565              ;; our modified PYTHONPATH, in order to prevent a confusing test
 566              ;; failure where expired certificates are not cleaned because
 567              ;; check-cert-expired is silently crashing.
 568              (substitute* "test/py/ganeti-cleaner_unittest.bash"
 569                (("then export PYTHONPATH=(.*)" all testpath)
 570                 (string-append all "else export PYTHONPATH="
 571                                (getenv "PYTHONPATH") ":" testpath "\n")))
 572
 573              (substitute* "test/py/ganeti.utils.process_unittest.py"
 574                ;; This test attempts to run an executable with
 575                ;; RunCmd(..., reset_env=True), which fails because the default
 576                ;; PATH from Constants.hs does not exist in the build container.
 577                ((".*def testResetEnv.*" all)
 578                 (string-append "  @unittest.skipIf(True, "
 579                                "\"cannot reset env in the build container\")\n"
 580                                all))
 581
 582                ;; XXX: Somehow this test fails in the build container, but
 583                ;; works in 'guix environment -C', even without /bin/sh?
 584                ((".*def testPidFile.*" all)
 585                 (string-append "  @unittest.skipIf(True, "
 586                                "\"testPidFile fails in the build container\")\n"
 587                                all)))
 588
 589              ;; XXX: Why are these links not added automatically.
 590              (with-directory-excursion "test/hs"
 591                (for-each (lambda (file)
 592                            (symlink "../../src/htools" file))
 593                          '("hspace" "hscan" "hinfo" "hbal" "hroller"
 594                            "hcheck" "hail" "hsqueeze")))
 595              #t))
 596          (add-after 'install 'install-bash-completions
 597            (lambda* (#:key outputs #:allow-other-keys)
 598              (let* ((out (assoc-ref outputs "out"))
 599                     (compdir (string-append out "/etc/bash_completion.d")))
 600                (mkdir-p compdir)
 601                (copy-file "doc/examples/bash_completion"
 602                              (string-append compdir "/ganeti"))
 603                ;; The one file contains completions for many different
 604                ;; executables.  Create symlinks for found completions.
 605                (with-directory-excursion compdir
 606                  (for-each
 607                   (lambda (prog) (symlink "ganeti" prog))
 608                   (call-with-input-file "ganeti"
 609                     (lambda (port)
 610                       (let loop ((line (read-line port))
 611                                  (progs '()))
 612                         (if (eof-object? line)
 613                             progs
 614                             (if (string-prefix? "complete" line)
 615                                 (loop (read-line port)
 616                                       ;; Extract "prog" from lines of the form:
 617                                       ;; "complete -F _prog -o filenames prog".
 618                                       ;; Note that 'burnin' is listed with the
 619                                       ;; absolute file name, which is why we
 620                                       ;; run everything through 'basename'.
 621                                       (cons (basename (car (reverse (string-split
 622                                                                      line #\ ))))
 623                                             progs))
 624                                 (loop (read-line port) progs))))))))
 625                #t)))
 626          ;; Wrap all executables with PYTHONPATH.  We can't borrow the phase
 627          ;; from python-build-system because we also need to wrap the scripts
 628          ;; in $out/lib/ganeti such as "node-daemon-setup".
 629          (add-after 'install 'wrap
 630            (lambda* (#:key inputs outputs #:allow-other-keys)
 631              (let* ((out (assoc-ref outputs "out"))
 632                     (sbin (string-append out "/sbin"))
 633                     (lib (string-append out "/lib"))
 634                     (python (assoc-ref inputs "python"))
 635                     (major+minor (python-version python))
 636                     (PYTHONPATH (string-append lib "/python" major+minor
 637                                                "/site-packages:"
 638                                                (getenv "PYTHONPATH"))))
 639                (define (shell-script? file)
 640                  (call-with-ascii-input-file file
 641                    (lambda (port)
 642                      (let ((shebang (false-if-exception (read-line port))))
 643                        (and shebang
 644                             (string-prefix? "#!" shebang)
 645                             (or (string-contains shebang "/bin/bash")
 646                                 (string-contains shebang "/bin/sh")))))))
 647
 648                (define (wrap? file)
 649                  ;; Do not wrap shell scripts because some are meant to be
 650                  ;; sourced, which breaks if they are wrapped.  We do wrap
 651                  ;; the Haskell executables because some call out to Python
 652                  ;; directly.
 653                  (and (executable-file? file)
 654                       (not (symbolic-link? file))
 655                       (not (shell-script? file))))
 656
 657                (for-each (lambda (file)
 658                            (wrap-program file
 659                              `("PYTHONPATH" ":" prefix (,PYTHONPATH))))
 660                          (filter wrap?
 661                                  (append (find-files (string-append lib "/ganeti"))
 662                                          (find-files sbin))))
 663                #t))))))
 664     (native-inputs
 665      `(("haskell" ,ghc)
 666        ("cabal" ,cabal-install)
 667        ("m4" ,m4)
 668
 669        ;; These inputs are necessary to bootstrap the package, because we
 670        ;; have patched the build system.
 671        ("autoconf" ,autoconf)
 672        ("automake" ,automake)
 673
 674        ;; For the documentation.
 675        ("python-docutils" ,python-docutils)
 676        ("sphinx" ,python-sphinx)
 677        ("pandoc" ,ghc-pandoc)
 678        ("dot" ,graphviz)
 679
 680        ;; Test dependencies.
 681        ("fakeroot" ,fakeroot)
 682        ("ghc-temporary" ,ghc-temporary)
 683        ("ghc-test-framework" ,ghc-test-framework)
 684        ("ghc-test-framework-hunit" ,ghc-test-framework-hunit)
 685        ("ghc-test-framework-quickcheck2" ,ghc-test-framework-quickcheck2)
 686        ("python-mock" ,python-mock)
 687        ("python-pyyaml" ,python-pyyaml)
 688        ("openssh" ,openssh)
 689        ("procps" ,procps)
 690        ("shelltestrunner" ,shelltestrunner)
 691        ("tzdata" ,tzdata-for-tests)))
 692     (inputs
 693      `(("arping" ,iputils)              ;must be the iputils version
 694        ("curl" ,curl)
 695        ("fping" ,fping)
 696        ("iproute2" ,iproute)
 697        ("ndisc6" ,ndisc6)
 698        ("socat" ,socat)
 699        ("qemu" ,qemu-minimal)           ;for qemu-img
 700        ("ghc-attoparsec" ,ghc-attoparsec)
 701        ("ghc-base64-bytestring" ,ghc-base64-bytestring)
 702        ("ghc-cryptonite" ,ghc-cryptonite)
 703        ("ghc-curl" ,ghc-curl)
 704        ("ghc-hinotify" ,ghc-hinotify)
 705        ("ghc-hslogger" ,ghc-hslogger)
 706        ("ghc-json" ,ghc-json)
 707        ("ghc-lens" ,ghc-lens)
 708        ("ghc-lifted-base" ,ghc-lifted-base)
 709        ("ghc-network" ,ghc-network)
 710        ("ghc-old-time" ,ghc-old-time)
 711        ("ghc-psqueue" ,ghc-psqueue)
 712        ("ghc-regex-pcre" ,ghc-regex-pcre)
 713        ("ghc-utf8-string" ,ghc-utf8-string)
 714        ("ghc-zlib" ,ghc-zlib)
 715
 716        ;; For the optional metadata daemon.
 717        ("ghc-snap-core" ,ghc-snap-core)
 718        ("ghc-snap-server" ,ghc-snap-server)
 719
 720        ("python" ,python)
 721        ("python-pyopenssl" ,python-pyopenssl)
 722        ("python-simplejson" ,python-simplejson)
 723        ("python-pyparsing" ,python-pyparsing)
 724        ("python-pyinotify" ,python-pyinotify)
 725        ("python-pycurl" ,python-pycurl)
 726        ("python-bitarray" ,python-bitarray)
 727        ("python-paramiko" ,python-paramiko)
 728        ("python-psutil" ,python-psutil)))
 729     (home-page "http://www.ganeti.org/")
 730     (synopsis "Cluster-based virtual machine management system")
 731     (description
 732      "Ganeti is a virtual machine management tool built on top of existing
 733 virtualization technologies such as Xen or KVM.  Ganeti controls:
 734
 735 @itemize @bullet
 736 @item Disk creation management;
 737 @item Operating system installation for instances (in co-operation with
 738 OS-specific install scripts); and
 739 @item Startup, shutdown, and failover between physical systems.
 740 @end itemize
 741
 742 Ganeti is designed to facilitate cluster management of virtual servers and
 743 to provide fast and simple recovery after physical failures, using
 744 commodity hardware.")
 745     (license license:bsd-2)))
 746
 747 (define-public ganeti-instance-guix
 748   (package
 749     (name "ganeti-instance-guix")
 750     (version "0.6")
 751     (home-page "https://github.com/mbakke/ganeti-instance-guix")
 752     (source (origin
 753               (method git-fetch)
 754               (uri (git-reference (url home-page) (commit version)))
 755               (file-name (git-file-name name version))
 756               (sha256
 757                (base32
 758                 "0aa08irpcpns6mhjgsplc5f0p8ab1qcr9ah1gj5z66kxgqyflzrp"))))
 759     (build-system gnu-build-system)
 760     (arguments
 761      '(#:configure-flags '("--sysconfdir=/etc" "--localstatedir=/var")))
 762     (native-inputs
 763      `(("autoconf" ,autoconf)
 764        ("automake" ,automake)))
 765     (inputs
 766      `(("util-linux" ,util-linux)
 767        ("qemu-img" ,qemu-minimal)))
 768     (synopsis "Guix OS integration for Ganeti")
 769     (description
 770      "This package provides a guest OS definition for Ganeti that uses
 771 Guix to build virtual machines.")
 772     (license license:gpl3+)))
 773
 774 (define-public libosinfo
 775   (package
 776     (name "libosinfo")
 777     (version "1.7.1")
 778     (source
 779      (origin
 780        (method url-fetch)
 781        (uri (string-append "https://releases.pagure.org/libosinfo/libosinfo-"
 782                            version ".tar.xz"))
 783        (sha256
 784         (base32
 785          "1s97sv24bybggjx6hgqba2qdqz3ivfpd4cmkh4zm5y59sim109mv"))))
 786     (build-system meson-build-system)
 787     (arguments
 788      `(#:configure-flags
 789        (list (string-append "-Dwith-usb-ids-path="
 790                             (assoc-ref %build-inputs "usb.ids"))
 791              (string-append "-Dwith-pci-ids-path="
 792                             (assoc-ref %build-inputs "pci.ids")))
 793        #:phases
 794        (modify-phases %standard-phases
 795          (add-after 'unpack 'patch-osinfo-path
 796            (lambda* (#:key inputs #:allow-other-keys)
 797              (substitute* "osinfo/osinfo_loader.c"
 798                (("path = DATA_DIR.*")
 799                 (string-append "path = \"" (assoc-ref inputs "osinfo-db")
 800                                "/share/osinfo\";")))
 801              #t)))))
 802     (inputs
 803      `(("libsoup" ,libsoup)
 804        ("libxml2" ,libxml2)
 805        ("libxslt" ,libxslt)
 806        ("osinfo-db" ,osinfo-db)))
 807     (native-inputs
 808      `(("glib" ,glib "bin")  ; glib-mkenums, etc.
 809        ("gobject-introspection" ,gobject-introspection)
 810        ("gtk-doc" ,gtk-doc)
 811        ("vala" ,vala)
 812        ("intltool" ,intltool)
 813        ("pkg-config" ,pkg-config)
 814        ("pci.ids"
 815         ,(origin
 816            (method url-fetch)
 817            (uri "https://github.com/pciutils/pciids/raw/ad02084f0bc143e3c15e31a6152a3dfb1d7a3156/pci.ids")
 818            (sha256
 819             (base32
 820              "0kfhpj5rnh24hz2714qhfmxk281vwc2w50sm73ggw5d15af7zfsw"))))
 821        ("usb.ids"
 822         ,(origin
 823            (method url-fetch)
 824            (uri "https://svn.code.sf.net/p/linux-usb/repo/trunk/htdocs/usb.ids?r=2681")
 825            (file-name "usb.ids")
 826            (sha256
 827             (base32
 828              "1m6yhvz5k8aqzxgk7xj3jkk8frl1hbv0h3vgj4wbnvnx79qnvz3r"))))))
 829     (home-page "https://libosinfo.org/")
 830     (synopsis "Operating system information database")
 831     (description "libosinfo is a GObject based library API for managing
 832 information about operating systems, hypervisors and the (virtual) hardware
 833 devices they can support.  It includes a database containing device metadata
 834 and provides APIs to match/identify optimal devices for deploying an operating
 835 system on a hypervisor.  Via GObject Introspection, the API is available in
 836 all common programming languages.  Vala bindings are also provided.")
 837     ;; The library files are released under LGPLv2.1 or later; the source
 838     ;; files in the "tools" directory are released under GPLv2+.
 839     (license (list license:lgpl2.1+ license:gpl2+))))
 840
 841 (define-public lxc
 842   (package
 843     (name "lxc")
 844     (version "3.1.0")
 845     (source (origin
 846               (method url-fetch)
 847               (uri (string-append
 848                     "https://linuxcontainers.org/downloads/lxc/lxc-"
 849                     version ".tar.gz"))
 850               (sha256
 851                (base32
 852                 "1igxqgx8q9cp15mcp1y8j564bl85ijw04jcmgb1s5bmfbg1751sd"))))
 853     (build-system gnu-build-system)
 854     (native-inputs
 855      `(("pkg-config" ,pkg-config)))
 856     (inputs
 857      `(("gnutls" ,gnutls)
 858        ("libcap" ,libcap)
 859        ("libseccomp" ,libseccomp)
 860        ("libselinux" ,libselinux)))
 861     (arguments
 862      `(#:configure-flags
 863        (list (string-append "--docdir=" (assoc-ref %outputs "out")
 864                             "/share/doc/" ,name "-" ,version)
 865              "--sysconfdir=/etc"
 866              "--localstatedir=/var")
 867        #:phases
 868        (modify-phases %standard-phases
 869          (replace 'install
 870            (lambda* (#:key outputs #:allow-other-keys)
 871              (let* ((out         (assoc-ref outputs "out"))
 872                     (bashcompdir (string-append out "/etc/bash_completion.d")))
 873                (invoke "make" "install"
 874                        (string-append "bashcompdir=" bashcompdir)
 875                        ;; Don't install files into /var and /etc.
 876                        "LXCPATH=/tmp/var/lib/lxc"
 877                        "localstatedir=/tmp/var"
 878                        "sysconfdir=/tmp/etc"
 879                        "sysconfigdir=/tmp/etc/default")))))))
 880     (synopsis "Linux container tools")
 881     (home-page "https://linuxcontainers.org/")
 882     (description
 883      "LXC is a userspace interface for the Linux kernel containment features.
 884 Through a powerful API and simple tools, it lets Linux users easily create and
 885 manage system or application containers.")
 886     (license license:lgpl2.1+)))
 887
 888 (define-public libvirt
 889   (package
 890     (name "libvirt")
 891     (version "5.8.0")
 892     (source
 893      (origin
 894        (method url-fetch)
 895        (uri (string-append "https://libvirt.org/sources/libvirt-"
 896                            version ".tar.xz"))
 897        (sha256
 898         (base32 "0m8cqaqflvys5kaqpvb0qr4k365j09jc5xk6x70yvg8qkcl2hcz2"))
 899        (patches
 900         (search-patches "libvirt-create-machine-cgroup.patch"))))
 901     (build-system gnu-build-system)
 902     (arguments
 903      `(#:configure-flags
 904        (list "--with-qemu"
 905              "--with-qemu-user=nobody"
 906              "--with-qemu-group=kvm"
 907              "--with-polkit"
 908              (string-append "--docdir=" (assoc-ref %outputs "out") "/share/doc/"
 909                             ,name "-" ,version)
 910              "--sysconfdir=/etc"
 911              "--localstatedir=/var")
 912        #:phases
 913        (modify-phases %standard-phases
 914          (add-before 'configure 'fix-BOURNE_SHELL-definition
 915            ;; BOURNE_SHELL is hard-#defined to ‘/bin/sh’, causing test failures.
 916            (lambda _
 917              (substitute* "config.h.in"
 918                (("/bin/sh") (which "sh")))
 919              #t))
 920          (add-before 'configure 'patch-libtirpc-file-names
 921            (lambda* (#:key inputs #:allow-other-keys)
 922              ;; libvirt uses an m4 macro instead of pkg-config to determine where
 923              ;; the RPC headers are located.  Tell it to look in the right place.
 924              (substitute* "configure"
 925                (("/usr/include/tirpc")  ;defined in m4/virt-xdr.m4
 926                 (string-append (assoc-ref inputs "libtirpc")
 927                                "/include/tirpc")))
 928              #t))
 929          (add-before 'configure 'disable-broken-tests
 930            (lambda _
 931              (let ((tests (list "commandtest"      ; hangs idly
 932                                 "qemuxml2argvtest" ; fails
 933                                 "qemuhotplugtest"  ; fails
 934                                 "virnetsockettest" ; tries to network
 935                                 "virshtest")))     ; fails
 936                (substitute* "tests/Makefile.in"
 937                  (((format #f "(~a)\\$\\(EXEEXT\\)" (string-join tests "|")))
 938                   ""))
 939                #t)))
 940          (replace 'install
 941            ;; Since the sysconfdir and localstatedir should be /etc and /var
 942            ;; at runtime, we must prevent writing to them at installation
 943            ;; time.
 944            (lambda* (#:key make-flags #:allow-other-keys)
 945              (apply invoke "make" "install"
 946                     "sysconfdir=/tmp/etc"
 947                     "localstatedir=/tmp/var"
 948                     make-flags))))))
 949     (inputs
 950      `(("libxml2" ,libxml2)
 951        ("eudev" ,eudev)
 952        ("libpciaccess" ,libpciaccess)
 953        ("gnutls" ,gnutls)
 954        ("dbus" ,dbus)
 955        ("libpcap" ,libpcap)
 956        ("libnl" ,libnl)
 957        ("libtirpc" ,libtirpc)           ;for <rpc/rpc.h>
 958        ("libuuid" ,util-linux "lib")
 959        ("lvm2" ,lvm2)                   ;for libdevmapper
 960        ("curl" ,curl)
 961        ("openssl" ,openssl)
 962        ("cyrus-sasl" ,cyrus-sasl)
 963        ("libyajl" ,libyajl)
 964        ("audit" ,audit)
 965        ("dmidecode" ,dmidecode)
 966        ("dnsmasq" ,dnsmasq)
 967        ("ebtables" ,ebtables)
 968        ("iproute" ,iproute)
 969        ("iptables" ,iptables)))
 970     (native-inputs
 971      `(("xsltproc" ,libxslt)
 972        ("perl" ,perl)
 973        ("pkg-config" ,pkg-config)
 974        ("polkit" ,polkit)
 975        ("python" ,python-wrapper)))
 976     (home-page "https://libvirt.org")
 977     (synopsis "Simple API for virtualization")
 978     (description "Libvirt is a C toolkit to interact with the virtualization
 979 capabilities of recent versions of Linux.  The library aims at providing long
 980 term stable C API initially for the Xen paravirtualization but should be able
 981 to integrate other virtualization mechanisms if needed.")
 982     (license license:lgpl2.1+)))
 983
 984 (define-public libvirt-glib
 985   (package
 986     (name "libvirt-glib")
 987     (version "3.0.0")
 988     (source (origin
 989               (method url-fetch)
 990               (uri (string-append "ftp://libvirt.org/libvirt/glib/"
 991                                   "libvirt-glib-" version ".tar.gz"))
 992               (sha256
 993                (base32
 994                 "1zpbv4ninc57c9rw4zmmkvvqn7154iv1qfr20kyxn8xplalqrzvz"))))
 995     (build-system gnu-build-system)
 996     (inputs
 997      `(("openssl" ,openssl)
 998        ("cyrus-sasl" ,cyrus-sasl)
 999        ("lvm2" ,lvm2)                   ; for libdevmapper
1000        ("libyajl" ,libyajl)))
1001     (native-inputs
1002      `(("pkg-config" ,pkg-config)
1003        ("intltool" ,intltool)
1004        ("glib" ,glib "bin")
1005        ("vala" ,vala)))
1006     (propagated-inputs
1007      ;; ‘Required:’ by the installed .pc files.
1008      `(("glib" ,glib)
1009        ("libvirt" ,libvirt)
1010        ("libxml2" ,libxml2)
1011        ("gobject-introspection" ,gobject-introspection)))
1012     (home-page "https://libvirt.org")
1013     (synopsis "GLib wrapper around libvirt")
1014     (description "libvirt-glib wraps the libvirt library to provide a
1015 high-level object-oriented API better suited for glib-based applications, via
1016 three libraries:
1017
1018 @enumerate
1019 @item libvirt-glib - GLib main loop integration & misc helper APIs
1020 @item libvirt-gconfig - GObjects for manipulating libvirt XML documents
1021 @item libvirt-gobject - GObjects for managing libvirt objects
1022 @end enumerate
1023 ")
1024     (license license:lgpl2.1+)))
1025
1026 (define-public python-libvirt
1027   (package
1028     (name "python-libvirt")
1029     (version "5.8.0")
1030     (source
1031      (origin
1032        (method url-fetch)
1033        (uri (string-append "https://libvirt.org/sources/python/libvirt-python-"
1034                            version ".tar.gz"))
1035        (sha256
1036         (base32 "0kyz3lx49d8p75mvbzinxc1zgs8g7adn77y9bm15b8b4ad9zl5s6"))))
1037     (build-system python-build-system)
1038     (arguments
1039      `(#:phases
1040        (modify-phases %standard-phases
1041          (add-after 'unpack 'patch-nosetests-path
1042            (lambda* (#:key inputs #:allow-other-keys)
1043              (substitute* "setup.py"
1044                (("\"/usr/bin/nosetests\"")
1045                 (string-append "\"" (which "nosetests") "\""))
1046                (("self\\.spawn\\(\\[sys\\.executable, nose\\]\\)")
1047                 (format #f "self.spawn([\"~a\", nose])" (which "bash"))))
1048              #t)))))
1049     (inputs
1050      `(("libvirt" ,libvirt)))
1051     (propagated-inputs
1052      `(("python-lxml" ,python-lxml)))
1053     (native-inputs
1054      `(("pkg-config" ,pkg-config)
1055        ("python-nose" ,python-nose)))
1056     (home-page "https://libvirt.org")
1057     (synopsis "Python bindings to libvirt")
1058     (description "This package provides Python bindings to the libvirt
1059 virtualization library.")
1060     (license license:lgpl2.1+)))
1061
1062 (define-public python2-libvirt
1063   (package-with-python2 python-libvirt))
1064
1065 (define-public virt-manager
1066   (package
1067     (name "virt-manager")
1068     (version "2.2.1")
1069     (source (origin
1070               (method url-fetch)
1071               (uri (string-append "https://virt-manager.org/download/sources"
1072                                   "/virt-manager/virt-manager-"
1073                                   version ".tar.gz"))
1074               (sha256
1075                (base32
1076                 "06ws0agxlip6p6n3n43knsnjyd91gqhh2dadgc33wl9lx1k8vn6g"))))
1077     (build-system python-build-system)
1078     (arguments
1079      `(#:use-setuptools? #f          ; uses custom distutils 'install' command
1080        #:test-target "test_ui"
1081        #:tests? #f                      ; TODO The tests currently fail
1082                                         ; RuntimeError: Loop condition wasn't
1083                                         ; met
1084        #:imported-modules ((guix build glib-or-gtk-build-system)
1085                            ,@%python-build-system-modules)
1086        #:modules ((ice-9 match)
1087                   (srfi srfi-26)
1088                   (guix build python-build-system)
1089                   ((guix build glib-or-gtk-build-system) #:prefix glib-or-gtk:)
1090                   (guix build utils))
1091        #:phases
1092        (modify-phases %standard-phases
1093          (add-after 'unpack 'fix-setup
1094            (lambda* (#:key outputs #:allow-other-keys)
1095              (substitute* "virtinst/buildconfig.py"
1096                (("/usr") (assoc-ref outputs "out")))
1097              #t))
1098          (add-after 'unpack 'fix-qemu-img-reference
1099            (lambda* (#:key inputs #:allow-other-keys)
1100              (substitute* "virtconv/formats.py"
1101                (("/usr(/bin/qemu-img)" _ suffix)
1102                 (string-append (assoc-ref inputs "qemu") suffix)))
1103              #t))
1104          (add-after 'unpack 'fix-default-uri
1105            (lambda* (#:key inputs #:allow-other-keys)
1106              ;; Xen is not available for now - so only patch qemu.
1107              (substitute* "virtManager/createconn.py"
1108                (("/usr(/bin/qemu-system)" _ suffix)
1109                 (string-append (assoc-ref inputs "qemu") suffix)))
1110              #t))
1111          (add-before 'wrap 'wrap-with-GI_TYPELIB_PATH
1112            (lambda* (#:key inputs outputs #:allow-other-keys)
1113              (let* ((bin       (string-append (assoc-ref outputs "out") "/bin"))
1114                     (bin-files (find-files bin ".*"))
1115                     (paths     (map (match-lambda
1116                                       ((output . directory)
1117                                        (let* ((girepodir (string-append
1118                                                           directory
1119                                                           "/lib/girepository-1.0")))
1120                                          (if (file-exists? girepodir)
1121                                              girepodir #f))))
1122                                     inputs)))
1123                (for-each (lambda (file)
1124                            (format #t "wrapping ~a\n" file)
1125                            (wrap-program file
1126                              `("GI_TYPELIB_PATH" ":" prefix
1127                                ,(filter identity paths))))
1128                          bin-files))
1129              #t))
1130          (replace 'check
1131            (lambda* (#:key tests? #:allow-other-keys)
1132              (when tests?
1133                (setenv "HOME" "/tmp")
1134                (system "Xvfb :1 &")
1135                (setenv "DISPLAY" ":1")
1136                ;; Dogtail requires that Assistive Technology support be enabled
1137                (setenv "GTK_MODULES" "gail:atk-bridge")
1138                (invoke "dbus-run-session" "--" "python" "setup.py" "test_ui"))
1139              #t))
1140          (add-after 'install 'glib-or-gtk-compile-schemas
1141            (assoc-ref glib-or-gtk:%standard-phases 'glib-or-gtk-compile-schemas))
1142          (add-after 'install 'glib-or-gtk-wrap
1143            (assoc-ref glib-or-gtk:%standard-phases 'glib-or-gtk-wrap)))))
1144     (inputs
1145      `(("dconf" ,dconf)
1146        ("gtk+" ,gtk+)
1147        ("gtk-vnc" ,gtk-vnc)
1148        ("gtksourceview" ,gtksourceview)
1149        ("libvirt" ,libvirt)
1150        ("libvirt-glib" ,libvirt-glib)
1151        ("libosinfo" ,libosinfo)
1152        ("vte" ,vte)
1153        ("python-libvirt" ,python-libvirt)
1154        ("python-requests" ,python-requests)
1155        ("python-pycairo" ,python-pycairo)
1156        ("python-pygobject" ,python-pygobject)
1157        ("python-libxml2" ,python-libxml2)
1158        ("spice-gtk" ,spice-gtk)))
1159     ;; virt-manager searches for qemu-img or kvm-img in the PATH.
1160     (propagated-inputs
1161      `(("qemu" ,qemu)))
1162     (native-inputs
1163      `(("glib" ,glib "bin")             ; glib-compile-schemas
1164        ("gobject-introspection" ,gobject-introspection)
1165        ("gtk+" ,gtk+ "bin")             ; gtk-update-icon-cache
1166        ("perl" ,perl)                   ; pod2man
1167        ("intltool" ,intltool)
1168        ;; The following are required for running the tests
1169        ;; ("python-dogtail" ,python-dogtail)
1170        ;; ("xvfb" ,xorg-server-for-tests)
1171        ;; ("dbus" ,dbus)
1172        ;; ("at-spi2-core" ,at-spi2-core)
1173        ;; ("gsettings-desktop-schemas" ,gsettings-desktop-schemas)
1174        ))
1175     (home-page "https://virt-manager.org/")
1176     (synopsis "Manage virtual machines")
1177     (description
1178      "The virt-manager application is a desktop user interface for managing
1179 virtual machines through libvirt.  It primarily targets KVM VMs, but also
1180 manages Xen and LXC (Linux containers).  It presents a summary view of running
1181 domains, their live performance and resource utilization statistics.")
1182     (license license:gpl2+)))
1183
1184 (define-public criu
1185   (package
1186     (name "criu")
1187     (version "3.14")
1188     (source (origin
1189               (method url-fetch)
1190               (uri (string-append "https://download.openvz.org/criu/criu-"
1191                                   version ".tar.bz2"))
1192               (sha256
1193                (base32
1194                 "1jrr3v99g18gc0hriz0avq6ccdvyya0j6wwz888sdsc4icc30gzn"))))
1195     (build-system gnu-build-system)
1196     (arguments
1197      `(#:test-target "test"
1198        #:tests? #f ; tests require mounting as root
1199        #:make-flags
1200        (list (string-append "PREFIX=" (assoc-ref %outputs "out"))
1201              (string-append "LIBDIR=" (assoc-ref %outputs "out")
1202                             "/lib")
1203              (string-append "ASCIIDOC=" (assoc-ref %build-inputs "asciidoc")
1204                             "/bin/asciidoc")
1205              (string-append "XMLTO=" (assoc-ref %build-inputs "xmlto")
1206                             "/bin/xmlto"))
1207        #:phases
1208        (modify-phases %standard-phases
1209          (replace 'configure
1210            (lambda* (#:key inputs #:allow-other-keys)
1211              ;; The includes for libnl are located in a sub-directory.
1212              (setenv "C_INCLUDE_PATH"
1213                      (string-append (assoc-ref inputs "libnl")
1214                                     "/include/libnl3:"
1215                                     (or (getenv "C_INCLUDE_PATH") "")))
1216              #t))
1217          (add-after 'configure 'fix-documentation
1218            (lambda* (#:key inputs outputs #:allow-other-keys)
1219              (substitute* "Documentation/Makefile"
1220                (("-m custom.xsl")
1221                 (string-append
1222                  "-m custom.xsl --skip-validation -x "
1223                  (assoc-ref inputs "docbook-xsl") "/xml/xsl/"
1224                  ,(package-name docbook-xsl) "-"
1225                  ,(package-version docbook-xsl)
1226                  "/manpages/docbook.xsl")))
1227              #t))
1228          (add-after 'unpack 'hardcode-variables
1229            (lambda* (#:key inputs #:allow-other-keys)
1230              ;; Hardcode arm version detection
1231              (substitute* "Makefile"
1232                (("ARMV.*:=.*") "ARMV := 7\n"))
1233              ;; We are currently using python-2
1234              (substitute* "crit/Makefile"
1235                (("\\$\\(PYTHON\\)") "python2"))
1236              (substitute* "lib/Makefile"
1237                (("\\$\\(PYTHON\\)")
1238                 (string-append (assoc-ref inputs "python")
1239                                "/bin/python")))
1240              #t))
1241          (add-before 'build 'fix-symlink
1242            (lambda* (#:key inputs #:allow-other-keys)
1243              ;; The file 'images/google/protobuf/descriptor.proto' points to
1244              ;; /usr/include/..., which obviously does not exist.
1245              (let* ((file "google/protobuf/descriptor.proto")
1246                     (target (string-append "images/" file))
1247                     (source (string-append (assoc-ref inputs "protobuf")
1248                                            "/include/" file)))
1249                (delete-file target)
1250                (symlink source target)
1251                #t)))
1252          (add-after 'install 'wrap
1253            (lambda* (#:key inputs outputs #:allow-other-keys)
1254              ;; Make sure 'crit' runs with the correct PYTHONPATH.
1255              (let* ((out (assoc-ref outputs "out"))
1256                     (path (string-append out
1257                                          "/lib/python"
1258                                          (string-take (string-take-right
1259                                                        (assoc-ref inputs "python") 5) 3)
1260                                          "/site-packages:"
1261                                          (getenv "PYTHONPATH"))))
1262                (wrap-program (string-append out "/bin/crit")
1263                  `("PYTHONPATH" ":" prefix (,path))))
1264              #t)))))
1265     (inputs
1266      `(("protobuf" ,protobuf)
1267        ("python" ,python-2)
1268        ("python2-protobuf" ,python2-protobuf)
1269        ("python2-ipaddr" ,python2-ipaddr)
1270        ("iproute" ,iproute)
1271        ("libaio" ,libaio)
1272        ("libcap" ,libcap)
1273        ("libnet" ,libnet)
1274        ("libnl" ,libnl)
1275        ("libbsd" ,libbsd)))
1276     (native-inputs
1277      `(("pkg-config" ,pkg-config)
1278        ("perl" ,perl)
1279        ("protobuf-c" ,protobuf-c)
1280        ("asciidoc" ,asciidoc)
1281        ("xmlto" ,xmlto)
1282        ("docbook-xml" ,docbook-xml)
1283        ("docbook-xsl" ,docbook-xsl)))
1284     (home-page "https://criu.org")
1285     (synopsis "Checkpoint and restore in user space")
1286     (description "Using this tool, you can freeze a running application (or
1287 part of it) and checkpoint it to a hard drive as a collection of files.  You
1288 can then use the files to restore and run the application from the point it
1289 was frozen at.  The distinctive feature of the CRIU project is that it is
1290 mainly implemented in user space.")
1291     ;; The project is licensed under GPLv2; files in the lib/ directory are
1292     ;; LGPLv2.1.
1293     (license (list license:gpl2 license:lgpl2.1))))
1294
1295 (define-public qmpbackup
1296   (package
1297     (name "qmpbackup")
1298     (version "0.2")
1299     (source (origin
1300               (method git-fetch)
1301               (uri (git-reference
1302                      (url "https://github.com/abbbi/qmpbackup")
1303                      (commit version)))
1304               (file-name (git-file-name name version))
1305               (sha256
1306                (base32
1307                 "0swhp5byz44brhyis1a39p11fyn9q84xz5q6v2fah29r7d71kmmx"))))
1308     (build-system python-build-system)
1309     (arguments
1310      `(#:python ,python-2))
1311     (home-page "https://github.com/abbbi/qmpbackup")
1312     (synopsis "Backup and restore QEMU machines")
1313     (description "qmpbackup is designed to create and restore full and
1314 incremental backups of running QEMU virtual machines via QMP, the QEMU
1315 Machine Protocol.")
1316     (license license:gpl3+)))
1317
1318 (define-public looking-glass-client
1319   (let ((commit "182c4752d57690da7f99d5e788de9b8baea33895"))
1320     (package
1321      (name "looking-glass-client")
1322      (version (string-append "a12-" (string-take commit 7)))
1323      (source
1324       (origin
1325        (method git-fetch)
1326        (uri (git-reference (url "https://github.com/gnif/LookingGlass")
1327                            (commit commit)))
1328        (file-name (git-file-name name version))
1329        (sha256
1330         (base32
1331          "02bq46ndmzq9cihazzn7xq1x7q5nzm7iw4l9lqzihxcxp9famkhw"))
1332        (modules '((guix build utils)))
1333        (snippet
1334         '(begin
1335            ;; Do not create binaries optimized for the CPU of the build machine,
1336            ;; for reproducibility and compatibility.  TODO: in the next version
1337            ;; of looking glass, this is exposed as a CMake configure option.
1338            (substitute* "client/CMakeLists.txt"
1339              (("-march=native")
1340               ""))
1341            #t))))
1342      (build-system cmake-build-system)
1343      (inputs `(("fontconfig" ,fontconfig)
1344                ("glu" ,glu)
1345                ("mesa" ,mesa)
1346                ("openssl" ,openssl)
1347                ("sdl2" ,sdl2)
1348                ("sdl2-ttf" ,sdl2-ttf)
1349                ("spice-protocol" ,spice-protocol)
1350                ("wayland" ,wayland)))
1351      (native-inputs `(("libconfig" ,libconfig)
1352                       ("nettle" ,nettle)
1353                       ("pkg-config" ,pkg-config)))
1354      (arguments
1355       `(#:tests? #f ;; No tests are available.
1356         #:make-flags '("CC=gcc")
1357         #:phases (modify-phases %standard-phases
1358                    (add-before 'configure 'chdir-to-client
1359                      (lambda* (#:key outputs #:allow-other-keys)
1360                        (chdir "client")
1361                        #t))
1362                    (add-after 'chdir-to-client 'add-missing-include
1363                      (lambda _
1364                        ;; Mimic upstream commit b9797529893, required since the
1365                        ;; update to Mesa 19.2.
1366                        (substitute* "renderers/egl/shader.h"
1367                          (("#include <stdbool\\.h>")
1368                           "#include <stdbool.h>\n#include <stddef.h>"))
1369                        #t))
1370                    (replace 'install
1371                      (lambda* (#:key outputs #:allow-other-keys)
1372                        (install-file "looking-glass-client"
1373                                      (string-append (assoc-ref outputs "out")
1374                                                     "/bin"))
1375                        #t)))))
1376      (home-page "https://looking-glass.hostfission.com")
1377      (synopsis "KVM Frame Relay (KVMFR) implementation")
1378      (description "Looking Glass allows the use of a KVM (Kernel-based Virtual
1379 Machine) configured for VGA PCI Pass-through without an attached physical
1380 monitor, keyboard or mouse.  It displays the VM's rendered contents on your main
1381 monitor/GPU.")
1382      ;; This package requires SSE instructions.
1383      (supported-systems '("i686-linux" "x86_64-linux"))
1384      (license license:gpl2+))))
1385
1386 (define-public runc
1387   (package
1388     (name "runc")
1389     (version "1.0.0-rc6")
1390     (source (origin
1391               (method url-fetch)
1392               (uri (string-append
1393                     "https://github.com/opencontainers/runc/releases/"
1394                     "download/v" version "/runc.tar.xz"))
1395               (file-name (string-append name "-" version ".tar.xz"))
1396               (patches (search-patches "runc-CVE-2019-5736.patch"))
1397               (sha256
1398                (base32
1399                 "1c7832dq70slkjh8qp2civ1wxhhdd2hrx84pq7db1mmqc9fdr3cc"))))
1400     (build-system go-build-system)
1401     (arguments
1402      '(#:import-path "github.com/opencontainers/runc"
1403        #:install-source? #f
1404        ;; XXX: 20/139 tests fail due to missing /var, cgroups and apparmor in
1405        ;; the build environment.
1406        #:tests? #f
1407        #:phases
1408        (modify-phases %standard-phases
1409          (replace 'unpack
1410            (lambda* (#:key source import-path #:allow-other-keys)
1411              ;; Unpack the tarball into 'runc' instead of 'runc-1.0.0-rc5'.
1412              (let ((dest (string-append "src/" import-path)))
1413                (mkdir-p dest)
1414                (invoke "tar" "-C" (string-append "src/" import-path)
1415                        "--strip-components=1"
1416                        "-xvf" source))))
1417          (replace 'build
1418            (lambda* (#:key import-path #:allow-other-keys)
1419              (chdir (string-append "src/" import-path))
1420              ;; XXX: requires 'go-md2man'.
1421              ;; (invoke "make" "man")
1422              (invoke "make")))
1423          ;; (replace 'check
1424          ;;   (lambda _
1425          ;;     (invoke "make" "localunittest")))
1426          (replace 'install
1427            (lambda* (#:key outputs #:allow-other-keys)
1428              (let ((out (assoc-ref outputs "out")))
1429               (invoke "make" "install" "install-bash"
1430                       (string-append "PREFIX=" out))))))))
1431     (native-inputs
1432      `(("pkg-config" ,pkg-config)))
1433     (inputs
1434      `(("libseccomp" ,libseccomp)))
1435     (synopsis "Open container initiative runtime")
1436     (home-page "https://www.opencontainers.org/")
1437     (description
1438      "@command{runc} is a command line client for running applications
1439 packaged according to the
1440 @uref{https://github.com/opencontainers/runtime-spec/blob/master/spec.md, Open
1441 Container Initiative (OCI) format} and is a compliant implementation of the
1442 Open Container Initiative specification.")
1443     (license license:asl2.0)))
1444
1445 (define-public umoci
1446   (package
1447     (name "umoci")
1448     (version "0.4.6")
1449     (source
1450      (origin
1451        (method url-fetch)
1452        (uri (string-append
1453              "https://github.com/opencontainers/umoci/releases/download/v"
1454              version "/umoci.tar.xz"))
1455        (file-name (string-append "umoci-" version ".tar.xz"))
1456        (sha256
1457         (base32 "06q7xfwnqysc013hapx31jhlzmyg8qb467qfkynj673qc7p9bd6h"))))
1458     (build-system go-build-system)
1459     (arguments
1460      '(#:import-path "github.com/opencontainers/umoci"
1461        #:install-source? #f
1462        #:phases
1463        (modify-phases %standard-phases
1464          (replace 'unpack
1465            (lambda* (#:key source import-path #:allow-other-keys)
1466              ;; Unpack the tarball into 'umoci' instead of "runc-${version}".
1467              (let ((dest (string-append "src/" import-path)))
1468                (mkdir-p dest)
1469                (invoke "tar" "-C" (string-append "src/" import-path)
1470                        "--strip-components=1"
1471                        "-xvf" source))))
1472          (replace 'build
1473            (lambda* (#:key import-path #:allow-other-keys)
1474              (chdir (string-append "src/" import-path))
1475              ;; TODO: build manpages with 'go-md2man'.
1476              (invoke "make" "SHELL=bash")))
1477          (replace 'install
1478            (lambda* (#:key outputs #:allow-other-keys)
1479              (let* ((out (assoc-ref outputs "out"))
1480                     (bindir (string-append out "/bin")))
1481                (install-file "umoci" bindir)
1482                #t))))))
1483     (home-page "https://umo.ci/")
1484     (synopsis "Tool for modifying Open Container images")
1485     (description
1486      "@command{umoci} is a tool that allows for high-level modification of an
1487 Open Container Initiative (OCI) image layout and its tagged images.")
1488     (license license:asl2.0)))
1489
1490 (define-public skopeo
1491   (package
1492     (name "skopeo")
1493     (version "0.1.40")
1494     (source (origin
1495               (method git-fetch)
1496               (uri (git-reference
1497                     (url "https://github.com/projectatomic/skopeo")
1498                     (commit (string-append "v" version))))
1499               (file-name (git-file-name name version))
1500               (sha256
1501                (base32
1502                 "1bagirzdzjhicn5dr691092ac3q6lhz3xngjzgqiqkxnvpz7p6cn"))))
1503     (build-system go-build-system)
1504     (native-inputs
1505      `(("pkg-config" ,pkg-config)))
1506     (inputs
1507      `(("btrfs-progs" ,btrfs-progs)
1508        ("eudev" ,eudev)
1509        ("libassuan" ,libassuan)
1510        ("libselinux" ,libselinux)
1511        ("libostree" ,libostree)
1512        ("lvm2" ,lvm2)
1513        ("glib" ,glib)
1514        ("gpgme" ,gpgme)))
1515     (arguments
1516      '(#:import-path "github.com/projectatomic/skopeo"
1517        #:install-source? #f
1518        #:tests? #f ; The tests require Docker
1519        #:phases
1520        (modify-phases %standard-phases
1521          (replace 'build
1522            (lambda* (#:key import-path #:allow-other-keys)
1523              (chdir (string-append "src/" import-path))
1524              ;; TODO: build manpages with 'go-md2man'.
1525              (invoke "make" "binary-local")))
1526          (replace 'install
1527            (lambda* (#:key outputs #:allow-other-keys)
1528              (let ((out (assoc-ref outputs "out")))
1529                (invoke "make" "install-binary" "install-completions"
1530                        (string-append "PREFIX=" out))))))))
1531     (home-page "https://github.com/projectatomic/skopeo")
1532     (synopsis "Interact with container images and container image registries")
1533     (description
1534      "@command{skopeo} is a command line utility providing various operations
1535 with container images and container image registries.  It can:
1536 @enumerate
1537
1538 @item Copy container images between various containers image stores,
1539 converting them as necessary.
1540
1541 @item Convert a Docker schema 2 or schema 1 container image to an OCI image.
1542
1543 @item Inspect a repository on a container registry without needlessly pulling
1544 the image.
1545
1546 @item Sign and verify container images.
1547
1548 @item Delete container images from a remote container registry.
1549
1550 @end enumerate")
1551     (license license:asl2.0)))
1552
1553 (define-public python-vagrant
1554   (package
1555     (name "python-vagrant")
1556     (version "0.5.15")
1557     (source
1558       (origin
1559         (method url-fetch)
1560         (uri (pypi-uri "python-vagrant" version))
1561         (sha256
1562          (base32
1563           "1ikrh6canhcxg5y7pzmkcnnydikppv7s6sm9prfx90nk0ac8m6mg"))))
1564     (build-system python-build-system)
1565     (arguments
1566      '(#:tests? #f)) ; tests involve running vagrant.
1567     (home-page "https://github.com/todddeluca/python-vagrant")
1568     (synopsis "Python bindings for Vagrant")
1569     (description
1570      "Python-vagrant is a Python module that provides a thin wrapper around the
1571 @code{vagrant} command line executable, allowing programmatic control of Vagrant
1572 virtual machines.")
1573     (license license:expat)))
1574
1575 (define-public bubblewrap
1576   (package
1577     (name "bubblewrap")
1578     (version "0.4.1")
1579     (source (origin
1580               (method url-fetch)
1581               (uri (string-append "https://github.com/containers/bubblewrap/"
1582                                   "releases/download/v" version "/bubblewrap-"
1583                                   version ".tar.xz"))
1584               (sha256
1585                (base32
1586                 "00ycgi6q2yngh06bnz50wkvar6r2jnjf3j158grhi9k13jdrpimr"))))
1587     (build-system gnu-build-system)
1588     (arguments
1589      `(#:phases
1590        (modify-phases %standard-phases
1591          (add-after 'unpack 'fix-test
1592            (lambda* (#:key outputs #:allow-other-keys)
1593              ;; Tests try to access /var/tmp, which is not possible in our build
1594              ;; environment.  Let's give them another directory.
1595              ;; /tmp gets overriden in some tests, so we need another directory.
1596              ;; the only possibility is the output directory.
1597              (let ((tmp-dir (string-append (assoc-ref outputs "out") "/tmp")))
1598                (mkdir-p tmp-dir)
1599                (substitute* "tests/test-run.sh"
1600                  (("/var/tmp") tmp-dir)
1601                  ;; Tests create a temporary python script, so fix its shebang.
1602                  (("/usr/bin/env python") (which "python"))
1603                  ;; Some tests try to access /usr, but that doesn't exist.
1604                  ;; Give them /gnu instead.
1605                  (("/usr") "/gnu")
1606                  (("--ro-bind /bin /bin") "--ro-bind /gnu /bin")
1607                  (("--ro-bind /sbin /sbin") "--ro-bind /gnu /sbin")
1608                  (("--ro-bind /lib /lib") "--ro-bind /gnu /lib")
1609                  (("  */bin/bash") (which "bash"))
1610                  (("/bin/sh") (which "sh"))
1611                  (("findmnt") (which "findmnt"))))
1612              #t))
1613          ;; Remove the directory we gave to tests to have a clean package.
1614          (add-after 'check 'remove-tmp-dir
1615            (lambda* (#:key outputs #:allow-other-keys)
1616              (delete-file-recursively (string-append (assoc-ref outputs "out") "/tmp"))
1617              #t)))))
1618     (inputs
1619      `(("libcap" ,libcap)))
1620     (native-inputs
1621      `(("python-2" ,python-2)
1622        ("util-linux" ,util-linux)))
1623     (home-page "https://github.com/containers/bubblewrap")
1624     (synopsis "Unprivileged sandboxing tool")
1625     (description "Bubblewrap is aimed at running applications in a sandbox,
1626 restricting their access to parts of the operating system or user data such as
1627 the home directory.  Bubblewrap always creates a new mount namespace, and the
1628 user can specify exactly what parts of the file system should be made visible
1629 in the sandbox.  These directories are mounted with the @code{nodev} option
1630 by default and can be made read-only.")
1631     (license license:lgpl2.0+)))
1632
1633 (define-public bochs
1634   (package
1635     (name "bochs")
1636     (version "2.6.11")
1637     (source
1638      (origin
1639        (method url-fetch)
1640        (uri (string-append "https://sourceforge.net/projects/bochs/files/bochs/"
1641                            version "/bochs-" version ".tar.gz"))
1642        (sha256
1643         (base32 "0ql8q6y1k356li1g9gbvl21448mlxphxxi6kjb2b3pxvzd0pp2b3"))))
1644     (build-system gnu-build-system)
1645     (arguments
1646      `(#:tests? #f))                    ; no tests exist
1647     (inputs
1648      `(("libxrandr" ,libxrandr)))
1649     (home-page "http://bochs.sourceforge.net/")
1650     (synopsis "Emulator for x86 PC")
1651     (description
1652      "Bochs is an emulator which can emulate Intel x86 CPU, common I/O
1653 devices, and a custom BIOS.  It can also be compiled to emulate many different
1654 x86 CPUs, from early 386 to the most recent x86-64 Intel and AMD processors.
1655 Bochs can run most Operating Systems inside the emulation including Linux,
1656 DOS or Microsoft Windows.")
1657     (license license:lgpl2.0+)))
1658
1659 (define-public xen
1660   (package
1661     (name "xen")
1662     (version "4.13.0")
1663     (source (origin
1664               (method git-fetch)
1665               (uri (git-reference
1666                     (url "git://xenbits.xenproject.org/xen.git")
1667                     (commit (string-append "RELEASE-" version))))
1668               (file-name (git-file-name name version))
1669               (sha256
1670                (base32
1671                 "0py50n995gv909i0d1lfdcj9wcp5g1d5z6m2291jqqlfyany138g"))))
1672     (build-system gnu-build-system)
1673     (arguments
1674      `(#:configure-flags
1675        (list "--enable-rpath"
1676              "--disable-qemu-traditional" ; It tries to do "git clone"
1677              "--disable-rombios" ; would try to "git clone" via etherboot.
1678              ;; TODO: Re-enable stubdom (it's "more secure" to use it).
1679              "--disable-stubdom" ; tries to "git clone" old patched newlib.
1680              (string-append "--with-initddir="
1681                             (assoc-ref %outputs "out")
1682                             "/etc/init.d")
1683              (string-append "--with-system-qemu="
1684                             (assoc-ref %build-inputs "qemu")
1685                             "/bin/qemu-system-i386")
1686              (string-append "--with-system-seabios="
1687                             (assoc-ref %build-inputs "seabios")
1688                             "/share/firmware/bios.bin")
1689              (string-append "--with-system-ovmf="
1690                             (assoc-ref %build-inputs "ovmf")
1691                             "/share/firmware/ovmf_ia32.bin"))
1692        #:make-flags (list "-j" "1"
1693                           "XEN_BUILD_DATE=Thu Jan  1 01:00:01 CET 1970"
1694                           "XEN_BUILD_TIME=01:00:01"
1695                           "XEN_BUILD_HOST="
1696                           "ETHERBOOT_NICS="
1697                           "SMBIOS_REL_DATE=01/01/1970"
1698                           "VGABIOS_REL_DATE=01 Jan 1970"
1699                           ; QEMU_TRADITIONAL_LOC
1700                           ; QEMU_UPSTREAM_LOC
1701                           "SYSCONFIG_DIR=/tmp/etc/default"
1702                           (string-append "BASH_COMPLETION_DIR="
1703                                          (assoc-ref %outputs "out")
1704                                          "/etc/bash_completion.d")
1705                           (string-append "BOOT_DIR="
1706                                          (assoc-ref %outputs "out")
1707                                          "/boot")
1708                           (string-append "DEBUG_DIR="
1709                                          (assoc-ref %outputs "out")
1710                                          "/lib/debug")
1711                           (string-append "EFI_DIR="
1712                                          (assoc-ref %outputs "out")
1713                                          "/lib/efi") ; TODO lib64 ?
1714                           "MINIOS_UPSTREAM_URL="
1715                           ;(string-append "DISTDIR="
1716                           ;               (assoc-ref %outputs "out"))
1717 )
1718        #:test-target "test"
1719        #:phases
1720        (modify-phases %standard-phases
1721         (add-after 'unpack 'unpack-mini-os
1722           (lambda* (#:key inputs #:allow-other-keys)
1723             (copy-recursively (assoc-ref inputs "mini-os") "extras/mini-os")
1724             #t))
1725         (add-after 'unpack-mini-os 'patch
1726           (lambda* (#:key inputs outputs #:allow-other-keys)
1727             (substitute* "tools/firmware/Rules.mk"
1728              (("override XEN_TARGET_ARCH = x86_32")
1729               (string-append "override XEN_TARGET_ARCH = x86_32
1730 override CC = " (assoc-ref inputs "cross-gcc") "/bin/i686-linux-gnu-gcc"))
1731              (("^CFLAGS =$")
1732               (string-append "CFLAGS=-I" (assoc-ref inputs "cross-libc")
1733                              "/include\n")))
1734             (substitute* "config/x86_32.mk"
1735              (("CFLAGS += -m32 -march=i686")
1736               (string-append "CFLAGS += -march=i686 -I"
1737                              (assoc-ref inputs "cross-libc")
1738                              "/include")))
1739             ;; /var is not in /gnu/store , so don't try to create it.
1740             (substitute* '("tools/Makefile"
1741                            "tools/xenstore/Makefile"
1742                            "tools/xenpaging/Makefile")
1743              (("\\$\\(INSTALL_DIR\\) .*XEN_(DUMP|LOG|RUN|LIB|PAGING)_DIR.*")
1744               "\n")
1745              (("\\$\\(INSTALL_DIR\\) .*XEN_(RUN|LIB)_STORED.*")
1746               "\n"))
1747             ;; Prevent xen from creating /etc .
1748             (substitute* "tools/examples/Makefile"
1749              ((" install-readmes") "")
1750              ((" install-configs") ""))
1751             ;; Set rpath.
1752             (substitute* "tools/pygrub/setup.py"
1753              (("library_dirs =")
1754               ; TODO: extra_link_args = ['-Wl,-rpath=/opt/foo'],
1755               (string-append "runtime_library_dirs = ['"
1756                              (assoc-ref outputs "out")
1757                              "/lib'],\nlibrary_dirs =")))
1758             #t))
1759         (add-before 'configure 'patch-xen-script-directory
1760           (lambda* (#:key outputs #:allow-other-keys)
1761             (substitute* '("configure"
1762                            "tools/configure"
1763                            "docs/configure")
1764              (("XEN_SCRIPT_DIR=.*")
1765               (string-append "XEN_SCRIPT_DIR="
1766                              (assoc-ref outputs "out")
1767                              "/etc/xen/scripts")))
1768             #t))
1769         (add-before 'configure 'set-environment-up
1770           (lambda* (#:key make-flags #:allow-other-keys)
1771              (define (cross? x)
1772                (string-contains x "cross-i686-linux"))
1773              (define (filter-environment! filter-predicate
1774                                           environment-variable-names)
1775                (for-each
1776                 (lambda (env-name)
1777                   (let* ((env-value (getenv env-name))
1778                          (search-path (search-path-as-string->list env-value))
1779                          (new-search-path (filter filter-predicate
1780                                                   search-path))
1781                          (new-env-value (list->search-path-as-string
1782                                          new-search-path ":")))
1783                     (setenv env-name new-env-value)))
1784                 environment-variable-names))
1785              (setenv "CROSS_CPATH" (getenv "CPATH"))
1786              (setenv "CROSS_LIBRARY_PATH" (getenv "LIBRARY_PATH"))
1787              (filter-environment! cross?
1788               '("CROSS_CPATH"
1789                 "CROSS_LIBRARY_PATH"))
1790              (filter-environment! (lambda (e) (not (cross? e)))
1791               '("CPATH"
1792                 "LIBRARY_PATH"))
1793              ;; Guix tries to be helpful and automatically adds
1794              ;; mini-os-git-checkout/include to the include path,
1795              ;; but actually we don't want it to be there (yet).
1796              (filter-environment! (lambda (e)
1797                                     (not
1798                                      (string-contains e
1799                                       "mini-os-git-checkout")))
1800               '("CPATH"
1801                 "LIBRARY_PATH"))
1802             (setenv "EFI_VENDOR" "guix")
1803              #t))
1804         (replace 'build
1805           (lambda* (#:key make-flags #:allow-other-keys)
1806             (apply invoke "make" "world" make-flags))))))
1807     (inputs
1808      `(("acpica" ,acpica) ; TODO: patch iasl invocation.
1809        ("bridge-utils" ,bridge-utils) ; TODO: patch invocations.
1810        ("glib" ,glib)
1811        ("iproute" ,iproute) ; TODO: patch invocations.
1812        ("libaio" ,libaio)
1813        ("libx11" ,libx11)
1814        ("libyajl" ,libyajl)
1815        ("ncurses" ,ncurses)
1816        ("openssl" ,openssl)
1817        ("ovmf" ,ovmf)
1818        ("pixman" ,pixman)
1819        ("qemu" ,qemu-minimal)
1820        ("seabios" ,seabios)
1821        ("util-linux" ,util-linux "lib") ; uuid
1822        ; TODO: ocaml-findlib, ocaml-nox.
1823        ("xz" ,xz) ; for liblzma
1824        ("zlib" ,zlib)))
1825     (native-inputs
1826      `(("dev86" ,dev86)
1827        ("bison" ,bison)
1828        ("cmake" ,cmake-minimal)
1829        ("figlet" ,figlet)
1830        ("flex" ,flex)
1831        ("gettext" ,gettext-minimal)
1832        ("libnl" ,libnl)
1833        ("mini-os"
1834        ,(origin
1835          (method git-fetch)
1836          (uri (git-reference
1837                (url "http://xenbits.xen.org/git-http/mini-os.git")
1838                (commit (string-append "xen-RELEASE-" version))))
1839          (sha256
1840           (base32
1841            "1i8pcl19n60i2m9vlg79q3nknpj209c9ic5x10wxaicx45kc107f"))
1842          (file-name "mini-os-git-checkout")))
1843        ("perl" ,perl)
1844        ; TODO: markdown
1845        ("pkg-config" ,pkg-config)
1846        ("python" ,python-2)
1847        ("wget" ,wget)
1848        ("cross-gcc" ,(cross-gcc "i686-linux-gnu"
1849                                 #:xbinutils (cross-binutils "i686-linux-gnu")
1850                                 #:libc (cross-libc "i686-linux-gnu")))
1851        ("cross-libc" ,(cross-libc "i686-linux-gnu")) ; header files
1852        ("cross-libc-static" ,(cross-libc "i686-linux-gnu") "static")))
1853     (home-page "https://xenproject.org/")
1854     (synopsis "Xen Virtual Machine Monitor")
1855     (description "This package provides the Xen Virtual Machine Monitor
1856 which is a hypervisor.")
1857     ;; TODO: Some files are licensed differently.  List those.
1858     (license license:gpl2)
1859     (supported-systems '("i686-linux" "x86_64-linux" "armhf-linux"))))
1860
1861 (define-public osinfo-db-tools
1862   (package
1863     (name "osinfo-db-tools")
1864     (version "1.8.0")
1865     (source (origin
1866               (method url-fetch)
1867               (uri (string-append "https://releases.pagure.org/libosinfo/osinfo-db-tools-"
1868                                   version ".tar.xz"))
1869
1870               (sha256
1871                (base32
1872                 "038q3gzdbkfkhpicj0755mw1q4gbvn57pslpw8n2dp3lds9im0g9"))))
1873     (build-system meson-build-system)
1874     (inputs
1875      `(("libsoup" ,libsoup)
1876        ("libxml2" ,libxml2)
1877        ("libxslt" ,libxslt)
1878        ("json-glib" ,json-glib)
1879        ("libarchive" ,libarchive)))
1880     (native-inputs
1881      `(("perl" ,perl)
1882        ("gobject-introspection" ,gobject-introspection)
1883        ("gettext" ,gettext-minimal)
1884        ("pkg-config" ,pkg-config)
1885        ;; Tests
1886        ("python" ,python)
1887        ("pytest" ,python-pytest)
1888        ("requests" ,python-requests)))
1889     (home-page "https://gitlab.com/libosinfo/osinfo-db-tools")
1890     (synopsis "Tools for managing the osinfo database")
1891     (description "This package contains a set of tools to assist
1892 administrators and developers in managing the database.")
1893     (license license:lgpl2.0+)))
1894
1895 (define-public osinfo-db
1896   (package
1897     (name "osinfo-db")
1898     (version "20200529")
1899     (source (origin
1900               (method url-fetch)
1901               (uri (string-append "https://releases.pagure.org/libosinfo/osinfo-db-"
1902                                   version ".tar.xz"))
1903               (sha256
1904                (base32
1905                 "0mbrf9j5wmjhc6jixvhp4jqyxixh1717lqrmzmipdg99xnzba81n"))))
1906     (build-system trivial-build-system)
1907     (arguments
1908      `(#:modules ((guix build utils))
1909        #:builder
1910        (begin
1911          (use-modules (guix build utils))
1912          (let* ((out (assoc-ref %outputs "out"))
1913                 (osinfo-dir (string-append out "/share/osinfo"))
1914                 (source (assoc-ref %build-inputs "source"))
1915                 (osinfo-db-import
1916                  (string-append (assoc-ref %build-inputs "osinfo-db-tools")
1917                                 "/bin/osinfo-db-import")))
1918            (mkdir-p osinfo-dir)
1919            (invoke osinfo-db-import "--dir" osinfo-dir source)
1920            #t))))
1921     (native-inputs
1922      `(("intltool" ,intltool)
1923        ("osinfo-db-tools" ,osinfo-db-tools)))
1924     (home-page "https://gitlab.com/libosinfo/osinfo-db")
1925     (synopsis "Database of information about operating systems")
1926     (description "Osinfo-db provides the database files for use with the
1927 libosinfo library.  It provides information about guest operating systems for
1928 use with virtualization provisioning tools")
1929     (license license:lgpl2.0+)))