Merge branch 'master' into staging

doc/guix.texi

@@ -1051,13 +1051,11 @@ name, and they will be scheduled on matching build machines.
 @end table
 @end deftp
 
-The @code{guile} command must be in the search path on the build
+The @command{guix} command must be in the search path on the build
-machines.  In addition, the Guix modules must be in
+machines.  You can check whether this is the case by running:
-@code{$GUILE_LOAD_PATH} on the build machine---you can check whether
-this is the case by running:
 
 @example
-ssh build-machine guile -c "'(use-modules (guix config))'"
+ssh build-machine guix repl --version
 @end example
 
 There is one last thing to do once @file{machines.scm} is in place.  As
@@ -7392,6 +7390,22 @@ are many packages, though, for which it lacks a method to determine
 whether a new upstream release is available.  However, the mechanism is
 extensible, so feel free to get in touch with us to add a new method!
 
+@table @code
+
+@item --recursive
+Consider the packages specified, and all the packages upon which they depend.
+
+@example
+$ guix refresh --recursive coreutils
+gnu/packages/acl.scm:35:2: warning: no updater for acl
+gnu/packages/m4.scm:30:12: info: 1.4.18 is already the latest version of m4
+gnu/packages/xml.scm:68:2: warning: no updater for expat
+gnu/packages/multiprecision.scm:40:12: info: 6.1.2 is already the latest version of gmp
+@dots{}
+@end example
+
+@end table
+
 Sometimes the upstream name differs from the package name used in Guix,
 and @command{guix refresh} needs a little help.  Most updaters honor the
 @code{upstream-name} property in package definitions, which can be used
@@ -7565,6 +7579,22 @@ hop@@2.4.0 geiser@@0.4 notmuch@@0.18 mu@@0.9.9.5 cflow@@1.4 idutils@@4.6 @dots{}
 The command above lists a set of packages that could be built to check
 for compatibility with an upgraded @code{flex} package.
 
+@table @code
+
+@item --list-transitive
+List all the packages which one or more packages depend upon.
+
+@example
+$ guix refresh --list-transitive flex
+flex@@2.6.4 depends on the following 25 packages: perl@@5.28.0 help2man@@1.47.6
+bison@@3.0.5 indent@@2.2.10 tar@@1.30 gzip@@1.9 bzip2@@1.0.6 xz@@5.2.4 file@@5.33 @dots{}
+@end example
+
+@end table
+
+The command above lists a set of packages which, when changed, would cause
+@code{flex} to be rebuilt.
+
 The following options can be used to customize GnuPG operation:
 
 @table @code
@@ -7660,12 +7690,14 @@ Identify inputs that should most likely be native inputs.
 @item source
 @itemx home-page
 @itemx mirror-url
+@itemx github-url
 @itemx source-file-name
 Probe @code{home-page} and @code{source} URLs and report those that are
