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-pycairo" ,python-pycairo)
 734        ("python-pygobject" ,python-pygobject)
 735        ("python-libxml2" ,python-libxml2)
 736        ("spice-gtk" ,spice-gtk)))
 737     ;; virt-manager searches for qemu-img or kvm-img in the PATH.
 738     (propagated-inputs
 739      `(("qemu" ,qemu)))
 740     (native-inputs
 741      `(("glib" ,glib "bin")             ; glib-compile-schemas
 742        ("gobject-introspection" ,gobject-introspection)
 743        ("gtk+" ,gtk+ "bin")             ; gtk-update-icon-cache
 744        ("perl" ,perl)                   ; pod2man
 745        ("intltool" ,intltool)
 746        ;; The following are required for running the tests
 747        ;; ("python-dogtail" ,python-dogtail)
 748        ;; ("xvfb" ,xorg-server-for-tests)
 749        ;; ("dbus" ,dbus)
 750        ;; ("at-spi2-core" ,at-spi2-core)
 751        ;; ("gsettings-desktop-schemas" ,gsettings-desktop-schemas)
 752        ))
 753     (home-page "https://virt-manager.org/")
 754     (synopsis "Manage virtual machines")
 755     (description
 756      "The virt-manager application is a desktop user interface for managing
 757 virtual machines through libvirt.  It primarily targets KVM VMs, but also
 758 manages Xen and LXC (Linux containers).  It presents a summary view of running
 759 domains, their live performance and resource utilization statistics.")
 760     (license license:gpl2+)))
 761
 762 (define-public criu
 763   (package
 764     (name "criu")
 765     (version "3.14")
 766     (source (origin
 767               (method url-fetch)
 768               (uri (string-append "https://download.openvz.org/criu/criu-"
 769                                   version ".tar.bz2"))
 770               (sha256
 771                (base32
 772                 "1jrr3v99g18gc0hriz0avq6ccdvyya0j6wwz888sdsc4icc30gzn"))))
 773     (build-system gnu-build-system)
 774     (arguments
 775      `(#:test-target "test"
 776        #:tests? #f ; tests require mounting as root
 777        #:make-flags
 778        (list (string-append "PREFIX=" (assoc-ref %outputs "out"))
 779              (string-append "LIBDIR=" (assoc-ref %outputs "out")
 780                             "/lib")
 781              (string-append "ASCIIDOC=" (assoc-ref %build-inputs "asciidoc")
 782                             "/bin/asciidoc")
 783              (string-append "XMLTO=" (assoc-ref %build-inputs "xmlto")
 784                             "/bin/xmlto"))
 785        #:phases
 786        (modify-phases %standard-phases
 787          (replace 'configure
 788            (lambda* (#:key inputs #:allow-other-keys)
 789              ;; The includes for libnl are located in a sub-directory.
 790              (setenv "C_INCLUDE_PATH"
 791                      (string-append (assoc-ref inputs "libnl")
 792                                     "/include/libnl3:"
 793                                     (or (getenv "C_INCLUDE_PATH") "")))
 794              #t))
 795          (add-after 'configure 'fix-documentation
 796            (lambda* (#:key inputs outputs #:allow-other-keys)
 797              (substitute* "Documentation/Makefile"
 798                (("-m custom.xsl")
 799                 (string-append
 800                  "-m custom.xsl --skip-validation -x "
 801                  (assoc-ref inputs "docbook-xsl") "/xml/xsl/"
 802                  ,(package-name docbook-xsl) "-"
 803                  ,(package-version docbook-xsl)
 804                  "/manpages/docbook.xsl")))
 805              #t))
 806          (add-after 'unpack 'hardcode-variables
 807            (lambda* (#:key inputs #:allow-other-keys)
 808              ;; Hardcode arm version detection
 809              (substitute* "Makefile"
 810                (("ARMV.*:=.*") "ARMV := 7\n"))
 811              ;; We are currently using python-2
 812              (substitute* "crit/Makefile"
 813                (("\\$\\(PYTHON\\)") "python2"))
 814              (substitute* "lib/Makefile"
 815                (("\\$\\(PYTHON\\)")
 816                 (string-append (assoc-ref inputs "python")
 817                                "/bin/python")))
 818              #t))
 819          (add-before 'build 'fix-symlink
 820            (lambda* (#:key inputs #:allow-other-keys)
 821              ;; The file 'images/google/protobuf/descriptor.proto' points to
 822              ;; /usr/include/..., which obviously does not exist.
 823              (let* ((file "google/protobuf/descriptor.proto")
 824                     (target (string-append "images/" file))
 825                     (source (string-append (assoc-ref inputs "protobuf")
 826                                            "/include/" file)))
 827                (delete-file target)
 828                (symlink source target)
 829                #t)))
 830          (add-after 'install 'wrap
 831            (lambda* (#:key inputs outputs #:allow-other-keys)
 832              ;; Make sure 'crit' runs with the correct PYTHONPATH.
 833              (let* ((out (assoc-ref outputs "out"))
 834                     (path (string-append out
 835                                          "/lib/python"
 836                                          (string-take (string-take-right
 837                                                        (assoc-ref inputs "python") 5) 3)
 838                                          "/site-packages:"
 839                                          (getenv "PYTHONPATH"))))
 840                (wrap-program (string-append out "/bin/crit")
 841                  `("PYTHONPATH" ":" prefix (,path))))
 842              #t)))))
 843     (inputs
 844      `(("protobuf" ,protobuf)
 845        ("python" ,python-2)
 846        ("python2-protobuf" ,python2-protobuf)
 847        ("python2-ipaddr" ,python2-ipaddr)
 848        ("iproute" ,iproute)
 849        ("libaio" ,libaio)
 850        ("libcap" ,libcap)
 851        ("libnet" ,libnet)
 852        ("libnl" ,libnl)
 853        ("libbsd" ,libbsd)))
 854     (native-inputs
 855      `(("pkg-config" ,pkg-config)
 856        ("perl" ,perl)
 857        ("protobuf-c" ,protobuf-c)
 858        ("asciidoc" ,asciidoc)
 859        ("xmlto" ,xmlto)
 860        ("docbook-xml" ,docbook-xml)
 861        ("docbook-xsl" ,docbook-xsl)))
 862     (home-page "https://criu.org")
 863     (synopsis "Checkpoint and restore in user space")
 864     (description "Using this tool, you can freeze a running application (or
 865 part of it) and checkpoint it to a hard drive as a collection of files.  You
 866 can then use the files to restore and run the application from the point it
 867 was frozen at.  The distinctive feature of the CRIU project is that it is
 868 mainly implemented in user space.")
 869     ;; The project is licensed under GPLv2; files in the lib/ directory are
 870     ;; LGPLv2.1.
 871     (license (list license:gpl2 license:lgpl2.1))))
 872
 873 (define-public qmpbackup
 874   (package
 875     (name "qmpbackup")
 876     (version "0.2")
 877     (source (origin
 878               (method git-fetch)
 879               (uri (git-reference
 880                      (url "https://github.com/abbbi/qmpbackup")
 881                      (commit version)))
 882               (file-name (git-file-name name version))
 883               (sha256
 884                (base32
 885                 "0swhp5byz44brhyis1a39p11fyn9q84xz5q6v2fah29r7d71kmmx"))))
 886     (build-system python-build-system)
 887     (arguments
 888      `(#:python ,python-2))
 889     (home-page "https://github.com/abbbi/qmpbackup")
 890     (synopsis "Backup and restore QEMU machines")
 891     (description "qmpbackup is designed to create and restore full and
 892 incremental backups of running QEMU virtual machines via QMP, the QEMU
 893 Machine Protocol.")
 894     (license license:gpl3+)))
 895
 896 (define-public looking-glass-client
 897   (let ((commit "182c4752d57690da7f99d5e788de9b8baea33895"))
 898     (package
 899      (name "looking-glass-client")
 900      (version (string-append "a12-" (string-take commit 7)))
 901      (source
 902       (origin
 903        (method git-fetch)
 904        (uri (git-reference (url "https://github.com/gnif/LookingGlass")
 905                            (commit commit)))
 906        (file-name (git-file-name name version))
 907        (sha256
 908         (base32
 909          "02bq46ndmzq9cihazzn7xq1x7q5nzm7iw4l9lqzihxcxp9famkhw"))
 910        (modules '((guix build utils)))
 911        (snippet
 912         '(begin
 913            ;; Do not create binaries optimized for the CPU of the build machine,
 914            ;; for reproducibility and compatibility.  TODO: in the next version
 915            ;; of looking glass, this is exposed as a CMake configure option.
 916            (substitute* "client/CMakeLists.txt"
 917              (("-march=native")
 918               ""))
 919            #t))))
 920      (build-system cmake-build-system)
 921      (inputs `(("fontconfig" ,fontconfig)
 922                ("glu" ,glu)
 923                ("mesa" ,mesa)
 924                ("openssl" ,openssl)
 925                ("sdl2" ,sdl2)
 926                ("sdl2-ttf" ,sdl2-ttf)
 927                ("spice-protocol" ,spice-protocol)
 928                ("wayland" ,wayland)))
 929      (native-inputs `(("libconfig" ,libconfig)
 930                       ("nettle" ,nettle)
 931                       ("pkg-config" ,pkg-config)))
 932      (arguments
 933       `(#:tests? #f ;; No tests are available.
 934         #:make-flags '("CC=gcc")
 935         #:phases (modify-phases %standard-phases
 936                    (add-before 'configure 'chdir-to-client
 937                      (lambda* (#:key outputs #:allow-other-keys)
 938                        (chdir "client")
 939                        #t))
 940                    (add-after 'chdir-to-client 'add-missing-include
 941                      (lambda _
 942                        ;; Mimic upstream commit b9797529893, required since the
 943                        ;; update to Mesa 19.2.
 944                        (substitute* "renderers/egl/shader.h"
 945                          (("#include <stdbool\\.h>")
 946                           "#include <stdbool.h>\n#include <stddef.h>"))
 947                        #t))
 948                    (replace 'install
 949                      (lambda* (#:key outputs #:allow-other-keys)
 950                        (install-file "looking-glass-client"
 951                                      (string-append (assoc-ref outputs "out")
 952                                                     "/bin"))
 953                        #t)))))
 954      (home-page "https://looking-glass.hostfission.com")
 955      (synopsis "KVM Frame Relay (KVMFR) implementation")
 956      (description "Looking Glass allows the use of a KVM (Kernel-based Virtual
 957 Machine) configured for VGA PCI Pass-through without an attached physical
 958 monitor, keyboard or mouse.  It displays the VM's rendered contents on your main
 959 monitor/GPU.")
 960      ;; This package requires SSE instructions.
 961      (supported-systems '("i686-linux" "x86_64-linux"))
 962      (license license:gpl2+))))
 963
 964 (define-public runc
 965   (package
 966     (name "runc")
 967     (version "1.0.0-rc6")
 968     (source (origin
 969               (method url-fetch)
 970               (uri (string-append
 971                     "https://github.com/opencontainers/runc/releases/"
 972                     "download/v" version "/runc.tar.xz"))
 973               (file-name (string-append name "-" version ".tar.xz"))
 974               (patches (search-patches "runc-CVE-2019-5736.patch"))
 975               (sha256
 976                (base32
 977                 "1c7832dq70slkjh8qp2civ1wxhhdd2hrx84pq7db1mmqc9fdr3cc"))))
 978     (build-system go-build-system)
 979     (arguments
 980      '(#:import-path "github.com/opencontainers/runc"
 981        #:install-source? #f
 982        ;; XXX: 20/139 tests fail due to missing /var, cgroups and apparmor in
 983        ;; the build environment.
 984        #:tests? #f
 985        #:phases
 986        (modify-phases %standard-phases
 987          (replace 'unpack
 988            (lambda* (#:key source import-path #:allow-other-keys)
 989              ;; Unpack the tarball into 'runc' instead of 'runc-1.0.0-rc5'.
 990              (let ((dest (string-append "src/" import-path)))
 991                (mkdir-p dest)
 992                (invoke "tar" "-C" (string-append "src/" import-path)
 993                        "--strip-components=1"
 994                        "-xvf" source))))
 995          (replace 'build
 996            (lambda* (#:key import-path #:allow-other-keys)
 997              (chdir (string-append "src/" import-path))
 998              ;; XXX: requires 'go-md2man'.
 999              ;; (invoke "make" "man")
1000              (invoke "make")))
1001          ;; (replace 'check
1002          ;;   (lambda _
1003          ;;     (invoke "make" "localunittest")))
1004          (replace 'install
1005            (lambda* (#:key outputs #:allow-other-keys)
1006              (let ((out (assoc-ref outputs "out")))
1007               (invoke "make" "install" "install-bash"
1008                       (string-append "PREFIX=" out))))))))
1009     (native-inputs
1010      `(("pkg-config" ,pkg-config)))
1011     (inputs
1012      `(("libseccomp" ,libseccomp)))
1013     (synopsis "Open container initiative runtime")
1014     (home-page "https://www.opencontainers.org/")
1015     (description
1016      "@command{runc} is a command line client for running applications
1017 packaged according to the
1018 @uref{https://github.com/opencontainers/runtime-spec/blob/master/spec.md, Open
1019 Container Initiative (OCI) format} and is a compliant implementation of the
1020 Open Container Initiative specification.")
1021     (license license:asl2.0)))
1022
1023 (define-public umoci
1024   (package
1025     (name "umoci")
1026     (version "0.4.6")
1027     (source
1028      (origin
1029        (method url-fetch)
1030        (uri (string-append
1031              "https://github.com/opencontainers/umoci/releases/download/v"
1032              version "/umoci.tar.xz"))
1033        (file-name (string-append "umoci-" version ".tar.xz"))
1034        (sha256
1035         (base32 "06q7xfwnqysc013hapx31jhlzmyg8qb467qfkynj673qc7p9bd6h"))))
1036     (build-system go-build-system)
1037     (arguments
1038      '(#:import-path "github.com/opencontainers/umoci"
1039        #:install-source? #f
1040        #:phases
1041        (modify-phases %standard-phases
1042          (replace 'unpack
1043            (lambda* (#:key source import-path #:allow-other-keys)
1044              ;; Unpack the tarball into 'umoci' instead of "runc-${version}".
1045              (let ((dest (string-append "src/" import-path)))
1046                (mkdir-p dest)
1047                (invoke "tar" "-C" (string-append "src/" import-path)
1048                        "--strip-components=1"
1049                        "-xvf" source))))
1050          (replace 'build
1051            (lambda* (#:key import-path #:allow-other-keys)
1052              (chdir (string-append "src/" import-path))
1053              ;; TODO: build manpages with 'go-md2man'.
1054              (invoke "make" "SHELL=bash")))
1055          (replace 'install
1056            (lambda* (#:key outputs #:allow-other-keys)
1057              (let* ((out (assoc-ref outputs "out"))
1058                     (bindir (string-append out "/bin")))
1059                (install-file "umoci" bindir)
1060                #t))))))
1061     (home-page "https://umo.ci/")
1062     (synopsis "Tool for modifying Open Container images")
1063     (description
1064      "@command{umoci} is a tool that allows for high-level modification of an
1065 Open Container Initiative (OCI) image layout and its tagged images.")
1066     (license license:asl2.0)))
1067
1068 (define-public skopeo
1069   (package
1070     (name "skopeo")
1071     (version "0.1.40")
1072     (source (origin
1073               (method git-fetch)
1074               (uri (git-reference
1075                     (url "https://github.com/projectatomic/skopeo")
1076                     (commit (string-append "v" version))))
1077               (file-name (git-file-name name version))
1078               (sha256
1079                (base32
1080                 "1bagirzdzjhicn5dr691092ac3q6lhz3xngjzgqiqkxnvpz7p6cn"))))
1081     (build-system go-build-system)
1082     (native-inputs
1083      `(("pkg-config" ,pkg-config)))
1084     (inputs
1085      `(("btrfs-progs" ,btrfs-progs)
1086        ("eudev" ,eudev)
1087        ("libassuan" ,libassuan)
1088        ("libselinux" ,libselinux)
1089        ("libostree" ,libostree)
1090        ("lvm2" ,lvm2)
1091        ("glib" ,glib)
1092        ("gpgme" ,gpgme)))
1093     (arguments
1094      '(#:import-path "github.com/projectatomic/skopeo"
1095        #:install-source? #f
1096        #:tests? #f ; The tests require Docker
1097        #:phases
1098        (modify-phases %standard-phases
1099          (replace 'build
1100            (lambda* (#:key import-path #:allow-other-keys)
1101              (chdir (string-append "src/" import-path))
1102              ;; TODO: build manpages with 'go-md2man'.
1103              (invoke "make" "binary-local")))
1104          (replace 'install
1105            (lambda* (#:key outputs #:allow-other-keys)
1106              (let ((out (assoc-ref outputs "out")))
1107                (invoke "make" "install-binary" "install-completions"
1108                        (string-append "PREFIX=" out))))))))
1109     (home-page "https://github.com/projectatomic/skopeo")
1110     (synopsis "Interact with container images and container image registries")
1111     (description
1112      "@command{skopeo} is a command line utility providing various operations
1113 with container images and container image registries.  It can:
1114 @enumerate
1115
1116 @item Copy container images between various containers image stores,
1117 converting them as necessary.
1118
1119 @item Convert a Docker schema 2 or schema 1 container image to an OCI image.
1120
1121 @item Inspect a repository on a container registry without needlessly pulling
1122 the image.
1123
1124 @item Sign and verify container images.
1125
1126 @item Delete container images from a remote container registry.
1127
1128 @end enumerate")
1129     (license license:asl2.0)))
1130
1131 (define-public python-vagrant
1132   (package
1133     (name "python-vagrant")
1134     (version "0.5.15")
1135     (source
1136       (origin
1137         (method url-fetch)
1138         (uri (pypi-uri "python-vagrant" version))
1139         (sha256
1140          (base32
1141           "1ikrh6canhcxg5y7pzmkcnnydikppv7s6sm9prfx90nk0ac8m6mg"))))
1142     (build-system python-build-system)
1143     (arguments
1144      '(#:tests? #f)) ; tests involve running vagrant.
1145     (home-page "https://github.com/todddeluca/python-vagrant")
1146     (synopsis "Python bindings for Vagrant")
1147     (description
1148      "Python-vagrant is a Python module that provides a thin wrapper around the
1149 @code{vagrant} command line executable, allowing programmatic control of Vagrant
1150 virtual machines.")
1151     (license license:expat)))
1152
1153 (define-public bubblewrap
1154   (package
1155     (name "bubblewrap")
1156     (version "0.4.1")
1157     (source (origin
1158               (method url-fetch)
1159               (uri (string-append "https://github.com/containers/bubblewrap/"
1160                                   "releases/download/v" version "/bubblewrap-"
1161                                   version ".tar.xz"))
1162               (sha256
1163                (base32
1164                 "00ycgi6q2yngh06bnz50wkvar6r2jnjf3j158grhi9k13jdrpimr"))))
1165     (build-system gnu-build-system)
1166     (arguments
1167      `(#:phases
1168        (modify-phases %standard-phases
1169          (add-after 'unpack 'fix-test
1170            (lambda* (#:key outputs #:allow-other-keys)
1171              ;; Tests try to access /var/tmp, which is not possible in our build
1172              ;; environment.  Let's give them another directory.
1173              ;; /tmp gets overriden in some tests, so we need another directory.
1174              ;; the only possibility is the output directory.
1175              (let ((tmp-dir (string-append (assoc-ref outputs "out") "/tmp")))
1176                (mkdir-p tmp-dir)
1177                (substitute* "tests/test-run.sh"
1178                  (("/var/tmp") tmp-dir)
1179                  ;; Tests create a temporary python script, so fix its shebang.
1180                  (("/usr/bin/env python") (which "python"))
1181                  ;; Some tests try to access /usr, but that doesn't exist.
1182                  ;; Give them /gnu instead.
1183                  (("/usr") "/gnu")
1184                  (("--ro-bind /bin /bin") "--ro-bind /gnu /bin")
1185                  (("--ro-bind /sbin /sbin") "--ro-bind /gnu /sbin")
1186                  (("--ro-bind /lib /lib") "--ro-bind /gnu /lib")
1187                  (("  */bin/bash") (which "bash"))
1188                  (("/bin/sh") (which "sh"))
1189                  (("findmnt") (which "findmnt"))))
1190              #t))
1191          ;; Remove the directory we gave to tests to have a clean package.
1192          (add-after 'check 'remove-tmp-dir
1193            (lambda* (#:key outputs #:allow-other-keys)
1194              (delete-file-recursively (string-append (assoc-ref outputs "out") "/tmp"))
1195              #t)))))
1196     (inputs
1197      `(("libcap" ,libcap)))
1198     (native-inputs
1199      `(("python-2" ,python-2)
1200        ("util-linux" ,util-linux)))
1201     (home-page "https://github.com/containers/bubblewrap")
1202     (synopsis "Unprivileged sandboxing tool")
1203     (description "Bubblewrap is aimed at running applications in a sandbox,
1204 restricting their access to parts of the operating system or user data such as
1205 the home directory.  Bubblewrap always creates a new mount namespace, and the
1206 user can specify exactly what parts of the file system should be made visible
1207 in the sandbox.  These directories are mounted with the @code{nodev} option
1208 by default and can be made read-only.")
1209     (license license:lgpl2.0+)))
1210
1211 (define-public bochs
1212   (package
1213     (name "bochs")
1214     (version "2.6.11")
1215     (source
1216      (origin
1217        (method url-fetch)
1218        (uri (string-append "https://sourceforge.net/projects/bochs/files/bochs/"
1219                            version "/bochs-" version ".tar.gz"))
1220        (sha256
1221         (base32 "0ql8q6y1k356li1g9gbvl21448mlxphxxi6kjb2b3pxvzd0pp2b3"))))
1222     (build-system gnu-build-system)
1223     (arguments
1224      `(#:tests? #f))                    ; no tests exist
1225     (inputs
1226      `(("libxrandr" ,libxrandr)))
1227     (home-page "http://bochs.sourceforge.net/")
1228     (synopsis "Emulator for x86 PC")
1229     (description
1230      "Bochs is an emulator which can emulate Intel x86 CPU, common I/O
1231 devices, and a custom BIOS.  It can also be compiled to emulate many different
1232 x86 CPUs, from early 386 to the most recent x86-64 Intel and AMD processors.
1233 Bochs can run most Operating Systems inside the emulation including Linux,
1234 DOS or Microsoft Windows.")
1235     (license license:lgpl2.0+)))
1236
1237 (define-public xen
1238   (package
1239     (name "xen")
1240     (version "4.13.0")
1241     (source (origin
1242               (method git-fetch)
1243               (uri (git-reference
1244                     (url "git://xenbits.xenproject.org/xen.git")
1245                     (commit (string-append "RELEASE-" version))))
1246               (file-name (git-file-name name version))
1247               (sha256
1248                (base32
1249                 "0py50n995gv909i0d1lfdcj9wcp5g1d5z6m2291jqqlfyany138g"))))
1250     (build-system gnu-build-system)
1251     (arguments
1252      `(#:configure-flags
1253        (list "--enable-rpath"
1254              "--disable-qemu-traditional" ; It tries to do "git clone"
1255              "--disable-rombios" ; would try to "git clone" via etherboot.
1256              ;; TODO: Re-enable stubdom (it's "more secure" to use it).
1257              "--disable-stubdom" ; tries to "git clone" old patched newlib.
1258              (string-append "--with-initddir="
1259                             (assoc-ref %outputs "out")
1260                             "/etc/init.d")
1261              (string-append "--with-system-qemu="
1262                             (assoc-ref %build-inputs "qemu")
1263                             "/bin/qemu-system-i386")
1264              (string-append "--with-system-seabios="
1265                             (assoc-ref %build-inputs "seabios")
1266                             "/share/firmware/bios.bin")
1267              (string-append "--with-system-ovmf="
1268                             (assoc-ref %build-inputs "ovmf")
1269                             "/share/firmware/ovmf_ia32.bin"))
1270        #:make-flags (list "-j" "1"
1271                           "XEN_BUILD_DATE=Thu Jan  1 01:00:01 CET 1970"
1272                           "XEN_BUILD_TIME=01:00:01"
1273                           "XEN_BUILD_HOST="
1274                           "ETHERBOOT_NICS="
1275                           "SMBIOS_REL_DATE=01/01/1970"
1276                           "VGABIOS_REL_DATE=01 Jan 1970"
1277                           ; QEMU_TRADITIONAL_LOC
1278                           ; QEMU_UPSTREAM_LOC
1279                           "SYSCONFIG_DIR=/tmp/etc/default"
1280                           (string-append "BASH_COMPLETION_DIR="
1281                                          (assoc-ref %outputs "out")
1282                                          "/etc/bash_completion.d")
1283                           (string-append "BOOT_DIR="
1284                                          (assoc-ref %outputs "out")
1285                                          "/boot")
1286                           (string-append "DEBUG_DIR="
1287                                          (assoc-ref %outputs "out")
1288                                          "/lib/debug")
1289                           (string-append "EFI_DIR="
1290                                          (assoc-ref %outputs "out")
1291                                          "/lib/efi") ; TODO lib64 ?
1292                           "MINIOS_UPSTREAM_URL="
1293                           ;(string-append "DISTDIR="
1294                           ;               (assoc-ref %outputs "out"))
1295 )
1296        #:test-target "test"
1297        #:phases
1298        (modify-phases %standard-phases
1299         (add-after 'unpack 'unpack-mini-os
1300           (lambda* (#:key inputs #:allow-other-keys)
1301             (copy-recursively (assoc-ref inputs "mini-os") "extras/mini-os")
1302             #t))
1303         (add-after 'unpack-mini-os 'patch
1304           (lambda* (#:key inputs outputs #:allow-other-keys)
1305             (substitute* "tools/firmware/Rules.mk"
1306              (("override XEN_TARGET_ARCH = x86_32")
1307               (string-append "override XEN_TARGET_ARCH = x86_32
1308 override CC = " (assoc-ref inputs "cross-gcc") "/bin/i686-linux-gnu-gcc"))
1309              (("^CFLAGS =$")
1310               (string-append "CFLAGS=-I" (assoc-ref inputs "cross-libc")
1311                              "/include\n")))
1312             (substitute* "config/x86_32.mk"
1313              (("CFLAGS += -m32 -march=i686")
1314               (string-append "CFLAGS += -march=i686 -I"
1315                              (assoc-ref inputs "cross-libc")
1316                              "/include")))
1317             ;; /var is not in /gnu/store , so don't try to create it.
1318             (substitute* '("tools/Makefile"
1319                            "tools/xenstore/Makefile"
1320                            "tools/xenpaging/Makefile")
1321              (("\\$\\(INSTALL_DIR\\) .*XEN_(DUMP|LOG|RUN|LIB|PAGING)_DIR.*")
1322               "\n")
1323              (("\\$\\(INSTALL_DIR\\) .*XEN_(RUN|LIB)_STORED.*")
1324               "\n"))
1325             ;; Prevent xen from creating /etc .
1326             (substitute* "tools/examples/Makefile"
1327              ((" install-readmes") "")
1328              ((" install-configs") ""))
1329             ;; Set rpath.
1330             (substitute* "tools/pygrub/setup.py"
1331              (("library_dirs =")
1332               ; TODO: extra_link_args = ['-Wl,-rpath=/opt/foo'],
1333               (string-append "runtime_library_dirs = ['"
1334                              (assoc-ref outputs "out")
1335                              "/lib'],\nlibrary_dirs =")))
1336             #t))
1337         (add-before 'configure 'patch-xen-script-directory
1338           (lambda* (#:key outputs #:allow-other-keys)
1339             (substitute* '("configure"
1340                            "tools/configure"
1341                            "docs/configure")
1342              (("XEN_SCRIPT_DIR=.*")
1343               (string-append "XEN_SCRIPT_DIR="
1344                              (assoc-ref outputs "out")
1345                              "/etc/xen/scripts")))
1346             #t))
1347         (add-before 'configure 'set-environment-up
1348           (lambda* (#:key make-flags #:allow-other-keys)
1349              (define (cross? x)
1350                (string-contains x "cross-i686-linux"))
1351              (define (filter-environment! filter-predicate
1352                                           environment-variable-names)
1353                (for-each
1354                 (lambda (env-name)
1355                   (let* ((env-value (getenv env-name))
1356                          (search-path (search-path-as-string->list env-value))
1357                          (new-search-path (filter filter-predicate
1358                                                   search-path))
1359                          (new-env-value (list->search-path-as-string
1360                                          new-search-path ":")))
1361                     (setenv env-name new-env-value)))
1362                 environment-variable-names))
1363              (setenv "CROSS_CPATH" (getenv "CPATH"))
1364              (setenv "CROSS_LIBRARY_PATH" (getenv "LIBRARY_PATH"))
1365              (filter-environment! cross?
1366               '("CROSS_CPATH"
1367                 "CROSS_LIBRARY_PATH"))
1368              (filter-environment! (lambda (e) (not (cross? e)))
1369               '("CPATH"
1370                 "LIBRARY_PATH"))
1371              ;; Guix tries to be helpful and automatically adds
1372              ;; mini-os-git-checkout/include to the include path,
1373              ;; but actually we don't want it to be there (yet).
1374              (filter-environment! (lambda (e)
1375                                     (not
1376                                      (string-contains e
1377                                       "mini-os-git-checkout")))
1378               '("CPATH"
1379                 "LIBRARY_PATH"))
1380             (setenv "EFI_VENDOR" "guix")
1381              #t))
1382         (replace 'build
1383           (lambda* (#:key make-flags #:allow-other-keys)
1384             (apply invoke "make" "world" make-flags))))))
1385     (inputs
1386      `(("acpica" ,acpica) ; TODO: patch iasl invocation.
1387        ("bridge-utils" ,bridge-utils) ; TODO: patch invocations.
1388        ("glib" ,glib)
1389        ("iproute" ,iproute) ; TODO: patch invocations.
1390        ("libaio" ,libaio)
1391        ("libx11" ,libx11)
1392        ("libyajl" ,libyajl)
1393        ("ncurses" ,ncurses)
1394        ("openssl" ,openssl)
1395        ("ovmf" ,ovmf)
1396        ("pixman" ,pixman)
1397        ("qemu" ,qemu-minimal)
1398        ("seabios" ,seabios)
1399        ("util-linux" ,util-linux "lib") ; uuid
1400        ; TODO: ocaml-findlib, ocaml-nox.
1401        ("xz" ,xz) ; for liblzma
1402        ("zlib" ,zlib)))
1403     (native-inputs
1404      `(("dev86" ,dev86)
1405        ("bison" ,bison)
1406        ("cmake" ,cmake-minimal)
1407        ("figlet" ,figlet)
1408        ("flex" ,flex)
1409        ("gettext" ,gettext-minimal)
1410        ("libnl" ,libnl)
1411        ("mini-os"
1412        ,(origin
1413          (method git-fetch)
1414          (uri (git-reference
1415                (url "http://xenbits.xen.org/git-http/mini-os.git")
1416                (commit (string-append "xen-RELEASE-" version))))
1417          (sha256
1418           (base32
1419            "1i8pcl19n60i2m9vlg79q3nknpj209c9ic5x10wxaicx45kc107f"))
1420          (file-name "mini-os-git-checkout")))
1421        ("perl" ,perl)
1422        ; TODO: markdown
1423        ("pkg-config" ,pkg-config)
1424        ("python" ,python-2)
1425        ("wget" ,wget)
1426        ("cross-gcc" ,(cross-gcc "i686-linux-gnu"
1427                                 #:xbinutils (cross-binutils "i686-linux-gnu")
1428                                 #:libc (cross-libc "i686-linux-gnu")))
1429        ("cross-libc" ,(cross-libc "i686-linux-gnu")) ; header files
1430        ("cross-libc-static" ,(cross-libc "i686-linux-gnu") "static")))
1431     (home-page "https://xenproject.org/")
1432     (synopsis "Xen Virtual Machine Monitor")
1433     (description "This package provides the Xen Virtual Machine Monitor
1434 which is a hypervisor.")
1435     ;; TODO: Some files are licensed differently.  List those.
1436     (license license:gpl2)
1437     (supported-systems '("i686-linux" "x86_64-linux" "armhf-linux"))))
1438
1439 (define-public osinfo-db-tools
1440   (package
1441     (name "osinfo-db-tools")
1442     (version "1.8.0")
1443     (source (origin
1444               (method url-fetch)
1445               (uri (string-append "https://releases.pagure.org/libosinfo/osinfo-db-tools-"
1446                                   version ".tar.xz"))
1447
1448               (sha256
1449                (base32
1450                 "038q3gzdbkfkhpicj0755mw1q4gbvn57pslpw8n2dp3lds9im0g9"))))
1451     (build-system meson-build-system)
1452     (inputs
1453      `(("libsoup" ,libsoup)
1454        ("libxml2" ,libxml2)
1455        ("libxslt" ,libxslt)
1456        ("json-glib" ,json-glib)
1457        ("libarchive" ,libarchive)))
1458     (native-inputs
1459      `(("perl" ,perl)
1460        ("gobject-introspection" ,gobject-introspection)
1461        ("gettext" ,gettext-minimal)
1462        ("pkg-config" ,pkg-config)
1463        ;; Tests
1464        ("python" ,python)
1465        ("pytest" ,python-pytest)
1466        ("requests" ,python-requests)))
1467     (home-page "https://gitlab.com/libosinfo/osinfo-db-tools")
1468     (synopsis "Tools for managing the osinfo database")
1469     (description "This package contains a set of tools to assist
1470 administrators and developers in managing the database.")
1471     (license license:lgpl2.0+)))
1472
1473 (define-public osinfo-db
1474   (package
1475     (name "osinfo-db")
1476     (version "20200529")
1477     (source (origin
1478               (method url-fetch)
1479               (uri (string-append "https://releases.pagure.org/libosinfo/osinfo-db-"
1480                                   version ".tar.xz"))
1481               (sha256
1482                (base32
1483                 "0mbrf9j5wmjhc6jixvhp4jqyxixh1717lqrmzmipdg99xnzba81n"))))
1484     (build-system trivial-build-system)
1485     (arguments
1486      `(#:modules ((guix build utils))
1487        #:builder
1488        (begin
1489          (use-modules (guix build utils))
1490          (let* ((out (assoc-ref %outputs "out"))
1491                 (osinfo-dir (string-append out "/share/osinfo"))
1492                 (source (assoc-ref %build-inputs "source"))
1493                 (osinfo-db-import
1494                  (string-append (assoc-ref %build-inputs "osinfo-db-tools")
1495                                 "/bin/osinfo-db-import")))
1496            (mkdir-p osinfo-dir)
1497            (invoke osinfo-db-import "--dir" osinfo-dir source)
1498            #t))))
1499     (native-inputs
1500      `(("intltool" ,intltool)
1501        ("osinfo-db-tools" ,osinfo-db-tools)))
1502     (home-page "https://gitlab.com/libosinfo/osinfo-db")
1503     (synopsis "Database of information about operating systems")
1504     (description "Osinfo-db provides the database files for use with the
1505 libosinfo library.  It provides information about guest operating systems for
1506 use with virtualization provisioning tools")
1507     (license license:lgpl2.0+)))