gnu/packages/virtualization.scm

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