Merge branch 'master' into core-updates

22 files changed, 865 insertions, 377 deletions

diff --git a/guix/build/download.scm b/guix/build/download.scm
index 0568800d7f..fec4cec3e8 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -39,8 +39,10 @@
             maybe-expand-mirrors
             url-fetch
             byte-count->string
+            current-terminal-columns
             progress-proc
             uri-abbreviation
+            nar-uri-abbreviation
             store-path-abbreviation))
 
 ;;; Commentary:
@@ -53,6 +55,10 @@
   ;; Size of the HTTP receive buffer.
   65536)
 
+(define current-terminal-columns
+  ;; Number of columns of the terminal.
+  (make-parameter 80))
+
 (define (nearest-exact-integer x)
   "Given a real number X, return the nearest exact integer, with ties going to
 the nearest exact even integer."
@@ -166,9 +172,10 @@ used to shorten FILE for display."
                                          (byte-count->string throughput)
                                          (seconds->string elapsed)
                                          (progress-bar %) %)))
-                ;; TODO: Make this adapt to the actual terminal width.
-                (display (string-pad-middle left right 80) log-port)
-                (display #\cr log-port)
+                (display "\r\x1b[K" log-port)
+                (display (string-pad-middle left right
+                                            (current-terminal-columns))
+                         log-port)
                 (flush-output-port log-port)
                 (cont))))
           (lambda (transferred cont)
@@ -182,9 +189,10 @@ used to shorten FILE for display."
                                          (byte-count->string throughput)
                                          (seconds->string elapsed)
                                          (byte-count->string transferred))))
-                ;; TODO: Make this adapt to the actual terminal width.
-                (display (string-pad-middle left right 80) log-port)
-                (display #\cr log-port)
+                (display "\r\x1b[K" log-port)
+                (display (string-pad-middle left right
+                                            (current-terminal-columns))
+                         log-port)
                 (flush-output-port log-port)
                 (cont))))))))
 
@@ -195,13 +203,18 @@ abbreviation of URI showing the scheme, host, and basename of the file."
     (uri->string uri))
 
   (define (elide-path)
-    (let ((path (uri-path uri)))
-      (string-append (symbol->string (uri-scheme uri)) "://"
+    (let* ((path   (uri-path uri))
+           (base   (basename path))
+           (prefix (string-append (symbol->string (uri-scheme uri)) "://"
 
-                     ;; `file' URIs have no host part.
-                     (or (uri-host uri) "")
+                                  ;; `file' URIs have no host part.
+                                  (or (uri-host uri) "")
 
-                     (string-append "/.../" (basename path)))))
+                                  (string-append "/" (ellipsis) "/"))))
+      (if (> (+ (string-length prefix) (string-length base)) max-length)
+          (string-append prefix (ellipsis)
+                         (string-drop base (quotient (string-length base) 2)))
+          (string-append prefix base))))
 
   (if (> (string-length uri-as-string) max-length)
       (let ((short (elide-path)))
@@ -210,6 +223,17 @@ abbreviation of URI showing the scheme, host, and basename of the file."
             uri-as-string))
       uri-as-string))
 
+(define (nar-uri-abbreviation uri)
+  "Abbreviate URI, which is assumed to be the URI of a nar as served by Hydra
+and 'guix publish', something like
+\"http://example.org/nar/1ldrllwbna0aw5z8kpci4fsvbd2w8cw4-texlive-bin-2015\"."
+  (let* ((uri  (if (string? uri) (string->uri uri) uri))
+         (path (basename (uri-path uri))))
+    (if (and (> (string-length path) 33)
+             (char=? (string-ref path 32) #\-))
+        (string-drop path 33)
+        path)))
+
 (define (ftp-fetch uri file)
   "Fetch data from URI and write it to FILE.  Return FILE on success."
   (let* ((conn (ftp-open (uri-host uri)))
@@ -267,6 +291,13 @@ host name without trailing dot."
 
     (set-session-transport-fd! session (fileno port))
     (set-session-default-priority! session)
+
+    ;; The "%COMPAT" bit allows us to work around firewall issues (info
+    ;; "(gnutls) Priority Strings"); see <http://bugs.gnu.org/23311>.
+    ;; Explicitly disable SSLv3, which is insecure:
+    ;; <https://tools.ietf.org/html/rfc7568>.
+    (set-session-priorities! session "NORMAL:%COMPAT:-VERS-SSL3.0")
+
     (set-session-credentials! session (make-certificate-credentials))
 
     ;; Uncomment the following lines in case of debugging emergency.
@@ -530,7 +561,8 @@ Return the resulting target URI."
                  (put-bytevector p bv-or-port))))
          file))
       ((301                                       ; moved permanently
-        302)                                      ; found (redirection)
+        302                                       ; found (redirection)
+        307)                                      ; temporary redirection
        (let ((uri (resolve-uri-reference (response-location resp) uri)))
          (format #t "following redirection to `~a'...~%"
                  (uri->string uri))
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 69a507def8..4e543d70d8 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -46,6 +47,21 @@
             mount-points
             swapon
             swapoff
+
+            file-system?
+            file-system-type
+            file-system-block-size
+            file-system-block-count
+            file-system-blocks-free
+            file-system-blocks-available
+            file-system-file-count
+            file-system-free-file-nodes
+            file-system-identifier
+            file-system-maximum-name-length
+            file-system-fragment-size
+            file-system-mount-flags
+            statfs
+
             processes
             mkdtemp!
             pivot-root
@@ -82,7 +98,31 @@
             interface-address
             interface-netmask
             interface-broadcast-address
-            network-interfaces))
+            network-interfaces
+
+            termios?
+            termios-input-flags
+            termios-output-flags
+            termios-control-flags
+            termios-local-flags
+            termios-line-discipline
+            termios-control-chars
+            termios-input-speed
+            termios-output-speed
+            local-flags
+            TCSANOW
+            TCSADRAIN
+            TCSAFLUSH
+            tcgetattr
+            tcsetattr
+
+            window-size?
+            window-size-rows
+            window-size-columns
+            window-size-x-pixels
+            window-size-y-pixels
+            terminal-window-size
+            terminal-columns))
 
 ;;; Commentary:
 ;;;
@@ -92,6 +132,155 @@
 ;;;
 ;;; Code:
 
