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