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