+
+;;;
+;;; Packed structures.
+;;;
+
+(define-syntax sizeof*
+  ;; XXX: This duplicates 'compile-time-value'.
+  (syntax-rules (int128 array)
+    ((_ int128)
+     16)
+    ((_ (array type n))
+     (* (sizeof* type) n))
+    ((_ type)
+     (let-syntax ((v (lambda (s)
+                       (let ((val (sizeof type)))
+                         (syntax-case s ()
+                           (_ val))))))
+       v))))
+
+(define-syntax alignof*
+  ;; XXX: This duplicates 'compile-time-value'.
+  (syntax-rules (int128 array)
+    ((_ int128)
+     16)
+    ((_ (array type n))
+     (alignof* type))
+    ((_ type)
+     (let-syntax ((v (lambda (s)
+                       (let ((val (alignof type)))
+                         (syntax-case s ()
+                           (_ val))))))
+       v))))
+
+(define-syntax align                             ;as found in (system foreign)
+  (syntax-rules (~)
+    "Add to OFFSET whatever it takes to get proper alignment for TYPE."
+    ((_ offset (type ~ endianness))
+     (align offset type))
+    ((_ offset type)
+     (1+ (logior (1- offset) (1- (alignof* type)))))))
+
+(define-syntax type-size
+  (syntax-rules (~)
+    ((_ (type ~ order))
+     (sizeof* type))
+    ((_ type)
+     (sizeof* type))))
+
+(define-syntax struct-alignment
+  (syntax-rules ()
+    "Compute the alignment for the aggregate made of TYPES at OFFSET.  The
+result is the alignment of the \"most strictly aligned component\"."
+    ((_ offset types ...)
+     (max (align offset types) ...))))
+
+(define-syntax struct-size
+  (syntax-rules ()
+    "Return the size in bytes of the structure made of TYPES."
+    ((_ offset (types-processed ...))
+     ;; The SysV ABI P.S. says: "Aggregates (structures and arrays) and unions
+     ;; assume the alignment of their most strictly aligned component."  As an
+     ;; example, a struct such as "int32, int16" has size 8, not 6.
+     (1+ (logior (1- offset)
+                 (1- (struct-alignment offset types-processed ...)))))
+    ((_ offset (types-processed ...) type0 types ...)
+     (struct-size (+ (type-size type0) (align offset type0))
+                  (type0 types-processed ...)
+                  types ...))))
+
+(define-syntax write-type
+  (syntax-rules (~ array)
+    ((_ bv offset (type ~ order) value)
+     (bytevector-uint-set! bv offset value
+                           (endianness order) (sizeof* type)))
+    ((_ bv offset (array type n) value)
+     (let loop ((i 0)
+                (value value)
+                (o offset))
+       (unless (= i n)
+         (match value
+           ((head . tail)
+            (write-type bv o type head)
+            (loop (+ 1 i) tail (+ o (sizeof* type))))))))
+    ((_ bv offset type value)
+     (bytevector-uint-set! bv offset value
+                           (native-endianness) (sizeof* type)))))
+
+(define-syntax write-types
+  (syntax-rules ()
+    ((_ bv offset () ())
+     #t)
+    ((_ bv offset (type0 types ...) (field0 fields ...))
+     (begin
+       (write-type bv (align offset type0) type0 field0)
+       (write-types bv
+                    (+ (align offset type0) (type-size type0))
+                    (types ...) (fields ...))))))
+
+(define-syntax read-type
+  (syntax-rules (~ array quote *)
+    ((_ bv offset '*)
+     (make-pointer (bytevector-uint-ref bv offset
+                                        (native-endianness)
+                                        (sizeof* '*))))
+    ((_ bv offset (type ~ order))
+     (bytevector-uint-ref bv offset
+                          (endianness order) (sizeof* type)))
+    ((_ bv offset (array type n))
+     (unfold (lambda (i) (= i n))
+             (lambda (i)
+               (read-type bv (+ offset (* i (sizeof* type))) type))
+             1+
+             0))
+    ((_ bv offset type)
+     (bytevector-uint-ref bv offset
+                          (native-endianness) (sizeof* type)))))
+
+(define-syntax read-types
+  (syntax-rules ()
+    ((_ return bv offset () (values ...))
+     (return values ...))
+    ((_ return bv offset (type0 types ...) (values ...))
+     (read-types return
+                 bv
+                 (+ (align offset type0) (type-size type0))
+                 (types ...)
+                 (values ... (read-type bv
+                                        (align offset type0)
+                                        type0))))))
+
+(define-syntax define-c-struct
+  (syntax-rules ()
+    "Define SIZE as the size in bytes of the C structure made of FIELDS.  READ
+as a deserializer and WRITE! as a serializer for the C structure with the
+given TYPES.  READ uses WRAP-FIELDS to return its value."
+    ((_ name size wrap-fields read write! (fields types) ...)
+     (begin
+       (define size
+         (struct-size 0 () types ...))
+       (define (write! bv offset fields ...)
+         (write-types bv offset (types ...) (fields ...)))
+       (define* (read bv #:optional (offset 0))
+         (read-types wrap-fields bv offset (types ...) ()))))))
+
+
+;;;
+;;; FFI.
+;;;
+
 (define %libc-errno-pointer
   ;; Glibc's 'errno' pointer.
   (let ((errno-loc (dynamic-func "__errno_location" (dynamic-link))))
@@ -137,6 +326,24 @@
   "Evaluate EXPR and restart upon EINTR.  Return the value of EXPR."
   (call-with-restart-on-EINTR (lambda () expr)))
 
+(define (syscall->procedure return-type name argument-types)
+  "Return a procedure that wraps the C function NAME using the dynamic FFI.
+If an error occurs while creating the binding, defer the error report until
+the returned procedure is called."
+  (catch #t
+    (lambda ()
+      (let ((ptr (dynamic-func name (dynamic-link))))
+        (pointer->procedure return-type ptr argument-types)))
+    (lambda args
+      (lambda _
+        (error (format #f "~a: syscall->procedure failed: ~s"
+                       name args))))))
+
+
+;;;
+;;; File systems.
+;;;
+
 (define (augment-mtab source target type options)
   "Augment /etc/mtab with information about the given mount point."
   (let ((port (open-file "/etc/mtab" "a")))
@@ -185,8 +392,7 @@
 (define UMOUNT_NOFOLLOW 8)
 
 (define mount
-  (let* ((ptr  (dynamic-func "mount" (dynamic-link)))
-         (proc (pointer->procedure int ptr `(* * * ,unsigned-long *))))
+  (let ((proc (syscall->procedure int "mount" `(* * * ,unsigned-long *))))
     (lambda* (source target type #:optional (flags 0) options
                      #:key (update-mtab? #f))
       "Mount device SOURCE on TARGET as a file system TYPE.  Optionally, FLAGS
@@ -214,8 +420,7 @@ error."
           (augment-mtab source target type options))))))
 
 (define umount
-  (let* ((ptr  (dynamic-func "umount2" (dynamic-link)))
-         (proc (pointer->procedure int ptr `(* ,int))))
+  (let ((proc (syscall->procedure int "umount2" `(* ,int))))
     (lambda* (target #:optional (flags 0)
                      #:key (update-mtab? #f))
       "Unmount TARGET.  Optionally FLAGS may be one of the MNT_* or UMOUNT_*
@@ -242,8 +447,7 @@ constants from <sys/mount.h>."
                  (loop (cons mount-point result))))))))))
 
 (define swapon
-  (let* ((ptr  (dynamic-func "swapon" (dynamic-link)))
-         (proc (pointer->procedure int ptr (list '* int))))
+  (let ((proc (syscall->procedure int "swapon" (list '* int))))
     (lambda* (device #:optional (flags 0))
       "Use the block special device at DEVICE for swapping."
       (let ((ret (proc (string->pointer device) flags))
@@ -254,8 +458,7 @@ constants from <sys/mount.h>."
                  (list err)))))))
 
 (define swapoff
-  (let* ((ptr  (dynamic-func "swapoff" (dynamic-link)))
-         (proc (pointer->procedure int ptr '(*))))
+  (let ((proc (syscall->procedure int "swapoff" '(*))))
     (lambda (device)
       "Stop using block special device DEVICE for swapping."
       (let ((ret (proc (string->pointer device)))
@@ -304,6 +507,65 @@ string TMPL and return its file name.  TMPL must end with 'XXXXXX'."
                  (list err)))
         (pointer->string result)))))
 
+
+(define-record-type <file-system>
+  (file-system type block-size blocks blocks-free
+               blocks-available files free-files identifier
+               name-length fragment-size mount-flags spare)
+  file-system?
+  (type              file-system-type)
+  (block-size        file-system-block-size)
+  (blocks            file-system-block-count)
+  (blocks-free       file-system-blocks-free)
+  (blocks-available  file-system-blocks-available)
+  (files             file-system-file-count)
+  (free-files        file-system-free-file-nodes)
+  (identifier        file-system-identifier)
+  (name-length       file-system-maximum-name-length)
+  (fragment-size     file-system-fragment-size)
+  (mount-flags       file-system-mount-flags)
+  (spare             file-system--spare))
+
+(define-syntax fsword                             ;fsword_t
+  (identifier-syntax long))
+
+(define-c-struct %statfs                          ;<bits/statfs.h>
+  sizeof-statfs                                   ;slightly overestimated
+  file-system
+  read-statfs
+  write-statfs!
+  (type             fsword)
+  (block-size       fsword)
+  (blocks           uint64)
+  (blocks-free      uint64)
+  (blocks-available uint64)
+  (files            uint64)
+  (free-files       uint64)
+  (identifier       (array int 2))
+  (name-length      fsword)
+  (fragment-size    fsword)
+  (mount-flags      fsword)
+  (spare            (array fsword 4)))
+
+(define statfs
+  (let ((proc (syscall->procedure int "statfs64" '(* *))))
+    (lambda (file)
+      "Return a <file-system> data structure describing the file system
+mounted at FILE."
+      (let* ((stat (make-bytevector sizeof-statfs))
+             (ret  (proc (string->pointer file) (bytevector->pointer stat)))
+             (err  (errno)))
+        (if (zero? ret)
+            (read-statfs stat)
+            (throw 'system-error "statfs" "~A: ~A"
+                   (list file (strerror err))
+                   (list err)))))))
+
+
+;;;
+;;; Containers.
+;;;
+
 ;; Linux clone flags, from linux/sched.h
 (define CLONE_CHILD_CLEARTID #x00200000)
 (define CLONE_CHILD_SETTID   #x01000000)
@@ -319,18 +581,18 @@ string TMPL and return its file name.  TMPL must end with 'XXXXXX'."
 ;; declared in <unistd.h> as a variadic function; in practice, it expects 6
 ;; pointer-sized arguments, as shown in, e.g., x86_64/syscall.S.
 (define clone
-  (let* ((ptr        (dynamic-func "syscall" (dynamic-link)))
-         (proc       (pointer->procedure long ptr
-                                         (list long                   ;sysno
-                                               unsigned-long          ;flags
-                                               '* '* '*
-                                               '*)))
+  (let* ((proc (syscall->procedure int "syscall"
+                                   (list long                   ;sysno
+                                         unsigned-long          ;flags
+                                         '* '* '*
+                                         '*)))
          ;; TODO: Don't do this.
          (syscall-id (match (utsname:machine (uname))
                        ("i686"   120)
                        ("x86_64" 56)
                        ("mips64" 5055)
-                       ("armv7l" 120))))
+                       ("armv7l" 120)
+                       (_ #f))))
     (lambda (flags)
       "Create a new child process by duplicating the current parent process.
 Unlike the fork system call, clone accepts FLAGS that specify which resources
@@ -365,8 +627,7 @@ there is no such limitation."
                   (list err))))))))
 
 (define pivot-root
-  (let* ((ptr  (dynamic-func "pivot_root" (dynamic-link)))
-         (proc (pointer->procedure int ptr (list '* '*))))
+  (let ((proc (syscall->procedure int "pivot_root" (list '* '*))))
     (lambda (new-root put-old)
       "Change the root file system to NEW-ROOT and move the current root file
 system to PUT-OLD."
@@ -380,107 +641,6 @@ system to PUT-OLD."
 
 
 ;;;
-;;; Packed structures.
-;;;
-
-(define-syntax sizeof*
-  ;; XXX: This duplicates 'compile-time-value'.
-  (syntax-rules (int128)
-    ((_ int128)
-     16)
-    ((_ type)
-     (let-syntax ((v (lambda (s)
-                       (let ((val (sizeof type)))
-                         (syntax-case s ()
-                           (_ val))))))
-       v))))
-
-(define-syntax alignof*
-  ;; XXX: This duplicates 'compile-time-value'.
-  (syntax-rules (int128)
-    ((_ int128)
-     16)
-    ((_ type)
-     (let-syntax ((v (lambda (s)
-                       (let ((val (alignof type)))
-                         (syntax-case s ()
-                           (_ val))))))
-       v))))
-
-(define-syntax align                             ;as found in (system foreign)
-  (syntax-rules (~)
-    "Add to OFFSET whatever it takes to get proper alignment for TYPE."
-    ((_ offset (type ~ endianness))
-     (align offset type))
-    ((_ offset type)
-     (1+ (logior (1- offset) (1- (alignof* type)))))))
-
-(define-syntax type-size
-  (syntax-rules (~)
-    ((_ (type ~ order))
-     (sizeof* type))
-    ((_ type)
-     (sizeof* type))))
-
-(define-syntax write-type
-  (syntax-rules (~)
-    ((_ bv offset (type ~ order) value)
-     (bytevector-uint-set! bv offset value
-                           (endianness order) (sizeof* type)))
-    ((_ bv offset type value)
-     (bytevector-uint-set! bv offset value
-                           (native-endianness) (sizeof* type)))))
-
-(define-syntax write-types
-  (syntax-rules ()
-    ((_ bv offset () ())
-     #t)
-    ((_ bv offset (type0 types ...) (field0 fields ...))
-     (begin
-       (write-type bv (align offset type0) type0 field0)
-       (write-types bv
-                    (+ (align offset type0) (type-size type0))
-                    (types ...) (fields ...))))))
-
-(define-syntax read-type
-  (syntax-rules (~ quote *)
-    ((_ bv offset '*)
-     (make-pointer (bytevector-uint-ref bv offset
-                                        (native-endianness)
-                                        (sizeof* '*))))
-    ((_ bv offset (type ~ order))
-     (bytevector-uint-ref bv offset
-                          (endianness order) (sizeof* type)))
-    ((_ bv offset type)
-     (bytevector-uint-ref bv offset
-                          (native-endianness) (sizeof* type)))))
-
-(define-syntax read-types
-  (syntax-rules ()
-    ((_ return bv offset () (values ...))
-     (return values ...))
-    ((_ return bv offset (type0 types ...) (values ...))
-     (read-types return
-                 bv
-                 (+ (align offset type0) (type-size type0))
-                 (types ...)
-                 (values ... (read-type bv
-                                        (align offset type0)
-                                        type0))))))
-
-(define-syntax define-c-struct
-  (syntax-rules ()
-    "Define READ as a deserializer and WRITE! as a serializer for the C
-structure with the given TYPES.  READ uses WRAP-FIELDS to return its value."
-    ((_ name wrap-fields read write! (fields types) ...)
-     (begin
-       (define (write! bv offset fields ...)
-         (write-types bv offset (types ...) (fields ...)))
-       (define (read bv offset)
-         (read-types wrap-fields bv offset (types ...) ()))))))
-
-
-;;;
 ;;; Network interfaces.
 ;;;
 
@@ -527,6 +687,7 @@ structure with the given TYPES.  READ uses WRAP-FIELDS to return its value."
       32))
 
 (define-c-struct sockaddr-in                      ;<linux/in.h>
+  sizeof-sockaddrin
   (lambda (family port address)
     (make-socket-address family address port))
   read-sockaddr-in
@@ -536,6 +697,7 @@ structure with the given TYPES.  READ uses WRAP-FIELDS to return its value."
   (address   (int32 ~ big)))
 
 (define-c-struct sockaddr-in6                     ;<linux/in6.h>
+  sizeof-sockaddr-in6
   (lambda (family port flowinfo address scopeid)
     (make-socket-address family address port flowinfo scopeid))
   read-sockaddr-in6
@@ -800,6 +962,7 @@ an <interface> object, and whose cdr is the pointer NEXT."
         next))
 
 (define-c-struct ifaddrs                          ;<ifaddrs.h>
+  %sizeof-ifaddrs
   values->interface
   read-ifaddrs
   write-ifaddrs!
@@ -811,14 +974,6 @@ an <interface> object, and whose cdr is the pointer NEXT."
   (broadcastaddr '*)
   (data          '*))
 
-(define-syntax %struct-ifaddrs-type
-  (identifier-syntax
-   `(* * ,unsigned-int * * * *)))
-
-(define-syntax %sizeof-ifaddrs
-  (identifier-syntax
-   (sizeof* %struct-ifaddrs-type)))
-
 (define (unfold-interface-list ptr)
   "Call 'read-ifaddrs' on PTR and all its 'next' fields, recursively, and
 return the list of resulting <interface> objects."
@@ -826,8 +981,7 @@ return the list of resulting <interface> objects."
              (result '()))
     (if (null-pointer? ptr)
         (reverse result)
-        (match (read-ifaddrs (pointer->bytevector ptr %sizeof-ifaddrs)
-                             0)
+        (match (read-ifaddrs (pointer->bytevector ptr %sizeof-ifaddrs))
           ((ifaddr . ptr)
            (loop ptr (cons ifaddr result)))))))
 
@@ -853,4 +1007,186 @@ network interface.  This is implemented using the 'getifaddrs' libc function."
   (let ((ptr (dynamic-func "freeifaddrs" (dynamic-link))))
     (pointer->procedure void ptr '(*))))
 
+
+;;;
+;;; Terminals.
+;;;
+
+(define-syntax bits->symbols-body
+  (syntax-rules ()
+    ((_ bits () ())
+     '())
+    ((_ bits (name names ...) (value values ...))
+     (let ((result (bits->symbols-body bits (names ...) (values ...))))
+       (if (zero? (logand bits value))
+           result
+           (cons 'name result))))))
+
+(define-syntax define-bits
+  (syntax-rules (define)
+    "Define the given numerical constants under CONSTRUCTOR, such that
+ (CONSTRUCTOR NAME) returns VALUE.  Define BITS->SYMBOLS as a procedure that,
+given an integer, returns the list of names of the constants that are or'd."
+    ((_ constructor bits->symbols (define names values) ...)
+     (begin
+       (define-syntax constructor
+         (syntax-rules (names ...)
+           ((_ names) values) ...
+           ((_ several (... ...))
+            (logior (constructor several) (... ...)))))
+       (define (bits->symbols bits)
+         (bits->symbols-body bits (names ...) (values ...)))
+       (define names values) ...))))
+
+;; 'local-flags' bits from <bits/termios.h>
+(define-bits local-flags
+  local-flags->symbols
+ (define ISIG #o0000001)
+ (define ICANON #o0000002)
+ (define XCASE #o0000004)
+ (define ECHO #o0000010)
+ (define ECHOE #o0000020)
+ (define ECHOK #o0000040)
+ (define ECHONL #o0000100)
+ (define NOFLSH #o0000200)
+ (define TOSTOP #o0000400)
+ (define ECHOCTL #o0001000)
+ (define ECHOPRT #o0002000)
+ (define ECHOKE #o0004000)
+ (define FLUSHO #o0010000)
+ (define PENDIN #o0040000)
+ (define IEXTEN #o0100000)
+ (define EXTPROC #o0200000))
+
+;; "Actions" values for 'tcsetattr'.
+(define TCSANOW  0)
+(define TCSADRAIN 1)
+(define TCSAFLUSH 2)
+
+(define-record-type <termios>
+  (termios input-flags output-flags control-flags local-flags
+           line-discipline control-chars
+           input-speed output-speed)
+  termios?
+  (input-flags      termios-input-flags)
+  (output-flags     termios-output-flags)
+  (control-flags    termios-control-flags)
+  (local-flags      termios-local-flags)
+  (line-discipline  termios-line-discipline)
+  (control-chars    termios-control-chars)
+  (input-speed      termios-input-speed)
+  (output-speed     termios-output-speed))
+
+(define-c-struct %termios                         ;<bits/termios.h>
+  sizeof-termios
+  termios
+  read-termios
+  write-termios!
+  (input-flags      unsigned-int)
+  (output-flags     unsigned-int)
+  (control-flags    unsigned-int)
+  (local-flags      unsigned-int)
+  (line-discipline  uint8)
+  (control-chars    (array uint8 32))
+  (input-speed      unsigned-int)
+  (output-speed     unsigned-int))
+
+(define tcgetattr
+  (let ((proc (syscall->procedure int "tcgetattr" (list int '*))))
+    (lambda (fd)
+      "Return the <termios> structure for the tty at FD."
+      (let* ((bv  (make-bytevector sizeof-termios))
+             (ret (proc fd (bytevector->pointer bv)))
+             (err (errno)))
+        (if (zero? ret)
+            (read-termios bv)
+            (throw 'system-error "tcgetattr" "~A"
+                   (list (strerror err))
+                   (list err)))))))
+
+(define tcsetattr
+  (let ((proc (syscall->procedure int "tcsetattr" (list int int '*))))
+    (lambda (fd actions termios)
+      "Use TERMIOS for the tty at FD.  ACTIONS is one of 'TCSANOW',
+'TCSADRAIN', or 'TCSAFLUSH'; see tcsetattr(3) for details."
+      (define bv
+        (make-bytevector sizeof-termios))
+
+      (let-syntax ((match/write (syntax-rules ()
+                                  ((_ fields ...)
+                                   (match termios
+                                     (($ <termios> fields ...)
+                                      (write-termios! bv 0 fields ...)))))))
+        (match/write input-flags output-flags control-flags local-flags
+                     line-discipline control-chars input-speed output-speed))
+
+      (let ((ret (proc fd actions (bytevector->pointer bv)))
+            (err (errno)))
+        (unless (zero? ret)
+          (throw 'system-error "tcgetattr" "~A"
+                 (list (strerror err))
+                 (list err)))))))
+
+(define-syntax TIOCGWINSZ                         ;<asm-generic/ioctls.h>
+  (identifier-syntax #x5413))
+
+(define-record-type <window-size>
+  (window-size rows columns x-pixels y-pixels)
+  window-size?
+  (rows     window-size-rows)
+  (columns  window-size-columns)
+  (x-pixels window-size-x-pixels)
+  (y-pixels window-size-y-pixels))
+
+(define-c-struct winsize                          ;<bits/ioctl-types.h>
+  sizeof-winsize
+  window-size
+  read-winsize
+  write-winsize!
+  (rows          unsigned-short)
+  (columns       unsigned-short)
+  (x-pixels      unsigned-short)
+  (y-pixels      unsigned-short))
+
+(define* (terminal-window-size #:optional (port (current-output-port)))
+  "Return a <window-size> structure describing the terminal at PORT, or raise
+a 'system-error' if PORT is not backed by a terminal.  This procedure
+corresponds to the TIOCGWINSZ ioctl."
+  (let* ((size (make-bytevector sizeof-winsize))
+         (ret  (%ioctl (fileno port) TIOCGWINSZ
+                       (bytevector->pointer size)))
+         (err  (errno)))
+    (if (zero? ret)
+        (read-winsize size)
+        (throw 'system-error "terminal-window-size" "~A"
+               (list (strerror err))
+               (list err)))))
+
+(define* (terminal-columns #:optional (port (current-output-port)))
+  "Return the best approximation of the number of columns of the terminal at
+PORT, trying to guess a reasonable value if all else fails.  The result is
+always a positive integer."
+  (define (fall-back)
+    (match (and=> (getenv "COLUMNS") string->number)
+      (#f 80)
+      ((? number? columns)
+       (if (> columns 0) columns 80))))
+
+  (catch 'system-error
+    (lambda ()
+      (if (file-port? port)
+          (match (window-size-columns (terminal-window-size port))
+            ;; Things like Emacs shell-mode return 0, which is unreasonable.
+            (0 (fall-back))
+            ((? number? columns) columns))
+          (fall-back)))
+    (lambda args
+      (let ((errno (system-error-errno args)))
+        ;; ENOTTY is what we're after but 2012-and-earlier Linux versions
+        ;; would return EINVAL instead in some cases:
+        ;; <https://bugs.ruby-lang.org/issues/10494>.
+        (if (or (= errno ENOTTY) (= errno EINVAL))
+            (fall-back)
+            (apply throw args))))))
+
 ;;; syscalls.scm ends here
diff --git a/guix/config.scm.in b/guix/config.scm.in
index 764e466bc5..d7df9f7d2b 100644
--- a/guix/config.scm.in
+++ b/guix/config.scm.in
@@ -55,11 +55,11 @@
       "@storedir@"))
 
 (define %state-directory
-  ;; This must match `NIX_STATE_DIR' as defined in `daemon.am'.
+  ;; This must match `NIX_STATE_DIR' as defined in `nix/local.mk'.
   (or (getenv "NIX_STATE_DIR") "@guix_localstatedir@/guix"))
 
 (define %config-directory
-  ;; This must match `NIX_CONF_DIR' as defined in `daemon.am'.
+  ;; This must match `NIX_CONF_DIR' as defined in `nix/local.mk'.
   (or (getenv "NIX_CONF_DIR") "@guix_sysconfdir@/guix"))
 
 (define %guix-register-program
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 9d720ca030..8021d99c8b 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -33,7 +33,6 @@
   #:use-module (guix records)
   #:use-module (guix upstream)
   #:use-module (guix packages)
-  #:use-module (gnu packages)
   #:export (gnu-package-name
             gnu-package-mundane-name
             gnu-package-copyright-holder
@@ -207,34 +206,12 @@ network to check in GNU's database."
 ;;; Latest release.
 ;;;
 
-(define (ftp-server/directory project)
-  "Return the FTP server and directory where PROJECT's tarball are
-stored."
-  (define quirks
-    '(("commoncpp2"   "ftp.gnu.org"   "/gnu/commoncpp")
-      ("ucommon"      "ftp.gnu.org"   "/gnu/commoncpp")
-      ("libzrtpcpp"   "ftp.gnu.org"   "/gnu/ccrtp")
-      ("libosip2"     "ftp.gnu.org"   "/gnu/osip")
-      ("libgcrypt"    "ftp.gnupg.org" "/gcrypt/libgcrypt")
-      ("libgpg-error" "ftp.gnupg.org" "/gcrypt/libgpg-error")
-      ("libassuan"    "ftp.gnupg.org" "/gcrypt/libassuan")
-      ("gnupg"        "ftp.gnupg.org" "/gcrypt/gnupg")
-      ("freefont-ttf" "ftp.gnu.org"   "/gnu/freefont")
-      ("gnu-ghostscript" "ftp.gnu.org"  "/gnu/ghostscript")
-      ("mit-scheme"   "ftp.gnu.org" "/gnu/mit-scheme/stable.pkg")
-      ("icecat"       "ftp.gnu.org" "/gnu/gnuzilla")
-      ("source-highlight" "ftp.gnu.org" "/gnu/src-highlite")
-      ("gnutls"       "ftp.gnutls.org" "/gcrypt/gnutls")
-
-      ;; FIXME: ftp.texmacs.org is currently outdated; texmacs.org refers to
-      ;; its own http URL instead.
-      ("TeXmacs"      "ftp.texmacs.org" "/TeXmacs/targz")))
-
-  (match (assoc project quirks)
-    ((_ server directory)
-     (values server directory))
-    (_
-     (values "ftp.gnu.org" (string-append "/gnu/" project)))))
+(define (ftp-server/directory package)
+  "Return the FTP server and directory where PACKAGE's tarball are stored."
+  (values (or (assoc-ref (package-properties package) 'ftp-server)
+              "ftp.gnu.org")
+          (or (assoc-ref (package-properties package) 'ftp-directory)
+              (string-append "/gnu/" (package-name package)))))
 
 (define (sans-extension tarball)
   "Return TARBALL without its .tar.* or .zip extension."
@@ -259,9 +236,13 @@ true."
               (lambda (match)
                 ;; Filter out unrelated files, like `guile-www-1.1.1'.
                 ;; Case-insensitive for things like "TeXmacs" vs. "texmacs".
+                ;; The "-src" suffix is for "freefont-src-20120503.tar.gz".
                 (and=> (match:substring match 1)
                        (lambda (name)
-                         (string-ci=? name project)))))
+                         (or (string-ci=? name project)
+                             (string-ci=? name
+                                          (string-append project
+                                                         "-src")))))))
        (not (regexp-exec %alpha-tarball-rx file))
        (let ((s (sans-extension file)))
          (regexp-exec %package-name-rx s))))
@@ -273,51 +254,53 @@ true."
                 (gnu-package-name->name+version (sans-extension tarball))))
     version))
 
-(define (releases project)
-  "Return the list of releases of PROJECT as a list of release name/directory
-pairs.  Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\"). "
+(define* (releases project
+                   #:key
+                   (server "ftp.gnu.org")
+                   (directory (string-append "/gnu/" project)))
+  "Return the list of <upstream-release> of PROJECT as a list of release
+name/directory pairs."
   ;; TODO: Parse something like fencepost.gnu.org:/gd/gnuorg/packages-ftp.
-  (let-values (((server directory) (ftp-server/directory project)))
-    (define conn (ftp-open server))
-
-    (let loop ((directories (list directory))
-               (result      '()))
-      (match directories
-        (()
-         (ftp-close conn)
-         (coalesce-sources result))
-        ((directory rest ...)
-         (let* ((files   (ftp-list conn directory))
-                (subdirs (filter-map (match-lambda
-                                       ((name 'directory . _) name)
-                                       (_ #f))
-                                     files)))
-           (define (file->url file)
-             (string-append "ftp://" server directory "/" file))
-
-           (define (file->source file)
-             (let ((url (file->url file)))
-               (upstream-source
-                (package project)
-                (version (tarball->version file))
-                (urls (list url))
-                (signature-urls (list (string-append url ".sig"))))))
-
-           (loop (append (map (cut string-append directory "/" <>)
-                              subdirs)
-                         rest)
-                 (append
-                  ;; Filter out signatures, deltas, and files which
-                  ;; are potentially not releases of PROJECT--e.g.,
-                  ;; in /gnu/guile, filter out guile-oops and
-                  ;; guile-www; in mit-scheme, filter out binaries.
-                  (filter-map (match-lambda
-                                ((file 'file . _)
-                                 (and (release-file? project file)
-                                      (file->source file)))
-                                (_ #f))
-                              files)
-                  result))))))))
+  (define conn (ftp-open server))
+
+  (let loop ((directories (list directory))
+             (result      '()))
+    (match directories
+      (()
+       (ftp-close conn)
+       (coalesce-sources result))
+      ((directory rest ...)
+       (let* ((files   (ftp-list conn directory))
+              (subdirs (filter-map (match-lambda
+                                     ((name 'directory . _) name)
+                                     (_ #f))
+                                   files)))
+         (define (file->url file)
+           (string-append "ftp://" server directory "/" file))
+
+         (define (file->source file)
+           (let ((url (file->url file)))
+             (upstream-source
+              (package project)
+              (version (tarball->version file))
+              (urls (list url))
+              (signature-urls (list (string-append url ".sig"))))))
+
+         (loop (append (map (cut string-append directory "/" <>)
+                            subdirs)
+                       rest)
+               (append
+                ;; Filter out signatures, deltas, and files which
+                ;; are potentially not releases of PROJECT--e.g.,
+                ;; in /gnu/guile, filter out guile-oops and
+                ;; guile-www; in mit-scheme, filter out binaries.
+                (filter-map (match-lambda
+                              ((file 'file . _)
+                               (and (release-file? project file)
+                                    (file->source file)))
+                              (_ #f))
+                            files)
+                result)))))))
 
 (define* (latest-ftp-release project
                              #:key
@@ -409,15 +392,15 @@ return the corresponding signature URL, or #f it signatures are unavailable."
               (ftp-close conn)
               result))))))
 
-(define (latest-release package . rest)
+(define* (latest-release package
+                         #:key
+                         (server "ftp.gnu.org")
+                         (directory (string-append "/gnu/" package)))
   "Return the <upstream-source> for the latest version of PACKAGE or #f.
-PACKAGE is the name of a GNU package.  This procedure automatically uses the
-right FTP server and directory for PACKAGE."
-  (let-values (((server directory) (ftp-server/directory package)))
-    (apply latest-ftp-release package
-           #:server server
-           #:directory directory
-           rest)))
+PACKAGE must be the canonical name of a GNU package."
+  (latest-ftp-release package
+                      #:server server
+                      #:directory directory))
 
 (define-syntax-rule (false-if-ftp-error exp)
   "Return #f if an FTP error is raise while evaluating EXP; return the result
@@ -432,10 +415,17 @@ of EXP otherwise."
       #f)))
 
 (define (latest-release* package)
-  "Like 'latest-release', but ignore FTP errors that might occur when PACKAGE
-is not actually a GNU package, or not hosted on ftp.gnu.org, or not under that
-name (this is the case for \"emacs-auctex\", for instance.)"
-  (false-if-ftp-error (latest-release package)))
+  "Like 'latest-release', but (1) take a <package> object, and (2) ignore FTP
+errors that might occur when PACKAGE is not actually a GNU package, or not
+hosted on ftp.gnu.org, or not under that name (this is the case for
+\"emacs-auctex\", for instance.)"
+  (let-values (((server directory)
+                (ftp-server/directory package)))
+    (let ((name (or (assoc-ref (package-properties package) 'upstream-name)
+                    (package-name package))))
+      (false-if-ftp-error (latest-release name
+                                          #:server server
+                                          #:directory directory)))))
 
 (define %package-name-rx
   ;; Regexp for a package name, e.g., "foo-X.Y".  Since TeXmacs uses
@@ -493,10 +483,10 @@ elpa.gnu.org, and all the GNOME packages."
       (even-minor-version? (or version name))))
 
   (false-if-ftp-error
-   (latest-ftp-release package
+   (latest-ftp-release (package-name package)
                        #:server "ftp.gnome.org"
                        #:directory (string-append "/pub/gnome/sources/"
-                                                  (match package
+                                                  (match (package-name package)
                                                     ("gconf" "GConf")
                                                     (x       x)))
 
@@ -528,10 +518,10 @@ elpa.gnu.org, and all the GNOME packages."
 
 (define (latest-xorg-release package)
   "Return the latest release of PACKAGE, the name of an X.org package."
-  (let ((uri (string->uri (origin-uri (package-source (specification->package package))))))
+  (let ((uri (string->uri (origin-uri (package-source package)))))
     (false-if-ftp-error
      (latest-ftp-release
-      package
+      (package-name package)
       #:server "ftp.freedesktop.org"
       #:directory
       (string-append "/pub/xorg/" (dirname (uri-path uri)))))))
diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm
index c80d568101..ad61ee7916 100644
--- a/guix/import/cpan.scm
+++ b/guix/import/cpan.scm
@@ -26,6 +26,7 @@
   #:use-module (json)
   #:use-module (guix hash)
   #:use-module (guix store)
+  #:use-module (guix utils)
   #:use-module (guix base32)
   #:use-module ((guix download) #:select (download-to-store))
   #:use-module (guix import utils)
@@ -121,16 +122,30 @@ META."
   (define version
     (assoc-ref meta "version"))
 
-  (define (core-module? name)
-    (and (force %corelist)
-         (parameterize ((current-error-port (%make-void-port "w")))
-           (let* ((corelist (open-pipe* OPEN_READ (force %corelist) name)))
-             (let loop ((line (read-line corelist)))
-               (if (eof-object? line)
-                   (begin (close-pipe corelist) #f)
-                   (if (string-contains line "first released with perl")
-                       (begin (close-pipe corelist) #t)
-                       (loop (read-line corelist)))))))))
+  (define core-module?
+    (let ((perl-version (package-version perl))
+          (rx (make-regexp
+               (string-append "released with perl v?([0-9\\.]*)"
+                              "(.*and removed from v?([0-9\\.]*))?"))))
+      (lambda (name)
+        (define (version-between? lower version upper)
+          (and (version>=? version lower)
+               (or (not upper)
+                   (version>? upper version))))
+        (and (force %corelist)
+             (parameterize ((current-error-port (%make-void-port "w")))
+               (let* ((corelist (open-pipe* OPEN_READ (force %corelist) name)))
+                 (let loop ()
+                   (let ((line (read-line corelist)))
+                     (if (eof-object? line)
+                         (begin (close-pipe corelist) #f)
+                         (or (and=> (regexp-exec rx line)
+                                    (lambda (m)
+                                      (let ((first (match:substring m 1))
+                                            (last  (match:substring m 3)))
+                                        (version-between?
+                                         first perl-version last))))
+                             (loop)))))))))))
 
   (define (convert-inputs phases)
     ;; Convert phase dependencies into a list of name/variable pairs.
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 562917c0a0..69485bc88d 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
-;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -32,7 +32,6 @@
   #:use-module ((guix build-system r) #:select (cran-uri bioconductor-uri))
   #:use-module (guix upstream)
   #:use-module (guix packages)
-  #:use-module (gnu packages)
   #:export (cran->guix-package
             bioconductor->guix-package
             %cran-updater
@@ -240,7 +239,7 @@ s-expression corresponding to that package, or #f on failure."
   "Return an <upstream-source> for the latest release of PACKAGE."
 
   (define upstream-name
-    (package->upstream-name (specification->package package)))
+    (package->upstream-name package))
 
   (define meta
     (fetch-description %cran-url upstream-name))
@@ -249,7 +248,7 @@ s-expression corresponding to that package, or #f on failure."
        (let ((version (assoc-ref meta "Version")))
          ;; CRAN does not provide signatures.
          (upstream-source
-          (package package)
+          (package (package-name package))
           (version version)
           (urls (cran-uri upstream-name version))))))
 
@@ -257,7 +256,7 @@ s-expression corresponding to that package, or #f on failure."
   "Return an <upstream-source> for the latest release of PACKAGE."
 
   (define upstream-name
-    (package->upstream-name (specification->package package)))
+    (package->upstream-name package))
 
   (define meta
     (fetch-description %bioconductor-svn-url upstream-name))
@@ -266,7 +265,7 @@ s-expression corresponding to that package, or #f on failure."
        (let ((version (assoc-ref meta "Version")))
          ;; Bioconductor does not provide signatures.
          (upstream-source
-          (package package)
+          (package (package-name package))
           (version version)
           (urls (bioconductor-uri upstream-name version))))))
 
diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm
index 529de4f232..ccc4063a53 100644
--- a/guix/import/elpa.scm
+++ b/guix/import/elpa.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
-;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -239,13 +239,11 @@ type '<elpa-package>'."
 ;;;
 
 (define (latest-release package)
-  "Return an <upstream-release> for the latest release of PACKAGE.  PACKAGE
-may be a Guix package name such as \"emacs-debbugs\" or an upstream name such
-as \"debbugs\"."
+  "Return an <upstream-release> for the latest release of PACKAGE."
   (define name
-    (if (string-prefix? "emacs-" package)
-        (string-drop package 6)
-        package))
+    (if (string-prefix? "emacs-" (package-name package))
+        (string-drop (package-name package) 6)
+        (package-name package)))
 
   (let* ((repo    'gnu)
          (info    (elpa-package-info name repo))
@@ -256,7 +254,7 @@ as \"debbugs\"."
                     ((_ raw-version reqs synopsis kind . rest)
                      (package-source-url kind name version repo)))))
     (upstream-source
-     (package package)
+     (package (package-name package))
      (version version)
      (urls (list url))
      (signature-urls (list (string-append url ".sig"))))))
diff --git a/guix/import/gem.scm b/guix/import/gem.scm
index b46622f00d..fc06b0d748 100644
--- a/guix/import/gem.scm
+++ b/guix/import/gem.scm
@@ -32,7 +32,6 @@
   #:use-module (guix licenses)
   #:use-module (guix base32)
   #:use-module (guix build-system ruby)
-  #:use-module (gnu packages)
   #:export (gem->guix-package
             %gem-updater))
 
@@ -171,15 +170,14 @@ package on RubyGems."
            ((source-url ...)
             (any rubygems-url? source-url))))))
 
-(define (latest-release guix-package)
-  "Return an <upstream-source> for the latest release of GUIX-PACKAGE."
-  (let* ((gem-name (guix-package->gem-name
-                    (specification->package guix-package)))
+(define (latest-release package)
+  "Return an <upstream-source> for the latest release of PACKAGE."
+  (let* ((gem-name (guix-package->gem-name package))
          (metadata (rubygems-fetch gem-name))
          (version (assoc-ref metadata "version"))
          (url (rubygems-uri gem-name version)))
     (upstream-source
-     (package guix-package)
+     (package (package-name package))
      (version version)
      (urls (list url)))))
 
diff --git a/guix/import/github.scm b/guix/import/github.scm
index c696dcb363..29116d79f0 100644
--- a/guix/import/github.scm
+++ b/guix/import/github.scm
@@ -25,7 +25,6 @@
   #:use-module (guix import utils)
   #:use-module (guix packages)
   #:use-module (guix upstream)
-  #:use-module (gnu packages)
   #:use-module (web uri)
   #:export (%github-updater))
 
@@ -175,15 +174,14 @@ https://github.com/settings/tokens"))
                    (if (eq? (string-ref tag 0) #\v)
                        (substring tag 1) tag)))))))))
 
-(define (latest-release guix-package)
-  "Return an <upstream-source> for the latest release of GUIX-PACKAGE."
-  (let* ((pkg (specification->package guix-package))
-         (source-uri (origin-uri (package-source pkg)))
+(define (latest-release pkg)
+  "Return an <upstream-source> for the latest release of PKG."
+  (let* ((source-uri (origin-uri (package-source pkg)))
          (name (package-name pkg))
          (newest-version (latest-released-version source-uri name)))
     (if newest-version
         (upstream-source
-         (package pkg)
+         (package name)
          (version newest-version)
          (urls (list (updated-github-url pkg newest-version))))
         #f))) ; On GitHub but no proper releases
diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm
index 640ead24f3..f07f453e11 100644
--- a/guix/import/hackage.scm
+++ b/guix/import/hackage.scm
@@ -23,7 +23,6 @@
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-1)
-  #:use-module (gnu packages)
   #:use-module ((guix download) #:select (download-to-store url-fetch))
   #:use-module ((guix utils) #:select (package-name->name+version
                                        canonical-newline-port))
@@ -269,10 +268,9 @@ respectively."
            ((source-url ...)
             (any haskell-url? source-url))))))
 
-(define (latest-release guix-package)
-  "Return an <upstream-source> for the latest release of GUIX-PACKAGE."
-  (let* ((hackage-name (guix-package->hackage-name
-                        (specification->package guix-package)))
+(define (latest-release package)
+  "Return an <upstream-source> for the latest release of PACKAGE."
+  (let* ((hackage-name (guix-package->hackage-name package))
          (cabal-meta (hackage-fetch hackage-name)))
     (match cabal-meta
       (#f
@@ -283,7 +281,7 @@ respectively."
       ((_ *** ("version" (version)))
        (let ((url (hackage-source-url hackage-name version)))
          (upstream-source
-          (package guix-package)
+          (package (package-name package))
           (version version)
           (urls (list url))))))))
 
diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index 8ae4948147..de30f4bea6 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -40,7 +40,6 @@
   #:use-module (guix upstream)
   #:use-module (guix licenses)
   #:use-module (guix build-system python)
-  #:use-module (gnu packages)
   #:use-module (gnu packages python)
   #:export (pypi->guix-package
             %pypi-updater))
@@ -248,16 +247,15 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
            ((source-url ...)
             (any pypi-url? source-url))))))
 
-(define (latest-release guix-package)
-  "Return an <upstream-source> for the latest release of GUIX-PACKAGE."
+(define (latest-release package)
+  "Return an <upstream-source> for the latest release of PACKAGE."
   (guard (c ((missing-source-error? c) #f))
-    (let* ((pypi-name (guix-package->pypi-name
-                       (specification->package guix-package)))
+    (let* ((pypi-name (guix-package->pypi-name package))
            (metadata (pypi-fetch pypi-name))
            (version (assoc-ref* metadata "info" "version"))
            (url (assoc-ref (latest-source-release metadata) "url")))
       (upstream-source
-       (package guix-package)
+       (package (package-name package))
        (version version)
        (urls (list url))))))
 
diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm
index 4a0c865b07..149647cfdf 100644
--- a/guix/scripts/challenge.scm
+++ b/guix/scripts/challenge.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -233,9 +233,11 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n"))
 
            (run-with-store store
              (mlet* %store-monad ((items  (mapm %store-monad
-                                               ensure-store-item files))
+                                                ensure-store-item files))
                                   (issues (discrepancies items urls)))
                (for-each summarize-discrepancy issues)
+               (unless (null? issues)
+                 (exit 2))
                (return (null? issues)))
              #:system system)))))))
 
diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm
index 6ebc14f573..1648198f6e 100644
--- a/guix/scripts/download.scm
+++ b/guix/scripts/download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,6 +24,8 @@
   #:use-module (guix utils)
   #:use-module (guix base32)
   #:use-module (guix download)
+  #:use-module ((guix build download) #:select (current-terminal-columns))
+  #:use-module ((guix build syscalls) #:select (terminal-columns))
   #:use-module (web uri)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
@@ -115,8 +117,10 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
                      (add-to-store store (basename (uri-path uri))
                                    #f "sha256" (uri-path uri)))
                     (else
-                     (download-to-store store (uri->string uri)
-                                        (basename (uri-path uri))))))
+                     (parameterize ((current-terminal-columns
+                                     (terminal-columns)))
+                       (download-to-store store (uri->string uri)
+                                          (basename (uri-path uri)))))))
            (hash  (call-with-input-file
                       (or path
                           (leave (_ "~a: download failed~%")
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 0ec2c5d3cb..d4c09ef54c 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -406,7 +406,15 @@ host file systems to mount inside the container."
                                             (file-system-mapping
                                              (source file)
                                              (target file)
-                                             (writable? #f))))
+                                             ;; XXX: On some GNU/Linux
+                                             ;; systems, /etc/resolv.conf is a
+                                             ;; symlink to a file in a tmpfs
+                                             ;; which, for an unknown reason,
+                                             ;; cannot be bind mounted
+                                             ;; read-only within the
+                                             ;; container.
+                                             (writable?
+                                              (string=? "/etc/resolv.conf")))))
                                      %network-configuration-files)
                          '())
                      ;; Mappings for the union closure of all inputs.
diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm
index fe1bb93f7f..4ec9ff9dca 100644
--- a/guix/scripts/gc.scm
+++ b/guix/scripts/gc.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,6 +20,7 @@
   #:use-module (guix ui)
   #:use-module (guix scripts)
   #:use-module (guix store)
+  #:autoload   (guix build syscalls) (statfs)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (srfi srfi-1)
@@ -43,6 +44,8 @@ Invoke the garbage collector.\n"))
   -C, --collect-garbage[=MIN]
                          collect at least MIN bytes of garbage"))
   (display (_ "
+  -F, --free-space=FREE  attempt to reach FREE available space in the store"))
+  (display (_ "
   -d, --delete           attempt to delete PATHS"))
   (display (_ "
       --optimize         optimize the store by deduplicating identical files"))
@@ -96,6 +99,9 @@ Invoke the garbage collector.\n"))
                             (leave (_ "invalid amount of storage: ~a~%")
                                    arg))))
                      (#f result)))))
+        (option '(#\F "free-space") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'free-space (size->number arg) result)))
         (option '(#\d "delete") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'action 'delete
@@ -175,6 +181,18 @@ Invoke the garbage collector.\n"))
                         (cut match:substring <> 1)))
         file))
 
+  (define (ensure-free-space store space)
+    ;; Attempt to have at least SPACE bytes available in STORE.
+    (let* ((fs    (statfs (%store-prefix)))
+           (free  (* (file-system-block-size fs)
+                     (file-system-blocks-available fs))))
+      (if (> free space)
+          (info (_ "already ~h bytes available on ~a, nothing to do~%")
+                free (%store-prefix))
+          (let ((to-free (- space free)))
+            (info (_ "freeing ~h bytes~%") to-free)
+            (collect-garbage store to-free)))))
+
   (with-error-handling
     (let* ((opts  (parse-options))
            (store (open-connection))
@@ -197,10 +215,15 @@ Invoke the garbage collector.\n"))
       (case (assoc-ref opts 'action)
         ((collect-garbage)
          (assert-no-extra-arguments)
-         (let ((min-freed (assoc-ref opts 'min-freed)))
-           (if min-freed
-               (collect-garbage store min-freed)
-               (collect-garbage store))))
+         (let ((min-freed  (assoc-ref opts 'min-freed))
+               (free-space (assoc-ref opts 'free-space)))
+           (cond
+            (free-space
+             (ensure-free-space store free-space))
+            (min-freed
+             (collect-garbage store min-freed))
+            (else
+             (collect-garbage store)))))
         ((delete)
          (delete-paths store (map direct-store-path paths)))
         ((list-references)
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 27b9e155ec..c581586ac3 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2016 Danny Milosavljevic <dannym+a@scratchpost.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -186,13 +187,17 @@ by two spaces; possible infraction~p at ~{~a~^, ~}")
                       'description))))
 
   (let ((description (package-description package)))
-    (when (string? description)
-      (check-not-empty description)
-      ;; Use raw description for this because Texinfo rendering automatically
-      ;; fixes end of sentence space.
-      (check-end-of-sentence-space description)
-      (and=> (check-texinfo-markup description)
-             check-proper-start))))
+    (if (string? description)
+        (begin
+          (check-not-empty description)
+          ;; Use raw description for this because Texinfo rendering
+          ;; automatically fixes end of sentence space.
+          (check-end-of-sentence-space description)
+          (and=> (check-texinfo-markup description)
+                 check-proper-start))
+        (emit-warning package
+                      (format #f (_ "invalid description: ~s") description)
+                      'description))))
 
 (define (check-inputs-should-be-native package)
   ;; Emit a warning if some inputs of PACKAGE are likely to belong to its
@@ -261,14 +266,19 @@ the synopsis")
                     (_ "synopsis should not start with the package name")
                     'synopsis)))
 
- (let ((synopsis (package-synopsis package)))
-   (when (string? synopsis)
-     (check-not-empty synopsis)
-     (check-proper-start synopsis)
-     (check-final-period synopsis)
-     (check-start-article synopsis)
-     (check-start-with-package-name synopsis)
-     (check-synopsis-length synopsis))))
+  (define checks
+    (list check-not-empty check-proper-start check-final-period
+          check-start-article check-start-with-package-name
+          check-synopsis-length))
+
+  (match (package-synopsis package)
+    ((? string? synopsis)
+     (for-each (lambda (proc)
+                 (proc synopsis))
+               checks))
+    (invalid
+     (emit-warning package (format #f (_ "invalid synopsis: ~s") invalid)
+                   'synopsis))))
 
 (define* (probe-uri uri #:key timeout)
   "Probe URI, a URI object, and return two values: a symbol denoting the
@@ -458,12 +468,14 @@ descriptions maintained upstream."
                (official-gnu-packages*))
     (#f                                   ;not a GNU package, so nothing to do
      #t)
-    (descriptor                           ;a genuine GNU package
+    (descriptor                                   ;a genuine GNU package
      (let ((upstream   (gnu-package-doc-summary descriptor))
            (downstream (package-synopsis package))
            (loc        (or (package-field-location package 'synopsis)
                            (package-location package))))
-       (unless (and upstream (string=? upstream downstream))
+       (when (and upstream
+                  (or (not (string? downstream))
+                      (not (string=? upstream downstream))))
          (format (guix-warning-port)
                  (_ "~a: ~a: proposed synopsis: ~s~%")
                  (location->string loc) (package-full-name package)
@@ -474,8 +486,9 @@ descriptions maintained upstream."
            (loc        (or (package-field-location package 'description)
                            (package-location package))))
        (when (and upstream
-                  (not (string=? (fill-paragraph upstream 100)
-                                 (fill-paragraph downstream 100))))
+                  (or (not (string? downstream))
+                      (not (string=? (fill-paragraph upstream 100)
+                                     (fill-paragraph downstream 100)))))
          (format (guix-warning-port)
                  (_ "~a: ~a: proposed description:~%     \"~a\"~%")
                  (location->string loc) (package-full-name package)
@@ -631,7 +644,8 @@ from ~s: ~a (~s)~%")
     (()
      #t)
     ((vulnerabilities ...)
-     (let* ((patches   (filter-map patch-file-name
+     (let* ((package   (or (package-replacement package) package))
+            (patches   (filter-map patch-file-name
                                    (or (and=> (package-source package)
                                               origin-patches)
                                        '())))
@@ -799,11 +813,14 @@ or a list thereof")
         (name (package-full-name package)))
     (for-each (lambda (checker)
                 (when tty?
-                  (format (current-error-port) "checking ~a [~a]...\r"
+                  (format (current-error-port) "checking ~a [~a]...\x1b[K\r"
                           name (lint-checker-name checker))
                   (force-output (current-error-port)))
                 ((lint-checker-check checker) package))
-              checkers)))
+              checkers)
+    (when tty?
+      (format (current-error-port) "\x1b[K")
+      (force-output (current-error-port)))))
 
 
 ;;;
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 82ce069598..1cfab81dbd 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -31,7 +31,8 @@
   #:use-module (guix pki)
   #:use-module ((guix build utils) #:select (mkdir-p dump-port))
   #:use-module ((guix build download)
-                #:select (progress-proc uri-abbreviation
+                #:select (current-terminal-columns
+                          progress-proc uri-abbreviation nar-uri-abbreviation
                           open-connection-for-uri
                           close-connection
                           store-path-abbreviation byte-count->string))
@@ -399,8 +400,10 @@ or is signed by an unauthorized key."
             (when verbose?
               ;; Visually separate substitutions with a newline.
               (format (current-error-port)
-                      "~%Found valid signature for ~a~%From ~a~%"
-                      (narinfo-path narinfo)
+                      (_ "~%Found valid signature for ~a~%")
+                      (narinfo-path narinfo))
+              (format (current-error-port)
+                      (_ "From ~a~%")
                       (uri->string (narinfo-uri narinfo)))))
           narinfo))))
 
@@ -895,11 +898,11 @@ DESTINATION as a nar file.  Verify the substitute against ACL."
                           (dl-size  (or download-size
                                         (and (equal? comp "none")
                                              (narinfo-size narinfo))))
-                          (progress (progress-proc (uri-abbreviation uri)
+                          (progress (progress-proc (uri->string uri)
                                                    dl-size
                                                    (current-error-port)
                                                    #:abbreviation
-                                                   store-path-abbreviation)))
+                                                   nar-uri-abbreviation)))
                      (progress-report-port progress raw)))
                   ((input pids)
                    (decompressed-port (and=> (narinfo-compression narinfo)
@@ -973,6 +976,16 @@ found."
      ;; daemon.
      '("http://hydra.gnu.org"))))
 
+(define (client-terminal-columns)
+  "Return the number of columns in the client's terminal, if it is known, or a
+default value."
+  (or (and=> (or (find-daemon-option "untrusted-terminal-columns")
+                 (find-daemon-option "terminal-columns"))
+             (lambda (str)
+               (let ((number (string->number str)))
+                 (and number (max 20 (- number 1))))))
+      80))
+
 (define (guix-substitute . args)
   "Implement the build daemon's substituter protocol."
   (mkdir-p %narinfo-cache-directory)
@@ -989,6 +1002,13 @@ found."
   (newline)
   (force-output (current-output-port))
 
+  ;; Attempt to install the client's locale, mostly so that messages are
+  ;; suitably translated.
+  (match (or (find-daemon-option "untrusted-locale")
+             (find-daemon-option "locale"))
+    (#f     #f)
+    (locale (false-if-exception (setlocale LC_ALL locale))))
+
   (with-networking
    (with-error-handling                           ; for signature errors
      (match args
@@ -1003,9 +1023,12 @@ found."
                   (loop (read-line)))))))
        (("--substitute" store-path destination)
         ;; Download STORE-PATH and add store it as a Nar in file DESTINATION.
-        (process-substitution store-path destination
-                              #:cache-urls %cache-urls
-                              #:acl (current-acl)))
+        ;; Specify the number of columns of the terminal so the progress
+        ;; report displays nicely.
+        (parameterize ((current-terminal-columns (client-terminal-columns)))
+          (process-substitution store-path destination
+                                #:cache-urls %cache-urls
+                                #:acl (current-acl))))
        (("--version")
         (show-version-and-exit "guix substitute"))
        (("--help")
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 566e7e8768..e5d754a6fa 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -477,7 +477,10 @@ PATTERN, a string.  When PATTERN is #f, display all the system generations."
     ((vm)
      (system-qemu-image/shared-store-script os
                                             #:full-boot? full-boot?
-                                            #:disk-image-size image-size
+                                            #:disk-image-size
+                                            (if full-boot?
+                                                image-size
+                                                (* 30 (expt 2 20)))
                                             #:mappings mappings))
     ((disk-image)
      (system-disk-image os #:disk-image-size image-size))))
diff --git a/guix/store.scm b/guix/store.scm
index 906611658e..8d1099dab2 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -22,6 +22,7 @@
   #:use-module (guix serialization)
   #:use-module (guix monads)
   #:autoload   (guix base32) (bytevector->base32-string)
+  #:autoload   (guix build syscalls) (terminal-columns)
   #:use-module (rnrs bytevectors)
   #:use-module (rnrs io ports)
   #:use-module (srfi srfi-1)
@@ -530,7 +531,13 @@ encoding conversion errors."
                             ;; the daemon's settings are used.  Otherwise, it
                             ;; overrides the daemons settings; see 'guix
                             ;; substitute'.
-                            (substitute-urls #f))
+                            (substitute-urls #f)
+
+                            ;; Number of columns in the client's terminal.
+                            (terminal-columns (terminal-columns))
+
+                            ;; Locale of the client.
+                            (locale (false-if-exception (setlocale LC_ALL))))
   ;; Must be called after `open-connection'.
 
   (define socket
@@ -565,6 +572,13 @@ encoding conversion errors."
                      ,@(if rounds
                            `(("build-repeat"
                               . ,(number->string (max 0 (1- rounds)))))
+                           '())
+                     ,@(if terminal-columns
+                           `(("terminal-columns"
+                              . ,(number->string terminal-columns)))
+                           '())
+                     ,@(if locale
+                           `(("locale" . ,locale))
                            '()))))
         (send (string-pairs pairs))))
     (let loop ((done? (process-stderr server)))
diff --git a/guix/ui.scm b/guix/ui.scm
index f95c63a81b..04ac43723e 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -34,6 +34,7 @@
   #:use-module (guix serialization)
   #:use-module ((guix build utils) #:select (mkdir-p))
   #:use-module ((guix licenses) #:select (license? license-name))
+  #:use-module ((guix build syscalls) #:select (terminal-columns))
   #:use-module (gnu system file-systems)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
@@ -816,8 +817,7 @@ converted to a space; sequences of more than one line break are preserved."
 ;;;
 
 (define %text-width
-  (make-parameter (or (and=> (getenv "WIDTH") string->number)
-                      80)))
+  (make-parameter (terminal-columns)))
 
 (set! (@@ (texinfo plain-text) wrap*)
       ;; XXX: Monkey patch this private procedure to let 'package->recutils'
@@ -855,11 +855,16 @@ followed by \"+ \", which makes for a valid multi-line field value in the
 (define* (package->recutils p port #:optional (width (%text-width)))
   "Write to PORT a `recutils' record of package P, arranging to fit within
 WIDTH columns."
+  (define width*
+    ;; The available number of columns once we've taken into account space for
+    ;; the initial "+ " prefix.
+    (if (> width 2) (- width 2) width))
+
   (define (dependencies->recutils packages)
     (let ((list (string-join (map package-full-name
                                   (sort packages package<?)) " ")))
       (string->recutils
-       (fill-paragraph list width
+       (fill-paragraph list width*
                        (string-length "dependencies: ")))))
 
   (define (package<? p1 p2)
@@ -901,7 +906,7 @@ WIDTH columns."
   (format port "~a~2%"
           (string->recutils
            (string-trim-right
-            (parameterize ((%text-width width))
+            (parameterize ((%text-width width*))
               (texi->plain-text
                (string-append "description: "
                               (or (and=> (package-description p) P_)
diff --git a/guix/upstream.scm b/guix/upstream.scm
index cea23feb82..167c9ff89a 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -22,8 +22,6 @@
   #:use-module (guix utils)
   #:use-module ((guix download)
                 #:select (download-to-store))
-  #:use-module ((guix build utils)
-                #:select (substitute))
   #:use-module (guix gnupg)
   #:use-module (guix packages)
   #:use-module (guix ui)
@@ -130,11 +128,11 @@ them matches."
        updaters))
 
 (define (package-update-path package updaters)
-  "Return an upstream source to update PACKAGE to, or #f if no update is
-needed or known."
+  "Return an upstream source to update PACKAGE, a <package> object, or #f if
+no update is needed or known."
   (match (lookup-updater package updaters)
     ((? procedure? latest-release)
-     (match (latest-release (package-name package))
+     (match (latest-release package)
        ((and source ($ <upstream-source> name version))
         (and (version>? version (package-version package))
              source))
@@ -205,52 +203,32 @@ and 'interactive' (default)."
   "Modify the source file that defines PACKAGE to refer to VERSION,
 whose tarball has SHA256 HASH (a bytevector).  Return the new version string
 if an update was made, and #f otherwise."
-  (define (new-line line matches replacement)
-    ;; Iterate over MATCHES and return the modified line based on LINE.
-    ;; Replace each match with REPLACEMENT.
-    (let loop ((m* matches)                       ; matches
-               (o  0)                             ; offset in L
-               (r  '()))                          ; result
-      (match m*
-        (()
-         (let ((r (cons (substring line o) r)))
-           (string-concatenate-reverse r)))
-        ((m . rest)
-         (loop rest
-               (match:end m)
-               (cons* replacement
-                      (substring line o (match:start m))
-                      r))))))
-
-  (define (update-source file old-version version
-                         old-hash hash)
-    ;; Update source file FILE, replacing occurrences OLD-VERSION by VERSION
-    ;; and occurrences of OLD-HASH by HASH (base32 representation thereof).
-
-    ;; TODO: Currently this is a bit of a sledgehammer: if VERSION occurs in
-    ;; different unrelated places, we may modify it more than needed, for
-    ;; instance.  We should try to make changes only within the sexp that
-    ;; corresponds to the definition of PACKAGE.
+  (define (update-expression expr old-version version old-hash hash)
+    ;; Update package expression EXPR, replacing occurrences OLD-VERSION by
+    ;; VERSION and occurrences of OLD-HASH by HASH (base32 representation
+    ;; thereof).
     (let ((old-hash (bytevector->nix-base32-string old-hash))
           (hash     (bytevector->nix-base32-string hash)))
-      (substitute file
-                  `((,(regexp-quote old-version)
-                     . ,(cut new-line <> <> version))
-                    (,(regexp-quote old-hash)
-                     . ,(cut new-line <> <> hash))))
-      version))
-
-  (let ((name (package-name package))
-        (loc  (package-field-location package 'version)))
-    (if loc
-        (let ((old-version (package-version package))
-              (old-hash    (origin-sha256 (package-source package)))
-              (file        (and=> (location-file loc)
-                                  (cut search-path %load-path <>))))
+      (string-replace-substring
+       (string-replace-substring expr old-hash hash)
+       old-version version)))
+
+  (let ((name        (package-name package))
+        (version-loc (package-field-location package 'version)))
+    (if version-loc
+        (let* ((loc         (package-location package))
+               (old-version (package-version package))
+               (old-hash    (origin-sha256 (package-source package)))
+               (file        (and=> (location-file loc)
+                                   (cut search-path %load-path <>))))
           (if file
-              (update-source file
-                             old-version version
-                             old-hash hash)
+              (and (edit-expression
+                    ;; Be sure to use absolute filename.
+                    (assq-set! (location->source-properties loc)
+                               'filename file)
+                    (cut update-expression <>
+                         old-version version old-hash hash))
+                   version)
               (begin
                 (warning (_ "~a: could not locate source file")
                          (location-file loc))
diff --git a/guix/utils.scm b/guix/utils.scm
index de541799fa..6c01edde21 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -41,6 +41,7 @@
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
+  #:use-module ((ice-9 iconv) #:select (bytevector->string))
   #:use-module (system foreign)
   #:export (bytevector->base16-string
             base16-string->bytevector
@@ -60,6 +61,7 @@
             location-line
             location-column
             source-properties->location
+            location->source-properties
 
             nix-system->gnu-triplet
             gnu-triplet->nix-system
@@ -86,6 +88,7 @@
             split
             cache-directory
             readlink*
+            edit-expression
 
             filtered-port
             compressed-port
@@ -318,6 +321,44 @@ a list of command-line arguments passed to the compression program."
         (unless (every (compose zero? cdr waitpid) pids)
           (error "compressed-output-port failure" pids))))))
 
+(define* (edit-expression source-properties proc #:key (encoding "UTF-8"))
+  "Edit the expression specified by SOURCE-PROPERTIES using PROC, which should
+be a procedure that takes the original expression in string and returns a new
+one.  ENCODING will be used to interpret all port I/O, it default to UTF-8.
+This procedure returns #t on success."
+  (with-fluids ((%default-port-encoding encoding))
+    (let* ((file   (assq-ref source-properties 'filename))
+           (line   (assq-ref source-properties 'line))
+           (column (assq-ref source-properties 'column))
+           (in     (open-input-file file))
+           ;; The start byte position of the expression.
+           (start  (begin (while (not (and (= line (port-line in))
+                                           (= column (port-column in))))
+                            (when (eof-object? (read-char in))
+                              (error (format #f "~a: end of file~%" in))))
+                          (ftell in)))
+           ;; The end byte position of the expression.
+           (end    (begin (read in) (ftell in))))
+      (seek in 0 SEEK_SET) ; read from the beginning of the file.
+      (let* ((pre-bv  (get-bytevector-n in start))
+             ;; The expression in string form.
+             (str     (bytevector->string
+                       (get-bytevector-n in (- end start))
+                       (port-encoding in)))
+             (post-bv (get-bytevector-all in))
+             (str*    (proc str)))
+        ;; Verify the edited expression is still a scheme expression.
+        (call-with-input-string str* read)
+        ;; Update the file with edited expression.
+        (with-atomic-file-output file
+          (lambda (out)
+            (put-bytevector out pre-bv)
+            (display str* out)
+            ;; post-bv maybe the end-of-file object.
+            (when (not (eof-object? post-bv))
+              (put-bytevector out post-bv))
+            #t))))))
+
 
 ;;;
 ;;; Advisory file locking.
@@ -767,7 +808,8 @@ elements after E."
 (define (cache-directory)
   "Return the cache directory for Guix, by default ~/.cache/guix."
   (or (getenv "XDG_CONFIG_HOME")
-      (and=> (getenv "HOME")
+      (and=> (or (getenv "HOME")
+                 (passwd:dir (getpwuid (getuid))))
              (cut string-append <> "/.cache/guix"))))
 
 (define (readlink* file)
@@ -855,3 +897,10 @@ etc."
     ;; In accordance with the GCS, start line and column numbers at 1.  Note
     ;; that unlike LINE and `port-column', COL is actually 1-indexed here...
     (location file (and line (+ line 1)) col)))
+
+(define (location->source-properties loc)
+  "Return the source property association list based on the info in LOC,
+a location object."
+  `((line     . ,(and=> (location-line loc) 1-))
+    (column   . ,(location-column loc))
+    (filename . ,(location-file loc))))