Merge branch 'master' into staging

9 files changed, 701 insertions, 522 deletions

diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm
index adeceb4a89..d4d3d28f2a 100644
--- a/guix/build-system/python.scm
+++ b/guix/build-system/python.scm
@@ -177,6 +177,7 @@ pre-defined variants."
                        #:key
                        (tests? #t)
                        (test-target "test")
+                       (use-setuptools? #t)
                        (configure-flags ''())
                        (phases '(@ (guix build python-build-system)
                                    %standard-phases))
@@ -204,6 +205,7 @@ provides a 'setup.py' file as its build system."
                      #:system ,system
                      #:test-target ,test-target
                      #:tests? ,tests?
+                     #:use-setuptools? ,use-setuptools?
                      #:phases ,phases
                      #:outputs %outputs
                      #:search-paths ',(map search-path-specification->sexp
diff --git a/guix/build/pull.scm b/guix/build/pull.scm
index 871bf6f535..6034e93cbf 100644
--- a/guix/build/pull.scm
+++ b/guix/build/pull.scm
@@ -84,7 +84,7 @@ containing the source code.  Write any debugging output to DEBUG-PORT."
       (("@GZIP@") (string-append gzip "/bin/gzip"))
       (("@BZIP2@") (string-append bzip2 "/bin/bzip2"))
       (("@XZ@") (string-append xz "/bin/xz"))
-      (("@NIX_INSTANTIATE@") ""))                 ;remnants from the past
+      (("@NIX_INSTANTIATE@") "nix-instantiate"))  ;for (guix import nix)
 
     ;; Augment the search path so Scheme code can be compiled.
     (set! %load-path (cons out %load-path))
diff --git a/guix/build/python-build-system.scm b/guix/build/python-build-system.scm
index 9109fb4ac7..3f280b0ac0 100644
--- a/guix/build/python-build-system.scm
+++ b/guix/build/python-build-system.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -27,31 +28,119 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:export (%standard-phases
+            add-installed-pythonpath
+            site-packages
             python-build))
 
 ;; Commentary:
 ;;
 ;; Builder-side code of the standard Python package build procedure.
 ;;
