gnu/packages/virtualization.scm

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