-invalid.  Suggest a @code{mirror://} URL when applicable.  Check that
+invalid.  Suggest a @code{mirror://} URL when applicable.  If the
-the source file name is meaningful, e.g.@: is not
+@code{source} URL redirects to a GitHub URL, recommend usage of the GitHub
-just a version number or ``git-checkout'', without a declared
+URL.  Check that the source file name is meaningful, e.g.@: is not just a
-@code{file-name} (@pxref{origin Reference}).
+version number or ``git-checkout'', without a declared @code{file-name}
+(@pxref{origin Reference}).
 
 @item cve
 @cindex security vulnerabilities
@@ -16332,6 +16364,37 @@ Configuration snippet added as-is to the BitlBee configuration file.
 @end table
 @end deftp
 
+@subsubheading Quassel Service
+
+@cindex IRC (Internet Relay Chat)
+@url{https://quassel-irc.org/,Quassel} is a distributed IRC client,
+meaning that one or more clients can attach to and detach from the
+central core.
+
+@defvr {Scheme Variable} quassel-service-type
+This is the service type for the @url{https://quassel-irc.org/,Quassel}
+IRC backend daemon.  Its value is a @code{quassel-configuration}
+(see below).
+@end defvr
+
+@deftp {Data Type} quassel-configuration
+This is the configuration for Quassel, with the following fields:
+
+@table @asis
+@item @code{quassel} (default: @code{quassel})
+The Quassel package to use.
+
+@item @code{interface} (default: @code{"::,0.0.0.0"})
+@item @code{port} (default: @code{4242})
+Listen on the network interface(s) corresponding to the IPv4 or IPv6
+interfaces specified in the comma delimited @var{interface}, on
+@var{port}.
+
+@item @code{loglevel} (default: @code{"Info"})
+The level of logging desired.  Accepted values are Debug, Info, Warning
+and Error.
+@end table
+@end deftp
 
 @node Telephony Services
 @subsubsection Telephony Services

gnu/local.mk

@@ -689,6 +689,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/fcgi-2.4.0-poll.patch			\
   %D%/packages/patches/fifo-map-fix-flags-for-gcc.patch		\
   %D%/packages/patches/fifo-map-remove-catch.hpp.patch		\
+  %D%/packages/patches/file-CVE-2018-10360.patch		\
   %D%/packages/patches/findutils-gnulib-libio.patch		\
   %D%/packages/patches/findutils-localstatedir.patch		\
   %D%/packages/patches/findutils-makedev.patch			\

gnu/packages/audio.scm

@@ -17,6 +17,7 @@
 ;;; Copyright © 2018 Marius Bakke <mbakke@fastmail.com>
 ;;; Copyright © 2018 Thorsten Wilms <t_w_@freenet.de>
 ;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org>
+;;; Copyright © 2018 Brendan Tildesley <brendan.tildesley@openmailbox.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -74,6 +75,7 @@
   #:use-module (gnu packages qt)
   #:use-module (gnu packages libbsd)
   #:use-module (gnu packages linux)
+  #:use-module (gnu packages libusb)
   #:use-module (gnu packages llvm)
   #:use-module (gnu packages mp3) ;taglib
   #:use-module (gnu packages perl)
@@ -229,57 +231,79 @@ namespace ARDOUR { const char* revision = \"" version "\" ; }"))
     (arguments
      `(#:configure-flags '("--cxx11"          ; required by gtkmm
                            "--no-phone-home"  ; don't contact ardour.org
-                           "--freedesktop"    ; install .desktop file
+                           "--freedesktop"    ; build .desktop file
                            "--test")          ; build unit tests
        #:phases
        (modify-phases %standard-phases
-         (add-after
+         (add-after 'unpack 'set-rpath-in-LDFLAGS
-          'unpack 'set-rpath-in-LDFLAGS
+          ,(ardour-rpath-phase (version-major version)))
-          ,(ardour-rpath-phase (version-major version))))
+         (add-after 'install 'install-freedesktop-files
+           (lambda* (#:key outputs #:allow-other-keys)
+             (let* ((out   (assoc-ref outputs "out"))
+                    (share (string-append out "/share"))
+                    (ver   ,(version-major version)))
+               (for-each
+                 (lambda (size)
+                   (let ((dir (string-append share "/icons/hicolor/"
+                                             size "x" size "/apps")))
+                     (mkdir-p dir)
+                     (copy-file
+                       (string-append "gtk2_ardour/resources/Ardour-icon_"
+                                      size "px.png")
+                       (string-append dir "/ardour" ver ".png"))))
+                 '("16" "22" "32" "48" "256"))
+               (install-file (string-append "build/gtk2_ardour/ardour"
+                                            ver ".desktop")
+                             (string-append share "/applications/"))
+               (install-file (string-append "build/gtk2_ardour/ardour"
+                                            ver ".appdata.xml")
+                             (string-append share "/appdata/")))
+             #t)))
        #:test-target "test"
        #:python ,python-2))
     (inputs
      `(("alsa-lib" ,alsa-lib)
-       ("aubio" ,aubio)
-       ("lrdf" ,lrdf)
-       ("boost" ,boost)
        ("atkmm" ,atkmm)
+       ("aubio" ,aubio)
+       ("boost" ,boost)
        ("cairomm" ,cairomm)
-       ("eudev" ,eudev)
-       ("gtkmm" ,gtkmm-2)
-       ("glibmm" ,glibmm)
-       ("libart-lgpl" ,libart-lgpl)
-       ("libgnomecanvasmm" ,libgnomecanvasmm)
-       ("pangomm" ,pangomm)
-       ("liblo" ,liblo)
-       ("libsndfile" ,libsndfile)
-       ("libsamplerate" ,libsamplerate)
-       ("libxml2" ,libxml2)
-       ("libogg" ,libogg)
-       ("libvorbis" ,libvorbis)
-       ("flac" ,flac)
-       ("lv2" ,lv2)
-       ("vamp" ,vamp)
        ("curl" ,curl)
+       ("eudev" ,eudev)
        ("fftw" ,fftw)
        ("fftwf" ,fftwf)
+       ("flac" ,flac)
+       ("glibmm" ,glibmm)
+       ("gtkmm" ,gtkmm-2)
        ("jack" ,jack-1)
+       ("libarchive" ,libarchive)
+       ("libart-lgpl" ,libart-lgpl)
+       ("libgnomecanvasmm" ,libgnomecanvasmm)
+       ("liblo" ,liblo)
+       ("libogg" ,libogg)
+       ("libsamplerate" ,libsamplerate)
+       ("libsndfile" ,libsndfile)
+       ("libusb" ,libusb)
+       ("libvorbis" ,libvorbis)
+       ("libxml2" ,libxml2)
+       ("lilv" ,lilv)
+       ("lrdf" ,lrdf)
+       ("lv2" ,lv2)
+       ("pangomm" ,pangomm)
+       ("python-rdflib" ,python-rdflib)
+       ("readline" ,readline)
+       ("redland" ,redland)
+       ("rubberband" ,rubberband)
        ("serd" ,serd)
        ("sord" ,sord)
        ("sratom" ,sratom)
        ("suil" ,suil)
-       ("lilv" ,lilv)
-       ("readline" ,readline)
-       ("redland" ,redland)
-       ("rubberband" ,rubberband)
-       ("libarchive" ,libarchive)
        ("taglib" ,taglib)
-       ("python-rdflib" ,python-rdflib)))
+       ("vamp" ,vamp)))
     (native-inputs
-     `(("perl" ,perl)
+     `(("cppunit" ,cppunit)
-       ("cppunit" ,cppunit)
-       ("itstool" ,itstool)
        ("gettext" ,gettext-minimal)
+       ("itstool" ,itstool)
+       ("perl" ,perl)
        ("pkg-config" ,pkg-config)))
     (home-page "http://ardour.org")
     (synopsis "Digital audio workstation")

gnu/packages/dictionaries.scm

@@ -247,21 +247,41 @@ and a Python library.")
 (define-public translate-shell
   (package
     (name "translate-shell")
-    (version "0.9.6.8")
+    (version "0.9.6.9")
     (source
       (origin
-        (method url-fetch)
+        (method git-fetch)
-        (uri (string-append "https://github.com/soimort/" name "/archive/v"
+        (uri (git-reference
-                            version ".tar.gz"))
+               (url"https://github.com/soimort/translate-shell.git")
+               (commit (string-append "v" version))))
+        (file-name (git-file-name name version))
         (sha256
          (base32
-          "17yc2kwk8957wwxyih0jmsai720ai2yqyvmrqrglcncqg6zdbz9w"))
+          "1xyf0vdxmbgqcgsr1gvgwh1q4fh080h68radkim6pfcwzffliszm"))))
-        (file-name (string-append name "-" version ".tar.gz"))))
     (build-system gnu-build-system)
     (arguments
      `(#:phases
        (modify-phases %standard-phases
          (delete 'configure)            ; no configure phase
+         (add-after 'unpack 'remove-unnecessary-file
+           ;; This file gets generated during the build phase.
+           (lambda _
+             (delete-file "translate")
+             #t))
+         (add-after 'install 'wrap-binary
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let* ((out     (assoc-ref outputs "out"))
+                    (bin     (string-append out "/bin/trans"))
+                    (curl    (assoc-ref inputs "curl"))
+                    (fribidi (assoc-ref inputs "fribidi"))
+                    (rlwrap  (assoc-ref inputs "rlwrap")))
+               (wrap-program bin
+                             `("PATH" ":" prefix
+                               (,(string-append out "/bin:"
+                                                curl "/bin:"
+                                                fribidi "/bin:"
+                                                rlwrap "/bin")))))
+             #t))
          (add-after 'install 'emacs-install
            (lambda* (#:key inputs outputs #:allow-other-keys)
              (let* ((out   (assoc-ref outputs "out"))
@@ -277,7 +297,7 @@ and a Python library.")
                   (guix build emacs-utils)
                   (guix build utils))
        #:test-target "test"))
-    (propagated-inputs
+    (inputs
      `(("curl" ,curl)
        ("fribidi" ,fribidi)
        ("rlwrap" ,rlwrap)))

gnu/packages/education.scm

@@ -41,6 +41,7 @@
   #:use-module (gnu packages qt)
   #:use-module (gnu packages sdl)
   #:use-module (gnu packages texinfo)
+  #:use-module (gnu packages xorg)
   #:use-module (gnu packages xml)
   #:use-module ((guix licenses) #:prefix license:)
   #:use-module (guix packages)
@@ -115,7 +116,7 @@ of categories with some of the activities available in that category.
 (define-public gcompris-qt
   (package
     (name "gcompris-qt")
-    (version "0.91")
+    (version "0.95")
     (source
       (origin
         (method url-fetch)
@@ -124,17 +125,17 @@ of categories with some of the activities available in that category.
                version ".tar.xz"))
         (sha256
          (base32
-          "09h098w9q79hnzla1pcpqlnnr6dbafm4q6zmdp7wlk11ym8n9kvg"))))
+          "1aaijjx2b7k1cyx59jhs64hlp1sppw1faa81qxl5lxc79vifrlrl"))))
     (build-system cmake-build-system)
     (arguments
      `(#:phases
        (modify-phases %standard-phases
-         (add-after 'unpack 'patch-for-qt5.11
+         (add-before 'check 'start-xorg-server
-           (lambda _
+           (lambda* (#:key inputs #:allow-other-keys)
-             (substitute* "src/core/CMakeLists.txt"
+             ;; The test suite requires a running X server.
-               (("qt5_use_modules") "target_link_libraries")
+             (system (string-append (assoc-ref inputs "xorg-server")
-               (("Qml Quick Gui Multimedia Network XmlPatterns Svg Xml Sensors Core")
+                                    "/bin/Xvfb :1 &"))
-                "Qt5::Qml Qt5::Quick Qt5::Gui Qt5::Multimedia Qt5::Core Qt5::Svg Qt5::Xml Qt5::XmlPatterns Qt5::Sensors"))
+             (setenv "DISPLAY" ":1")
              #t))
          (add-after 'install 'wrap-executable
            (lambda* (#:key inputs outputs #:allow-other-keys)
@@ -152,13 +153,14 @@ of categories with some of the activities available in that category.
                          '("qtdeclarative" "qtgraphicaleffects"
                            "qtmultimedia" "qtquickcontrols"))))
                #t))))
-       #:configure-flags (list "-DQML_BOX2D_MODULE=disabled")
+       #:configure-flags (list "-DQML_BOX2D_MODULE=disabled"
-       #:tests? #f)) ; no test target
+                               "-DBUILD_TESTING=TRUE")))
     (native-inputs
      `(("extra-cmake-modules" ,extra-cmake-modules)
        ("gettext" ,gettext-minimal)
        ("perl" ,perl)
-       ("qttools" ,qttools)))
+       ("qttools" ,qttools)
+       ("xorg-server" ,xorg-server)))
     (inputs
      `(("python-2" ,python-2)
        ("qtbase" ,qtbase)

gnu/packages/file.scm

@@ -3,6 +3,7 @@
 ;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -30,6 +31,7 @@
   (package
     (name "file")
     (version "5.33")
+    (replacement file/fixed)
     (source (origin
               (method url-fetch)
               (uri (string-append "ftp://ftp.astron.com/pub/file/file-"
@@ -51,3 +53,10 @@ extensions to tell you the type of a file, but looks at the actual contents
 of the file.  This package provides the libmagic library.")
    (license bsd-2)
    (home-page "https://www.darwinsys.com/file/")))
+
+(define file/fixed
+  (package
+    (inherit file)
+    (source
+      (origin (inherit (package-source file))
+              (patches (search-patches "file-CVE-2018-10360.patch"))))))

gnu/packages/fonts.scm

@@ -22,6 +22,7 @@
 ;;; Copyright © 2017, 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2017 Mohammed Sadiq <sadiq@sadiqpk.org>
 ;;; Copyright © 2018 Charlie Ritter <chewzerita@posteo.net>
+;;; Copyright © 2018 Gabriel Hondet <gabrielhondet@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -1351,3 +1352,24 @@ reproduction and display environments.  This package provides only TrueType
 files (TTF).")
     (home-page "https://software.sil.org/charis/")
     (license license:silofl1.1)))
+
+(define-public font-mononoki
+  (package
+    (name "font-mononoki")
+    (version "1.2")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://github.com/madmalik/mononoki/")
+                    (commit version)))
+              (sha256
+               (base32
+                "1rkzyxn30rn8qv2h2xz324j7q15hzg2lci8790a7cdl1dfgic4xi"))
+              (file-name (git-file-name name version))))
+    (build-system font-build-system)
+    (synopsis "Font for programming and code review")
+    (description
+     "Mononoki is a typeface by Matthias Tellen, created to enhance code
+formatting.")
+    (home-page "https://madmalik.github.io/mononoki/")
+    (license license:silofl1.1)))

gnu/packages/gnupg.scm

@@ -471,16 +471,23 @@ interface (FFI) of Guile.")
 (define-public python-gpg
   (package
     (name "python-gpg")
-    (version "1.8.0")
+    (version "1.10.0")
     (source (origin
               (method url-fetch)
               (uri (pypi-uri "gpg" version))
               (sha256
                (base32
-                "1x74i6q713c0bckls7rdm8kgsmllf9qvy9x62jghszlhgjkyh9nd"))))
+                "1ji3ynhp36m1ccx7bmaq75dhij9frpn19v9mpi4aajn8csl194il"))))
     (build-system python-build-system)
     (arguments
-     '(#:tests? #f)) ; No test suite.
+     '(#:phases
+       (modify-phases %standard-phases
+         (add-before 'build 'set-environment
+           (lambda _
+             (substitute* "setup.py"
+               (("cc") (which "gcc")))
+             #t)))
+       #:tests? #f)) ; No test suite.
     (inputs
      `(("gpgme" ,gpgme)))
     (native-inputs

gnu/packages/kde-frameworks.scm

@@ -207,33 +207,6 @@ Phonon-GStreamer is a backend based on the GStreamer multimedia library.")
     ;; license: source files mention "either version 2.1 or 3"
     (license (list license:lgpl2.1 license:lgpl3))))
 
-(define-public gpgmepp
-  (package
-    (name "gpgmepp")
-    (version "16.08.2")
-    (source (origin
-              (method url-fetch)
-              (uri (string-append
-                    "mirror://kde/stable/applications"
-                    "/" version "/src/"
-                    name "-" version ".tar.xz"))
-              (sha256
-               (base32
-                "0828qlhdi1i26n2xgyb01c0q77m6jlppbxv6mprryxq0ma88940a"))))
-    (build-system cmake-build-system)
-    (native-inputs
-     `(("extra-cmake-modules" ,extra-cmake-modules)))
-    (propagated-inputs
-     `(("boost" ,boost)
-       ("gpgme" ,gpgme)))
-    (inputs
-     `(("qtbase" ,qtbase)))
-    (home-page "https://community.kde.org/Frameworks")
-    (synopsis "C++ bindings/wrapper for gpgme")
-    (description "C++ bindings/wrapper for gpgme.")
-    (license license:lgpl2.1+)
-    (properties `((superseded . ,gpgme)))))
-
 (define-public kpmcore
   (package
     (name "kpmcore")
@@ -2003,7 +1976,8 @@ gallons).")
            ;; This test fails on i686 and aarch64
            (lambda _
              (substitute* "autotests/unit/file/CMakeLists.txt"
-               (("metadatamovertest") ""))
+               (("^\\s*ecm_add_test\\(.* TEST_NAME metadatamovertest .*" line)
+                (string-append "# " line)))
              #t))
          (replace 'check
            (lambda _

gnu/packages/llvm.scm

@@ -97,10 +97,10 @@ of programming tools as well as libraries with equivalent functionality.")
 
 ;; TODO: Build Mesa with LLVM 7 in the next staging cycle.
 ;; TODO: Make LLVM 7 the default LLVM once Clang is also upgraded.
-(define-public llvm-7.0.0
+(define-public llvm-7.0.1
   (package (inherit llvm)
     (name "llvm")
-    (version "7.0.0")
+    (version "7.0.1")
     (source
      (origin
       (method url-fetch)
@@ -108,7 +108,7 @@ of programming tools as well as libraries with equivalent functionality.")
                           version "/llvm-" version ".src.tar.xz"))
       (sha256
        (base32
-        "08p27wv1pr9ql2zc3f3qkkymci46q7myvh8r5ijippnbwr2gihcb"))))))
+        "16s196wqzdw4pmri15hadzqgdi926zln3an2viwyq0kini6zr3d3"))))))
 
 (define* (clang-runtime-from-llvm llvm hash
                                   #:optional (patches '()))

gnu/packages/ocaml.scm

@@ -10,6 +10,7 @@
 ;;; Copyright © 2017 Ben Woodcroft <donttrustben@gmail.com>
 ;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2018 Peter Kreye <kreyepr@gmail.com>
+;;; Copyright © 2018 Gabriel Hondet <gabrielhondet@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -4989,3 +4990,57 @@ provides BigN, BigZ, BigQ that used to be part of Coq standard library.")
 simplifying the proofs of inequalities on expressions of real numbers for the
 Coq proof assistant.")
     (license license:cecill-c)))
+
+(define-public dedukti
+  (package
+    (name "dedukti")
+    (version "2.6.0")
+    (home-page "https://deducteam.github.io/")
+    (source
+     (origin
+       (method git-fetch)
+       (uri (git-reference
+             (url "https://github.com/deducteam/dedukti.git")
+             (commit (string-append "v" version))))
+       (file-name (git-file-name name version))
+       (sha256
+        (base32
+         "0frl3diff033i4fmq304b8wbsdnc9mvlhmwd7a3zd699ng2lzbxb"))))
+    (inputs
+     `(("menhir" ,ocaml-menhir)))
+    (native-inputs
+     `(("ocamlbuild" ,ocamlbuild)))
+    (build-system ocaml-build-system)
+    (arguments
+     `(#:phases
+       (modify-phases %standard-phases
+         (delete 'configure)
+         (replace 'build
+           (lambda _
+             (invoke "make")
+	     #t))
+         (replace 'check
+           (lambda _
+             (invoke "make" "tests")
+	     #t))
+         (add-before 'install 'set-binpath
+           ;; Change binary path in the makefile
+           (lambda _
+             (let ((out (assoc-ref %outputs "out")))
+               (substitute* "GNUmakefile"
+                 (("BINDIR = (.*)$")
+                  (string-append "BINDIR = " out "/bin"))))
+	     #t))
+	 (replace 'install
+	   (lambda _
+	     (invoke "make" "install")
+	     #t)))))
+    (synopsis "Proof-checker for the λΠ-calculus modulo theory, an extension of
+the λ-calculus")
+    (description "Dedukti is a proof-checker for the λΠ-calculus modulo
+theory.  The λΠ-calculus is an extension of the simply typed λ-calculus with
+dependent types.  The λΠ-calculus modulo theory is itself an extension of the
+λΠ-calculus where the context contains variable declaration as well as rewrite
+rules.  This system is not designed to develop proofs, but to check proofs
+developed in other systems.  In particular, it enjoys a minimalistic syntax.")
+    (license license:cecill-c)))

gnu/packages/package-management.scm

@@ -105,8 +105,8 @@
   ;; Note: the 'update-guix-package.scm' script expects this definition to
   ;; start precisely like this.
   (let ((version "0.16.0")
-        (commit "bdf860c2e99077d431da0cc1db4fc14db2a35d31")
+        (commit "6f1e0bb79266f34b50b09200b9280a641b8aa7c8")
-        (revision 6))
+        (revision 7))
     (package
       (name "guix")
 
@@ -122,7 +122,7 @@
                       (commit commit)))
                 (sha256
                  (base32
-                  "0876y2pjcrwb3ynxqlpkn3pxx2iil8hrzdadh23jd6jbhvm087q1"))
+                  "0xk4ki5zsliwknxc9a3lvpjzpckz8nx4dz55xmw9sydq5z5mmy50"))
                 (file-name (string-append "guix-" version "-checkout"))))
       (build-system gnu-build-system)
       (arguments

gnu/packages/parallel.scm

@@ -48,7 +48,7 @@
 (define-public parallel
   (package
     (name "parallel")
-    (version "20181122")
+    (version "20181222")
     (source
      (origin
       (method url-fetch)
@@ -56,7 +56,7 @@
                           version ".tar.bz2"))
       (sha256
        (base32
-        "1mcqymf6vg8jhnjv71sswcz5xrwpq2h2ishi8m1hz8rwhc65h1ig"))))
+        "0sd39nzgff3rpyzfwkffb5yxbdm5r6amrkslbgpjlrcrymy9z305"))))
     (build-system gnu-build-system)
     (arguments
      `(#:phases

gnu/packages/patches/file-CVE-2018-10360.patch

@@ -0,0 +1,27 @@
+https://github.com/file/file/commit/a642587a9c9e2dd7feacdf513c3643ce26ad3c22.patch
+The leading part of the patch starting at line 27 was trimmed off.
+This patch should be OK to drop with file@5.35.
+
+From a642587a9c9e2dd7feacdf513c3643ce26ad3c22 Mon Sep 17 00:00:00 2001
+From: Christos Zoulas <christos@zoulas.com>
+Date: Sat, 9 Jun 2018 16:00:06 +0000
+Subject: [PATCH] Avoid reading past the end of buffer (Rui Reis)
+
+---
+ src/readelf.c | 5 +++--
+ 1 file changed, 3 insertions(+), 2 deletions(-)
+
+diff --git a/src/readelf.c b/src/readelf.c
+index 79c83f9f5..1f41b4611 100644
+--- a/src/readelf.c
++++ b/src/readelf.c
+@@ -842,7 +842,8 @@ do_core_note(struct magic_set *ms, unsigned char *nbuf, uint32_t type,
+ 
+ 				cname = (unsigned char *)
+ 				    &nbuf[doff + prpsoffsets(i)];
+-				for (cp = cname; *cp && isprint(*cp); cp++)
++				for (cp = cname; cp < nbuf + size && *cp
++				    && isprint(*cp); cp++)
+ 					continue;
+ 				/*
+ 				 * Linux apparently appends a space at the end

gnu/packages/photo.scm

@@ -353,7 +353,7 @@ photographic equipment.")
 (define-public darktable
   (package
     (name "darktable")
-    (version "2.4.4")
+    (version "2.6.0")
     (source (origin
               (method url-fetch)
               (uri (string-append
@@ -362,7 +362,7 @@ photographic equipment.")
                     version "/darktable-" version ".tar.xz"))
               (sha256
                (base32
-                "0kdhmiw4wxk2w9v2hms9yk8nl4ymdshnqyj0l07nivzzr6w20hwn"))))
+                "0y04cx0a0rwdclmn16f5y0z2vnm7yxly291gzjgdhcn59a77sga8"))))
     (build-system cmake-build-system)
     (arguments
      `(#:tests? #f ; There are no tests.

gnu/packages/python-web.scm

@@ -509,27 +509,28 @@ is Python’s.")
 (define-public python-openid
   (package
     (name "python-openid")
-    (version "3.0.10")
+    (version "3.1.0")
     (source
      (origin
        (method url-fetch)
        (uri (pypi-uri "python3-openid" version))
        (sha256
         (base32
-         "1x3nh3fycqfn43jp5j5pb4q4y2jxp4mdka4absaa3bc0078qd758"))))
+         "00l5hrjh19740w00b3fnsqldnla41wbr2rics09dl4kyd1fkd3b2"))))
     (build-system python-build-system)
     (arguments
      `(#:phases
        (modify-phases %standard-phases
         (replace 'check
           (lambda _
-            (invoke "./admin/runtests")
+            (invoke "coverage" "run" "-m"
-            #t)))))
+                    "unittest" "openid.test.test_suite"))))))
     (properties `((python2-variant . ,(delay python2-openid))))
     (propagated-inputs
      `(("python-defusedxml" ,python-defusedxml)))
     (native-inputs
-     `(("python-psycopg2" ,python-psycopg2)
+     `(("python-coverage" ,python-coverage)
+       ("python-psycopg2" ,python-psycopg2)
        ("python-django" ,python-django)))
     (home-page "https://github.com/necaris/python3-openid")
     (synopsis "OpenID support for servers and consumers")

gnu/packages/python.scm

@@ -12637,14 +12637,14 @@ validating Swagger API specifications.")
 (define-public python-apache-libcloud
   (package
     (name "python-apache-libcloud")
-    (version "2.3.0")
+    (version "2.4.0")
     (source
       (origin
         (method url-fetch)
         (uri (pypi-uri "apache-libcloud" version))
         (sha256
-          (base32
+         (base32
-            "15xg79ad4g2xrk081ylvj41k5hmg9hl1xvbmb5hd0fqn08wfwbhf"))))
+          "0daj3mkzw79v5zin2r1s2wkrz1hplfc16bwj4ss68i5qjq4l2p0j"))))
     (build-system python-build-system)
     (arguments
      `(#:phases

gnu/packages/wine.scm

@@ -225,7 +225,7 @@ integrate Windows applications into your desktop.")
 (define-public wine-staging-patchset-data
   (package
    (name "wine-staging-patchset-data")
-   (version "3.21")
+   (version "4.0-rc3")
    (source
     (origin
       (method git-fetch)
@@ -235,7 +235,7 @@ integrate Windows applications into your desktop.")
       (file-name (git-file-name name version))
       (sha256
        (base32
-        "1bxryvqw5rvhcx8vjl714jaj0rjsrh95kh3sn499rrljc3c8qsbl"))))
+        "1yx758mv605w2g7f9aj4xf09p8q5dvbf6b9h1kdvsyhm8bkrgx66"))))
    (build-system trivial-build-system)
    (native-inputs
     `(("bash" ,bash)
@@ -276,12 +276,12 @@ integrate Windows applications into your desktop.")
               (method url-fetch)
               (uri (string-append
                     "https://dl.winehq.org/wine/source/"
-                    (version-major version) ".x"
+                    (version-major version) ".0"
                     "/wine-" version ".tar.xz"))
               (file-name (string-append name "-" version ".tar.xz"))
               (sha256
                (base32
-                "1h70wb7kysbzv36i3fblyiihvalwhy6sj4s2a8nf21nz2mhc0k58"))))
+                "176cdnznbk3pikh87j5q4cjb7rky5dxikf1nr0mp8a9cycycxr7w"))))
     (inputs `(("autoconf" ,autoconf) ; for autoreconf
               ("gtk+" ,gtk+)
               ("libva" ,libva)

gnu/packages/wm.scm

@@ -76,6 +76,7 @@
   #:use-module (gnu packages lua)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages suckless)
+  #:use-module (gnu packages mpd)
   #:use-module (guix download)
   #:use-module (guix git-download))
 
@@ -1051,3 +1052,45 @@ its size
 @item Display preview images in a tiled icon layout
 @end itemize")
     (license license:gpl2+)))
+
+(define-public polybar
+  (package
+    (name "polybar")
+    (version "3.3.0")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "https://github.com/jaagr/polybar/releases/"
+                           "download/" version "/polybar.tar"))
+       (sha256
+        (base32 "0sjh3xmf11g09spi88zj7xsc3a3vv78kixab6n5i7436py7xwzb4"))
+       (file-name (string-append name "-" version ".tar"))))
+    (build-system cmake-build-system)
+    (arguments
+     ;; Test is disabled because it requires downloading googletest from the
+     ;; Internet.
+     '(#:tests? #f))
+    (inputs
+     `(("alsa-lib" ,alsa-lib)
+       ("cairo" ,cairo)
+       ("i3-wm" ,i3-wm)
+       ("libmpdclient" ,libmpdclient)
+       ("libnl" ,libnl)
+       ("libxcb" ,libxcb)
+       ("pulseaudio" ,pulseaudio)
+       ("xcb-proto" ,xcb-proto)
+       ("xcb-util" ,xcb-util)
+       ("xcb-util-cursor" ,xcb-util-cursor)
+       ("xcb-util-image" ,xcb-util-image)
+       ("xcb-util-wm" ,xcb-util-wm)
+       ("xcb-util-xrm" ,xcb-util-xrm)))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)
+       ("python-2" ,python-2)           ; lib/xpp depends on python 2
+       ("python" ,python)))             ; xcb-proto depends on python 3
+    (home-page "https://polybar.github.io/")
+    (synopsis "Fast and easy-to-use status bar")
+    (description "Polybar aims to help users build beautiful and highly
+customizable status bars for their desktop environment.  It has built-in
+functionality to display information about the most commonly used services.")
+    (license license:expat)))

gnu/services/messaging.scm

@@ -22,6 +22,8 @@
 (define-module (gnu services messaging)
   #:use-module (gnu packages messaging)
   #:use-module (gnu packages admin)
+  #:use-module (gnu packages irc)
+  #:use-module (gnu packages tls)
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
   #:use-module (gnu services configuration)
@@ -50,7 +52,10 @@
             bitlbee-configuration
             bitlbee-configuration?
             bitlbee-service
-            bitlbee-service-type))
+            bitlbee-service-type
+
+            quassel-configuration
+            quassel-service-type))
 
 ;;; Commentary:
 ;;;
@@ -895,3 +900,86 @@ configuration file."
             (bitlbee bitlbee)
             (interface interface) (port port)
             (extra-settings extra-settings))))
+
+
+;;;
+;;; Quassel.
+;;;
+
+(define-record-type* <quassel-configuration>
+  quassel-configuration make-quassel-configuration
+  quassel-configuration?
+  (quassel quassel-configuration-quassel
+           (default quassel))
+  (interface quassel-configuration-interface
+             (default "::,0.0.0.0"))
+  (port quassel-configuration-port
+        (default 4242))
+  (loglevel quassel-configuration-loglevel
+            (default "Info")))
+
+(define quassel-shepherd-service
+  (match-lambda
+    (($ <quassel-configuration> quassel interface port loglevel)
+     (with-imported-modules (source-module-closure
+                              '((gnu build shepherd)
+                                (gnu system file-systems)))
+       (list (shepherd-service
+               (provision '(quassel))
+               (requirement '(user-processes networking))
+               (modules '((gnu build shepherd)
+                          (gnu system file-systems)))
+               (start #~(make-forkexec-constructor/container
+                          (list #$(file-append quassel "/bin/quasselcore")
+                                "--configdir=/var/lib/quassel"
+                                "--logfile=/var/log/quassel/core.log"
+                                (string-append "--loglevel=" #$loglevel)
+                                (string-append "--port=" (number->string #$port))
+                                (string-append "--listen=" #$interface))
+                          #:mappings (list (file-system-mapping
+                                             (source "/var/lib/quassel")
+                                             (target source)
+                                             (writable? #t))
+                                           (file-system-mapping
+                                             (source "/var/log/quassel")
+                                             (target source)
+                                             (writable? #t)))))
+               (stop  #~(make-kill-destructor))))))))
+
+(define %quassel-account
+  (list (user-group (name "quassel") (system? #t))
+        (user-account
+          (name "quasselcore")
+          (group "quassel")
+          (system? #t)
+          (comment "Quassel daemon user")
+          (home-directory "/var/lib/quassel")
+          (shell (file-append shadow "/sbin/nologin")))))
+
+(define %quassel-activation
+  #~(begin
+      (use-modules (guix build utils))
+      (mkdir-p "/var/lib/quassel")
+      (mkdir-p "/var/log/quassel")
+      (let ((cert "/var/lib/quassel/quasselCert.pem"))
+        (unless (file-exists? cert)
+          (invoke #$(file-append openssl "/bin/openssl")
+                  "req" "-x509" "-nodes" "-batch" "-days" "680" "-newkey"
+                  "rsa" "-keyout" cert "-out" cert)))))
+
+(define quassel-service-type
+  (service-type (name 'quassel)
+                (extensions
+                  (list (service-extension shepherd-root-service-type
+                                           quassel-shepherd-service)
+                        (service-extension profile-service-type
+                                           (compose list quassel-configuration-quassel))
+                        (service-extension account-service-type
+                                           (const %quassel-account))
+                        (service-extension activation-service-type
+                                           (const %quassel-activation))))
+                (default-value (quassel-configuration))
+                (description
+                 "Run @url{https://quassel-irc.org/,quasselcore}, the backend
+for the distributed IRC client quassel, which allows you to connect from
+multiple machines simultaneously.")))

gnu/system/examples/vm-image.tmpl

@@ -24,6 +24,8 @@ partprobe, and then 2) resizing the filesystem with resize2fs.\n"))
   (timezone "Etc/UTC")
   (locale "en_US.utf8")
 
+(firmware '())
+
   ;; Assuming /dev/sdX is the target hard disk, and "my-root" is
   ;; the label of the target root file system.
   (bootloader (bootloader-configuration

gnu/tests/messaging.scm

@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,7 +30,8 @@
   #:use-module (guix store)
   #:use-module (guix modules)
   #:export (%test-prosody
-            %test-bitlbee))
+            %test-bitlbee
+            %test-quassel))
 
 (define (run-xmpp-test name xmpp-service pid-file create-account)
   "Run a test of an OS running XMPP-SERVICE, which writes its PID to PID-FILE."
@@ -239,3 +241,53 @@
    (name "bitlbee")
    (description "Connect to a BitlBee IRC server.")
    (value (run-bitlbee-test))))
+
+(define (run-quassel-test)
+  (define os
+    (marionette-operating-system
+      (simple-operating-system (service dhcp-client-service-type)
+                               (service quassel-service-type))
+     #:imported-modules (source-module-closure
+                         '((gnu services herd)))))
+
+  (define vm
+    (virtual-machine
+      (operating-system os)
+      (port-forwardings `((4242 . 4242)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-64)
+                       (gnu build marionette))
+
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "quassel")
+
+          (test-assert "service started"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'quassel))
+             marionette))
+
+          (test-assert "certificate file"
+            (marionette-eval
+              '(file-exists? "/var/lib/quassel/quasselCert.pem")
+              marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "quassel-test" test))
+
+(define %test-quassel
+  (system-test
+   (name "quassel")
+   (description "Connect to a quassel IRC server.")
+   (value (run-quassel-test))))

guix/inferior.scm

@@ -54,6 +54,7 @@
   #:use-module ((rnrs bytevectors) #:select (string->utf8))
   #:export (inferior?
             open-inferior
+            port->inferior
             close-inferior
             inferior-eval
             inferior-eval-with-store
@@ -93,10 +94,11 @@
 
 ;; Inferior Guix process.
 (define-record-type <inferior>
-  (inferior pid socket version packages table)
+  (inferior pid socket close version packages table)
   inferior?
   (pid      inferior-pid)
   (socket   inferior-socket)
+  (close    inferior-close-socket)               ;procedure
   (version  inferior-version)                    ;REPL protocol version
   (packages inferior-package-promise)            ;promise of inferior packages
   (table    inferior-package-table))             ;promise of vhash
@@ -131,19 +133,17 @@ it's an old Guix."
                           ((@ (guix scripts repl) machine-repl))))))
         pipe)))
 
-(define* (open-inferior directory #:key (command "bin/guix"))
+(define* (port->inferior pipe #:optional (close close-port))
-  "Open the inferior Guix in DIRECTORY, running 'DIRECTORY/COMMAND repl' or
+  "Given PIPE, an input/output port, return an inferior that talks over PIPE.
-equivalent.  Return #f if the inferior could not be launched."
+PIPE is closed with CLOSE when 'close-inferior' is called on the returned
-  (define pipe
+inferior."
-    (inferior-pipe directory command))
-
   (cond-expand
     ((and guile-2 (not guile-2.2)) #t)
     (else (setvbuf pipe 'line)))
 
   (match (read pipe)
     (('repl-version 0 rest ...)
-     (letrec ((result (inferior 'pipe pipe (cons 0 rest)
+     (letrec ((result (inferior 'pipe pipe close (cons 0 rest)
                                 (delay (%inferior-packages result))
                                 (delay (%inferior-package-table result)))))
        (inferior-eval '(use-modules (guix)) result)
@@ -155,9 +155,18 @@ equivalent.  Return #f if the inferior could not be launched."
     (_
      #f)))
 
+(define* (open-inferior directory #:key (command "bin/guix"))
+  "Open the inferior Guix in DIRECTORY, running 'DIRECTORY/COMMAND repl' or
+equivalent.  Return #f if the inferior could not be launched."
+  (define pipe
+    (inferior-pipe directory command))
+
+  (port->inferior pipe close-pipe))
+
 (define (close-inferior inferior)
   "Close INFERIOR."
-  (close-pipe (inferior-socket inferior)))
+  (let ((close (inferior-close-socket inferior)))
+    (close (inferior-socket inferior))))
 
 ;; Non-self-quoting object of the inferior.
 (define-record-type <inferior-object>
@@ -409,6 +418,7 @@ thus be the code of a one-argument procedure that accepts a store."
   ;; Create a named socket in /tmp and let INFERIOR connect to it and use it
   ;; as its store.  This ensures the inferior uses the same store, with the
   ;; same options, the same per-session GC roots, etc.
+  ;; FIXME: This strategy doesn't work for remote inferiors (SSH).
   (call-with-temporary-directory
    (lambda (directory)
      (chmod directory #o700)

guix/scripts/lint.scm

@@ -8,6 +8,7 @@
 ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -44,8 +45,10 @@
   #:use-module (guix cve)
   #:use-module (gnu packages)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 format)
+  #:use-module (web client)
   #:use-module (web uri)
   #:use-module ((guix build download)
                 #:select (maybe-expand-mirrors
@@ -74,6 +77,7 @@
             check-source
             check-source-file-name
             check-mirror-url
+            check-github-url
             check-license
             check-vulnerabilities
             check-for-updates
@@ -773,6 +777,37 @@ descriptions maintained upstream."
       (let ((uris (origin-uris origin)))
         (for-each check-mirror-uri uris)))))
 
+(define (check-github-url package)
+  "Check whether PACKAGE uses source URLs that redirect to GitHub."
+  (define (follow-redirect uri)
+    (receive (response body) (http-head uri)
+      (case (response-code response)
+        ((301 302)
+         (uri->string (assoc-ref (response-headers response) 'location)))
+        (else #f))))
+
+  (define (follow-redirects-to-github uri)
+    (cond
+     ((string-prefix? "https://github.com/" uri) uri)
+     ((string-prefix? "http" uri)
+      (and=> (follow-redirect uri) follow-redirects-to-github))
+     ;; Do not attempt to follow redirects on URIs other than http and https
+     ;; (such as mirror, file)
+     (else #f)))
+
+  (let ((origin (package-source package)))
+    (when (and (origin? origin)
+               (eqv? (origin-method origin) url-fetch))
+      (for-each
+       (lambda (uri)
+         (and=> (follow-redirects-to-github uri)
+                (lambda (github-uri)
+                  (emit-warning
+                   package
+                   (format #f (G_ "URL should be '~a'") github-uri)
+                   'source))))
+       (origin-uris origin)))))
+
 (define (check-derivation package)
   "Emit a warning if we fail to compile PACKAGE to a derivation."
   (define (try system)
@@ -1055,6 +1090,10 @@ or a list thereof")
      (name        'mirror-url)
      (description "Suggest 'mirror://' URLs")
      (check       check-mirror-url))
+   (lint-checker
+     (name        'github-uri)
+     (description "Suggest GitHub URIs")
+     (check       check-github-url))
    (lint-checker
      (name        'source-file-name)
      (description "Validate file names of sources")

guix/scripts/offload.scm

@@ -23,13 +23,12 @@
   #:use-module (ssh session)
   #:use-module (ssh channel)
   #:use-module (ssh popen)
-  #:use-module (ssh dist)
-  #:use-module (ssh dist node)
   #:use-module (ssh version)
   #:use-module (guix config)
   #:use-module (guix records)
   #:use-module (guix ssh)
   #:use-module (guix store)
+  #:use-module (guix inferior)
   #:use-module (guix derivations)
   #:use-module ((guix serialization)
                 #:select (nar-error? nar-error-file))
@@ -321,12 +320,15 @@ hook."
     (set-port-revealed! port 1)
     port))
 
+(define (node-guile-version node)
+  (inferior-eval '(version) node))
+
 (define (node-free-disk-space node)
   "Return the free disk space, in bytes, in NODE's store."
-  (node-eval node
+  (inferior-eval `(begin
-             `(begin
+                    (use-modules (guix build syscalls))
-                (use-modules (guix build syscalls))
+                    (free-disk-space ,(%store-prefix)))
-                (free-disk-space ,(%store-prefix)))))
+                 node))
 
 (define* (transfer-and-offload drv machine
                                #:key
@@ -367,8 +369,12 @@ MACHINE."
                      (derivation-file-name drv)
                      (build-machine-name machine)
                      (nix-protocol-error-message c))
-             (let* ((space (false-if-exception
+             (let* ((inferior (false-if-exception (remote-inferior session)))
-                            (node-free-disk-space (make-node session)))))
+                    (space (false-if-exception
+                            (node-free-disk-space inferior))))
+
+               (when inferior
+                 (close-inferior inferior))
 
                ;; Use exit code 100 for a permanent build failure.  The daemon
                ;; interprets other non-zero codes as transient build failures.
@@ -417,11 +423,11 @@ of free disk space on '~a'~%")
 
 (define (node-load node)
   "Return the load on NODE.  Return +∞ if NODE is misbehaving."
-  (let ((line (node-eval node
+  (let ((line (inferior-eval '(begin
-                         '(begin
+                                (use-modules (ice-9 rdelim))
-                            (use-modules (ice-9 rdelim))
+                                (call-with-input-file "/proc/loadavg"
-                            (call-with-input-file "/proc/loadavg"
+                                  read-string))
-                              read-string)))))
+                             node)))
     (if (eof-object? line)
         +inf.0 ;MACHINE does not respond, so assume it is infinitely loaded
         (match (string-tokenize line)
@@ -508,9 +514,10 @@ slot (which must later be released with 'release-build-slot'), or #f and #f."
          ;; Note: We call 'node-load' only as a last resort because it is
          ;; too costly to call it once for every machine.
          (let* ((session (false-if-exception (open-ssh-session best)))
-                (node    (and session (make-node session)))
+                (node    (and session (remote-inferior session)))
                 (load    (and node (normalized-load best (node-load node))))
                 (space   (and node (node-free-disk-space node))))
+           (when node (close-inferior node))
            (when session (disconnect! session))
            (if (and node (< load 2.) (>= space %minimum-disk-space))
                (match others
@@ -613,40 +620,34 @@ If TIMEOUT is #f, simply evaluate EXP..."
     (#f
      (report-guile-error name))
     ((? string? version)
-     ;; Note: The version string already contains the word "Guile".
+     (info (G_ "'~a' is running GNU Guile ~a~%")
-     (info (G_ "'~a' is running ~a~%")
            name (node-guile-version node)))))
 
 (define (assert-node-has-guix node name)
-  "Bail out if NODE lacks the (guix) module, or if its daemon is not running."
+  "Bail out if NODE if #f or if we fail to use the (guix) module, or if its
-  (catch 'node-repl-error
+daemon is not running."
-    (lambda ()
+  (unless (inferior? node)
-      (match (node-eval node
+    (leave (G_ "failed to run 'guix repl' on '~a'~%") name))
-                        '(begin
-                           (use-modules (guix))
-                           (and add-text-to-store 'alright)))
-        ('alright #t)
-        (_ (report-module-error name))))
-    (lambda (key . args)
-      (report-module-error name)))
 
-  (catch 'node-repl-error
+  (match (inferior-eval '(begin
-    (lambda ()
+                           (use-modules (guix))
-      (match (node-eval node
+                           (and add-text-to-store 'alright))
-                        '(begin
+                        node)
+    ('alright #t)
+    (_ (report-module-error name)))
+
+  (match (inferior-eval '(begin
                            (use-modules (guix))
                            (with-store store
                              (add-text-to-store store "test"
-                                                "Hello, build machine!"))))
+                                                "Hello, build machine!")))
-        ((? string? str)
+                        node)
-         (info (G_ "Guix is usable on '~a' (test returned ~s)~%")
+    ((? string? str)
-               name str))
+     (info (G_ "Guix is usable on '~a' (test returned ~s)~%")
-        (x
+           name str))
-         (leave (G_ "failed to talk to guix-daemon on '~a' (test returned ~s)~%")
+    (x
-                name x))))
+     (leave (G_ "failed to talk to guix-daemon on '~a' (test returned ~s)~%")
-    (lambda (key . args)
+            name x))))
-      (leave (G_ "remote evaluation on '~a' failed:~{ ~s~}~%")
-             name args))))
 
 (define %random-state
   (delay
@@ -656,25 +657,23 @@ If TIMEOUT is #f, simply evaluate EXP..."
   (string-append name "-"
                  (number->string (random 1000000 (force %random-state)))))
 
-(define (assert-node-can-import node name daemon-socket)
+(define (assert-node-can-import session node name daemon-socket)
   "Bail out if NODE refuses to import our archives."
-  (let ((session (node-session node)))
+  (with-store store
-    (with-store store
+    (let* ((item   (add-text-to-store store "export-test" (nonce)))
-      (let* ((item   (add-text-to-store store "export-test" (nonce)))
+           (remote (connect-to-remote-daemon session daemon-socket)))
-             (remote (connect-to-remote-daemon session daemon-socket)))
+      (with-store local
-        (with-store local
+        (send-files local (list item) remote))
-          (send-files local (list item) remote))
 
-        (if (valid-path? remote item)
+      (if (valid-path? remote item)
-            (info (G_ "'~a' successfully imported '~a'~%")
+          (info (G_ "'~a' successfully imported '~a'~%")
-                  name item)
+                name item)
-            (leave (G_ "'~a' was not properly imported on '~a'~%")
+          (leave (G_ "'~a' was not properly imported on '~a'~%")
-                   item name))))))
+                 item name)))))
 
-(define (assert-node-can-export node name daemon-socket)
+(define (assert-node-can-export session node name daemon-socket)
   "Bail out if we cannot import signed archives from NODE."
-  (let* ((session (node-session node))
+  (let* ((remote  (connect-to-remote-daemon session daemon-socket))
-         (remote  (connect-to-remote-daemon session daemon-socket))
          (item    (add-text-to-store remote "import-test" (nonce name))))
     (with-store store
       (if (and (retrieve-files store (list item) remote)
@@ -701,11 +700,13 @@ machine."
     (let* ((names    (map build-machine-name machines))
            (sockets  (map build-machine-daemon-socket machines))
            (sessions (map open-ssh-session machines))
-           (nodes    (map make-node sessions)))
+           (nodes    (map remote-inferior sessions)))
-      (for-each assert-node-repl nodes names)
       (for-each assert-node-has-guix nodes names)
-      (for-each assert-node-can-import nodes names sockets)
+      (for-each assert-node-repl nodes names)
-      (for-each assert-node-can-export nodes names sockets))))
+      (for-each assert-node-can-import sessions nodes names sockets)
+      (for-each assert-node-can-export sessions nodes names sockets)
+      (for-each close-inferior nodes)
+      (for-each disconnect! sessions))))
 
 (define (check-machine-status machine-file pred)
   "Print the load of each machine matching PRED in MACHINE-FILE."
@@ -721,20 +722,28 @@ machine."
     (info (G_ "getting status of ~a build machines defined in '~a'...~%")
           (length machines) machine-file)
     (for-each (lambda (machine)
-                (let* ((session (open-ssh-session machine))
+                (define session
-                       (node    (make-node session))
+                  (open-ssh-session machine))
-                       (uts     (node-eval node '(uname)))
+
-                       (load    (node-load node))
+                (match (remote-inferior session)
-                       (free    (node-free-disk-space node)))
+                  (#f
-                  (disconnect! session)
+                   (warning (G_ "failed to run 'guix repl' on machine '~a'~%")
-                  (format #t "~a~%  kernel: ~a ~a~%  architecture: ~a~%\
+                            (build-machine-name machine)))
+                  ((? inferior? inferior)
+                   (let ((uts  (inferior-eval '(uname) inferior))
+                         (load (node-load inferior))
+                         (free (node-free-disk-space inferior)))
+                     (close-inferior inferior)
+                     (format #t "~a~%  kernel: ~a ~a~%  architecture: ~a~%\
   host name: ~a~%  normalized load: ~a~%  free disk space: ~,2f MiB~%"
-                          (build-machine-name machine)
+                             (build-machine-name machine)
-                          (utsname:sysname uts) (utsname:release uts)
+                             (utsname:sysname uts) (utsname:release uts)
-                          (utsname:machine uts)
+                             (utsname:machine uts)
-                          (utsname:nodename uts)
+                             (utsname:nodename uts)
-                          (normalized-load machine load)
+                             (normalized-load machine load)
-                          (/ free (expt 2 20) 1.))))
+                             (/ free (expt 2 20) 1.)))))
+
+                (disconnect! session))
               machines)))
 
 

guix/scripts/refresh.scm

@@ -5,6 +5,7 @@
 ;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -40,6 +41,7 @@
   #:use-module (ice-9 regex)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 format)
+  #:use-module (ice-9 threads) ; par-for-each
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
@@ -88,6 +90,12 @@
         (option '(#\l "list-dependent") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'list-dependent? #t result)))
+        (option '(#\r "recursive") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'recursive? #t result)))
+        (option '("list-transitive") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'list-transitive? #t result)))
 
         (option '("keyring") #t #f
                 (lambda (opt name arg result)
@@ -140,6 +148,10 @@ specified with `--select'.\n"))
   (display (G_ "
   -l, --list-dependent   list top-level dependent packages that would need to
                          be rebuilt as a result of upgrading PACKAGE..."))
+  (display (G_ "
+  -r, --recursive        check the PACKAGE and its inputs for upgrades"))
+  (display (G_ "
+      --list-transitive  list all the packages that PACKAGE depends on"))
   (newline)
   (display (G_ "
       --keyring=FILE     use FILE as the keyring of upstream OpenPGP keys"))
@@ -323,6 +335,43 @@ dependent packages are rebuilt: ~{~a~^ ~}~%"
                  (map full-name covering))))
       (return #t))))
 
+(define (refresh-recursive packages)
+  "Check all of the package inputs of PACKAGES for newer upstream versions."
+  (mlet %store-monad ((edges (node-edges %bag-node-type
+                                         ;; Here we don't want the -boot0 packages.
+                                         (fold-packages cons '()))))
+    (let ((dependent (node-transitive-edges packages edges)))
+      ;; par-for-each has an undefined return value, so packages which cause
+      ;; errors can be ignored.
+      (par-for-each (lambda (package)
+                      (guix-refresh package))
+                    (map package-name dependent)))
+    (return #t)))
+
+(define (list-transitive packages)
+  "List all the packages that would cause PACKAGES to be rebuilt if they are changed."
+  ;; Using %BAG-NODE-TYPE is more accurate than using %PACKAGE-NODE-TYPE
+  ;; because it includes implicit dependencies.
+  (define (full-name package)
+    (string-append (package-name package) "@"
+                   (package-version package)))
+
+  (mlet %store-monad ((edges (node-edges %bag-node-type
+                                         ;; Here we don't want the -boot0 packages.
+                                         (fold-packages cons '()))))
+    (let ((dependent (node-transitive-edges packages edges)))
+      (match packages
+        ((x)
+         (format (current-output-port)
+                 (G_ "~a depends on the following ~d packages: ~{~a~^ ~}~%.")
+                 (full-name x) (length dependent) (map full-name dependent)))
+        (lst
+         (format (current-output-port)
+                 (G_ "The following ~d packages \
+all are dependent packages: ~{~a~^ ~}~%")
+                 (length dependent) (map full-name dependent))))
+      (return #t))))
+
 
 ;;;
 ;;; Manifest.
@@ -402,7 +451,9 @@ update would trigger a complete rebuild."
   (let* ((opts            (parse-options))
          (update?         (assoc-ref opts 'update?))
          (updaters        (options->updaters opts))
+         (recursive?      (assoc-ref opts 'recursive?))
          (list-dependent? (assoc-ref opts 'list-dependent?))
+         (list-transitive? (assoc-ref opts 'list-transitive?))
          (key-download    (assoc-ref opts 'key-download))
 
          ;; Warn about missing updaters when a package is explicitly given on
@@ -441,6 +492,10 @@ update would trigger a complete rebuild."
           (cond
            (list-dependent?
             (list-dependents packages))
+           (list-transitive?
+            (list-transitive packages))
+           (recursive?
+            (refresh-recursive packages))
            (update?
             (parameterize ((%openpgp-key-server
                             (or (assoc-ref opts 'key-server)

guix/ssh.scm

@@ -18,6 +18,7 @@
 
 (define-module (guix ssh)
   #:use-module (guix store)
+  #:use-module (guix inferior)
   #:use-module (guix i18n)
   #:use-module ((guix utils) #:select (&fix-hint))
   #:use-module (ssh session)
@@ -26,8 +27,6 @@
   #:use-module (ssh channel)
   #:use-module (ssh popen)
   #:use-module (ssh session)
-  #:use-module (ssh dist)
-  #:use-module (ssh dist node)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
@@ -36,6 +35,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 binary-ports)
   #:export (open-ssh-session
+            remote-inferior
             remote-daemon-channel
             connect-to-remote-daemon
             send-files
@@ -94,6 +94,26 @@ Throw an error on failure."
                 (message (format #f (G_ "SSH connection to '~a' failed: ~a~%")
                                  host (get-error session))))))))))
 
+(define (remote-inferior session)
+  "Return a remote inferior for the given SESSION."
+  (let ((pipe (open-remote-pipe* session OPEN_BOTH
+                                 "guix" "repl" "-t" "machine")))
+    (port->inferior pipe)))
+
+(define (inferior-remote-eval exp session)
+  "Evaluate EXP in a new inferior running in SESSION, and close the inferior
+right away."
+  (let ((inferior (remote-inferior session)))
+    (dynamic-wind
+      (const #t)
+      (lambda ()
+        (inferior-eval exp inferior))
+      (lambda ()
+        ;; Close INFERIOR right away to prevent finalization from happening in
+        ;; another thread at the wrong time (see
+        ;; <https://bugs.gnu.org/26976>.)
+        (close-inferior inferior)))))
+
 (define* (remote-daemon-channel session
                                 #:optional
                                 (socket-name
@@ -269,15 +289,15 @@ Return the list of store items actually sent."
   ;; Compute the subset of FILES missing on SESSION and send them.
   (let* ((files   (if recursive? (requisites local files) files))
          (session (channel-get-session (nix-server-socket remote)))
-         (node    (make-node session))
+         (missing (inferior-remote-eval
-         (missing (node-eval node
+                   `(begin
-                             `(begin
+                      (use-modules (guix)
-                                (use-modules (guix)
+                                   (srfi srfi-1) (srfi srfi-26))
-                                             (srfi srfi-1) (srfi srfi-26))
 
-                                (with-store store
+                      (with-store store
-                                  (remove (cut valid-path? store <>)
+                        (remove (cut valid-path? store <>)
-                                          ',files)))))
+                                ',files)))
+                   session))
          (count   (length missing))
          (sizes   (map (lambda (item)
                          (path-info-nar-size (query-path-info local item)))

tests/lint.scm

@@ -6,6 +6,7 @@
 ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -669,6 +670,33 @@
        (check-mirror-url (dummy-package "x" (source source)))))
    "mirror://gnu/foo/foo.tar.gz"))
 
+(test-assert "github-url"
+  (string-null?
+   (with-warnings
+     (with-http-server 200 %long-string
+       (check-github-url
+        (dummy-package "x" (source
+                            (origin
+                              (method url-fetch)
+                              (uri (%local-url))
+                              (sha256 %null-sha256)))))))))
+
+(let ((github-url "https://github.com/foo/bar/bar-1.0.tar.gz"))
+  (test-assert "github-url: one suggestion"
+    (string-contains
+     (with-warnings
+       (with-http-server (301 `((location . ,(string->uri github-url)))) ""
+         (let ((initial-uri (%local-url)))
+           (parameterize ((%http-server-port (+ 1 (%http-server-port))))
+             (with-http-server (302 `((location . ,(string->uri initial-uri)))) ""
+               (check-github-url
+                (dummy-package "x" (source
+                                    (origin
+                                      (method url-fetch)
+                                      (uri (%local-url))
+                                      (sha256 %null-sha256))))))))))
+     github-url)))
+
 (test-assert "cve"
   (mock ((guix scripts lint) package-vulnerabilities (const '()))
         (string-null?