gnu/packages/virtualization.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2016 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 Ricardo Wurmus <rekado@elephly.net>
   6 ;;;
   7 ;;; This file is part of GNU Guix.
   8 ;;;
   9 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  10 ;;; under the terms of the GNU General Public License as published by
  11 ;;; the Free Software Foundation; either version 3 of the License, or (at
  12 ;;; your option) any later version.
  13 ;;;
  14 ;;; GNU Guix is distributed in the hope that it will be useful, but
  15 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;;; GNU General Public License for more details.
  18 ;;;
  19 ;;; You should have received a copy of the GNU General Public License
  20 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 (define-module (gnu packages virtualization)
  23   #:use-module (gnu packages)
  24   #:use-module (gnu packages admin)
  25   #:use-module (gnu packages attr)
  26   #:use-module (gnu packages autotools)
  27   #:use-module (gnu packages check)
  28   #:use-module (gnu packages compression)
  29   #:use-module (gnu packages curl)
  30   #:use-module (gnu packages cyrus-sasl)
  31   #:use-module (gnu packages disk)
  32   #:use-module (gnu packages dns)
  33   #:use-module (gnu packages gl)
  34   #:use-module (gnu packages glib)
  35   #:use-module (gnu packages gnome)
  36   #:use-module (gnu packages gtk)
  37   #:use-module (gnu packages image)
  38   #:use-module (gnu packages libusb)
  39   #:use-module (gnu packages linux)
  40   #:use-module (gnu packages ncurses)
  41   #:use-module (gnu packages perl)
  42   #:use-module (gnu packages pkg-config)
  43   #:use-module (gnu packages polkit)
  44   #:use-module (gnu packages python)
  45   #:use-module (gnu packages sdl)
  46   #:use-module (gnu packages spice)
  47   #:use-module (gnu packages texinfo)
  48   #:use-module (gnu packages tls)
  49   #:use-module (gnu packages web)
  50   #:use-module (gnu packages xdisorg)
  51   #:use-module (gnu packages xml)
  52   #:use-module (guix build-system gnu)
  53   #:use-module (guix build-system python)
  54   #:use-module (guix download)
  55   #:use-module ((guix licenses) #:select (gpl2 gpl2+ lgpl2.1+))
  56   #:use-module (guix packages)
  57   #:use-module (guix utils)
  58   #:use-module (srfi srfi-1))
  59
  60 (define (qemu-patch commit file-name sha256)
  61   "Return an origin for COMMIT."
  62   (origin
  63     (method url-fetch)
  64     (uri (string-append
  65           "http://git.qemu.org/?p=qemu.git;a=commitdiff_plain;h="
  66           commit))
  67     (sha256 sha256)
  68     (file-name file-name)))
  69
  70 (define-public qemu
  71   (package
  72     (name "qemu")
  73     (version "2.9.0")
  74     (source (origin
  75              (method url-fetch)
  76              (uri (string-append "http://wiki.qemu-project.org/download/qemu-"
  77                                  version ".tar.xz"))
  78              (patches (search-patches "qemu-CVE-2017-7493.patch"
  79                                       "qemu-CVE-2017-8112.patch"
  80                                       "qemu-CVE-2017-8309.patch"
  81                                       "qemu-CVE-2017-8379.patch"
  82                                       "qemu-CVE-2017-8380.patch"
  83                                       "qemu-CVE-2017-9524.patch"))
  84              (sha256
  85               (base32
  86                "08mhfs0ndbkyqgw7fjaa9vjxf4dinrly656f6hjzvmaz7hzc677h"))))
  87     (build-system gnu-build-system)
  88     (arguments
  89      '(;; Running tests in parallel can occasionally lead to failures, like:
  90        ;; boot_sector_test: assertion failed (signature == SIGNATURE): (0x00000000 == 0x0000dead)
  91        #:parallel-tests? #f
  92
  93        #:phases
  94        (modify-phases %standard-phases
  95          (replace 'configure
  96            (lambda* (#:key inputs outputs (configure-flags '())
  97                            #:allow-other-keys)
  98              ;; The `configure' script doesn't understand some of the
  99              ;; GNU options.  Thus, add a new phase that's compatible.
 100              (let ((out (assoc-ref outputs "out")))
 101                (setenv "SHELL" (which "bash"))
 102
 103                ;; While we're at it, patch for tests.
 104                (substitute* "tests/libqtest.c"
 105                  (("/bin/sh") (which "sh")))
 106
 107                ;; The binaries need to be linked against -lrt.
 108                (setenv "LDFLAGS" "-lrt")
 109                (zero?
 110                 (apply system*
 111                        `("./configure"
 112                          ,(string-append "--cc=" (which "gcc"))
 113                          ;; Some architectures insist on using HOST_CC
 114                          ,(string-append "--host-cc=" (which "gcc"))
 115                          "--disable-debug-info" ; save build space
 116                          "--enable-virtfs"      ; just to be sure
 117                          ,(string-append "--prefix=" out)
 118                          ,@configure-flags))))))
 119          (add-after 'install 'install-info
 120            (lambda* (#:key inputs outputs #:allow-other-keys)
 121              ;; Install the Info manual, unless Texinfo is missing.
 122              (or (not (assoc-ref inputs "texinfo"))
 123                  (let ((out (assoc-ref outputs "out")))
 124                    (and (zero? (system* "make" "info"))
 125                         (let ((infodir (string-append out "/share/info")))
 126                           (for-each (lambda (info)
 127                                       (install-file info infodir))
 128                                     (find-files "." "\\.info"))
 129                           #t))))))
 130          (add-before 'check 'make-gtester-verbose
 131            (lambda _
 132              ;; Make GTester verbose to facilitate investigation upon failure.
 133              (setenv "V" "1") #t))
 134          (add-before 'check 'disable-test-qga
 135            (lambda _
 136              (substitute* "tests/Makefile.include"
 137                ;; Comment out the test-qga test, which needs /sys and
 138                ;; fails within the build environment.
 139                (("check-unit-.* tests/test-qga" all)
 140                 (string-append "# " all)))
 141              #t)))))
 142     (inputs                                       ; TODO: Add optional inputs.
 143      `(("alsa-lib" ,alsa-lib)
 144        ("attr" ,attr)
 145        ("glib" ,glib)
 146        ;; ("libaio" ,libaio)
 147        ("libattr" ,attr)
 148        ("libcap" ,libcap)           ; virtfs support requires libcap & libattr
 149        ("libjpeg" ,libjpeg-8)
 150        ("libpng" ,libpng)
 151        ("libusb" ,libusb)                         ;USB pass-through support
 152        ("mesa" ,mesa)
 153        ("ncurses" ,ncurses)
 154        ;; ("pciutils" ,pciutils)
 155        ("pixman" ,pixman)
 156        ("sdl" ,sdl)
 157        ("spice" ,spice)
 158        ("util-linux" ,util-linux)
 159        ;; ("vde2" ,vde2)
 160        ("virglrenderer" ,virglrenderer)
 161        ("zlib" ,zlib)))
 162     (native-inputs `(("glib:bin" ,glib "bin") ; gtester, etc.
 163                      ("perl" ,perl)
 164                      ("pkg-config" ,pkg-config)
 165                      ("python" ,python-2) ; incompatible with Python 3 according to error message
 166                      ("texinfo" ,texinfo)))
 167     (home-page "http://www.qemu-project.org")
 168     (synopsis "Machine emulator and virtualizer")
 169     (description
 170      "QEMU is a generic machine emulator and virtualizer.
 171
 172 When used as a machine emulator, QEMU can run OSes and programs made for one
 173 machine (e.g. an ARM board) on a different machine---e.g., your own PC.  By
 174 using dynamic translation, it achieves very good performance.
 175
 176 When used as a virtualizer, QEMU achieves near native performances by
 177 executing the guest code directly on the host CPU.  QEMU supports
 178 virtualization when executing under the Xen hypervisor or using
 179 the KVM kernel module in Linux.  When using KVM, QEMU can virtualize x86,
 180 server and embedded PowerPC, and S390 guests.")
 181
 182     ;; Many files are GPLv2+, but some are GPLv2-only---e.g., `memory.c'.
 183     (license gpl2)
 184
 185     ;; Several tests fail on MIPS; see <http://hydra.gnu.org/build/117914>.
 186     (supported-systems (delete "mips64el-linux" %supported-systems))))
 187
 188 (define-public qemu-minimal
 189   ;; QEMU without GUI support.
 190   (package (inherit qemu)
 191     (name "qemu-minimal")
 192     (synopsis "Machine emulator and virtualizer (without GUI)")
 193     (arguments
 194      `(#:configure-flags
 195        ;; Restrict to the targets supported by Guix.
 196        '("--target-list=i386-softmmu,x86_64-softmmu,mips64el-softmmu,arm-softmmu,aarch64-softmmu")
 197        ,@(package-arguments qemu)))
 198
 199     ;; Remove dependencies on optional libraries, notably GUI libraries.
 200     (inputs (fold alist-delete (package-inputs qemu)
 201                   '("libusb" "mesa" "sdl" "spice" "virglrenderer")))))
 202
 203 (define-public libosinfo
 204   (package
 205     (name "libosinfo")
 206     (version "1.0.0")
 207     (source
 208      (origin
 209        (method url-fetch)
 210        (uri (string-append "https://releases.pagure.org/libosinfo/libosinfo-"
 211                            version ".tar.gz"))
 212        (sha256
 213         (base32
 214          "0srrs2m6irqd4f867g8ls6jp2dq3ql0l9d0fh80d55sivvn2bd7p"))))
 215     (build-system gnu-build-system)
 216     (arguments
 217      `(#:configure-flags
 218        (list (string-append "--with-usb-ids-path="
 219                             (assoc-ref %build-inputs "usb.ids"))
 220              (string-append "--with-pci-ids-path="
 221                             (assoc-ref %build-inputs "pci.ids")))
 222        #:phases
 223        (modify-phases %standard-phases
 224          ;; This odd test fails for unknown reasons.
 225          (add-after 'unpack 'disable-broken-test
 226            (lambda _
 227              (substitute* "test/Makefile.in"
 228                (("test-isodetect\\$\\(EXEEXT\\)") ""))
 229              #t)))))
 230     (inputs
 231      `(("libsoup" ,libsoup)
 232        ("libxml2" ,libxml2)
 233        ("libxslt" ,libxslt)
 234        ("gobject-introspection" ,gobject-introspection)))
 235     (native-inputs
 236      `(("check" ,check)
 237        ("glib" ,glib "bin")  ; glib-mkenums, etc.
 238        ("gtk-doc" ,gtk-doc)
 239        ("vala" ,vala)
 240        ("intltool" ,intltool)
 241        ("pkg-config" ,pkg-config)
 242        ("pci.ids"
 243         ,(origin
 244            (method url-fetch)
 245            (uri "https://github.com/pciutils/pciids/raw/ad02084f0bc143e3c15e31a6152a3dfb1d7a3156/pci.ids")
 246            (sha256
 247             (base32
 248              "0kfhpj5rnh24hz2714qhfmxk281vwc2w50sm73ggw5d15af7zfsw"))))
 249        ("usb.ids"
 250         ,(origin
 251            (method url-fetch)
 252            (uri "http://linux-usb.cvs.sourceforge.net/viewvc/linux-usb/htdocs/usb.ids?revision=1.551")
 253            (file-name "usb.ids")
 254            (sha256
 255             (base32
 256              "17rg5i0wbyk289gr8v4kgvnc9q5bidz7ldcvv9x58l083wn16hq3"))))))
 257     (home-page "https://libosinfo.org/")
 258     (synopsis "Operating system information database")
 259     (description "libosinfo is a GObject based library API for managing
 260 information about operating systems, hypervisors and the (virtual) hardware
 261 devices they can support.  It includes a database containing device metadata
 262 and provides APIs to match/identify optimal devices for deploying an operating
 263 system on a hypervisor.  Via GObject Introspection, the API is available in
 264 all common programming languages.  Vala bindings are also provided.")
 265     ;; The library files are released under LGPLv2.1 or later; the source
 266     ;; files in the "tools" directory are released under GPLv2+.
 267     (license (list lgpl2.1+ gpl2+))))
 268
 269 (define-public libvirt
 270   (package
 271     (name "libvirt")
 272     (version "3.5.0")
 273     (source (origin
 274               (method url-fetch)
 275               (uri (string-append "http://libvirt.org/sources/libvirt-"
 276                                   version ".tar.xz"))
 277               (sha256
 278                (base32
 279                 "05mm4xdw6g960rwvc9189nhxpm1vrilnmpl4h4m1lha11pivlqr9"))))
 280     (build-system gnu-build-system)
 281     (arguments
 282      `(;; FAIL: virshtest
 283        ;; FAIL: virfirewalltest
 284        ;; FAIL: virkmodtest
 285        ;; FAIL: virnetsockettest
 286        ;; FAIL: networkxml2firewalltest
 287        ;; FAIL: nwfilterebiptablestest
 288        ;; FAIL: nwfilterxml2firewalltest
 289        ;; Times out after PASS: virsh-vcpupin
 290        #:tests? #f
 291        #:configure-flags
 292        (list "--with-polkit"
 293              "--sysconfdir=/etc"
 294              "--localstatedir=/var")
 295        #:phases
 296        (modify-phases %standard-phases
 297          (add-after 'unpack 'fix-tests
 298            (lambda _
 299              (substitute* '("tests/commandtest.c"
 300                             "gnulib/tests/test-posix_spawn1.c"
 301                             "gnulib/tests/test-posix_spawn2.c")
 302                (("/bin/sh") (which "sh")))
 303              #t))
 304          (replace 'install
 305            ;; Since the sysconfdir and localstatedir should be /etc and /var
 306            ;; at runtime, we must prevent writing to them at installation
 307            ;; time.
 308            (lambda _
 309              (zero? (system* "make" "install"
 310                              "sysconfdir=/tmp/etc"
 311                              "localstatedir=/tmp/var")))))))
 312     (inputs
 313      `(("libxml2" ,libxml2)
 314        ("gnutls" ,gnutls)
 315        ("dbus" ,dbus)
 316        ("qemu" ,qemu)
 317        ("polkit" ,polkit)
 318        ("libpcap" ,libpcap)
 319        ("libnl" ,libnl)
 320        ("libuuid" ,util-linux)
 321        ("lvm2" ,lvm2) ; for libdevmapper
 322        ("curl" ,curl)
 323        ("openssl" ,openssl)
 324        ("cyrus-sasl" ,cyrus-sasl)
 325        ("perl" ,perl)
 326        ("python" ,python-2)
 327        ("libyajl" ,libyajl)
 328        ("audit" ,audit)
 329        ("dmidecode" ,dmidecode)
 330        ("dnsmasq" ,dnsmasq)
 331        ("ebtables" ,ebtables)
 332        ("iproute" ,iproute)
 333        ("iptables" ,iptables)))
 334     (native-inputs
 335      `(("pkg-config" ,pkg-config)))
 336     (home-page "http://libvirt.org")
 337     (synopsis "Simple API for virtualization")
 338     (description "Libvirt is a C toolkit to interact with the virtualization
 339 capabilities of recent versions of Linux.  The library aims at providing long
 340 term stable C API initially for the Xen paravirtualization but should be able
 341 to integrate other virtualization mechanisms if needed.")
 342     (license lgpl2.1+)))
 343
 344 (define-public libvirt-glib
 345   (package
 346     (name "libvirt-glib")
 347     (version "1.0.0")
 348     (source (origin
 349               (method url-fetch)
 350               (uri (string-append "ftp://libvirt.org/libvirt/glib/"
 351                                   "libvirt-glib-" version ".tar.gz"))
 352               (sha256
 353                (base32
 354                 "0iwa5sdbii52pjpdm5j37f67sdmf0kpcky4liwhy1nf43k85i4fa"))))
 355     (build-system gnu-build-system)
 356     (arguments
 357      `(#:phases
 358        (modify-phases %standard-phases
 359          (add-after 'unpack 'fix-tests
 360            (lambda _
 361              (substitute* "tests/test-events.c"
 362                (("/bin/true") (which "true")))
 363              #t)))))
 364     (inputs
 365      `(("libxml2" ,libxml2)
 366        ("libvirt" ,libvirt)
 367        ("gobject-introspection" ,gobject-introspection)
 368        ("glib" ,glib)
 369        ("openssl" ,openssl)
 370        ("cyrus-sasl" ,cyrus-sasl)
 371        ("lvm2" ,lvm2) ; for libdevmapper
 372        ("libyajl" ,libyajl)))
 373     (native-inputs
 374      `(("pkg-config" ,pkg-config)
 375        ("intltool" ,intltool)
 376        ("glib" ,glib "bin")
 377        ("vala" ,vala)))
 378     (home-page "http://libvirt.org")
 379     (synopsis "GLib wrapper around libvirt")
 380     (description "libvirt-glib wraps the libvirt library to provide a
 381 high-level object-oriented API better suited for glib-based applications, via
 382 three libraries:
 383
 384 @enumerate
 385 @item libvirt-glib - GLib main loop integration & misc helper APIs
 386 @item libvirt-gconfig - GObjects for manipulating libvirt XML documents
 387 @item libvirt-gobject - GObjects for managing libvirt objects
 388 @end enumerate
 389 ")
 390     (license lgpl2.1+)))
 391
 392 (define-public python-libvirt
 393   (package
 394     (name "python-libvirt")
 395     (version "3.4.0")
 396     (source (origin
 397               (method url-fetch)
 398               (uri (pypi-uri "libvirt-python" version))
 399               (sha256
 400                (base32
 401                 "04dma3979171p9yf0cg7m03shk038hc9vyfm9lb8z60qyn0pg9xg"))))
 402     (build-system python-build-system)
 403     (arguments
 404      `(#:phases
 405        (modify-phases %standard-phases
 406          (add-after 'unpack 'patch-nosetests-path
 407            (lambda* (#:key inputs #:allow-other-keys)
 408              (substitute* "setup.py"
 409                (("\"/usr/bin/nosetests\"")
 410                 (string-append "\"" (which "nosetests") "\""))
 411                (("self\\.spawn\\(\\[sys\\.executable, nose\\]\\)")
 412                 (format #f "self.spawn([\"~a\", nose])" (which "bash"))))
 413              #t)))))
 414     (inputs
 415      `(("libvirt" ,libvirt)))
 416     (propagated-inputs
 417      `(("python-lxml" ,python-lxml)))
 418     (native-inputs
 419      `(("pkg-config" ,pkg-config)
 420        ("python-nose" ,python-nose)))
 421     (home-page "http://libvirt.org")
 422     (synopsis "Python bindings to libvirt")
 423     (description "This package provides Python bindings to the libvirt
 424 virtualization library.")
 425     (license lgpl2.1+)))
 426
 427 (define-public python2-libvirt
 428   (package-with-python2 python-libvirt))
 429
 430 (define-public virt-manager
 431   (package
 432     (name "virt-manager")
 433     (version "1.4.1")
 434     (source (origin
 435               (method url-fetch)
 436               (uri (string-append "https://virt-manager.org/download/sources"
 437                                   "/virt-manager/virt-manager-"
 438                                   version ".tar.gz"))
 439               (sha256
 440                (base32
 441                 "0i1rkxz730vw1nqghrp189jhhp53pw81k0h71hhxmyqlkyclkig6"))))
 442     (build-system python-build-system)
 443     (arguments
 444      `(#:python ,python-2
 445        #:use-setuptools? #f ; Uses custom distutils 'install' command.
 446        ;; Some of the tests seem to require network access to install virtual
 447        ;; machines.
 448        #:tests? #f
 449        #:modules ((ice-9 match)
 450                   (srfi srfi-26)
 451                   (guix build python-build-system)
 452                   (guix build utils))
 453        #:phases
 454        (modify-phases %standard-phases
 455          (add-after 'unpack 'fix-setup
 456            (lambda* (#:key outputs #:allow-other-keys)
 457              (substitute* "virtcli/cliconfig.py"
 458                (("/usr") (assoc-ref outputs "out")))
 459              #t))
 460          (add-before 'wrap 'wrap-with-GI_TYPELIB_PATH
 461            (lambda* (#:key inputs outputs #:allow-other-keys)
 462              (let* ((bin       (string-append (assoc-ref outputs "out") "/bin"))
 463                     (bin-files (find-files bin ".*"))
 464                     (paths     (map (match-lambda
 465                                       ((output . directory)
 466                                        (let* ((girepodir (string-append
 467                                                           directory
 468                                                           "/lib/girepository-1.0")))
 469                                          (if (file-exists? girepodir)
 470                                              girepodir #f))))
 471                                     inputs)))
 472                (for-each (lambda (file)
 473                            (format #t "wrapping ~a\n" file)
 474                            (wrap-program file
 475                              `("GI_TYPELIB_PATH" ":" prefix
 476                                ,(filter identity paths))))
 477                          bin-files))
 478              #t)))))
 479     (inputs
 480      `(("gtk+" ,gtk+)
 481        ("gtk-vnc" ,gtk-vnc)
 482        ("libvirt" ,libvirt)
 483        ("libvirt-glib" ,libvirt-glib)
 484        ("libosinfo" ,libosinfo)
 485        ("vte" ,vte)
 486        ("gobject-introspection" ,gobject-introspection)
 487        ("python2-libvirt" ,python2-libvirt)
 488        ("python2-requests" ,python2-requests)
 489        ("python2-ipaddr" ,python2-ipaddr)
 490        ("python2-pygobject" ,python2-pygobject)
 491        ("python2-libxml2" ,python2-libxml2)))
 492     ;; virt-manager searches for qemu-img or kvm-img in the PATH.
 493     (propagated-inputs
 494      `(("qemu" ,qemu)))
 495     (native-inputs
 496      `(("glib" ,glib "bin")             ; glib-compile-schemas.
 497        ("gtk+" ,gtk+ "bin")             ; gtk-update-icon-cache
 498        ("perl" ,perl)                   ; pod2man
 499        ("intltool" ,intltool)))
 500     (home-page "https://virt-manager.org/")
 501     (synopsis "Manage virtual machines")
 502     (description
 503      "The virt-manager application is a desktop user interface for managing
 504 virtual machines through libvirt.  It primarily targets KVM VMs, but also
 505 manages Xen and LXC (Linux containers).  It presents a summary view of running
 506 domains, their live performance and resource utilization statistics.")
 507     (license gpl2+)))