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