-;; Code:
+;;
+;; Backgound about the Python installation methods
+;;
+;; In Python there are different ways to install packages: distutils,
+;; setuptools, easy_install and pip.  All of these are sharing the file
+;; setup.py, introduced with distutils in Python 2.0. The setup.py file can be
+;; considered as a kind of Makefile accepting targets (or commands) like
+;; "build" and "install".  As of autumn 2016 the recommended way to install
+;; Python packages is using pip.
+;;
+;; For both distutils and setuptools, running "python setup.py install" is the
+;; way to install Python packages.  With distutils the "install" command
+;; basically copies all packages into <prefix>/lib/pythonX.Y/site-packages.
+;;
+;; Some time later "setuptools" was established to enhance distutils.  To use
+;; setuptools, the developer imports setuptools in setup.py.  When importing
+;; setuptools, the original "install" command gets overwritten by setuptools'
+;; "install" command.
+;;
+;; The command-line tools easy_install and pip are both capable of finding and
+;; downloading the package source from PyPI (the Python Package Index).  Both
+;; of them import setuptools and execute the "setup.py" file under their
+;; control.  Thus the "setup.py" behaves as if the developer had imported
+;; setuptools within setup.py - even is still using only distutils.
+;;
+;; Setuptools' "install" command (to be more precise: the "easy_install"
+;; command which is called by "install") will put the path of the currently
+;; installed version of each package and it's dependencies (as declared in
+;; setup.py) into an "easy-install.pth" file.  In Guix each packages gets its
+;; own "site-packages" directory and thus an "easy-install.pth" of its own.
+;; To avoid conflicts, the python build system renames the file to
+;; <packagename>.pth in the phase rename-pth-file.  To ensure that Python will
+;; process the .pth file, easy_install also creates a basic "site.py" in each
+;; "site-packages" directory.  The file is the same for all packages, thus
+;; there is no need to rename it.  For more information about .pth files and
+;; the site module, please refere to
+;; https://docs.python.org/3/library/site.html.
+;;
+;; The .pth files contain the file-system paths (pointing to the store) of all
+;; dependencies.  So the dependency is hidden in the .pth file but is not
+;; visible in the file-system.  Now if packages A and B both required packages
+;; P, but in different versions, Guix will not detect this when installing
+;; both A and B to a profile. (For details and example see
+;; https://lists.gnu.org/archive/html/guix-devel/2016-10/msg01233.html.)
+;;
+;; Pip behaves a bit different then easy_install: it always executes
+;; "setup.py" with the option "--single-version-externally-managed" set.  This
+;; makes setuptools' "install" command run the original "install" command
+;; instead of the "easy_install" command, so no .pth file (and no site.py)
+;; will be created.  The "site-packages" directory only contains the package
+;; and the related .egg-info directory.
+;;
+;; This is exactly what we need for Guix and this is what we mimic in the
+;; install phase below.
+;;
+;; As a draw back, the magic of the .pth file of linking to the other required
+;; packages is gone and these packages have now to be declared as
+;; "propagated-inputs".
+;;
+;; Note: Importing setuptools also adds two sub-commands: "install_egg_info"
+;; and "install_scripts".  These sub-commands are executed even if
+;; "--single-version-externally-managed" is set, thus the .egg-info directory
+;; and the scripts defined in entry-points will always be created.
+
 
+(define setuptools-shim
+  ;; Run setup.py with "setuptools" being imported, which will patch
+  ;; "distutils". This is needed for packages using "distutils" instead of
+  ;; "setuptools" since the former does not understand the
+  ;; "--single-version-externally-managed" flag.
+  ;; Python code taken from pip 9.0.1 pip/utils/setuptools_build.py
+  (string-append
+   "import setuptools, tokenize;__file__='setup.py';"
+   "f=getattr(tokenize, 'open', open)(__file__);"
+   "code=f.read().replace('\\r\\n', '\\n');"
+   "f.close();"
+   "exec(compile(code, __file__, 'exec'))"))
 
-(define (call-setuppy command params)
+(define (call-setuppy command params use-setuptools?)
   (if (file-exists? "setup.py")
       (begin
          (format #t "running \"python setup.py\" with command ~s and parameters ~s~%"
                 command params)
-         (zero? (apply system* "python" "setup.py" command params)))
+         (if use-setuptools?
+             (zero? (apply system* "python" "-c" setuptools-shim
+                           command params))
+             (zero? (apply system* "python" "./setup.py" command params))))
       (error "no setup.py found")))
 
-(define* (build #:rest empty)
+(define* (build #:key use-setuptools? #:allow-other-keys)
   "Build a given Python package."
-  (call-setuppy "build" '()))
+  (call-setuppy "build" '() use-setuptools?))
 
-(define* (check #:key tests? test-target #:allow-other-keys)
+(define* (check #:key tests? test-target use-setuptools? #:allow-other-keys)
   "Run the test suite of a given Python package."
   (if tests?
-    (call-setuppy test-target '())
+      ;; Running `setup.py test` creates an additional .egg-info directory in
+      ;; build/lib in some cases, e.g. if the source is in a sub-directory
+      ;; (given with `package_dir`). This will by copied to the output, too,
+      ;; so we need to remove.
+      (let ((before (find-files "build" "\\.egg-info$" #:directories? #t)))
+        (call-setuppy test-target '() use-setuptools?)
+        (let* ((after (find-files "build" "\\.egg-info$" #:directories? #t))
+               (inter (lset-difference eqv? after before)))
+          (for-each delete-file-recursively inter)))
     #t))
 
 (define (get-python-version python)
@@ -60,25 +149,36 @@
          (major+minor (take components 2)))
     (string-join major+minor ".")))
 
-(define* (install #:key outputs inputs (configure-flags '())
+(define (site-packages inputs outputs)
+  "Return the path of the current output's Python site-package."
+  (let* ((out (assoc-ref outputs "out"))
+         (python (assoc-ref inputs "python")))
+    (string-append out "/lib/python"
+                   (get-python-version python)
+                   "/site-packages/")))
+
+(define (add-installed-pythonpath inputs outputs)
+  "Prepend the Python site-package of OUTPUT to PYTHONPATH.  This is useful
+when running checks after installing the package."
+  (let ((old-path (getenv "PYTHONPATH"))
+        (add-path (site-packages inputs outputs)))
+    (setenv "PYTHONPATH"
+            (string-append add-path
+                           (if old-path (string-append ":" old-path) "")))
+    #t))
+
+(define* (install #:key outputs (configure-flags '()) use-setuptools?
                   #:allow-other-keys)
   "Install a given Python package."
   (let* ((out (assoc-ref outputs "out"))
          (params (append (list (string-append "--prefix=" out))
-                         configure-flags))
-         (python-version (get-python-version (assoc-ref inputs "python")))
-         (old-path (getenv "PYTHONPATH"))
-         (add-path (string-append out "/lib/python" python-version
-                                  "/site-packages/")))
-        ;; create the module installation directory and add it to PYTHONPATH
-        ;; to make setuptools happy
-        (mkdir-p add-path)
-        (setenv "PYTHONPATH"
-                (string-append (if old-path
-                                   (string-append old-path ":")
-                                   "")
-                               add-path))
-        (call-setuppy "install" params)))
+                         (if use-setuptools?
+                             ;; distutils does not accept these flags
+                             (list "--single-version-externally-managed"
+                                    "--root=/")
+                             '())
+                         configure-flags)))
+    (call-setuppy "install" params use-setuptools?)))
 
 (define* (wrap #:key inputs outputs #:allow-other-keys)
   (define (list-of-files dir)
@@ -112,6 +212,9 @@
 (define* (rename-pth-file #:key name inputs outputs #:allow-other-keys)
   "Rename easy-install.pth to NAME.pth to avoid conflicts between packages
 installed with setuptools."
+  ;; Even if the "easy-install.pth" is not longer created, we kept this phase.
+  ;; There still may be packages creating an "easy-install.pth" manually for
+  ;; some good reason.
   (let* ((out (assoc-ref outputs "out"))
          (python (assoc-ref inputs "python"))
          (site-packages (string-append out "/lib/python"
@@ -137,8 +240,7 @@ installed with setuptools."
     #t))
 
 (define %standard-phases
-  ;; 'configure' and 'build' phases are not needed.  Everything is done during
-  ;; 'install'.
+  ;; 'configure' phase is not needed.
   (modify-phases gnu:%standard-phases
     (add-after 'unpack 'ensure-no-mtimes-pre-1980 ensure-no-mtimes-pre-1980)
     (delete 'configure)
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 78392c9a11..4d4bb452be 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -60,7 +60,8 @@
             %gnu-updater
             %gnome-updater
             %kde-updater
-            %xorg-updater))
+            %xorg-updater
+            %kernel.org-updater))
 
 ;;; Commentary:
 ;;;
@@ -448,21 +449,26 @@ elpa.gnu.org, and all the GNOME packages."
        (not (gnome-package? package))
        (gnu-package? package)))
 
-(define (gnome-package? package)
-  "Return true if PACKAGE is a GNOME package, hosted on gnome.org."
-  (define gnome-uri?
-    (match-lambda
-      ((? string? uri)
-       (string-prefix? "mirror://gnome/" uri))
-      (_
-       #f)))
-
-  (match (package-source package)
-    ((? origin? origin)
-     (match (origin-uri origin)
-       ((? gnome-uri?) #t)
-       (_              #f)))
-    (_ #f)))
+(define (url-prefix-predicate prefix)
+  "Return a predicate that returns true when passed a package where one of its
+source URLs starts with PREFIX."
+  (lambda (package)
+    (define matching-uri?
+      (match-lambda
+        ((? string? uri)
+         (string-prefix? prefix uri))
+        (_
+         #f)))
+
+    (match (package-source package)
+      ((? origin? origin)
+       (match (origin-uri origin)
+         ((? matching-uri?) #t)
+         (_                 #f)))
+      (_ #f))))
+
+(define gnome-package?
+  (url-prefix-predicate "mirror://gnome/"))
 
 (define (latest-gnome-release package)
   "Return the latest release of PACKAGE, the name of a GNOME package."
@@ -504,49 +510,19 @@ elpa.gnu.org, and all the GNOME packages."
                        ;; checksums.
                        #:file->signature (const #f))))
 
-(define (kde-package? package)
-  "Return true if PACKAGE is a KDE package, developed by KDE.org."
-  (define kde-uri?
-    (match-lambda
-      ((? string? uri)
-       (string-prefix? "mirror://kde/" uri))
-      (_
-       #f)))
-
-  (match (package-source package)
-    ((? origin? origin)
-     (match (origin-uri origin)
-      ((? kde-uri?) #t)
-      (_             #f)))
-    (_ #f)))
 
 (define (latest-kde-release package)
   "Return the latest release of PACKAGE, the name of an KDE.org package."
   (let ((uri (string->uri (origin-uri (package-source package)))))
     (false-if-ftp-error
      (latest-ftp-release
-      (package-name package)
+      (or (assoc-ref (package-properties package) 'upstream-name)
+          (package-name package))
       #:server "mirrors.mit.edu"
       #:directory
       (string-append "/kde" (dirname (dirname (uri-path uri))))
       #:file->signature (const #f)))))
 
-(define (xorg-package? package)
-  "Return true if PACKAGE is an X.org package, developed by X.org."
-  (define xorg-uri?
-    (match-lambda
-      ((? string? uri)
-       (string-prefix? "mirror://xorg/" uri))
-      (_
-       #f)))
-
-  (match (package-source package)
-    ((? origin? origin)
-     (match (origin-uri origin)
-       ((? xorg-uri?) #t)
-       (_              #f)))
-    (_ #f)))
-
 (define (latest-xorg-release package)
   "Return the latest release of PACKAGE, the name of an X.org package."
   (let ((uri (string->uri (origin-uri (package-source package)))))
@@ -557,6 +533,22 @@ elpa.gnu.org, and all the GNOME packages."
       #:directory
       (string-append "/pub/xorg/" (dirname (uri-path uri)))))))
 
+(define (latest-kernel.org-release package)
+  "Return the latest release of PACKAGE, the name of a kernel.org package."
+  (let ((uri (string->uri (origin-uri (package-source package)))))
+    (false-if-ftp-error
+     (latest-ftp-release
+      (package-name package)
+      #:server "ftp.free.fr"                      ;a mirror reachable over FTP
+      #:directory (string-append "/mirrors/ftp.kernel.org"
+                                 (dirname (uri-path uri)))
+
+      ;; kernel.org provides "foo-x.y.tar.sign" files, which are signatures of
+      ;; the uncompressed tarball.
+      #:file->signature (lambda (tarball)
+                          (string-append (file-sans-extension tarball)
+                                         ".sign"))))))
+
 (define %gnu-updater
   (upstream-updater
    (name 'gnu)
@@ -575,14 +567,21 @@ elpa.gnu.org, and all the GNOME packages."
   (upstream-updater
     (name 'kde)
     (description "Updater for KDE packages")
-    (pred kde-package?)
+    (pred (url-prefix-predicate "mirror://kde/"))
     (latest latest-kde-release)))
 
 (define %xorg-updater
   (upstream-updater
    (name 'xorg)
    (description "Updater for X.org packages")
-   (pred xorg-package?)
+   (pred (url-prefix-predicate "mirror://xorg/"))
    (latest latest-xorg-release)))
 
+(define %kernel.org-updater
+  (upstream-updater
+   (name 'kernel.org)
+   (description "Updater for packages hosted on kernel.org")
+   (pred (url-prefix-predicate "mirror://kernel.org/"))
+   (latest latest-kernel.org-release)))
+
 ;;; gnu-maintenance.scm ends here
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 9641d3926a..9b991786c3 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
 ;;; Copyright © 2016 Danny Milosavljevic <dannym+a@scratchpost.org>
+;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -59,6 +60,7 @@
   #:export (guix-lint
             check-description-style
             check-inputs-should-be-native
+            check-inputs-should-not-be-an-input-at-all
             check-patch-file-names
             check-synopsis-style
             check-derivation
@@ -229,34 +231,65 @@ by two spaces; possible infraction~p at ~{~a~^, ~}")
                       (format #f (_ "invalid description: ~s") description)
                       'description))))
 
+(define (warn-if-package-has-input linted inputs-to-check input-names message)
+  ;; Emit a warning MESSAGE if some of the inputs named in INPUT-NAMES are
+  ;; contained in INPUTS-TO-CHECK, which are assumed to be inputs of package
+  ;; LINTED.
+  (match inputs-to-check
+    (((labels packages . outputs) ...)
+     (for-each (lambda (package output)
+                 (when (package? package)
+                   (let ((input (string-append
+                                 (package-name package)
+                                 (if (> (length output) 0)
+                                     (string-append ":" (car output))
+                                     ""))))
+                     (when (member input input-names)
+                       (emit-warning linted
+                                     (format #f (_ message) input)
+                                     'inputs-to-check)))))
+               packages outputs))))
+
 (define (check-inputs-should-be-native package)
   ;; Emit a warning if some inputs of PACKAGE are likely to belong to its
   ;; native inputs.
-  (let ((linted package)
+  (let ((message "'~a' should probably be a native input")
         (inputs (package-inputs package))
-        (native-inputs
+        (input-names
           '("pkg-config"
             "extra-cmake-modules"
             "glib:bin"
             "intltool"
             "itstool"
-            "qttools")))
-    (match inputs
-      (((labels packages . outputs) ...)
-       (for-each (lambda (package output)
-                   (when (package? package)
-                     (let ((input (string-append
-                                   (package-name package)
-                                   (if (> (length output) 0)
-                                       (string-append ":" (car output))
-                                       ""))))
-                       (when (member input native-inputs)
-                         (emit-warning linted
-                                       (format #f (_ "'~a' should probably \
-be a native input")
-                                               input)
-                                       'inputs)))))
-                 packages outputs)))))
+            "qttools"
+            "python-coverage" "python2-coverage"
+            "python-cython" "python2-cython"
+            "python-docutils" "python2-docutils"
+            "python-mock" "python2-mock"
+            "python-nose" "python2-nose"
+            "python-pbr" "python2-pbr"
+            "python-pytest" "python2-pytest"
+            "python-pytest-cov" "python2-pytest-cov"
+            "python-setuptools-scm" "python2-setuptools-scm"
+            "python-sphinx" "python2-sphinx")))
+    (warn-if-package-has-input package inputs input-names message)))
+
+(define (check-inputs-should-not-be-an-input-at-all package)
+  ;; Emit a warning if some inputs of PACKAGE are likely to should not be
+  ;; an input at all.
+  (let ((message "'~a' should probably not be an input at all")
+        (inputs (package-inputs package))
+        (input-names
+          '("python-setuptools"
+            "python2-setuptools"
+            "python-pip"
+            "python2-pip")))
+    (warn-if-package-has-input package (package-inputs package)
+                               input-names message)
+    (warn-if-package-has-input package (package-native-inputs package)
+                               input-names message)
+    (warn-if-package-has-input package (package-propagated-inputs package)
+                               input-names message)))
 
 (define (package-name-regexp package)
   "Return a regexp that matches PACKAGE's name as a word at the beginning of a
@@ -876,6 +909,10 @@ them for PACKAGE."
      (description "Identify inputs that should be native inputs")
      (check       check-inputs-should-be-native))
    (lint-checker
+     (name        'inputs-should-not-be-input)
+     (description "Identify inputs that should be inputs at all")
+     (check       check-inputs-should-not-be-an-input-at-all))
+   (lint-checker
      (name        'patch-file-names)
      (description "Validate file names and availability of patches")
      (check       check-patch-file-names))
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index 33d141e7ef..bc024a8701 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -17,6 +17,13 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix scripts offload)
+  #:use-module (ssh key)
+  #:use-module (ssh auth)
+  #:use-module (ssh session)
+  #:use-module (ssh channel)
+  #:use-module (ssh popen)
+  #:use-module (ssh dist)
+  #:use-module (ssh dist node)
   #:use-module (guix config)
   #:use-module (guix records)
   #:use-module (guix store)
@@ -65,14 +72,15 @@
   (system          build-machine-system)          ; string
   (user            build-machine-user)            ; string
   (private-key     build-machine-private-key      ; file name
-                   (default (user-lsh-private-key)))
+                   (default (user-openssh-private-key)))
+  (host-key        build-machine-host-key)        ; string
+  (daemon-socket   build-machine-daemon-socket    ; string
+                   (default "/var/guix/daemon-socket/socket"))
   (parallel-builds build-machine-parallel-builds  ; number
                    (default 1))
   (speed           build-machine-speed            ; inexact real
                    (default 1.0))
   (features        build-machine-features         ; list of strings
-                   (default '()))
-  (ssh-options     build-machine-ssh-options      ; list of strings
                    (default '())))
 
 (define-record-type* <build-requirements>
@@ -86,19 +94,11 @@
   ;; File that lists machines available as build slaves.
   (string-append %config-directory "/machines.scm"))
 
-(define %lsh-command
-  "lsh")
-
-(define %lshg-command
-  ;; FIXME: 'lshg' fails to pass large amounts of data, see
-  ;; <http://lists.lysator.liu.se/pipermail/lsh-bugs/2014q1/000639.html>.
-  "lsh")
-
-(define (user-lsh-private-key)
-  "Return the user's default lsh private key, or #f if it could not be
+(define (user-openssh-private-key)
+  "Return the user's default SSH private key, or #f if it could not be
 determined."
   (and=> (getenv "HOME")
-         (cut string-append <> "/.lsh/identity")))
+         (cut string-append <> "/.ssh/id_rsa")))
 
 (define %user-module
   ;; Module in which the machine description file is loaded.
@@ -134,81 +134,120 @@ determined."
          (leave (_ "failed to load machine file '~a': ~s~%")
                 file args))))))
 
-;;; FIXME: The idea was to open the connection to MACHINE once for all, but
-;;; lshg is currently non-functional.
-;; (define (open-ssh-gateway machine)
-;;   "Initiate an SSH connection gateway to MACHINE, and return the PID of the
-;; running lsh gateway upon success, or #f on failure."
-;;   (catch 'system-error
-;;     (lambda ()
-;;       (let* ((port   (open-pipe* OPEN_READ %lsh-command
-;;                                  "-l" (build-machine-user machine)
-;;                                  "-i" (build-machine-private-key machine)
-;;                                  ;; XXX: With lsh 2.1, passing '--write-pid'
-;;                                  ;; last causes the PID not to be printed.
-;;                                  "--write-pid" "--gateway" "--background"
-;;                                  (build-machine-name machine)))
-;;              (line   (read-line port))
-;;              (status (close-pipe port)))
-;;        (if (zero? status)
-;;            (let ((pid (string->number line)))
-;;              (if (integer? pid)
-;;                  pid
-;;                  (begin
-;;                    (warning (_ "'~a' did not write its PID on stdout: ~s~%")
-;;                             %lsh-command line)
-;;                    #f)))
-;;            (begin
-;;              (warning (_ "failed to initiate SSH connection to '~a':\
-;;  '~a' exited with ~a~%")
-;;                       (build-machine-name machine)
-;;                       %lsh-command
-;;                       (status:exit-val status))
-;;              #f))))
-;;     (lambda args
-;;       (leave (_ "failed to execute '~a': ~a~%")
-;;              %lsh-command (strerror (system-error-errno args))))))
-
-(define-syntax with-error-to-port
-  (syntax-rules ()
-    ((_ port exp0 exp ...)
-     (let ((new port)
-           (old (current-error-port)))
-       (dynamic-wind
-         (lambda ()
-           (set-current-error-port new))
-         (lambda ()
-           exp0 exp ...)
-         (lambda ()
-           (set-current-error-port old)))))))
-
-(define* (remote-pipe machine mode command
-                      #:key (error-port (current-error-port)) (quote? #t))
-  "Run COMMAND (a string list) on MACHINE, assuming an lsh gateway has been
-set up.  When QUOTE? is true, perform shell-quotation of all the elements of
-COMMAND.  Return either a pipe opened with MODE, or #f if the lsh client could
-not be started."
-  (define (shell-quote str)
-    ;; Sort-of shell-quote STR so it can be passed as an argument to the
-    ;; shell.
-    (with-output-to-string
-      (lambda ()
-        (write str))))
-
-  ;; Let the child inherit ERROR-PORT.
-  (with-error-to-port error-port
-    (apply open-pipe* mode %lshg-command
-           "-l" (build-machine-user machine)
-           "-p" (number->string (build-machine-port machine))
-
-           ;; XXX: Remove '-i' when %LSHG-COMMAND really is lshg.
-           "-i" (build-machine-private-key machine)
-
-           (append (build-machine-ssh-options machine)
-                   (list (build-machine-name machine))
-                   (if quote?
-                       (map shell-quote command)
-                       command)))))
+(define (host-key->type+key host-key)
+  "Destructure HOST-KEY, an OpenSSH host key string, and return two values:
+its key type as a symbol, and the actual base64-encoded string."
+  (define (type->symbol type)
+    (and (string-prefix? "ssh-" type)
+         (string->symbol (string-drop type 4))))
+
+  (match (string-tokenize host-key)
+    ((type key _)
+     (values (type->symbol type) key))
+    ((type key)
+     (values (type->symbol type) key))))
+
+(define (private-key-from-file* file)
+  "Like 'private-key-from-file', but raise an error that 'with-error-handling'
+can interpret meaningfully."
+  (catch 'guile-ssh-error
+    (lambda ()
+      (private-key-from-file file))
+    (lambda (key proc str . rest)
+      (raise (condition
+              (&message (message (format #f (_ "failed to load SSH \
+private key from '~a': ~a")
+                                         file str))))))))
+
+(define (open-ssh-session machine)
+  "Open an SSH session for MACHINE and return it.  Throw an error on failure."
+  (let ((private (private-key-from-file* (build-machine-private-key machine)))
+        (public  (public-key-from-file
+                  (string-append (build-machine-private-key machine)
+                                 ".pub")))
+        (session (make-session #:user (build-machine-user machine)
+                               #:host (build-machine-name machine)
+                               #:port (build-machine-port machine)
+                               #:timeout 5        ;seconds
+                               ;; #:log-verbosity 'protocol
+                               #:identity (build-machine-private-key machine)
+
+                               ;; We need lightweight compression when
+                               ;; exchanging full archives.
+                               #:compression "zlib"
+                               #:compression-level 3)))
+    (connect! session)
+
+    ;; Authenticate the server.  XXX: Guile-SSH 0.10.1 doesn't know about
+    ;; ed25519 keys and 'get-key-type' returns #f in that case.
+    (let-values (((server)   (get-server-public-key session))
+                 ((type key) (host-key->type+key
+                              (build-machine-host-key machine))))
+      (unless (and (or (not (get-key-type server))
+                       (eq? (get-key-type server) type))
+                   (string=? (public-key->string server) key))
+        ;; Key mismatch: something's wrong.  XXX: It could be that the server
+        ;; provided its Ed25519 key when we where expecting its RSA key.
+        (leave (_ "server at '~a' returned host key '~a' of type '~a' \
+instead of '~a' of type '~a'~%")
+               (build-machine-name machine)
+               (public-key->string server) (get-key-type server)
+               key type)))
+
+    (let ((auth (userauth-public-key! session private)))
+      (unless (eq? 'success auth)
+        (disconnect! session)
+        (leave (_ "SSH public key authentication failed for '~a': ~a~%")
+               (build-machine-name machine) (get-error session))))
+
+    session))
+
+(define* (connect-to-remote-daemon session
+                                   #:optional
+                                   (socket-name "/var/guix/daemon-socket/socket"))
+  "Connect to the remote build daemon listening on SOCKET-NAME over SESSION,
+an SSH session.  Return a <nix-server> object."
+  (define redirect
+    ;; Code run in SESSION to redirect the remote process' stdin/stdout to the
+    ;; daemon's socket, à la socat.  The SSH protocol supports forwarding to
+    ;; Unix-domain sockets but libssh doesn't have an API for that, hence this
+    ;; hack.
+    `(begin
+       (use-modules (ice-9 match) (rnrs io ports))
+
+       (let ((sock   (socket AF_UNIX SOCK_STREAM 0))
+             (stdin  (current-input-port))
+             (stdout (current-output-port)))
+         (setvbuf stdin _IONBF)
+         (setvbuf stdout _IONBF)
+         (connect sock AF_UNIX ,socket-name)
+
+         (let loop ()
+           (match (select (list stdin sock) '() (list stdin stdout sock))
+             ((reads writes ())
+              (when (memq stdin reads)
+                (match (get-bytevector-some stdin)
+                  ((? eof-object?)
+                   (primitive-exit 0))
+                  (bv
+                   (put-bytevector sock bv))))
+              (when (memq sock reads)
+                (match (get-bytevector-some sock)
+                  ((? eof-object?)
+                   (primitive-exit 0))
+                  (bv
+                   (put-bytevector stdout bv))))
+              (loop))
+             (_
+              (primitive-exit 1)))))))
+
+  (let ((channel
+         (open-remote-pipe* session OPEN_BOTH
+                            ;; Sort-of shell-quote REDIRECT.
+                            "guile" "-c"
+                            (object->string
+                             (object->string redirect)))))
+    (open-connection #:port channel)))
 
 
 ;;;
@@ -299,113 +338,6 @@ hook."
     (set-port-revealed! port 1)
     port))
 
-(define %gc-root-file
-  ;; File name of the temporary GC root we install.
-  (format #f "offload-~a-~a" (gethostname) (getpid)))
-
-(define (register-gc-root file machine)
-  "Mark FILE, a store item, as a garbage collector root on MACHINE."
-  (define script
-    `(begin
-       (use-modules (guix config))
-
-       ;; Note: we can't use 'add-indirect-root' because dangling links under
-       ;; gcroots/auto are automatically deleted by the GC.  This strategy
-       ;; doesn't have this problem, but it requires write access to that
-       ;; directory.
-       (let ((root-directory (string-append %state-directory
-                                            "/gcroots/tmp")))
-         (catch 'system-error
-           (lambda ()
-             (mkdir root-directory))
-           (lambda args
-             (unless (= EEXIST (system-error-errno args))
-               (error "failed to create remote GC root directory"
-                      root-directory (system-error-errno args)))))
-
-         (catch 'system-error
-           (lambda ()
-             (symlink ,file
-                      (string-append root-directory "/" ,%gc-root-file)))
-           (lambda args
-             ;; If FILE already exists, we can assume that either it's a stale
-             ;; reference (which is fine), or another process is already
-             ;; building the derivation represented by FILE (which is fine
-             ;; too.)  Thus, do nothing in that case.
-             (unless (= EEXIST (system-error-errno args))
-               (apply throw args)))))))
-
-  (let ((pipe (remote-pipe machine OPEN_READ
-                           `("guile" "-c" ,(object->string script)))))
-    (read-string pipe)
-    (let ((status (close-pipe pipe)))
-      (unless (zero? status)
-        ;; Better be safe than sorry: if we ignore the error here, then FILE
-        ;; may be GC'd just before we start using it.
-        (leave (_ "failed to register GC root for '~a' on '~a' (status: ~a)~%")
-               file (build-machine-name machine) status)))))
-
-(define (remove-gc-roots machine)
-  "Remove from MACHINE the GC roots previously installed with
-'register-gc-root'."
-  (define script
-    `(begin
-       (use-modules (guix config) (ice-9 ftw)
-                    (srfi srfi-1) (srfi srfi-26))
-
-       (let ((root-directory (string-append %state-directory
-                                            "/gcroots/tmp")))
-         (false-if-exception
-          (delete-file
-           (string-append root-directory "/" ,%gc-root-file)))
-
-         ;; These ones were created with 'guix build -r' (there can be more
-         ;; than one in case of multiple-output derivations.)
-         (let ((roots (filter (cut string-prefix? ,%gc-root-file <>)
-                              (scandir "."))))
-           (for-each (lambda (file)
-                       (false-if-exception (delete-file file)))
-                     roots)))))
-
-  (let ((pipe (remote-pipe machine OPEN_READ
-                           `("guile" "-c" ,(object->string script)))))
-    (read-string pipe)
-    (close-pipe pipe)))
-
-(define* (offload drv machine
-                  #:key print-build-trace? (max-silent-time 3600)
-                  build-timeout (log-port (build-log-port)))
-  "Perform DRV on MACHINE, assuming DRV and its prerequisites are available
-there, and write the build log to LOG-PORT.  Return the exit status."
-  (format (current-error-port) "offloading '~a' to '~a'...~%"
-          (derivation-file-name drv) (build-machine-name machine))
-  (format (current-error-port) "@ build-remote ~a ~a~%"
-          (derivation-file-name drv) (build-machine-name machine))
-
-  ;; Normally DRV has already been protected from GC when it was transferred.
-  ;; The '-r' flag below prevents the build result from being GC'd.
-  (let ((pipe (remote-pipe machine OPEN_READ
-                           `("guix" "build"
-                             "-r" ,%gc-root-file
-                             ,(format #f "--max-silent-time=~a"
-                                      max-silent-time)
-                             ,@(if build-timeout
-                                   (list (format #f "--timeout=~a"
-                                                 build-timeout))
-                                   '())
-                             ,(derivation-file-name drv))
-
-                           ;; Since 'guix build' writes the build log to its
-                           ;; stderr, everything will go directly to LOG-PORT.
-                           #:error-port log-port)))
-    (let loop ((line (read-line pipe)))
-      (unless (eof-object? line)
-        (display line log-port)
-        (newline log-port)
-        (loop (read-line pipe))))
-
-    (close-pipe pipe)))
-
 (define* (transfer-and-offload drv machine
                                #:key
                                (inputs '())
@@ -416,120 +348,131 @@ there, and write the build log to LOG-PORT.  Return the exit status."
   "Offload DRV to MACHINE.  Prior to the actual offloading, transfer all of
 INPUTS to MACHINE; if building DRV succeeds, retrieve all of OUTPUTS from
 MACHINE."
-  (when (begin
-          (register-gc-root (derivation-file-name drv) machine)
-          (send-files (cons (derivation-file-name drv) inputs)
-                      machine))
-    (let ((status (offload drv machine
-                           #:print-build-trace? print-build-trace?
-                           #:max-silent-time max-silent-time
-                           #:build-timeout build-timeout)))
-      (if (zero? status)
-          (begin
-            (retrieve-files outputs machine)
-            (remove-gc-roots machine)
-            (format (current-error-port)
-                    "done with offloaded '~a'~%"
-                    (derivation-file-name drv)))
-          (begin
-            (remove-gc-roots machine)
-            (format (current-error-port)
-                    "derivation '~a' offloaded to '~a' failed \
-with exit code ~a~%"
-                    (derivation-file-name drv)
-                    (build-machine-name machine)
-                    (status:exit-val status))
-
-            ;; Use exit code 100 for a permanent build failure.  The daemon
-            ;; interprets other non-zero codes as transient build failures.
-            (primitive-exit 100))))))
-
-(define (send-files files machine)
-  "Send the subset of FILES that's missing to MACHINE's store.  Return #t on
-success, #f otherwise."
-  (define (missing-files files)
-    ;; Return the subset of FILES not already on MACHINE.
-    (let*-values (((files)
-                   (format #f "~{~a~%~}" files))
-                  ((missing pids)
-                   (filtered-port
-                    (append (list (which %lshg-command)
-                                  "-l" (build-machine-user machine)
-                                  "-p" (number->string
-                                        (build-machine-port machine))
-                                  "-i" (build-machine-private-key machine))
-                            (build-machine-ssh-options machine)
-                            (cons (build-machine-name machine)
-                                  '("guix" "archive" "--missing")))
-                    (open-input-string files)))
-                  ((result)
-                   (read-string missing)))
-      (for-each waitpid pids)
-      (string-tokenize result)))
+  (define session
+    (open-ssh-session machine))
 
+  (define store
+    (connect-to-remote-daemon session
+                              (build-machine-daemon-socket machine)))
+
+  (set-build-options store
+                     #:print-build-trace print-build-trace?
+                     #:max-silent-time max-silent-time
+                     #:timeout build-timeout)
+
+  ;; Protect DRV from garbage collection.
+  (add-temp-root store (derivation-file-name drv))
+
+  (send-files (cons (derivation-file-name drv) inputs)
+              store)
+  (format (current-error-port) "offloading '~a' to '~a'...~%"
+          (derivation-file-name drv) (build-machine-name machine))
+  (format (current-error-port) "@ build-remote ~a ~a~%"
+          (derivation-file-name drv) (build-machine-name machine))
+
+  (guard (c ((nix-protocol-error? c)
+             (format (current-error-port)
+                     (_ "derivation '~a' offloaded to '~a' failed: ~a~%")
+                     (derivation-file-name drv)
+                     (build-machine-name machine)
+                     (nix-protocol-error-message c))
+             ;; Use exit code 100 for a permanent build failure.  The daemon
+             ;; interprets other non-zero codes as transient build failures.
+             (primitive-exit 100)))
+    (build-derivations store (list drv)))
+
+  (retrieve-files outputs store)
+  (format (current-error-port) "done with offloaded '~a'~%"
+          (derivation-file-name drv)))
+
+(define (store-import-channel session)
+  "Return an output port to which archives to be exported to SESSION's store
+can be written."
+  ;; Using the 'import-paths' RPC on a remote store would be slow because it
+  ;; makes a round trip every time 32 KiB have been transferred.  This
+  ;; procedure instead opens a separate channel to use the remote
+  ;; 'import-paths' procedure, which consumes all the data in a single round
+  ;; trip.
+  (define import
+    `(begin
+       (use-modules (guix))
+
+       (with-store store
+         (setvbuf (current-input-port) _IONBF)
+         (import-paths store (current-input-port)))))
+
+  (open-remote-output-pipe session
+                           (string-join
+                            `("guile" "-c"
+                              ,(object->string
+                                (object->string import))))))
+
+(define (store-export-channel session files)
+  "Return an input port from which an export of FILES from SESSION's store can
+be read."
+  ;; Same as above: this is more efficient than calling 'export-paths' on a
+  ;; remote store.
+  (define export
+    `(begin
+       (use-modules (guix))
+
+       (with-store store
+         (setvbuf (current-output-port) _IONBF)
+         (export-paths store ',files (current-output-port)))))
+
+  (open-remote-input-pipe session
+                          (string-join
+                           `("guile" "-c"
+                             ,(object->string
+                               (object->string export))))))
+
+(define (send-files files remote)
+  "Send the subset of FILES that's missing to REMOTE, a remote store."
   (with-store store
-    (guard (c ((nix-protocol-error? c)
-               (warning (_ "failed to export files for '~a': ~s~%")
-                        (build-machine-name machine)
-                        c)
-               #f))
-
-      ;; Compute the subset of FILES missing on MACHINE, and send them in
-      ;; topologically sorted order so that they can actually be imported.
-      ;;
-      ;; To reduce load on the machine that's offloading (since it's typically
-      ;; already quite busy, see hydra.gnu.org), compress with gzip rather
-      ;; than xz: For a compression ratio 2 times larger, it is 20 times
-      ;; faster.
-      (let* ((files (missing-files (topologically-sorted store files)))
-             (pipe  (remote-pipe machine OPEN_WRITE
-                                 '("gzip" "-dc" "|"
-                                   "guix" "archive" "--import")
-                                 #:quote? #f)))
-        (format #t (_ "sending ~a store files to '~a'...~%")
-                (length files) (build-machine-name machine))
-        (call-with-compressed-output-port 'gzip pipe
-          (lambda (compressed)
-            (catch 'system-error
-              (lambda ()
-                (export-paths store files compressed))
-              (lambda args
-                (warning (_ "failed while exporting files to '~a': ~a~%")
-                         (build-machine-name machine)
-                         (strerror (system-error-errno args))))))
-          #:options '("--fast"))
-
-        ;; Wait for the 'lsh' process to complete.
-        (zero? (close-pipe pipe))))))
-
-(define (retrieve-files files machine)
-  "Retrieve FILES from MACHINE's store, and import them."
-  (define host
-    (build-machine-name machine))
-
-  (let ((pipe (remote-pipe machine OPEN_READ
-                           `("guix" "archive" "--export" ,@files
-                             "|" "xz" "-c")
-                           #:quote? #f)))
-    (and pipe
-         (with-store store
-           (guard (c ((nix-protocol-error? c)
-                      (warning (_ "failed to import files from '~a': ~s~%")
-                               host c)
-                      #f))
-             (format (current-error-port) "retrieving ~a files from '~a'...~%"
-                     (length files) host)
-
-             ;; We cannot use the 'import-paths' RPC here because we already
-             ;; hold the locks for FILES.
-             (call-with-decompressed-port 'xz pipe
-               (lambda (decompressed)
-                 (restore-file-set decompressed
-                                   #:log-port (current-error-port)
-                                   #:lock? #f)))
-
-             ;; Wait for the 'lsh' process to complete.
-             (zero? (close-pipe pipe)))))))
+    ;; Compute the subset of FILES missing on SESSION, and send them in
+    ;; topologically sorted order so that they can actually be imported.
+    (let* ((sorted  (topologically-sorted store files))
+           (session (channel-get-session (nix-server-socket remote)))
+           (node    (make-node session))
+           (missing (node-eval node
+                               `(begin
+                                  (use-modules (guix)
+                                               (srfi srfi-1) (srfi srfi-26))
+
+                                  (with-store store
+                                    (remove (cut valid-path? store <>)
+                                            ',sorted)))))
+           (port    (store-import-channel session)))
+      (format #t (_ "sending ~a store files to '~a'...~%")
+              (length missing) (session-get session 'host))
+
+      (export-paths store missing port)
+
+      ;; Tell the remote process that we're done.  (In theory the
+      ;; end-of-archive mark of 'export-paths' would be enough, but in
+      ;; practice it's not.)
+      (channel-send-eof port)
+
+      ;; Wait for completion of the remote process.
+      (let ((result (zero? (channel-get-exit-status port))))
+        (close-port port)
+        result))))
+
+(define (retrieve-files files remote)
+  "Retrieve FILES from SESSION's store, and import them."
+  (let* ((session (channel-get-session (nix-server-socket remote)))
+         (host    (session-get session 'host))
+         (port    (store-export-channel session files)))
+    (format #t (_ "retrieving ~a files from '~a'...~%")
+            (length files) host)
+
+    ;; We cannot use the 'import-paths' RPC here because we already
+    ;; hold the locks for FILES.
+    (let ((result (restore-file-set port
+                                    #:log-port (current-error-port)
+                                    #:lock? #f)))
+      (close-port port)
+      result)))
 
 
 ;;;
@@ -547,13 +490,12 @@ success, #f otherwise."
 (define (machine-load machine)
   "Return the load of MACHINE, divided by the number of parallel builds
 allowed on MACHINE."
-  (let* ((pipe   (remote-pipe machine OPEN_READ `("cat" "/proc/loadavg")))
-         (line   (read-line pipe))
-         (status (close-pipe pipe)))
-    (unless (eqv? 0 (status:exit-val status))
-      (warning (_ "failed to obtain load of '~a': SSH client exited with ~a~%")
-               (build-machine-name machine)
-               (status:exit-val status)))
+  ;; Note: This procedure is costly since it creates a new SSH session.
+  (let* ((session (open-ssh-session machine))
+         (pipe    (open-remote-pipe* session OPEN_READ
+                                     "cat" "/proc/loadavg"))
+         (line    (read-line pipe)))
+    (close-port pipe)
 
     (if (eof-object? line)
         +inf.0    ;MACHINE does not respond, so assume it is infinitely loaded
@@ -569,17 +511,6 @@ allowed on MACHINE."
           (_
            +inf.0)))))           ;something's fishy about MACHINE, so avoid it
 
-(define (machine-power-factor m)
-  "Return a factor that aggregates the speed and load of M.  The higher the
-better."
-  (/ (build-machine-speed m)
-     (+ 1 (machine-load m))))
-
-(define (machine-less-loaded-or-faster? m1 m2)
-  "Return #t if M1 is either less loaded or faster than M2.  (This relation
-defines a total order on machines.)"
-  (> (machine-power-factor m1) (machine-power-factor m2)))
-
 (define (machine-lock-file machine hint)
   "Return the name of MACHINE's lock file for HINT."
   (string-append %state-directory "/offload/"
@@ -607,29 +538,39 @@ defines a total order on machines.)"
   ;;   5. Release the global machine-choice lock.
 
   (with-file-lock (machine-choice-lock-file)
-    (define machines+slots
+    (define machines+slots+loads
       (filter-map (lambda (machine)
+                    ;; Call 'machine-load' from here to make sure it is called
+                    ;; only once per machine (it is expensive).
                     (let ((slot (acquire-build-slot machine)))
-                      (and slot (list machine slot))))
+                      (and slot
+                           (list machine slot (machine-load machine)))))
                   machines))
 
     (define (undecorate pred)
       (lambda (a b)
         (match a
-          ((machine1 slot1)
+          ((machine1 slot1 load1)
            (match b
-             ((machine2 slot2)
-              (pred machine1 machine2)))))))
-
-    (let loop ((machines+slots
-                (sort machines+slots
+             ((machine2 slot2 load2)
+              (pred machine1 load1 machine2 load2)))))))
+
+    (define (machine-less-loaded-or-faster? m1 l1 m2 l2)
+      ;; Return #t if M1 is either less loaded or faster than M2, with L1
+      ;; being the load of M1 and L2 the load of M2.  (This relation defines a
+      ;; total order on machines.)
+      (> (/ (build-machine-speed m1) (+ 1 l1))
+         (/ (build-machine-speed m2) (+ 1 l2))))
+
+    (let loop ((machines+slots+loads
+                (sort machines+slots+loads
                       (undecorate machine-less-loaded-or-faster?))))
-      (match machines+slots
-        (((best slot) others ...)
+      (match machines+slots+loads
+        (((best slot load) others ...)
          ;; Return the best machine unless it's already overloaded.
-         (if (< (machine-load best) 2.)
+         (if (< load 2.)
              (match others
-               (((machines slots) ...)
+               (((machines slots loads) ...)
                 ;; Release slots from the uninteresting machines.
                 (for-each release-build-slot slots)
 
@@ -675,17 +616,6 @@ defines a total order on machines.)"
              ;; Not now, all the machines are busy.
              (display "# postpone\n")))))))
 
-(define-syntax-rule (with-nar-error-handling body ...)
-  "Execute BODY with any &nar-error suitably reported to the user."
-  (guard (c ((nar-error? c)
-             (let ((file (nar-error-file c)))
-               (if (condition-has-type? c &message)
-                   (leave (_ "while importing file '~a': ~a~%")
-                          file (gettext (condition-message c)))
-                   (leave (_ "failed to import file '~a'~%")
-                          file)))))
-    body ...))
-
 
 ;;;
 ;;; Entry point.
@@ -716,7 +646,7 @@ defines a total order on machines.)"
              (cond ((regexp-exec request-line-rx line)
                     =>
                     (lambda (match)
-                      (with-nar-error-handling
+                      (with-error-handling
                        (process-request (equal? (match:substring match 1) "1")
                                         (match:substring match 2) ; system
                                         (call-with-input-file
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index b81c69f9fe..e1ff544de0 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -35,7 +35,8 @@
                 #:select (%gnu-updater
                           %gnome-updater
                           %kde-updater
-                          %xorg-updater))
+                          %xorg-updater
+                          %kernel.org-updater))
   #:use-module (guix import elpa)
   #:use-module (guix import cran)
   #:use-module (guix import hackage)
@@ -200,6 +201,7 @@ unavailable optional dependencies such as Guile-JSON."
                  %gnome-updater
                  %kde-updater
                  %xorg-updater
+                 %kernel.org-updater
                  %elpa-updater
                  %cran-updater
                  %bioconductor-updater
@@ -208,7 +210,7 @@ unavailable optional dependencies such as Guile-JSON."
                  ((guix import gem) => %gem-updater)
                  ((guix import github) => %github-updater)))
 
-(define (lookup-updater name)
+(define (lookup-updater-by-name name)
   "Return the updater called NAME."
   (or (find (lambda (updater)
               (eq? name (upstream-updater-name updater)))
@@ -218,38 +220,84 @@ unavailable optional dependencies such as Guile-JSON."
 (define (list-updaters-and-exit)
   "Display available updaters and exit."
   (format #t (_ "Available updaters:~%"))
-  (for-each (lambda (updater)
-              (format #t "- ~a: ~a~%"
-                      (upstream-updater-name updater)
-                      (_ (upstream-updater-description updater))))
-            %updaters)
+  (newline)
+
+  (let* ((packages (fold-packages cons '()))
+         (total    (length packages)))
+    (define covered
+      (fold (lambda (updater covered)
+              (let ((matches (count (upstream-updater-predicate updater)
+                                    packages)))
+                ;; TRANSLATORS: The parenthetical expression here is rendered
+                ;; like "(42% coverage)" and denotes the fraction of packages
+                ;; covered by the given updater.
+                (format #t (_ "  - ~a: ~a (~2,1f% coverage)~%")
+                        (upstream-updater-name updater)
+                        (_ (upstream-updater-description updater))
+                        (* 100. (/ matches total)))
+                (+ covered matches)))
+            0
+            %updaters))
+
+    (newline)
+    (format #t (_ "~2,1f% of the packages are covered by these updaters.~%")
+            (* 100. (/ covered total))))
   (exit 0))
 
+(define (warn-no-updater package)
+  (format (current-error-port)
+          (_ "~a: warning: no updater for ~a~%")
+          (location->string (package-location package))
+          (package-name package)))
+
 (define* (update-package store package updaters
-                         #:key (key-download 'interactive))
+                         #:key (key-download 'interactive) warn?)
   "Update the source file that defines PACKAGE with the new version.
 KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed
-values: 'interactive' (default), 'always', and 'never'."
-  (let-values (((version tarball)
-                (package-update store package updaters
-                                #:key-download key-download))
-               ((loc)
-                (or (package-field-location package 'version)
-                    (package-location package))))
-    (when version
-      (if (and=> tarball file-exists?)
-          (begin
-            (format (current-error-port)
-                    (_ "~a: ~a: updating from version ~a to version ~a...~%")
-                    (location->string loc)
-                    (package-name package)
-                    (package-version package) version)
-            (let ((hash (call-with-input-file tarball
-                          port-sha256)))
-              (update-package-source package version hash)))
-          (warning (_ "~a: version ~a could not be \
+values: 'interactive' (default), 'always', and 'never'.  When WARN? is true,
+warn about packages that have no matching updater."
+  (if (lookup-updater package updaters)
+      (let-values (((version tarball)
+                    (package-update store package updaters
+                                    #:key-download key-download))
+                   ((loc)
+                    (or (package-field-location package 'version)
+                        (package-location package))))
+        (when version
+          (if (and=> tarball file-exists?)
+              (begin
+                (format (current-error-port)
+                        (_ "~a: ~a: updating from version ~a to version ~a...~%")
+                        (location->string loc)
+                        (package-name package)
+                        (package-version package) version)
+                (let ((hash (call-with-input-file tarball
+                              port-sha256)))
+                  (update-package-source package version hash)))
+              (warning (_ "~a: version ~a could not be \
 downloaded and authenticated; not updating~%")
-                   (package-name package) version)))))
+                       (package-name package) version))))
+      (when warn?
+        (warn-no-updater package))))
+
+(define* (check-for-package-update package updaters #:key warn?)
+  "Check whether an update is available for PACKAGE and print a message.  When
+WARN? is true and no updater exists for PACKAGE, print a warning."
+  (match (package-latest-release package updaters)
+    ((? upstream-source? source)
+     (when (version>? (upstream-source-version source)
+                      (package-version package))
+       (let ((loc (or (package-field-location package 'version)
+                      (package-location package))))
+         (format (current-error-port)
+                 (_ "~a: ~a would be upgraded from ~a to ~a~%")
+                 (location->string loc)
+                 (package-name package) (package-version package)
+                 (upstream-source-version source)))))
+    (#f
+     (when warn?
+       (warn-no-updater package)))))
+
 
 
 ;;;
@@ -312,7 +360,7 @@ dependent packages are rebuilt: ~{~a~^ ~}~%"
     ;; Return the list of updaters to use.
     (match (filter-map (match-lambda
                          (('updaters . names)
-                          (map lookup-updater names))
+                          (map lookup-updater-by-name names))
                          (_ #f))
                        opts)
       (()
@@ -360,6 +408,12 @@ update would trigger a complete rebuild."
          (updaters        (options->updaters opts))
          (list-dependent? (assoc-ref opts 'list-dependent?))
          (key-download    (assoc-ref opts 'key-download))
+
+         ;; Warn about missing updaters when a package is explicitly given on
+         ;; the command line.
+         (warn?           (or (assoc-ref opts 'argument)
+                              (assoc-ref opts 'expression)))
+
          (packages
           (match (filter-map (match-lambda
                                (('argument . spec)
@@ -397,22 +451,14 @@ update would trigger a complete rebuild."
                                 (%gpg-command))))
               (for-each
                (cut update-package store <> updaters
-                    #:key-download key-download)
+                    #:key-download key-download
+                    #:warn? warn?)
                packages)
               (with-monad %store-monad
                 (return #t))))
            (else
-            (for-each (lambda (package)
-                        (match (package-update-path package updaters)
-                          ((? upstream-source? source)
-                           (let ((loc (or (package-field-location package 'version)
-                                          (package-location package))))
-                             (format (current-error-port)
-                                     (_ "~a: ~a would be upgraded from ~a to ~a~%")
-                                     (location->string loc)
-                                     (package-name package) (package-version package)
-                                     (upstream-source-version source))))
-                          (#f #f)))
+            (for-each (cut check-for-package-update <> updaters
+                           #:warn? warn?)
                       packages)
             (with-monad %store-monad
               (return #t)))))))))
diff --git a/guix/store.scm b/guix/store.scm
index 7f54b87db1..689a94c636 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -345,50 +345,58 @@
   (message nix-protocol-error-message)
   (status  nix-protocol-error-status))
 
-(define* (open-connection #:optional (file (%daemon-socket-file))
-                          #:key (reserve-space? #t) cpu-affinity)
-  "Connect to the daemon over the Unix-domain socket at FILE.  When
-RESERVE-SPACE? is true, instruct it to reserve a little bit of extra space on
-the file system so that the garbage collector can still operate, should the
-disk become full.  When CPU-AFFINITY is true, it must be an integer
-corresponding to an OS-level CPU number to which the daemon's worker process
-for this connection will be pinned.  Return a server object."
+(define (open-unix-domain-socket file)
+  "Connect to the Unix-domain socket at FILE and return it.  Raise a
+'&nix-connection-error' upon error."
   (let ((s (with-fluids ((%default-port-encoding #f))
              ;; This trick allows use of the `scm_c_read' optimization.
              (socket PF_UNIX SOCK_STREAM 0)))
         (a (make-socket-address PF_UNIX file)))
 
     (catch 'system-error
-      (cut connect s a)
+      (lambda ()
+        (connect s a)
+        s)
       (lambda args
         ;; Translate the error to something user-friendly.
         (let ((errno (system-error-errno args)))
           (raise (condition (&nix-connection-error
                              (file file)
-                             (errno errno)))))))
+                             (errno errno)))))))))
 
-    (write-int %worker-magic-1 s)
-    (let ((r (read-int s)))
+(define* (open-connection #:optional (file (%daemon-socket-file))
+                          #:key port (reserve-space? #t) cpu-affinity)
+  "Connect to the daemon over the Unix-domain socket at FILE, or, if PORT is
+not #f, use it as the I/O port over which to communicate to a build daemon.
+
+When RESERVE-SPACE? is true, instruct it to reserve a little bit of extra
+space on the file system so that the garbage collector can still operate,
+should the disk become full.  When CPU-AFFINITY is true, it must be an integer
+corresponding to an OS-level CPU number to which the daemon's worker process
+for this connection will be pinned.  Return a server object."
+  (let ((port (or port (open-unix-domain-socket file))))
+    (write-int %worker-magic-1 port)
+    (let ((r (read-int port)))
       (and (eqv? r %worker-magic-2)
-           (let ((v (read-int s)))
+           (let ((v (read-int port)))
              (and (eqv? (protocol-major %protocol-version)
                         (protocol-major v))
                   (begin
-                    (write-int %protocol-version s)
+                    (write-int %protocol-version port)
                     (when (>= (protocol-minor v) 14)
-                      (write-int (if cpu-affinity 1 0) s)
+                      (write-int (if cpu-affinity 1 0) port)
                       (when cpu-affinity
-                        (write-int cpu-affinity s)))
+                        (write-int cpu-affinity port)))
                     (when (>= (protocol-minor v) 11)
-                      (write-int (if reserve-space? 1 0) s))
-                    (let ((s (%make-nix-server s
-                                               (protocol-major v)
-                                               (protocol-minor v)
-                                               (make-hash-table 100)
-                                               (make-hash-table 100))))
-                      (let loop ((done? (process-stderr s)))
-                        (or done? (process-stderr s)))
-                      s))))))))
+                      (write-int (if reserve-space? 1 0) port))
+                    (let ((conn (%make-nix-server port
+                                                  (protocol-major v)
+                                                  (protocol-minor v)
+                                                  (make-hash-table 100)
+                                                  (make-hash-table 100))))
+                      (let loop ((done? (process-stderr conn)))
+                        (or done? (process-stderr conn)))
+                      conn))))))))
 
 (define (close-connection server)
   "Close the connection to SERVER."
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 18157376d2..8685afd860 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -26,6 +26,11 @@
   #:use-module (guix packages)
   #:use-module (guix ui)
   #:use-module (guix base32)
+  #:use-module (guix gexp)
+  #:use-module (guix store)
+  #:use-module ((guix derivations)
+                #:select (built-derivations derivation->output-path))
+  #:use-module (guix monads)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
@@ -49,8 +54,11 @@
             upstream-updater-predicate
             upstream-updater-latest
 
+            lookup-updater
+
             download-tarball
-            package-update-path
+            package-latest-release
+            package-latest-release*
             package-update
             update-package-source))
 
@@ -127,17 +135,50 @@ them matches."
           (and (pred package) latest)))
        updaters))
 
-(define (package-update-path package updaters)
+(define (package-latest-release package updaters)
   "Return an upstream source to update PACKAGE, a <package> object, or #f if
-no update is needed or known."
+none of UPDATERS matches PACKAGE.  It is the caller's responsibility to ensure
+that the returned source is newer than the current one."
   (match (lookup-updater package updaters)
     ((? procedure? latest-release)
-     (match (latest-release package)
-       ((and source ($ <upstream-source> name version))
-        (and (version>? version (package-version package))
-             source))
-       (_ #f)))
-    (#f #f)))
+     (latest-release package))
+    (_ #f)))
+
+(define (package-latest-release* package updaters)
+  "Like 'package-latest-release', but ensure that the return source is newer
+than that of PACKAGE."
+  (match (package-latest-release package updaters)
+    ((and source ($ <upstream-source> name version))
+     (and (version>? version (package-version package))
+          source))
+    (_
+     #f)))
+
+(define (uncompressed-tarball name tarball)
+  "Return a derivation that decompresses TARBALL."
+  (define (ref package)
+    (module-ref (resolve-interface '(gnu packages compression))
+                package))
+
+  (define compressor
+    (cond ((or (string-suffix? ".gz" tarball)
+               (string-suffix? ".tgz" tarball))
+           (file-append (ref 'gzip) "/bin/gzip"))
+          ((string-suffix? ".bz2" tarball)
+           (file-append (ref 'bzip2) "/bin/bzip2"))
+          ((string-suffix? ".xz" tarball)
+           (file-append (ref 'xz) "/bin/xz"))
+          ((string-suffix? ".lz" tarball)
+           (file-append (ref 'lzip) "/bin/lzip"))
+          (else
+           (error "unknown archive type" tarball))))
+
+  (gexp->derivation (file-sans-extension name)
+                    #~(begin
+                        (copy-file #+tarball #+name)
+                        (and (zero? (system* #+compressor "-d" #+name))
+                             (copy-file #+(file-sans-extension name)
+                                        #$output)))))
 
 (define* (download-tarball store url signature-url
                            #:key (key-download 'interactive))
@@ -149,8 +190,22 @@ values: 'interactive' (default), 'always', and 'never'."
   (let ((tarball (download-to-store store url)))
     (if (not signature-url)
         tarball
-        (let* ((sig (download-to-store store signature-url))
-               (ret (gnupg-verify* sig tarball #:key-download key-download)))
+        (let* ((sig  (download-to-store store signature-url))
+
+               ;; Sometimes we get a signature over the uncompressed tarball.
+               ;; In that case, decompress the tarball in the store so that we
+               ;; can check the signature.
+               (data (if (string-prefix? (basename url)
+                                         (basename signature-url))
+                         tarball
+                         (run-with-store store
+                           (mlet %store-monad ((drv (uncompressed-tarball
+                                                     (basename url) tarball)))
+                             (mbegin %store-monad
+                               (built-derivations (list drv))
+                               (return (derivation->output-path drv)))))))
+
+               (ret  (gnupg-verify* sig data #:key-download key-download)))
           (if ret
               tarball
               (begin
@@ -179,7 +234,7 @@ values: the item from LST1 and the item from LST2 that match PRED."
 PACKAGE, or #f and #f when PACKAGE is up-to-date.  KEY-DOWNLOAD specifies a
 download policy for missing OpenPGP keys; allowed values: 'always', 'never',
 and 'interactive' (default)."
-  (match (package-update-path package updaters)
+  (match (package-latest-release* package updaters)
     (($ <upstream-source> _ version urls signature-urls)
      (let*-values (((name)
                     (package-name package))