Merge branch 'master' into core-updates

16 files changed, 410 insertions, 319 deletions

diff --git a/guix/build-system/minify.scm b/guix/build-system/minify.scm
index af90a32f59..21d84a179a 100644
--- a/guix/build-system/minify.scm
+++ b/guix/build-system/minify.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,7 +39,6 @@
 (define %minify-build-system-modules
   ;; Build-side modules imported by default.
   `((guix build minify-build-system)
-    (ice-9 popen)
     ,@%gnu-build-system-modules))
 
 (define (default-uglify-js)
diff --git a/guix/build-system/trivial.scm b/guix/build-system/trivial.scm
index 350b1df553..b50ef7cd92 100644
--- a/guix/build-system/trivial.scm
+++ b/guix/build-system/trivial.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, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -36,7 +36,7 @@
 
 (define* (lower name
                 #:key source inputs native-inputs outputs system target
-                guile builder modules)
+                guile builder modules allowed-references)
   "Return a bag for NAME."
   (bag
     (name name)
@@ -51,19 +51,36 @@
     (build (if target trivial-cross-build trivial-build))
     (arguments `(#:guile ,guile
                  #:builder ,builder
-                 #:modules ,modules))))
+                 #:modules ,modules
+                 #:allowed-references ,allowed-references))))
 
 (define* (trivial-build store name inputs
                         #:key
                         outputs guile system builder (modules '())
-                        search-paths)
+                        search-paths allowed-references)
   "Run build expression BUILDER, an expression, for SYSTEM.  SOURCE is
 ignored."
+  (define canonicalize-reference
+    (match-lambda
+     ((? package? p)
+      (derivation->output-path (package-derivation store p system
+                                                   #:graft? #f)))
+     (((? package? p) output)
+      (derivation->output-path (package-derivation store p system
+                                                   #:graft? #f)
+                               output))
+     ((? string? output)
+      output)))
+
   (build-expression->derivation store name builder
                                 #:inputs inputs
                                 #:system system
                                 #:outputs outputs
                                 #:modules modules
+                                #:allowed-references
+                                (and allowed-references
+                                     (map canonicalize-reference
+                                          allowed-references))
                                 #:guile-for-build
                                 (guile-for-build store guile system)))
 
@@ -71,14 +88,29 @@ ignored."
                               #:key
                               target native-drvs target-drvs
                               outputs guile system builder (modules '())
-                              search-paths native-search-paths)
+                              search-paths native-search-paths
+                              allowed-references)
   "Run build expression BUILDER, an expression, for SYSTEM.  SOURCE is
 ignored."
+  (define canonicalize-reference
+    (match-lambda
+     ((? package? p)
+      (derivation->output-path (package-cross-derivation store p system)))
+     (((? package? p) output)
+      (derivation->output-path (package-cross-derivation store p system)
+                               output))
+     ((? string? output)
+      output)))
+
   (build-expression->derivation store name builder
                                 #:inputs (append native-drvs target-drvs)
                                 #:system system
                                 #:outputs outputs
                                 #:modules modules
+                                #:allowed-references
+                                (and allowed-references
+                                     (map canonicalize-reference
+                                          allowed-references))
                                 #:guile-for-build
                                 (guile-for-build store guile system)))
 
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 1b630a9d6d..315a3554ec 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, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
@@ -321,14 +321,6 @@ host name without trailing dot."
    ((uri? uri-or-string) uri-or-string)
    (else (error "Invalid URI" uri-or-string))))
 
-(define current-http-proxy
-  ;; XXX: Add a dummy definition for Guile < 2.0.10; this is used in
-  ;; 'open-socket-for-uri'.
-  (or (and=> (module-variable (resolve-interface '(web client))
-                              'current-http-proxy)
-             variable-ref)
-      (const #f)))
-
 (define* (open-socket-for-uri uri-or-string #:key timeout)
   "Return an open input/output port for a connection to URI.  When TIMEOUT is
 not #f, it must be a (possibly inexact) number denoting the maximum duration
diff --git a/guix/build/git.scm b/guix/build/git.scm
index c1af545a76..14d415a6f8 100644
--- a/guix/build/git.scm
+++ b/guix/build/git.scm
@@ -37,28 +37,31 @@ recursively.  Return #t on success, #f otherwise."
   ;; in advance anyway.
   (setenv "GIT_SSL_NO_VERIFY" "true")
 
-  ;; We cannot use "git clone --recursive" since the following "git checkout"
-  ;; effectively removes sub-module checkouts as of Git 2.6.3.
-  (and (zero? (system* git-command "clone" url directory))
-       (with-directory-excursion directory
-         (system* git-command "tag" "-l")
-         (and (zero? (system* git-command "checkout" commit))
-              (begin
-                (when recursive?
-                  ;; Now is the time to fetch sub-modules.
-                  (unless (zero? (system* git-command "submodule" "update"
+  (mkdir-p directory)
+
+  (with-directory-excursion directory
+    (invoke git-command "init")
+    (invoke git-command "remote" "add" "origin" url)
+    (if (zero? (system* git-command "fetch" "--depth" "1" "origin" commit))
+        (invoke git-command "checkout" "FETCH_HEAD")
+        (begin
+          (invoke git-command "fetch" "origin")
+          (invoke git-command "checkout" commit)))
+    (when recursive?
+      ;; Now is the time to fetch sub-modules.
+      (unless (zero? (system* git-command "submodule" "update"
                                           "--init" "--recursive"))
-                    (error "failed to fetch sub-modules" url))
+        (error "failed to fetch sub-modules" url))
 
-                  ;; In sub-modules, '.git' is a flat file, not a directory,
-                  ;; so we can use 'find-files' here.
-                  (for-each delete-file-recursively
-                            (find-files directory "^\\.git$")))
+      ;; In sub-modules, '.git' is a flat file, not a directory,
+      ;; so we can use 'find-files' here.
+      (for-each delete-file-recursively
+                (find-files directory "^\\.git$")))
 
-                ;; The contents of '.git' vary as a function of the current
-                ;; status of the Git repo.  Since we want a fixed output, this
-                ;; directory needs to be taken out.
-                (delete-file-recursively ".git")
-                #t)))))
+      ;; The contents of '.git' vary as a function of the current
+      ;; status of the Git repo.  Since we want a fixed output, this
+      ;; directory needs to be taken out.
+      (delete-file-recursively ".git")
+      #t))
 
 ;;; git.scm ends here
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 0cb630cfb3..25726b885e 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
@@ -350,39 +350,6 @@ expansion-time error is raised if FIELD does not exist in TYPE."
 ;;; FFI.
 ;;;
 
-(define %libc-errno-pointer
-  ;; Glibc's 'errno' pointer, for use with Guile < 2.0.12.
-  (let ((errno-loc (false-if-exception
-                    (dynamic-func "__errno_location" (dynamic-link)))))
-    (and errno-loc
-         (let ((proc (pointer->procedure '* errno-loc '())))
-           (proc)))))
-
-(define errno                                     ;for Guile < 2.0.12
-  (if %libc-errno-pointer
-      (let ((bv (pointer->bytevector %libc-errno-pointer (sizeof int))))
-        (lambda ()
-          "Return the current errno."
-          ;; XXX: We assume that nothing changes 'errno' while we're doing all this.
-          ;; In particular, that means that no async must be running here.
-
-          ;; Use one of the fixed-size native-ref procedures because they are
-          ;; optimized down to a single VM instruction, which reduces the risk
-          ;; that we fiddle with 'errno' (needed on Guile 2.0.5, libc 2.11.)
-          (let-syntax ((ref (lambda (s)
-                              (syntax-case s ()
-                                ((_ bv)
-                                 (case (sizeof int)
-                                   ((4)
-                                    #'(bytevector-s32-native-ref bv 0))
-                                   ((8)
-                                    #'(bytevector-s64-native-ref bv 0))
-                                   (else
-                                    (error "unsupported 'int' size"
-                                           (sizeof int)))))))))
-            (ref bv))))
-      (lambda () 0)))
-
 (define (call-with-restart-on-EINTR thunk)
   (let loop ()
     (catch 'system-error
@@ -406,17 +373,8 @@ the returned procedure is called."
     (lambda ()
       (let ((ptr (dynamic-func name (dynamic-link))))
         ;; The #:return-errno? facility was introduced in Guile 2.0.12.
-        ;; Support older versions of Guile by catching 'wrong-number-of-args'.
-        (catch 'wrong-number-of-args
-          (lambda ()
-            (pointer->procedure return-type ptr argument-types
-                                #:return-errno? #t))
-          (lambda (key . rest)
-            (let ((proc (pointer->procedure return-type ptr argument-types)))
-              (lambda args
-                (let ((result (apply proc args))
-                      (err    (errno)))
-                  (values result err))))))))
+        (pointer->procedure return-type ptr argument-types
+                            #:return-errno? #t)))
     (lambda args
       (lambda _
         (error (format #f "~a: syscall->procedure failed: ~s"
diff --git a/guix/gexp.scm b/guix/gexp.scm
index f005c4d296..8dea022e04 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -86,6 +87,7 @@
 
             define-gexp-compiler
             gexp-compiler?
+            file-like?
             lower-object
 
             lower-inputs
@@ -182,6 +184,11 @@ procedure to lower it; otherwise return #f."
   (and=> (hashq-ref %gexp-compilers (struct-vtable object))
          gexp-compiler-lower))
 
+(define (file-like? object)
+  "Return #t if OBJECT leads to a file in the store once unquoted in a
+G-expression; otherwise return #f."
+  (and (struct? object) (->bool (lookup-compiler object))))
+
 (define (lookup-expander object)
   "Search for an expander for OBJECT.  Upon success, return the three argument
 procedure to expand it; otherwise return #f."
diff --git a/guix/glob.scm b/guix/glob.scm
new file mode 100644
index 0000000000..4fc5173ac0
--- /dev/null
+++ b/guix/glob.scm
@@ -0,0 +1,97 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; 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 glob)
+  #:use-module (ice-9 match)
+  #:export (compile-glob-pattern
+            glob-match?))
+
+;;; Commentary:
+;;;
+;;; This is a minimal implementation of "glob patterns" (info "(libc)
+;;; Globbbing").  It is currently limited to simple patterns and does not
+;;; support braces and square brackets, for instance.
+;;;
+;;; Code:
+
+(define (wildcard-indices str)
+  "Return the list of indices in STR where wildcards can be found."
+  (let loop ((index 0)
+             (result '()))
+    (if (= index (string-length str))
+        (reverse result)
+        (loop (+ 1 index)
+              (case (string-ref str index)
+                ((#\? #\*) (cons index result))
+                (else      result))))))
+
+(define (compile-glob-pattern str)
+  "Return an sexp that represents the compiled form of STR, a glob pattern
+such as \"foo*\" or \"foo??bar\"."
+  (define flatten
+    (match-lambda
+      (((? string? str)) str)
+      (x x)))
+
+  (let loop ((index   0)
+             (indices (wildcard-indices str))
+             (result '()))
+    (match indices
+      (()
+       (flatten (cond ((zero? index)
+                       (list str))
+                      ((= index (string-length str))
+                       (reverse result))
+                      (else
+                       (reverse (cons (string-drop str index)
+                                      result))))))
+      ((wildcard-index . rest)
+       (let ((wildcard (match (string-ref str wildcard-index)
+                         (#\? '?)
+                         (#\* '*))))
+         (match (substring str index wildcard-index)
+           (""  (loop (+ 1 wildcard-index)
+                      rest
+                      (cons wildcard result)))
+           (str (loop (+ 1 wildcard-index)
+                      rest
+                      (cons* wildcard str result)))))))))
+
+(define (glob-match? pattern str)
+  "Return true if STR matches PATTERN, a compiled glob pattern as returned by
+'compile-glob-pattern'."
+  (let loop ((pattern pattern)
+             (str str))
+   (match pattern
+     ((? string? literal) (string=? literal str))
+     (((? string? one))   (string=? one str))
+     (('*)  #t)
+     (('?) (= 1 (string-length str)))
+     (()    #t)
+     (('* suffix . rest)
+      (match (string-contains str suffix)
+        (#f    #f)
+        (index (loop rest
+                     (string-drop str
+                                  (+ index (string-length suffix)))))))
+     (('? . rest)
+      (and (>= (string-length str) 1)
+           (loop rest (string-drop str 1))))
+     ((prefix . rest)
+      (and (string-prefix? prefix str)
+           (loop rest (string-drop str (string-length prefix))))))))
diff --git a/guix/hash.scm b/guix/hash.scm
index 44e4472580..39834043e1 100644
--- a/guix/hash.scm
+++ b/guix/hash.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,7 +23,9 @@
   #:use-module (system foreign)
   #:use-module ((guix build utils) #:select (dump-port))
   #:use-module (srfi srfi-11)
-  #:export (sha256
+  #:use-module (srfi srfi-26)
+  #:export (sha1
+            sha256
             open-sha256-port
             port-sha256
             file-sha256
@@ -44,17 +46,26 @@
   ;; Value as of Libgcrypt 1.5.2.
   (identifier-syntax 8))
 
-(define sha256
+(define-syntax GCRY_MD_SHA1
+  (identifier-syntax 2))
+
+(define bytevector-hash
   (let ((hash (pointer->procedure void
                                   (libgcrypt-func "gcry_md_hash_buffer")
                                   `(,int * * ,size_t))))
-    (lambda (bv)
-      "Return the SHA256 of BV as a bytevector."
-      (let ((digest (make-bytevector (/ 256 8))))
-        (hash GCRY_MD_SHA256 (bytevector->pointer digest)
+    (lambda (bv type size)
+      "Return the hash TYPE, of SIZE bytes, of BV as a bytevector."
+      (let ((digest (make-bytevector size)))
+        (hash type (bytevector->pointer digest)
               (bytevector->pointer bv) (bytevector-length bv))
         digest))))
 
+(define sha1
+  (cut bytevector-hash <> GCRY_MD_SHA1 20))
+
+(define sha256
+  (cut bytevector-hash <> GCRY_MD_SHA256 (/ 256 8)))
+
 (define open-sha256-md
   (let ((open (pointer->procedure int
                                   (libgcrypt-func "gcry_md_open")
@@ -159,7 +170,6 @@ data read from PORT.  The thunk always returns the same value."
 
   (define (unbuffered port)
     ;; Guile <= 2.0.9 does not support 'setvbuf' on custom binary input ports.
-    ;; If you get a wrong-type-arg error here, the fix is to upgrade Guile.  :-)
     (setvbuf port _IONBF)
     port)
 
diff --git a/guix/http-client.scm b/guix/http-client.scm
index bab31875d1..e8a2a23fc5 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2012, 2015 Free Software Foundation, Inc.
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
@@ -69,158 +69,6 @@
   (reason http-get-error-reason))                 ; string
 
 
-(define-syntax when-guile<=2.0.5-or-otherwise-broken
-  (lambda (s)
-    (syntax-case s ()
-      ((_ body ...)
-       ;; Always emit BODY, regardless of VERSION, because sometimes this code
-       ;; might be compiled with a recent Guile and run with 2.0.5---e.g.,
-       ;; when using "guix pull".
-       #'(begin body ...)))))
-
-(when-guile<=2.0.5-or-otherwise-broken
- ;; Backport of Guile commits 312e79f8 ("Add HTTP Chunked Encoding support to
- ;; web modules."), 00d3ecf2 ("http: Do not buffer HTTP chunks."), and 53b8d5f
- ;; ("web: Gracefully handle premature EOF when reading chunk header.")
-
- (use-modules (ice-9 rdelim))
-
- (define %web-http
-   (resolve-module '(web http)))
-
- ;; Chunked Responses
- (define (read-chunk-header port)
-   "Read a chunk header from PORT and return the size in bytes of the
- upcoming chunk."
-   (match (read-line port)
-     ((? eof-object?)
-      ;; Connection closed prematurely: there's nothing left to read.
-      0)
-     (str
-      (let ((extension-start (string-index str
-                                           (lambda (c)
-                                             (or (char=? c #\;)
-                                                 (char=? c #\return))))))
-        (string->number (if extension-start       ; unnecessary?
-                            (substring str 0 extension-start)
-                            str)
-                        16)))))
-
- (define* (make-chunked-input-port port #:key (keep-alive? #f))
-   "Returns a new port which translates HTTP chunked transfer encoded
-data from PORT into a non-encoded format. Returns eof when it has
-read the final chunk from PORT. This does not necessarily mean
-that there is no more data on PORT. When the returned port is
-closed it will also close PORT, unless the KEEP-ALIVE? is true."
-   (define (close)
-     (unless keep-alive?
-       (close-port port)))
-
-   (define chunk-size 0)     ;size of the current chunk
-   (define remaining 0)      ;number of bytes left from the current chunk
-   (define finished? #f)     ;did we get all the chunks?
-
-   (define (read! bv idx to-read)
-     (define (loop to-read num-read)
-       (cond ((or finished? (zero? to-read))
-              num-read)
-             ((zero? remaining)                    ;get a new chunk
-              (let ((size (read-chunk-header port)))
-                (set! chunk-size size)
-                (set! remaining size)
-                (if (zero? size)
-                    (begin
-                      (set! finished? #t)
-                      num-read)
-                    (loop to-read num-read))))
-             (else                           ;read from the current chunk
-              (let* ((ask-for (min to-read remaining))
-                     (read    (get-bytevector-n! port bv (+ idx num-read)
-                                                 ask-for)))
-                (if (eof-object? read)
-                    (begin                         ;premature termination
-                      (set! finished? #t)
-                      num-read)
-                    (let ((left (- remaining read)))
-                      (set! remaining left)
-                      (when (zero? left)
-                        ;; We're done with this chunk; read CR and LF.
-                        (get-u8 port) (get-u8 port))
-                      (loop (- to-read read)
-                            (+ num-read read))))))))
-     (loop to-read 0))
-
-   (make-custom-binary-input-port "chunked input port" read! #f #f close))
-
- ;; Chunked encoding support in Guile <= 2.0.11 would load whole chunks in
- ;; memory---see <http://bugs.gnu.org/19939>.
- (when (module-variable %web-http 'read-chunk-body)
-   (module-set! %web-http 'make-chunked-input-port make-chunked-input-port))
-
- (define (make-delimited-input-port port len keep-alive?)
-   "Return an input port that reads from PORT, and makes sure that
-exactly LEN bytes are available from PORT.  Closing the returned port
-closes PORT, unless KEEP-ALIVE? is true."
-   (define bytes-read 0)
-
-   (define (fail)
-     ((@@ (web response) bad-response)
-      "EOF while reading response body: ~a bytes of ~a"
-      bytes-read len))
-
-   (define (read! bv start count)
-     ;; Read at most LEN bytes in total.  HTTP/1.1 doesn't say what to do
-     ;; when a server provides more than the Content-Length, but it seems
-     ;; wise to just stop reading at LEN.
-     (let ((count (min count (- len bytes-read))))
-       (let loop ((ret (get-bytevector-n! port bv start count)))
-         (cond ((eof-object? ret)
-                (if (= bytes-read len)
-                    0                              ; EOF
-                    (fail)))
-               ((and (zero? ret) (> count 0))
-                ;; Do not return zero since zero means EOF, so try again.
-                (loop (get-bytevector-n! port bv start count)))
-               (else
-                (set! bytes-read (+ bytes-read ret))
-                ret)))))
-
-   (define close
-     (and (not keep-alive?)
-          (lambda ()
-            (close-port port))))
-
-   (make-custom-binary-input-port "delimited input port" read! #f #f close))
-
- (define (read-header-line port)
-   "Read an HTTP header line and return it without its final CRLF or LF.
-Raise a 'bad-header' exception if the line does not end in CRLF or LF,
-or if EOF is reached."
-   (match (%read-line port)
-     (((? string? line) . #\newline)
-      ;; '%read-line' does not consider #\return a delimiter; so if it's
-      ;; there, remove it.  We are more tolerant than the RFC in that we
-      ;; tolerate LF-only endings.
-      (if (string-suffix? "\r" line)
-          (string-drop-right line 1)
-          line))
-     ((line . _)                                ;EOF or missing delimiter
-      ((@@ (web http) bad-header) 'read-header-line line))))
-
- (unless (guile-version>? "2.0.11")
-   ;; Guile <= 2.0.9 had a bug whereby 'response-body-port' would read more
-   ;; than what 'content-length' says.  See Guile commit 802a25b.
-   ;; Guile <= 2.0.11 had a bug whereby the 'close' method of the response
-   ;; body port would fail with wrong-arg-num.  See Guile commit 5a10e41.
-   (module-set! (resolve-module '(web response))
-                'make-delimited-input-port make-delimited-input-port)
-
-   ;; Guile <= 2.0.11 was affected by <http://bugs.gnu.org/22273>.  See Guile
-   ;; commit 4c7732c.
-   (when (module-variable %web-http 'read-line*)
-     (module-set! %web-http 'read-line* read-header-line))))
-
-
 (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
                      keep-alive? (verify-certificate? #t)
                      (headers '((user-agent . "GNU Guile"))))
diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm
index 2ef02c43a4..58c051e283 100644
--- a/guix/import/cpan.scm
+++ b/guix/import/cpan.scm
@@ -131,7 +131,11 @@ or #f on failure.  MODULE should be e.g. \"Test::Script\""
      ;; version is sometimes not quoted in the module json, so it gets
      ;; imported into Guile as a number, so convert it to a string.
      (number->string version))
-    (version version)))
+    (version
+     ;; Sometimes we get a "v" prefix.  Strip it.
+     (if (string-prefix? "v" version)
+         (string-drop version 1)
+         version))))
 
 (define (perl-package)
   "Return the 'perl' package.  This is a lazy reference so that we don't
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 8e3e49e444..95dc9746bd 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2014, 2016 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
@@ -494,19 +494,19 @@ must be a manifest-pattern."
 Remove MANIFEST entries that have the same name and output as ENTRIES."
   (define (same-entry? entry name output)
     (match entry
-      (($ <manifest-entry> entry-name _ entry-output _ ...)
+      (($ <manifest-entry> entry-name _ entry-output _)
        (and (equal? name entry-name)
             (equal? output entry-output)))))
 
   (make-manifest
-   (append entries
-           (fold (lambda (entry result)
-                   (match entry
-                     (($ <manifest-entry> name _ out _ ...)
-                      (filter (negate (cut same-entry? <> name out))
-                              result))))
-                 (manifest-entries manifest)
-                 entries))))
+   (fold (lambda (entry result)                   ;XXX: quadratic
+           (match entry
+             (($ <manifest-entry> name _ out _)
+              (cons entry
+                    (remove (cut same-entry? <> name out)
+                            result)))))
+         (manifest-entries manifest)
+         entries)))
 
 (define (manifest-lookup manifest pattern)
   "Return the first item of MANIFEST that matches PATTERN, or #f if there is
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 67da6fc3bf..4f88c513c0 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2018 David Thompson <davet@gnu.org>
 ;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Mike Gerwitz <mtg@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -160,6 +161,13 @@ COMMAND or an interactive shell in that environment.\n"))
   (display (G_ "
   -N, --network          allow containers to access the network"))
   (display (G_ "
+  -P, --link-profile     link environment profile to ~/.guix-profile within
+                         an isolated container"))
+  (display (G_ "
+  -u, --user=USER        instead of copying the name and home of the current
+                         user into an isolated container, use the name USER
+                         with home directory /home/USER"))
+  (display (G_ "
       --share=SPEC       for containers, share writable host file system
                          according to SPEC"))
   (display (G_ "
@@ -243,6 +251,13 @@ COMMAND or an interactive shell in that environment.\n"))
          (option '(#\N "network") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'network? #t result)))
+         (option '(#\P "link-profile") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'link-profile? #t result)))
+         (option '(#\u "user") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'user arg
+                               (alist-delete 'user result eq?))))
          (option '("share") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'file-system-mapping
@@ -403,41 +418,50 @@ environment variables are cleared before setting the new ones."
     (pid (match (waitpid pid)
            ((_ . status) status)))))
 
-(define* (launch-environment/container #:key command bash user-mappings
-                                       profile paths network?)
+(define* (launch-environment/container #:key command bash user user-mappings
+                                       profile paths link-profile? network?)
   "Run COMMAND within a container that features the software in PROFILE.
 Environment variables are set according to PATHS, a list of native search
 paths.  The global shell is BASH, a file name for a GNU Bash binary in the
 store.  When NETWORK?, access to the host system network is permitted.
 USER-MAPPINGS, a list of file system mappings, contains the user-specified
-host file systems to mount inside the container."
+host file systems to mount inside the container.  If USER is not #f, each
+target of USER-MAPPINGS will be re-written relative to '/home/USER', and USER
+will be used for the passwd entry.  LINK-PROFILE? creates a symbolic link from
+~/.guix-profile to the environment profile."
   (mlet %store-monad ((reqs (inputs->requisites
                              (list (direct-store-path bash) profile))))
     (return
-     (let* ((cwd (getcwd))
-            (passwd (getpwuid (getuid)))
+     (let* ((cwd      (getcwd))
+            (home     (getenv "HOME"))
+            (passwd   (mock-passwd (getpwuid (getuid))
+                                   user
+                                   bash))
+            (home-dir (passwd:dir passwd))
             ;; Bind-mount all requisite store items, user-specified mappings,
             ;; /bin/sh, the current working directory, and possibly networking
             ;; configuration files within the container.
             (mappings
-             (append user-mappings
-                     ;; Current working directory.
-                     (list (file-system-mapping
-                            (source cwd)
-                            (target cwd)
-                            (writable? #t)))
-                     ;; When in Rome, do as Nix build.cc does: Automagically
-                     ;; map common network configuration files.
-                     (if network?
-                         %network-file-mappings
-                         '())
-                     ;; Mappings for the union closure of all inputs.
-                     (map (lambda (dir)
-                            (file-system-mapping
-                             (source dir)
-                             (target dir)
-                             (writable? #f)))
-                          reqs)))
+             (override-user-mappings
+              user home
+              (append user-mappings
+                      ;; Current working directory.
+                      (list (file-system-mapping
+                             (source cwd)
+                             (target cwd)
+                             (writable? #t)))
+                      ;; When in Rome, do as Nix build.cc does: Automagically
+                      ;; map common network configuration files.
+                      (if network?
+                          %network-file-mappings
+                          '())
+                      ;; Mappings for the union closure of all inputs.
+                      (map (lambda (dir)
+                             (file-system-mapping
+                              (source dir)
+                              (target dir)
+                              (writable? #f)))
+                           reqs))))
             (file-systems (append %container-file-systems
                                   (map file-system-mapping->bind-mount
                                        mappings))))
@@ -458,10 +482,14 @@ host file systems to mount inside the container."
                       ;; The same variables as in Nix's 'build.cc'.
                       '("TMPDIR" "TEMPDIR" "TMP" "TEMP"))
 
-            ;; Create a dummy home directory under the same name as on the
-            ;; host.
-            (mkdir-p (passwd:dir passwd))
-            (setenv "HOME" (passwd:dir passwd))
+            ;; Create a dummy home directory.
+            (mkdir-p home-dir)
+            (setenv "HOME" home-dir)
+
+            ;; If requested, link $GUIX_ENVIRONMENT to $HOME/.guix-profile;
+            ;; this allows programs expecting that path to continue working as
+            ;; expected within a container.
+            (when link-profile? (link-environment profile home-dir))
 
             ;; Create a dummy /etc/passwd to satisfy applications that demand
             ;; to read it, such as 'git clone' over SSH, a valid use-case when
@@ -481,7 +509,7 @@ host file systems to mount inside the container."
 
             ;; For convenience, start in the user's current working
             ;; directory rather than the root directory.
-            (chdir cwd)
+            (chdir (override-user-dir user home cwd))
 
             (primitive-exit/status
              ;; A container's environment is already purified, so no need to
@@ -491,6 +519,72 @@ host file systems to mount inside the container."
                            (delq 'net %namespaces) ; share host network
                            %namespaces)))))))
 
+(define (mock-passwd passwd user-override shell)
+  "Generate mock information for '/etc/passwd'.  If USER-OVERRIDE is not '#f',
+it is expected to be a string representing the mock username; it will produce
+a user of that name, with a home directory of '/home/USER-OVERRIDE', and no
+GECOS field.  If USER-OVERRIDE is '#f', data will be inherited from PASSWD.
+In either case, the shadow password and UID/GID are cleared, since the user
+runs as root within the container.  SHELL will always be used in place of the
+shell in PASSWD.
+
+The resulting vector is suitable for use with Guile's POSIX user procedures.
+
+See passwd(5) for more information each of the fields."
+  (if user-override
+      (vector
+       user-override
+        "x" "0" "0"  ;; no shadow, user is now root
+        ""           ;; no personal information
+        (user-override-home user-override)
+        shell)
+      (vector
+       (passwd:name passwd)
+        "x" "0" "0"  ;; no shadow, user is now root
+        (passwd:gecos passwd)
+        (passwd:dir passwd)
+        shell)))
+
+(define (user-override-home user)
+  "Return home directory for override user USER."
+  (string-append "/home/" user))
+
+(define (override-user-mappings user home mappings)
+  "If a username USER is provided, rewrite each HOME prefix in file system
+mappings MAPPINGS to a home directory determined by 'override-user-dir';
+otherwise, return MAPPINGS."
+  (if (not user)
+      mappings
+      (map (lambda (mapping)
+             (let ((target (file-system-mapping-target mapping)))
+               (if (string-prefix? home target)
+                   (file-system-mapping
+                    (source    (file-system-mapping-source mapping))
+                    (target    (override-user-dir user home target))
+                    (writable? (file-system-mapping-writable? mapping)))
+                   mapping)))
+           mappings)))
+
+(define (override-user-dir user home dir)
+  "If username USER is provided, overwrite string prefix HOME in DIR with a
+directory determined by 'user-override-home'; otherwise, return DIR."
+  (if (and user (string-prefix? home dir))
+      (string-append (user-override-home user)
+                     (substring dir (string-length home)))
+      dir))
+
+(define (link-environment profile home-dir)
+  "Create a symbolic link from HOME-DIR/.guix-profile to PROFILE."
+  (let ((profile-dir (string-append home-dir "/.guix-profile")))
+    (catch 'system-error
+      (lambda ()
+        (symlink profile profile-dir))
+      (lambda args
+        (if (= EEXIST (system-error-errno args))
+            (leave (G_ "cannot link profile: '~a' already exists within container~%")
+                   profile-dir)
+            (apply throw args))))))
+
 (define (environment-bash container? bootstrap? system)
   "Return a monadic value in the store monad for the version of GNU Bash
 needed in the environment for SYSTEM, if any.  If CONTAINER? is #f, return #f.
@@ -564,7 +658,9 @@ message if any test fails."
     (let* ((opts       (parse-args args))
            (pure?      (assoc-ref opts 'pure))
            (container? (assoc-ref opts 'container?))
+           (link-prof? (assoc-ref opts 'link-profile?))
            (network?   (assoc-ref opts 'network?))
+           (user       (assoc-ref opts 'user))
            (bootstrap? (assoc-ref opts 'bootstrap?))
            (system     (assoc-ref opts 'system))
            (command    (or (assoc-ref opts 'exec)
@@ -597,6 +693,11 @@ message if any test fails."
 
       (when container? (assert-container-features))
 
+      (when (and (not container?) link-prof?)
+        (leave (G_ "'--link-profile' cannot be used without '--container'~%")))
+      (when (and (not container?) user)
+        (leave (G_ "'--user' cannot be used without '--container'~%")))
+
       (with-store store
         (set-build-options-from-command-line store opts)
 
@@ -643,9 +744,11 @@ message if any test fails."
                                             "/bin/sh"))))
                     (launch-environment/container #:command command
                                                   #:bash bash-binary
+                                                  #:user user
                                                   #:user-mappings mappings
                                                   #:profile profile
                                                   #:paths paths
+                                                  #:link-profile? link-prof?
                                                   #:network? network?)))
                  (else
                   (return
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 617e102d93..d8b80efe8e 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2013, 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2014, 2016 Alex Kost <alezost@gmail.com>
@@ -247,11 +247,15 @@ specified in MANIFEST, a manifest object."
 description matches at least one of REGEXPS sorted by relevance, and the list
 of relevance scores."
   (let ((matches (fold-packages (lambda (package result)
-                                  (match (package-relevance package regexps)
-                                    ((? zero?)
-                                     result)
-                                    (score
-                                     (cons (list package score) result))))
+                                  (if (package-superseded package)
+                                      result
+                                      (match (package-relevance package
+                                                                regexps)
+                                        ((? zero?)
+                                         result)
+                                        (score
+                                         (cons (list package score)
+                                               result)))))
                                 '())))
     (unzip2 (sort matches
                   (lambda (m1 m2)
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 2fd2bf8104..8e1119fb49 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -212,15 +212,7 @@ provide."
            (begin
              (warning (G_ "while fetching ~a: server is somewhat slow~%")
                       (uri->string uri))
-             (warning (G_ "try `--no-substitutes' if the problem persists~%"))
-
-             ;; Before Guile v2.0.9-39-gfe51c7b, EINTR was reported to the user,
-             ;; and thus PORT had to be closed and re-opened.  This is not the
-             ;; case afterward.
-             (unless (or (guile-version>? "2.0.9")
-                         (version>? (version) "2.0.9.39"))
-               (when port
-                 (close-connection port))))
+             (warning (G_ "try `--no-substitutes' if the problem persists~%")))
            (begin
              (when (or (not port) (port-closed? port))
                (set! port (guix:open-connection-for-uri
@@ -571,10 +563,8 @@ initial connection on which HTTP requests are sent."
       ;; XXX: Do our own caching to work around inefficiencies when
       ;; communicating over TLS: <http://bugs.gnu.org/22966>.
       (let-values (((buffer get) (open-bytevector-output-port)))
-        ;; On Guile > 2.0.9, inherit the HTTP proxying property from P.
-        (when (module-variable (resolve-interface '(web http))
-                               'http-proxy-port?)
-          (set-http-proxy-port?! buffer (http-proxy-port? p)))
+        ;; Inherit the HTTP proxying property from P.
+        (set-http-proxy-port?! buffer (http-proxy-port? p))
 
         (for-each (cut write-request <> buffer)
                   (at-most 1000 requests))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 999ffb010b..acfccce96d 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -41,6 +41,9 @@
   #:use-module (gnu build install)
   #:autoload   (gnu build file-systems)
                  (find-partition-by-label find-partition-by-uuid)
+  #:autoload   (gnu build linux-modules)
+                 (device-module-aliases matching-modules)
+  #:use-module (gnu system linux-initrd)
   #:use-module (gnu system)
   #:use-module (gnu bootloader)
   #:use-module (gnu system file-systems)
@@ -624,21 +627,49 @@ any, are available.  Raise an error if they're not."
       ;; Better be safe than sorry.
       (exit 1))))
 
-(define (check-mapped-devices mapped-devices)
+(define (check-mapped-devices os)
   "Check that each of MAPPED-DEVICES is valid according to the 'check'
 procedure of its type."
+  (define boot-mapped-devices
+    (operating-system-boot-mapped-devices os))
+
+  (define (needed-for-boot? md)
+    (memq md boot-mapped-devices))
+
+  (define initrd-modules
+    (operating-system-initrd-modules os))
+
   (for-each (lambda (md)
               (let ((check (mapped-device-kind-check
                             (mapped-device-type md))))
                 ;; We expect CHECK to raise an exception with a detailed
-                ;; '&message' if something goes wrong, but handle the case
-                ;; where it just returns #f.
-                (unless (check md)
-                  (leave (G_ "~a: invalid '~a' mapped device~%")
-                         (location->string
-                          (source-properties->location
-                           (mapped-device-location md)))))))
-            mapped-devices))
+                ;; '&message' if something goes wrong.
+                (check md
+                       #:needed-for-boot? (needed-for-boot? md)
+                       #:initrd-modules initrd-modules)))
+            (operating-system-mapped-devices os)))
+
+(define (check-initrd-modules os)
+  "Check that modules needed by 'needed-for-boot' file systems in OS are
+available in the initrd.  Note that mapped devices are responsible for
+checking this by themselves in their 'check' procedure."
+  (define (file-system-/dev fs)
+    (let ((device (file-system-device fs)))
+      (match (file-system-title fs)
+        ('device device)
+        ('uuid   (find-partition-by-uuid device))
+        ('label  (find-partition-by-label device)))))
+
+  (define file-systems
+    (filter file-system-needed-for-boot?
+            (operating-system-file-systems os)))
+
+  (for-each (lambda (fs)
+              (check-device-initrd-modules (file-system-/dev fs)
+                                           (operating-system-initrd-modules os)
+                                           (source-properties->location
+                                            (file-system-location fs))))
+            file-systems))
 
 
 ;;;
@@ -730,9 +761,10 @@ output when building a system derivation, such as a disk image."
   ;; instantiating a broken configuration.  Assume that we can only check if
   ;; running as root.
   (when (memq action '(init reconfigure))
+    (check-mapped-devices os)
     (when (zero? (getuid))
-      (check-file-system-availability (operating-system-file-systems os)))
-    (check-mapped-devices (operating-system-mapped-devices os)))
+      (check-file-system-availability (operating-system-file-systems os))
+      (check-initrd-modules os)))
 
   (mlet* %store-monad
       ((sys       (system-derivation-for-action os action
diff --git a/guix/ui.scm b/guix/ui.scm
index fb2380b68a..cb49a15c4d 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -52,6 +52,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:use-module (ice-9 regex)
+  #:autoload   (system base compile) (compile-file)
   #:autoload   (system repl repl)  (start-repl)
   #:autoload   (system repl debug) (make-debug stack->vector)
   #:use-module (texinfo)
@@ -186,8 +187,8 @@ messages."
 
   (define (error-string frame args)
     (call-with-output-string
-     (lambda (port)
-       (apply display-error frame port (cdr args)))))
+      (lambda (port)
+        (apply display-error frame port (cdr args)))))
 
   (define tag
     (make-prompt-tag "user-code"))
@@ -199,9 +200,10 @@ messages."
       ;; In 2.2.3, the bogus answer to <https://bugs.gnu.org/29226> was to
       ;; ignore all available .go, not just those from ~/.cache, which in turn
       ;; meant that we had to rebuild *everything*.  Since this is too costly,
-      ;; we have to turn auto '%fresh-auto-compile' with that version, at the
-      ;; risk of getting ABI breakage in the user's config file.  See
-      ;; <https://bugs.gnu.org/29881>.
+      ;; we have to turn off '%fresh-auto-compile' with that version, so to
+      ;; avoid ABI breakage in the user's config file, we explicitly compile
+      ;; it (the problem remains if the user's config is spread on several
+      ;; modules.)  See <https://bugs.gnu.org/29881>.
       (unless (string=? (version) "2.2.3")
         (set! %fresh-auto-compile #t))
 
@@ -215,6 +217,12 @@ messages."
          (parameterize ((current-warning-port (%make-void-port "w")))
            (call-with-prompt tag
              (lambda ()
+               (when (string=? (version) "2.2.3")
+                 (catch 'system-error
+                   (lambda ()
+                     (compile-file file #:env user-module))
+                   (const #f)))              ;EACCES maybe, let's interpret it
+
                ;; Give 'load' an absolute file name so that it doesn't try to
                ;; search for FILE in %LOAD-PATH.  Note: use 'load', not
                ;; 'primitive-load', so that FILE is compiled, which then allows us
@@ -291,8 +299,10 @@ VARIABLE and return it, or #f if none was found."
   "Display MESSAGE, a l10n message possibly containing Texinfo markup, to
 PORT."
   (format port (G_ "hint: ~a~%")
-          (fill-paragraph (texi->plain-text message)
-                          (terminal-columns) 8)))
+          ;; XXX: We should arrange so that the initial indent is wider.
+          (parameterize ((%text-width (max 15
+                                           (- (terminal-columns) 5))))
+            (texi->plain-text message))))
 
 (define* (report-load-error file args #:optional frame)
   "Report the failure to load FILE, a user-provided Scheme file.
@@ -631,6 +641,8 @@ directories:~{ ~a~}~%")
                      (G_ "~a: error: ~a~%")
                      (location->string (error-location c))
                      (gettext (condition-message c) %gettext-domain))
+             (when (fix-hint? c)
+               (display-hint (condition-fix-hint c)))
              (exit 1))
             ((and (message-condition? c) (fix-hint? c))
              (format (current-error-port) "~a: error: ~a~%"