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 Mark H Weaver <mhw@netris.org>
   4 ;;; Copyright © 2016, 2017 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 Rutger Helling <rhelling@mykolab.com>
   9 ;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
  10 ;;; Copyright © 2018 Danny Milosavljevic <dannym@scratchpost.org>
  11 ;;; Copyright © 2018 Sou Bunnbu <iyzsong@member.fsf.org>
  12 ;;;
  13 ;;; This file is part of GNU Guix.
  14 ;;;
  15 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  16 ;;; under the terms of the GNU General Public License as published by
  17 ;;; the Free Software Foundation; either version 3 of the License, or (at
  18 ;;; your option) any later version.
  19 ;;;
  20 ;;; GNU Guix is distributed in the hope that it will be useful, but
  21 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;;; GNU General Public License for more details.
  24 ;;;
  25 ;;; You should have received a copy of the GNU General Public License
  26 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  27
  28 (define-module (gnu packages virtualization)
  29   #:use-module (gnu packages)
  30   #:use-module (gnu packages admin)
  31   #:use-module (gnu packages attr)
  32   #:use-module (gnu packages autotools)
  33   #:use-module (gnu packages check)
  34   #:use-module (gnu packages compression)
  35   #:use-module (gnu packages curl)
  36   #:use-module (gnu packages cyrus-sasl)
  37   #:use-module (gnu packages disk)
  38   #:use-module (gnu packages dns)
  39   #:use-module (gnu packages docbook)
  40   #:use-module (gnu packages documentation)
  41   #:use-module (gnu packages fontutils)
  42   #:use-module (gnu packages gettext)
  43   #:use-module (gnu packages gl)
  44   #:use-module (gnu packages glib)
  45   #:use-module (gnu packages gnome)
  46   #:use-module (gnu packages golang)
  47   #:use-module (gnu packages gtk)
  48   #:use-module (gnu packages image)
  49   #:use-module (gnu packages libusb)
  50   #:use-module (gnu packages linux)
  51   #:use-module (gnu packages ncurses)
  52   #:use-module (gnu packages networking)
  53   #:use-module (gnu packages perl)
  54   #:use-module (gnu packages pkg-config)
  55   #:use-module (gnu packages polkit)
  56   #:use-module (gnu packages protobuf)
  57   #:use-module (gnu packages python)
  58   #:use-module (gnu packages python-web)
  59   #:use-module (gnu packages pulseaudio)
  60   #:use-module (gnu packages selinux)
  61   #:use-module (gnu packages sdl)
  62   #:use-module (gnu packages spice)
  63   #:use-module (gnu packages texinfo)
  64   #:use-module (gnu packages tls)
  65   #:use-module (gnu packages web)
  66   #:use-module (gnu packages xdisorg)
  67   #:use-module (gnu packages xml)
  68   #:use-module (guix build-system gnu)
  69   #:use-module (guix build-system go)
  70   #:use-module (guix build-system python)
  71   #:use-module (guix download)
  72   #:use-module ((guix licenses) #:select (gpl2 gpl2+ gpl3+ lgpl2.1 lgpl2.1+
  73                                                asl2.0))
  74   #:use-module (guix packages)
  75   #:use-module (guix utils)
  76   #:use-module (srfi srfi-1))
  77
  78 (define (qemu-patch commit file-name sha256)
  79   "Return an origin for COMMIT."
  80   (origin
  81     (method url-fetch)
  82     (uri (string-append
  83           "http://git.qemu.org/?p=qemu.git;a=commitdiff_plain;h="
  84           commit))
  85     (sha256 sha256)
  86     (file-name file-name)))
  87
  88 (define-public qemu
  89   (package
  90     (name "qemu")
  91     (version "2.12.0")
  92     (source (origin
  93              (method url-fetch)
  94              (uri (string-append "https://download.qemu.org/qemu-"
  95                                  version ".tar.xz"))
  96              (sha256
  97               (base32
  98                "1z66spkm1prvhbq7h5mfnp0i6mmamsb938fqmdfvyrgzc7rh34z6"))))
  99     (build-system gnu-build-system)
 100     (arguments
 101      '(;; Running tests in parallel can occasionally lead to failures, like:
 102        ;; boot_sector_test: assertion failed (signature == SIGNATURE): (0x00000000 == 0x0000dead)
 103        #:parallel-tests? #f
 104        #:configure-flags (list "--enable-usb-redir" "--enable-opengl"
 105                                (string-append "--smbd="
 106                                               (assoc-ref %outputs "out")
 107                                               "/libexec/samba-wrapper")
 108                                "--audio-drv-list=alsa,pa,sdl")
 109        #:phases
 110        (modify-phases %standard-phases
 111          (replace 'configure
 112            (lambda* (#:key inputs outputs (configure-flags '())
 113                            #:allow-other-keys)
 114              ;; The `configure' script doesn't understand some of the
 115              ;; GNU options.  Thus, add a new phase that's compatible.
 116              (let ((out (assoc-ref outputs "out")))
 117                (setenv "SHELL" (which "bash"))
 118
 119                ;; While we're at it, patch for tests.
 120                (substitute* "tests/libqtest.c"
 121                  (("/bin/sh") (which "sh")))
 122
 123                ;; The binaries need to be linked against -lrt.
 124                (setenv "LDFLAGS" "-lrt")
 125                (zero?
 126                 (apply system*
 127                        `("./configure"
 128                          ,(string-append "--cc=" (which "gcc"))
 129                          ;; Some architectures insist on using HOST_CC
 130                          ,(string-append "--host-cc=" (which "gcc"))
 131                          "--disable-debug-info" ; save build space
 132                          "--enable-virtfs"      ; just to be sure
 133                          ,(string-append "--prefix=" out)
 134                          ,(string-append "--sysconfdir=/etc")
 135                          ,@configure-flags))))))
 136          (add-after 'install 'install-info
 137            (lambda* (#:key inputs outputs #:allow-other-keys)
 138              ;; Install the Info manual, unless Texinfo is missing.
 139              (or (not (assoc-ref inputs "texinfo"))
 140                  (let ((out (assoc-ref outputs "out")))
 141                    (and (zero? (system* "make" "info"))
 142                         (let ((infodir (string-append out "/share/info")))
 143                           (for-each (lambda (info)
 144                                       (install-file info infodir))
 145                                     (find-files "." "\\.info"))
 146                           #t))))))
 147          ;; Create a wrapper for Samba. This allows QEMU to use Samba without
 148          ;; pulling it in as an input. Note that you need to explicitly install
 149          ;; Samba in your Guix profile for Samba support.
 150          (add-after 'install-info 'create-samba-wrapper
 151            (lambda* (#:key inputs outputs #:allow-other-keys)
 152              (let* ((out    (assoc-ref %outputs "out"))
 153                     (libexec (string-append out "/libexec")))
 154                (call-with-output-file "samba-wrapper"
 155                  (lambda (port)
 156                    (format port "#!/bin/sh
 157 exec smbd $@")))
 158                (chmod "samba-wrapper" #o755)
 159                (install-file "samba-wrapper" libexec))
 160              #t))
 161          (add-before 'check 'make-gtester-verbose
 162            (lambda _
 163              ;; Make GTester verbose to facilitate investigation upon failure.
 164              (setenv "V" "1") #t))
 165          (add-before 'check 'disable-test-qga
 166            (lambda _
 167              (substitute* "tests/Makefile.include"
 168                ;; Comment out the test-qga test, which needs /sys and
 169                ;; fails within the build environment.
 170                (("check-unit-.* tests/test-qga" all)
 171                 (string-append "# " all)))
 172              #t)))))
 173     (inputs                                       ; TODO: Add optional inputs.
 174      `(("alsa-lib" ,alsa-lib)
 175        ("attr" ,attr)
 176        ("glib" ,glib)
 177        ("gtk+" ,gtk+)
 178        ("libaio" ,libaio)
 179        ("libattr" ,attr)
 180        ("libcap" ,libcap)           ; virtfs support requires libcap & libattr
 181        ("libdrm" ,libdrm)
 182        ("libepoxy" ,libepoxy)
 183        ("libjpeg" ,libjpeg-turbo)
 184        ("libpng" ,libpng)
 185        ("libseccomp" ,libseccomp)
 186        ("libusb" ,libusb)                         ;USB pass-through support
 187        ("mesa" ,mesa)
 188        ("ncurses" ,ncurses)
 189        ;; ("pciutils" ,pciutils)
 190        ("pixman" ,pixman)
 191        ("pulseaudio" ,pulseaudio)
 192        ("sdl2" ,sdl2)
 193        ("spice" ,spice)
 194        ("usbredir" ,usbredir)
 195        ("util-linux" ,util-linux)
 196        ;; ("vde2" ,vde2)
 197        ("virglrenderer" ,virglrenderer)
 198        ("zlib" ,zlib)))
 199     (native-inputs `(("gettext" ,gettext-minimal)
 200                      ("glib:bin" ,glib "bin") ; gtester, etc.
 201                      ("perl" ,perl)
 202                      ("pkg-config" ,pkg-config)
 203                      ("python-wrapper" ,python-wrapper)
 204                      ("texinfo" ,texinfo)))
 205     (home-page "https://www.qemu.org")
 206     (synopsis "Machine emulator and virtualizer")
 207     (description
 208      "QEMU is a generic machine emulator and virtualizer.
 209
 210 When used as a machine emulator, QEMU can run OSes and programs made for one
 211 machine (e.g. an ARM board) on a different machine---e.g., your own PC.  By
 212 using dynamic translation, it achieves very good performance.
 213
 214 When used as a virtualizer, QEMU achieves near native performances by
 215 executing the guest code directly on the host CPU.  QEMU supports
 216 virtualization when executing under the Xen hypervisor or using
 217 the KVM kernel module in Linux.  When using KVM, QEMU can virtualize x86,
 218 server and embedded PowerPC, and S390 guests.")
 219
 220     ;; Many files are GPLv2+, but some are GPLv2-only---e.g., `memory.c'.
 221     (license gpl2)
 222
 223     ;; Several tests fail on MIPS; see <http://hydra.gnu.org/build/117914>.
 224     (supported-systems (delete "mips64el-linux" %supported-systems))))
 225
 226 (define-public qemu-minimal
 227   ;; QEMU without GUI support.
 228   (package (inherit qemu)
 229     (name "qemu-minimal")
 230     (synopsis "Machine emulator and virtualizer (without GUI)")
 231     (arguments
 232      (substitute-keyword-arguments (package-arguments qemu)
 233        ((#:configure-flags _ '(list))
 234         ;; Restrict to the targets supported by Guix.
 235         ''("--target-list=i386-softmmu,x86_64-softmmu,mips64el-softmmu,arm-softmmu,aarch64-softmmu"))))
 236
 237     ;; Remove dependencies on optional libraries, notably GUI libraries.
 238     (native-inputs (fold alist-delete (package-native-inputs qemu)
 239                   '("gettext")))
 240     (inputs (fold alist-delete (package-inputs qemu)
 241                   '("libusb" "mesa" "sdl2" "spice" "virglrenderer" "gtk+"
 242                     "usbredir" "libdrm" "libepoxy" "pulseaudio")))))
 243
 244 ;; The GRUB test suite fails with later versions of Qemu, so we
 245 ;; keep it at 2.10 for now.  See
 246 ;; <https://lists.gnu.org/archive/html/bug-grub/2018-02/msg00004.html>.
 247 ;; This package is hidden since we do not backport updates to it.
 248 (define-public qemu-minimal-2.10
 249   (hidden-package
 250    (package
 251     (inherit qemu-minimal)
 252     (version "2.10.2")
 253     (source (origin
 254              (method url-fetch)
 255              (uri (string-append "https://download.qemu.org/qemu-"
 256                                  version ".tar.xz"))
 257              (sha256
 258               (base32
 259                "17w21spvaxaidi2am5lpsln8yjpyp2zi3s3gc6nsxj5arlgamzgw"))))
 260     ;; qemu-minimal-2.10 needs Python 2. Remove below once no longer necessary.
 261     (native-inputs `(("python-2" ,python-2)
 262                      ,@(fold alist-delete (package-native-inputs qemu)
 263                              '("python-wrapper")))))))
 264
 265 (define-public libosinfo
 266   (package
 267     (name "libosinfo")
 268     (version "1.0.0")
 269     (source
 270      (origin
 271        (method url-fetch)
 272        (uri (string-append "https://releases.pagure.org/libosinfo/libosinfo-"
 273                            version ".tar.gz"))
 274        (sha256
 275         (base32
 276          "0srrs2m6irqd4f867g8ls6jp2dq3ql0l9d0fh80d55sivvn2bd7p"))))
 277     (build-system gnu-build-system)
 278     (arguments
 279      `(#:configure-flags
 280        (list (string-append "--with-usb-ids-path="
 281                             (assoc-ref %build-inputs "usb.ids"))
 282              (string-append "--with-pci-ids-path="
 283                             (assoc-ref %build-inputs "pci.ids")))
 284        #:phases
 285        (modify-phases %standard-phases
 286          ;; This odd test fails for unknown reasons.
 287          (add-after 'unpack 'disable-broken-test
 288            (lambda _
 289              (substitute* "test/Makefile.in"
 290                (("test-isodetect\\$\\(EXEEXT\\)") ""))
 291              #t)))))
 292     (inputs
 293      `(("libsoup" ,libsoup)
 294        ("libxml2" ,libxml2)
 295        ("libxslt" ,libxslt)
 296        ("gobject-introspection" ,gobject-introspection)))
 297     (native-inputs
 298      `(("check" ,check)
 299        ("glib" ,glib "bin")  ; glib-mkenums, etc.
 300        ("gtk-doc" ,gtk-doc)
 301        ("vala" ,vala)
 302        ("intltool" ,intltool)
 303        ("pkg-config" ,pkg-config)
 304        ("pci.ids"
 305         ,(origin
 306            (method url-fetch)
 307            (uri "https://github.com/pciutils/pciids/raw/ad02084f0bc143e3c15e31a6152a3dfb1d7a3156/pci.ids")
 308            (sha256
 309             (base32
 310              "0kfhpj5rnh24hz2714qhfmxk281vwc2w50sm73ggw5d15af7zfsw"))))
 311        ("usb.ids"
 312         ,(origin
 313            (method url-fetch)
 314            (uri "https://svn.code.sf.net/p/linux-usb/repo/trunk/htdocs/usb.ids?r=2681")
 315            (file-name "usb.ids")
 316            (sha256
 317             (base32
 318              "1m6yhvz5k8aqzxgk7xj3jkk8frl1hbv0h3vgj4wbnvnx79qnvz3r"))))))
 319     (home-page "https://libosinfo.org/")
 320     (synopsis "Operating system information database")
 321     (description "libosinfo is a GObject based library API for managing
 322 information about operating systems, hypervisors and the (virtual) hardware
 323 devices they can support.  It includes a database containing device metadata
 324 and provides APIs to match/identify optimal devices for deploying an operating
 325 system on a hypervisor.  Via GObject Introspection, the API is available in
 326 all common programming languages.  Vala bindings are also provided.")
 327     ;; The library files are released under LGPLv2.1 or later; the source
 328     ;; files in the "tools" directory are released under GPLv2+.
 329     (license (list lgpl2.1+ gpl2+))))
 330
 331 (define-public lxc
 332   (package
 333     (name "lxc")
 334     (version "2.1.1")
 335     (source (origin
 336               (method url-fetch)
 337               (uri (string-append
 338                     "https://linuxcontainers.org/downloads/lxc/lxc-"
 339                     version ".tar.gz"))
 340               (sha256
 341                (base32
 342                 "1xpghrinxhm2072fwmn42pxhjwh7qx6cbsipw4s6g38a8mkklrk8"))))
 343     (build-system gnu-build-system)
 344     (native-inputs
 345      `(("pkg-config" ,pkg-config)))
 346     (inputs
 347      `(("gnutls" ,gnutls)
 348        ("libcap" ,libcap)
 349        ("libseccomp" ,libseccomp)
 350        ("libselinux" ,libselinux)))
 351     (arguments
 352      '(#:configure-flags
 353        '("--sysconfdir=/etc"
 354          "--localstatedir=/var")
 355        #:phases
 356        (modify-phases %standard-phases
 357          (replace 'install
 358            (lambda* (#:key outputs #:allow-other-keys)
 359              (let* ((out         (assoc-ref outputs "out"))
 360                     (bashcompdir (string-append out "/etc/bash_completion.d")))
 361                (zero? (system*
 362                        "make" "install"
 363                        (string-append "bashcompdir=" bashcompdir)
 364                        ;; Don't install files into /var and /etc.
 365                        "LXCPATH=/tmp/var/lib/lxc"
 366                        "localstatedir=/tmp/var"
 367                        "sysconfdir=/tmp/etc"
 368                        "sysconfigdir=/tmp/etc/default"))))))))
 369     (synopsis "Linux container tools")
 370     (home-page "https://linuxcontainers.org/")
 371     (description
 372      "LXC is a userspace interface for the Linux kernel containment features.
 373 Through a powerful API and simple tools, it lets Linux users easily create and
 374 manage system or application containers.")
 375     (license lgpl2.1+)))
 376
 377 (define-public libvirt
 378   (package
 379     (name "libvirt")
 380     (version "4.2.0")
 381     (source (origin
 382               (method url-fetch)
 383               (uri (string-append "https://libvirt.org/sources/libvirt-"
 384                                   version ".tar.xz"))
 385               (sha256
 386                (base32
 387                 "0nq1iz5iic466qahp0i8dlvyd6li0b0pdrvvrz9286l12x2fm61s"))))
 388     (build-system gnu-build-system)
 389     (arguments
 390      `(;; FAIL: virshtest
 391        ;; FAIL: virfirewalltest
 392        ;; FAIL: virkmodtest
 393        ;; FAIL: virnetsockettest
 394        ;; FAIL: networkxml2firewalltest
 395        ;; FAIL: nwfilterebiptablestest
 396        ;; FAIL: nwfilterxml2firewalltest
 397        ;; Time-out while running commandtest.
 398        #:tests? #f
 399        #:configure-flags
 400        (list "--with-polkit"
 401              "--sysconfdir=/etc"
 402              "--localstatedir=/var")
 403        #:phases
 404        (modify-phases %standard-phases
 405          (add-after 'unpack 'fix-tests
 406            (lambda _
 407              (substitute* '("tests/commandtest.c"
 408                             "gnulib/tests/test-posix_spawn1.c"
 409                             "gnulib/tests/test-posix_spawn2.c")
 410                (("/bin/sh") (which "sh")))
 411              #t))
 412          (replace 'install
 413            ;; Since the sysconfdir and localstatedir should be /etc and /var
 414            ;; at runtime, we must prevent writing to them at installation
 415            ;; time.
 416            (lambda _
 417              (invoke "make" "install"
 418                             "sysconfdir=/tmp/etc"
 419                             "localstatedir=/tmp/var")))
 420          (add-after 'install 'wrap-libvirtd
 421            (lambda* (#:key inputs outputs #:allow-other-keys)
 422              (let ((out (assoc-ref outputs "out")))
 423                (wrap-program (string-append out "/sbin/libvirtd")
 424                  `("PATH" = (,(string-append (assoc-ref inputs "iproute")
 425                                              "/sbin")
 426                              ,(string-append (assoc-ref inputs "qemu")
 427                                              "/bin"))))
 428                #t))))))
 429     (inputs
 430      `(("libxml2" ,libxml2)
 431        ("gnutls" ,gnutls)
 432        ("dbus" ,dbus)
 433        ("qemu" ,qemu)
 434        ("libpcap" ,libpcap)
 435        ("libnl" ,libnl)
 436        ("libuuid" ,util-linux)
 437        ("lvm2" ,lvm2) ; for libdevmapper
 438        ("curl" ,curl)
 439        ("openssl" ,openssl)
 440        ("cyrus-sasl" ,cyrus-sasl)
 441        ("libyajl" ,libyajl)
 442        ("audit" ,audit)
 443        ("dmidecode" ,dmidecode)
 444        ("dnsmasq" ,dnsmasq)
 445        ("ebtables" ,ebtables)
 446        ("iproute" ,iproute)
 447        ("iptables" ,iptables)))
 448     (native-inputs
 449      `(("xsltproc" ,libxslt)
 450        ("perl" ,perl)
 451        ("pkg-config" ,pkg-config)
 452        ("polkit" ,polkit)
 453        ("python" ,python)))
 454     (home-page "https://libvirt.org")
 455     (synopsis "Simple API for virtualization")
 456     (description "Libvirt is a C toolkit to interact with the virtualization
 457 capabilities of recent versions of Linux.  The library aims at providing long
 458 term stable C API initially for the Xen paravirtualization but should be able
 459 to integrate other virtualization mechanisms if needed.")
 460     (license lgpl2.1+)))
 461
 462 (define-public libvirt-glib
 463   (package
 464     (name "libvirt-glib")
 465     (version "1.0.0")
 466     (source (origin
 467               (method url-fetch)
 468               (uri (string-append "ftp://libvirt.org/libvirt/glib/"
 469                                   "libvirt-glib-" version ".tar.gz"))
 470               (sha256
 471                (base32
 472                 "0iwa5sdbii52pjpdm5j37f67sdmf0kpcky4liwhy1nf43k85i4fa"))))
 473     (build-system gnu-build-system)
 474     (arguments
 475      `(#:phases
 476        (modify-phases %standard-phases
 477          (add-after 'unpack 'fix-tests
 478            (lambda _
 479              (substitute* "tests/test-events.c"
 480                (("/bin/true") (which "true")))
 481              #t)))))
 482     (inputs
 483      `(("libxml2" ,libxml2)
 484        ("libvirt" ,libvirt)
 485        ("gobject-introspection" ,gobject-introspection)
 486        ("glib" ,glib)
 487        ("openssl" ,openssl)
 488        ("cyrus-sasl" ,cyrus-sasl)
 489        ("lvm2" ,lvm2) ; for libdevmapper
 490        ("libyajl" ,libyajl)))
 491     (native-inputs
 492      `(("pkg-config" ,pkg-config)
 493        ("intltool" ,intltool)
 494        ("glib" ,glib "bin")
 495        ("vala" ,vala)))
 496     (home-page "https://libvirt.org")
 497     (synopsis "GLib wrapper around libvirt")
 498     (description "libvirt-glib wraps the libvirt library to provide a
 499 high-level object-oriented API better suited for glib-based applications, via
 500 three libraries:
 501
 502 @enumerate
 503 @item libvirt-glib - GLib main loop integration & misc helper APIs
 504 @item libvirt-gconfig - GObjects for manipulating libvirt XML documents
 505 @item libvirt-gobject - GObjects for managing libvirt objects
 506 @end enumerate
 507 ")
 508     (license lgpl2.1+)))
 509
 510 (define-public python-libvirt
 511   (package
 512     (name "python-libvirt")
 513     (version "4.1.0")
 514     (source (origin
 515               (method url-fetch)
 516               (uri (pypi-uri "libvirt-python" version))
 517               (sha256
 518                (base32
 519                 "1ixqhxjkczl8vk9wjx4cknw4374cw5nnsacbd2s755kpd0ys7hny"))))
 520     (build-system python-build-system)
 521     (arguments
 522      `(#:phases
 523        (modify-phases %standard-phases
 524          (add-after 'unpack 'patch-nosetests-path
 525            (lambda* (#:key inputs #:allow-other-keys)
 526              (substitute* "setup.py"
 527                (("\"/usr/bin/nosetests\"")
 528                 (string-append "\"" (which "nosetests") "\""))
 529                (("self\\.spawn\\(\\[sys\\.executable, nose\\]\\)")
 530                 (format #f "self.spawn([\"~a\", nose])" (which "bash"))))
 531              #t)))))
 532     (inputs
 533      `(("libvirt" ,libvirt)))
 534     (propagated-inputs
 535      `(("python-lxml" ,python-lxml)))
 536     (native-inputs
 537      `(("pkg-config" ,pkg-config)
 538        ("python-nose" ,python-nose)))
 539     (home-page "https://libvirt.org")
 540     (synopsis "Python bindings to libvirt")
 541     (description "This package provides Python bindings to the libvirt
 542 virtualization library.")
 543     (license lgpl2.1+)))
 544
 545 (define-public python2-libvirt
 546   (package-with-python2 python-libvirt))
 547
 548 (define-public virt-manager
 549   (package
 550     (name "virt-manager")
 551     (version "1.5.1")
 552     (source (origin
 553               (method url-fetch)
 554               (uri (string-append "https://virt-manager.org/download/sources"
 555                                   "/virt-manager/virt-manager-"
 556                                   version ".tar.gz"))
 557               (sha256
 558                (base32
 559                 "1ardmd4sxdmd57y7qpka44gf09c1yq2g0xs074d3k1h925crv27f"))))
 560     (build-system python-build-system)
 561     (arguments
 562      `(#:python ,python-2
 563        #:use-setuptools? #f ; Uses custom distutils 'install' command.
 564        ;; Some of the tests seem to require network access to install virtual
 565        ;; machines.
 566        #:tests? #f
 567        #:imported-modules ((guix build glib-or-gtk-build-system)
 568                            ,@%python-build-system-modules)
 569        #:modules ((ice-9 match)
 570                   (srfi srfi-26)
 571                   (guix build python-build-system)
 572                   ((guix build glib-or-gtk-build-system) #:prefix glib-or-gtk:)
 573                   (guix build utils))
 574        #:phases
 575        (modify-phases %standard-phases
 576          (add-after 'unpack 'fix-setup
 577            (lambda* (#:key outputs #:allow-other-keys)
 578              (substitute* "virtcli/cliconfig.py"
 579                (("/usr") (assoc-ref outputs "out")))
 580              #t))
 581          (add-after 'unpack 'fix-default-uri
 582            (lambda* (#:key inputs #:allow-other-keys)
 583              ;; xen is not available for now - so only patch qemu
 584              (substitute* "virtManager/connect.py"
 585                (("/usr(/bin/qemu-system)" _ suffix)
 586                 (string-append (assoc-ref inputs "qemu") suffix)))
 587              #t))
 588          (add-before 'wrap 'wrap-with-GI_TYPELIB_PATH
 589            (lambda* (#:key inputs outputs #:allow-other-keys)
 590              (let* ((bin       (string-append (assoc-ref outputs "out") "/bin"))
 591                     (bin-files (find-files bin ".*"))
 592                     (paths     (map (match-lambda
 593                                       ((output . directory)
 594                                        (let* ((girepodir (string-append
 595                                                           directory
 596                                                           "/lib/girepository-1.0")))
 597                                          (if (file-exists? girepodir)
 598                                              girepodir #f))))
 599                                     inputs)))
 600                (for-each (lambda (file)
 601                            (format #t "wrapping ~a\n" file)
 602                            (wrap-program file
 603                              `("GI_TYPELIB_PATH" ":" prefix
 604                                ,(filter identity paths))))
 605                          bin-files))
 606              #t))
 607          (add-after 'install 'glib-or-gtk-compile-schemas
 608            (assoc-ref glib-or-gtk:%standard-phases 'glib-or-gtk-compile-schemas))
 609          (add-after 'install 'glib-or-gtk-wrap
 610            (assoc-ref glib-or-gtk:%standard-phases 'glib-or-gtk-wrap)))))
 611     (inputs
 612      `(("dconf" ,dconf)
 613        ("gtk+" ,gtk+)
 614        ("gtk-vnc" ,gtk-vnc)
 615        ("libvirt" ,libvirt)
 616        ("libvirt-glib" ,libvirt-glib)
 617        ("libosinfo" ,libosinfo)
 618        ("vte" ,vte)
 619        ("gobject-introspection" ,gobject-introspection)
 620        ("python2-libvirt" ,python2-libvirt)
 621        ("python2-requests" ,python2-requests)
 622        ("python2-ipaddr" ,python2-ipaddr)
 623        ("python2-pycairo" ,python2-pycairo)
 624        ("python2-pygobject" ,python2-pygobject)
 625        ("python2-libxml2" ,python2-libxml2)
 626        ("spice-gtk" ,spice-gtk)))
 627     ;; virt-manager searches for qemu-img or kvm-img in the PATH.
 628     (propagated-inputs
 629      `(("qemu" ,qemu)))
 630     (native-inputs
 631      `(("glib" ,glib "bin")             ; glib-compile-schemas.
 632        ("gtk+" ,gtk+ "bin")             ; gtk-update-icon-cache
 633        ("perl" ,perl)                   ; pod2man
 634        ("intltool" ,intltool)))
 635     (home-page "https://virt-manager.org/")
 636     (synopsis "Manage virtual machines")
 637     (description
 638      "The virt-manager application is a desktop user interface for managing
 639 virtual machines through libvirt.  It primarily targets KVM VMs, but also
 640 manages Xen and LXC (Linux containers).  It presents a summary view of running
 641 domains, their live performance and resource utilization statistics.")
 642     (license gpl2+)))
 643
 644 (define-public criu
 645   (package
 646     (name "criu")
 647     (version "3.7")
 648     (source (origin
 649               (method url-fetch)
 650               (uri (string-append "http://download.openvz.org/criu/criu-"
 651                                   version ".tar.bz2"))
 652               (sha256
 653                (base32
 654                 "0qrpz7pvnks34v7d8lb73flz3mb7qwnib94pdwaxh0mskn8470fq"))))
 655     (build-system gnu-build-system)
 656     (arguments
 657      `(#:test-target "test"
 658        #:tests? #f ; tests require mounting as root
 659        #:make-flags
 660        (list (string-append "PREFIX=" (assoc-ref %outputs "out"))
 661              (string-append "LIBDIR=" (assoc-ref %outputs "out")
 662                             "/lib"))
 663        #:phases
 664        (modify-phases %standard-phases
 665          (replace 'configure
 666            (lambda* (#:key inputs #:allow-other-keys)
 667              ;; The includes for libnl are located in a sub-directory.
 668              (setenv "C_INCLUDE_PATH"
 669                      (string-append (assoc-ref inputs "libnl")
 670                                     "/include/libnl3:"
 671                                     (getenv "C_INCLUDE_PATH")))
 672              ;; Prevent xmlto from failing the install phase.
 673              (substitute* "Documentation/Makefile"
 674                (("XMLTO.*:=.*")
 675                 (string-append "XMLTO:="
 676                                (assoc-ref inputs "xmlto")
 677                                "/bin/xmlto"
 678                                " --skip-validation "
 679                                " -x "
 680                                (assoc-ref inputs "docbook-xsl")
 681                                "/xml/xsl/docbook-xsl-"
 682                                ,(package-version docbook-xsl)
 683                                "/manpages/docbook.xsl")))
 684              #t))
 685          (add-before 'build 'fix-symlink
 686            (lambda* (#:key inputs #:allow-other-keys)
 687              ;; The file 'images/google/protobuf/descriptor.proto' points to
 688              ;; /usr/include/..., which obviously does not exist.
 689              (let* ((file "google/protobuf/descriptor.proto")
 690                     (target (string-append "images/" file))
 691                     (source (string-append (assoc-ref inputs "protobuf")
 692                                            "/include/" file)))
 693                (delete-file target)
 694                (symlink source target)
 695                #t)))
 696          (add-after 'install 'wrap
 697            (lambda* (#:key inputs outputs #:allow-other-keys)
 698              ;; Make sure 'crit' runs with the correct PYTHONPATH.
 699              (let* ((out (assoc-ref outputs "out"))
 700                     (path (string-append out
 701                                          "/lib/python"
 702                                          (string-take (string-take-right
 703                                                        (assoc-ref inputs "python") 5) 3)
 704                                          "/site-packages:"
 705                                          (getenv "PYTHONPATH"))))
 706                (wrap-program (string-append out "/bin/crit")
 707                  `("PYTHONPATH" ":" prefix (,path))))
 708              #t)))))
 709     (inputs
 710      `(("protobuf" ,protobuf)
 711        ("python" ,python-2)
 712        ("python2-protobuf" ,python2-protobuf)
 713        ("python2-ipaddr" ,python2-ipaddr)
 714        ("iproute" ,iproute)
 715        ("libaio" ,libaio)
 716        ("libcap" ,libcap)
 717        ("libnet" ,libnet)
 718        ("libnl" ,libnl)))
 719     (native-inputs
 720      `(("pkg-config" ,pkg-config)
 721        ("perl" ,perl)
 722        ("protobuf-c" ,protobuf-c)
 723        ("asciidoc" ,asciidoc)
 724        ("xmlto" ,xmlto)
 725        ("docbook-xml" ,docbook-xml)
 726        ("docbook-xsl" ,docbook-xsl)))
 727     (home-page "https://criu.org")
 728     (synopsis "Checkpoint and restore in user space")
 729     (description "Using this tool, you can freeze a running application (or
 730 part of it) and checkpoint it to a hard drive as a collection of files.  You
 731 can then use the files to restore and run the application from the point it
 732 was frozen at.  The distinctive feature of the CRIU project is that it is
 733 mainly implemented in user space.")
 734     ;; The project is licensed under GPLv2; files in the lib/ directory are
 735     ;; LGPLv2.1.
 736     (license (list gpl2 lgpl2.1))))
 737
 738 (define-public qmpbackup
 739   (package
 740     (name "qmpbackup")
 741     (version "0.2")
 742     (source (origin
 743               (method url-fetch)
 744               (uri (string-append "https://github.com/abbbi/qmpbackup/archive/"
 745                                   version ".tar.gz"))
 746               (sha256
 747                (base32
 748                 "10k9mnb1yrg4gw1rvz4kw4dxc4aajl8gnjrpm3axqkg63qmxj3qn"))
 749               (file-name (string-append name "-" version ".tar.gz"))))
 750     (build-system python-build-system)
 751     (arguments
 752      `(#:python ,python-2))
 753     (home-page "https://github.com/abbbi/qmpbackup")
 754     (synopsis "Backup and restore QEMU machines")
 755     (description "qmpbackup is designed to create and restore full and
 756 incremental backups of running QEMU virtual machines via QMP, the QEMU
 757 Machine Protocol.")
 758     (license gpl3+)))
 759
 760 (define-public lookingglass
 761   (package
 762    (name "lookingglass")
 763    (version "a10")
 764    (source
 765     (origin
 766      (method url-fetch)
 767      (uri (string-append "https://github.com/gnif/LookingGlass/archive/"
 768                          version ".tar.gz"))
 769      (file-name (string-append name "-" version))
 770      (sha256
 771       (base32
 772        "0zlxg9ibzr0a598wr5nl1pb4l7mzsqn8ip72v4frph0vwsm5il6c"))))
 773    (build-system gnu-build-system)
 774    (inputs `(("fontconfig" ,fontconfig)
 775              ("glu" ,glu)
 776              ("mesa" ,mesa)
 777              ("openssl" ,openssl)
 778              ("sdl2" ,sdl2)
 779              ("sdl2-ttf" ,sdl2-ttf)
 780              ("spice-protocol" ,spice-protocol)))
 781    (native-inputs `(("pkg-config" ,pkg-config)))
 782    (arguments
 783     `(#:tests? #f ;; No tests are available.
 784       #:phases (modify-phases %standard-phases
 785                  (replace 'configure
 786                    (lambda* (#:key outputs #:allow-other-keys)
 787                      (chdir "client")
 788                      #t))
 789                  (replace 'install
 790                    (lambda* (#:key outputs #:allow-other-keys)
 791                      (install-file "bin/looking-glass-client"
 792                                    (string-append (assoc-ref outputs "out")
 793                                                   "/bin"))
 794                      #t)))))
 795    (home-page "https://looking-glass.hostfission.com")
 796    (synopsis "KVM Frame Relay (KVMFR) implementation")
 797    (description "Looking Glass allows the use of a KVM (Kernel-based Virtual
 798 Machine) configured for VGA PCI Pass-through without an attached physical
 799 monitor, keyboard or mouse.  It displays the VM's rendered contents on your main
 800 monitor/GPU.")
 801    ;; This package requires SSE instructions.
 802    (supported-systems '("i686-linux" "x86_64-linux"))
 803    (license gpl2+)))
 804
 805 (define-public runc
 806   (package
 807     (name "runc")
 808     (version "1.0.0-rc5")
 809     (source (origin
 810               (method url-fetch)
 811               (uri (string-append
 812                     "https://github.com/opencontainers/runc/releases/"
 813                     "download/v" version "/runc.tar.xz"))
 814               (sha256
 815                (base32
 816                 "081avdzwnqpk368wbaihlzsypaxpj42d7699h7jgp0fks14x4103"))))
 817     (build-system go-build-system)
 818     (arguments
 819      '(#:import-path "github.com/opencontainers/runc"
 820        #:install-source? #f
 821        ;; XXX: 20/139 tests fail due to missing /var, cgroups and apparmor in
 822        ;; the build environment.
 823        #:tests? #f
 824        #:phases
 825        (modify-phases %standard-phases
 826          (replace 'unpack
 827            (lambda* (#:key source import-path #:allow-other-keys)
 828              ;; Unpack the tarball into 'runc' instead of 'runc-1.0.0-rc5'.
 829              (let ((dest (string-append "src/" import-path)))
 830                (mkdir-p dest)
 831                (invoke "tar" "-C" (string-append "src/" import-path)
 832                        "--strip-components=1"
 833                        "-xvf" source))))
 834          (replace 'build
 835            (lambda* (#:key import-path #:allow-other-keys)
 836              (chdir (string-append "src/" import-path))
 837              ;; XXX: requires 'go-md2man'.
 838              ;; (invoke "make" "man")
 839              (invoke "make")))
 840          ;; (replace 'check
 841          ;;   (lambda _
 842          ;;     (invoke "make" "localunittest")))
 843          (replace 'install
 844            (lambda* (#:key outputs #:allow-other-keys)
 845              (let ((out (assoc-ref outputs "out")))
 846               (invoke "make" "install" "install-bash"
 847                       (string-append "PREFIX=" out))))))))
 848     (native-inputs
 849      `(("pkg-config" ,pkg-config)))
 850     (inputs
 851      `(("libseccomp" ,libseccomp)))
 852     (synopsis "Open container initiative runtime")
 853     (home-page "https://www.opencontainers.org/")
 854     (description
 855      "@command{runc} is a command line client for running applications
 856 packaged according to the
 857 @uref{https://github.com/opencontainers/runtime-spec/blob/master/spec.md, Open
 858 Container Initiative (OCI) format} and is a compliant implementation of the
 859 Open Container Initiative specification.")
 860     (license asl2.0)))