Merge branch 'master' into core-updates

23 files changed, 596 insertions, 259 deletions

diff --git a/guix/build-system/scons.scm b/guix/build-system/scons.scm
new file mode 100644
index 0000000000..da09cc7ded
--- /dev/null
+++ b/guix/build-system/scons.scm
@@ -0,0 +1,134 @@
+;;; 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 scons)
+  #: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 (%scons-build-system-modules
+            scons-build
+            scons-build-system))
+
+;; Commentary:
+;;
+;; Standard build procedure for applications using SCons. This is implemented
+;; as an extension of 'gnu-build-system'.
+;;
+;; Code:
+
+(define %scons-build-system-modules
+  ;; Build-side modules imported by default.
+  `((guix build scons-build-system)
+    ,@%gnu-build-system-modules))
+
+(define (default-scons)
+  "Return the default SCons package."
+  ;; Lazily resolve the binding to avoid a circular dependency.
+  (let ((python (resolve-interface '(gnu packages python))))
+    (module-ref python 'scons)))
+
+(define* (lower name
+                #:key source inputs native-inputs outputs system target
+                (scons (default-scons))
+                #:allow-other-keys
+                #:rest arguments)
+  "Return a bag for NAME."
+  (define private-keywords
+    '(#:source #:target #:scons #:inputs #:native-inputs))
+
+  (and (not target)                               ;XXX: no cross-compilation
+       (bag
+         (name name)
+         (system system)
+         (host-inputs `(,@(if source
+                              `(("source" ,source))
+                              '())
+                        ,@inputs
+
+                        ;; Keep the standard inputs of 'gnu-build-system'.
+                        ,@(standard-packages)))
+         (build-inputs `(("scons" ,scons)
+                         ,@native-inputs))
+         (outputs outputs)
+         (build scons-build)
+         (arguments (strip-keyword-arguments private-keywords arguments)))))
+
+(define* (scons-build store name inputs
+                      #:key
+                      (tests? #t)
+                      (scons-flags ''())
+                      (test-target "test")
+                      (phases '(@ (guix build scons-build-system)
+                                  %standard-phases))
+                      (outputs '("out"))
+                      (search-paths '())
+                      (system (%current-system))
+                      (guile #f)
+                      (imported-modules %scons-build-system-modules)
+                      (modules '((guix build scons-build-system)
+                                 (guix build utils))))
+  "Build SOURCE using SCons, and with INPUTS.  This assumes that SOURCE
+provides a 'SConstruct' file as its build system."
+  (define builder
+    `(begin
+       (use-modules ,@modules)
+       (scons-build #:name ,name
+                    #:source ,(match (assoc-ref inputs "source")
+                                (((? derivation? source))
+                                 (derivation->output-path source))
+                                ((source)
+                                 source)
+                                (source
+                                 source))
+                    #:scons-flags ,scons-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 scons-build-system
+  (build-system
+    (name 'scons)
+    (description "The standard SCons build system")
+    (lower lower)))
+
+;;; scons.scm ends here
diff --git a/guix/build/compile.scm b/guix/build/compile.scm
index 8b5a2faf84..1bd8c60fe5 100644
--- a/guix/build/compile.scm
+++ b/guix/build/compile.scm
@@ -163,7 +163,11 @@ files are for HOST, a GNU triplet such as \"x86_64-linux-gnu\"."
       ;; compile files in parallel.
       (compile #f)
 
-      (n-par-for-each workers build files)
+      ;; XXX: Don't use too many workers to work around the insane memory
+      ;; requirements of the compiler in Guile 2.2.2:
+      ;; <https://lists.gnu.org/archive/html/guile-devel/2017-05/msg00033.html>.
+      (n-par-for-each (min workers 8) build files)
+
       (unless (zero? total)
         (report-compilation #f total total)))))
 
diff --git a/guix/build/profiles.scm b/guix/build/profiles.scm
index 5c96fe9067..b4160fba1b 100644
--- a/guix/build/profiles.scm
+++ b/guix/build/profiles.scm
@@ -82,7 +82,7 @@ definitions for all the SEARCH-PATHS."
 # for this profile.  You may want to define the 'GUIX_PROFILE' environment
 # variable to point to the \"visible\" name of the profile, like this:
 #
-#  GUIX_PROFILE=/path/to/profile \\
+#  GUIX_PROFILE=/path/to/profile ; \\
 #  source /path/to/profile/etc/profile
 #
 # When GUIX_PROFILE is undefined, the various environment variables refer
diff --git a/guix/build/scons-build-system.scm b/guix/build/scons-build-system.scm
new file mode 100644
index 0000000000..a8760968d8
--- /dev/null
+++ b/guix/build/scons-build-system.scm
@@ -0,0 +1,65 @@
+;;; 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 scons-build-system)
+  #:use-module ((guix build gnu-build-system) #:prefix gnu:)
+  #:use-module (guix build utils)
+  #:export (%standard-phases
+            scons-build))
+
+;; Commentary:
+;;
+;; Builder-side code of the SCons build system.
+;;
+;; Code:
+
+(define* (build #:key outputs (scons-flags '()) (parallel-build? #t) #:allow-other-keys)
+  (let ((out (assoc-ref outputs "out")))
+    (mkdir-p out)
+    (zero? (apply system* "scons"
+                  (append (if parallel-build?
+                              (list "-j" (number->string
+                                          (parallel-job-count)))
+                              (list))
+                          scons-flags)))))
+
+(define* (check #:key tests? test-target (scons-flags '()) #:allow-other-keys)
+  "Run the test suite of a given SCons application."
+  (cond (tests?
+         (zero? (apply system* "scons" test-target scons-flags)))
+        (else
+         (format #t "test suite not run~%")
+         #t)))
+
+(define* (install #:key outputs (scons-flags '()) #:allow-other-keys)
+  "Install a given SCons application."
+  (zero? (apply system* "scons" "install" scons-flags)))
+
+(define %standard-phases
+  (modify-phases gnu:%standard-phases
+    (delete 'configure)
+    (replace 'build build)
+    (replace 'check check)
+    (replace 'install install)))
+
+(define* (scons-build #:key inputs (phases %standard-phases)
+                       #:allow-other-keys #:rest args)
+  "Build a given SCons application, applying all of PHASES in order."
+  (apply gnu:gnu-build #:inputs inputs #:phases phases args))
+
+;;; scons-build-system.scm ends here
diff --git a/guix/build/union.scm b/guix/build/union.scm
index 18167fa3e3..256123c566 100644
--- a/guix/build/union.scm
+++ b/guix/build/union.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com>
 ;;;
@@ -78,11 +78,12 @@ identical, #f otherwise."
 
 (define* (union-build output inputs
                       #:key (log-port (current-error-port))
-                      (create-all-directories? #f))
+                      (create-all-directories? #f)
+                      (symlink symlink))
   "Build in the OUTPUT directory a symlink tree that is the union of all the
-INPUTS.  As a special case, if CREATE-ALL-DIRECTORIES?, creates the
-subdirectories in the output directory to make sure the caller can modify them
-later."
+INPUTS, using SYMLINK to create symlinks.  As a special case, if
+CREATE-ALL-DIRECTORIES?, creates the subdirectories in the output directory to
+make sure the caller can modify them later."
 
   (define (symlink* input output)
     (format log-port "`~a' ~~> `~a'~%" input output)
diff --git a/guix/gexp.scm b/guix/gexp.scm
index b9525603ee..1929947d95 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -564,6 +564,7 @@ names and file names suitable for the #:allowed-references argument to
                            allowed-references disallowed-references
                            leaked-env-vars
                            local-build? (substitutable? #t)
+                           deprecation-warnings
                            (script-name (string-append name "-builder")))
   "Return a derivation NAME that runs EXP (a gexp) with GUILE-FOR-BUILD (a
 derivation) on SYSTEM; EXP is stored in a file called SCRIPT-NAME.  When
@@ -599,6 +600,9 @@ refer to.  Any reference to another store item will lead to a build error.
 Similarly for DISALLOWED-REFERENCES, which can list items that must not be
 referenced by the outputs.
 
+DEPRECATION-WARNINGS determines whether to show deprecation warnings while
+compiling modules.  It can be #f, #t, or 'detailed.
+
 The other arguments are as for 'derivation'."
   (define %modules
     (delete-duplicates
@@ -648,7 +652,9 @@ The other arguments are as for 'derivation'."
                                      (compiled-modules %modules
                                                        #:system system
                                                        #:module-path module-path
-                                                       #:guile guile-for-build)
+                                                       #:guile guile-for-build
+                                                       #:deprecation-warnings
+                                                       deprecation-warnings)
                                      (return #f)))
                        (graphs   (if references-graphs
                                      (lower-reference-graphs references-graphs
@@ -1023,7 +1029,8 @@ last one is created from the given <scheme-file> object."
                            #:key (name "module-import-compiled")
                            (system (%current-system))
                            (guile (%guile-for-build))
-                           (module-path %load-path))
+                           (module-path %load-path)
+                           (deprecation-warnings #f))
   "Return a derivation that builds a tree containing the `.go' files
 corresponding to MODULES.  All the MODULES are built in a context where
 they can refer to each other."
@@ -1073,7 +1080,15 @@ they can refer to each other."
     (gexp->derivation name build
                       #:system system
                       #:guile-for-build guile
-                      #:local-build? #t)))
+                      #:local-build? #t
+                      #:env-vars
+                      (case deprecation-warnings
+                        ((#f)
+                         '(("GUILE_WARN_DEPRECATED" . "no")))
+                        ((detailed)
+                         '(("GUILE_WARN_DEPRECATED" . "detailed")))
+                        (else
+                         '())))))
 
 
 ;;;
@@ -1081,10 +1096,12 @@ they can refer to each other."
 ;;;
 
 (define (default-guile)
-  ;; Lazily resolve 'guile-final'.  This module must not refer to (gnu …)
+  ;; Lazily resolve 'guile-2.2' (not 'guile-final' because this is for
+  ;; programs returned by 'program-file' and we don't want to keep references
+  ;; to several Guile packages).  This module must not refer to (gnu …)
   ;; modules directly, to avoid circular dependencies, hence this hack.
-  (module-ref (resolve-interface '(gnu packages commencement))
-              'guile-final))
+  (module-ref (resolve-interface '(gnu packages guile))
+              'guile-2.2))
 
 (define (load-path-expression modules)
   "Return as a monadic value a gexp that sets '%load-path' and
@@ -1204,13 +1221,30 @@ This yields an 'etc' directory containing these two files."
                                          (ungexp target))))))
                           files))))))
 
-(define (directory-union name things)
+(define* (directory-union name things
+                          #:key (copy? #f) (quiet? #f))
   "Return a directory that is the union of THINGS, where THINGS is a list of
 file-like objects denoting directories.  For example:
 
   (directory-union \"guile+emacs\" (list guile emacs))
 
-yields a directory that is the union of the 'guile' and 'emacs' packages."
+yields a directory that is the union of the 'guile' and 'emacs' packages.
+
+When HARD-LINKS? is true, create hard links instead of symlinks.  When QUIET?
+is true, the derivation will not print anything."
+  (define symlink
+    (if copy?
+        (gexp (lambda (old new)
+                (if (file-is-directory? old)
+                    (symlink old new)
+                    (copy-file old new))))
+        (gexp symlink)))
+
+  (define log-port
+    (if quiet?
+        (gexp (%make-void-port "w"))
+        (gexp (current-error-port))))
+
   (match things
     ((one)
      ;; Only one thing; return it.
@@ -1221,7 +1255,10 @@ yields a directory that is the union of the 'guile' and 'emacs' packages."
                       (gexp (begin
                               (use-modules (guix build union))
                               (union-build (ungexp output)
-                                           '(ungexp things)))))))))
+                                           '(ungexp things)
+
+                                           #:log-port (ungexp log-port)
+                                           #:symlink (ungexp symlink)))))))))
 
 
 ;;;
diff --git a/guix/git.scm b/guix/git.scm
index 7a83b56216..fc41e2ace3 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -80,11 +80,17 @@ of SHA1 string."
    "-" (string-take sha1 7)))
 
 (define* (copy-to-store store cache-directory #:key url repository)
-  "Copy items in cache-directory to store.  URL and REPOSITORY are used
-to forge store directory name."
+  "Copy CACHE-DIRECTORY recursively to STORE.  URL and REPOSITORY are used to
+create the store directory name."
+  (define (dot-git? file stat)
+    (and (string=? (basename file) ".git")
+         (eq? 'directory (stat:type stat))))
+
   (let* ((commit (repository->head-sha1 repository))
          (name   (url+commit->name url commit)))
-    (values (add-to-store store name #t "sha256" cache-directory) commit)))
+    (values (add-to-store store name #t "sha256" cache-directory
+                          #:select? (negate dot-git?))
+            commit)))
 
 (define (switch-to-ref repository ref)
   "Switch to REPOSITORY's branch, commit or tag specified by REF."
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 0de36f2f71..00e80bc79f 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -335,9 +335,6 @@ return the corresponding signature URL, or #f it signatures are unavailable."
     (if (version>? (upstream-source-version a) (upstream-source-version b))
         a b))
 
-  (define contains-digit?
-    (cut string-any char-set:digit <>))
-
   (define patch-directory-name?
     ;; Return #t for patch directory names such as 'bash-4.2-patches'.
     (cut string-suffix? "patches" <>))
@@ -361,8 +358,7 @@ return the corresponding signature URL, or #f it signatures are unavailable."
              (result    #f))
     (let* ((entries (ftp-list conn directory))
 
-           ;; Filter out sub-directories that do not contain digits---e.g.,
-           ;; /gnuzilla/lang and /gnupg/patches.  Filter out "w32"
+           ;; Filter out things like /gnupg/patches.  Filter out "w32"
            ;; directories as found on ftp.gnutls.org.
            (subdirs (filter-map (match-lambda
                                   (((? patch-directory-name? dir)
@@ -370,8 +366,8 @@ return the corresponding signature URL, or #f it signatures are unavailable."
                                    #f)
                                   (("w32" 'directory . _)
                                    #f)
-                                  (((? contains-digit? dir) 'directory . _)
-                                   (and (keep-file? dir) dir))
+                                  ((directory 'directory . _)
+                                   directory)
                                   (_ #f))
                                 entries))
 
diff --git a/guix/packages.scm b/guix/packages.scm
index 35f9b685a3..d3f3cf0fdd 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -609,6 +609,7 @@ specifies modules in scope when evaluating SNIPPET."
       (gexp->derivation name build
                         #:graft? #f
                         #:system system
+                        #:deprecation-warnings #t ;to avoid a rebuild
                         #:guile-for-build guile-for-build))))
 
 (define (transitive-inputs inputs)
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 51c330b323..07fe2faa3c 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1118,82 +1118,80 @@ the entries in MANIFEST."
     (module-ref (resolve-interface '(gnu packages man)) 'man-db))
 
   (define build
-    #~(begin
-        (use-modules (guix build utils)
-                     (srfi srfi-1)
-                     (srfi srfi-19)
-                     (srfi srfi-26))
-
-        (define entries
-          (filter-map (lambda (directory)
-                        (let ((man (string-append directory "/share/man")))
-                          (and (directory-exists? man)
-                               man)))
-                      '#$(manifest-inputs manifest)))
-
-        (define manpages-collection-dir
-          (string-append (getenv "PWD") "/manpages-collection"))
-
-        (define man-directory
-          (string-append #$output "/share/man"))
-
-        (define (get-manpage-tail-path manpage-path)
-          (let ((index (string-contains manpage-path "/share/man/")))
-            (unless index
-              (error "Manual path doesn't contain \"/share/man/\":"
-                     manpage-path))
-            (string-drop manpage-path (+ index (string-length "/share/man/")))))
-
-        (define (populate-manpages-collection-dir entries)
-          (let ((manpages (append-map (cut find-files <> #:stat stat) entries)))
-            (for-each (lambda (manpage)
-                        (let* ((dest-file (string-append
-                                           manpages-collection-dir "/"
-                                           (get-manpage-tail-path manpage))))
-                          (mkdir-p (dirname dest-file))
-                          (catch 'system-error
-                            (lambda ()
-                              (symlink manpage dest-file))
-                            (lambda args
-                              ;; Different packages may contain the same
-                              ;; manpage.  Simply ignore the symlink error.
-                              #t))))
-                      manpages)))
-
-        (mkdir-p manpages-collection-dir)
-        (populate-manpages-collection-dir entries)
-
-        ;; Create a mandb config file which contains a custom made
-        ;; manpath. The associated catpath is the location where the database
-        ;; gets generated.
-        (copy-file #+(file-append man-db "/etc/man_db.conf")
-                   "man_db.conf")
-        (substitute* "man_db.conf"
-          (("MANDB_MAP	/usr/man		/var/cache/man/fsstnd")
-           (string-append "MANDB_MAP " manpages-collection-dir " "
-                          man-directory)))
-
-        (mkdir-p man-directory)
-        (setenv "MANPATH" (string-join entries ":"))
-
-        (format #t "Creating manual page database for ~a packages... "
-                (length entries))
-        (force-output)
-        (let* ((start-time (current-time))
-               (exit-status (system* #+(file-append man-db "/bin/mandb")
-                                    "--quiet" "--create"
-                                    "-C" "man_db.conf"))
-               (duration (time-difference (current-time) start-time)))
-          (format #t "done in ~,3f s~%"
-                  (+ (time-second duration)
-                     (* (time-nanosecond duration) (expt 10 -9))))
+    (with-imported-modules '((guix build utils))
+      #~(begin
+          (use-modules (guix build utils)
+                       (srfi srfi-1)
+                       (srfi srfi-19)
+                       (srfi srfi-26))
+
+          (define entries
+            (filter-map (lambda (directory)
+                          (let ((man (string-append directory "/share/man")))
+                            (and (directory-exists? man)
+                                 man)))
+                        '#$(manifest-inputs manifest)))
+
+          (define manpages-collection-dir
+            (string-append (getenv "PWD") "/manpages-collection"))
+
+          (define man-directory
+            (string-append #$output "/share/man"))
+
+          (define (get-manpage-tail-path manpage-path)
+            (let ((index (string-contains manpage-path "/share/man/")))
+              (unless index
+                (error "Manual path doesn't contain \"/share/man/\":"
+                       manpage-path))
+              (string-drop manpage-path (+ index (string-length "/share/man/")))))
+
+          (define (populate-manpages-collection-dir entries)
+            (let ((manpages (append-map (cut find-files <> #:stat stat) entries)))
+              (for-each (lambda (manpage)
+                          (let* ((dest-file (string-append
+                                             manpages-collection-dir "/"
+                                             (get-manpage-tail-path manpage))))
+                            (mkdir-p (dirname dest-file))
+                            (catch 'system-error
+                              (lambda ()
+                                (symlink manpage dest-file))
+                              (lambda args
+                                ;; Different packages may contain the same
+                                ;; manpage.  Simply ignore the symlink error.
+                                #t))))
+                        manpages)))
+
+          (mkdir-p manpages-collection-dir)
+          (populate-manpages-collection-dir entries)
+
+          ;; Create a mandb config file which contains a custom made
+          ;; manpath. The associated catpath is the location where the database
+          ;; gets generated.
+          (copy-file #+(file-append man-db "/etc/man_db.conf")
+                     "man_db.conf")
+          (substitute* "man_db.conf"
+            (("MANDB_MAP	/usr/man		/var/cache/man/fsstnd")
+             (string-append "MANDB_MAP " manpages-collection-dir " "
+                            man-directory)))
+
+          (mkdir-p man-directory)
+          (setenv "MANPATH" (string-join entries ":"))
+
+          (format #t "Creating manual page database for ~a packages... "
+                  (length entries))
           (force-output)
-          (zero? exit-status))))
+          (let* ((start-time (current-time))
+                 (exit-status (system* #+(file-append man-db "/bin/mandb")
+                                       "--quiet" "--create"
+                                       "-C" "man_db.conf"))
+                 (duration (time-difference (current-time) start-time)))
+            (format #t "done in ~,3f s~%"
+                    (+ (time-second duration)
+                       (* (time-nanosecond duration) (expt 10 -9))))
+            (force-output)
+            (zero? exit-status)))))
 
   (gexp->derivation "manual-database" build
-                    #:modules '((guix build utils)
-                                (srfi srfi-19)
-                                (srfi srfi-26))
                     #:local-build? #t))
 
 (define %default-profile-hooks
@@ -1294,6 +1292,9 @@ are cross-built for TARGET."
                       #:system system
                       #:target target
 
+                      ;; Don't complain about _IO* on Guile 2.2.
+                      #:env-vars '(("GUILE_WARN_DEPRECATED" . "no"))
+
                       ;; Not worth offloading.
                       #:local-build? #t
 
diff --git a/guix/progress.scm b/guix/progress.scm
index beca2c22a6..0ca5c08782 100644
--- a/guix/progress.scm
+++ b/guix/progress.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Sou Bunnbu <iyzsong@gmail.com>
 ;;; Copyright © 2015 Steve Sprang <scs@stevesprang.com>
+;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -30,8 +31,13 @@
             progress-reporter?
             call-with-progress-reporter
 
+            start-progress-reporter!
+            stop-progress-reporter!
+            progress-reporter-report!
+
             progress-reporter/silent
             progress-reporter/file
+            progress-reporter/bar
 
             byte-count->string
             current-terminal-columns
@@ -58,6 +64,24 @@ stopped."
     (($ <progress-reporter> start report stop)
      (dynamic-wind start (lambda () (proc report)) stop))))
 
+(define (start-progress-reporter! reporter)
+  "Low-level procedure to start REPORTER."
+  (match reporter
+    (($ <progress-reporter> start report stop)
+     (start))))
+
+(define (progress-reporter-report! reporter)
+  "Low-level procedure to lead REPORTER to emit a report."
+  (match reporter
+    (($ <progress-reporter> start report stop)
+     (report))))
+
+(define (stop-progress-reporter! reporter)
+  "Low-level procedure to stop REPORTER."
+  (match reporter
+    (($ <progress-reporter> start report stop)
+     (stop))))
+
 (define progress-reporter/silent
   (make-progress-reporter noop noop noop))
 
@@ -146,13 +170,19 @@ INTERVAL (a time-duration object), otherwise does nothing and returns #f."
 (define* (progress-bar % #:optional (bar-width 20))
   "Return % as a string representing an ASCII-art progress bar.  The total
 width of the bar is BAR-WIDTH."
-  (let* ((fraction (/ % 100))
+  (let* ((bar-width (max 3 (- bar-width 2)))
+         (fraction (/ % 100))
          (filled   (inexact->exact (floor (* fraction bar-width))))
          (empty    (- bar-width filled)))
     (format #f "[~a~a]"
             (make-string filled #\#)
             (make-string empty #\space))))
 
+(define (erase-in-line port)
+  "Write an ANSI erase-in-line sequence to PORT to erase the whole line and
+move the cursor to the beginning of the line."
+  (display "\r\x1b[K" port))
+
 (define* (progress-reporter/file file size
                                  #:optional (log-port (current-output-port))
                                  #:key (abbreviation basename))
@@ -176,7 +206,7 @@ ABBREVIATION used to shorten FILE for display."
                                      (byte-count->string throughput)
                                      (seconds->string elapsed)
                                      (progress-bar %) %)))
-            (display "\r\x1b[K" log-port)
+            (erase-in-line log-port)
             (display (string-pad-middle left right
                                         (current-terminal-columns))
                      log-port)
@@ -188,7 +218,7 @@ ABBREVIATION used to shorten FILE for display."
                                      (byte-count->string throughput)
                                      (seconds->string elapsed)
                                      (byte-count->string transferred))))
-            (display "\r\x1b[K" log-port)
+            (erase-in-line log-port)
             (display (string-pad-middle left right
                                         (current-terminal-columns))
                      log-port)
@@ -206,6 +236,39 @@ ABBREVIATION used to shorten FILE for display."
      ;; Don't miss the last report.
      (stop render))))
 
+(define* (progress-reporter/bar total
+                                #:optional
+                                (prefix "")
+                                (port (current-error-port)))
+  "Return a reporter that shows a progress bar every time one of the TOTAL
+tasks is performed.  Write PREFIX at the beginning of the line."
+  (define done 0)
+
+  (define (report-progress)
+    (set! done (+ 1 done))
+    (unless (> done total)
+      (let* ((ratio (* 100. (/ done total))))
+        (erase-in-line port)
+        (if (string-null? prefix)
+            (display (progress-bar ratio (current-terminal-columns)) port)
+            (let ((width (- (current-terminal-columns)
+                            (string-length prefix) 3)))
+              (display prefix port)
+              (display "  " port)
+              (display (progress-bar ratio width) port)))
+        (force-output port))))
+
+  (progress-reporter
+   (start (lambda ()
+            (set! done 0)))
+   (report report-progress)
+   (stop (lambda ()
+           (erase-in-line port)
+           (unless (string-null? prefix)
+             (display prefix port)
+             (newline port))
+           (force-output port)))))
+
 ;; TODO: replace '(@ (guix build utils) dump-port))'.
 (define* (dump-port* in out
                      #:key (buffer-size 16384)
diff --git a/guix/records.scm b/guix/records.scm
index 1f00e16603..c02395f2ae 100644
--- a/guix/records.scm
+++ b/guix/records.scm
@@ -81,7 +81,7 @@ fields, and DELAYED is the list of identifiers of delayed fields."
                (record-error 'name s "extraneous field initializers ~a"
                              unexpected)))
 
-           #`(make-struct type 0
+           #`(make-struct/no-tail type
                           #,@(map (lambda (field index)
                                     (or (field-inherited-value field)
                                         (if (innate-field? field)
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 0d69218338..e1b7feecfa 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -586,7 +586,7 @@ message if any test fails."
                          store
                          (if bootstrap?
                              %bootstrap-guile
-                             (canonical-package guile-2.0)))))
+                             (canonical-package guile-2.2)))))
           (run-with-store store
             ;; Containers need a Bourne shell at /bin/sh.
             (mlet* %store-monad ((bash       (environment-bash container?
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 8840b1acb5..1b43b0a63c 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -587,24 +587,49 @@ from ~a")
                                     (package-home-page package))
                     'home-page)))))
 
+(define %distro-directory
+  (dirname (search-path %load-path "gnu.scm")))
+
 (define (check-patch-file-names package)
   "Emit a warning if the patches requires by PACKAGE are badly named or if the
 patch could not be found."
   (guard (c ((message-condition? c)     ;raised by 'search-patch'
              (emit-warning package (condition-message c)
                            'patch-file-names)))
+    (define patches
+      (or (and=> (package-source package) origin-patches)
+          '()))
+
     (unless (every (match-lambda        ;patch starts with package name?
                      ((? string? patch)
                       (and=> (string-contains (basename patch)
                                               (package-name package))
                              zero?))
                      (_  #f))     ;must be an <origin> or something like that.
-                   (or (and=> (package-source package) origin-patches)
-                       '()))
+                   patches)
       (emit-warning
        package
        (G_ "file names of patches should start with the package name")
-       'patch-file-names))))
+       'patch-file-names))
+
+    ;; Check whether we're reaching tar's maximum file name length.
+    (let ((prefix (string-length %distro-directory))
+          (margin (string-length "guix-0.13.0-10-123456789/"))
+          (max    99))
+      (for-each (match-lambda
+                  ((? string? patch)
+                   (when (> (+ margin (if (string-prefix? %distro-directory
+                                                          patch)
+                                          (- (string-length patch) prefix)
+                                          (string-length patch)))
+                            max)
+                     (emit-warning
+                      package
+                      (format #f (G_ "~a: file name is too long")
+                              (basename patch))
+                      'patch-file-names)))
+                  (_ #f))
+                patches))))
 
 (define (escape-quotes str)
   "Replace any quote character in STR by an escaped quote character."
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index 6a2485a007..ebd0bf783d 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -118,7 +118,7 @@ determined."
   (catch #t
     (lambda ()
       ;; Avoid ABI incompatibility with the <build-machine> record.
-      (set! %fresh-auto-compile #t)
+      ;; (set! %fresh-auto-compile #t)
 
       (save-module-excursion
        (lambda ()
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index f972ca2ef7..0a4a07ae2a 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -49,7 +49,7 @@
   #:use-module (srfi srfi-37)
   #:use-module (gnu packages)
   #:autoload   (gnu packages base) (canonical-package)
-  #:autoload   (gnu packages guile) (guile-2.0)
+  #:autoload   (gnu packages guile) (guile-2.2)
   #:autoload   (gnu packages bootstrap) (%bootstrap-guile)
   #:export (build-and-use-profile
             delete-generations
@@ -918,5 +918,5 @@ processed, #f otherwise."
                              (%store)
                              (if (assoc-ref opts 'bootstrap?)
                                  %bootstrap-guile
-                                 (canonical-package guile-2.0)))))
+                                 (canonical-package guile-2.2)))))
               (process-actions (%store) opts)))))))
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 2400198000..be0c168444 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -25,7 +25,6 @@
   #:use-module (guix config)
   #:use-module (guix packages)
   #:use-module (guix derivations)
-  #:use-module (guix download)
   #:use-module (guix gexp)
   #:use-module (guix grafts)
   #:use-module (guix monads)
@@ -39,14 +38,9 @@
   #:use-module ((gnu packages bootstrap)
                 #:select (%bootstrap-guile))
   #:use-module ((gnu packages certs) #:select (le-certs))
-  #:use-module (gnu packages compression)
-  #:use-module (gnu packages gnupg)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
-  #:use-module (srfi srfi-34)
-  #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-37)
-  #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
   #:export (guix-pull))
 
@@ -281,7 +275,7 @@ certificates~%"))
                                 store
                                 (if (assoc-ref opts 'bootstrap?)
                                     %bootstrap-guile
-                                    (canonical-package guile-2.0)))))
+                                    (canonical-package guile-2.2)))))
                  (run-with-store store
                    (build-and-install checkout (config-directory)
                                       #:commit commit
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index e50f1d8ac7..e2ff42693f 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -36,6 +36,8 @@
   #:use-module (guix graph)
   #:use-module (guix scripts graph)
   #:use-module (guix build utils)
+  #:use-module (guix progress)
+  #:use-module ((guix build syscalls) #:select (terminal-columns))
   #:use-module (gnu build install)
   #:autoload   (gnu build file-systems)
                  (find-partition-by-label find-partition-by-uuid)
@@ -107,47 +109,54 @@ BODY..., and restore them."
   (store-lift topologically-sorted))
 
 
-(define* (copy-item item target
+(define* (copy-item item references target
                     #:key (log-port (current-error-port)))
-  "Copy ITEM to the store under root directory TARGET and register it."
-  (mlet* %store-monad ((refs (references* item)))
-    (let ((dest  (string-append target item))
-          (state (string-append target "/var/guix")))
-      (format log-port "copying '~a'...~%" item)
-
-      ;; Remove DEST if it exists to make sure that (1) we do not fail badly
-      ;; while trying to overwrite it (see <http://bugs.gnu.org/20722>), and
-      ;; (2) we end up with the right contents.
-      (when (file-exists? dest)
-        (delete-file-recursively dest))
-
-      (copy-recursively item dest
-                        #:log (%make-void-port "w"))
-
-      ;; Register ITEM; as a side-effect, it resets timestamps, etc.
-      ;; Explicitly use "TARGET/var/guix" as the state directory, to avoid
-      ;; reproducing the user's current settings; see
-      ;; <http://bugs.gnu.org/18049>.
-      (unless (register-path item
-                             #:prefix target
-                             #:state-directory state
-                             #:references refs)
-        (leave (G_ "failed to register '~a' under '~a'~%")
-               item target))
-
-      (return #t))))
+  "Copy ITEM to the store under root directory TARGET and register it with
+REFERENCES as its set of references."
+  (let ((dest  (string-append target item))
+        (state (string-append target "/var/guix")))
+    (format log-port "copying '~a'...~%" item)
+
+    ;; Remove DEST if it exists to make sure that (1) we do not fail badly
+    ;; while trying to overwrite it (see <http://bugs.gnu.org/20722>), and
+    ;; (2) we end up with the right contents.
+    (when (file-exists? dest)
+      (delete-file-recursively dest))
+
+    (copy-recursively item dest
+                      #:log (%make-void-port "w"))
+
+    ;; Register ITEM; as a side-effect, it resets timestamps, etc.
+    ;; Explicitly use "TARGET/var/guix" as the state directory, to avoid
+    ;; reproducing the user's current settings; see
+    ;; <http://bugs.gnu.org/18049>.
+    (unless (register-path item
+                           #:prefix target
+                           #:state-directory state
+                           #:references references)
+      (leave (G_ "failed to register '~a' under '~a'~%")
+             item target))))
 
 (define* (copy-closure item target
                        #:key (log-port (current-error-port)))
   "Copy ITEM and all its dependencies to the store under root directory
 TARGET, and register them."
-  (mlet* %store-monad ((refs    (references* item))
-                       (to-copy (topologically-sorted*
-                                 (delete-duplicates (cons item refs)
-                                                    string=?))))
-    (sequence %store-monad
-              (map (cut copy-item <> target #:log-port log-port)
-                   to-copy))))
+  (mlet* %store-monad ((to-copy (topologically-sorted* (list item)))
+                       (refs    (mapm %store-monad references* to-copy)))
+    (define progress-bar
+      (progress-reporter/bar (length to-copy)
+                             (format #f (G_ "copying to '~a'...")
+                                     target)))
+
+    (call-with-progress-reporter progress-bar
+      (lambda (report)
+        (let ((void (%make-void-port "w")))
+          (for-each (lambda (item refs)
+                      (copy-item item refs target #:log-port void)
+                      (report))
+                    to-copy refs))))
+
+    (return *unspecified*)))
 
 (define* (install-bootloader installer-drv
                              #:key
@@ -667,7 +676,8 @@ and TARGET arguments."
     (gexp->file "bootloader-installer"
                 (with-imported-modules '((guix build utils))
                   #~(begin
-                      (use-modules (guix build utils))
+                      (use-modules (guix build utils)
+                                   (ice-9 binary-ports))
                       (#$installer #$bootloader #$device #$target))))))
 
 (define* (perform-action action os
@@ -1095,7 +1105,8 @@ argument list and OPTS is the option alist."
                                          parse-sub-command))
            (args     (option-arguments opts))
            (command  (assoc-ref opts 'action)))
-      (parameterize ((%graft? (assoc-ref opts 'graft?)))
+      (parameterize ((%graft? (assoc-ref opts 'graft?))
+                     (current-terminal-columns (terminal-columns)))
         (process-command command args opts)))))
 
 ;;; Local Variables:
diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm
index 0d4a7fa26b..2e782e36ce 100644
--- a/guix/scripts/weather.scm
+++ b/guix/scripts/weather.scm
@@ -23,10 +23,11 @@
   #:use-module (guix packages)
   #:use-module (guix profiles)
   #:use-module (guix derivations)
+  #:use-module (guix progress)
   #:use-module (guix monads)
   #:use-module (guix store)
   #:use-module (guix grafts)
-  #:use-module (guix build syscalls)
+  #:use-module ((guix build syscalls) #:select (terminal-columns))
   #:use-module (guix scripts substitute)
   #:use-module (gnu packages)
   #:use-module (web uri)
@@ -48,42 +49,38 @@
                       (cons package result))))
                  '()))
 
+(define (call-with-progress-reporter reporter proc)
+  "This is a variant of 'call-with-progress-reporter' that works with monadic
+scope."
+  ;; TODO: Move to a more appropriate place.
+  (with-monad %store-monad
+    (start-progress-reporter! reporter)
+    (mlet* %store-monad ((report -> (lambda ()
+                                      (progress-reporter-report! reporter)))
+                         (result (proc report)))
+      (stop-progress-reporter! reporter)
+      (return result))))
+
 (define* (package-outputs packages
                           #:optional (system (%current-system)))
   "Return the list of outputs of all of PACKAGES for the given SYSTEM."
   (let ((packages (filter (cut supported-package? <> system) packages)))
-
-    (define update-progress!
-      (let ((total (length packages))
-            (done  0)
-            (width (max 10 (- (terminal-columns) 10))))
-        (lambda ()
-          (set! done (+ 1 done))
-          (let* ((ratio (/ done total 1.))
-                 (done  (inexact->exact (round (* width ratio))))
-                 (left  (- width done)))
-            (format (current-error-port) "~5,1f% [~a~a]\r"
-                    (* ratio 100.)
-                    (make-string done #\#)
-                    (make-string left #\space))
-            (when (>= done total)
-              (newline (current-error-port)))
-            (force-output (current-error-port))))))
-
     (format (current-error-port)
             (G_ "computing ~h package derivations for ~a...~%")
             (length packages) system)
 
-    (foldm %store-monad
-           (lambda (package result)
-             (mlet %store-monad ((drv (package->derivation package system
-                                                           #:graft? #f)))
-               (update-progress!)
-               (match (derivation->output-paths drv)
-                 (((names . items) ...)
-                  (return (append items result))))))
-           '()
-           packages)))
+    (call-with-progress-reporter (progress-reporter/bar (length packages))
+      (lambda (report)
+        (foldm %store-monad
+               (lambda (package result)
+                 (mlet %store-monad ((drv (package->derivation package system
+                                                               #:graft? #f)))
+                   (report)
+                   (match (derivation->output-paths drv)
+                     (((names . items) ...)
+                      (return (append items result))))))
+               '()
+               packages)))))
 
 (cond-expand
   (guile-2.2
@@ -204,31 +201,32 @@ Report the availability of substitutes.\n"))
 
 (define (guix-weather . args)
   (with-error-handling
-    (let* ((opts     (parse-command-line args %options
-                                         (list %default-options)
-                                         #:build-options? #f))
-           (urls     (assoc-ref opts 'substitute-urls))
-           (systems  (match (filter-map (match-lambda
-                                          (('system . system) system)
-                                          (_ #f))
-                                        opts)
-                       (() (list (%current-system)))
-                       (systems systems)))
-           (packages (let ((file (assoc-ref opts 'manifest)))
-                       (if file
-                           (load-manifest file)
-                           (all-packages))))
-           (items    (with-store store
-                       (parameterize ((%graft? #f))
-                         (concatenate
-                          (run-with-store store
-                            (mapm %store-monad
-                                  (lambda (system)
-                                    (package-outputs packages system))
-                                  systems)))))))
-      (for-each (lambda (server)
-                  (report-server-coverage server items))
-                urls))))
+    (parameterize ((current-terminal-columns (terminal-columns)))
+      (let* ((opts     (parse-command-line args %options
+                                           (list %default-options)
+                                           #:build-options? #f))
+             (urls     (assoc-ref opts 'substitute-urls))
+             (systems  (match (filter-map (match-lambda
+                                            (('system . system) system)
+                                            (_ #f))
+                                          opts)
+                         (() (list (%current-system)))
+                         (systems systems)))
+             (packages (let ((file (assoc-ref opts 'manifest)))
+                         (if file
+                             (load-manifest file)
+                             (all-packages))))
+             (items    (with-store store
+                         (parameterize ((%graft? #f))
+                           (concatenate
+                            (run-with-store store
+                              (mapm %store-monad
+                                    (lambda (system)
+                                      (package-outputs packages system))
+                                    systems)))))))
+        (for-each (lambda (server)
+                    (report-server-coverage server items))
+                  urls)))))
 
 ;;; Local Variables:
 ;;; eval: (put 'let/time 'scheme-indent-function 1)
diff --git a/guix/ssh.scm b/guix/ssh.scm
index 32cf6e464b..7b33ef5a3b 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -18,7 +18,7 @@
 
 (define-module (guix ssh)
   #:use-module (guix store)
-  #:use-module ((guix ui) #:select (G_ N_))
+  #:use-module (guix i18n)
   #:use-module (ssh session)
   #:use-module (ssh auth)
   #:use-module (ssh key)
diff --git a/guix/ui.scm b/guix/ui.scm
index 0fc5ab63ad..e40fe576ba 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -28,6 +28,7 @@
 (define-module (guix ui)
   #:use-module (guix i18n)
   #:use-module (guix gexp)
+  #:use-module (guix sets)
   #:use-module (guix utils)
   #:use-module (guix store)
   #:use-module (guix config)
@@ -194,7 +195,7 @@ messages."
   (catch #t
     (lambda ()
       ;; XXX: Force a recompilation to avoid ABI issues.
-      (set! %fresh-auto-compile #t)
+      ;; (set! %fresh-auto-compile #t)
       (set! %load-should-auto-compile #t)
 
       (save-module-excursion
@@ -253,8 +254,9 @@ VARIABLE and return it, or #f if none was found."
          (_ #t)))
       (_ #f)))
 
-  (let loop ((modules (list (resolve-module '() #f #f #:ensure #f)))
-             (suggestions '()))
+  (let loop ((modules     (list (resolve-module '() #f #f #:ensure #f)))
+             (suggestions '())
+             (visited     (setq)))
     (match modules
       (()
        ;; Pick the "best" suggestion.
@@ -262,16 +264,19 @@ VARIABLE and return it, or #f if none was found."
          (() #f)
          ((first _ ...) first)))
       ((head tail ...)
-       (let ((next (append tail
-                           (hash-map->list (lambda (name module)
-                                             module)
-                                           (module-submodules head)))))
-         (match (module-local-variable head variable)
-           (#f (loop next suggestions))
-           (_
-            (match (module-name head)
-              (('gnu _ ...) head)                 ;must be that one
-              (_ (loop next (cons head suggestions)))))))))))
+       (if (set-contains? visited head)
+           (loop tail suggestions visited)
+           (let ((visited (set-insert head visited))
+                 (next    (append tail
+                                  (hash-map->list (lambda (name module)
+                                                    module)
+                                                  (module-submodules head)))))
+             (match (module-local-variable head variable)
+               (#f (loop next suggestions visited))
+               (_
+                (match (module-name head)
+                  (('gnu _ ...) head)             ;must be that one
+                  (_ (loop next (cons head suggestions) visited)))))))))))
 
 (define* (display-hint message #:optional (port (current-error-port)))
   "Display MESSAGE, a l10n message possibly containing Texinfo markup, to
@@ -308,7 +313,7 @@ ARGS is the list of arguments received by the 'throw' handler."
        (#f
         (display-hint (G_ "Did you forget a @code{use-modules} form?")))
        (module
-        (display-hint (format #f (G_ "Try adding @code{(use-modules ~a)}.")
+        (display-hint (format #f (G_ "Did you forget @code{(use-modules ~a)}?")
                               (module-name module))))))
     (('srfi-34 obj)
      (if (message-condition? obj)
@@ -545,19 +550,24 @@ interpreted."
                                    (manifest-entry-version parent))
                      (report-parent-entries parent))))
 
-               (report-error (G_ "profile contains conflicting entries for ~a:~a~%")
+               (define (manifest-entry-output* entry)
+                 (match (manifest-entry-output entry)
+                   ("out"   "")
+                   (output (string-append ":" output))))
+
+               (report-error (G_ "profile contains conflicting entries for ~a~a~%")
                              (manifest-entry-name entry)
-                             (manifest-entry-output entry))
-               (report-error (G_ "  first entry: ~a@~a:~a ~a~%")
+                             (manifest-entry-output* entry))
+               (report-error (G_ "  first entry: ~a@~a~a ~a~%")
                              (manifest-entry-name entry)
                              (manifest-entry-version entry)
-                             (manifest-entry-output entry)
+                             (manifest-entry-output* entry)
                              (manifest-entry-item entry))
                (report-parent-entries entry)
-               (report-error (G_ "  second entry: ~a@~a:~a ~a~%")
+               (report-error (G_ "  second entry: ~a@~a~a ~a~%")
                              (manifest-entry-name conflict)
                              (manifest-entry-version conflict)
-                             (manifest-entry-output conflict)
+                             (manifest-entry-output* conflict)
                              (manifest-entry-item conflict))
                (report-parent-entries conflict)
                (exit 1)))
diff --git a/guix/utils.scm b/guix/utils.scm
index c0ffed172a..fed31f4ca4 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -75,6 +76,7 @@
             %current-target-system
             package-name->name+version
             target-mingw?
+            target-arm32?
             version-compare
             version>?
             version>=?
@@ -467,6 +469,9 @@ a character other than '@'."
   (and target
        (string-suffix? "-mingw32" target)))
 
+(define (target-arm32?)
+  (string-prefix? "arm" (or (%current-target-system) (%current-system))))
+
 (define version-compare
   (let ((strverscmp
          (let ((sym (or (dynamic-func "strverscmp" (dynamic-link))
diff --git a/guix/zlib.scm b/guix/zlib.scm
index 955589ab48..3bd0ad86c9 100644
--- a/guix/zlib.scm
+++ b/guix/zlib.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -149,31 +149,6 @@ the number of uncompressed bytes written, a strictly positive integer."
   ;; Z_DEFAULT_COMPRESSION.
   -1)
 
-(define (close-procedure gzfile port)
-  "Return a procedure that closes GZFILE, ensuring its underlying PORT is
-closed even if closing GZFILE triggers an exception."
-  (let-syntax ((ignore-EBADF
-                (syntax-rules ()
-                  ((_ exp)
-                   (catch 'system-error
-                     (lambda ()
-                       exp)
-                     (lambda args
-                       (unless (= EBADF (system-error-errno args))
-                         (apply throw args))))))))
-
-    (lambda ()
-      (catch 'zlib-error
-        (lambda ()
-          ;; 'gzclose' closes the underlying file descriptor.  'close-port'
-          ;; calls close(2) and gets EBADF, which we swallow.
-          (gzclose gzfile)
-          (ignore-EBADF (close-port port)))
-        (lambda args
-          ;; Make sure PORT is closed despite the zlib error.
-          (ignore-EBADF (close-port port))
-          (apply throw args))))))
-
 (define* (make-gzip-input-port port #:key (buffer-size %default-buffer-size))
   "Return an input port that decompresses data read from PORT, a file port.
 PORT is automatically closed when the resulting port is closed.  BUFFER-SIZE
@@ -183,7 +158,14 @@ buffered input, which would be lost (and is lost anyway)."
   (define gzfile
     (match (drain-input port)
       (""                                         ;PORT's buffer is empty
-       (gzdopen (fileno port) "r"))
+       ;; 'gzclose' will eventually close the file descriptor beneath PORT.
+       ;; 'close-port' on PORT would get EBADF if 'gzclose' already closed it,
+       ;; so that's no good; revealed ports are no good either because they
+       ;; leak (see <https://bugs.gnu.org/28784>); calling 'close-port' after
+       ;; 'gzclose' doesn't work either because it leads to a race condition
+       ;; (see <https://bugs.gnu.org/29335>).  So we dup and close PORT right
+       ;; away.
+       (gzdopen (dup (fileno port)) "r"))
       (_
        ;; This is unrecoverable but it's better than having the buffered input
        ;; be lost, leading to unclear end-of-file or corrupt-data errors down
@@ -197,8 +179,10 @@ buffered input, which would be lost (and is lost anyway)."
   (unless (= buffer-size %default-buffer-size)
     (gzbuffer! gzfile buffer-size))
 
+  (close-port port)                               ;we no longer need it
   (make-custom-binary-input-port "gzip-input" read! #f #f
-                                 (close-procedure gzfile port)))
+                                 (lambda ()
+                                   (gzclose gzfile))))
 
 (define* (make-gzip-output-port port
                                 #:key
@@ -210,7 +194,7 @@ port is closed."
   (define gzfile
     (begin
       (force-output port)                         ;empty PORT's buffer
-      (gzdopen (fileno port)
+      (gzdopen (dup (fileno port))
                (string-append "w" (number->string level)))))
 
   (define (write! bv start count)
@@ -219,8 +203,10 @@ port is closed."
   (unless (= buffer-size %default-buffer-size)
     (gzbuffer! gzfile buffer-size))
 
+  (close-port port)
   (make-custom-binary-output-port "gzip-output" write! #f #f
-                                  (close-procedure gzfile port)))
+                                  (lambda ()
+                                    (gzclose gzfile))))
 
 (define* (call-with-gzip-input-port port proc
                                     #:key (buffer-size %default-buffer-size))