Merge branch 'core-updates'.

13 files changed, 264 insertions, 130 deletions

diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm
index c675155a6a..c91ad2ee0c 100644
--- a/guix/build-system/gnu.scm
+++ b/guix/build-system/gnu.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -278,6 +278,7 @@ standard packages used as implicit inputs of the GNU build system."
                     (strip-directories ''("lib" "lib64" "libexec"
                                           "bin" "sbin"))
                     (phases '%standard-phases)
+                    (locale "en_US.UTF-8")
                     (system (%current-system))
                     (imported-modules %default-modules)
                     (modules %default-modules)
@@ -328,6 +329,7 @@ are allowed to refer to."
                   #:search-paths ',(map search-path-specification->sexp
                                         search-paths)
                   #:phases ,phases
+                  #:locale ,locale
                   #:configure-flags ,configure-flags
                   #:make-flags ,make-flags
                   #:out-of-source? ,out-of-source?
@@ -410,6 +412,7 @@ is one of `host' or `target'."
                           (strip-directories ''("lib" "lib64" "libexec"
                                                 "bin" "sbin"))
                           (phases '%standard-phases)
+                          (locale "en_US.UTF-8")
                           (system (%current-system))
                           (imported-modules '((guix build gnu-build-system)
                                               (guix build utils)))
@@ -473,6 +476,7 @@ platform."
                                              search-path-specification->sexp
                                              native-search-paths)
                     #:phases ,phases
+                    #:locale ,locale
                     #:configure-flags ,configure-flags
                     #:make-flags ,make-flags
                     #:out-of-source? ,out-of-source?
diff --git a/guix/build/cmake-build-system.scm b/guix/build/cmake-build-system.scm
index 74b4f01425..08ae73ef8d 100644
--- a/guix/build/cmake-build-system.scm
+++ b/guix/build/cmake-build-system.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
 ;;; Copyright © 2014 Andreas Enge <andreas@enge.fr>
 ;;;
@@ -57,6 +57,8 @@
                   "-DCMAKE_INSTALL_RPATH_USE_LINK_PATH=TRUE"
                   ;; add (other) libraries of the project itself to rpath
                   ,(string-append "-DCMAKE_INSTALL_RPATH=" out "/lib")
+                  ;; enable verbose output from builds
+                  "-DCMAKE_VERBOSE_MAKEFILE=ON"
                   ,@configure-flags)))
       (setenv "CMAKE_LIBRARY_PATH" (getenv "LIBRARY_PATH"))
       (setenv "CMAKE_INCLUDE_PATH" (getenv "CPATH"))
