Merge branch 'master' into core-updates

 Conflicts:
	gnu/packages/image.scm
        (incorporated libtiff graft)

13 files changed, 408 insertions, 60 deletions

diff --git a/guix/build-system/font.scm b/guix/build-system/font.scm
new file mode 100644
index 0000000000..f448c302c2
--- /dev/null
+++ b/guix/build-system/font.scm
@@ -0,0 +1,130 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build-system font)
+  #:use-module (guix utils)
+  #:use-module (guix packages)
+  #:use-module (guix derivations)
+  #:use-module (guix search-paths)
+  #:use-module (guix build-system)
+  #:use-module (guix build-system gnu)
+  #:use-module (ice-9 match)
+  #:export (%font-build-system-modules
+            font-build
+            font-build-system))
+
+;; Commentary:
+;;
+;; Standard build procedure for fonts.  This is implemented as an extension of
+;; 'gnu-build-system'.
+;;
+;; Code:
+
+(define %font-build-system-modules
+  ;; Build-side modules imported by default.
+  `((guix build font-build-system)
+    ,@%gnu-build-system-modules))
+
+(define* (lower name
+                #:key source inputs native-inputs outputs system target
+                #:allow-other-keys
+                #:rest arguments)
+  "Return a bag for NAME."
+  (define private-keywords
+    '(#:target #:inputs #:native-inputs))
+
+  (bag
+    (name name)
+    (system system)
+    (host-inputs `(,@(if source
+                         `(("source" ,source))
+                         '())
+                   ,@inputs
+                   ,(list "tar" (module-ref (resolve-interface '(gnu packages base)) 'tar))
+                   ,(list "unzip" (module-ref (resolve-interface '(gnu packages zip)) 'unzip))
+                   ,@(let ((compression (resolve-interface '(gnu packages compression))))
+                       (map (match-lambda
+                              ((name package)
+                               (list name (module-ref compression package))))
+                            `(("gzip" gzip)
+                              ("bzip2" bzip2)
+                              ("xz" xz))))))
+    (build-inputs native-inputs)
+    (outputs outputs)
+    (build font-build)
+    (arguments (strip-keyword-arguments private-keywords arguments))))
+
+(define* (font-build store name inputs
+                     #:key source
+                     (tests? #t)
+                     (test-target "test")
+                     (configure-flags ''())
+                     (phases '(@ (guix build font-build-system)
+                                 %standard-phases))
+                     (outputs '("out"))
+                     (search-paths '())
+                     (system (%current-system))
+                     (guile #f)
+                     (imported-modules %font-build-system-modules)
+                     (modules '((guix build font-build-system)
+                                (guix build utils))))
+  "Build SOURCE with INPUTS."
+  (define builder
+    `(begin
+       (use-modules ,@modules)
+       (font-build #:name ,name
+                   #:source ,(match (assoc-ref inputs "source")
+                               (((? derivation? source))
+                                (derivation->output-path source))
+                               ((source)
+                                source)
+                               (source
+                                source))
+                   #:configure-flags ,configure-flags
+                   #:system ,system
+                   #:test-target ,test-target
+                   #:tests? ,tests?
+                   #:phases ,phases
+                   #:outputs %outputs
+                   #:search-paths ',(map search-path-specification->sexp
+                                         search-paths)
+                   #:inputs %build-inputs)))
+
+  (define guile-for-build
+    (match guile
+      ((? package?)
+       (package-derivation store guile system #:graft? #f))
+      (#f                                         ; the default
+       (let* ((distro (resolve-interface '(gnu packages commencement)))
+              (guile  (module-ref distro 'guile-final)))
+         (package-derivation store guile system #:graft? #f)))))
+
+  (build-expression->derivation store name builder
+                                #:inputs inputs
+                                #:system system
+                                #:modules imported-modules
+                                #:outputs outputs
+                                #:guile-for-build guile-for-build))
+
+(define font-build-system
+  (build-system
+    (name 'font)
+    (description "The build system for font packages")
+    (lower lower)))
+
+;;; font.scm ends here
diff --git a/guix/build/download.scm b/guix/build/download.scm
index ce4708a873..6ef6233346 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -296,6 +296,13 @@ session record port using PORT as its underlying communication port."
   (make-parameter (or (getenv "GUIX_TLS_CERTIFICATE_DIRECTORY")
                       (getenv "SSL_CERT_DIR"))))  ;like OpenSSL
 
+(define (set-certificate-credentials-x509-trust-file!* cred file format)
+  "Like 'set-certificate-credentials-x509-trust-file!', but without the file
+name decoding bug described at
+<https://debbugs.gnu.org/cgi/bugreport.cgi?bug=26948#17>."
+  (let ((data (call-with-input-file file get-bytevector-all)))
+    (set-certificate-credentials-x509-trust-data! cred data format)))
+
 (define (make-credendials-with-ca-trust-files directory)
   "Return certificate credentials with X.509 authority certificates read from
 DIRECTORY.  Those authority certificates are checked when
@@ -309,7 +316,7 @@ DIRECTORY.  Those authority certificates are checked when
                 (let ((file (string-append directory "/" file)))
                   ;; Protect against dangling symlinks.
                   (when (file-exists? file)
-                    (set-certificate-credentials-x509-trust-file!
+                    (set-certificate-credentials-x509-trust-file!*
                      cred file
                      x509-certificate-format/pem))))
               (or files '()))
diff --git a/guix/build/font-build-system.scm b/guix/build/font-build-system.scm
new file mode 100644
index 0000000000..f2a646f6f4
--- /dev/null
+++ b/guix/build/font-build-system.scm
@@ -0,0 +1,72 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2017 Alex Griffin <a@ajgrf.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build font-build-system)
+  #:use-module ((guix build gnu-build-system) #:prefix gnu:)
+  #:use-module (guix build utils)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:export (%standard-phases
+            font-build))
+
+;; Commentary:
+;;
+;; Builder-side code of the build procedure for font packages.
+;;
+;; Code:
+
+(define gnu:unpack (assoc-ref gnu:%standard-phases 'unpack))
+
+(define* (unpack #:key source #:allow-other-keys)
+  "Unpack SOURCE into the build directory.  SOURCE may be a compressed
+archive, or a font file."
+  (if (any (cut string-suffix? <> source)
+           (list ".ttf" ".otf"))
+      (begin
+        (mkdir "source")
+        (chdir "source")
+        (copy-file source (strip-store-file-name source))
+        #t)
+      (gnu:unpack #:source source)))
+
+(define* (install #:key outputs #:allow-other-keys)
+  "Install the package contents."
+  (let* ((out (assoc-ref outputs "out"))
+         (source (getcwd))
+         (fonts (string-append out "/share/fonts")))
+    (for-each (cut install-file <> (string-append fonts "/truetype"))
+              (find-files source "\\.(ttf|ttc)$"))
+    (for-each (cut install-file <> (string-append fonts "/opentype"))
+              (find-files source "\\.(otf|otc)$"))
+    #t))
+
+(define %standard-phases
+  (modify-phases gnu:%standard-phases
+    (replace 'unpack unpack)
+    (delete 'configure)
+    (delete 'check)
+    (delete 'build)
+    (replace 'install install)))
+
+(define* (font-build #:key inputs (phases %standard-phases)
+                      #:allow-other-keys #:rest args)
+  "Build the given font package, applying all of PHASES in order."
+  (apply gnu:gnu-build #:inputs inputs #:phases phases args))
+
+;;; font-build-system.scm ends here
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 0529c228a5..2def2a108f 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -62,6 +62,7 @@
             file-system-fragment-size
             file-system-mount-flags
             statfs
+            free-disk-space
 
             processes
             mkdtemp!
@@ -69,6 +70,9 @@
             pivot-root
             fcntl-flock
 
+            set-thread-name
+            thread-name
+
             CLONE_CHILD_CLEARTID
             CLONE_CHILD_SETTID
             CLONE_NEWNS
@@ -694,6 +698,12 @@ mounted at FILE."
                    (list file (strerror err))
                    (list err)))))))
 
+(define (free-disk-space file)
+  "Return the free disk space, in bytes, on the file system that hosts FILE."
+  (let ((fs (statfs file)))
+    (* (file-system-block-size fs)
+       (file-system-blocks-available fs))))
+
 
 ;;;
 ;;; Containers.
@@ -884,6 +894,52 @@ exception if it's already taken."
 
 
 ;;;
+;;; Miscellaneous, aka. 'prctl'.
+;;;
+
+(define %prctl
+  ;; Should it win the API contest against 'ioctl'?  You tell us!
+  (syscall->procedure int "prctl"
+                      (list int unsigned-long unsigned-long
+                            unsigned-long unsigned-long)))
+
+(define PR_SET_NAME 15)                           ;<linux/prctl.h>
+(define PR_GET_NAME 16)
+
+(define %max-thread-name-length
+  ;; Maximum length in bytes of the process name, including the terminating
+  ;; zero.
+  16)
+
+(define (set-thread-name name)
+  "Set the name of the calling thread to NAME.  NAME is truncated to 15
+bytes."
+  (let ((ptr (string->pointer name)))
+    (let-values (((ret err)
+                  (%prctl PR_SET_NAME
+                          (pointer-address ptr) 0 0 0)))
+      (unless (zero? ret)
+        (throw 'set-process-name "set-process-name"
+               "set-process-name: ~A"
+               (list (strerror err))
+               (list err))))))
+
+(define (thread-name)
+  "Return the name of the calling thread as a string."
+  (let ((buf (make-bytevector %max-thread-name-length)))
+    (let-values (((ret err)
+                  (%prctl PR_GET_NAME
+                          (pointer-address (bytevector->pointer buf))
+                          0 0 0)))
+      (if (zero? ret)
+          (bytes->string (bytevector->u8-list buf))
+          (throw 'process-name "process-name"
+                 "process-name: ~A"
+                 (list (strerror err))
+                 (list err))))))
+
+
+;;;
 ;;; Network interfaces.
 ;;;
 
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 9aaab05ecb..b9ad9c9e8c 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -271,13 +271,14 @@ result is the set of prerequisites of DRV not already in valid."
 (define* (substitution-oracle store drv
                               #:key (mode (build-mode normal)))
   "Return a one-argument procedure that, when passed a store file name,
-returns #t if it's substitutable and #f otherwise.  The returned procedure
+returns a 'substitutable?' if it's substitutable and #f otherwise.
+The returned procedure
 knows about all substitutes for all the derivations listed in DRV, *except*
 those that are already valid (that is, it won't bother checking whether an
 item is substitutable if it's already on disk); it also knows about their
 prerequisites, unless they are themselves substitutable.
 
-Creating a single oracle (thus making a single 'substitutable-paths' call) and
+Creating a single oracle (thus making a single 'substitutable-path-info' call) and
 reusing it is much more efficient than calling 'has-substitutes?' or similar
 repeatedly, because it avoids the costs associated with launching the
 substituter many times."
@@ -318,21 +319,28 @@ substituter many times."
                                    (cons* self (dependencies drv) result)))))
                         '()
                         drv))))
-         (subst (list->set (substitutable-paths store paths))))
-    (cut set-contains? subst <>)))
+         (subst (fold (lambda (subst vhash)
+                        (vhash-cons (substitutable-path subst) subst
+                                    vhash))
+                      vlist-null
+                      (substitutable-path-info store paths))))
+    (lambda (item)
+      (match (vhash-assoc item subst)
+        (#f #f)
+        ((key . value) value)))))
 
 (define* (derivation-prerequisites-to-build store drv
                                             #:key
                                             (mode (build-mode normal))
                                             (outputs
                                              (derivation-output-names drv))
-                                            (substitutable?
+                                            (substitutable-info
                                              (substitution-oracle store
                                                                   (list drv)
                                                                   #:mode mode)))
   "Return two values: the list of derivation-inputs required to build the
 OUTPUTS of DRV and not already available in STORE, recursively, and the list
-of required store paths that can be substituted.  SUBSTITUTABLE? must be a
+of required store paths that can be substituted.  SUBSTITUTABLE-INFO must be a
 one-argument procedure similar to that returned by 'substitution-oracle'."
   (define built?
     (cut valid-path? store <>))
@@ -343,7 +351,7 @@ one-argument procedure similar to that returned by 'substitution-oracle'."
   (define input-substitutable?
     ;; Return true if and only if all of SUB-DRVS are subsitutable.  If at
     ;; least one is missing, then everything must be rebuilt.
-    (compose (cut every substitutable? <>) derivation-input-output-paths))
+    (compose (cut every substitutable-info <>) derivation-input-output-paths))
 
   (define (derivation-built? drv* sub-drvs)
     ;; In 'check' mode, assume that DRV is not built.
@@ -351,20 +359,24 @@ one-argument procedure similar to that returned by 'substitution-oracle'."
                    (eq? drv* drv)))
          (every built? (derivation-output-paths drv* sub-drvs))))
 
-  (define (derivation-substitutable? drv sub-drvs)
+  (define (derivation-substitutable-info drv sub-drvs)
     (and (substitutable-derivation? drv)
-         (every substitutable? (derivation-output-paths drv sub-drvs))))
+         (let ((info (filter-map substitutable-info
+                                 (derivation-output-paths drv sub-drvs))))
+           (and (= (length info) (length sub-drvs))
+                info))))
 
   (let loop ((drv        drv)
              (sub-drvs   outputs)
-             (build      '())
-             (substitute '()))
+             (build      '())                     ;list of <derivation-input>
+             (substitute '()))                    ;list of <substitutable>
     (cond ((derivation-built? drv sub-drvs)
            (values build substitute))
-          ((derivation-substitutable? drv sub-drvs)
-           (values build
-                   (append (derivation-output-paths drv sub-drvs)
-                           substitute)))
+          ((derivation-substitutable-info drv sub-drvs)
+           =>
+           (lambda (substitutables)
+             (values build
+                     (append substitutables substitute))))
           (else
            (let ((build  (if (substitutable-derivation? drv)
                              build
@@ -381,8 +393,9 @@ one-argument procedure similar to that returned by 'substitution-oracle'."
                     (append (append-map (lambda (input)
                                           (if (and (not (input-built? input))
                                                    (input-substitutable? input))
-                                              (derivation-input-output-paths
-                                               input)
+                                              (map substitutable-info
+                                                   (derivation-input-output-paths
+                                                    input))
                                               '()))
                                         (derivation-inputs drv))
                             substitute)
diff --git a/guix/git-download.scm b/guix/git-download.scm
index 9f6d20ee38..316835502c 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -146,7 +146,8 @@ absolute file name and STAT is the result of 'lstat'."
                           (line
                            (loop (cons line lines))))))
          (inodes      (map (lambda (file)
-                             (let ((stat (lstat file)))
+                             (let ((stat (lstat
+                                          (string-append directory "/" file))))
                                (cons (stat:dev stat) (stat:ino stat))))
                            files))
          (status      (close-pipe pipe)))
diff --git a/guix/licenses.scm b/guix/licenses.scm
index 8396b1a3c6..6845b89d90 100644
--- a/guix/licenses.scm
+++ b/guix/licenses.scm
@@ -11,6 +11,7 @@
 ;;; Copyright © 2016, 2017 ng0 <ng0@libertad.pw>
 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2017 Petter <petter@mykolab.ch>
+;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -37,7 +38,8 @@
             non-copyleft
             bsd-style                             ;deprecated!
             cc0
-            cc-by2.0 cc-by3.0 cc-by-sa2.0 cc-by-sa3.0 cc-by-sa4.0
+            cc-by2.0 cc-by3.0 cc-by4.0
+            cc-by-sa2.0 cc-by-sa3.0 cc-by-sa4.0
             cddl1.0
             cecill cecill-b cecill-c
             artistic2.0 clarified-artistic
@@ -181,6 +183,11 @@ at URI, which may be a file:// URI pointing the package's tree."
            "http://creativecommons.org/licenses/by-sa/2.0/"
            "Creative Commons Attribution-ShareAlike 2.0 Generic"))
 
+(define cc-by4.0
+  (license "CC-BY 4.0"
+           "http://creativecommons.org/licenses/by/4.0/"
+           "Creative Commons Attribution 4.0 Unported"))
+
 (define cc-by3.0
   (license "CC-BY 3.0"
            "http://creativecommons.org/licenses/by/3.0/"
diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm
index 221467a108..0a9719d259 100644
--- a/guix/scripts/gc.scm
+++ b/guix/scripts/gc.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,7 +20,7 @@
   #:use-module (guix ui)
   #:use-module (guix scripts)
   #:use-module (guix store)
-  #:autoload   (guix build syscalls) (statfs)
+  #:autoload   (guix build syscalls) (free-disk-space)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (srfi srfi-1)
@@ -184,9 +184,7 @@ Invoke the garbage collector.\n"))
 
   (define (ensure-free-space store space)
     ;; Attempt to have at least SPACE bytes available in STORE.
-    (let* ((fs    (statfs (%store-prefix)))
-           (free  (* (file-system-block-size fs)
-                     (file-system-blocks-available fs))))
+    (let ((free (free-disk-space (%store-prefix))))
       (if (> free space)
           (info (G_ "already ~h bytes available on ~a, nothing to do~%")
                 free (%store-prefix))
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index 74c0c5484c..77b340cff6 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -34,7 +34,8 @@
                 #:select (nar-error? nar-error-file))
   #:use-module (guix nar)
   #:use-module (guix utils)
-  #:use-module ((guix build syscalls) #:select (fcntl-flock))
+  #:use-module ((guix build syscalls)
+                #:select (fcntl-flock set-thread-name))
   #:use-module ((guix build utils) #:select (which mkdir-p))
   #:use-module (guix ui)
   #:use-module (srfi srfi-1)
@@ -641,6 +642,7 @@ machine."
      (let ((max-silent-time    (string->number max-silent-time))
            (build-timeout      (string->number build-timeout))
            (print-build-trace? (string=? print-build-trace? "1")))
+       (set-thread-name "guix offload")
        (parameterize ((%current-system system))
          (let loop ((line (read-line)))
            (unless (eof-object? line)
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index c306b809a7..c49c0c3e20 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -58,6 +58,7 @@
                 #:select (with-atomic-file-output compressed-file?))
   #:use-module ((guix build utils)
                 #:select (dump-port mkdir-p find-files))
+  #:use-module ((guix build syscalls) #:select (set-thread-name))
   #:export (%public-key
             %private-key
 
@@ -649,6 +650,7 @@ blocking."
      ;; thread so that the main thread can keep working in the meantime.
      (call-with-new-thread
       (lambda ()
+        (set-thread-name "publish nar")
         (let* ((response (write-response (sans-content-length response)
                                          client))
                (port     (begin
@@ -670,6 +672,7 @@ blocking."
      ;; Send a raw file in a separate thread.
      (call-with-new-thread
       (lambda ()
+        (set-thread-name "publish file")
         (catch 'system-error
           (lambda ()
             (call-with-input-file (utf8->string body)
@@ -858,10 +861,16 @@ consider using the '--user' option!~%")))
                 (sockaddr:port address))
         (when repl-port
           (repl:spawn-server (repl:make-tcp-server-socket #:port repl-port)))
+
+        ;; Set the name of the main thread.
+        (set-thread-name "guix publish")
+
         (with-store store
           (run-publish-server socket store
                               #:cache cache
-                              #:pool (and cache (make-pool workers))
+                              #:pool (and cache (make-pool workers
+                                                           #:thread-name
+                                                           "publish worker"))
                               #:nar-path nar-path
                               #:compression compression
                               #:narinfo-ttl ttl))))))
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 73d4f6e2eb..71f30030b6 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -39,6 +39,8 @@
                            . guix:open-connection-for-uri)
                           close-connection
                           store-path-abbreviation byte-count->string))
+  #:use-module ((guix build syscalls)
+                #:select (set-thread-name))
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
@@ -872,15 +874,7 @@ DESTINATION as a nar file.  Verify the substitute against ACL."
     (format #t "~a~%" (narinfo-hash narinfo))
 
     (format (current-error-port)
-            ;; TRANSLATORS: The second part of this message looks like
-            ;; "(4.1MiB installed)"; it shows the size of the package once
-            ;; installed.
-            (G_ "Downloading ~a~:[~*~; (~a installed)~]...~%")
-            (uri->string uri)
-            ;; Use the Nar size as an estimate of the installed size.
-            (narinfo-size narinfo)
-            (and=> (narinfo-size narinfo)
-                   (cute byte-count->string <>)))
+            (G_ "Downloading ~a...~%") (uri->string uri))
     (let*-values (((raw download-size)
                    ;; Note that Hydra currently generates Nars on the fly
                    ;; and doesn't specify a Content-Length, so
@@ -1015,6 +1009,8 @@ default value."
     (#f     #f)
     (locale (false-if-exception (setlocale LC_ALL locale))))
 
+  (set-thread-name "guix substitute")
+
   (with-networking
    (with-error-handling                           ; for signature errors
      (match args
diff --git a/guix/ui.scm b/guix/ui.scm
index 9e0fa26d19..5060fd6dc7 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -38,7 +38,8 @@
   #:use-module (guix serialization)
   #:use-module ((guix build utils) #:select (mkdir-p))
   #:use-module ((guix licenses) #:select (license? license-name))
-  #:use-module ((guix build syscalls) #:select (terminal-columns))
+  #:use-module ((guix build syscalls)
+                #:select (free-disk-space terminal-columns))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-19)
@@ -581,6 +582,17 @@ error."
                   (derivation->output-path derivation out-name)))
                (derivation-outputs derivation))))
 
+(define (check-available-space need)
+  "Make sure at least NEED bytes are available in the store.  Otherwise emit a
+warning."
+  (let ((free (catch 'system-error
+                (lambda ()
+                  (free-disk-space (%store-prefix)))
+                (const #f))))
+    (when (and free (>= need free))
+      (warning (G_ "at least ~,1h MB needed but only ~,1h MB available in ~a~%")
+               (/ need 1e6) (/ free 1e6) (%store-prefix)))))
+
 (define* (show-what-to-build store drv
                              #:key dry-run? (use-substitutes? #t)
                              (mode (build-mode normal)))
@@ -588,7 +600,7 @@ error."
 derivations listed in DRV using MODE, a 'build-mode' value.  Return #t if
 there's something to build, #f otherwise.  When USE-SUBSTITUTES?, check and
 report what is prerequisites are available for download."
-  (define substitutable?
+  (define substitutable-info
     ;; Call 'substitutation-oracle' upfront so we don't end up launching the
     ;; substituter many times.  This makes a big difference, especially when
     ;; DRV is a long list as is the case with 'guix environment'.
@@ -600,7 +612,7 @@ report what is prerequisites are available for download."
     (or (null? (derivation-outputs drv))
         (let ((out (derivation->output-path drv))) ;XXX: assume "out" exists
           (or (valid-path? store out)
-              (substitutable? out)))))
+              (substitutable-info out)))))
 
   (let*-values (((build download)
                  (fold2 (lambda (drv build download)
@@ -608,7 +620,8 @@ report what is prerequisites are available for download."
                                         (derivation-prerequisites-to-build
                                          store drv
                                          #:mode mode
-                                         #:substitutable? substitutable?)))
+                                         #:substitutable-info
+                                         substitutable-info)))
                             (values (append b build)
                                     (append d download))))
                         '() '()
@@ -622,13 +635,26 @@ report what is prerequisites are available for download."
                  (if use-substitutes?
                      (delete-duplicates
                       (append download
-                              (remove (cut valid-path? store <>)
-                                      (append-map
-                                       substitutable-references
-                                       (substitutable-path-info store
-                                                                download)))))
+                              (filter-map (lambda (item)
+                                            (if (valid-path? store item)
+                                                #f
+                                                (substitutable-info item)))
+                                          (append-map
+                                           substitutable-references
+                                           download))))
                      download)))
-    ;; TODO: Show the installed size of DOWNLOAD.
+    (define installed-size
+      (reduce + 0 (map substitutable-nar-size download)))
+
+    (define download-size
+      (/ (reduce + 0 (map substitutable-download-size download))
+         1e6))
+
+    (define display-download-size?
+      ;; Sometimes narinfos lack information about the download size.  Only
+      ;; display when we have information for all of DOWNLOAD.
+      (not (any (compose zero? substitutable-download-size) download)))
+
     (if dry-run?
         (begin
           (format (current-error-port)
@@ -636,22 +662,43 @@ report what is prerequisites are available for download."
                       "~:[The following derivations would be built:~%~{   ~a~%~}~;~]"
                       (length build))
                   (null? build) build)
-          (format (current-error-port)
-                  (N_ "~:[The following file would be downloaded:~%~{   ~a~%~}~;~]"
-                      "~:[The following files would be downloaded:~%~{   ~a~%~}~;~]"
-                      (length download))
-                  (null? download) download))
+          (if display-download-size?
+              (format (current-error-port)
+                      ;; TRANSLATORS: "MB" is for "megabyte"; it should be
+                      ;; translated to the corresponding abbreviation.
+                      (G_ "~:[~,1h MB would be downloaded:~%~{   ~a~%~}~;~]")
+                      (null? download)
+                      download-size
+                      (map substitutable-path download))
+              (format (current-error-port)
+                      (N_ "~:[The following file would be downloaded:~%~{   ~a~%~}~;~]"
+                          "~:[The following files would be downloaded:~%~{   ~a~%~}~;~]"
+                          (length download))
+                      (null? download)
+                      (map substitutable-path download))))
         (begin
           (format (current-error-port)
                   (N_ "~:[The following derivation will be built:~%~{   ~a~%~}~;~]"
                       "~:[The following derivations will be built:~%~{   ~a~%~}~;~]"
                       (length build))
                   (null? build) build)
-          (format (current-error-port)
-                  (N_ "~:[The following file will be downloaded:~%~{   ~a~%~}~;~]"
-                      "~:[The following files will be downloaded:~%~{   ~a~%~}~;~]"
-                      (length download))
-                  (null? download) download)))
+          (if display-download-size?
+              (format (current-error-port)
+                      ;; TRANSLATORS: "MB" is for "megabyte"; it should be
+                      ;; translated to the corresponding abbreviation.
+                      (G_ "~:[~,1h MB will be downloaded:~%~{   ~a~%~}~;~]")
+                      (null? download)
+                      download-size
+                      (map substitutable-path download))
+              (format (current-error-port)
+                      (N_ "~:[The following file will be downloaded:~%~{   ~a~%~}~;~]"
+                          "~:[The following files will be downloaded:~%~{   ~a~%~}~;~]"
+                          (length download))
+                      (null? download)
+                      (map substitutable-path download)))))
+
+    (check-available-space installed-size)
+
     (pair? build)))
 
 (define show-what-to-build*
diff --git a/guix/workers.scm b/guix/workers.scm
index e3452d249a..846f5e50a9 100644
--- a/guix/workers.scm
+++ b/guix/workers.scm
@@ -23,6 +23,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
+  #:use-module ((guix build syscalls) #:select (set-thread-name))
   #:export (pool?
             make-pool
             pool-enqueue!
@@ -60,7 +61,8 @@
     (lambda ()
       (lock-mutex mutex))))
 
-(define (worker-thunk mutex condvar pop-queue)
+(define* (worker-thunk mutex condvar pop-queue
+                       #:key (thread-name "guix worker"))
   "Return the thunk executed by worker threads."
   (define (loop)
     (match (pop-queue)
@@ -80,11 +82,18 @@
     (loop))
 
   (lambda ()
+    (catch 'system-error
+      (lambda ()
+        (set-thread-name thread-name))
+      (const #f))
+
     (with-mutex mutex
       (loop))))
 
-(define* (make-pool #:optional (count (current-processor-count)))
-  "Return a pool of COUNT workers."
+(define* (make-pool #:optional (count (current-processor-count))
+                    #:key (thread-name "guix worker"))
+  "Return a pool of COUNT workers.  Use THREAD-NAME as the name of these
+threads as reported by the operating system."
   (let* ((mutex   (make-mutex))
          (condvar (make-condition-variable))
          (queue   (make-q))
@@ -93,7 +102,8 @@
                             (worker-thunk mutex condvar
                                           (lambda ()
                                             (and (not (q-empty? queue))
-                                                 (q-pop! queue)))))
+                                                 (q-pop! queue)))
+                                          #:thread-name thread-name))
                           1+
                           0))
          (threads (map (lambda (proc)