;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2016 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu packages qemu)
  #:use-module (gnu packages)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages attr)
  #:use-module (gnu packages autotools)
  #:use-module (gnu packages check)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages curl)
  #:use-module (gnu packages cyrus-sasl)
  #:use-module (gnu packages disk)
  #:use-module (gnu packages gl)
  #:use-module (gnu packages glib)
  #:use-module (gnu packages gnome)
  #:use-module (gnu packages gtk)
  #:use-module (gnu packages image)
  #:use-module (gnu packages libusb)
  #:use-module (gnu packages linux)
  #:use-module (gnu packages ncurses)
  #:use-module (gnu packages perl)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages polkit)
  #:use-module (gnu packages python)
  #:use-module (gnu packages sdl)
  #:use-module (gnu packages spice)
  #:use-module (gnu packages texinfo)
  #:use-module (gnu packages tls)
  #:use-module (gnu packages web)
  #:use-module (gnu packages xdisorg)
  #:use-module (gnu packages xml)
  #:use-module (guix build-system gnu)
  #:use-module (guix build-system python)
  #:use-module (guix download)
  #:use-module ((guix licenses) #:select (gpl2 gpl2+ lgpl2.1+))
  #:use-module (guix packages)
  #:use-module (guix utils)
  #:use-module (srfi srfi-1))

(define (qemu-patch commit file-name sha256)
  "Return an origin for COMMIT."
  (origin
    (method url-fetch)
    (uri (string-append
          "http://git.qemu.org/?p=qemu.git;a=commitdiff_plain;h="
          commit))
    (sha256 sha256)
    (file-name file-name)))

