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–2021 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 ;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
  19 ;;; Copyright © 2020 Brett Gilio <brettg@gnu.org>
  20 ;;;
  21 ;;; This file is part of GNU Guix.
  22 ;;;
  23 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  24 ;;; under the terms of the GNU General Public License as published by
  25 ;;; the Free Software Foundation; either version 3 of the License, or (at
  26 ;;; your option) any later version.
  27 ;;;
  28 ;;; GNU Guix is distributed in the hope that it will be useful, but
  29 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  30 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  31 ;;; GNU General Public License for more details.
  32 ;;;
  33 ;;; You should have received a copy of the GNU General Public License
  34 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  35
  36 (define-module (gnu packages virtualization)
  37   #:use-module (gnu packages)
  38   #:use-module (gnu packages admin)
  39   #:use-module (gnu packages assembly)
  40   #:use-module (gnu packages attr)
  41   #:use-module (gnu packages autotools)
  42   #:use-module (gnu packages backup)
  43   #:use-module (gnu packages base)
  44   #:use-module (gnu packages bison)
  45   #:use-module (gnu packages check)
  46   #:use-module (gnu packages cmake)
  47   #:use-module (gnu packages compression)
  48   #:use-module (gnu packages cross-base)
  49   #:use-module (gnu packages curl)
  50   #:use-module (gnu packages cyrus-sasl)
  51   #:use-module (gnu packages debian)
  52   #:use-module (gnu packages disk)
  53   #:use-module (gnu packages dns)
  54   #:use-module (gnu packages docbook)
  55   #:use-module (gnu packages documentation)
  56   #:use-module (gnu packages figlet)
  57   #:use-module (gnu packages firmware)
  58   #:use-module (gnu packages flex)
  59   #:use-module (gnu packages fontutils)
  60   #:use-module (gnu packages freedesktop)
  61   #:use-module (gnu packages gettext)
  62   #:use-module (gnu packages gl)
  63   #:use-module (gnu packages glib)
  64   #:use-module (gnu packages gnome)
  65   #:use-module (gnu packages gnupg)
  66   #:use-module (gnu packages golang)
  67   #:use-module (gnu packages graphviz)
  68   #:use-module (gnu packages gtk)
  69   #:use-module (gnu packages haskell)
  70   #:use-module (gnu packages haskell-apps)
  71   #:use-module (gnu packages haskell-check)
  72   #:use-module (gnu packages haskell-crypto)
  73   #:use-module (gnu packages haskell-web)
  74   #:use-module (gnu packages haskell-xyz)
  75   #:use-module (gnu packages image)
  76   #:use-module (gnu packages libbsd)
  77   #:use-module (gnu packages libusb)
  78   #:use-module (gnu packages linux)
  79   #:use-module (gnu packages m4)
  80   #:use-module (gnu packages ncurses)
  81   #:use-module (gnu packages nettle)
  82   #:use-module (gnu packages networking)
  83   #:use-module (gnu packages onc-rpc)
  84   #:use-module (gnu packages package-management)
  85   #:use-module (gnu packages perl)
  86   #:use-module (gnu packages pcre)
  87   #:use-module (gnu packages pkg-config)
  88   #:use-module (gnu packages polkit)
  89   #:use-module (gnu packages protobuf)
  90   #:use-module (gnu packages python)
  91   #:use-module (gnu packages python-build)
  92   #:use-module (gnu packages python-check)
  93   #:use-module (gnu packages python-crypto)
  94   #:use-module (gnu packages python-web)
  95   #:use-module (gnu packages python-xyz)
  96   #:use-module (gnu packages pulseaudio)
  97   #:use-module (gnu packages selinux)
  98   #:use-module (gnu packages sdl)
  99   #:use-module (gnu packages sphinx)
 100   #:use-module (gnu packages spice)
 101   #:use-module (gnu packages ssh)
 102   #:use-module (gnu packages texinfo)
 103   #:use-module (gnu packages textutils)
 104   #:use-module (gnu packages tls)
 105   #:use-module (gnu packages web)
 106   #:use-module (gnu packages wget)
 107   #:use-module (gnu packages xdisorg)
 108   #:use-module (gnu packages xml)
 109   #:use-module (gnu packages xorg)
 110   #:use-module (guix build-system cmake)
 111   #:use-module (guix build-system gnu)
 112   #:use-module (guix build-system go)
 113   #:use-module (guix build-system meson)
 114   #:use-module (guix build-system python)
 115   #:use-module (guix build-system trivial)
 116   #:use-module (guix download)
 117   #:use-module (guix git-download)
 118   #:use-module ((guix licenses) #:prefix license:)
 119   #:use-module (guix packages)
 120   #:use-module (guix utils)
 121   #:use-module (srfi srfi-1)
 122   #:use-module (srfi srfi-26)
 123   #:use-module (ice-9 match))
 124
 125 (define (qemu-patch commit file-name sha256-bv)
 126   "Return an origin for COMMIT."
 127   (origin
 128     (method url-fetch)
 129     (uri (string-append
 130           "http://git.qemu.org/?p=qemu.git;a=commitdiff_plain;h="
 131           commit))
 132     (hash (content-hash sha256-bv sha256))
 133     (file-name file-name)))
 134
 135 (define-public qemu
 136   (package
 137     (name "qemu")
 138     (version "5.1.0")
 139     (source
 140      (origin
 141        (method url-fetch)
 142        (uri (string-append "https://download.qemu.org/qemu-"
 143                            version ".tar.xz"))
 144        (sha256
 145         (base32
 146          "1rd41wwlvp0vpialjp2czs6i3lsc338xc72l3zkbb7ixjfslw5y9"))
 147        (patches (search-patches "qemu-build-info-manual.patch"
 148                                 "qemu-CVE-2021-20203.patch"))
 149        (modules '((guix build utils)))
 150        (snippet
 151         '(begin
 152            ;; Fix a bug in the do_ioctl_ifconf() function of qemu to
 153            ;; make ioctl(…, SIOCGIFCONF, …) work for emulated 64 bit
 154            ;; architectures.  The size of struct ifreq is handled
 155            ;; incorrectly.
 156            ;; https://lists.nongnu.org/archive/html/qemu-devel/2021-01/msg01545.html
 157            (substitute* '("linux-user/syscall.c")
 158              (("^([[:blank:]]*)const argtype ifreq_arg_type.*$" line indent)
 159               (string-append line indent "const argtype ifreq_max_type[] = "
 160                              "{ MK_STRUCT(STRUCT_ifmap_ifreq) };\n"))
 161              (("^([[:blank:]]*)target_ifreq_size[[:blank:]]=.*$" _ indent)
 162               (string-append indent "target_ifreq_size = "
 163                              "thunk_type_size(ifreq_max_type, 0);")))))))
 164     (outputs '("out" "static" "doc"))   ;4.7 MiB of HTML docs
 165     (build-system gnu-build-system)
 166     (arguments
 167      ;; FIXME: Disable tests on i686 to work around
 168      ;; <https://bugs.gnu.org/40527>.
 169      `(#:tests? ,(or (%current-target-system)
 170                      (not (string=? "i686-linux" (%current-system))))
 171        #:configure-flags
 172        (let ((gcc (string-append (assoc-ref %build-inputs "gcc") "/bin/gcc"))
 173              (out (assoc-ref %outputs "out")))
 174          (list (string-append "--cc=" gcc)
 175                ;; Some architectures insist on using HOST_CC.
 176                (string-append "--host-cc=" gcc)
 177                (string-append "--prefix=" out)
 178                "--sysconfdir=/etc"
 179                (string-append "--smbd=" out "/libexec/samba-wrapper")
 180                "--disable-debug-info"   ;for space considerations
 181                ;; The binaries need to be linked against -lrt.
 182                (string-append "--extra-ldflags=-lrt")))
 183        ;; Make build and test output verbose to facilitate investigation upon failure.
 184        #:make-flags '("V=1")
 185        #:modules ((srfi srfi-1)
 186                   (srfi srfi-26)
 187                   (ice-9 ftw)
 188                   (ice-9 match)
 189                   ,@%gnu-build-system-modules)
 190        #:phases
 191        (modify-phases %standard-phases
 192          (add-after 'set-paths 'hide-glibc
 193            (lambda* (#:key inputs #:allow-other-keys)
 194              ;; Work around https://issues.guix.info/issue/36882.  We need to
 195              ;; remove glibc from C_INCLUDE_PATH so that the one hardcoded in GCC,
 196              ;; at the bottom of GCC include search-path is used.
 197              (let* ((filters '("libc"))
 198                     (input-directories
 199                      (filter-map (lambda (input)
 200                                    (match input
 201                                      ((name . dir)
 202                                       (and (not (member name filters))
 203                                            dir))))
 204                                  inputs)))
 205                (set-path-environment-variable "C_INCLUDE_PATH"
 206                                               '("include")
 207                                               input-directories))))
 208          (add-after 'unpack 'extend-test-time-outs
 209            (lambda _
 210              ;; These tests can time out on heavily-loaded and/or slow storage.
 211              (substitute* (cons* "tests/qemu-iotests/common.qemu"
 212                                  (find-files "tests/qemu-iotests" "^[0-9]+$"))
 213                (("QEMU_COMM_TIMEOUT=[0-9]+" match)
 214                 (string-append match "9")))))
 215          (add-after 'unpack 'disable-unusable-tests
 216            (lambda _
 217              (substitute* "tests/Makefile.include"
 218                ;; Comment out the test-qga test, which needs /sys and
 219                ;; fails within the build environment.
 220                (("check-unit-.* tests/test-qga" all)
 221                 (string-append "# " all))
 222                ;; Comment out the test-char test, which needs networking and
 223                ;; fails within the build environment.
 224                (("check-unit-.* tests/test-char" all)
 225                 (string-append "# " all)))
 226              (substitute* "tests/qtest/Makefile.include"
 227                ;; Disable the following test, which triggers a crash on some
 228                ;; x86 CPUs (see https://issues.guix.info/43048 and
 229                ;; https://bugs.launchpad.net/qemu/+bug/1896263).
 230                (("check-qtest-i386-y \\+= bios-tables-test" all)
 231                 (string-append "# " all)))))
 232          (add-after 'unpack 'patch-test-shebangs
 233            (lambda _
 234              (substitute* "tests/qemu-iotests/check"
 235                (("#!/usr/bin/env python3")
 236                 (string-append "#!" (which "python3"))))))
 237          (add-after 'patch-source-shebangs 'patch-/bin/sh-references
 238            (lambda _
 239              ;; Ensure the executables created by these source files reference
 240              ;; /bin/sh from the store so they work inside the build container.
 241              (substitute* '("block/cloop.c" "migration/exec.c"
 242                             "net/tap.c" "tests/qtest/libqtest.c")
 243                (("/bin/sh") (which "sh")))))
 244          (replace 'configure
 245            (lambda* (#:key inputs outputs configure-flags #:allow-other-keys)
 246              ;; The `configure' script doesn't understand some of the
 247              ;; GNU options.  Thus, add a new phase that's compatible.
 248              (let ((out (assoc-ref outputs "out")))
 249                (setenv "SHELL" (which "bash"))
 250                ;; Ensure config.status gets the correct shebang off the bat.
 251                ;; The build system gets confused if we change it later and
 252                ;; attempts to re-run the whole configury, and fails.
 253                (substitute* "configure"
 254                  (("#!/bin/sh")
 255                   (string-append "#!" (which "sh"))))
 256                (mkdir-p "b/qemu")
 257                (chdir "b/qemu")
 258                (apply invoke "../../configure" configure-flags))))
 259          ;; Configure, build and install QEMU user-emulation static binaries.
 260          (add-after 'configure 'configure-user-static
 261            (lambda* (#:key inputs outputs #:allow-other-keys)
 262              (let* ((gcc (string-append (assoc-ref inputs "gcc") "/bin/gcc"))
 263                     (static (assoc-ref outputs "static"))
 264                     ;; This is the common set of configure flags; it is
 265                     ;; duplicated here to isolate this phase from manipulations
 266                     ;; to the #:configure-flags build argument, as done in
 267                     ;; derived packages such as qemu-minimal.
 268                     (configure-flags (list (string-append "--cc=" gcc)
 269                                            (string-append "--host-cc=" gcc)
 270                                            "--sysconfdir=/etc"
 271                                            "--disable-debug-info")))
 272                (mkdir-p "../user-static")
 273                (with-directory-excursion "../user-static"
 274                  (apply invoke "../../configure"
 275                         "--static"
 276                         "--disable-docs" ;already built
 277                         "--disable-system"
 278                         "--enable-linux-user"
 279                         (string-append "--prefix=" static)
 280                         configure-flags)))))
 281          (add-after 'build 'build-user-static
 282            (lambda args
 283              (with-directory-excursion "../user-static"
 284                (apply (assoc-ref %standard-phases 'build) args))))
 285          (add-after 'install 'install-user-static
 286            (lambda* (#:key outputs #:allow-other-keys)
 287              (let* ((static (assoc-ref outputs "static"))
 288                     (bin (string-append static "/bin")))
 289                (with-directory-excursion "../user-static"
 290                  (for-each (cut install-file <> bin)
 291                            (append-map (cut find-files <> "^qemu-")
 292                                        (scandir "."
 293                                                 (cut string-suffix?
 294                                                      "-linux-user" <>))))))))
 295          ;; Create a wrapper for Samba. This allows QEMU to use Samba without
 296          ;; pulling it in as an input. Note that you need to explicitly install
 297          ;; Samba in your Guix profile for Samba support.
 298          (add-after 'install 'create-samba-wrapper
 299            (lambda* (#:key inputs outputs #:allow-other-keys)
 300              (let* ((out    (assoc-ref outputs "out"))
 301                     (libexec (string-append out "/libexec")))
 302                (call-with-output-file "samba-wrapper"
 303                  (lambda (port)
 304                    (format port "#!/bin/sh
 305 exec smbd $@")))
 306                (chmod "samba-wrapper" #o755)
 307                (install-file "samba-wrapper" libexec))))
 308          (add-after 'install 'move-html-doc
 309            (lambda* (#:key inputs outputs #:allow-other-keys)
 310              (let* ((out (assoc-ref outputs "out"))
 311                     (doc (assoc-ref outputs "doc"))
 312                     (qemu-doc (string-append doc "/share/doc/qemu-" ,version)))
 313                (mkdir-p qemu-doc)
 314                (rename-file (string-append out "/share/doc/qemu")
 315                             (string-append qemu-doc "/html"))))))))
 316     (inputs                             ; TODO: Add optional inputs.
 317      `(("alsa-lib" ,alsa-lib)
 318        ("attr" ,attr)
 319        ("glib" ,glib)
 320        ("gtk+" ,gtk+)
 321        ("libaio" ,libaio)
 322        ("libattr" ,attr)
 323        ("libcacard" ,libcacard)  ; smartcard support
 324        ("libcap-ng" ,libcap-ng)  ; virtfs support requires libcap-ng & libattr
 325        ("libdrm" ,libdrm)
 326        ("libepoxy" ,libepoxy)
 327        ("libjpeg" ,libjpeg-turbo)
 328        ("libpng" ,libpng)
 329        ("libseccomp" ,libseccomp)
 330        ("libusb" ,libusb)               ;USB pass-through support
 331        ("mesa" ,mesa)
 332        ("ncurses" ,ncurses)
 333        ;; ("pciutils" ,pciutils)
 334        ("pixman" ,pixman)
 335        ("pulseaudio" ,pulseaudio)
 336        ("sdl2" ,sdl2)
 337        ("spice" ,spice)
 338        ("usbredir" ,usbredir)
 339        ("util-linux" ,util-linux)
 340        ("vde2" ,vde2)
 341        ("virglrenderer" ,virglrenderer)
 342        ("zlib" ,zlib)))
 343     (native-inputs `(("gettext" ,gettext-minimal)
 344                      ("glib:bin" ,glib "bin") ; gtester, etc.
 345                      ("perl" ,perl)
 346                      ("flex" ,flex)
 347                      ("bison" ,bison)
 348                      ("pkg-config" ,pkg-config)
 349                      ("python-wrapper" ,python-wrapper)
 350                      ("python-sphinx" ,python-sphinx)
 351                      ("texinfo" ,texinfo)
 352                      ;; The following static libraries are required to build
 353                      ;; the static output of QEMU.
 354                      ("glib-static" ,glib-static)
 355                      ("pcre:static" ,pcre "static")
 356                      ("zlib:static" ,zlib "static")))
 357     (home-page "https://www.qemu.org")
 358     (synopsis "Machine emulator and virtualizer")
 359     (description
 360      "QEMU is a generic machine emulator and virtualizer.
 361
 362 When used as a machine emulator, QEMU can run OSes and programs made for one
 363 machine (e.g. an ARM board) on a different machine---e.g., your own PC.  By
 364 using dynamic translation, it achieves very good performance.
 365
 366 When used as a virtualizer, QEMU achieves near native performances by
 367 executing the guest code directly on the host CPU.  QEMU supports
 368 virtualization when executing under the Xen hypervisor or using
 369 the KVM kernel module in Linux.  When using KVM, QEMU can virtualize x86,
 370 server and embedded PowerPC, and S390 guests.")
 371
 372     ;; Many files are GPLv2+, but some are GPLv2-only---e.g., `memory.c'.
 373     (license license:gpl2)
 374
 375     ;; Several tests fail on MIPS; see <http://hydra.gnu.org/build/117914>.
 376     (supported-systems (fold delete %supported-systems
 377                              '("mips64el-linux" "i586-gnu")))))
 378
 379 (define-public qemu-minimal
 380   ;; QEMU without GUI support, only supporting the host's architecture
 381   (package
 382     (inherit qemu)
 383     (name "qemu-minimal")
 384     (synopsis
 385      "Machine emulator and virtualizer (without GUI) for the host architecture")
 386     (arguments
 387      (substitute-keyword-arguments (package-arguments qemu)
 388        ((#:configure-flags configure-flags '(list))
 389         ;; Restrict to the host's architecture.
 390         (let* ((system (or (%current-target-system)
 391                            (%current-system)))
 392                (target-list-arg
 393                 (match system
 394                   ((? (cut string-prefix? "i686" <>))
 395                    "--target-list=i386-softmmu")
 396                   ((? (cut string-prefix? "x86_64" <>))
 397                    "--target-list=i386-softmmu,x86_64-softmmu")
 398                   ((? (cut string-prefix? "mips64" <>))
 399                    (string-append "--target-list=mips-softmmu,mipsel-softmmu,"
 400                                   "mips64-softmmu,mips64el-softmmu"))
 401                   ((? (cut string-prefix? "mips" <>))
 402                    "--target-list=mips-softmmu,mipsel-softmmu")
 403                   ((? (cut string-prefix? "aarch64" <>))
 404                    "--target-list=arm-softmmu,aarch64-softmmu")
 405                   ((? (cut string-prefix? "arm" <>))
 406                    "--target-list=arm-softmmu")
 407                   ((? (cut string-prefix? "alpha" <>))
 408                    "--target-list=alpha-softmmu")
 409                   ((? (cut string-prefix? "powerpc64" <>))
 410                    "--target-list=ppc-softmmu,ppc64-softmmu")
 411                   ((? (cut string-prefix? "powerpc" <>))
 412                    "--target-list=ppc-softmmu")
 413                   ((? (cut string-prefix? "s390" <>))
 414                    "--target-list=s390x-softmmu")
 415                   ((? (cut string-prefix? "riscv" <>))
 416                    "--target-list=riscv32-softmmu,riscv64-softmmu")
 417                   (else       ; An empty list actually builds all the targets.
 418                    '()))))
 419           `(cons ,target-list-arg ,configure-flags)))))
 420
 421     ;; Remove dependencies on optional libraries, notably GUI libraries.
 422     (native-inputs (fold alist-delete (package-native-inputs qemu)
 423                          '("gettext")))
 424     (inputs (fold alist-delete (package-inputs qemu)
 425                   '("libusb" "mesa" "sdl2" "spice" "virglrenderer" "gtk+"
 426                     "usbredir" "libdrm" "libepoxy" "pulseaudio" "vde2"
 427                     "libcacard")))))
 428
 429 (define (system->qemu-target system)
 430   (cond
 431    ((string-prefix? "i686" system)
 432     "qemu-system-i386")
 433    ((string-prefix? "arm" system)
 434     "qemu-system-arm")
 435    (else
 436     (string-append "qemu-system-" (match (string-split system #\-)
 437                                     ((arch kernel) arch)
 438                                     (_ system))))))
 439
 440 (define-public ganeti
 441   (package
 442     (name "ganeti")
 443     ;; Note: we use a pre-release for Python 3 compatibility as well as many
 444     ;; other fixes.
 445     (version "3.0.0beta1-24-g024cc9fa2")
 446     (source (origin
 447               (method git-fetch)
 448               (uri (git-reference
 449                     (url "https://github.com/ganeti/ganeti")
 450                     (commit (string-append "v" version))))
 451               (sha256
 452                (base32 "1ll34qd2mifni3bhg7cnir3xfnkafig8ch33qndqwrsby0y5ssia"))
 453               (file-name (git-file-name name version))
 454               (patches (search-patches "ganeti-shepherd-support.patch"
 455                                        "ganeti-shepherd-master-failover.patch"
 456                                        "ganeti-deterministic-manual.patch"
 457                                        "ganeti-drbd-compat.patch"
 458                                        "ganeti-os-disk-size.patch"
 459                                        "ganeti-haskell-pythondir.patch"
 460                                        "ganeti-disable-version-symlinks.patch"
 461                                        "ganeti-preserve-PYTHONPATH.patch"))))
 462     (build-system gnu-build-system)
 463     (arguments
 464      `(#:imported-modules (,@%gnu-build-system-modules
 465                            (guix build haskell-build-system)
 466                            (guix build python-build-system))
 467        #:modules (,@%gnu-build-system-modules
 468                   ((guix build haskell-build-system) #:prefix haskell:)
 469                   ((guix build python-build-system) #:select (python-version))
 470                   (ice-9 rdelim))
 471
 472        ;; The default test target includes a lot of checks that are only really
 473        ;; relevant for developers such as NEWS file checking, line lengths, etc.
 474        ;; We are only interested in the "py-tests" and "hs-tests" targets: this
 475        ;; is the closest we've got even though it includes a little more.
 476        #:test-target "check-TESTS"
 477
 478        #:configure-flags
 479        (list "--localstatedir=/var"
 480              "--sharedstatedir=/var"
 481              "--sysconfdir=/etc"
 482              "--enable-haskell-tests"
 483
 484              ;; By default, the build system installs everything to versioned
 485              ;; directories such as $libdir/3.0 and relies on a $libdir/default
 486              ;; symlink pointed from /etc/ganeti/{lib,share} to actually function.
 487              ;; This is done to accommodate installing multiple versions in
 488              ;; parallel, but is of little use to us as Guix users can just
 489              ;; roll back and forth.  Thus, disable it for simplicity.
 490              "--disable-version-links"
 491
 492              ;; Ganeti can optionally take control over SSH host keys and
 493              ;; distribute them to nodes as they are added, and also rotate keys
 494              ;; with 'gnt-cluster renew-crypto --new-ssh-keys'.  Thus it needs to
 495              ;; know how to restart the SSH daemon.
 496              "--with-sshd-restart-command='herd restart ssh-daemon'"
 497
 498              ;; Look for OS definitions in this directory by default.  It can
 499              ;; be changed in the cluster configuration.
 500              "--with-os-search-path=/run/current-system/profile/share/ganeti/os"
 501
 502              ;; The default QEMU executable to use.  We don't use the package
 503              ;; here because this entry is stored in the cluster configuration.
 504              (string-append "--with-kvm-path=/run/current-system/profile/bin/"
 505                             ,(system->qemu-target (%current-system))))
 506        #:phases
 507        (modify-phases %standard-phases
 508          (add-after 'unpack 'create-vcs-version
 509            (lambda _
 510              ;; If we are building from a git checkout, we need to create a
 511              ;; 'vcs-version' file manually because the build system does
 512              ;; not have access to the git repository information.
 513              (unless (file-exists? "vcs-version")
 514                (call-with-output-file "vcs-version"
 515                  (lambda (port)
 516                    (format port "v~a~%" ,version))))
 517              #t))
 518          (add-after 'unpack 'patch-absolute-file-names
 519            (lambda _
 520              (substitute* '("lib/utils/process.py"
 521                             "lib/utils/text.py"
 522                             "src/Ganeti/Constants.hs"
 523                             "src/Ganeti/HTools/CLI.hs"
 524                             "test/py/ganeti.config_unittest.py"
 525                             "test/py/ganeti.hooks_unittest.py"
 526                             "test/py/ganeti.utils.process_unittest.py"
 527                             "test/py/ganeti.utils.text_unittest.py"
 528                             "test/py/ganeti.utils.wrapper_unittest.py")
 529                (("/bin/sh") (which "sh"))
 530                (("/bin/bash") (which "bash"))
 531                (("/usr/bin/env") (which "env"))
 532                (("/bin/true") (which "true")))
 533
 534              ;; This script is called by the node daemon at startup to perform
 535              ;; sanity checks on the cluster IP addresses, and it is also used
 536              ;; in a master-failover scenario.  Add absolute references to
 537              ;; avoid propagating these executables.
 538              (substitute* "tools/master-ip-setup"
 539                (("arping") (which "arping"))
 540                (("ndisc6") (which "ndisc6"))
 541                (("fping") (which "fping"))
 542                (("grep") (which "grep"))
 543                (("ip addr") (string-append (which "ip") " addr")))
 544              #t))
 545          (add-after 'unpack 'override-builtin-PATH
 546            (lambda _
 547              ;; Ganeti runs OS install scripts and similar with a built-in
 548              ;; hard coded PATH.  Patch so it works on Guix System.
 549              (substitute* "src/Ganeti/Constants.hs"
 550                (("/sbin:/bin:/usr/sbin:/usr/bin")
 551                 "/run/setuid-programs:/run/current-system/profile/sbin:\
 552 /run/current-system/profile/bin"))
 553              #t))
 554          (add-after 'bootstrap 'patch-sphinx-version-detection
 555            (lambda _
 556              ;; The build system runs 'sphinx-build --version' to verify that
 557              ;; the Sphinx is recent enough, but does not expect the
 558              ;; .sphinx-build-real executable name created by the Sphinx wrapper.
 559              (substitute* "configure"
 560                (("\\$SPHINX --version 2>&1")
 561                 "$SPHINX --version 2>&1 | sed 's/.sphinx-build-real/sphinx-build/g'"))
 562              #t))
 563
 564          ;; The build system invokes Cabal and GHC, which do not work with
 565          ;; GHC_PACKAGE_PATH: <https://github.com/haskell/cabal/issues/3728>.
 566          ;; Tweak the build system to do roughly what haskell-build-system does.
 567          (add-before 'configure 'configure-haskell
 568            (assoc-ref haskell:%standard-phases 'setup-compiler))
 569          (add-after 'configure 'do-not-use-GHC_PACKAGE_PATH
 570            (lambda _
 571              (unsetenv "GHC_PACKAGE_PATH")
 572              (substitute* "Makefile"
 573                (("\\$\\(CABAL\\)")
 574                 "$(CABAL) --package-db=../package.conf.d")
 575                (("\\$\\(GHC\\)")
 576                 "$(GHC) -package-db=../package.conf.d"))
 577              #t))
 578          (add-after 'configure 'make-ghc-use-shared-libraries
 579            (lambda _
 580              (substitute* "Makefile"
 581                (("HFLAGS =") "HFLAGS = -dynamic -fPIC"))
 582              #t))
 583          (add-after 'configure 'fix-installation-directories
 584            (lambda _
 585              (substitute* "Makefile"
 586                ;; Do not attempt to create /var during install.
 587                (("\\$\\(DESTDIR\\)\\$\\{localstatedir\\}")
 588                 "$(DESTDIR)${prefix}${localstatedir}")
 589                ;; Similarly, do not attempt to install the sample ifup scripts
 590                ;; to /etc/ganeti.
 591                (("\\$\\(DESTDIR\\)\\$\\(ifupdir\\)")
 592                 "$(DESTDIR)${prefix}$(ifupdir)"))
 593              #t))
 594          (add-before 'build 'adjust-tests
 595            (lambda _
 596              ;; Disable tests that can not run.  Do it early to prevent
 597              ;; touching the Makefile later and triggering a needless rebuild.
 598              (substitute* "Makefile"
 599                ;; These tests expect the presence of a 'root' user (via
 600                ;; ganeti/runtime.py), which fails in the build environment.
 601                (("test/py/ganeti\\.asyncnotifier_unittest\\.py") "")
 602                (("test/py/ganeti\\.backend_unittest\\.py") "")
 603                (("test/py/ganeti\\.daemon_unittest\\.py") "")
 604                (("test/py/ganeti\\.tools\\.ensure_dirs_unittest\\.py") "")
 605                (("test/py/ganeti\\.utils\\.io_unittest-runasroot\\.py") "")
 606                ;; Disable the bash_completion test, as it requires the full
 607                ;; bash instead of bash-minimal.
 608                (("test/py/bash_completion\\.bash")
 609                 "")
 610                ;; This test requires networking.
 611                (("test/py/import-export_unittest\\.bash")
 612                 ""))
 613
 614              ;; Many of the Makefile targets reset PYTHONPATH before running
 615              ;; the Python interpreter, which does not work very well for us.
 616              (substitute* "Makefile"
 617                (("PYTHONPATH=")
 618                 (string-append "PYTHONPATH=" (getenv "PYTHONPATH") ":")))
 619              #t))
 620          (add-after 'build 'build-bash-completions
 621            (lambda _
 622              (let ((orig-pythonpath (getenv "PYTHONPATH")))
 623                (setenv "PYTHONPATH" (string-append ".:" orig-pythonpath))
 624                (invoke "./autotools/build-bash-completion")
 625                (setenv "PYTHONPATH" orig-pythonpath)
 626                #t)))
 627          (add-before 'check 'pre-check
 628            (lambda* (#:key inputs #:allow-other-keys)
 629              ;; Set TZDIR so that time zones are found.
 630              (setenv "TZDIR" (string-append (assoc-ref inputs "tzdata")
 631                                             "/share/zoneinfo"))
 632
 633              ;; This test checks whether PYTHONPATH is untouched, and extends
 634              ;; it to include test directories if so.  Add an else branch for
 635              ;; our modified PYTHONPATH, in order to prevent a confusing test
 636              ;; failure where expired certificates are not cleaned because
 637              ;; check-cert-expired is silently crashing.
 638              (substitute* "test/py/ganeti-cleaner_unittest.bash"
 639                (("then export PYTHONPATH=(.*)" all testpath)
 640                 (string-append all "else export PYTHONPATH="
 641                                (getenv "PYTHONPATH") ":" testpath "\n")))
 642
 643              (substitute* "test/py/ganeti.utils.process_unittest.py"
 644                ;; This test attempts to run an executable with
 645                ;; RunCmd(..., reset_env=True), which fails because the default
 646                ;; PATH from Constants.hs does not exist in the build container.
 647                ((".*def testResetEnv.*" all)
 648                 (string-append "  @unittest.skipIf(True, "
 649                                "\"cannot reset env in the build container\")\n"
 650                                all))
 651
 652                ;; XXX: Somehow this test fails in the build container, but
 653                ;; works in 'guix environment -C', even without /bin/sh?
 654                ((".*def testPidFile.*" all)
 655                 (string-append "  @unittest.skipIf(True, "
 656                                "\"testPidFile fails in the build container\")\n"
 657                                all)))
 658
 659              ;; XXX: Why are these links not added automatically.
 660              (with-directory-excursion "test/hs"
 661                (for-each (lambda (file)
 662                            (symlink "../../src/htools" file))
 663                          '("hspace" "hscan" "hinfo" "hbal" "hroller"
 664                            "hcheck" "hail" "hsqueeze")))
 665              #t))
 666          (add-after 'install 'install-bash-completions
 667            (lambda* (#:key outputs #:allow-other-keys)
 668              (let* ((out (assoc-ref outputs "out"))
 669                     (compdir (string-append out "/etc/bash_completion.d")))
 670                (mkdir-p compdir)
 671                (copy-file "doc/examples/bash_completion"
 672                              (string-append compdir "/ganeti"))
 673                ;; The one file contains completions for many different
 674                ;; executables.  Create symlinks for found completions.
 675                (with-directory-excursion compdir
 676                  (for-each
 677                   (lambda (prog) (symlink "ganeti" prog))
 678                   (call-with-input-file "ganeti"
 679                     (lambda (port)
 680                       (let loop ((line (read-line port))
 681                                  (progs '()))
 682                         (if (eof-object? line)
 683                             progs
 684                             (if (string-prefix? "complete" line)
 685                                 (loop (read-line port)
 686                                       ;; Extract "prog" from lines of the form:
 687                                       ;; "complete -F _prog -o filenames prog".
 688                                       ;; Note that 'burnin' is listed with the
 689                                       ;; absolute file name, which is why we
 690                                       ;; run everything through 'basename'.
 691                                       (cons (basename (car (reverse (string-split
 692                                                                      line #\ ))))
 693                                             progs))
 694                                 (loop (read-line port) progs))))))))
 695                #t)))
 696          ;; Wrap all executables with PYTHONPATH.  We can't borrow the phase
 697          ;; from python-build-system because we also need to wrap the scripts
 698          ;; in $out/lib/ganeti such as "node-daemon-setup".
 699          (add-after 'install 'wrap
 700            (lambda* (#:key inputs outputs #:allow-other-keys)
 701              (let* ((out (assoc-ref outputs "out"))
 702                     (sbin (string-append out "/sbin"))
 703                     (lib (string-append out "/lib"))
 704                     (python (assoc-ref inputs "python"))
 705                     (major+minor (python-version python))
 706                     (PYTHONPATH (string-append lib "/python" major+minor
 707                                                "/site-packages:"
 708                                                (getenv "PYTHONPATH"))))
 709                (define (shell-script? file)
 710                  (call-with-ascii-input-file file
 711                    (lambda (port)
 712                      (let ((shebang (false-if-exception (read-line port))))
 713                        (and shebang
 714                             (string-prefix? "#!" shebang)
 715                             (or (string-contains shebang "/bin/bash")
 716                                 (string-contains shebang "/bin/sh")))))))
 717
 718                (define (wrap? file)
 719                  ;; Do not wrap shell scripts because some are meant to be
 720                  ;; sourced, which breaks if they are wrapped.  We do wrap
 721                  ;; the Haskell executables because some call out to Python
 722                  ;; directly.
 723                  (and (executable-file? file)
 724                       (not (symbolic-link? file))
 725                       (not (shell-script? file))))
 726
 727                (for-each (lambda (file)
 728                            (wrap-program file
 729                              `("PYTHONPATH" ":" prefix (,PYTHONPATH))))
 730                          (filter wrap?
 731                                  (append (find-files (string-append lib "/ganeti"))
 732                                          (find-files sbin))))
 733                #t))))))
 734     (native-inputs
 735      `(("haskell" ,ghc)
 736        ("cabal" ,cabal-install)
 737        ("m4" ,m4)
 738
 739        ;; These inputs are necessary to bootstrap the package, because we
 740        ;; have patched the build system.
 741        ("autoconf" ,autoconf)
 742        ("automake" ,automake)
 743
 744        ;; For the documentation.
 745        ("python-docutils" ,python-docutils)
 746        ("sphinx" ,python-sphinx)
 747        ("pandoc" ,pandoc)
 748        ("dot" ,graphviz)
 749
 750        ;; Test dependencies.
 751        ("fakeroot" ,fakeroot)
 752        ("ghc-temporary" ,ghc-temporary)
 753        ("ghc-test-framework" ,ghc-test-framework)
 754        ("ghc-test-framework-hunit" ,ghc-test-framework-hunit)
 755        ("ghc-test-framework-quickcheck2" ,ghc-test-framework-quickcheck2)
 756        ("python-mock" ,python-mock)
 757        ("python-pyyaml" ,python-pyyaml)
 758        ("openssh" ,openssh)
 759        ("procps" ,procps)
 760        ("shelltestrunner" ,shelltestrunner)
 761        ("tzdata" ,tzdata-for-tests)))
 762     (inputs
 763      `(("arping" ,iputils)              ;must be the iputils version
 764        ("curl" ,curl)
 765        ("fping" ,fping)
 766        ("iproute2" ,iproute)
 767        ("ndisc6" ,ndisc6)
 768        ("socat" ,socat)
 769        ("qemu" ,qemu-minimal)           ;for qemu-img
 770        ("ghc-attoparsec" ,ghc-attoparsec)
 771        ("ghc-base64-bytestring" ,ghc-base64-bytestring)
 772        ("ghc-cryptonite" ,ghc-cryptonite)
 773        ("ghc-curl" ,ghc-curl)
 774        ("ghc-hinotify" ,ghc-hinotify)
 775        ("ghc-hslogger" ,ghc-hslogger)
 776        ("ghc-json" ,ghc-json)
 777        ("ghc-lens" ,ghc-lens)
 778        ("ghc-lifted-base" ,ghc-lifted-base)
 779        ("ghc-network" ,ghc-network)
 780        ("ghc-old-time" ,ghc-old-time)
 781        ("ghc-psqueue" ,ghc-psqueue)
 782        ("ghc-regex-pcre" ,ghc-regex-pcre)
 783        ("ghc-utf8-string" ,ghc-utf8-string)
 784        ("ghc-zlib" ,ghc-zlib)
 785
 786        ;; For the optional metadata daemon.
 787        ("ghc-snap-core" ,ghc-snap-core)
 788        ("ghc-snap-server" ,ghc-snap-server)
 789
 790        ("python" ,python)
 791        ("python-pyopenssl" ,python-pyopenssl)
 792        ("python-simplejson" ,python-simplejson)
 793        ("python-pyparsing" ,python-pyparsing)
 794        ("python-pyinotify" ,python-pyinotify)
 795        ("python-pycurl" ,python-pycurl)
 796        ("python-bitarray" ,python-bitarray)
 797        ("python-paramiko" ,python-paramiko)
 798        ("python-psutil" ,python-psutil)))
 799     (home-page "https://www.ganeti.org/")
 800     (synopsis "Cluster-based virtual machine management system")
 801     (description
 802      "Ganeti is a virtual machine management tool built on top of existing
 803 virtualization technologies such as Xen or KVM.  Ganeti controls:
 804
 805 @itemize @bullet
 806 @item Disk creation management;
 807 @item Operating system installation for instances (in co-operation with
 808 OS-specific install scripts); and
 809 @item Startup, shutdown, and failover between physical systems.
 810 @end itemize
 811
 812 Ganeti is designed to facilitate cluster management of virtual servers and
 813 to provide fast and simple recovery after physical failures, using
 814 commodity hardware.")
 815     (license license:bsd-2)))
 816
 817 (define-public ganeti-instance-guix
 818   (package
 819     (name "ganeti-instance-guix")
 820     (version "0.6")
 821     (home-page "https://github.com/mbakke/ganeti-instance-guix")
 822     (source (origin
 823               (method git-fetch)
 824               (uri (git-reference (url home-page) (commit version)))
 825               (file-name (git-file-name name version))
 826               (sha256
 827                (base32
 828                 "0aa08irpcpns6mhjgsplc5f0p8ab1qcr9ah1gj5z66kxgqyflzrp"))))
 829     (build-system gnu-build-system)
 830     (arguments
 831      '(#:configure-flags '("--sysconfdir=/etc" "--localstatedir=/var")))
 832     (native-inputs
 833      `(("autoconf" ,autoconf)
 834        ("automake" ,automake)))
 835     (inputs
 836      `(("util-linux" ,util-linux)
 837        ("qemu-img" ,qemu-minimal)))
 838     (synopsis "Guix OS integration for Ganeti")
 839     (description
 840      "This package provides a guest OS definition for Ganeti that uses
 841 Guix to build virtual machines.")
 842     (license license:gpl3+)))
 843
 844 (define-public ganeti-instance-debootstrap
 845   (package
 846     (name "ganeti-instance-debootstrap")
 847     ;; We need two commits on top of the latest release for compatibility
 848     ;; with newer sfdisk, as well as gnt-network integration.
 849     (version "0.16-2-ge145396")
 850     (home-page "https://github.com/ganeti/instance-debootstrap")
 851     (source (origin
 852               (method git-fetch)
 853               (uri (git-reference (url home-page) (commit version)))
 854               (file-name (git-file-name name version))
 855               (sha256
 856                (base32
 857                 "0f2isw9d8lawzj21rrq1q9xhq8xfa65rqbhqmrn59z201x9q1336"))))
 858     (build-system gnu-build-system)
 859     (arguments
 860      '(#:configure-flags '("--sysconfdir=/etc" "--localstatedir=/var")
 861        #:phases (modify-phases %standard-phases
 862                   (add-after 'unpack 'add-absolute-references
 863                     (lambda _
 864                       (substitute* "common.sh.in"
 865                         (("/sbin/blkid") (which "blkid"))
 866                         (("kpartx -")
 867                          (string-append (which "kpartx") " -")))
 868                       (substitute* "import"
 869                         (("restore -r")
 870                          (string-append (which "restore") " -r")))
 871                       (substitute* "export"
 872                         (("dump -0")
 873                          (string-append (which "dump") " -0")))
 874                       (substitute* "create"
 875                         (("debootstrap") (which "debootstrap"))
 876                         (("`which run-parts`") (which "run-parts"))
 877                         ;; Here we actually need to hard code /bin/passwd
 878                         ;; because it's called via chroot, which fails if
 879                         ;; "/bin" is not in PATH.
 880                         (("passwd") "/bin/passwd"))
 881                       #t))
 882                   (add-after 'unpack 'set-dpkg-arch
 883                     (lambda* (#:key system #:allow-other-keys)
 884                       ;; The create script passes --arch to debootstrap,
 885                       ;; and defaults to `dpkg --print-architecture` when
 886                       ;; ARCH is not set in variant.conf.  Hard code the
 887                       ;; build-time architecture to avoid the dpkg dependency.
 888                       (let ((dpkg-arch
 889                              (cond ((string-prefix? "x86_64" system)
 890                                     "amd64")
 891                                    ((string-prefix? "i686" system)
 892                                     "i386")
 893                                    ((string-prefix? "aarch64" system)
 894                                     "arm64")
 895                                    (else (car (string-split system #\-))))))
 896                         (substitute* "create"
 897                           (("`dpkg --print-architecture`")
 898                            dpkg-arch))
 899                         #t)))
 900                   (add-after 'configure 'adjust-Makefile
 901                     (lambda _
 902                       ;; Do not attempt to create /etc/ganeti/instance-debootstrap
 903                       ;; and /etc/default/ganeti-instance-debootstrap during install.
 904                       ;; They are created by the Ganeti service.
 905                       (substitute* "Makefile"
 906                         (("\\$\\(variantsdir\\)")
 907                          "$(prefix)/etc/ganeti/instance-debootstrap/variants")
 908                         (("\\$\\(defaultsdir\\)")
 909                          "$(prefix)/etc/default/ganeti-instance-debootstrap"))
 910                       #t))
 911                   (add-after 'install 'make-variants.list-symlink
 912                     (lambda* (#:key outputs #:allow-other-keys)
 913                       ;; The Ganeti OS API mandates a variants.list file that
 914                       ;; describes all supported "variants" of this OS.
 915                       ;; Guix generates this file, so make the original file
 916                       ;; a symlink to it.
 917                       (with-directory-excursion (string-append
 918                                                  (assoc-ref outputs "out")
 919                                                  "/share/ganeti/os/debootstrap")
 920                         (delete-file "variants.list")
 921                         (symlink "/etc/ganeti/instance-debootstrap/variants/variants.list"
 922                                  "variants.list"))
 923                       #t)))))
 924     (native-inputs
 925      `(("autoconf" ,autoconf)
 926        ("automake" ,automake)))
 927     (inputs
 928      `(("debianutils" ,debianutils)
 929        ("debootstrap" ,debootstrap)
 930        ("dump" ,dump)
 931        ("kpartx" ,multipath-tools)
 932        ("util-linux" ,util-linux)))
 933     (synopsis "Debian OS integration for Ganeti")
 934     (description
 935      "This package provides a guest OS definition for Ganeti.  It installs
 936 Debian or a derivative using @command{debootstrap}.")
 937     (license license:gpl2+)))
 938
 939 (define-public libosinfo
 940   (package
 941     (name "libosinfo")
 942     (version "1.7.1")
 943     (source
 944      (origin
 945        (method url-fetch)
 946        (uri (string-append "https://releases.pagure.org/libosinfo/libosinfo-"
 947                            version ".tar.xz"))
 948        (sha256
 949         (base32
 950          "1s97sv24bybggjx6hgqba2qdqz3ivfpd4cmkh4zm5y59sim109mv"))))
 951     (build-system meson-build-system)
 952     (arguments
 953      `(#:configure-flags
 954        (list (string-append "-Dwith-usb-ids-path="
 955                             (assoc-ref %build-inputs "usb.ids"))
 956              (string-append "-Dwith-pci-ids-path="
 957                             (assoc-ref %build-inputs "pci.ids")))
 958        #:phases
 959        (modify-phases %standard-phases
 960          (add-after 'unpack 'patch-osinfo-path
 961            (lambda* (#:key inputs #:allow-other-keys)
 962              (substitute* "osinfo/osinfo_loader.c"
 963                (("path = DATA_DIR.*")
 964                 (string-append "path = \"" (assoc-ref inputs "osinfo-db")
 965                                "/share/osinfo\";")))
 966              #t)))))
 967     (inputs
 968      `(("libsoup" ,libsoup)
 969        ("libxml2" ,libxml2)
 970        ("libxslt" ,libxslt)
 971        ("osinfo-db" ,osinfo-db)))
 972     (native-inputs
 973      `(("glib" ,glib "bin")  ; glib-mkenums, etc.
 974        ("gobject-introspection" ,gobject-introspection)
 975        ("gtk-doc" ,gtk-doc)
 976        ("vala" ,vala)
 977        ("intltool" ,intltool)
 978        ("pkg-config" ,pkg-config)
 979        ("pci.ids"
 980         ,(origin
 981            (method url-fetch)
 982            (uri "https://github.com/pciutils/pciids/raw/ad02084f0bc143e3c15e31a6152a3dfb1d7a3156/pci.ids")
 983            (sha256
 984             (base32
 985              "0kfhpj5rnh24hz2714qhfmxk281vwc2w50sm73ggw5d15af7zfsw"))))
 986        ("usb.ids"
 987         ,(origin
 988            (method url-fetch)
 989            (uri "https://svn.code.sf.net/p/linux-usb/repo/trunk/htdocs/usb.ids?r=2681")
 990            (file-name "usb.ids")
 991            (sha256
 992             (base32
 993              "1m6yhvz5k8aqzxgk7xj3jkk8frl1hbv0h3vgj4wbnvnx79qnvz3r"))))))
 994     (home-page "https://libosinfo.org/")
 995     (synopsis "Operating system information database")
 996     (description "libosinfo is a GObject based library API for managing
 997 information about operating systems, hypervisors and the (virtual) hardware
 998 devices they can support.  It includes a database containing device metadata
 999 and provides APIs to match/identify optimal devices for deploying an operating
1000 system on a hypervisor.  Via GObject Introspection, the API is available in
1001 all common programming languages.  Vala bindings are also provided.")
1002     ;; The library files are released under LGPLv2.1 or later; the source
1003     ;; files in the "tools" directory are released under GPLv2+.
1004     (license (list license:lgpl2.1+ license:gpl2+))))
1005
1006 (define-public lxc
1007   (package
1008     (name "lxc")
1009     (version "4.0.6")
1010     (source (origin
1011               (method url-fetch)
1012               (uri (string-append
1013                     "https://linuxcontainers.org/downloads/lxc/lxc-"
1014                     version ".tar.gz"))
1015               (sha256
1016                (base32
1017                 "0qz4l7mlhq7hx53q606qgvkyzyr01glsw290v8ppzvxn1fydlrci"))))
1018     (build-system gnu-build-system)
1019     (native-inputs
1020      `(("pkg-config" ,pkg-config)))
1021     (inputs
1022      `(("gnutls" ,gnutls)
1023        ("libcap" ,libcap)
1024        ("libseccomp" ,libseccomp)
1025        ("libselinux" ,libselinux)))
1026     (arguments
1027      `(#:configure-flags
1028        (list (string-append "--docdir=" (assoc-ref %outputs "out")
1029                             "/share/doc/" ,name "-" ,version)
1030              "--sysconfdir=/etc"
1031              "--localstatedir=/var")
1032        #:phases
1033        (modify-phases %standard-phases
1034          (replace 'install
1035            (lambda* (#:key outputs #:allow-other-keys)
1036              (let* ((out         (assoc-ref outputs "out"))
1037                     (bashcompdir (string-append out "/etc/bash_completion.d")))
1038                (invoke "make" "install"
1039                        (string-append "bashcompdir=" bashcompdir)
1040                        ;; Don't install files into /var and /etc.
1041                        "LXCPATH=/tmp/var/lib/lxc"
1042                        "localstatedir=/tmp/var"
1043                        "sysconfdir=/tmp/etc"
1044                        "sysconfigdir=/tmp/etc/default")))))))
1045     (synopsis "Linux container tools")
1046     (home-page "https://linuxcontainers.org/")
1047     (description
1048      "LXC is a userspace interface for the Linux kernel containment features.
1049 Through a powerful API and simple tools, it lets Linux users easily create and
1050 manage system or application containers.")
1051     (license license:lgpl2.1+)))
1052
1053 (define-public libvirt
1054   (package
1055     (name "libvirt")
1056     (version "5.8.0")
1057     (source
1058      (origin
1059        (method url-fetch)
1060        (uri (string-append "https://libvirt.org/sources/libvirt-"
1061                            version ".tar.xz"))
1062        (sha256
1063         (base32 "0m8cqaqflvys5kaqpvb0qr4k365j09jc5xk6x70yvg8qkcl2hcz2"))
1064        (patches
1065         (search-patches "libvirt-create-machine-cgroup.patch"))))
1066     (build-system gnu-build-system)
1067     (arguments
1068      `(#:configure-flags
1069        (list "--with-qemu"
1070              "--with-qemu-user=nobody"
1071              "--with-qemu-group=kvm"
1072              "--with-polkit"
1073              (string-append "--docdir=" (assoc-ref %outputs "out") "/share/doc/"
1074                             ,name "-" ,version)
1075              "--sysconfdir=/etc"
1076              "--localstatedir=/var")
1077        #:phases
1078        (modify-phases %standard-phases
1079          (add-before 'configure 'fix-BOURNE_SHELL-definition
1080            ;; BOURNE_SHELL is hard-#defined to ‘/bin/sh’, causing test failures.
1081            (lambda _
1082              (substitute* "config.h.in"
1083                (("/bin/sh") (which "sh")))
1084              #t))
1085          (add-before 'configure 'patch-libtirpc-file-names
1086            (lambda* (#:key inputs #:allow-other-keys)
1087              ;; libvirt uses an m4 macro instead of pkg-config to determine where
1088              ;; the RPC headers are located.  Tell it to look in the right place.
1089              (substitute* "configure"
1090                (("/usr/include/tirpc")  ;defined in m4/virt-xdr.m4
1091                 (string-append (assoc-ref inputs "libtirpc")
1092                                "/include/tirpc")))
1093              #t))
1094          (add-before 'configure 'disable-broken-tests
1095            (lambda _
1096              (let ((tests (list "commandtest"      ; hangs idly
1097                                 "qemuxml2argvtest" ; fails
1098                                 "qemuhotplugtest"  ; fails
1099                                 "virnetsockettest" ; tries to network
1100                                 "virshtest")))     ; fails
1101                (substitute* "tests/Makefile.in"
1102                  (((format #f "(~a)\\$\\(EXEEXT\\)" (string-join tests "|")))
1103                   ""))
1104                #t)))
1105          (replace 'install
1106            ;; Since the sysconfdir and localstatedir should be /etc and /var
1107            ;; at runtime, we must prevent writing to them at installation
1108            ;; time.
1109            (lambda* (#:key make-flags #:allow-other-keys)
1110              (apply invoke "make" "install"
1111                     "sysconfdir=/tmp/etc"
1112                     "localstatedir=/tmp/var"
1113                     make-flags))))))
1114     (inputs
1115      `(("libxml2" ,libxml2)
1116        ("eudev" ,eudev)
1117        ("libpciaccess" ,libpciaccess)
1118        ("gnutls" ,gnutls)
1119        ("dbus" ,dbus)
1120        ("libpcap" ,libpcap)
1121        ("libnl" ,libnl)
1122        ("libtirpc" ,libtirpc)           ;for <rpc/rpc.h>
1123        ("libuuid" ,util-linux "lib")
1124        ("lvm2" ,lvm2)                   ;for libdevmapper
1125        ("curl" ,curl)
1126        ("openssl" ,openssl)
1127        ("cyrus-sasl" ,cyrus-sasl)
1128        ("libyajl" ,libyajl)
1129        ("audit" ,audit)
1130        ("dmidecode" ,dmidecode)
1131        ("dnsmasq" ,dnsmasq)
1132        ("ebtables" ,ebtables)
1133        ("iproute" ,iproute)
1134        ("iptables" ,iptables)))
1135     (native-inputs
1136      `(("xsltproc" ,libxslt)
1137        ("perl" ,perl)
1138        ("pkg-config" ,pkg-config)
1139        ("polkit" ,polkit)
1140        ("python" ,python-wrapper)))
1141     (home-page "https://libvirt.org")
1142     (synopsis "Simple API for virtualization")
1143     (description "Libvirt is a C toolkit to interact with the virtualization
1144 capabilities of recent versions of Linux.  The library aims at providing long
1145 term stable C API initially for the Xen paravirtualization but should be able
1146 to integrate other virtualization mechanisms if needed.")
1147     (license license:lgpl2.1+)))
1148
1149 (define-public libvirt-glib
1150   (package
1151     (name "libvirt-glib")
1152     (version "3.0.0")
1153     (source (origin
1154               (method url-fetch)
1155               (uri (string-append "ftp://libvirt.org/libvirt/glib/"
1156                                   "libvirt-glib-" version ".tar.gz"))
1157               (sha256
1158                (base32
1159                 "1zpbv4ninc57c9rw4zmmkvvqn7154iv1qfr20kyxn8xplalqrzvz"))))
1160     (build-system gnu-build-system)
1161     (inputs
1162      `(("openssl" ,openssl)
1163        ("cyrus-sasl" ,cyrus-sasl)
1164        ("lvm2" ,lvm2)                   ; for libdevmapper
1165        ("libyajl" ,libyajl)))
1166     (native-inputs
1167      `(("pkg-config" ,pkg-config)
1168        ("intltool" ,intltool)
1169        ("glib" ,glib "bin")
1170        ("vala" ,vala)))
1171     (propagated-inputs
1172      ;; ‘Required:’ by the installed .pc files.
1173      `(("glib" ,glib)
1174        ("libvirt" ,libvirt)
1175        ("libxml2" ,libxml2)
1176        ("gobject-introspection" ,gobject-introspection)))
1177     (home-page "https://libvirt.org")
1178     (synopsis "GLib wrapper around libvirt")
1179     (description "libvirt-glib wraps the libvirt library to provide a
1180 high-level object-oriented API better suited for glib-based applications, via
1181 three libraries:
1182
1183 @enumerate
1184 @item libvirt-glib - GLib main loop integration & misc helper APIs
1185 @item libvirt-gconfig - GObjects for manipulating libvirt XML documents
1186 @item libvirt-gobject - GObjects for managing libvirt objects
1187 @end enumerate
1188 ")
1189     (license license:lgpl2.1+)))
1190
1191 (define-public python-libvirt
1192   (package
1193     (name "python-libvirt")
1194     (version "5.8.0")
1195     (source
1196      (origin
1197        (method url-fetch)
1198        (uri (string-append "https://libvirt.org/sources/python/libvirt-python-"
1199                            version ".tar.gz"))
1200        (sha256
1201         (base32 "0kyz3lx49d8p75mvbzinxc1zgs8g7adn77y9bm15b8b4ad9zl5s6"))))
1202     (build-system python-build-system)
1203     (arguments
1204      `(#:phases
1205        (modify-phases %standard-phases
1206          (add-after 'unpack 'patch-nosetests-path
1207            (lambda* (#:key inputs #:allow-other-keys)
1208              (substitute* "setup.py"
1209                (("\"/usr/bin/nosetests\"")
1210                 (string-append "\"" (which "nosetests") "\""))
1211                (("self\\.spawn\\(\\[sys\\.executable, nose\\]\\)")
1212                 (format #f "self.spawn([\"~a\", nose])" (which "bash"))))
1213              #t)))))
1214     (inputs
1215      `(("libvirt" ,libvirt)))
1216     (propagated-inputs
1217      `(("python-lxml" ,python-lxml)))
1218     (native-inputs
1219      `(("pkg-config" ,pkg-config)
1220        ("python-nose" ,python-nose)))
1221     (home-page "https://libvirt.org")
1222     (synopsis "Python bindings to libvirt")
1223     (description "This package provides Python bindings to the libvirt
1224 virtualization library.")
1225     (license license:lgpl2.1+)))
1226
1227 (define-public python2-libvirt
1228   (package-with-python2 python-libvirt))
1229
1230 (define-public virt-manager
1231   (package
1232     (name "virt-manager")
1233     (version "2.2.1")
1234     (source (origin
1235               (method url-fetch)
1236               (uri (string-append "https://virt-manager.org/download/sources"
1237                                   "/virt-manager/virt-manager-"
1238                                   version ".tar.gz"))
1239               (sha256
1240                (base32
1241                 "06ws0agxlip6p6n3n43knsnjyd91gqhh2dadgc33wl9lx1k8vn6g"))))
1242     (build-system python-build-system)
1243     (arguments
1244      `(#:use-setuptools? #f          ; uses custom distutils 'install' command
1245        #:test-target "test_ui"
1246        #:tests? #f                      ; TODO The tests currently fail
1247                                         ; RuntimeError: Loop condition wasn't
1248                                         ; met
1249        #:imported-modules ((guix build glib-or-gtk-build-system)
1250                            ,@%python-build-system-modules)
1251        #:modules ((ice-9 match)
1252                   (srfi srfi-26)
1253                   (guix build python-build-system)
1254                   ((guix build glib-or-gtk-build-system) #:prefix glib-or-gtk:)
1255                   (guix build utils))
1256        #:phases
1257        (modify-phases %standard-phases
1258          (add-after 'unpack 'fix-setup
1259            (lambda* (#:key outputs #:allow-other-keys)
1260              (substitute* "virtinst/buildconfig.py"
1261                (("/usr") (assoc-ref outputs "out")))
1262              #t))
1263          (add-after 'unpack 'fix-qemu-img-reference
1264            (lambda* (#:key inputs #:allow-other-keys)
1265              (substitute* "virtconv/formats.py"
1266                (("/usr(/bin/qemu-img)" _ suffix)
1267                 (string-append (assoc-ref inputs "qemu") suffix)))
1268              #t))
1269          (add-after 'unpack 'fix-default-uri
1270            (lambda* (#:key inputs #:allow-other-keys)
1271              ;; Xen is not available for now - so only patch qemu.
1272              (substitute* "virtManager/createconn.py"
1273                (("/usr(/bin/qemu-system)" _ suffix)
1274                 (string-append (assoc-ref inputs "qemu") suffix)))
1275              #t))
1276          (add-before 'wrap 'wrap-with-GI_TYPELIB_PATH
1277            (lambda* (#:key inputs outputs #:allow-other-keys)
1278              (let* ((bin       (string-append (assoc-ref outputs "out") "/bin"))
1279                     (bin-files (find-files bin ".*"))
1280                     (paths     (map (match-lambda
1281                                       ((output . directory)
1282                                        (let* ((girepodir (string-append
1283                                                           directory
1284                                                           "/lib/girepository-1.0")))
1285                                          (if (file-exists? girepodir)
1286                                              girepodir #f))))
1287                                     inputs)))
1288                (for-each (lambda (file)
1289                            (format #t "wrapping ~a\n" file)
1290                            (wrap-program file
1291                              `("GI_TYPELIB_PATH" ":" prefix
1292                                ,(filter identity paths))))
1293                          bin-files))
1294              #t))
1295          (replace 'check
1296            (lambda* (#:key tests? #:allow-other-keys)
1297              (when tests?
1298                (setenv "HOME" "/tmp")
1299                (system "Xvfb :1 &")
1300                (setenv "DISPLAY" ":1")
1301                ;; Dogtail requires that Assistive Technology support be enabled
1302                (setenv "GTK_MODULES" "gail:atk-bridge")
1303                (invoke "dbus-run-session" "--" "python" "setup.py" "test_ui"))
1304              #t))
1305          (add-after 'install 'glib-or-gtk-compile-schemas
1306            (assoc-ref glib-or-gtk:%standard-phases 'glib-or-gtk-compile-schemas))
1307          (add-after 'install 'glib-or-gtk-wrap
1308            (assoc-ref glib-or-gtk:%standard-phases 'glib-or-gtk-wrap)))))
1309     (inputs
1310      `(("dconf" ,dconf)
1311        ("gtk+" ,gtk+)
1312        ("gtk-vnc" ,gtk-vnc)
1313        ("gtksourceview" ,gtksourceview)
1314        ("libvirt" ,libvirt)
1315        ("libvirt-glib" ,libvirt-glib)
1316        ("libosinfo" ,libosinfo)
1317        ("vte" ,vte)
1318        ("python-libvirt" ,python-libvirt)
1319        ("python-requests" ,python-requests)
1320        ("python-pycairo" ,python-pycairo)
1321        ("python-pygobject" ,python-pygobject)
1322        ("python-libxml2" ,python-libxml2)
1323        ("spice-gtk" ,spice-gtk)))
1324     ;; virt-manager searches for qemu-img or kvm-img in the PATH.
1325     (propagated-inputs
1326      `(("qemu" ,qemu)))
1327     (native-inputs
1328      `(("glib" ,glib "bin")             ; glib-compile-schemas
1329        ("gobject-introspection" ,gobject-introspection)
1330        ("gtk+" ,gtk+ "bin")             ; gtk-update-icon-cache
1331        ("perl" ,perl)                   ; pod2man
1332        ("intltool" ,intltool)
1333        ;; The following are required for running the tests
1334        ;; ("python-dogtail" ,python-dogtail)
1335        ;; ("xvfb" ,xorg-server-for-tests)
1336        ;; ("dbus" ,dbus)
1337        ;; ("at-spi2-core" ,at-spi2-core)
1338        ;; ("gsettings-desktop-schemas" ,gsettings-desktop-schemas)
1339        ))
1340     (home-page "https://virt-manager.org/")
1341     (synopsis "Manage virtual machines")
1342     (description
1343      "The virt-manager application is a desktop user interface for managing
1344 virtual machines through libvirt.  It primarily targets KVM VMs, but also
1345 manages Xen and LXC (Linux containers).  It presents a summary view of running
1346 domains, their live performance and resource utilization statistics.")
1347     (license license:gpl2+)))
1348
1349 (define-public criu
1350   (package
1351     (name "criu")
1352     (version "3.15")
1353     (source (origin
1354               (method url-fetch)
1355               (uri (string-append "https://download.openvz.org/criu/criu-"
1356                                   version ".tar.bz2"))
1357               (sha256
1358                (base32
1359                 "09d0j24x0cyc7wkgi7cnxqgfjk7kbdlm79zxpj8d356sa3rw2z24"))))
1360     (build-system gnu-build-system)
1361     (arguments
1362      `(#:test-target "test"
1363        #:tests? #f ; tests require mounting as root
1364        #:make-flags
1365        (list (string-append "PREFIX=" (assoc-ref %outputs "out"))
1366              (string-append "LIBDIR=" (assoc-ref %outputs "out")
1367                             "/lib")
1368              (string-append "ASCIIDOC=" (assoc-ref %build-inputs "asciidoc")
1369                             "/bin/asciidoc")
1370              (string-append "XMLTO=" (assoc-ref %build-inputs "xmlto")
1371                             "/bin/xmlto"))
1372        #:phases
1373        (modify-phases %standard-phases
1374          (replace 'configure
1375            (lambda* (#:key inputs #:allow-other-keys)
1376              ;; The includes for libnl are located in a sub-directory.
1377              (setenv "C_INCLUDE_PATH"
1378                      (string-append (assoc-ref inputs "libnl")
1379                                     "/include/libnl3:"
1380                                     (or (getenv "C_INCLUDE_PATH") "")))
1381              #t))
1382          (add-after 'configure 'fix-documentation
1383            (lambda* (#:key inputs outputs #:allow-other-keys)
1384              (substitute* "Documentation/Makefile"
1385                (("-m custom.xsl")
1386                 (string-append
1387                  "-m custom.xsl --skip-validation -x "
1388                  (assoc-ref inputs "docbook-xsl") "/xml/xsl/"
1389                  ,(package-name docbook-xsl) "-"
1390                  ,(package-version docbook-xsl)
1391                  "/manpages/docbook.xsl")))
1392              #t))
1393          (add-after 'unpack 'hardcode-variables
1394            (lambda* (#:key inputs #:allow-other-keys)
1395              ;; Hardcode arm version detection
1396              (substitute* "Makefile"
1397                (("ARMV.*:=.*") "ARMV := 7\n"))
1398              ;; We are currently using python-2
1399              (substitute* "crit/Makefile"
1400                (("\\$\\(PYTHON\\)") "python2"))
1401              (substitute* "lib/Makefile"
1402                (("\\$\\(PYTHON\\)")
1403                 (string-append (assoc-ref inputs "python")
1404                                "/bin/python")))
1405              #t))
1406          (add-before 'build 'fix-symlink
1407            (lambda* (#:key inputs #:allow-other-keys)
1408              ;; The file 'images/google/protobuf/descriptor.proto' points to
1409              ;; /usr/include/..., which obviously does not exist.
1410              (let* ((file "google/protobuf/descriptor.proto")
1411                     (target (string-append "images/" file))
1412                     (source (string-append (assoc-ref inputs "protobuf")
1413                                            "/include/" file)))
1414                (delete-file target)
1415                (symlink source target)
1416                #t)))
1417          (add-after 'install 'wrap
1418            (lambda* (#:key inputs outputs #:allow-other-keys)
1419              ;; Make sure 'crit' runs with the correct PYTHONPATH.
1420              (let* ((out (assoc-ref outputs "out"))
1421                     (path (string-append out
1422                                          "/lib/python"
1423                                          (string-take (string-take-right
1424                                                        (assoc-ref inputs "python") 5) 3)
1425                                          "/site-packages:"
1426                                          (getenv "PYTHONPATH"))))
1427                (wrap-program (string-append out "/bin/crit")
1428                  `("PYTHONPATH" ":" prefix (,path))))
1429              #t)))))
1430     (inputs
1431      `(("protobuf" ,protobuf)
1432        ("python" ,python-2)
1433        ("python2-protobuf" ,python2-protobuf)
1434        ("python2-ipaddr" ,python2-ipaddr)
1435        ("iproute" ,iproute)
1436        ("libaio" ,libaio)
1437        ("libcap" ,libcap)
1438        ("libnet" ,libnet)
1439        ("libnl" ,libnl)
1440        ("libbsd" ,libbsd)
1441        ("nftables" ,nftables)))
1442     (native-inputs
1443      `(("pkg-config" ,pkg-config)
1444        ("perl" ,perl)
1445        ("protobuf-c" ,protobuf-c)
1446        ("asciidoc" ,asciidoc)
1447        ("xmlto" ,xmlto)
1448        ("docbook-xml" ,docbook-xml)
1449        ("docbook-xsl" ,docbook-xsl)))
1450     (home-page "https://criu.org")
1451     (synopsis "Checkpoint and restore in user space")
1452     (description "Using this tool, you can freeze a running application (or
1453 part of it) and checkpoint it to a hard drive as a collection of files.  You
1454 can then use the files to restore and run the application from the point it
1455 was frozen at.  The distinctive feature of the CRIU project is that it is
1456 mainly implemented in user space.")
1457     ;; The project is licensed under GPLv2; files in the lib/ directory are
1458     ;; LGPLv2.1.
1459     (license (list license:gpl2 license:lgpl2.1))))
1460
1461 (define-public qmpbackup
1462   (package
1463     (name "qmpbackup")
1464     (version "0.2")
1465     (source (origin
1466               (method git-fetch)
1467               (uri (git-reference
1468                      (url "https://github.com/abbbi/qmpbackup")
1469                      (commit version)))
1470               (file-name (git-file-name name version))
1471               (sha256
1472                (base32
1473                 "0swhp5byz44brhyis1a39p11fyn9q84xz5q6v2fah29r7d71kmmx"))))
1474     (build-system python-build-system)
1475     (arguments
1476      `(#:python ,python-2))
1477     (home-page "https://github.com/abbbi/qmpbackup")
1478     (synopsis "Backup and restore QEMU machines")
1479     (description "qmpbackup is designed to create and restore full and
1480 incremental backups of running QEMU virtual machines via QMP, the QEMU
1481 Machine Protocol.")
1482     (license license:gpl3+)))
1483
1484 (define-public looking-glass-client
1485   (let ((commit "182c4752d57690da7f99d5e788de9b8baea33895"))
1486     (package
1487      (name "looking-glass-client")
1488      (version (string-append "a12-" (string-take commit 7)))
1489      (source
1490       (origin
1491        (method git-fetch)
1492        (uri (git-reference (url "https://github.com/gnif/LookingGlass")
1493                            (commit commit)))
1494        (file-name (git-file-name name version))
1495        (sha256
1496         (base32
1497          "02bq46ndmzq9cihazzn7xq1x7q5nzm7iw4l9lqzihxcxp9famkhw"))
1498        (modules '((guix build utils)))
1499        (snippet
1500         '(begin
1501            ;; Do not create binaries optimized for the CPU of the build machine,
1502            ;; for reproducibility and compatibility.  TODO: in the next version
1503            ;; of looking glass, this is exposed as a CMake configure option.
1504            (substitute* "client/CMakeLists.txt"
1505              (("-march=native")
1506               ""))
1507            #t))))
1508      (build-system cmake-build-system)
1509      (inputs `(("fontconfig" ,fontconfig)
1510                ("glu" ,glu)
1511                ("mesa" ,mesa)
1512                ("openssl" ,openssl)
1513                ("sdl2" ,sdl2)
1514                ("sdl2-ttf" ,sdl2-ttf)
1515                ("spice-protocol" ,spice-protocol)
1516                ("wayland" ,wayland)))
1517      (native-inputs `(("libconfig" ,libconfig)
1518                       ("nettle" ,nettle)
1519                       ("pkg-config" ,pkg-config)))
1520      (arguments
1521       `(#:tests? #f ;; No tests are available.
1522         #:make-flags '("CC=gcc")
1523         #:phases (modify-phases %standard-phases
1524                    (add-before 'configure 'chdir-to-client
1525                      (lambda* (#:key outputs #:allow-other-keys)
1526                        (chdir "client")
1527                        #t))
1528                    (add-after 'chdir-to-client 'add-missing-include
1529                      (lambda _
1530                        ;; Mimic upstream commit b9797529893, required since the
1531                        ;; update to Mesa 19.2.
1532                        (substitute* "renderers/egl/shader.h"
1533                          (("#include <stdbool\\.h>")
1534                           "#include <stdbool.h>\n#include <stddef.h>"))
1535                        #t))
1536                    (replace 'install
1537                      (lambda* (#:key outputs #:allow-other-keys)
1538                        (install-file "looking-glass-client"
1539                                      (string-append (assoc-ref outputs "out")
1540                                                     "/bin"))
1541                        #t)))))
1542      (home-page "https://looking-glass.hostfission.com")
1543      (synopsis "KVM Frame Relay (KVMFR) implementation")
1544      (description "Looking Glass allows the use of a KVM (Kernel-based Virtual
1545 Machine) configured for VGA PCI Pass-through without an attached physical
1546 monitor, keyboard or mouse.  It displays the VM's rendered contents on your main
1547 monitor/GPU.")
1548      ;; This package requires SSE instructions.
1549      (supported-systems '("i686-linux" "x86_64-linux"))
1550      (license license:gpl2+))))
1551
1552 (define-public runc
1553   (package
1554     (name "runc")
1555     (version "1.0.0-rc6")
1556     (source (origin
1557               (method url-fetch)
1558               (uri (string-append
1559                     "https://github.com/opencontainers/runc/releases/"
1560                     "download/v" version "/runc.tar.xz"))
1561               (file-name (string-append name "-" version ".tar.xz"))
1562               (patches (search-patches "runc-CVE-2019-5736.patch"))
1563               (sha256
1564                (base32
1565                 "1c7832dq70slkjh8qp2civ1wxhhdd2hrx84pq7db1mmqc9fdr3cc"))))
1566     (build-system go-build-system)
1567     (arguments
1568      '(#:import-path "github.com/opencontainers/runc"
1569        #:install-source? #f
1570        ;; XXX: 20/139 tests fail due to missing /var, cgroups and apparmor in
1571        ;; the build environment.
1572        #:tests? #f
1573        #:phases
1574        (modify-phases %standard-phases
1575          (replace 'unpack
1576            (lambda* (#:key source import-path #:allow-other-keys)
1577              ;; Unpack the tarball into 'runc' instead of 'runc-1.0.0-rc5'.
1578              (let ((dest (string-append "src/" import-path)))
1579                (mkdir-p dest)
1580                (invoke "tar" "-C" (string-append "src/" import-path)
1581                        "--strip-components=1"
1582                        "-xvf" source))))
1583          (replace 'build
1584            (lambda* (#:key import-path #:allow-other-keys)
1585              (with-directory-excursion (string-append "src/" import-path)
1586                ;; XXX: requires 'go-md2man'.
1587                ;; (invoke "make" "man")
1588                (invoke "make"))))
1589          ;; (replace 'check
1590          ;;   (lambda _
1591          ;;     (invoke "make" "localunittest")))
1592          (replace 'install
1593            (lambda* (#:key import-path outputs #:allow-other-keys)
1594              (with-directory-excursion (string-append "src/" import-path)
1595                (let ((out (assoc-ref outputs "out")))
1596                  (invoke "make" "install" "install-bash"
1597                          (string-append "PREFIX=" out)))))))))
1598     (native-inputs
1599      `(("pkg-config" ,pkg-config)))
1600     (inputs
1601      `(("libseccomp" ,libseccomp)))
1602     (synopsis "Open container initiative runtime")
1603     (home-page "https://www.opencontainers.org/")
1604     (description
1605      "@command{runc} is a command line client for running applications
1606 packaged according to the
1607 @uref{https://github.com/opencontainers/runtime-spec/blob/master/spec.md, Open
1608 Container Initiative (OCI) format} and is a compliant implementation of the
1609 Open Container Initiative specification.")
1610     (license license:asl2.0)))
1611
1612 (define-public umoci
1613   (package
1614     (name "umoci")
1615     (version "0.4.6")
1616     (source
1617      (origin
1618        (method url-fetch)
1619        (uri (string-append
1620              "https://github.com/opencontainers/umoci/releases/download/v"
1621              version "/umoci.tar.xz"))
1622        (file-name (string-append "umoci-" version ".tar.xz"))
1623        (sha256
1624         (base32 "06q7xfwnqysc013hapx31jhlzmyg8qb467qfkynj673qc7p9bd6h"))))
1625     (build-system go-build-system)
1626     (arguments
1627      '(#:import-path "github.com/opencontainers/umoci"
1628        #:install-source? #f
1629        #:phases
1630        (modify-phases %standard-phases
1631          (replace 'unpack
1632            (lambda* (#:key source import-path #:allow-other-keys)
1633              ;; Unpack the tarball into 'umoci' instead of "runc-${version}".
1634              (let ((dest (string-append "src/" import-path)))
1635                (mkdir-p dest)
1636                (invoke "tar" "-C" (string-append "src/" import-path)
1637                        "--strip-components=1"
1638                        "-xvf" source))))
1639          (replace 'build
1640            (lambda* (#:key import-path #:allow-other-keys)
1641              (with-directory-excursion (string-append "src/" import-path)
1642                ;; TODO: build manpages with 'go-md2man'.
1643                (invoke "make" "SHELL=bash"))))
1644          (replace 'install
1645            (lambda* (#:key import-path outputs #:allow-other-keys)
1646              (let* ((out (assoc-ref outputs "out"))
1647                     (bindir (string-append out "/bin")))
1648                (install-file (string-append "src/" import-path "/umoci")
1649                              bindir)
1650                #t))))))
1651     (home-page "https://umo.ci/")
1652     (synopsis "Tool for modifying Open Container images")
1653     (description
1654      "@command{umoci} is a tool that allows for high-level modification of an
1655 Open Container Initiative (OCI) image layout and its tagged images.")
1656     (license license:asl2.0)))
1657
1658 (define-public skopeo
1659   (package
1660     (name "skopeo")
1661     (version "1.2.1")
1662     (source (origin
1663               (method git-fetch)
1664               (uri (git-reference
1665                     (url "https://github.com/containers/skopeo")
1666                     (commit (string-append "v" version))))
1667               (file-name (git-file-name name version))
1668               (sha256
1669                (base32
1670                 "1y9pmijazbgxzriymrm7zrifmkd1x1wad9b3zjcj7zwr6c999dhg"))))
1671     (build-system go-build-system)
1672     (native-inputs
1673      `(("pkg-config" ,pkg-config)
1674        ("go-github-com-go-md2man" ,go-github-com-go-md2man)))
1675     (inputs
1676      `(("btrfs-progs" ,btrfs-progs)
1677        ("eudev" ,eudev)
1678        ("libassuan" ,libassuan)
1679        ("libselinux" ,libselinux)
1680        ("libostree" ,libostree)
1681        ("lvm2" ,lvm2)
1682        ("glib" ,glib)
1683        ("gpgme" ,gpgme)))
1684     (arguments
1685      '(#:import-path "github.com/containers/skopeo"
1686        #:install-source? #f
1687        #:tests? #f                                ; The tests require Docker
1688        #:phases
1689        (modify-phases %standard-phases
1690          (replace 'build
1691            (lambda* (#:key import-path #:allow-other-keys)
1692              (with-directory-excursion (string-append "src/" import-path)
1693                (invoke "make" "bin/skopeo"))))
1694          (add-after 'build 'build-docs
1695            (lambda* (#:key import-path #:allow-other-keys)
1696              (with-directory-excursion (string-append "src/" import-path)
1697                (invoke "make" "docs"))))
1698          (replace 'install
1699            (lambda* (#:key import-path outputs #:allow-other-keys)
1700              (with-directory-excursion (string-append "src/" import-path)
1701                (let ((out (assoc-ref outputs "out")))
1702                  (install-file "default-policy.json"
1703                                (string-append out "/etc/containers"))
1704                  (invoke "make" "install-binary" "install-completions" "install-docs"
1705                          (string-append "PREFIX=" out)))))))))
1706     (home-page "https://github.com/containers/skopeo")
1707     (synopsis "Interact with container images and container image registries")
1708     (description
1709      "@command{skopeo} is a command line utility providing various operations
1710 with container images and container image registries.  It can:
1711 @enumerate
1712
1713 @item Copy container images between various containers image stores,
1714 converting them as necessary.
1715
1716 @item Convert a Docker schema 2 or schema 1 container image to an OCI image.
1717
1718 @item Inspect a repository on a container registry without needlessly pulling
1719 the image.
1720
1721 @item Sign and verify container images.
1722
1723 @item Delete container images from a remote container registry.
1724
1725 @end enumerate")
1726     (license license:asl2.0)))
1727
1728 (define-public python-vagrant
1729   (package
1730     (name "python-vagrant")
1731     (version "0.5.15")
1732     (source
1733       (origin
1734         (method url-fetch)
1735         (uri (pypi-uri "python-vagrant" version))
1736         (sha256
1737          (base32
1738           "1ikrh6canhcxg5y7pzmkcnnydikppv7s6sm9prfx90nk0ac8m6mg"))))
1739     (build-system python-build-system)
1740     (arguments
1741      '(#:tests? #f)) ; tests involve running vagrant.
1742     (home-page "https://github.com/todddeluca/python-vagrant")
1743     (synopsis "Python bindings for Vagrant")
1744     (description
1745      "Python-vagrant is a Python module that provides a thin wrapper around the
1746 @code{vagrant} command line executable, allowing programmatic control of Vagrant
1747 virtual machines.")
1748     (license license:expat)))
1749
1750 (define-public bubblewrap
1751   (package
1752     (name "bubblewrap")
1753     (version "0.4.1")
1754     (source (origin
1755               (method url-fetch)
1756               (uri (string-append "https://github.com/containers/bubblewrap/"
1757                                   "releases/download/v" version "/bubblewrap-"
1758                                   version ".tar.xz"))
1759               (sha256
1760                (base32
1761                 "00ycgi6q2yngh06bnz50wkvar6r2jnjf3j158grhi9k13jdrpimr"))))
1762     (build-system gnu-build-system)
1763     (arguments
1764      `(#:phases
1765        (modify-phases %standard-phases
1766          (add-after 'unpack 'fix-test
1767            (lambda* (#:key outputs #:allow-other-keys)
1768              ;; Tests try to access /var/tmp, which is not possible in our build
1769              ;; environment.  Let's give them another directory.
1770              ;; /tmp gets overriden in some tests, so we need another directory.
1771              ;; the only possibility is the output directory.
1772              (let ((tmp-dir (string-append (assoc-ref outputs "out") "/tmp")))
1773                (mkdir-p tmp-dir)
1774                (substitute* "tests/test-run.sh"
1775                  (("/var/tmp") tmp-dir)
1776                  ;; Tests create a temporary python script, so fix its shebang.
1777                  (("/usr/bin/env python") (which "python"))
1778                  ;; Some tests try to access /usr, but that doesn't exist.
1779                  ;; Give them /gnu instead.
1780                  (("/usr") "/gnu")
1781                  (("--ro-bind /bin /bin") "--ro-bind /gnu /bin")
1782                  (("--ro-bind /sbin /sbin") "--ro-bind /gnu /sbin")
1783                  (("--ro-bind /lib /lib") "--ro-bind /gnu /lib")
1784                  (("  */bin/bash") (which "bash"))
1785                  (("/bin/sh") (which "sh"))
1786                  (("findmnt") (which "findmnt"))))
1787              #t))
1788          ;; Remove the directory we gave to tests to have a clean package.
1789          (add-after 'check 'remove-tmp-dir
1790            (lambda* (#:key outputs #:allow-other-keys)
1791              (delete-file-recursively (string-append (assoc-ref outputs "out") "/tmp"))
1792              #t)))))
1793     (inputs
1794      `(("libcap" ,libcap)))
1795     (native-inputs
1796      `(("python" ,python-wrapper)
1797        ("util-linux" ,util-linux)))
1798     (home-page "https://github.com/containers/bubblewrap")
1799     (synopsis "Unprivileged sandboxing tool")
1800     (description "Bubblewrap is aimed at running applications in a sandbox,
1801 restricting their access to parts of the operating system or user data such as
1802 the home directory.  Bubblewrap always creates a new mount namespace, and the
1803 user can specify exactly what parts of the file system should be made visible
1804 in the sandbox.  These directories are mounted with the @code{nodev} option
1805 by default and can be made read-only.")
1806     (license license:lgpl2.0+)))
1807
1808 (define-public bochs
1809   (package
1810     (name "bochs")
1811     (version "2.6.11")
1812     (source
1813      (origin
1814        (method url-fetch)
1815        (uri (string-append "https://sourceforge.net/projects/bochs/files/bochs/"
1816                            version "/bochs-" version ".tar.gz"))
1817        (sha256
1818         (base32 "0ql8q6y1k356li1g9gbvl21448mlxphxxi6kjb2b3pxvzd0pp2b3"))))
1819     (build-system gnu-build-system)
1820     (arguments
1821      `(#:tests? #f))                    ; no tests exist
1822     (inputs
1823      `(("libxrandr" ,libxrandr)))
1824     (home-page "http://bochs.sourceforge.net/")
1825     (synopsis "Emulator for x86 PC")
1826     (description
1827      "Bochs is an emulator which can emulate Intel x86 CPU, common I/O
1828 devices, and a custom BIOS.  It can also be compiled to emulate many different
1829 x86 CPUs, from early 386 to the most recent x86-64 Intel and AMD processors.
1830 Bochs can run most Operating Systems inside the emulation including Linux,
1831 DOS or Microsoft Windows.")
1832     (license license:lgpl2.0+)))
1833
1834 (define-public xen
1835   (package
1836     (name "xen")
1837     (version "4.14.1")
1838     (source (origin
1839               (method git-fetch)
1840               (uri (git-reference
1841                     (url "git://xenbits.xenproject.org/xen.git")
1842                     (commit (string-append "RELEASE-" version))))
1843               (file-name (git-file-name name version))
1844               (sha256
1845                (base32
1846                 "1r90rvypw76ya9clqw5p02gm1k8hxz73f7gr95ca778nnzvb7xjw"))))
1847     (build-system gnu-build-system)
1848     (arguments
1849      `(#:configure-flags
1850        (list "--enable-rpath"
1851              "--disable-qemu-traditional" ; It tries to do "git clone"
1852              "--disable-rombios" ; would try to "git clone" via etherboot.
1853              ;; TODO: Re-enable stubdom (it's "more secure" to use it).
1854              "--disable-stubdom" ; tries to "git clone" old patched newlib.
1855              (string-append "--with-initddir="
1856                             (assoc-ref %outputs "out")
1857                             "/etc/init.d")
1858              (string-append "--with-system-qemu="
1859                             (assoc-ref %build-inputs "qemu")
1860                             "/bin/qemu-system-i386")
1861              (string-append "--with-system-seabios="
1862                             (assoc-ref %build-inputs "seabios")
1863                             "/share/firmware/bios.bin")
1864              (string-append "--with-system-ovmf="
1865                             (assoc-ref %build-inputs "ovmf")
1866                             "/share/firmware/ovmf_ia32.bin"))
1867        #:make-flags (list "-j" "1"
1868                           "XEN_BUILD_DATE=Thu Jan  1 01:00:01 CET 1970"
1869                           "XEN_BUILD_TIME=01:00:01"
1870                           "XEN_BUILD_HOST="
1871                           "ETHERBOOT_NICS="
1872                           "SMBIOS_REL_DATE=01/01/1970"
1873                           "VGABIOS_REL_DATE=01 Jan 1970"
1874                           ; QEMU_TRADITIONAL_LOC
1875                           ; QEMU_UPSTREAM_LOC
1876                           "SYSCONFIG_DIR=/tmp/etc/default"
1877                           (string-append "BASH_COMPLETION_DIR="
1878                                          (assoc-ref %outputs "out")
1879                                          "/etc/bash_completion.d")
1880                           (string-append "BOOT_DIR="
1881                                          (assoc-ref %outputs "out")
1882                                          "/boot")
1883                           (string-append "DEBUG_DIR="
1884                                          (assoc-ref %outputs "out")
1885                                          "/lib/debug")
1886                           (string-append "EFI_DIR="
1887                                          (assoc-ref %outputs "out")
1888                                          "/lib/efi") ; TODO lib64 ?
1889                           "MINIOS_UPSTREAM_URL="
1890                           ;(string-append "DISTDIR="
1891                           ;               (assoc-ref %outputs "out"))
1892 )
1893        #:test-target "test"
1894        #:phases
1895        (modify-phases %standard-phases
1896         (add-after 'unpack 'unpack-mini-os
1897           (lambda* (#:key inputs #:allow-other-keys)
1898             (copy-recursively (assoc-ref inputs "mini-os") "extras/mini-os")
1899             #t))
1900         (add-after 'unpack-mini-os 'patch
1901           (lambda* (#:key inputs outputs #:allow-other-keys)
1902             (substitute* "tools/firmware/Rules.mk"
1903              (("override XEN_TARGET_ARCH = x86_32")
1904               (string-append "override XEN_TARGET_ARCH = x86_32
1905 override CC = " (assoc-ref inputs "cross-gcc") "/bin/i686-linux-gnu-gcc"))
1906              (("^CFLAGS =$")
1907               (string-append "CFLAGS=-I" (assoc-ref inputs "cross-libc")
1908                              "/include\n")))
1909             (substitute* "config/x86_32.mk"
1910              (("CFLAGS += -m32 -march=i686")
1911               (string-append "CFLAGS += -march=i686 -I"
1912                              (assoc-ref inputs "cross-libc")
1913                              "/include")))
1914             ;; /var is not in /gnu/store , so don't try to create it.
1915             (substitute* '("tools/Makefile"
1916                            "tools/xenstore/Makefile"
1917                            "tools/xenpaging/Makefile")
1918              (("\\$\\(INSTALL_DIR\\) .*XEN_(DUMP|LOG|RUN|LIB|PAGING)_DIR.*")
1919               "\n")
1920              (("\\$\\(INSTALL_DIR\\) .*XEN_(RUN|LIB)_STORED.*")
1921               "\n"))
1922             ;; Prevent xen from creating /etc .
1923             (substitute* "tools/examples/Makefile"
1924              ((" install-readmes") "")
1925              ((" install-configs") ""))
1926             ;; Set rpath.
1927             (substitute* "tools/pygrub/setup.py"
1928              (("library_dirs =")
1929               ; TODO: extra_link_args = ['-Wl,-rpath=/opt/foo'],
1930               (string-append "runtime_library_dirs = ['"
1931                              (assoc-ref outputs "out")
1932                              "/lib'],\nlibrary_dirs =")))
1933             #t))
1934         (add-before 'configure 'patch-xen-script-directory
1935           (lambda* (#:key outputs #:allow-other-keys)
1936             (substitute* '("configure"
1937                            "tools/configure"
1938                            "docs/configure")
1939              (("XEN_SCRIPT_DIR=.*")
1940               (string-append "XEN_SCRIPT_DIR="
1941                              (assoc-ref outputs "out")
1942                              "/etc/xen/scripts")))
1943             #t))
1944         (add-before 'configure 'set-environment-up
1945           (lambda* (#:key make-flags #:allow-other-keys)
1946              (define (cross? x)
1947                (string-contains x "cross-i686-linux"))
1948              (define (filter-environment! filter-predicate
1949                                           environment-variable-names)
1950                (for-each
1951                 (lambda (env-name)
1952                   (let* ((env-value (getenv env-name))
1953                          (search-path (search-path-as-string->list env-value))
1954                          (new-search-path (filter filter-predicate
1955                                                   search-path))
1956                          (new-env-value (list->search-path-as-string
1957                                          new-search-path ":")))
1958                     (setenv env-name new-env-value)))
1959                 environment-variable-names))
1960              (setenv "CROSS_C_INCLUDE_PATH" (getenv "C_INCLUDE_PATH"))
1961              (setenv "CROSS_CPLUS_INCLUDE_PATH" (getenv "CPLUS_INCLUDE_PATH"))
1962              (setenv "CROSS_LIBRARY_PATH" (getenv "LIBRARY_PATH"))
1963              (filter-environment! cross?
1964               '("CROSS_C_INCLUDE_PATH" "CROSS_CPLUS_INCLUDE_PATH"
1965                 "CROSS_LIBRARY_PATH"))
1966              (filter-environment! (lambda (e) (not (cross? e)))
1967               '("C_INCLUDE_PATH" "CPLUS_INCLUDE_PATH"
1968                 "LIBRARY_PATH"))
1969              ;; Guix tries to be helpful and automatically adds
1970              ;; mini-os-git-checkout/include to the include path,
1971              ;; but actually we don't want it to be there (yet).
1972              (filter-environment! (lambda (e)
1973                                     (not
1974                                      (string-contains e
1975                                       "mini-os-git-checkout")))
1976               '("C_INCLUDE_PATH" "CPLUS_INCLUDE_PATH"
1977                 "LIBRARY_PATH"))
1978             (setenv "EFI_VENDOR" "guix")
1979              #t))
1980         (replace 'build
1981           (lambda* (#:key make-flags #:allow-other-keys)
1982             (apply invoke "make" "world" make-flags))))))
1983     (inputs
1984      `(("acpica" ,acpica) ; TODO: patch iasl invocation.
1985        ("bridge-utils" ,bridge-utils) ; TODO: patch invocations.
1986        ("glib" ,glib)
1987        ("iproute" ,iproute) ; TODO: patch invocations.
1988        ("libaio" ,libaio)
1989        ("libx11" ,libx11)
1990        ("libyajl" ,libyajl)
1991        ("ncurses" ,ncurses)
1992        ("openssl" ,openssl)
1993        ("ovmf" ,ovmf)
1994        ("pixman" ,pixman)
1995        ("qemu" ,qemu-minimal)
1996        ("seabios" ,seabios)
1997        ("util-linux" ,util-linux "lib") ; uuid
1998        ; TODO: ocaml-findlib, ocaml-nox.
1999        ("xz" ,xz) ; for liblzma
2000        ("zlib" ,zlib)))
2001     (native-inputs
2002      `(("dev86" ,dev86)
2003        ("bison" ,bison)
2004        ("cmake" ,cmake-minimal)
2005        ("figlet" ,figlet)
2006        ("flex" ,flex)
2007        ("gettext" ,gettext-minimal)
2008        ("libnl" ,libnl)
2009        ("mini-os"
2010        ,(origin
2011          (method git-fetch)
2012          (uri (git-reference
2013                (url "http://xenbits.xen.org/git-http/mini-os.git")
2014                (commit (string-append "xen-RELEASE-" version))))
2015          (sha256
2016           (base32
2017            "1i8pcl19n60i2m9vlg79q3nknpj209c9ic5x10wxaicx45kc107f"))
2018          (file-name "mini-os-git-checkout")))
2019        ("perl" ,perl)
2020        ; TODO: markdown
2021        ("pkg-config" ,pkg-config)
2022        ("python" ,python-2)
2023        ("wget" ,wget)
2024        ("cross-gcc" ,(cross-gcc "i686-linux-gnu"
2025                                 #:xbinutils (cross-binutils "i686-linux-gnu")
2026                                 #:libc (cross-libc "i686-linux-gnu")))
2027        ("cross-libc" ,(cross-libc "i686-linux-gnu")) ; header files
2028        ("cross-libc-static" ,(cross-libc "i686-linux-gnu") "static")))
2029     (home-page "https://xenproject.org/")
2030     (synopsis "Xen Virtual Machine Monitor")
2031     (description "This package provides the Xen Virtual Machine Monitor
2032 which is a hypervisor.")
2033     ;; TODO: Some files are licensed differently.  List those.
2034     (license license:gpl2)
2035     (supported-systems '("i686-linux" "x86_64-linux" "armhf-linux"))))
2036
2037 (define-public osinfo-db-tools
2038   (package
2039     (name "osinfo-db-tools")
2040     (version "1.8.0")
2041     (source (origin
2042               (method url-fetch)
2043               (uri (string-append "https://releases.pagure.org/libosinfo/osinfo-db-tools-"
2044                                   version ".tar.xz"))
2045
2046               (sha256
2047                (base32
2048                 "038q3gzdbkfkhpicj0755mw1q4gbvn57pslpw8n2dp3lds9im0g9"))))
2049     (build-system meson-build-system)
2050     (inputs
2051      `(("libsoup" ,libsoup)
2052        ("libxml2" ,libxml2)
2053        ("libxslt" ,libxslt)
2054        ("json-glib" ,json-glib)
2055        ("libarchive" ,libarchive)))
2056     (native-inputs
2057      `(("perl" ,perl)
2058        ("gobject-introspection" ,gobject-introspection)
2059        ("gettext" ,gettext-minimal)
2060        ("pkg-config" ,pkg-config)
2061        ;; Tests
2062        ("python" ,python)
2063        ("pytest" ,python-pytest)
2064        ("requests" ,python-requests)))
2065     (home-page "https://gitlab.com/libosinfo/osinfo-db-tools")
2066     (synopsis "Tools for managing the osinfo database")
2067     (description "This package contains a set of tools to assist
2068 administrators and developers in managing the database.")
2069     (license license:lgpl2.0+)))
2070
2071 (define-public osinfo-db
2072   (package
2073     (name "osinfo-db")
2074     (version "20201218")
2075     (source (origin
2076               (method url-fetch)
2077               (uri (string-append "https://releases.pagure.org/libosinfo/osinfo-db-"
2078                                   version ".tar.xz"))
2079               (sha256
2080                (base32
2081                 "0ydbindwgw7kg861rqii5036gq0dbbbmv35dzrmmv937ddfsxwh0"))))
2082     (build-system trivial-build-system)
2083     (arguments
2084      `(#:modules ((guix build utils))
2085        #:builder
2086        (begin
2087          (use-modules (guix build utils))
2088          (let* ((out (assoc-ref %outputs "out"))
2089                 (osinfo-dir (string-append out "/share/osinfo"))
2090                 (source (assoc-ref %build-inputs "source"))
2091                 (osinfo-db-import
2092                  (string-append (assoc-ref %build-inputs "osinfo-db-tools")
2093                                 "/bin/osinfo-db-import")))
2094            (mkdir-p osinfo-dir)
2095            (invoke osinfo-db-import "--dir" osinfo-dir source)
2096            #t))))
2097     (native-inputs
2098      `(("intltool" ,intltool)
2099        ("osinfo-db-tools" ,osinfo-db-tools)))
2100     (home-page "https://gitlab.com/libosinfo/osinfo-db")
2101     (synopsis "Database of information about operating systems")
2102     (description "Osinfo-db provides the database files for use with the
2103 libosinfo library.  It provides information about guest operating systems for
2104 use with virtualization provisioning tools")
2105     (license license:lgpl2.0+)))
2106
2107 (define-public python-transient
2108   (package
2109     (name "python-transient")
2110     (version "0.12")
2111     (source
2112      (origin
2113        (method url-fetch)
2114        (uri (pypi-uri "transient" version))
2115        (sha256
2116         (base32
2117          "148yiqrmcscsi6787y0f27i1y9cf0gcw3mqfv5frhpmsmv62mv5z"))))
2118     (build-system python-build-system)
2119     (arguments
2120      `(#:tests? #f ; Requires behave
2121        #:phases (modify-phases %standard-phases
2122                   (add-after 'unpack 'fix-dependencies
2123                     (lambda _
2124                       (substitute* "setup.py"
2125                         (("==")
2126                          ">="))
2127                       #t)))))
2128     (propagated-inputs
2129      `(("python-beautifultable" ,python-beautifultable)
2130        ("python-click" ,python-click)
2131        ("python-importlib-resources"
2132         ,python-importlib-resources)
2133        ("python-lark-parser" ,python-lark-parser)
2134        ("python-marshmallow" ,python-marshmallow)
2135        ("python-progressbar2" ,python-progressbar2)
2136        ("python-requests" ,python-requests)
2137        ("python-toml" ,python-toml)))
2138     (native-inputs
2139      `(("python-black" ,python-black)
2140        ("python-mypy" ,python-mypy)
2141        ("python-pyhamcrest" ,python-pyhamcrest)
2142        ("python-twine" ,python-twine)))
2143     (home-page
2144      "https://github.com/ALSchwalm/transient")
2145     (synopsis
2146      "QEMU Wrapper written in Python")
2147     (description
2148      "@code{transient} is a wrapper for QEMU allowing the creation of virtual
2149 machines with shared folder, ssh, and disk creation support.")
2150     (license license:expat)))