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