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