@@ -72,9 +74,9 @@
 (define %standard-phases
   ;; Everything is as with the GNU Build System except for the `configure'
   ;; and 'check' phases.
-  (alist-replace 'configure configure
-    (alist-replace 'check check
-                   gnu:%standard-phases)))
+  (modify-phases gnu:%standard-phases
+    (replace check check)
+    (replace configure configure)))
 
 (define* (cmake-build #:key inputs (phases %standard-phases)
                       #:allow-other-keys #:rest args)
diff --git a/guix/build/download.scm b/guix/build/download.scm
index e8d61e0d92..a3105ad41d 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -26,6 +26,7 @@
   #:use-module (rnrs io ports)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
@@ -42,24 +43,66 @@
 ;;;
 ;;; Code:
 
+(define %http-receive-buffer-size
+  ;; Size of the HTTP receive buffer.
+  65536)
+
+(define (duration->seconds duration)
+  "Return the number of seconds represented by DURATION, a 'time-duration'
+object, as an inexact number."
+  (+ (time-second duration)
+     (/ (time-nanosecond duration) 1e9)))
+
+(define (throughput->string throughput)
+  "Given THROUGHPUT, measured in bytes per second, return a string
+representing it in a human-readable way."
+  (if (> throughput 3e6)
+      (format #f "~,2f MiB/s" (/ throughput (expt 2. 20)))
+      (format #f "~,0f KiB/s" (/ throughput 1024.0))))
+
 (define* (progress-proc file size #:optional (log-port (current-output-port)))
   "Return a procedure to show the progress of FILE's download, which is
 SIZE byte long.  The returned procedure is suitable for use as an
 argument to `dump-port'.  The progress report is written to LOG-PORT."
-  (if (number? size)
-      (lambda (transferred cont)
-        (let ((% (* 100.0 (/ transferred size))))
-          (display #\cr log-port)
-          (format log-port "~a\t~5,1f% of ~,1f KiB"
-                  file % (/ size 1024.0))
-          (flush-output-port log-port)
-          (cont)))
-      (lambda (transferred cont)
-        (display #\cr log-port)
-        (format log-port "~a\t~6,1f KiB transferred"
-                file (/ transferred 1024.0))
-        (flush-output-port log-port)
-        (cont))))
+  ;; XXX: Because of <http://bugs.gnu.org/19939> this procedure is often not
+  ;; called as frequently as we'd like too; this is especially bad with Nginx
+  ;; on hydra.gnu.org, which returns whole nars as a single chunk.
+  (let ((start-time #f))
+    (let-syntax ((with-elapsed-time
+                     (syntax-rules ()
+                       ((_ elapsed body ...)
+                        (let* ((now     (current-time time-monotonic))
+                               (elapsed (and start-time
+                                             (duration->seconds
+                                              (time-difference now
+                                                               start-time)))))
+                          (unless start-time
+                            (set! start-time now))
+                          body ...)))))
+      (if (number? size)
+          (lambda (transferred cont)
+            (with-elapsed-time elapsed
+              (let ((%          (* 100.0 (/ transferred size)))
+                    (throughput (if elapsed
+                                    (/ transferred elapsed)
+                                    0)))
+                (display #\cr log-port)
+                (format log-port "~a\t~5,1f% of ~,1f KiB (~a)"
+                        file % (/ size 1024.0)
+                        (throughput->string throughput))
+                (flush-output-port log-port)
+                (cont))))
+          (lambda (transferred cont)
+            (with-elapsed-time elapsed
+              (let ((throughput (if elapsed
+                                    (/ transferred elapsed)
+                                    0)))
+                (display #\cr log-port)
+                (format log-port "~a\t~6,1f KiB transferred (~a)"
+                        file (/ transferred 1024.0)
+                        (throughput->string throughput))
+                (flush-output-port log-port)
+                (cont))))))))
 
 (define* (uri-abbreviation uri #:optional (max-length 42))
   "If URI's string representation is larger than MAX-LENGTH, return an
@@ -92,7 +135,7 @@ abbreviation of URI showing the scheme, host, and basename of the file."
     (call-with-output-file file
       (lambda (out)
         (dump-port in out
-                   #:buffer-size 65536            ; don't flood the log
+                   #:buffer-size %http-receive-buffer-size
                    #:progress (progress-proc (uri-abbreviation uri) size))))
 
     (ftp-close conn))
@@ -182,7 +225,7 @@ which is not available during bootstrap."
           (connect s (addrinfo:addr ai))
 
           ;; Buffer input and output on this port.
-          (setvbuf s _IOFBF)
+          (setvbuf s _IOFBF %http-receive-buffer-size)
 
           (if (eq? 'https (uri-scheme uri))
               (tls-wrap s (uri-host uri))
@@ -334,7 +377,7 @@ Return the resulting target URI."
              (if (port? bv-or-port)
                  (begin
                    (dump-port bv-or-port p
-                              #:buffer-size 65536 ; don't flood the log
+                              #:buffer-size %http-receive-buffer-size
                               #:progress (progress-proc (uri-abbreviation uri)
                                                         size))
                    (newline))
@@ -423,4 +466,8 @@ on success."
                file url)
        #f))))
 
+;;; Local Variables:
+;;; eval: (put 'with-elapsed-time 'scheme-indent-function 1)
+;;; End:
+
 ;;; download.scm ends here
diff --git a/guix/build/glib-or-gtk-build-system.scm b/guix/build/glib-or-gtk-build-system.scm
index 92e91bf7a5..c57bc3e731 100644
--- a/guix/build/glib-or-gtk-build-system.scm
+++ b/guix/build/glib-or-gtk-build-system.scm
@@ -239,13 +239,10 @@ needed."
          outputs))
 
 (define %standard-phases
-  (alist-cons-after
-   'install 'glib-or-gtk-wrap wrap-all-programs
-   (alist-cons-after
-    'install 'glib-or-gtk-icon-cache generate-icon-cache
-    (alist-cons-after
-     'install 'glib-or-gtk-compile-schemas compile-glib-schemas
-     gnu:%standard-phases))))
+  (modify-phases gnu:%standard-phases
+    (add-after install glib-or-gtk-compile-schemas compile-glib-schemas)
+    (add-after install glib-or-gtk-icon-cache generate-icon-cache)
+    (add-after install glib-or-gtk-wrap wrap-all-programs)))
 
 (define* (glib-or-gtk-build #:key inputs (phases %standard-phases)
                             #:allow-other-keys #:rest args)
diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index 2880168273..5ae537150f 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -94,6 +94,33 @@
 
   #t)
 
+(define* (install-locale #:key
+                         (locale "en_US.UTF-8")
+                         (locale-category LC_ALL)
+                         #:allow-other-keys)
+  "Try to install LOCALE; emit a warning if that fails.  The main goal is to
+use a UTF-8 locale so that Guile correctly interprets UTF-8 file names.
+
+This phase must typically happen after 'set-paths' so that $LOCPATH has a
+chance to be set."
+  (catch 'system-error
+    (lambda ()
+      (setlocale locale-category locale)
+
+      ;; While we're at it, pass it to sub-processes.
+      (setenv (locale-category->string locale-category) locale)
+
+      (format (current-error-port) "using '~a' locale for category ~s~%"
+              locale (locale-category->string locale-category))
+      #t)
+    (lambda args
+      ;; This is known to fail for instance in early bootstrap where locales
+      ;; are not available.
+      (format (current-error-port)
+              "warning: failed to install '~a' locale: ~a~%"
+              locale (strerror (system-error-errno args)))
+      #t)))
+
 (define* (unpack #:key source #:allow-other-keys)
   "Unpack SOURCE in the working directory, and change directory within the
 source.  When SOURCE is a directory, copy it in a sub-directory of the current
@@ -108,7 +135,9 @@ working directory."
         (copy-recursively source "."
                           #:keep-mtime? #t)
         #t)
-      (and (zero? (system* "tar" "xvf" source))
+      (and (if (string-suffix? ".zip" source)
+               (zero? (system* "unzip" source))
+               (zero? (system* "tar" "xvf" source)))
            (chdir (first-subdirectory ".")))))
 
 ;; See <http://bugs.gnu.org/17840>.
@@ -452,7 +481,7 @@ DOCUMENTATION-COMPRESSOR-FLAGS."
   ;; Standard build phases, as a list of symbol/procedure pairs.
   (let-syntax ((phases (syntax-rules ()
                          ((_ p ...) `((p . ,p) ...)))))
-    (phases set-paths unpack
+    (phases set-paths install-locale unpack
             patch-usr-bin-file
             patch-source-shebangs configure patch-generated-file-shebangs
             build check install
@@ -470,6 +499,9 @@ in order.  Return #t if all the PHASES succeeded, #f otherwise."
   (setvbuf (current-output-port) _IOLBF)
   (setvbuf (current-error-port) _IOLBF)
 
+  ;; Encoding/decoding errors shouldn't be silent.
+  (fluid-set! %default-port-conversion-strategy 'error)
+
   ;; The trick is to #:allow-other-keys everywhere, so that each procedure in
   ;; PHASES can pick the keyword arguments it's interested in.
   (every (match-lambda
diff --git a/guix/build/gnu-dist.scm b/guix/build/gnu-dist.scm
index 562056b5f6..887b5e94e9 100644
--- a/guix/build/gnu-dist.scm
+++ b/guix/build/gnu-dist.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -82,14 +82,11 @@
 
 (define %dist-phases
   ;; Phases for building a source tarball.
-  (alist-replace
-   'unpack copy-source
-   (alist-cons-before
-    'configure 'autoreconf autoreconf
-    (alist-replace
-     'build build
-     (alist-replace
-      'install install-dist
-      (alist-delete 'strip %standard-phases))))))
+  (modify-phases %standard-phases
+    (delete strip)
+    (replace install install-dist)
+    (replace build build)
+    (add-before configure autoreconf autoreconf)
+    (replace unpack copy-source)))
 
 ;;; gnu-dist.scm ends here
diff --git a/guix/build/perl-build-system.scm b/guix/build/perl-build-system.scm
index 7eb944ccd1..9ca5353bb9 100644
--- a/guix/build/perl-build-system.scm
+++ b/guix/build/perl-build-system.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -71,15 +71,11 @@
 (define %standard-phases
   ;; Everything is as with the GNU Build System except for the `configure',
   ;; `build', `check', and `install' phases.
-  (alist-replace
-   'configure configure
-   (alist-replace
-    'build build
-    (alist-replace
-     'check check
-     (alist-replace
-      'install install
-      gnu:%standard-phases)))))
+  (modify-phases gnu:%standard-phases
+    (replace install install)
+    (replace check check)
+    (replace build build)
+    (replace configure configure)))
 
 (define* (perl-build #:key inputs (phases %standard-phases)
                      #:allow-other-keys #:rest args)
diff --git a/guix/build/python-build-system.scm b/guix/build/python-build-system.scm
index 74ba0c765d..9f853134bd 100644
--- a/guix/build/python-build-system.scm
+++ b/guix/build/python-build-system.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;;
@@ -122,19 +122,13 @@ installed with setuptools."
 (define %standard-phases
   ;; 'configure' and 'build' phases are not needed.  Everything is done during
   ;; 'install'.
-  (alist-cons-before
-   'strip 'rename-pth-file
-   rename-pth-file
-   (alist-cons-after
-    'install 'wrap
-    wrap
-    (alist-replace
-     'build build
-     (alist-replace
-      'check check
-      (alist-replace 'install install
-                     (alist-delete 'configure
-                                   gnu:%standard-phases)))))))
+  (modify-phases gnu:%standard-phases
+    (delete configure)
+    (replace install install)
+    (replace check check)
+    (replace build build)
+    (add-after install wrap wrap)
+    (add-before strip rename-pth-file rename-pth-file)))
 
 (define* (python-build #:key inputs (phases %standard-phases)
                        #:allow-other-keys #:rest args)
diff --git a/guix/build/ruby-build-system.scm b/guix/build/ruby-build-system.scm
index 4221295d88..1310c4a0b3 100644
--- a/guix/build/ruby-build-system.scm
+++ b/guix/build/ruby-build-system.scm
@@ -71,16 +71,12 @@ directory."
                     "--bindir" (string-append out "/bin")))))
 
 (define %standard-phases
-  (alist-cons-after
-   'unpack 'gitify gitify
-   (alist-replace
-    'build build
-    (alist-replace
-     'install install
-     (alist-replace
-      'check check
-      (alist-delete
-       'configure gnu:%standard-phases))))))
+  (modify-phases gnu:%standard-phases
+    (delete configure)
+    (add-after unpack gitify gitify)
+    (replace build build)
+    (replace install install)
+    (replace check check)))
 
 (define* (ruby-build #:key inputs (phases %standard-phases)
                      #:allow-other-keys #:rest args)
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 4407f9af23..a5a6167a8c 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -21,6 +21,7 @@
 (define-module (guix build utils)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-60)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
@@ -54,6 +55,7 @@
             alist-cons-before
             alist-cons-after
             alist-replace
+            modify-phases
             with-atomic-file-replacement
             substitute
             substitute*
@@ -64,7 +66,9 @@
             patch-/usr/bin/file
             fold-port-matches
             remove-store-references
-            wrap-program))
+            wrap-program
+
+            locale-category->string))
 
 
 ;;;
@@ -323,7 +327,7 @@ for under the directories designated by FILES.  For example:
                                           (list file)
                                           '())))))
                             files))
-              input-dirs))
+              (delete-duplicates input-dirs)))
 
 (define (list->search-path-as-string lst separator)
   (string-join lst separator))
@@ -423,6 +427,33 @@ An error is raised when no such pair exists."
       ((_ after ...)
        (append before (alist-cons key value after))))))
 
+(define-syntax-rule (modify-phases phases mod-spec ...)
+  "Modify PHASES sequentially as per each MOD-SPEC, which may have one of the
+following forms:
+
+  (delete <old-phase-name>)
+  (replace <old-phase-name> <new-phase>)
+  (add-before <old-phase-name> <new-phase-name> <new-phase>)
+  (add-after <old-phase-name> <new-phase-name> <new-phase>)
+
+Where every <*-phase-name> is an automatically quoted symbol, and <new-phase>
+an expression evaluating to a procedure."
+  (let* ((phases* phases)
+         (phases* (%modify-phases phases* mod-spec))
+         ...)
+    phases*))
+
+(define-syntax %modify-phases
+  (syntax-rules (delete replace add-before add-after)
+    ((_ phases (delete old-phase-name))
+     (alist-delete 'old-phase-name phases))
+    ((_ phases (replace old-phase-name new-phase))
+     (alist-replace 'old-phase-name new-phase phases))
+    ((_ phases (add-before old-phase-name new-phase-name new-phase))
+     (alist-cons-before 'old-phase-name 'new-phase-name new-phase phases))
+    ((_ phases (add-after old-phase-name new-phase-name new-phase))
+     (alist-cons-after 'old-phase-name 'new-phase-name new-phase phases))))
+
 
 ;;;
 ;;; Text substitution (aka. sed).
@@ -557,22 +588,27 @@ match the terminating newline of a line."
 (define* (dump-port in out
                     #:key (buffer-size 16384)
                     (progress (lambda (t k) (k))))
-  "Read as much data as possible from IN and write it to OUT, using
-chunks of BUFFER-SIZE bytes.  Call PROGRESS after each successful
-transfer of BUFFER-SIZE bytes or less, passing it the total number of
-bytes transferred and the continuation of the transfer as a thunk."
+  "Read as much data as possible from IN and write it to OUT, using chunks of
+BUFFER-SIZE bytes.  Call PROGRESS at the beginning and after each successful
+transfer of BUFFER-SIZE bytes or less, passing it the total number of bytes
+transferred and the continuation of the transfer as a thunk."
   (define buffer
     (make-bytevector buffer-size))
 
-  (let loop ((total 0)
-             (bytes (get-bytevector-n! in buffer 0 buffer-size)))
+  (define (loop total bytes)
     (or (eof-object? bytes)
         (let ((total (+ total bytes)))
           (put-bytevector out buffer 0 bytes)
           (progress total
                     (lambda ()
                       (loop total
-                            (get-bytevector-n! in buffer 0 buffer-size))))))))
+                            (get-bytevector-n! in buffer 0 buffer-size)))))))
+
+  ;; Make sure PROGRESS is called when we start so that it can measure
+  ;; throughput.
+  (progress 0
+            (lambda ()
+              (loop 0 (get-bytevector-n! in buffer 0 buffer-size)))))
 
 (define (set-file-time file stat)
   "Set the atime/mtime of FILE to that specified by STAT."
@@ -582,6 +618,14 @@ bytes transferred and the continuation of the transfer as a thunk."
          (stat:atimensec stat)
          (stat:mtimensec stat)))
 
+(define (get-char* p)
+  ;; We call it `get-char', but that's really a binary version
+  ;; thereof.  (The real `get-char' cannot be used here because our
+  ;; bootstrap Guile is hacked to always use UTF-8.)
+  (match (get-u8 p)
+    ((? integer? x) (integer->char x))
+    (x x)))
+
 (define patch-shebang
   (let ((shebang-rx (make-regexp "^[[:blank:]]*([[:graph:]]+)[[:blank:]]*([[:graph:]]*)(.*)$")))
     (lambda* (file
@@ -617,8 +661,8 @@ FILE are kept unchanged."
 
       (call-with-ascii-input-file file
         (lambda (p)
-          (and (eq? #\# (read-char p))
-               (eq? #\! (read-char p))
+          (and (eq? #\# (get-char* p))
+               (eq? #\! (get-char* p))
                (let ((line (false-if-exception (read-line p))))
                  (and=> (and line (regexp-exec shebang-rx line))
                         (lambda (m)
@@ -668,16 +712,18 @@ When KEEP-MTIME? is true, the atime/mtime of FILE are kept unchanged."
       shell))
 
   (let ((st (stat file)))
-   (substitute* file
-     (("^ *SHELL[[:blank:]]*:?=[[:blank:]]*([[:graph:]]*/)([[:graph:]]+)(.*)$"
-       _ dir shell args)
-      (let* ((old (string-append dir shell))
-             (new (or (find-shell shell) old)))
-        (unless (string=? new old)
-          (format (current-error-port)
-                  "patch-makefile-SHELL: ~a: changing `SHELL' from `~a' to `~a'~%"
-                  file old new))
-        (string-append "SHELL = " new args))))
+    ;; Consider FILE is using an 8-bit encoding to avoid errors.
+    (with-fluids ((%default-port-encoding #f))
+      (substitute* file
+        (("^ *SHELL[[:blank:]]*:?=[[:blank:]]*([[:graph:]]*/)([[:graph:]]+)(.*)$"
+          _ dir shell args)
+         (let* ((old (string-append dir shell))
+                (new (or (find-shell shell) old)))
+           (unless (string=? new old)
+             (format (current-error-port)
+                     "patch-makefile-SHELL: ~a: changing `SHELL' from `~a' to `~a'~%"
+                     file old new))
+           (string-append "SHELL = " new args)))))
 
    (when keep-mtime?
      (set-file-time file st))))
@@ -694,13 +740,15 @@ unchanged."
               "patch-/usr/bin/file: warning: \
 no replacement 'file' command, doing nothing~%")
       (let ((st (stat file)))
-        (substitute* file
-          (("/usr/bin/file")
-           (begin
-             (format (current-error-port)
-                     "patch-/usr/bin/file: ~a: changing `~a' to `~a'~%"
-                     file "/usr/bin/file" file-command)
-             file-command)))
+        ;; Consider FILE is using an 8-bit encoding to avoid errors.
+        (with-fluids ((%default-port-encoding #f))
+          (substitute* file
+            (("/usr/bin/file")
+             (begin
+               (format (current-error-port)
+                       "patch-/usr/bin/file: ~a: changing `~a' to `~a'~%"
+                       file "/usr/bin/file" file-command)
+               file-command))))
 
         (when keep-mtime?
           (set-file-time file st)))))
@@ -717,21 +765,13 @@ for each unmatched character."
         (map char-set (string->list pattern))
         pattern))
 
-  (define (get-char p)
-    ;; We call it `get-char', but that's really a binary version
-    ;; thereof.  (The real `get-char' cannot be used here because our
-    ;; bootstrap Guile is hacked to always use UTF-8.)
-    (match (get-u8 p)
-      ((? integer? x) (integer->char x))
-      (x x)))
-
   ;; Note: we're not really striving for performance here...
   (let loop ((chars   '())
              (pattern initial-pattern)
              (matched '())
              (result  init))
     (cond ((null? chars)
-           (loop (list (get-char port))
+           (loop (list (get-char* port))
                  pattern
                  matched
                  result))
@@ -816,7 +856,7 @@ contents:
   #!location/of/bin/bash
   export PATH=\"/gnu/.../bar/bin\"
   export CERT_PATH=\"$CERT_PATH${CERT_PATH:+:}/gnu/.../baz/certs:/qux/certs\"
-  exec -a location/of/foo location/of/.foo-real \"$@\"
+  exec -a $0 location/of/.foo-real \"$@\"
 
 This is useful for scripts that expect particular programs to be in $PATH, for
 programs that expect particular shared libraries to be in $LD_LIBRARY_PATH, or
@@ -837,7 +877,7 @@ the previous wrapper."
     (if (zero? number)
         (let ((prog-real (string-append (dirname prog) "/."
                                         (basename prog) "-real")))
-          (copy-file prog prog-real)
+          (rename-file prog prog-real)
           prog-real)
         (wrapper-file-name number)))
 
@@ -870,11 +910,10 @@ the previous wrapper."
     (with-output-to-file prog-tmp
       (lambda ()
         (format #t
-                "#!~a~%~a~%exec -a \"~a\" \"~a\" \"$@\"~%"
+                "#!~a~%~a~%exec -a \"$0\" \"~a\" \"$@\"~%"
                 (which "bash")
                 (string-join (map export-variable vars)
                              "\n")
-                (canonicalize-path prog)
                 (canonicalize-path target))))
 
     (chmod prog-tmp #o755)
@@ -882,6 +921,27 @@ the previous wrapper."
     (symlink wrapper prog-tmp)
     (rename-file prog-tmp prog)))
 
+
+;;;
+;;; Locales.
+;;;
+
+(define (locale-category->string category)
+  "Return the name of locale category CATEGORY, one of the 'LC_' constants.
+If CATEGORY is a bitwise or of several 'LC_' constants, an approximation is
+returned."
+  (letrec-syntax ((convert (syntax-rules ()
+                             ((_)
+                              (number->string category))
+                             ((_ first rest ...)
+                              (if (= first category)
+                                  (symbol->string 'first)
+                                  (convert rest ...))))))
+    (convert LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE
+             LC_IDENTIFICATION LC_MEASUREMENT LC_MESSAGES LC_MONETARY
+             LC_NAME LC_NUMERIC LC_PAPER LC_TELEPHONE
+             LC_TIME)))
+
 ;;; Local Variables:
 ;;; eval: (put 'call-with-output-file/atomic 'scheme-indent-function 1)
 ;;; eval: (put 'call-with-ascii-input-file 'scheme-indent-function 1)
diff --git a/guix/build/waf-build-system.scm b/guix/build/waf-build-system.scm
index e64b51abc0..d172c5a836 100644
--- a/guix/build/waf-build-system.scm
+++ b/guix/build/waf-build-system.scm
@@ -69,14 +69,11 @@
         (call-waf "install" params)))
 
 (define %standard-phases
-  (alist-replace
-   'configure configure
-   (alist-replace
-    'build build
-    (alist-replace
-     'check check
-     (alist-replace 'install install
-                    gnu:%standard-phases)))))
+  (modify-phases gnu:%standard-phases
+    (replace configure configure)
+    (replace build build)
+    (replace check check)
+    (replace install install)))
 
 (define* (waf-build #:key inputs (phases %standard-phases)
                        #:allow-other-keys #:rest args)
diff --git a/guix/gexp.scm b/guix/gexp.scm
index a8349c7d6e..1e26342101 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -314,12 +314,13 @@ references."
        (cons name result))
       ((? gexp? exp)
        (append (gexp-outputs exp) result))
+      ((lst ...)
+       (fold-right add-reference-output result lst))
       (_
        result)))
 
-  (fold-right add-reference-output
-              '()
-              (gexp-references exp)))
+  (delete-duplicates
+   (add-reference-output (gexp-references exp) '())))
 
 (define* (gexp->sexp exp #:key
                      (system (%current-system))
diff --git a/guix/packages.scm b/guix/packages.scm
index 5b686a122f..fc5264673d 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -335,7 +335,8 @@ corresponds to the arguments expected by `set-path-environment-variable'."
       ("bzip2" ,(ref '(gnu packages compression) 'bzip2))
       ("gzip"  ,(ref '(gnu packages compression) 'gzip))
       ("lzip"  ,(ref '(gnu packages compression) 'lzip))
-      ("patch" ,(ref '(gnu packages base) 'patch)))))
+      ("patch" ,(ref '(gnu packages base) 'patch))
+      ("locales" ,(ref '(gnu packages base) 'glibc-utf8-locales)))))
 
 (define (default-guile)
   "Return the default Guile package used to run the build code of
@@ -411,7 +412,11 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
                     (srfi srfi-1)
                     (guix build utils))
 
-       (let ((out     (assoc-ref %outputs "out"))
+       ;; Encoding/decoding errors shouldn't be silent.
+       (fluid-set! %default-port-conversion-strategy 'error)
+
+       (let ((locales (assoc-ref %build-inputs "locales"))
+             (out     (assoc-ref %outputs "out"))
              (xz      (assoc-ref %build-inputs "xz"))
              (decomp  (assoc-ref %build-inputs ,decompression-type))
              (source  (assoc-ref %build-inputs "source"))
@@ -433,6 +438,12 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
                          (lambda (name)
                            (not (member name '("." "..")))))))
 
+         (when locales
+           ;; First of all, install a UTF-8 locale so that UTF-8 file names
+           ;; are correctly interpreted.  During bootstrap, LOCALES is #f.
+           (setenv "LOCPATH" (string-append locales "/lib/locale"))
+           (setlocale LC_ALL "en_US.UTF-8"))
+
          (setenv "PATH" (string-append xz "/bin" ":"
                                        decomp "/bin"))