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