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