gnu/packages/virtualization.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2015, 2016, 2017, 2018 Mark H Weaver <mhw@netris.org>
   4 ;;; Copyright © 2016, 2017, 2018. 2019 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 ;;;
  17 ;;; This file is part of GNU Guix.
  18 ;;;
  19 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  20 ;;; under the terms of the GNU General Public License as published by
  21 ;;; the Free Software Foundation; either version 3 of the License, or (at
  22 ;;; your option) any later version.
  23 ;;;
  24 ;;; GNU Guix is distributed in the hope that it will be useful, but
  25 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  26 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  27 ;;; GNU General Public License for more details.
  28 ;;;
  29 ;;; You should have received a copy of the GNU General Public License
  30 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  31
  32 (define-module (gnu packages virtualization)
  33   #:use-module (gnu packages)
  34   #:use-module (gnu packages admin)
  35   #:use-module (gnu packages assembly)
  36   #:use-module (gnu packages attr)
  37   #:use-module (gnu packages autotools)
  38   #:use-module (gnu packages backup)
  39   #:use-module (gnu packages bison)
  40   #:use-module (gnu packages check)
  41   #:use-module (gnu packages cmake)
  42   #:use-module (gnu packages compression)
  43   #:use-module (gnu packages cross-base)
  44   #:use-module (gnu packages curl)
  45   #:use-module (gnu packages cyrus-sasl)
  46   #:use-module (gnu packages disk)
  47   #:use-module (gnu packages dns)
  48   #:use-module (gnu packages docbook)
  49   #:use-module (gnu packages documentation)
  50   #:use-module (gnu packages figlet)
  51   #:use-module (gnu packages firmware)
  52   #:use-module (gnu packages flex)
  53   #:use-module (gnu packages fontutils)
  54   #:use-module (gnu packages freedesktop)
  55   #:use-module (gnu packages gettext)
  56   #:use-module (gnu packages gl)
  57   #:use-module (gnu packages glib)
  58   #:use-module (gnu packages gnome)
  59   #:use-module (gnu packages gnupg)
  60   #:use-module (gnu packages golang)
  61   #:use-module (gnu packages gtk)
  62   #:use-module (gnu packages image)
  63   #:use-module (gnu packages libbsd)
  64   #:use-module (gnu packages libusb)
  65   #:use-module (gnu packages linux)
  66   #:use-module (gnu packages ncurses)
  67   #:use-module (gnu packages nettle)
  68   #:use-module (gnu packages networking)
  69   #:use-module (gnu packages onc-rpc)
  70   #:use-module (gnu packages package-management)
  71   #:use-module (gnu packages perl)
  72   #:use-module (gnu packages pkg-config)
  73   #:use-module (gnu packages polkit)
  74   #:use-module (gnu packages protobuf)
  75   #:use-module (gnu packages python)
  76   #:use-module (gnu packages python-web)
  77   #:use-module (gnu packages python-xyz)
  78   #:use-module (gnu packages pulseaudio)
  79   #:use-module (gnu packages selinux)
  80   #:use-module (gnu packages sdl)
  81   #:use-module (gnu packages sphinx)
  82   #:use-module (gnu packages spice)
  83   #:use-module (gnu packages texinfo)
  84   #:use-module (gnu packages textutils)
  85   #:use-module (gnu packages tls)
  86   #:use-module (gnu packages web)
  87   #:use-module (gnu packages wget)
  88   #:use-module (gnu packages xdisorg)
  89   #:use-module (gnu packages xml)
  90   #:use-module (gnu packages xorg)
  91   #:use-module (guix build-system cmake)
  92   #:use-module (guix build-system gnu)
  93   #:use-module (guix build-system go)
  94   #:use-module (guix build-system meson)
  95   #:use-module (guix build-system python)
  96   #:use-module (guix build-system trivial)
  97   #:use-module (guix download)
  98   #:use-module (guix git-download)
  99   #:use-module ((guix licenses) #:prefix license:)
 100   #:use-module (guix packages)
 101   #:use-module (guix utils)
 102   #:use-module (srfi srfi-1))
 103
 104 (define (qemu-patch commit file-name sha256)
 105   "Return an origin for COMMIT."
 106   (origin
 107     (method url-fetch)
 108     (uri (string-append
 109           "http://git.qemu.org/?p=qemu.git;a=commitdiff_plain;h="
 110           commit))
 111     (sha256 sha256)
 112     (file-name file-name)))
 113
 114 (define-public qemu
 115   (package
 116     (name "qemu")
 117     (version "4.2.0")
 118     (source (origin
 119              (method url-fetch)
 120              (uri (string-append "https://download.qemu.org/qemu-"
 121                                  version ".tar.xz"))
 122              (patches (search-patches "qemu-CVE-2020-1711.patch"
 123                                       "qemu-CVE-2020-7039.patch"
 124                                       "qemu-CVE-2020-7211.patch"
 125                                       "qemu-CVE-2020-8608.patch"
 126                                       "qemu-fix-documentation-build-failure.patch"))
 127              (sha256
 128               (base32
 129                "1w38hzlw7xp05gcq1nhga7hxvndxy6dfcnzi7q2il8ff110isj6k"))))
 130     (build-system gnu-build-system)
 131     (arguments
 132      '(;; Running tests in parallel can occasionally lead to failures, like:
 133        ;; boot_sector_test: assertion failed (signature == SIGNATURE): (0x00000000 == 0x0000dead)
 134        #:parallel-tests? #f
 135        #:configure-flags (list "--enable-usb-redir" "--enable-opengl"
 136                                "--enable-docs"
 137                                (string-append "--smbd="
 138                                               (assoc-ref %outputs "out")
 139                                               "/libexec/samba-wrapper")
 140                                "--audio-drv-list=alsa,pa,sdl")
 141        ;; Make build and test output verbose to facilitate investigation upon failure.
 142        #:make-flags '("V=1")
 143        #:phases
 144        (modify-phases %standard-phases
 145          (replace 'configure
 146            (lambda* (#:key inputs outputs (configure-flags '())
 147                            #:allow-other-keys)
 148              ;; The `configure' script doesn't understand some of the
 149              ;; GNU options.  Thus, add a new phase that's compatible.
 150              (let ((out (assoc-ref outputs "out")))
 151                (setenv "SHELL" (which "bash"))
 152
 153                ;; While we're at it, patch for tests.
 154                (substitute* "tests/libqtest.c"
 155                  (("/bin/sh") (which "sh")))
 156
 157                ;; The binaries need to be linked against -lrt.
 158                (setenv "LDFLAGS" "-lrt")
 159                (apply invoke
 160                       `("./configure"
 161                         ,(string-append "--cc=" (which "gcc"))
 162                         ;; Some architectures insist on using HOST_CC
 163                         ,(string-append "--host-cc=" (which "gcc"))
 164                         "--disable-debug-info" ; save build space
 165                         "--enable-virtfs"      ; just to be sure
 166                         ,(string-append "--prefix=" out)
 167                         ,(string-append "--sysconfdir=/etc")
 168                         ,@configure-flags)))))
 169          (add-after 'install 'install-info
 170            (lambda* (#:key inputs outputs #:allow-other-keys)
 171              ;; Install the Info manual, unless Texinfo is missing.
 172              (when (assoc-ref inputs "texinfo")
 173                (let* ((out  (assoc-ref outputs "out"))
 174                       (dir (string-append out "/share/info")))
 175                  (invoke "make" "info")
 176                  (for-each (lambda (info)
 177                              (install-file info dir))
 178                            (find-files "." "\\.info"))))
 179              #t))
 180          ;; Create a wrapper for Samba. This allows QEMU to use Samba without
 181          ;; pulling it in as an input. Note that you need to explicitly install
 182          ;; Samba in your Guix profile for Samba support.
 183          (add-after 'install-info 'create-samba-wrapper
 184            (lambda* (#:key inputs outputs #:allow-other-keys)
 185              (let* ((out    (assoc-ref %outputs "out"))
 186                     (libexec (string-append out "/libexec")))
 187                (call-with-output-file "samba-wrapper"
 188                  (lambda (port)
 189                    (format port "#!/bin/sh
 190 exec smbd $@")))
 191                (chmod "samba-wrapper" #o755)
 192                (install-file "samba-wrapper" libexec))
 193              #t))
 194          (add-before 'configure 'prevent-network-configuration
 195            (lambda _
 196              ;; Prevent the build from trying to use git to fetch from the net.
 197              (substitute* "Makefile"
 198                (("@./config.status")
 199                 "")) #t))
 200          (add-before 'check 'disable-unusable-tests
 201            (lambda* (#:key inputs outputs #:allow-other-keys)
 202              (substitute* "tests/Makefile.include"
 203                ;; Comment out the test-qga test, which needs /sys and
 204                ;; fails within the build environment.
 205                (("check-unit-.* tests/test-qga" all)
 206                 (string-append "# " all)))
 207              (substitute* "tests/Makefile.include"
 208                ;; Comment out the test-char test, which needs networking and
 209                ;; fails within the build environment.
 210                (("check-unit-.* tests/test-char" all)
 211                 (string-append "# " all)))
 212              #t)))))
 213     (inputs                                       ; TODO: Add optional inputs.
 214      `(("alsa-lib" ,alsa-lib)
 215        ("attr" ,attr)
 216        ("glib" ,glib)
 217        ("gtk+" ,gtk+)
 218        ("libaio" ,libaio)
 219        ("libattr" ,attr)
 220        ("libcap" ,libcap)           ; virtfs support requires libcap & libattr
 221        ("libdrm" ,libdrm)
 222        ("libepoxy" ,libepoxy)
 223        ("libjpeg" ,libjpeg-turbo)
 224        ("libpng" ,libpng)
 225        ("libseccomp" ,libseccomp)
 226        ("libusb" ,libusb)                         ;USB pass-through support
 227        ("mesa" ,mesa)
 228        ("ncurses" ,ncurses)
 229        ;; ("pciutils" ,pciutils)
 230        ("pixman" ,pixman)
 231        ("pulseaudio" ,pulseaudio)
 232        ("sdl2" ,sdl2)
 233        ("spice" ,spice)
 234        ("usbredir" ,usbredir)
 235        ("util-linux" ,util-linux)
 236        ("vde2" ,vde2)
 237        ("virglrenderer" ,virglrenderer)
 238        ("zlib" ,zlib)))
 239     (native-inputs `(("gettext" ,gettext-minimal)
 240                      ("glib:bin" ,glib "bin") ; gtester, etc.
 241                      ("perl" ,perl)
 242                      ("flex" ,flex)
 243                      ("bison" ,bison)
 244                      ("pkg-config" ,pkg-config)
 245                      ("python-wrapper" ,python-wrapper)
 246                      ("python-sphinx" ,python-sphinx)
 247                      ("texinfo" ,texinfo)))
 248     (home-page "https://www.qemu.org")
 249     (synopsis "Machine emulator and virtualizer")
 250     (description
 251      "QEMU is a generic machine emulator and virtualizer.
 252
 253 When used as a machine emulator, QEMU can run OSes and programs made for one
 254 machine (e.g. an ARM board) on a different machine---e.g., your own PC.  By
 255 using dynamic translation, it achieves very good performance.
 256
 257 When used as a virtualizer, QEMU achieves near native performances by
 258 executing the guest code directly on the host CPU.  QEMU supports
 259 virtualization when executing under the Xen hypervisor or using
 260 the KVM kernel module in Linux.  When using KVM, QEMU can virtualize x86,
 261 server and embedded PowerPC, and S390 guests.")
 262
 263     ;; Many files are GPLv2+, but some are GPLv2-only---e.g., `memory.c'.
 264     (license license:gpl2)
 265
 266     ;; Several tests fail on MIPS; see <http://hydra.gnu.org/build/117914>.
 267     (supported-systems (delete "mips64el-linux" %supported-systems))))
 268
 269 (define-public qemu-minimal
 270   ;; QEMU without GUI support.
 271   (package (inherit qemu)
 272     (name "qemu-minimal")
 273     (synopsis "Machine emulator and virtualizer (without GUI)")
 274     (arguments
 275      (substitute-keyword-arguments (package-arguments qemu)
 276        ((#:configure-flags _ '(list))
 277         ;; Restrict to the targets supported by Guix.
 278         ''("--target-list=i386-softmmu,x86_64-softmmu,mips64el-softmmu,arm-softmmu,aarch64-softmmu"))))
 279
 280     ;; Remove dependencies on optional libraries, notably GUI libraries.
 281     (native-inputs (fold alist-delete (package-native-inputs qemu)
 282                   '("gettext")))
 283     (inputs (fold alist-delete (package-inputs qemu)
 284                   '("libusb" "mesa" "sdl2" "spice" "virglrenderer" "gtk+"
 285                     "usbredir" "libdrm" "libepoxy" "pulseaudio" "vde2")))))
 286
 287 (define-public libosinfo
 288   (package
 289     (name "libosinfo")
 290     (version "1.7.1")
 291     (source
 292      (origin
 293        (method url-fetch)
 294        (uri (string-append "https://releases.pagure.org/libosinfo/libosinfo-"
 295                            version ".tar.xz"))
 296        (sha256
 297         (base32
 298          "1s97sv24bybggjx6hgqba2qdqz3ivfpd4cmkh4zm5y59sim109mv"))))
 299     (build-system meson-build-system)
 300     (arguments
 301      `(#:configure-flags
 302        (list (string-append "-Dwith-usb-ids-path="
 303                             (assoc-ref %build-inputs "usb.ids"))
 304              (string-append "-Dwith-pci-ids-path="
 305                             (assoc-ref %build-inputs "pci.ids")))
 306        #:phases
 307        (modify-phases %standard-phases
 308          (add-after 'unpack 'patch-osinfo-path
 309            (lambda* (#:key inputs #:allow-other-keys)
 310              (substitute* "osinfo/osinfo_loader.c"
 311                (("path = DATA_DIR.*")
 312                 (string-append "path = \"" (assoc-ref inputs "osinfo-db")
 313                                "/share/osinfo\";")))
 314              #t)))))
 315     (inputs
 316      `(("libsoup" ,libsoup)
 317        ("libxml2" ,libxml2)
 318        ("libxslt" ,libxslt)
 319        ("osinfo-db" ,osinfo-db)))
 320     (native-inputs
 321      `(("glib" ,glib "bin")  ; glib-mkenums, etc.
 322        ("gobject-introspection" ,gobject-introspection)
 323        ("gtk-doc" ,gtk-doc)
 324        ("vala" ,vala)
 325        ("intltool" ,intltool)
 326        ("pkg-config" ,pkg-config)
 327        ("pci.ids"
 328         ,(origin
 329            (method url-fetch)
 330            (uri "https://github.com/pciutils/pciids/raw/ad02084f0bc143e3c15e31a6152a3dfb1d7a3156/pci.ids")
 331            (sha256
 332             (base32
 333              "0kfhpj5rnh24hz2714qhfmxk281vwc2w50sm73ggw5d15af7zfsw"))))
 334        ("usb.ids"
 335         ,(origin
 336            (method url-fetch)
 337            (uri "https://svn.code.sf.net/p/linux-usb/repo/trunk/htdocs/usb.ids?r=2681")
 338            (file-name "usb.ids")
 339            (sha256
 340             (base32
 341              "1m6yhvz5k8aqzxgk7xj3jkk8frl1hbv0h3vgj4wbnvnx79qnvz3r"))))))
 342     (home-page "https://libosinfo.org/")
 343     (synopsis "Operating system information database")
 344     (description "libosinfo is a GObject based library API for managing
 345 information about operating systems, hypervisors and the (virtual) hardware
 346 devices they can support.  It includes a database containing device metadata
 347 and provides APIs to match/identify optimal devices for deploying an operating
 348 system on a hypervisor.  Via GObject Introspection, the API is available in
 349 all common programming languages.  Vala bindings are also provided.")
 350     ;; The library files are released under LGPLv2.1 or later; the source
 351     ;; files in the "tools" directory are released under GPLv2+.
 352     (license (list license:lgpl2.1+ license:gpl2+))))
 353
 354 (define-public lxc
 355   (package
 356     (name "lxc")
 357     (version "3.1.0")
 358     (source (origin
 359               (method url-fetch)
 360               (uri (string-append
 361                     "https://linuxcontainers.org/downloads/lxc/lxc-"
 362                     version ".tar.gz"))
 363               (sha256
 364                (base32
 365                 "1igxqgx8q9cp15mcp1y8j564bl85ijw04jcmgb1s5bmfbg1751sd"))))
 366     (build-system gnu-build-system)
 367     (native-inputs
 368      `(("pkg-config" ,pkg-config)))
 369     (inputs
 370      `(("gnutls" ,gnutls)
 371        ("libcap" ,libcap)
 372        ("libseccomp" ,libseccomp)
 373        ("libselinux" ,libselinux)))
 374     (arguments
 375      `(#:configure-flags
 376        (list (string-append "--docdir=" (assoc-ref %outputs "out")
 377                             "/share/doc/" ,name "-" ,version)
 378              "--sysconfdir=/etc"
 379              "--localstatedir=/var")
 380        #:make-flags
 381        ;; Treat the kernel headers as system headers to silence
 382        ;; compiler warnings from those.
 383        (list (string-append "C_INCLUDE_PATH="
 384                             (assoc-ref %build-inputs "kernel-headers")
 385                             "/include"))
 386        #:phases
 387        (modify-phases %standard-phases
 388          (replace 'install
 389            (lambda* (#:key outputs #:allow-other-keys)
 390              (let* ((out         (assoc-ref outputs "out"))
 391                     (bashcompdir (string-append out "/etc/bash_completion.d")))
 392                (invoke "make" "install"
 393                        (string-append "bashcompdir=" bashcompdir)
 394                        ;; Don't install files into /var and /etc.
 395                        "LXCPATH=/tmp/var/lib/lxc"
 396                        "localstatedir=/tmp/var"
 397                        "sysconfdir=/tmp/etc"
 398                        "sysconfigdir=/tmp/etc/default")))))))
 399     (synopsis "Linux container tools")
 400     (home-page "https://linuxcontainers.org/")
 401     (description
 402      "LXC is a userspace interface for the Linux kernel containment features.
 403 Through a powerful API and simple tools, it lets Linux users easily create and
 404 manage system or application containers.")
 405     (license license:lgpl2.1+)))
 406
 407 (define-public libvirt
 408   (package
 409     (name "libvirt")
 410     (version "5.8.0")
 411     (source
 412      (origin
 413        (method url-fetch)
 414        (uri (string-append "https://libvirt.org/sources/libvirt-"
 415                            version ".tar.xz"))
 416        (sha256
 417         (base32 "0m8cqaqflvys5kaqpvb0qr4k365j09jc5xk6x70yvg8qkcl2hcz2"))
 418        (patches
 419         (search-patches "libvirt-create-machine-cgroup.patch"))))
 420     (build-system gnu-build-system)
 421     (arguments
 422      `(#:configure-flags
 423        (list "--with-qemu"
 424              "--with-qemu-user=nobody"
 425              "--with-qemu-group=kvm"
 426              "--with-polkit"
 427              (string-append "--docdir=" (assoc-ref %outputs "out") "/share/doc/"
 428                             ,name "-" ,version)
 429              "--sysconfdir=/etc"
 430              "--localstatedir=/var")
 431        #:phases
 432        (modify-phases %standard-phases
 433          (add-before 'configure 'fix-BOURNE_SHELL-definition
 434            ;; BOURNE_SHELL is hard-#defined to ‘/bin/sh’, causing test failures.
 435            (lambda _
 436              (substitute* "config.h.in"
 437                (("/bin/sh") (which "sh")))
 438              #t))
 439          (add-before 'configure 'patch-libtirpc-file-names
 440            (lambda* (#:key inputs #:allow-other-keys)
 441              ;; libvirt uses an m4 macro instead of pkg-config to determine where
 442              ;; the RPC headers are located.  Tell it to look in the right place.
 443              (substitute* "configure"
 444                (("/usr/include/tirpc")  ;defined in m4/virt-xdr.m4
 445                 (string-append (assoc-ref inputs "libtirpc")
 446                                "/include/tirpc")))
 447              #t))
 448          (add-before 'configure 'disable-broken-tests
 449            (lambda _
 450              (let ((tests (list "commandtest"      ; hangs idly
 451                                 "qemuxml2argvtest" ; fails
 452                                 "qemuhotplugtest"  ; fails
 453                                 "virnetsockettest" ; tries to network
 454                                 "virshtest")))     ; fails
 455                (substitute* "tests/Makefile.in"
 456                  (((format #f "(~a)\\$\\(EXEEXT\\)" (string-join tests "|")))
 457                   ""))
 458                #t)))
 459          (replace 'install
 460            ;; Since the sysconfdir and localstatedir should be /etc and /var
 461            ;; at runtime, we must prevent writing to them at installation
 462            ;; time.
 463            (lambda* (#:key make-flags #:allow-other-keys)
 464              (apply invoke "make" "install"
 465                     "sysconfdir=/tmp/etc"
 466                     "localstatedir=/tmp/var"
 467                     make-flags))))))
 468     (inputs
 469      `(("libxml2" ,libxml2)
 470        ("eudev" ,eudev)
 471        ("libpciaccess" ,libpciaccess)
 472        ("gnutls" ,gnutls)
 473        ("dbus" ,dbus)
 474        ("libpcap" ,libpcap)
 475        ("libnl" ,libnl)
 476        ("libtirpc" ,libtirpc)           ;for <rpc/rpc.h>
 477        ("libuuid" ,util-linux)
 478        ("lvm2" ,lvm2)                   ;for libdevmapper
 479        ("curl" ,curl)
 480        ("openssl" ,openssl)
 481        ("cyrus-sasl" ,cyrus-sasl)
 482        ("libyajl" ,libyajl)
 483        ("audit" ,audit)
 484        ("dmidecode" ,dmidecode)
 485        ("dnsmasq" ,dnsmasq)
 486        ("ebtables" ,ebtables)
 487        ("iproute" ,iproute)
 488        ("iptables" ,iptables)))
 489     (native-inputs
 490      `(("xsltproc" ,libxslt)
 491        ("perl" ,perl)
 492        ("pkg-config" ,pkg-config)
 493        ("polkit" ,polkit)
 494        ("python" ,python-wrapper)))
 495     (home-page "https://libvirt.org")
 496     (synopsis "Simple API for virtualization")
 497     (description "Libvirt is a C toolkit to interact with the virtualization
 498 capabilities of recent versions of Linux.  The library aims at providing long
 499 term stable C API initially for the Xen paravirtualization but should be able
 500 to integrate other virtualization mechanisms if needed.")
 501     (license license:lgpl2.1+)))
 502
 503 (define-public libvirt-glib
 504   (package
 505     (name "libvirt-glib")
 506     (version "3.0.0")
 507     (source (origin
 508               (method url-fetch)
 509               (uri (string-append "ftp://libvirt.org/libvirt/glib/"
 510                                   "libvirt-glib-" version ".tar.gz"))
 511               (sha256
 512                (base32
 513                 "1zpbv4ninc57c9rw4zmmkvvqn7154iv1qfr20kyxn8xplalqrzvz"))))
 514     (build-system gnu-build-system)
 515     (inputs
 516      `(("openssl" ,openssl)
 517        ("cyrus-sasl" ,cyrus-sasl)
 518        ("lvm2" ,lvm2)                   ; for libdevmapper
 519        ("libyajl" ,libyajl)))
 520     (native-inputs
 521      `(("pkg-config" ,pkg-config)
 522        ("intltool" ,intltool)
 523        ("glib" ,glib "bin")
 524        ("vala" ,vala)))
 525     (propagated-inputs
 526      ;; ‘Required:’ by the installed .pc files.
 527      `(("glib" ,glib)
 528        ("libvirt" ,libvirt)
 529        ("libxml2" ,libxml2)
 530        ("gobject-introspection" ,gobject-introspection)))
 531     (home-page "https://libvirt.org")
 532     (synopsis "GLib wrapper around libvirt")
 533     (description "libvirt-glib wraps the libvirt library to provide a
 534 high-level object-oriented API better suited for glib-based applications, via
 535 three libraries:
 536
 537 @enumerate
 538 @item libvirt-glib - GLib main loop integration & misc helper APIs
 539 @item libvirt-gconfig - GObjects for manipulating libvirt XML documents
 540 @item libvirt-gobject - GObjects for managing libvirt objects
 541 @end enumerate
 542 ")
 543     (license license:lgpl2.1+)))
 544
 545 (define-public python-libvirt
 546   (package
 547     (name "python-libvirt")
 548     (version "5.8.0")
 549     (source
 550      (origin
 551        (method url-fetch)
 552        (uri (string-append "https://libvirt.org/sources/python/libvirt-python-"
 553                            version ".tar.gz"))
 554        (sha256
 555         (base32 "0kyz3lx49d8p75mvbzinxc1zgs8g7adn77y9bm15b8b4ad9zl5s6"))))
 556     (build-system python-build-system)
 557     (arguments
 558      `(#:phases
 559        (modify-phases %standard-phases
 560          (add-after 'unpack 'patch-nosetests-path
 561            (lambda* (#:key inputs #:allow-other-keys)
 562              (substitute* "setup.py"
 563                (("\"/usr/bin/nosetests\"")
 564                 (string-append "\"" (which "nosetests") "\""))
 565                (("self\\.spawn\\(\\[sys\\.executable, nose\\]\\)")
 566                 (format #f "self.spawn([\"~a\", nose])" (which "bash"))))
 567              #t)))))
 568     (inputs
 569      `(("libvirt" ,libvirt)))
 570     (propagated-inputs
 571      `(("python-lxml" ,python-lxml)))
 572     (native-inputs
 573      `(("pkg-config" ,pkg-config)
 574        ("python-nose" ,python-nose)))
 575     (home-page "https://libvirt.org")
 576     (synopsis "Python bindings to libvirt")
 577     (description "This package provides Python bindings to the libvirt
 578 virtualization library.")
 579     (license license:lgpl2.1+)))
 580
 581 (define-public python2-libvirt
 582   (package-with-python2 python-libvirt))
 583
 584 (define-public virt-manager
 585   (package
 586     (name "virt-manager")
 587     (version "2.2.1")
 588     (source (origin
 589               (method url-fetch)
 590               (uri (string-append "https://virt-manager.org/download/sources"
 591                                   "/virt-manager/virt-manager-"
 592                                   version ".tar.gz"))
 593               (sha256
 594                (base32
 595                 "06ws0agxlip6p6n3n43knsnjyd91gqhh2dadgc33wl9lx1k8vn6g"))))
 596     (build-system python-build-system)
 597     (arguments
 598      `(#:use-setuptools? #f          ; uses custom distutils 'install' command
 599        ;; Some of the tests seem to require network access to install virtual
 600        ;; machines.
 601        #:tests? #f
 602        #:imported-modules ((guix build glib-or-gtk-build-system)
 603                            ,@%python-build-system-modules)
 604        #:modules ((ice-9 match)
 605                   (srfi srfi-26)
 606                   (guix build python-build-system)
 607                   ((guix build glib-or-gtk-build-system) #:prefix glib-or-gtk:)
 608                   (guix build utils))
 609        #:phases
 610        (modify-phases %standard-phases
 611          (add-after 'unpack 'fix-setup
 612            (lambda* (#:key outputs #:allow-other-keys)
 613              (substitute* "virtinst/buildconfig.py"
 614                (("/usr") (assoc-ref outputs "out")))
 615              #t))
 616          (add-after 'unpack 'fix-qemu-img-reference
 617            (lambda* (#:key inputs #:allow-other-keys)
 618              (substitute* "virtconv/formats.py"
 619                (("/usr(/bin/qemu-img)" _ suffix)
 620                 (string-append (assoc-ref inputs "qemu") suffix)))
 621              #t))
 622          (add-after 'unpack 'fix-default-uri
 623            (lambda* (#:key inputs #:allow-other-keys)
 624              ;; Xen is not available for now - so only patch qemu.
 625              (substitute* "virtManager/createconn.py"
 626                (("/usr(/bin/qemu-system)" _ suffix)
 627                 (string-append (assoc-ref inputs "qemu") suffix)))
 628              #t))
 629          (add-before 'wrap 'wrap-with-GI_TYPELIB_PATH
 630            (lambda* (#:key inputs outputs #:allow-other-keys)
 631              (let* ((bin       (string-append (assoc-ref outputs "out") "/bin"))
 632                     (bin-files (find-files bin ".*"))
 633                     (paths     (map (match-lambda
 634                                       ((output . directory)
 635                                        (let* ((girepodir (string-append
 636                                                           directory
 637                                                           "/lib/girepository-1.0")))
 638                                          (if (file-exists? girepodir)
 639                                              girepodir #f))))
 640                                     inputs)))
 641                (for-each (lambda (file)
 642                            (format #t "wrapping ~a\n" file)
 643                            (wrap-program file
 644                              `("GI_TYPELIB_PATH" ":" prefix
 645                                ,(filter identity paths))))
 646                          bin-files))
 647              #t))
 648          (add-after 'install 'glib-or-gtk-compile-schemas
 649            (assoc-ref glib-or-gtk:%standard-phases 'glib-or-gtk-compile-schemas))
 650          (add-after 'install 'glib-or-gtk-wrap
 651            (assoc-ref glib-or-gtk:%standard-phases 'glib-or-gtk-wrap)))))
 652     (inputs
 653      `(("dconf" ,dconf)
 654        ("gtk+" ,gtk+)
 655        ("gtk-vnc" ,gtk-vnc)
 656        ("gtksourceview" ,gtksourceview)
 657        ("libvirt" ,libvirt)
 658        ("libvirt-glib" ,libvirt-glib)
 659        ("libosinfo" ,libosinfo)
 660        ("vte" ,vte)
 661        ("python-libvirt" ,python-libvirt)
 662        ("python-requests" ,python-requests)
 663        ("python-ipaddress" ,python-ipaddress)
 664        ("python-pycairo" ,python-pycairo)
 665        ("python-pygobject" ,python-pygobject)
 666        ("python-libxml2" ,python-libxml2)
 667        ("spice-gtk" ,spice-gtk)))
 668     ;; virt-manager searches for qemu-img or kvm-img in the PATH.
 669     (propagated-inputs
 670      `(("qemu" ,qemu)))
 671     (native-inputs
 672      `(("glib" ,glib "bin")             ; glib-compile-schemas
 673        ("gobject-introspection" ,gobject-introspection)
 674        ("gtk+" ,gtk+ "bin")             ; gtk-update-icon-cache
 675        ("perl" ,perl)                   ; pod2man
 676        ("intltool" ,intltool)))
 677     (home-page "https://virt-manager.org/")
 678     (synopsis "Manage virtual machines")
 679     (description
 680      "The virt-manager application is a desktop user interface for managing
 681 virtual machines through libvirt.  It primarily targets KVM VMs, but also
 682 manages Xen and LXC (Linux containers).  It presents a summary view of running
 683 domains, their live performance and resource utilization statistics.")
 684     (license license:gpl2+)))
 685
 686 (define-public criu
 687   (package
 688     (name "criu")
 689     (version "3.13")
 690     (source (origin
 691               (method url-fetch)
 692               (uri (string-append "http://download.openvz.org/criu/criu-"
 693                                   version ".tar.bz2"))
 694               (sha256
 695                (base32
 696                 "1yn9ix9lqvqvjrs3a3g6g1wqfniyf9n7giy0mr3jvijmrcm7y0pa"))))
 697     (build-system gnu-build-system)
 698     (arguments
 699      `(#:test-target "test"
 700        #:tests? #f ; tests require mounting as root
 701        #:make-flags
 702        (list (string-append "PREFIX=" (assoc-ref %outputs "out"))
 703              (string-append "LIBDIR=" (assoc-ref %outputs "out")
 704                             "/lib")
 705              (string-append "ASCIIDOC=" (assoc-ref %build-inputs "asciidoc")
 706                             "/bin/asciidoc")
 707              (string-append "XMLTO=" (assoc-ref %build-inputs "xmlto")
 708                             "/bin/xmlto"))
 709        #:phases
 710        (modify-phases %standard-phases
 711          (replace 'configure
 712            (lambda* (#:key inputs #:allow-other-keys)
 713              ;; The includes for libnl are located in a sub-directory.
 714              (setenv "C_INCLUDE_PATH"
 715                      (string-append (assoc-ref inputs "libnl")
 716                                     "/include/libnl3:"
 717                                     ;; Also add the kernel headers here so that GCC
 718                                     ;; treats them as "system headers".  Otherwise
 719                                     ;; the build fails with -Werror because parasite.c
 720                                     ;; includes both <linux/fs.h> and <sys/mount.h>,
 721                                     ;; which define some of the same constants.
 722                                     (assoc-ref inputs "kernel-headers")
 723                                     "/include"))
 724              #t))
 725          (add-after 'configure 'fix-documentation
 726            (lambda* (#:key inputs outputs #:allow-other-keys)
 727              (substitute* "Documentation/Makefile"
 728                (("-m custom.xsl")
 729                 (string-append
 730                  "-m custom.xsl --skip-validation -x "
 731                  (assoc-ref inputs "docbook-xsl") "/xml/xsl/"
 732                  ,(package-name docbook-xsl) "-"
 733                  ,(package-version docbook-xsl)
 734                  "/manpages/docbook.xsl")))
 735              #t))
 736          (add-after 'unpack 'hardcode-variables
 737            (lambda* (#:key inputs #:allow-other-keys)
 738              ;; Hardcode arm version detection
 739              (substitute* "Makefile"
 740                (("ARMV.*:=.*") "ARMV := 7\n"))
 741              ;; We are currently using python-2
 742              (substitute* "crit/Makefile"
 743                (("\\$\\(PYTHON\\)") "python2"))
 744              (substitute* "lib/Makefile"
 745                (("\\$\\(PYTHON\\)")
 746                 (string-append (assoc-ref inputs "python")
 747                                "/bin/python")))
 748              #t))
 749          (add-before 'build 'fix-symlink
 750            (lambda* (#:key inputs #:allow-other-keys)
 751              ;; The file 'images/google/protobuf/descriptor.proto' points to
 752              ;; /usr/include/..., which obviously does not exist.
 753              (let* ((file "google/protobuf/descriptor.proto")
 754                     (target (string-append "images/" file))
 755                     (source (string-append (assoc-ref inputs "protobuf")
 756                                            "/include/" file)))
 757                (delete-file target)
 758                (symlink source target)
 759                #t)))
 760          (add-after 'install 'wrap
 761            (lambda* (#:key inputs outputs #:allow-other-keys)
 762              ;; Make sure 'crit' runs with the correct PYTHONPATH.
 763              (let* ((out (assoc-ref outputs "out"))
 764                     (path (string-append out
 765                                          "/lib/python"
 766                                          (string-take (string-take-right
 767                                                        (assoc-ref inputs "python") 5) 3)
 768                                          "/site-packages:"
 769                                          (getenv "PYTHONPATH"))))
 770                (wrap-program (string-append out "/bin/crit")
 771                  `("PYTHONPATH" ":" prefix (,path))))
 772              #t)))))
 773     (inputs
 774      `(("protobuf" ,protobuf)
 775        ("python" ,python-2)
 776        ("python2-protobuf" ,python2-protobuf)
 777        ("python2-ipaddr" ,python2-ipaddr)
 778        ("iproute" ,iproute)
 779        ("libaio" ,libaio)
 780        ("libcap" ,libcap)
 781        ("libnet" ,libnet)
 782        ("libnl" ,libnl)
 783        ("libbsd" ,libbsd)))
 784     (native-inputs
 785      `(("pkg-config" ,pkg-config)
 786        ("perl" ,perl)
 787        ("protobuf-c" ,protobuf-c)
 788        ("asciidoc" ,asciidoc)
 789        ("xmlto" ,xmlto)
 790        ("docbook-xml" ,docbook-xml)
 791        ("docbook-xsl" ,docbook-xsl)))
 792     (home-page "https://criu.org")
 793     (synopsis "Checkpoint and restore in user space")
 794     (description "Using this tool, you can freeze a running application (or
 795 part of it) and checkpoint it to a hard drive as a collection of files.  You
 796 can then use the files to restore and run the application from the point it
 797 was frozen at.  The distinctive feature of the CRIU project is that it is
 798 mainly implemented in user space.")
 799     ;; The project is licensed under GPLv2; files in the lib/ directory are
 800     ;; LGPLv2.1.
 801     (license (list license:gpl2 license:lgpl2.1))))
 802
 803 (define-public qmpbackup
 804   (package
 805     (name "qmpbackup")
 806     (version "0.2")
 807     (source (origin
 808               (method git-fetch)
 809               (uri (git-reference
 810                      (url "https://github.com/abbbi/qmpbackup.git")
 811                      (commit version)))
 812               (file-name (git-file-name name version))
 813               (sha256
 814                (base32
 815                 "0swhp5byz44brhyis1a39p11fyn9q84xz5q6v2fah29r7d71kmmx"))))
 816     (build-system python-build-system)
 817     (arguments
 818      `(#:python ,python-2))
 819     (home-page "https://github.com/abbbi/qmpbackup")
 820     (synopsis "Backup and restore QEMU machines")
 821     (description "qmpbackup is designed to create and restore full and
 822 incremental backups of running QEMU virtual machines via QMP, the QEMU
 823 Machine Protocol.")
 824     (license license:gpl3+)))
 825
 826 (define-public looking-glass-client
 827   (let ((commit "182c4752d57690da7f99d5e788de9b8baea33895"))
 828     (package
 829      (name "looking-glass-client")
 830      (version (string-append "a12-" (string-take commit 7)))
 831      (source
 832       (origin
 833        (method git-fetch)
 834        (uri (git-reference (url "https://github.com/gnif/LookingGlass")
 835                            (commit commit)))
 836        (file-name (git-file-name name version))
 837        (sha256
 838         (base32
 839          "02bq46ndmzq9cihazzn7xq1x7q5nzm7iw4l9lqzihxcxp9famkhw"))
 840        (modules '((guix build utils)))
 841        (snippet
 842         '(begin
 843            ;; Do not create binaries optimized for the CPU of the build machine,
 844            ;; for reproducibility and compatibility.  TODO: in the next version
 845            ;; of looking glass, this is exposed as a CMake configure option.
 846            (substitute* "client/CMakeLists.txt"
 847              (("-march=native")
 848               ""))
 849            #t))))
 850      (build-system cmake-build-system)
 851      (inputs `(("fontconfig" ,fontconfig)
 852                ("glu" ,glu)
 853                ("mesa" ,mesa)
 854                ("openssl" ,openssl)
 855                ("sdl2" ,sdl2)
 856                ("sdl2-ttf" ,sdl2-ttf)
 857                ("spice-protocol" ,spice-protocol)
 858                ("wayland" ,wayland)))
 859      (native-inputs `(("libconfig" ,libconfig)
 860                       ("nettle" ,nettle)
 861                       ("pkg-config" ,pkg-config)))
 862      (arguments
 863       `(#:tests? #f ;; No tests are available.
 864         #:make-flags '("CC=gcc")
 865         #:phases (modify-phases %standard-phases
 866                    (add-before 'configure 'chdir-to-client
 867                      (lambda* (#:key outputs #:allow-other-keys)
 868                        (chdir "client")
 869                        #t))
 870                    (add-after 'chdir-to-client 'add-missing-include
 871                      (lambda _
 872                        ;; Mimic upstream commit b9797529893, required since the
 873                        ;; update to Mesa 19.2.
 874                        (substitute* "renderers/egl/shader.h"
 875                          (("#include <stdbool\\.h>")
 876                           "#include <stdbool.h>\n#include <stddef.h>"))
 877                        #t))
 878                    (replace 'install
 879                      (lambda* (#:key outputs #:allow-other-keys)
 880                        (install-file "looking-glass-client"
 881                                      (string-append (assoc-ref outputs "out")
 882                                                     "/bin"))
 883                        #t)))))
 884      (home-page "https://looking-glass.hostfission.com")
 885      (synopsis "KVM Frame Relay (KVMFR) implementation")
 886      (description "Looking Glass allows the use of a KVM (Kernel-based Virtual
 887 Machine) configured for VGA PCI Pass-through without an attached physical
 888 monitor, keyboard or mouse.  It displays the VM's rendered contents on your main
 889 monitor/GPU.")
 890      ;; This package requires SSE instructions.
 891      (supported-systems '("i686-linux" "x86_64-linux"))
 892      (license license:gpl2+))))
 893
 894 (define-public runc
 895   (package
 896     (name "runc")
 897     (version "1.0.0-rc6")
 898     (source (origin
 899               (method url-fetch)
 900               (uri (string-append
 901                     "https://github.com/opencontainers/runc/releases/"
 902                     "download/v" version "/runc.tar.xz"))
 903               (file-name (string-append name "-" version ".tar.xz"))
 904               (patches (search-patches "runc-CVE-2019-5736.patch"))
 905               (sha256
 906                (base32
 907                 "1c7832dq70slkjh8qp2civ1wxhhdd2hrx84pq7db1mmqc9fdr3cc"))))
 908     (build-system go-build-system)
 909     (arguments
 910      '(#:import-path "github.com/opencontainers/runc"
 911        #:install-source? #f
 912        ;; XXX: 20/139 tests fail due to missing /var, cgroups and apparmor in
 913        ;; the build environment.
 914        #:tests? #f
 915        #:phases
 916        (modify-phases %standard-phases
 917          (replace 'unpack
 918            (lambda* (#:key source import-path #:allow-other-keys)
 919              ;; Unpack the tarball into 'runc' instead of 'runc-1.0.0-rc5'.
 920              (let ((dest (string-append "src/" import-path)))
 921                (mkdir-p dest)
 922                (invoke "tar" "-C" (string-append "src/" import-path)
 923                        "--strip-components=1"
 924                        "-xvf" source))))
 925          (replace 'build
 926            (lambda* (#:key import-path #:allow-other-keys)
 927              (chdir (string-append "src/" import-path))
 928              ;; XXX: requires 'go-md2man'.
 929              ;; (invoke "make" "man")
 930              (invoke "make")))
 931          ;; (replace 'check
 932          ;;   (lambda _
 933          ;;     (invoke "make" "localunittest")))
 934          (replace 'install
 935            (lambda* (#:key outputs #:allow-other-keys)
 936              (let ((out (assoc-ref outputs "out")))
 937               (invoke "make" "install" "install-bash"
 938                       (string-append "PREFIX=" out))))))))
 939     (native-inputs
 940      `(("pkg-config" ,pkg-config)))
 941     (inputs
 942      `(("libseccomp" ,libseccomp)))
 943     (synopsis "Open container initiative runtime")
 944     (home-page "https://www.opencontainers.org/")
 945     (description
 946      "@command{runc} is a command line client for running applications
 947 packaged according to the
 948 @uref{https://github.com/opencontainers/runtime-spec/blob/master/spec.md, Open
 949 Container Initiative (OCI) format} and is a compliant implementation of the
 950 Open Container Initiative specification.")
 951     (license license:asl2.0)))
 952
 953 (define-public umoci
 954   (package
 955     (name "umoci")
 956     (version "0.4.5")
 957     (source (origin
 958               (method url-fetch)
 959               (uri (string-append
 960                     "https://github.com/openSUSE/umoci/releases/download/v"
 961                     version "/umoci.tar.xz"))
 962               (file-name (string-append "umoci-" version ".tar.xz"))
 963               (sha256
 964                (base32
 965                 "0x1yyvpllz6fyy9xip6f7b6c94v984n3faf8p50fr9y4ygkgi15a"))))
 966     (build-system go-build-system)
 967     (arguments
 968      '(#:import-path "github.com/openSUSE/umoci"
 969        #:install-source? #f
 970        #:phases
 971        (modify-phases %standard-phases
 972          (replace 'unpack
 973            (lambda* (#:key source import-path #:allow-other-keys)
 974              ;; Unpack the tarball into 'umoci' instead of "runc-${version}".
 975              (let ((dest (string-append "src/" import-path)))
 976                (mkdir-p dest)
 977                (invoke "tar" "-C" (string-append "src/" import-path)
 978                        "--strip-components=1"
 979                        "-xvf" source))))
 980          (replace 'build
 981            (lambda* (#:key import-path #:allow-other-keys)
 982              (chdir (string-append "src/" import-path))
 983              ;; TODO: build manpages with 'go-md2man'.
 984              (invoke "make" "SHELL=bash")))
 985          (replace 'install
 986            (lambda* (#:key outputs #:allow-other-keys)
 987              (let* ((out (assoc-ref outputs "out"))
 988                     (bindir (string-append out "/bin")))
 989                (install-file "umoci" bindir)
 990                #t))))))
 991     (home-page "https://umo.ci/")
 992     (synopsis "Tool for modifying Open Container images")
 993     (description
 994      "@command{umoci} is a tool that allows for high-level modification of an
 995 Open Container Initiative (OCI) image layout and its tagged images.")
 996     (license license:asl2.0)))
 997
 998 (define-public skopeo
 999   (package
1000     (name "skopeo")
1001     (version "0.1.40")
1002     (source (origin
1003               (method git-fetch)
1004               (uri (git-reference
1005                     (url "https://github.com/projectatomic/skopeo")
1006                     (commit (string-append "v" version))))
1007               (file-name (git-file-name name version))
1008               (sha256
1009                (base32
1010                 "1bagirzdzjhicn5dr691092ac3q6lhz3xngjzgqiqkxnvpz7p6cn"))))
1011     (build-system go-build-system)
1012     (native-inputs
1013      `(("pkg-config" ,pkg-config)))
1014     (inputs
1015      `(("btrfs-progs" ,btrfs-progs)
1016        ("eudev" ,eudev)
1017        ("libassuan" ,libassuan)
1018        ("libselinux" ,libselinux)
1019        ("libostree" ,libostree)
1020        ("lvm2" ,lvm2)
1021        ("glib" ,glib)
1022        ("gpgme" ,gpgme)))
1023     (arguments
1024      '(#:import-path "github.com/projectatomic/skopeo"
1025        #:install-source? #f
1026        #:tests? #f ; The tests require Docker
1027        #:phases
1028        (modify-phases %standard-phases
1029          (replace 'build
1030            (lambda* (#:key import-path #:allow-other-keys)
1031              (chdir (string-append "src/" import-path))
1032              ;; TODO: build manpages with 'go-md2man'.
1033              (invoke "make" "binary-local")))
1034          (replace 'install
1035            (lambda* (#:key outputs #:allow-other-keys)
1036              (let ((out (assoc-ref outputs "out")))
1037                (invoke "make" "install-binary" "install-completions"
1038                        (string-append "PREFIX=" out))))))))
1039     (home-page "https://github.com/projectatomic/skopeo")
1040     (synopsis "Interact with container images and container image registries")
1041     (description
1042      "@command{skopeo} is a command line utility providing various operations
1043 with container images and container image registries.  It can:
1044 @enumerate
1045
1046 @item Copy container images between various containers image stores,
1047 converting them as necessary.
1048
1049 @item Convert a Docker schema 2 or schema 1 container image to an OCI image.
1050
1051 @item Inspect a repository on a container registry without needlessly pulling
1052 the image.
1053
1054 @item Sign and verify container images.
1055
1056 @item Delete container images from a remote container registry.
1057
1058 @end enumerate")
1059     (license license:asl2.0)))
1060
1061 (define-public python-vagrant
1062   (package
1063     (name "python-vagrant")
1064     (version "0.5.15")
1065     (source
1066       (origin
1067         (method url-fetch)
1068         (uri (pypi-uri "python-vagrant" version))
1069         (sha256
1070          (base32
1071           "1ikrh6canhcxg5y7pzmkcnnydikppv7s6sm9prfx90nk0ac8m6mg"))))
1072     (build-system python-build-system)
1073     (arguments
1074      '(#:tests? #f)) ; tests involve running vagrant.
1075     (home-page "https://github.com/todddeluca/python-vagrant")
1076     (synopsis "Python bindings for Vagrant")
1077     (description
1078      "Python-vagrant is a Python module that provides a thin wrapper around the
1079 @code{vagrant} command line executable, allowing programmatic control of Vagrant
1080 virtual machines.")
1081     (license license:expat)))
1082
1083 (define-public bubblewrap
1084   (package
1085     (name "bubblewrap")
1086     (version "0.4.1")
1087     (source (origin
1088               (method url-fetch)
1089               (uri (string-append "https://github.com/containers/bubblewrap/"
1090                                   "releases/download/v" version "/bubblewrap-"
1091                                   version ".tar.xz"))
1092               (sha256
1093                (base32
1094                 "00ycgi6q2yngh06bnz50wkvar6r2jnjf3j158grhi9k13jdrpimr"))))
1095     (build-system gnu-build-system)
1096     (arguments
1097      `(#:phases
1098        (modify-phases %standard-phases
1099          (add-after 'unpack 'fix-test
1100            (lambda* (#:key outputs #:allow-other-keys)
1101              ;; Tests try to access /var/tmp, which is not possible in our build
1102              ;; environment.  Let's give them another directory.
1103              ;; /tmp gets overriden in some tests, so we need another directory.
1104              ;; the only possibility is the output directory.
1105              (let ((tmp-dir (string-append (assoc-ref outputs "out") "/tmp")))
1106                (mkdir-p tmp-dir)
1107                (substitute* "tests/test-run.sh"
1108                  (("/var/tmp") tmp-dir)
1109                  ;; Tests create a temporary python script, so fix its shebang.
1110                  (("/usr/bin/env python") (which "python"))
1111                  ;; Some tests try to access /usr, but that doesn't exist.
1112                  ;; Give them /gnu instead.
1113                  (("/usr") "/gnu")
1114                  (("--ro-bind /bin /bin") "--ro-bind /gnu /bin")
1115                  (("--ro-bind /sbin /sbin") "--ro-bind /gnu /sbin")
1116                  (("--ro-bind /lib /lib") "--ro-bind /gnu /lib")
1117                  (("  */bin/bash") (which "bash"))
1118                  (("/bin/sh") (which "sh"))
1119                  (("findmnt") (which "findmnt"))))
1120              #t))
1121          ;; Remove the directory we gave to tests to have a clean package.
1122          (add-after 'check 'remove-tmp-dir
1123            (lambda* (#:key outputs #:allow-other-keys)
1124              (delete-file-recursively (string-append (assoc-ref outputs "out") "/tmp"))
1125              #t)))))
1126     (inputs
1127      `(("libcap" ,libcap)))
1128     (native-inputs
1129      `(("python-2" ,python-2)
1130        ("util-linux" ,util-linux)))
1131     (home-page "https://github.com/containers/bubblewrap")
1132     (synopsis "Unprivileged sandboxing tool")
1133     (description "Bubblewrap is aimed at running applications in a sandbox,
1134 restricting their access to parts of the operating system or user data such as
1135 the home directory.  Bubblewrap always creates a new mount namespace, and the
1136 user can specify exactly what parts of the file system should be made visible
1137 in the sandbox.  These directories are mounted with the @code{nodev} option
1138 by default and can be made read-only.")
1139     (license license:lgpl2.0+)))
1140
1141 (define-public bochs
1142   (package
1143     (name "bochs")
1144     (version "2.6.11")
1145     (source
1146      (origin
1147        (method url-fetch)
1148        (uri (string-append "https://sourceforge.net/projects/bochs/files/bochs/"
1149                            version "/bochs-" version ".tar.gz"))
1150        (sha256
1151         (base32 "0ql8q6y1k356li1g9gbvl21448mlxphxxi6kjb2b3pxvzd0pp2b3"))))
1152     (build-system gnu-build-system)
1153     (arguments
1154      `(#:tests? #f))                    ; no tests exist
1155     (inputs
1156      `(("libxrandr" ,libxrandr)))
1157     (home-page "http://bochs.sourceforge.net/")
1158     (synopsis "Emulator for x86 PC")
1159     (description
1160      "Bochs is an emulator which can emulate Intel x86 CPU, common I/O
1161 devices, and a custom BIOS.  It can also be compiled to emulate many different
1162 x86 CPUs, from early 386 to the most recent x86-64 Intel and AMD processors.
1163 Bochs can run most Operating Systems inside the emulation including Linux,
1164 DOS or Microsoft Windows.")
1165     (license license:lgpl2.0+)))
1166
1167 (define-public xen
1168   (package
1169     (name "xen")
1170     (version "4.11.1")
1171     (source (origin
1172               (method git-fetch)
1173               (uri (git-reference
1174                     (url "git://xenbits.xenproject.org/xen.git")
1175                     (commit (string-append "RELEASE-" version))))
1176               (file-name (git-file-name name version))
1177               (sha256
1178                (base32
1179                 "1wv1hyfii14vi9lfjmnv07h2gpm3b7kvh2p55f4yy2b40simksgk"))))
1180     (build-system gnu-build-system)
1181     (arguments
1182      `(#:configure-flags
1183        (list "--enable-rpath"
1184              "--disable-qemu-traditional" ; It tries to do "git clone"
1185              "--disable-rombios" ; would try to "git clone" via etherboot.
1186              ;; TODO: Re-enable stubdom (it's "more secure" to use it).
1187              "--disable-stubdom" ; tries to "git clone" old patched newlib.
1188              (string-append "--with-initddir="
1189                             (assoc-ref %outputs "out")
1190                             "/etc/init.d")
1191              (string-append "--with-system-qemu="
1192                             (assoc-ref %build-inputs "qemu")
1193                             "/bin/qemu-system-i386")
1194              (string-append "--with-system-seabios="
1195                             (assoc-ref %build-inputs "seabios")
1196                             "/share/firmware/bios.bin")
1197              (string-append "--with-system-ovmf="
1198                             (assoc-ref %build-inputs "ovmf")
1199                             "/share/firmware/ovmf_ia32.bin"))
1200        #:make-flags (list "-j" "1"
1201                           "XEN_BUILD_DATE=Thu Jan  1 01:00:01 CET 1970"
1202                           "XEN_BUILD_TIME=01:00:01"
1203                           "XEN_BUILD_HOST="
1204                           "ETHERBOOT_NICS="
1205                           "SMBIOS_REL_DATE=01/01/1970"
1206                           "VGABIOS_REL_DATE=01 Jan 1970"
1207                           ; QEMU_TRADITIONAL_LOC
1208                           ; QEMU_UPSTREAM_LOC
1209                           "SYSCONFIG_DIR=/tmp/etc/default"
1210                           (string-append "BASH_COMPLETION_DIR="
1211                                          (assoc-ref %outputs "out")
1212                                          "/etc/bash_completion.d")
1213                           (string-append "BOOT_DIR="
1214                                          (assoc-ref %outputs "out")
1215                                          "/boot")
1216                           (string-append "DEBUG_DIR="
1217                                          (assoc-ref %outputs "out")
1218                                          "/lib/debug")
1219                           (string-append "EFI_DIR="
1220                                          (assoc-ref %outputs "out")
1221                                          "/lib/efi") ; TODO lib64 ?
1222                           "MINIOS_UPSTREAM_URL="
1223                           ;(string-append "DISTDIR="
1224                           ;               (assoc-ref %outputs "out"))
1225 )
1226        #:test-target "test"
1227        #:phases
1228        (modify-phases %standard-phases
1229         (add-after 'unpack 'unpack-mini-os
1230           (lambda* (#:key inputs #:allow-other-keys)
1231             (copy-recursively (assoc-ref inputs "mini-os") "extras/mini-os")
1232             #t))
1233         (add-after 'unpack-mini-os 'patch
1234           (lambda* (#:key inputs outputs #:allow-other-keys)
1235             (substitute* "tools/firmware/Rules.mk"
1236              (("override XEN_TARGET_ARCH = x86_32")
1237               (string-append "override XEN_TARGET_ARCH = x86_32
1238 override CC = " (assoc-ref inputs "cross-gcc") "/bin/i686-linux-gnu-gcc"))
1239              (("^CFLAGS =$")
1240               (string-append "CFLAGS=-I" (assoc-ref inputs "cross-libc")
1241                              "/include\n")))
1242             (substitute* "config/x86_32.mk"
1243              (("CFLAGS += -m32 -march=i686")
1244               (string-append "CFLAGS += -march=i686 -I"
1245                              (assoc-ref inputs "cross-libc")
1246                              "/include")))
1247             ;; /var is not in /gnu/store , so don't try to create it.
1248             (substitute* '("tools/Makefile"
1249                            "tools/xenstore/Makefile"
1250                            "tools/xenpaging/Makefile")
1251              (("\\$\\(INSTALL_DIR\\) .*XEN_(DUMP|LOG|RUN|LIB|PAGING)_DIR.*")
1252               "\n")
1253              (("\\$\\(INSTALL_DIR\\) .*XEN_(RUN|LIB)_STORED.*")
1254               "\n"))
1255             ;; Prevent xen from creating /etc .
1256             (substitute* "tools/examples/Makefile"
1257              ((" install-readmes") "")
1258              ((" install-configs") ""))
1259             ;; Set rpath.
1260             (substitute* "tools/pygrub/setup.py"
1261              (("library_dirs =")
1262               ; TODO: extra_link_args = ['-Wl,-rpath=/opt/foo'],
1263               (string-append "runtime_library_dirs = ['"
1264                              (assoc-ref outputs "out")
1265                              "/lib'],\nlibrary_dirs =")))
1266             #t))
1267         (add-before 'configure 'patch-xen-script-directory
1268           (lambda* (#:key outputs #:allow-other-keys)
1269             (substitute* '("configure"
1270                            "tools/configure"
1271                            "docs/configure")
1272              (("XEN_SCRIPT_DIR=.*")
1273               (string-append "XEN_SCRIPT_DIR="
1274                              (assoc-ref outputs "out")
1275                              "/etc/xen/scripts")))
1276             #t))
1277         (add-before 'configure 'set-environment-up
1278           (lambda* (#:key make-flags #:allow-other-keys)
1279              (define (cross? x)
1280                (string-contains x "cross-i686-linux"))
1281              (define (filter-environment! filter-predicate
1282                                           environment-variable-names)
1283                (for-each
1284                 (lambda (env-name)
1285                   (let* ((env-value (getenv env-name))
1286                          (search-path (search-path-as-string->list env-value))
1287                          (new-search-path (filter filter-predicate
1288                                                   search-path))
1289                          (new-env-value (list->search-path-as-string
1290                                          new-search-path ":")))
1291                     (setenv env-name new-env-value)))
1292                 environment-variable-names))
1293              (setenv "CROSS_CPATH" (getenv "CPATH"))
1294              (setenv "CROSS_LIBRARY_PATH" (getenv "LIBRARY_PATH"))
1295              (filter-environment! cross?
1296               '("CROSS_CPATH"
1297                 "CROSS_LIBRARY_PATH"))
1298              (filter-environment! (lambda (e) (not (cross? e)))
1299               '("CPATH"
1300                 "LIBRARY_PATH"))
1301              ;; Guix tries to be helpful and automatically adds
1302              ;; mini-os-git-checkout/include to the include path,
1303              ;; but actually we don't want it to be there (yet).
1304              (filter-environment! (lambda (e)
1305                                     (not
1306                                      (string-contains e
1307                                       "mini-os-git-checkout")))
1308               '("CPATH"
1309                 "LIBRARY_PATH"))
1310             (setenv "EFI_VENDOR" "guix")
1311              #t))
1312         (replace 'build
1313           (lambda* (#:key make-flags #:allow-other-keys)
1314             (apply invoke "make" "world" make-flags))))))
1315     (inputs
1316      `(("acpica" ,acpica) ; TODO: patch iasl invocation.
1317        ("bridge-utils" ,bridge-utils) ; TODO: patch invocations.
1318        ("glib" ,glib)
1319        ("iproute" ,iproute) ; TODO: patch invocations.
1320        ("libaio" ,libaio)
1321        ("libx11" ,libx11)
1322        ("libyajl" ,libyajl)
1323        ("ncurses" ,ncurses)
1324        ("openssl" ,openssl)
1325        ("ovmf" ,ovmf)
1326        ("pixman" ,pixman)
1327        ("qemu" ,qemu-minimal)
1328        ("seabios" ,seabios)
1329        ("util-linux" ,util-linux) ; uuid
1330        ; TODO: ocaml-findlib, ocaml-nox.
1331        ("xz" ,xz) ; for liblzma
1332        ("zlib" ,zlib)))
1333     (native-inputs
1334      `(("dev86" ,dev86)
1335        ("bison" ,bison)
1336        ("cmake" ,cmake-minimal)
1337        ("figlet" ,figlet)
1338        ("flex" ,flex)
1339        ("gettext" ,gettext-minimal)
1340        ("libnl" ,libnl)
1341        ("mini-os"
1342        ,(origin
1343          (method git-fetch)
1344          (uri (git-reference
1345                (url "http://xenbits.xen.org/git-http/mini-os.git")
1346                (commit (string-append "xen-RELEASE-" version))))
1347          (sha256
1348           (base32
1349            "1i8pcl19n60i2m9vlg79q3nknpj209c9ic5x10wxaicx45kc107f"))
1350          (file-name "mini-os-git-checkout")))
1351        ("perl" ,perl)
1352        ; TODO: markdown
1353        ("pkg-config" ,pkg-config)
1354        ("python" ,python-2)
1355        ("wget" ,wget)
1356        ("cross-gcc" ,(cross-gcc "i686-linux-gnu"
1357                                 #:xbinutils (cross-binutils "i686-linux-gnu")
1358                                 #:libc (cross-libc "i686-linux-gnu")))
1359        ("cross-libc" ,(cross-libc "i686-linux-gnu")) ; header files
1360        ("cross-libc-static" ,(cross-libc "i686-linux-gnu") "static")))
1361     (home-page "https://xenproject.org/")
1362     (synopsis "Xen Virtual Machine Monitor")
1363     (description "This package provides the Xen Virtual Machine Monitor
1364 which is a hypervisor.")
1365     ;; TODO: Some files are licensed differently.  List those.
1366     (license license:gpl2)
1367     (supported-systems '("i686-linux" "x86_64-linux" "armhf-linux"))))
1368
1369 (define-public osinfo-db-tools
1370   (package
1371     (name "osinfo-db-tools")
1372     (version "1.7.0")
1373     (source (origin
1374               (method url-fetch)
1375               (uri (string-append "https://releases.pagure.org/libosinfo/osinfo-db-tools-"
1376                                   version ".tar.xz"))
1377
1378               (sha256
1379                (base32
1380                 "08x8mrafphyll0d35xdc143rip3ahrz6bmzhc85nwhq7yk2vxpab"))))
1381     (build-system meson-build-system)
1382     (inputs
1383      `(("libsoup" ,libsoup)
1384        ("libxml2" ,libxml2)
1385        ("libxslt" ,libxslt)
1386        ("json-glib" ,json-glib)
1387        ("libarchive" ,libarchive)))
1388     (native-inputs
1389      `(("perl" ,perl)
1390        ("gobject-introspection" ,gobject-introspection)
1391        ("gettext" ,gettext-minimal)
1392        ("pkg-config" ,pkg-config)
1393        ;; Tests
1394        ("python" ,python)
1395        ("pytest" ,python-pytest)
1396        ("requests" ,python-requests)))
1397     (home-page "https://gitlab.com/libosinfo/osinfo-db-tools")
1398     (synopsis "Tools for managing the osinfo database")
1399     (description "This package contains a set of tools to assist
1400 administrators and developers in managing the database.")
1401     (license license:lgpl2.0+)))
1402
1403 (define-public osinfo-db
1404   (package
1405     (name "osinfo-db")
1406     (version "20200203")
1407     (source (origin
1408               (method url-fetch)
1409               (uri (string-append "https://releases.pagure.org/libosinfo/osinfo-db-"
1410                                   version ".tar.xz"))
1411               (sha256
1412                (base32
1413                 "1zjq1dhlci00j17dij7s3l30hybzmaykpk5b6bd5xbllp745njn5"))))
1414     (build-system trivial-build-system)
1415     (arguments
1416      `(#:modules ((guix build utils))
1417        #:builder
1418        (begin
1419          (use-modules (guix build utils))
1420          (let* ((out (assoc-ref %outputs "out"))
1421                 (osinfo-dir (string-append out "/share/osinfo"))
1422                 (source (assoc-ref %build-inputs "source"))
1423                 (osinfo-db-import
1424                  (string-append (assoc-ref %build-inputs "osinfo-db-tools")
1425                                 "/bin/osinfo-db-import")))
1426            (mkdir-p osinfo-dir)
1427            (invoke osinfo-db-import "--dir" osinfo-dir source)
1428            #t))))
1429     (native-inputs
1430      `(("intltool" ,intltool)
1431        ("osinfo-db-tools" ,osinfo-db-tools)))
1432     (home-page "https://gitlab.com/libosinfo/osinfo-db")
1433     (synopsis "Database of information about operating systems")
1434     (description "Osinfo-db provides the database files for use with the
1435 libosinfo library.  It provides information about guest operating systems for
1436 use with virtualization provisioning tools")
1437     (license license:lgpl2.0+)))