(define-public qemu
  (package
    (name "qemu")
    (version "2.6.0")
    (source (origin
             (method url-fetch)
             (uri (string-append "http://wiki.qemu-project.org/download/qemu-"
                                 version ".tar.bz2"))
             (sha256
              (base32
               "1v1lhhd6m59hqgmiz100g779rjq70pik5v4b3g936ci73djlmb69"))))
    (build-system gnu-build-system)
    (arguments
     '(;; Running tests in parallel can occasionally lead to failures, like:
       ;; boot_sector_test: assertion fa<tr><td><span title='2015-10-21 18:01:38 +0200'>2015-10-21</span></td><td><a href='/guix/commit/gnu/packages/gnu-pw-mgr.scm?id=1a1553db7e8823b5b82f715058a227b3f703f7d8'>gnu: gnu-pw-mgr: Update to 1.6.</a><span class='msg-avail'>...<span class='msg-tooltip'>* gnu/packages/gnu-pw-mgr.scm (gnu-pw-mgr): Update to 1.6.
</span></span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2015-09-20 15:09:51 -0500'>2015-09-20</span></td><td><a href='/guix/commit/gnu/packages/gnu-pw-mgr.scm?id=f210647da264a637716b004ddde713a2dbe9beb6'>gnu: gnu-pw-mgr: Update to 1.5.</a><span class='msg-avail'>...<span class='msg-tooltip'>* gnu/packages/gnu-pw-mgr.scm (gnu-pw-mgr): Update to 1.5.
</span></span></td><td>Eric Bavier</td></tr>
<tr><td><span title='2015-06-02 15:43:34 -0400'>2015-06-02</span></td><td><a href='/guix/commit/gnu/packages/gnu-pw-mgr.scm?id=ed8a724b331869bf79a441a8c2243d2c4468101d'>gnu: gnu-pw-mgr: Update to 1.4.</a><span class='msg-avail'>...<span class='msg-tooltip'>* gnu/packages/gnu-pw-mgr.scm (gnu-pw-mgr): Update to 1.4.  Use .xz tarball.
  Move 'which' to native-inputs.  Add 'autogen' to native-inputs.
</span></span></td><td>Mark H Weaver</td></tr>
<tr><td><span title='2015-03-04 17:23:27 +0100'>2015-03-04</span></td><td><a href='/guix/commit/gnu/packages/gnu-pw-mgr.scm?id=ce0614ddb0c9aae46fba677a46392de8039c7086'>gnu: Move 'which' to (gnu packages base).</a><span class='msg-avail'>...<span class='msg-tooltip'>* gnu/packages/which.scm: Remove.
* gnu-system.am (GNU_SYSTEM_MODULES): Remove it.
* gnu/packages/base.scm (which): New variable.
* gnu/packages/aspell.scm, gnu/packages/audio.scm,
  gnu/packages/autogen.scm, gnu/packages/cdrom.scm,
  gnu/packages/compression.scm, gnu/packages/datamash.scm,
  gnu/packages/games.scm, gnu/packages/glib.scm,
  gnu/packages/gnu-pw-mgr.scm, gnu/packages/gnutls.scm,
  gnu/packages/gps.scm, gnu/packages/guile.scm,
  gnu/packages/java.scm, gnu/packages/libevent.scm,
  gnu/packages/linux.scm, gnu/packages/lisp.scm,
  gnu/packages/node.scm, gnu/packages/ntp.scm,
  gnu/packages/orpheus.scm, gnu/packages/pciutils.scm,
  gnu/packages/python.scm, gnu/packages/qt.scm,
  gnu/packages/rsync.scm, gnu/packages/sawfish.scm,
  gnu/packages/scheme.scm, gnu/packages/ssh.scm,
  gnu/packages/statistics.scm, gnu/packages/texlive.scm,
  gnu/packages/wdiff.scm: Adjust accordingly.
</span></span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2015-03-01 19:44:13 -0500'>2015-03-01</span></td><td><a href='/guix/commit/gnu/packages/gnu-pw-mgr.scm?id=f6176e7870010f2395ed28030f0517160558cc3c'>gnu: gnu-pw-mgr: Update to 1.3.</a><span class='msg-avail'>...<span class='msg-tooltip'>* gnu/packages/gnu-pw-mgr.scm (gnu-pw-mgr): Update to 1.3.
</span></span></td><td>Mark H Weaver</td></tr>
<tr><td><span title='2014-03-26 21:35:54 +0100'>2014-03-26</span></td><td><a href='/guix/commit/gnu/packages/gnu-pw-mgr.scm?id=8bae41a4cefce48af73afb46068ca84750a08da0'>gnu: gnu-pw-mgr: Fix download location.</a><span class='msg-avail'>...<span class='msg-tooltip'>* gnu/packages/gnu-pw-mgr.scm (gnu-pw-mgr): Fix download location.
</span></span></td><td>Andreas Enge</td></tr>
<tr><td><span title='2014-03-25 17:09:48 -0500'>2014-03-25</span></td><td><a href='/guix/commit/gnu/packages/gnu-pw-mgr.scm?id=7216a041581fe2533241ed31ddeec039cc66dd0e'>gnu: gnu-pw-mgr: Upgrade to 1.2</a><span class='msg-avail'>...<span class='msg-tooltip'>* gnu/packages/gnu-pw-mgr.scm: Upgrade to 1.2
</span></span></td><td>Eric Bavier</td></tr>
<tr><td><span title='2014-02-06 09:13:43 +0100'>2014-02-06</span></td><td><a href='/guix/commit/gnu/packages/gnu-pw-mgr.scm?id=8254b480664ad3af84564804dfc6ad2dd9b88afb'>gnu: gnu-pw-mgr: Upgrade to 1.1.</a><span class='msg-avail'>...<span class='msg-tooltip'>* gnu/packages/gnu-pw-mgr.scm (gnu-pw-mgr): Upgrade to 1.1.

Signed-off-by: Andreas Enge &lt;andreas@enge.fr&gt;
</span></span></td><td>Eric Bavier</td></tr>
<tr><td><span title='2013-12-03 22:07:23 +0100'>2013-12-03</span></td><td><a href='/guix/commit/gnu/packages/gnu-pw-mgr.scm?id=889a87f08c903832e110631f59a17c11943926fe'>gnu: Add gnu-pw-mgr</a><span class='msg-avail'>...<span class='msg-tooltip'>* gnu/packages/gnu-pw-mgr.scm: New file
* gnu-system.am (GNU_SYSTEM_MODULES): Add it

Signed-off-by: Ludovic Courtès &lt;ludo@gnu.org&gt;
</span></span></td><td>Eric Bavier</td></tr>
</table><ul class='pager'></ul></div> <!-- class=content -->
                         <div class=footer>generated by
                             <a href="https://git.zx2c4.com/cgit/about/">
                                 cgit
                             </a>
                         </div>
                        </div> <!-- id=cgit -->
</body>
</html>
uments qemu)))

    ;; Remove dependencies on optional libraries, notably GUI libraries.
    (inputs (fold alist-delete (package-inputs qemu)
                  '("libusb" "mesa" "sdl" "spice" "virglrenderer")))))

(define-public libosinfo
  (package
    (name "libosinfo")
    (version "0.3.1")
    (source
     (origin
       (method url-fetch)
       (uri (string-append "https://fedorahosted.org/releases/l/i/libosinfo/libosinfo-"
                           version ".tar.gz"))
       (sha256
        (base32
         "151qrzmafxww5yfamrr7phk8217xmihfhazpb597vdv87na75cjh"))))
    (build-system gnu-build-system)
    (arguments
     `(#:phases
       (modify-phases %standard-phases
         (add-after 'unpack 'copy-ids
           (lambda* (#:key inputs #:allow-other-keys)
             (copy-file (assoc-ref inputs "pci.ids") "data/pci.ids")
             (copy-file (assoc-ref inputs "usb.ids") "data/usb.ids")
             #t)))))
    (inputs
     `(("libsoup" ,libsoup)
       ("libxml2" ,libxml2)
       ("libxslt" ,libxslt)
       ("gobject-introspection" ,gobject-introspection)))
    (native-inputs
     `(("check" ,check)
       ("glib" ,glib "bin")  ; glib-mkenums, etc.
       ("gtk-doc" ,gtk-doc)
       ("vala" ,vala)
       ("intltool" ,intltool)
       ("pkg-config" ,pkg-config)
       ("pci.ids"
        ,(origin
           (method url-fetch)
           (uri "http://pciids.sourceforge.net/v2.2/pci.ids")
           (sha256
            (base32
             "0h8v0lrlrxkfnjiwnwiq86zyvb8qa2n3844dp1m01lh2nb2fliqw"))))
       ("usb.ids"
        ,(origin
           (method url-fetch)
           (uri "http://linux-usb.cvs.sourceforge.net/viewvc/linux-usb/htdocs/usb.ids?revision=1.539")
           (sha256
            (base32
             "0w9ila7662lzpx416lqy69zx6gfwq2xiigwd5fdyqcrg3dj07m80"))))))
    (home-page "https://libosinfo.org/")
    (synopsis "Operating system information database")
    (description "libosinfo is a GObject based library API for managing
information about operating systems, hypervisors and the (virtual) hardware
devices they can support.  It includes a database containing device metadata
and provides APIs to match/identify optimal devices for deploying an operating
system on a hypervisor.  Via GObject Introspection, the API is available in
all common programming languages.  Vala bindings are also provided.")
    ;; The library files are released under LGPLv2.1 or later; the source
    ;; files in the "tools" directory are released under GPLv2+.
    (license (list lgpl2.1+ gpl2+))))

(define-public libvirt
  (package
    (name "libvirt")
    (version "2.1.0")
    (source (origin
              (method url-fetch)
              (uri (string-append "http://libvirt.org/sources/libvirt-"
                                  version ".tar.xz"))
              (sha256
               (base32
                "0sriasjc573c519yqw1hcfb3qqjcsm9hm8vayw0anwkl6di9ay8s"))))
    (build-system gnu-build-system)
    (arguments
     `(;; FAIL: virshtest
       ;; FAIL: virfirewalltest
       ;; FAIL: virkmodtest
       ;; FAIL: virnetsockettest
       ;; FAIL: networkxml2firewalltest
       ;; FAIL: nwfilterebiptablestest
       ;; FAIL: nwfilterxml2firewalltest
       ;; Times out after PASS: virsh-vcpupin
       #:tests? #f
       #:configure-flags
       (list "--with-polkit"
             "--localstatedir=/var")
       #:phases
       (modify-phases %standard-phases
         (add-after 'unpack 'fix-tests
           (lambda _
             (substitute* '("tests/commandtest.c"
                            "gnulib/tests/test-posix_spawn1.c"
                            "gnulib/tests/test-posix_spawn2.c")
               (("/bin/sh") (which "sh")))
             #t))
         (add-after 'unpack 'do-not-mkdir-in-/var
           ;; Since the localstatedir should be /var at runtime, we must
           ;; prevent writing to /var at installation time.
           (lambda* (#:key outputs #:allow-other-keys)
             (let* ((out           (assoc-ref outputs "out"))
                    (localstatedir (string-append out "/var")))
               (substitute* '("src/Makefile.in"
                              "daemon/Makefile.in")
                 (("\\$\\(DESTDIR\\)\\$\\(localstatedir)") localstatedir)))
             #t)))))
    (inputs
     `(("libxml2" ,libxml2)
       ("gnutls" ,gnutls)
       ("dbus" ,dbus)
       ("qemu" ,qemu)
       ("polkit" ,polkit)
       ("libpcap" ,libpcap)
       ("libnl" ,libnl)
       ("libuuid" ,util-linux)
       ("lvm2" ,lvm2) ; for libdevmapper
       ("curl" ,curl)
       ("openssl" ,openssl)
       ("cyrus-sasl" ,cyrus-sasl)
       ("perl" ,perl)
       ("python" ,python-2)
       ("libyajl" ,libyajl)
       ("audit" ,audit)))
    (native-inputs
     `(("pkg-config" ,pkg-config)))
    (home-page "http://libvirt.org")
    (synopsis "Simple API for virtualization")
    (description "Libvirt is a C toolkit to interact with the virtualization
capabilities of recent versions of Linux.  The library aims at providing long
term stable C API initially for the Xen paravirtualization but should be able
to integrate other virtualization mechanisms if needed.")
    (license lgpl2.1+)))

(define-public libvirt-glib
  (package
    (name "libvirt-glib")
    (version "0.2.3")
    (source (origin
              (method url-fetch)
              (uri (string-append "ftp://libvirt.org/libvirt/glib/"
                                  "libvirt-glib-" version ".tar.gz"))
              (sha256
               (base32
                "1pahj8qa7k2307sd57rwqwq1hijya02v0sxk91hl3cw48niimcf3"))))
    (build-system gnu-build-system)
    (arguments
     `(#:phases
       (modify-phases %standard-phases
         (add-after 'unpack 'fix-tests
           (lambda _
             (substitute* "tests/test-events.c"
               (("/bin/true") (which "true")))
             #t)))))
    (inputs
     `(("libxml2" ,libxml2)
       ("libvirt" ,libvirt)
       ("gobject-introspection" ,gobject-introspection)
       ("glib" ,glib)
       ("openssl" ,openssl)
       ("cyrus-sasl" ,cyrus-sasl)
       ("lvm2" ,lvm2) ; for libdevmapper
       ("libyajl" ,libyajl)))
    (native-inputs
     `(("pkg-config" ,pkg-config)
       ("intltool" ,intltool)
       ("glib" ,glib "bin")
       ("vala" ,vala)))
    (home-page "http://libvirt.org")
    (synopsis "GLib wrapper around libvirt")
    (description "libvirt-glib wraps the libvirt library to provide a
high-level object-oriented API better suited for glib-based applications, via
three libraries:

@enumerate
@item libvirt-glib - GLib main loop integration & misc helper APIs
@item libvirt-gconfig - GObjects for manipulating libvirt XML documents
@item libvirt-gobject - GObjects for managing libvirt objects
@end enumerate
")
    (license lgpl2.1+)))

(define-public python-libvirt
  (package
    (name "python-libvirt")
    (version "2.0.0")
    (source (origin
              (method url-fetch)
              (uri (pypi-uri "libvirt-python" version))
              (sha256
               (base32
                "0h0x5lpsx97bvw20pzfcsdmmivximddq4qmn8fk0n55dqv0wn5kq"))))
    (build-system python-build-system)
    (arguments
     `(#:phases
       (modify-phases %standard-phases
         (add-after 'unpack 'patch-nosetests-path
           (lambda* (#:key inputs #:allow-other-keys)
             (substitute* "setup.py"
               (("sys.executable, \"/usr/bin/nosetests\"")
                (string-append "\"" (which "bash") "\", \""
                               (which "nosetests") "\"")))
             #t)))))
    (inputs
     `(("libvirt" ,libvirt)
       ("python-lxml" ,python-lxml)))
    (native-inputs
     `(("pkg-config" ,pkg-config)
       ("python-nose" ,python-nose)))
    (home-page "http://libvirt.org")
    (synopsis "Python bindings to libvirt")
    (description "This package provides Python bindings to the libvirt
virtualization library.")
    (license lgpl2.1+)))

(define-public python2-libvirt
  (package-with-python2 python-libvirt))

(define-public virt-manager
  (package
    (name "virt-manager")
    (version "1.4.0")
    (source (origin
              (method url-fetch)
              (uri (string-append "https://virt-manager.org/download/sources"
                                  "/virt-manager/virt-manager-"
                                  version ".tar.gz"))
              (sha256
               (base32
                "1jnawqjmcqd2db78ngx05x7cxxn3iy1sb4qfgbwcn045qh6a8cdz"))))
    (build-system python-build-system)
    (arguments
     `(#:python ,python-2
       ;; Some of the tests seem to require network access to install virtual
       ;; machines.
       #:tests? #f
       #:modules ((ice-9 match)
                  (srfi srfi-26)
                  (guix build python-build-system)
                  (guix build utils))
       #:phases
       (modify-phases %standard-phases
         (add-after 'unpack 'fix-setup
           (lambda* (#:key outputs #:allow-other-keys)
             (substitute* "virtcli/cliconfig.py"
               (("/usr") (assoc-ref outputs "out")))
             #t))
         (add-before 'wrap 'wrap-with-GI_TYPELIB_PATH
           (lambda* (#:key inputs outputs #:allow-other-keys)
             (let* ((bin       (string-append (assoc-ref outputs "out") "/bin"))
                    (bin-files (find-files bin ".*"))
                    (paths     (map (match-lambda
                                      ((output . directory)
                                       (let* ((girepodir (string-append
                                                          directory
                                                          "/lib/girepository-1.0")))
                                         (if (file-exists? girepodir)
                                             girepodir #f))))
                                    inputs)))
               (for-each (lambda (file)
                           (format #t "wrapping ~a\n" file)
                           (wrap-program file
                             `("GI_TYPELIB_PATH" ":" prefix
                               ,(filter identity paths))))
                         bin-files))
             #t)))))
    (inputs
     `(("gtk+" ,gtk+)
       ("libvirt" ,libvirt)
       ("libvirt-glib" ,libvirt-glib)
       ("libosinfo" ,libosinfo)
       ("gobject-introspection" ,gobject-introspection)
       ("python2-libvirt" ,python2-libvirt)
       ("python2-requests" ,python2-requests)
       ("python2-ipaddr" ,python2-ipaddr)
       ("python2-pygobject" ,python2-pygobject)
       ("python2-libxml2" ,python2-libxml2)))
    ;; virt-manager searches for qemu-img or kvm-img in the PATH.
    (propagated-inputs
     `(("qemu" ,qemu)))
    (native-inputs
     `(("glib" ,glib "bin")             ; glib-compile-schemas.
       ("perl" ,perl)                   ; pod2man
       ("intltool" ,intltool)))
    (home-page "https://virt-manager.org/")
    (synopsis "Manage virtual machines")
    (description
     "The virt-manager application is a desktop user interface for managing
virtual machines through libvirt.  It primarily targets KVM VMs, but also
manages Xen and LXC (Linux containers).  It presents a summary view of running
domains, their live performance and resource utilization statistics.")
    (license gpl2+)))