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