Merge branch 'master' into core-updates

Conflicts:
	Makefile.am
	gnu/packages/autotools.scm
	gnu/packages/guile.scm
	gnu/packages/python.scm
	gnu/packages/shishi.scm
	guix/gnu-maintenance.scm
	guix/scripts/build.scm
	guix/scripts/gc.scm
	guix/scripts/package.scm
	guix/scripts/substitute-binary.scm
	guix/ui.scm
	nix/nix-daemon/guix-daemon.cc
	test-env.in
	tests/nar.scm
	tests/store.scm

17 files changed, 1308 insertions, 294 deletions

diff --git a/guix/derivations.scm b/guix/derivations.scm
index 2243d2ba46..cf329819c4 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -48,6 +48,7 @@
             derivation-input?
             derivation-input-path
             derivation-input-sub-derivations
+            derivation-input-output-paths
 
             fixed-output-derivation?
             derivation-hash
@@ -99,6 +100,14 @@ download with a fixed hash (aka. `fetchurl')."
      #t)
     (_ #f)))
 
+(define (derivation-input-output-paths input)
+  "Return the list of output paths corresponding to INPUT, a
+<derivation-input>."
+  (match input
+    (($ <derivation-input> path sub-drvs)
+     (map (cut derivation-path->output-path path <>)
+          sub-drvs))))
+
 (define (derivation-prerequisites drv)
   "Return the list of derivation-inputs required to build DRV, recursively."
   (let loop ((drv    drv)
@@ -113,47 +122,85 @@ download with a fixed hash (aka. `fetchurl')."
                  inputs)))))
 
 (define* (derivation-prerequisites-to-build store drv
-                                            #:key (outputs
-                                                   (map
-                                                    car
-                                                    (derivation-outputs drv))))
-  "Return the list of derivation-inputs required to build the OUTPUTS of
-DRV and not already available in STORE, recursively."
+                                            #:key
+                                            (outputs
+                                             (map
+                                              car
+                                              (derivation-outputs drv)))
+                                            (use-substitutes? #t))
+  "Return two values: the list of derivation-inputs required to build the
+OUTPUTS of DRV and not already available in STORE, recursively, and the list
+of required store paths that can be substituted.  When USE-SUBSTITUTES? is #f,
+that second value is the empty list."
+  (define (derivation-output-paths drv sub-drvs)
+    (match drv
+      (($ <derivation> outputs)
+       (map (lambda (sub-drv)
+              (derivation-output-path (assoc-ref outputs sub-drv)))
+            sub-drvs))))
+
   (define built?
     (cut valid-path? store <>))
 
+  (define substitutable?
+    ;; Return true if the given path is substitutable.  Call
+    ;; `substitutable-paths' upfront, to benefit from parallelism in the
+    ;; substituter.
+    (if use-substitutes?
+        (let ((s (substitutable-paths store
+                                      (append
+                                       (derivation-output-paths drv outputs)
+                                       (append-map
+                                        derivation-input-output-paths
+                                        (derivation-prerequisites drv))))))
+          (cut member <> s))
+        (const #f)))
+
   (define input-built?
-    (match-lambda
-     (($ <derivation-input> path sub-drvs)
-      (let ((out (map (cut derivation-path->output-path path <>)
-                      sub-drvs)))
-        (any built? out)))))
+    (compose (cut any built? <>) derivation-input-output-paths))
+
+  (define input-substitutable?
+    ;; Return true if and only if all of SUB-DRVS are subsitutable.  If at
+    ;; least one is missing, then everything must be rebuilt.
+    (compose (cut every substitutable? <>) derivation-input-output-paths))
 
   (define (derivation-built? drv sub-drvs)
-    (match drv
-      (($ <derivation> outputs)
-       (let ((paths (map (lambda (sub-drv)
-                           (derivation-output-path
-                            (assoc-ref outputs sub-drv)))
-                         sub-drvs)))
-         (every built? paths)))))
-
-  (let loop ((drv      drv)
-             (sub-drvs outputs)
-             (result   '()))
-    (if (derivation-built? drv sub-drvs)
-        result
-        (let ((inputs (remove (lambda (i)
-                                (or (member i result) ; XXX: quadratic
-                                    (input-built? i)))
-                              (derivation-inputs drv))))
-          (fold loop
-                (append inputs result)
-                (map (lambda (i)
-                       (call-with-input-file (derivation-input-path i)
-                         read-derivation))
-                     inputs)
-                (map derivation-input-sub-derivations inputs))))))
+    (every built? (derivation-output-paths drv sub-drvs)))
+
+  (define (derivation-substitutable? drv sub-drvs)
+    (every substitutable? (derivation-output-paths drv sub-drvs)))
+
+  (let loop ((drv        drv)
+             (sub-drvs   outputs)
+             (build      '())
+             (substitute '()))
+    (cond ((derivation-built? drv sub-drvs)
+           (values build substitute))
+          ((derivation-substitutable? drv sub-drvs)
+           (values build
+                   (append (derivation-output-paths drv sub-drvs)
+                           substitute)))
+          (else
+           (let ((inputs (remove (lambda (i)
+                                   (or (member i build) ; XXX: quadratic
+                                       (input-built? i)
+                                       (input-substitutable? i)))
+                                 (derivation-inputs drv))))
+             (fold2 loop
+                    (append inputs build)
+                    (append (append-map (lambda (input)
+                                          (if (and (not (input-built? input))
+                                                   (input-substitutable? input))
+                                              (derivation-input-output-paths
+                                               input)
+                                              '()))
+                                        (derivation-inputs drv))
+                            substitute)
+                    (map (lambda (i)
+                           (call-with-input-file (derivation-input-path i)
+                             read-derivation))
+                         inputs)
+                    (map derivation-input-sub-derivations inputs)))))))
 
 (define (%read-derivation drv-port)
   ;; Actually read derivation from DRV-PORT.
diff --git a/guix/download.scm b/guix/download.scm
index 689920c3e0..99353be8b0 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -21,13 +21,15 @@
   #:use-module (ice-9 match)
   #:use-module (guix derivations)
   #:use-module (guix packages)
-  #:use-module ((guix store) #:select (derivation-path?))
+  #:use-module ((guix store) #:select (derivation-path? add-to-store))
+  #:use-module ((guix build download) #:renamer (symbol-prefix-proc 'build:))
   #:use-module (guix utils)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:export (%mirrors
-            url-fetch))
+            url-fetch
+            download-to-store))
 
 ;;; Commentary:
 ;;;
@@ -230,4 +232,17 @@ must be a list of symbol/URL-list pairs."
                                   #:guile-for-build guile-for-build
                                   #:env-vars env-vars)))
 
+(define* (download-to-store store url #:optional (name (basename url))
+                            #:key (log (current-error-port)))
+  "Download from URL to STORE, either under NAME or URL's basename if
+omitted.  Write progress reports to LOG."
+  (call-with-temporary-output-file
+   (lambda (temp port)
+     (let ((result
+            (parameterize ((current-output-port log))
+              (build:url-fetch url temp #:mirrors %mirrors))))
+       (close port)
+       (and result
+            (add-to-store store name #f "sha256" temp))))))
+
 ;;; download.scm ends here
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 89e7f25589..be739e34a3 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -28,9 +28,17 @@
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (system foreign)
+  #:use-module (guix web)
   #:use-module (guix ftp-client)
+  #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (guix packages)
+  #:use-module ((guix download) #:select (download-to-store))
+  #:use-module (guix gnupg)
+  #:use-module (rnrs io ports)
+  #:use-module (guix base32)
+  #:use-module ((guix build utils)
+                #:select (substitute))
   #:export (gnu-package-name
             gnu-package-mundane-name
             gnu-package-copyright-holder
@@ -49,7 +57,10 @@
 
             releases
             latest-release
-            gnu-package-name->name+version))
+            gnu-package-name->name+version
+            package-update-path
+            package-update
+            update-package-source))
 
 ;;; Commentary:
 ;;;
@@ -63,46 +74,11 @@
 ;;; List of GNU packages.
 ;;;
 
-(define (http-fetch uri)
-  "Return an input port containing the textual data at URI, a string."
-  (let*-values (((resp data)
-                 (let ((uri (string->uri uri)))
-                   ;; Try hard to use the API du jour to get an input port.
-                   (if (version>? "2.0.7" (version))
-                       (if (defined? 'http-get*)
-                           (http-get* uri)
-                           (http-get uri))       ; old Guile, returns a string
-                       (http-get uri #:streaming? #t)))) ; 2.0.8 or later
-               ((code)
-                (response-code resp)))
-    (case code
-      ((200)
-       (cond ((not data)
-              (begin
-                ;; XXX: Guile 2.0.5 and earlier did not support chunked transfer
-                ;; encoding, which is required when fetching %PACKAGE-LIST-URL
-                ;; (see <http://lists.gnu.org/archive/html/guile-devel/2011-09/msg00089.html>).
-                ;; Since users may still be using these versions, warn them and
-                ;; bail out.
-                (format (current-error-port)
-                        "warning: using Guile ~a, ~a ~s encoding~%"
-                        (version)
-                        "which does not support HTTP"
-                        (response-transfer-encoding resp))
-                (error "download failed; use a newer Guile"
-                       uri resp)))
-             ((string? data)                 ; old `http-get' returns a string
-              (open-input-string data))
-             (else                           ; input port
-              data)))
-      (else
-       (error "download failed" uri code
-              (response-reason-phrase resp))))))
-
 (define %package-list-url
-  (string-append "http://cvs.savannah.gnu.org/"
-                 "viewvc/*checkout*/gnumaint/"
-                 "gnupackages.txt?root=womb"))
+  (string->uri
+   (string-append "http://cvs.savannah.gnu.org/"
+                  "viewvc/*checkout*/gnumaint/"
+                  "gnupackages.txt?root=womb")))
 
 (define-record-type* <gnu-package-descriptor>
   gnu-package-descriptor
@@ -188,7 +164,7 @@
                                "savannah" "fsd" "language" "logo"
                                "doc-category" "doc-summary" "doc-urls"
                                "download-url")))
-        (group-package-fields (http-fetch %package-list-url)
+        (group-package-fields (http-fetch %package-list-url #:text? #t)
                               '(())))))
 
 (define (find-packages regexp)
@@ -201,16 +177,17 @@
 
 (define gnu-package?
   (memoize
-   (lambda (package)
-     "Return true if PACKAGE is a GNU package.  This procedure may access the
+   (let ((official-gnu-packages (memoize official-gnu-packages)))
+     (lambda (package)
+       "Return true if PACKAGE is a GNU package.  This procedure may access the
 network to check in GNU's database."
-     ;; TODO: Find a way to determine that a package is non-GNU without going
-     ;; through the network.
-     (let ((url  (and=> (package-source package) origin-uri))
-           (name (package-name package)))
-       (or (and (string? url) (string-prefix? "mirror://gnu" url))
-           (and (member name (map gnu-package-name (official-gnu-packages)))
-                #t))))))
+       ;; TODO: Find a way to determine that a package is non-GNU without going
+       ;; through the network.
+       (let ((url  (and=> (package-source package) origin-uri))
+             (name (package-name package)))
+         (or (and (string? url) (string-prefix? "mirror://gnu" url))
+             (and (member name (map gnu-package-name (official-gnu-packages)))
+                  #t)))))))
 
 
 ;;;
@@ -234,6 +211,7 @@ stored."
       ("mit-scheme"   "ftp.gnu.org" "/gnu/mit-scheme/stable.pkg")
       ("icecat"       "ftp.gnu.org" "/gnu/gnuzilla")
       ("source-highlight" "ftp.gnu.org" "/gnu/src-highlite")
+      ("glib"         "ftp.gnome.org" "/pub/gnome/sources/glib")
       ("TeXmacs"      "ftp.texmacs.org" "/TeXmacs/targz")))
 
   (match (assoc project quirks)
@@ -242,30 +220,33 @@ stored."
     (_
      (values "ftp.gnu.org" (string-append "/gnu/" project)))))
 
+(define (sans-extension tarball)
+  "Return TARBALL without its .tar.* extension."
+  (let ((end (string-contains tarball ".tar")))
+    (substring tarball 0 end)))
+
+(define %tarball-rx
+  (make-regexp "^(.+)-([0-9]|[^-])*(-src)?\\.tar\\."))
+
+(define %alpha-tarball-rx
+  (make-regexp "^.*-.*[0-9](-|~)?(alpha|beta|rc|cvs|svn|git)-?[0-9\\.]*\\.tar\\."))
+
+(define (release-file project file)
+  "Return #f if FILE is not a release tarball of PROJECT, otherwise return
+PACKAGE-VERSION."
+  (and (not (string-suffix? ".sig" file))
+       (and=> (regexp-exec %tarball-rx file)
+              (lambda (match)
+                ;; Filter out unrelated files, like `guile-www-1.1.1'.
+                (equal? project (match:substring match 1))))
+       (not (regexp-exec %alpha-tarball-rx file))
+       (let ((s (sans-extension file)))
+         (and (regexp-exec %package-name-rx s) s))))
+
 (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\"). "
   ;; TODO: Parse something like fencepost.gnu.org:/gd/gnuorg/packages-ftp.
-  (define release-rx
-    (make-regexp (string-append "^" project
-                                "-([0-9]|[^-])*(-src)?\\.tar\\.")))
-
-  (define alpha-rx
-    (make-regexp "^.*-.*[0-9](-|~)?(alpha|beta|rc|cvs|svn|git)-?[0-9\\.]*\\.tar\\."))
-
-  (define (sans-extension tarball)
-    (let ((end (string-contains tarball ".tar")))
-      (substring tarball 0 end)))
-
-  (define (release-file file)
-    ;; Return #f if FILE is not a release tarball, otherwise return
-    ;; PACKAGE-VERSION.
-    (and (not (string-suffix? ".sig" file))
-         (regexp-exec release-rx file)
-         (not (regexp-exec alpha-rx file))
-         (let ((s (sans-extension file)))
-           (and (regexp-exec %package-name-rx s) s))))
-
   (let-values (((server directory) (ftp-server/directory project)))
     (define conn (ftp-open server))
 
@@ -291,7 +272,7 @@ pairs.  Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
                   ;; guile-www; in mit-scheme, filter out binaries.
                   (filter-map (match-lambda
                                 ((file 'file . _)
-                                 (and=> (release-file file)
+                                 (and=> (release-file project file)
                                         (cut cons <> directory)))
                                 (_ #f))
                               files)
@@ -299,14 +280,39 @@ pairs.  Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
 
 (define (latest-release project)
   "Return (\"FOO-X.Y\" . \"/bar/foo\") or #f."
-  (let ((releases (releases project)))
-    (and (not (null? releases))
-         (fold (lambda (release latest)
-                 (if (version>? (car release) (car latest))
-                     release
-                     latest))
-               '("" . "")
-               releases))))
+  (define (latest a b)
+    (if (version>? a b) a b))
+
+  (define contains-digit?
+    (cut string-any char-set:digit <>))
+
+  (let-values (((server directory) (ftp-server/directory project)))
+    (define conn (ftp-open server))
+
+    (let loop ((directory directory))
+      (let* ((entries (ftp-list conn directory))
+             (subdirs (filter-map (match-lambda
+                                   ((dir 'directory . _) dir)
+                                   (_ #f))
+                                  entries)))
+        (match subdirs
+          (()
+           ;; No sub-directories, so assume that tarballs are here.
+           (let ((files (filter-map (match-lambda
+                                     ((file 'file . _)
+                                      (release-file project file))
+                                     (_ #f))
+                                    entries)))
+             (and=> (reduce latest #f files)
+                    (cut cons <> directory))))
+          ((subdirs ...)
+           ;; Assume that SUBDIRS correspond to versions, and jump into the
+           ;; one with the highest version number.  Filter out sub-directories
+           ;; that do not contain digits---e.g., /gnuzilla/lang.
+           (let* ((subdirs (filter contains-digit? subdirs))
+                  (target  (reduce latest #f subdirs)))
+             (and target
+                  (loop (string-append directory "/" target))))))))))
 
 (define %package-name-rx
   ;; Regexp for a package name, e.g., "foo-X.Y".  Since TeXmacs uses
@@ -320,4 +326,116 @@ pairs.  Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
         (values name+version #f)
         (values (match:substring match 1) (match:substring match 2)))))
 
+
+;;;
+;;; Auto-update.
+;;;
+
+(define (package-update-path package)
+  "Return an update path for PACKAGE, or #f if no update is needed."
+  (and (gnu-package? package)
+       (match (latest-release (package-name package))
+         ((name+version . directory)
+          (let-values (((_ new-version)
+                        (package-name->name+version name+version)))
+            (and (version>? name+version (package-full-name package))
+                 `(,new-version . ,directory))))
+         (_ #f))))
+
+(define* (download-tarball store project directory version
+                           #:optional (archive-type "gz"))
+  "Download PROJECT's tarball over FTP and check its OpenPGP signature.  On
+success, return the tarball file name."
+  (let* ((server  (ftp-server/directory project))
+         (base    (string-append project "-" version ".tar." archive-type))
+         (url     (string-append "ftp://" server "/" directory "/" base))
+         (sig-url (string-append url ".sig"))
+         (tarball (download-to-store store url))
+         (sig     (download-to-store store sig-url)))
+    (let ((ret (gnupg-verify* sig tarball)))
+      (if ret
+          tarball
+          (begin
+            (warning (_ "signature verification failed for `~a'~%")
+                     base)
+            (warning (_ "(could be because the public key is not in your keyring)~%"))
+            #f)))))
+
+(define (package-update store package)
+  "Return the new version and the file name of the new version tarball for
+PACKAGE, or #f and #f when PACKAGE is up-to-date."
+  (match (package-update-path package)
+    ((version . directory)
+     (let-values (((name)
+                   (package-name package))
+                  ((archive-type)
+                   (let ((source (package-source package)))
+                     (or (and (origin? source)
+                              (file-extension (origin-uri source)))
+                         "gz"))))
+       (let ((tarball (download-tarball store name directory version
+                                        archive-type)))
+         (values version tarball))))
+    (_
+     (values #f #f))))
+
+(define (update-package-source package version hash)
+  "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.
+    (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 <>))))
+          (if file
+              (update-source file
+                             old-version version
+                             old-hash hash)
+              (begin
+                (warning (_ "~a: could not locate source file")
+                         (location-file loc))
+                #f)))
+        (begin
+          (format (current-error-port)
+                  (_ "~a: ~a: no `version' field in source; skipping~%")
+                  name (package-location package))))))
+
 ;;; gnu-maintenance.scm ends here
diff --git a/guix/gnupg.scm b/guix/gnupg.scm
new file mode 100644
index 0000000000..ee67bea91b
--- /dev/null
+++ b/guix/gnupg.scm
@@ -0,0 +1,152 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2010, 2011, 2013 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 gnupg)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 rdelim)
+  #:use-module (srfi srfi-1)
+  #:export (gnupg-verify
+            gnupg-verify*
+            gnupg-status-good-signature?
+            gnupg-status-missing-key?))
+
+;;; Commentary:
+;;;
+;;; GnuPG interface.
+;;;
+;;; Code:
+
+(define %gpg-command "gpg2")
+(define %openpgp-key-server "keys.gnupg.net")
+
+(define (gnupg-verify sig file)
+  "Verify signature SIG for FILE.  Return a status s-exp if GnuPG failed."
+
+  (define (status-line->sexp line)
+    ;; See file `doc/DETAILS' in GnuPG.
+    (define sigid-rx
+      (make-regexp
+       "^\\[GNUPG:\\] SIG_ID ([A-Za-z0-9/]+) ([[:digit:]]{4}-[[:digit:]]{2}-[[:digit:]]{2}) ([[:digit:]]+)"))
+    (define goodsig-rx
+      (make-regexp "^\\[GNUPG:\\] GOODSIG ([[:xdigit:]]+) (.+)$"))
+    (define validsig-rx
+      (make-regexp
+       "^\\[GNUPG:\\] VALIDSIG ([[:xdigit:]]+) ([[:digit:]]{4}-[[:digit:]]{2}-[[:digit:]]{2}) ([[:digit:]]+) .*$"))
+    (define expkeysig-rx                    ; good signature, but expired key
+      (make-regexp "^\\[GNUPG:\\] EXPKEYSIG ([[:xdigit:]]+) (.*)$"))
+    (define errsig-rx
+      (make-regexp
+       "^\\[GNUPG:\\] ERRSIG ([[:xdigit:]]+) ([^ ]+) ([^ ]+) ([^ ]+) ([[:digit:]]+) ([[:digit:]]+)"))
+
+    (cond ((regexp-exec sigid-rx line)
+           =>
+           (lambda (match)
+             `(signature-id ,(match:substring match 1) ; sig id
+                            ,(match:substring match 2) ; date
+                            ,(string->number           ; timestamp
+                              (match:substring match 3)))))
+          ((regexp-exec goodsig-rx line)
+           =>
+           (lambda (match)
+             `(good-signature ,(match:substring match 1)    ; key id
+                              ,(match:substring match 2)))) ; user name
+          ((regexp-exec validsig-rx line)
+           =>
+           (lambda (match)
+             `(valid-signature ,(match:substring match 1) ; fingerprint
+                               ,(match:substring match 2) ; sig creation date
+                               ,(string->number           ; timestamp
+                                 (match:substring match 3)))))
+          ((regexp-exec expkeysig-rx line)
+           =>
+           (lambda (match)
+             `(expired-key-signature ,(match:substring match 1) ; fingerprint
+                                     ,(match:substring match 2)))) ; user name
+          ((regexp-exec errsig-rx line)
+           =>
+           (lambda (match)
+             `(signature-error ,(match:substring match 1) ; key id or fingerprint
+                               ,(match:substring match 2) ; pubkey algo
+                               ,(match:substring match 3) ; hash algo
+                               ,(match:substring match 4) ; sig class
+                               ,(string->number           ; timestamp
+                                 (match:substring match 5))
+                               ,(let ((rc
+                                       (string->number ; return code
+                                        (match:substring match 6))))
+                                  (case rc
+                                    ((9) 'missing-key)
+                                    ((4) 'unknown-algorithm)
+                                    (else rc))))))
+          (else
+           `(unparsed-line ,line))))
+
+  (define (parse-status input)
+    (let loop ((line   (read-line input))
+               (result '()))
+      (if (eof-object? line)
+          (reverse result)
+          (loop (read-line input)
+                (cons (status-line->sexp line) result)))))
+
+  (let* ((pipe   (open-pipe* OPEN_READ %gpg-command "--status-fd=1"
+                             "--verify" sig file))
+         (status (parse-status pipe)))
+    ;; Ignore PIPE's exit status since STATUS above should contain all the
+    ;; info we need.
+    (close-pipe pipe)
+    status))
+
+(define (gnupg-status-good-signature? status)
+  "If STATUS, as returned by `gnupg-verify', denotes a good signature, return
+a key-id/user pair; return #f otherwise."
+  (any (lambda (sexp)
+         (match sexp
+           (((or 'good-signature 'expired-key-signature) key-id user)
+            (cons key-id user))
+           (_ #f)))
+       status))
+
+(define (gnupg-status-missing-key? status)
+  "If STATUS denotes a missing-key error, then return the key-id of the
+missing key."
+  (any (lambda (sexp)
+         (match sexp
+           (('signature-error key-id _ ...)
+            key-id)
+           (_ #f)))
+       status))
+
+(define (gnupg-receive-keys key-id server)
+  (system* %gpg-command "--keyserver" server "--recv-keys" key-id))
+
+(define* (gnupg-verify* sig file #:optional (server %openpgp-key-server))
+  "Like `gnupg-verify', but try downloading the public key if it's missing.
+Return #t if the signature was good, #f otherwise."
+  (let ((status (gnupg-verify sig file)))
+    (or (gnupg-status-good-signature? status)
+        (let ((missing (gnupg-status-missing-key? status)))
+          (and missing
+               (begin
+                 ;; Download the missing key and try again.
+                 (gnupg-receive-keys missing server)
+                 (gnupg-status-good-signature? (gnupg-verify sig file))))))))
+
+;;; gnupg.scm ends here
diff --git a/guix/packages.scm b/guix/packages.scm
index 3a6a07bbcc..7a1b100b8d 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -64,6 +64,7 @@
             package-maintainers
             package-properties
             package-location
+            package-field-location
 
             package-transitive-inputs
             package-transitive-propagated-inputs
@@ -182,6 +183,38 @@ corresponds to the arguments expected by `set-path-environment-variable'."
                                                        package)
                                                       16)))))
 
+(define (package-field-location package field)
+  "Return the source code location of the definition of FIELD for PACKAGE, or
+#f if it could not be determined."
+  (define (goto port line column)
+    (unless (and (= (port-column port) (- column 1))
+                 (= (port-line port) (- line 1)))
+      (unless (eof-object? (read-char port))
+        (goto port line column))))
+
+  (match (package-location package)
+    (($ <location> file line column)
+     (catch 'system
+       (lambda ()
+         (call-with-input-file (search-path %load-path file)
+           (lambda (port)
+             (goto port line column)
+             (match (read port)
+               (('package inits ...)
+                (let ((field (assoc field inits)))
+                  (match field
+                    ((_ value)
+                     (and=> (or (source-properties value)
+                                (source-properties field))
+                            source-properties->location))
+                    (_
+                     #f))))
+               (_
+                #f)))))
+       (lambda _
+         #f)))
+    (_ #f)))
+
 
 ;; Error conditions.
 
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 339ad0d06f..0bf154dd41 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -43,12 +43,11 @@
 When SOURCE? is true, return the derivations of the package sources."
   (let ((p (read/eval-package-expression str)))
     (if source?
-        (let ((source (package-source p))
-              (loc    (package-location p)))
+        (let ((source (package-source p)))
           (if source
               (package-source-derivation (%store) source)
-              (leave (_ "~a: error: package `~a' has no source~%")
-                     (location->string loc) (package-name p))))
+              (leave (_ "package `~a' has no source~%")
+                     (package-name p))))
         (package-derivation (%store) p system))))
 
 
@@ -169,7 +168,9 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
             (add-indirect-root (%store) root))
            ((paths ...)
             (fold (lambda (path count)
-                    (let ((root (string-append root "-" (number->string count))))
+                    (let ((root (string-append root
+                                               "-"
+                                               (number->string count))))
                       (symlink path root)
                       (add-indirect-root (%store) root))
                     (+ 1 count))
@@ -177,8 +178,7 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
                   paths))))
        (lambda args
          (leave (_ "failed to create GC root `~a': ~a~%")
-                root (strerror (system-error-errno args)))
-         (exit 1)))))
+                root (strerror (system-error-errno args)))))))
 
   (define newest-available-packages
     (memoize find-newest-available-packages))
@@ -237,7 +237,9 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
                                    (_ #f))
                                   opts)))
 
-          (show-what-to-build (%store) drv (assoc-ref opts 'dry-run?))
+          (show-what-to-build (%store) drv
+                              #:use-substitutes? (assoc-ref opts 'substitutes?)
+                              #:dry-run? (assoc-ref opts 'dry-run?))
 
           ;; TODO: Add more options.
           (set-build-options (%store)
diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm
index 7c00312c74..220211e6b8 100644
--- a/guix/scripts/download.scm
+++ b/guix/scripts/download.scm
@@ -21,30 +21,15 @@
   #:use-module (guix store)
   #:use-module (guix utils)
   #:use-module (guix base32)
-  #:use-module ((guix download) #:select (%mirrors))
-  #:use-module (guix build download)
+  #:use-module (guix download)
   #:use-module (web uri)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-11)
-  #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-37)
   #:use-module (rnrs bytevectors)
   #:use-module (rnrs io ports)
   #:export (guix-download))
 
-(define (fetch-and-store store fetch name)
-  "Call FETCH for URI, and pass it the name of a file to write to; eventually,
-copy data from that port to STORE, under NAME.  Return the resulting
-store path."
-  (call-with-temporary-output-file
-   (lambda (temp port)
-     (let ((result
-            (parameterize ((current-output-port (current-error-port)))
-              (fetch temp))))
-       (close port)
-       (and result
-            (add-to-store store name #f "sha256" temp))))))
 
 ;;;
 ;;; Command-line options.
@@ -55,11 +40,14 @@ store path."
   `((format . ,bytevector->nix-base32-string)))
 
 (define (show-help)
-  (display (_ "Usage: guix download [OPTION]... URL
+  (display (_ "Usage: guix download [OPTION] URL
 Download the file at URL, add it to the store, and print its store path
-and the hash of its contents.\n"))
+and the hash of its contents.
+
+Supported formats: 'nix-base32' (default), 'base32', and 'base16'
+('hex' and 'hexadecimal' can be used as well).\n"))
   (format #t (_ "
-  -f, --format=FMT       write the hash in the given format (default: `nix-base32')"))
+  -f, --format=FMT       write the hash in the given format"))
   (newline)
   (display (_ "
   -h, --help             display this help and exit"))
@@ -114,20 +102,18 @@ and the hash of its contents.\n"))
            (store (open-connection))
            (arg   (assq-ref opts 'argument))
            (uri   (or (string->uri arg)
-                      (leave (_ "guix-download: ~a: failed to parse URI~%")
+                      (leave (_ "~a: failed to parse URI~%")
                              arg)))
            (path  (case (uri-scheme uri)
                     ((file)
                      (add-to-store store (basename (uri-path uri))
                                    #f "sha256" (uri-path uri)))
                     (else
-                     (fetch-and-store store
-                                      (cut url-fetch arg <>
-                                           #:mirrors %mirrors)
-                                      (basename (uri-path uri))))))
+                     (download-to-store store (uri->string uri)
+                                        (basename (uri-path uri))))))
            (hash  (call-with-input-file
                       (or path
-                          (leave (_ "guix-download: ~a: download failed~%")
+                          (leave (_ "~a: download failed~%")
                                  arg))
                     (compose sha256 get-bytevector-all)))
            (fmt   (assq-ref opts 'format)))
diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm
index 3d918923f8..7625bc46e6 100644
--- a/guix/scripts/gc.scm
+++ b/guix/scripts/gc.scm
@@ -87,9 +87,8 @@ interpreted."
              ("TB"  (expt 10 12))
              (""    1)
              (_
-              (leave (_ "error: unknown unit: ~a~%") unit)
-              (exit 1))))
-        (leave (_ "error: invalid number: ~a") numstr))))
+              (leave (_ "unknown unit: ~a~%") unit))))
+        (leave (_ "invalid number: ~a~%") numstr))))
 
 (define %options
   ;; Specification of the command-line options.
@@ -110,7 +109,7 @@ interpreted."
                       (let ((amount (size->number arg)))
                         (if arg
                             (alist-cons 'min-freed amount result)
-                            (leave (_ "error: invalid amount of storage: ~a~%")
+                            (leave (_ "invalid amount of storage: ~a~%")
                                    arg))))
                      (#f result)))))
         (option '(#\d "delete") #f #f
diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm
new file mode 100644
index 0000000000..ad05a4e66f
--- /dev/null
+++ b/guix/scripts/hash.scm
@@ -0,0 +1,120 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.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 scripts hash)
+    #:use-module (guix base32)
+    #:use-module (guix ui)
+    #:use-module (guix utils)
+    #:use-module (rnrs io ports)
+    #:use-module (rnrs files)
+    #:use-module (ice-9 match)
+    #:use-module (srfi srfi-1)
+    #:use-module (srfi srfi-26)
+    #:use-module (srfi srfi-37)
+    #:export (guix-hash))
+
+
+;;;
+;;; Command-line options.
+;;;
+
+(define %default-options
+  ;; Alist of default option values.
+  `((format . ,bytevector->nix-base32-string)))
+
+(define (show-help)
+  (display (_ "Usage: guix hash [OPTION] FILE
+Return the cryptographic hash of FILE.
+
+Supported formats: 'nix-base32' (default), 'base32', and 'base16'
+('hex' and 'hexadecimal' can be used as well).\n"))
+  (format #t (_ "
+  -f, --format=FMT       write the hash in the given format"))
+  (newline)
+  (display (_ "
+  -h, --help             display this help and exit"))
+  (display (_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  (show-bug-report-information))
+
+(define %options
+  ;; Specification of the command-line options.
+  (list (option '(#\f "format") #t #f
+                (lambda (opt name arg result)
+                  (define fmt-proc
+                    (match arg
+                      ("nix-base32"
+                       bytevector->nix-base32-string)
+                      ("base32"
+                       bytevector->base32-string)
+                      ((or "base16" "hex" "hexadecimal")
+                       bytevector->base16-string)
+                      (x
+                       (leave (_ "unsupported hash format: ~a~%")
+                              arg))))
+
+                  (alist-cons 'format fmt-proc
+                              (alist-delete 'format result))))
+
+        (option '(#\h "help") #f #f
+                (lambda args
+                  (show-help)
+                  (exit 0)))
+        (option '(#\V "version") #f #f
+                (lambda args
+                  (show-version-and-exit "guix hash")))))
+
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-hash . args)
+  (define (parse-options)
+    ;; Return the alist of option values.
+    (args-fold args %options
+               (lambda (opt name arg result)
+                 (leave (_ "unrecognized option: ~a~%")
+                        name))
+               (lambda (arg result)
+                 (alist-cons 'argument arg result))
+               %default-options))
+
+    (let* ((opts (parse-options))
+           (args (filter-map (match-lambda
+                              (('argument . value)
+                               value)
+                              (_ #f))
+                             (reverse opts)))
+           (fmt  (assq-ref opts 'format)))
+
+      (match args
+        ((file)
+         (catch 'system-error
+           (lambda ()
+             (format #t "~a~%"
+                     (call-with-input-file file
+                       (compose fmt sha256 get-bytevector-all))))
+           (lambda args
+             (leave (_ "~a~%")
+                    (strerror (system-error-errno args))))))
+        (_
+         (leave (_ "wrong number of arguments~%"))))))
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index ac99d16497..c5656efc14 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -208,7 +208,7 @@ all of PACKAGES, a list of name/version/output/path/deps tuples."
       (switch-symlinks profile previous-profile))
 
     (cond ((not (file-exists? profile))           ; invalid profile
-           (leave (_ "error: profile `~a' does not exist~%")
+           (leave (_ "profile `~a' does not exist~%")
                   profile))
           ((zero? number)                         ; empty profile
            (format (current-error-port)
@@ -266,19 +266,42 @@ matching packages."
                        (assoc-ref (derivation-outputs drv) sub-drv))))
          `(,name ,out))))))
 
+(define %sigint-prompt
+  ;; The prompt to jump to upon SIGINT.
+  (make-prompt-tag "interruptible"))
+
+(define (call-with-sigint-handler thunk handler)
+  "Call THUNK and return its value.  Upon SIGINT, call HANDLER with the signal
+number in the context of the continuation of the call to this function, and
+return its return value."
+  (call-with-prompt %sigint-prompt
+                    (lambda ()
+                      (sigaction SIGINT
+                        (lambda (signum)
+                          (sigaction SIGINT SIG_DFL)
+                          (abort-to-prompt %sigint-prompt signum)))
+                      (thunk))
+                    (lambda (k signum)
+                      (handler signum))))
+
 (define-syntax-rule (waiting exp fmt rest ...)
   "Display the given message while EXP is being evaluated."
   (let* ((message (format #f fmt rest ...))
          (blank   (make-string (string-length message) #\space)))
     (display message (current-error-port))
     (force-output (current-error-port))
-    (let ((result exp))
-      ;; Clear the line.
-      (display #\cr (current-error-port))
-      (display blank (current-error-port))
-      (display #\cr (current-error-port))
-      (force-output (current-error-port))
-      exp)))
+    (call-with-sigint-handler
+     (lambda ()
+       (let ((result exp))
+         ;; Clear the line.
+         (display #\cr (current-error-port))
+         (display blank (current-error-port))
+         (display #\cr (current-error-port))
+         (force-output (current-error-port))
+         exp))
+     (lambda (signum)
+       (format (current-error-port) "  interrupted by signal ~a~%" SIGINT)
+       #f))))
 
 (define (check-package-freshness package)
   "Check whether PACKAGE has a newer version available upstream, and report
@@ -328,7 +351,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
   (display (_ "
   -r, --remove=PACKAGE   remove PACKAGE"))
   (display (_ "
-  -u, --upgrade=REGEXP   upgrade all the installed packages matching REGEXP"))
+  -u, --upgrade[=REGEXP] upgrade all the installed packages matching REGEXP"))
   (display (_ "
       --roll-back        roll back to the previous generation"))
   (newline)
@@ -379,7 +402,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
         (option '(#\r "remove") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'remove arg result)))
-        (option '(#\u "upgrade") #t #f
+        (option '(#\u "upgrade") #f #t
                 (lambda (opt name arg result)
                   (alist-cons 'upgrade arg result)))
         (option '("roll-back") #f #f
@@ -454,8 +477,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
     (define (ensure-output p sub-drv)
       (if (member sub-drv (package-outputs p))
           p
-          (leave (_ "~a: error: package `~a' lacks output `~a'~%")
-                 (location->string (package-location p))
+          (leave (_ "package `~a' lacks output `~a'~%")
                  (package-full-name p)
                  sub-drv)))
 
@@ -602,7 +624,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
         (let* ((installed (manifest-packages (profile-manifest profile)))
                (upgrade-regexps (filter-map (match-lambda
                                              (('upgrade . regexp)
-                                              (make-regexp regexp))
+                                              (make-regexp (or regexp "")))
                                              (_ #f))
                                             opts))
                (upgrade  (if (null? upgrade-regexps)
@@ -674,7 +696,9 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
             (ensure-default-profile))
 
           (show-what-to-remove/install remove* install* dry-run?)
-          (show-what-to-build (%store) drv dry-run?)
+          (show-what-to-build (%store) drv
+                              #:use-substitutes? (assoc-ref opts 'substitutes?)
+                              #:dry-run? dry-run?)
 
           (or dry-run?
               (and (build-derivations (%store) drv)
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
new file mode 100644
index 0000000000..da318b07ad
--- /dev/null
+++ b/guix/scripts/refresh.scm
@@ -0,0 +1,182 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 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 scripts refresh)
+  #:use-module (guix ui)
+  #:use-module (guix store)
+  #:use-module (guix utils)
+  #:use-module (guix packages)
+  #:use-module (guix gnu-maintenance)
+  #:use-module (gnu packages)
+  #:use-module ((gnu packages base) #:select (%final-inputs))
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-37)
+  #:use-module (rnrs io ports)
+  #:export (guix-refresh))
+
+
+;;;
+;;; Command-line options.
+;;;
+
+(define %default-options
+  ;; Alist of default option values.
+  '())
+
+(define %options
+  ;; Specification of the command-line options.
+  (list (option '(#\n "dry-run") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'dry-run? #t result)))
+        (option '(#\s "select") #t #f
+                (lambda (opt name arg result)
+                  (match arg
+                    ((or "core" "non-core")
+                     (alist-cons 'select (string->symbol arg)
+                                 result))
+                    (x
+                     (leave (_ "~a: invalid selection; expected `core' or `non-core'")
+                            arg)))))
+
+        (option '(#\h "help") #f #f
+                (lambda args
+                  (show-help)
+                  (exit 0)))
+        (option '(#\V "version") #f #f
+                (lambda args
+                  (show-version-and-exit "guix refresh")))))
+
+(define (show-help)
+  (display (_ "Usage: guix refresh [OPTION]... PACKAGE...
+Update package definitions to match the latest upstream version.
+
+When PACKAGE... is given, update only the specified packages.  Otherwise
+update all the packages of the distribution, or the subset thereof
+specified with `--select'.\n"))
+  (display (_ "
+  -n, --dry-run          do not build the derivations"))
+  (display (_ "
+  -s, --select=SUBSET    select all the packages in SUBSET, one of
+                         `core' or `non-core'"))
+  (newline)
+  (display (_ "
+  -h, --help             display this help and exit"))
+  (display (_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  (show-bug-report-information))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-refresh . args)
+  (define (parse-options)
+    ;; Return the alist of option values.
+    (args-fold args %options
+               (lambda (opt name arg result)
+                 (leave (_ "~A: unrecognized option~%") name))
+               (lambda (arg result)
+                 (alist-cons 'argument arg result))
+               %default-options))
+
+  (define core-package?
+    (let* ((input->package (match-lambda
+                            ((name (? package? package) _ ...) package)
+                            (_ #f)))
+           (final-inputs   (map input->package %final-inputs))
+           (core           (append final-inputs
+                                   (append-map (compose (cut filter-map input->package <>)
+                                                        package-transitive-inputs)
+                                               final-inputs)))
+           (names          (delete-duplicates (map package-name core))))
+      (lambda (package)
+        "Return true if PACKAGE is likely a \"core package\"---i.e., one whose
+update would trigger a complete rebuild."
+        ;; Compare by name because packages in base.scm basically inherit
+        ;; other packages.  So, even if those packages are not core packages
+        ;; themselves, updating them would also update those who inherit from
+        ;; them.
+        ;; XXX: Fails to catch MPFR/MPC, whose *source* is used as input.
+        (member (package-name package) names))))
+
+  (let* ((opts     (parse-options))
+         (dry-run? (assoc-ref opts 'dry-run?))
+         (packages (match (concatenate
+                           (filter-map (match-lambda
+                                        (('argument . value)
+                                         (let ((p (find-packages-by-name value)))
+                                           (unless p
+                                             (leave (_ "~a: no package by that name")
+                                                    value))
+                                           p))
+                                        (_ #f))
+                                       opts))
+                     (()                          ; default to all packages
+                      (let ((select? (match (assoc-ref opts 'select)
+                                       ('core core-package?)
+                                       ('non-core (negate core-package?))
+                                       (_ (const #t)))))
+                        ;; TODO: Keep only the newest of each package.
+                        (fold-packages (lambda (package result)
+                                         (if (select? package)
+                                             (cons package result)
+                                             result))
+                                       '())))
+                     (some                        ; user-specified packages
+                      some))))
+    (with-error-handling
+      (if dry-run?
+          (for-each (lambda (package)
+                      (match (false-if-exception (package-update-path package))
+                        ((new-version . directory)
+                         (let ((loc (or (package-field-location package 'version)
+                                        (package-location package))))
+                           (format (current-error-port)
+                                   (_ "~a: ~a would be upgraded from ~a to ~a~%")
+                                   (location->string loc)
+                                   (package-name package) (package-version package)
+                                   new-version)))
+                        (_ #f)))
+                    packages)
+          (let ((store (open-connection)))
+            (for-each (lambda (package)
+                        (let-values (((version tarball)
+                                      (catch #t
+                                        (lambda ()
+                                          (package-update store package))
+                                        (lambda _
+                                          (values #f #f))))
+                                     ((loc)
+                                      (or (package-field-location package
+                                                                  'version)
+                                          (package-location package))))
+                          (when version
+                            (format (current-error-port)
+                                    (_ "~a: ~a: updating from version ~a to version ~a...~%")
+                                    (location->string loc) (package-name package)
+                                    (package-version package) version)
+                            (let ((hash (call-with-input-file tarball
+                                          (compose sha256 get-bytevector-all))))
+                              (update-package-source package version hash)))))
+                      packages))))))
diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm
index 2b447ce7f2..87561db4b3 100755
--- a/guix/scripts/substitute-binary.scm
+++ b/guix/scripts/substitute-binary.scm
@@ -22,18 +22,20 @@
   #:use-module (guix utils)
   #:use-module (guix config)
   #:use-module (guix nar)
+  #:use-module ((guix build utils) #:select (mkdir-p))
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
   #:use-module (ice-9 threads)
   #:use-module (ice-9 format)
+  #:use-module (ice-9 ftw)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
   #:use-module (web uri)
-  #:use-module (web client)
-  #:use-module (web response)
+  #:use-module (guix web)
   #:export (guix-substitute-binary))
 
 ;;; Comment:
@@ -47,6 +49,40 @@
 ;;;
 ;;; Code:
 
+(define %narinfo-cache-directory
+  ;; A local cache of narinfos, to avoid going to the network.
+  (or (and=> (getenv "XDG_CACHE_HOME")
+             (cut string-append <> "/guix/substitute-binary"))
+      (string-append %state-directory "/substitute-binary/cache")))
+
+(define %narinfo-ttl
+  ;; Number of seconds during which cached narinfo lookups are considered
+  ;; valid.
+  (* 24 3600))
+
+(define %narinfo-negative-ttl
+  ;; Likewise, but for negative lookups---i.e., cached lookup failures.
+  (* 3 3600))
+
+(define %narinfo-expired-cache-entry-removal-delay
+  ;; How often we want to remove files corresponding to expired cache entries.
+  (* 7 24 3600))
+
+(define (with-atomic-file-output file proc)
+  "Call PROC with an output port for the file that is going to replace FILE.
+Upon success, FILE is atomically replaced by what has been written to the
+output port, and PROC's result is returned."
+  (let* ((template (string-append file ".XXXXXX"))
+         (out      (mkstemp! template)))
+    (with-throw-handler #t
+      (lambda ()
+        (let ((result (proc out)))
+          (close out)
+          (rename-file template file)
+          result))
+      (lambda (key . args)
+        (false-if-exception (delete-file template))))))
+
 (define (fields->alist port)
   "Read recutils-style record from PORT and return them as a list of key/value
 pairs."
@@ -72,6 +108,17 @@ pairs."
   (let ((args (map (cut assoc-ref alist <>) keys)))
     (apply make args)))
 
+(define (object->fields object fields port)
+  "Write OBJECT (typically a record) as a series of recutils-style fields to
+PORT, according to FIELDS.  FIELDS must be a list of field name/getter pairs."
+  (let loop ((fields fields))
+    (match fields
+      (()
+       object)
+      (((field . get) rest ...)
+       (format port "~a: ~a~%" field (get object))
+       (loop rest)))))
+
 (define (fetch uri)
   "Return a binary input port to URI and the number of bytes it's expected to
 provide."
@@ -80,28 +127,7 @@ provide."
      (let ((port (open-input-file (uri-path uri))))
        (values port (stat:size (stat port)))))
     ((http)
-     (let*-values (((resp port)
-                    ;; XXX: `http-get*' was introduced in 2.0.7, and deprecated
-                    ;; in 2.0.8 (!).  Assume it is available here.
-                    (if (version>? "2.0.7" (version))
-                        (http-get* uri #:decode-body? #f)
-                        (http-get uri #:streaming? #t)))
-                   ((code)
-                    (response-code resp))
-                   ((size)
-                    (response-content-length resp)))
-       (case code
-         ((200)                                   ; OK
-          (values port size))
-         ((301                                    ; moved permanently
-           302)                                   ; found (redirection)
-          (let ((uri (response-location resp)))
-            (format #t "following redirection to `~a'...~%"
-                    (uri->string uri))
-            (fetch uri)))
-         (else
-          (error "download failed" (uri->string uri)
-                 code (response-reason-phrase resp))))))))
+     (http-fetch uri #:text? #f))))
 
 (define-record-type <cache>
   (%make-cache url store-directory wants-mass-query?)
@@ -161,22 +187,166 @@ failure."
                      (_ deriver))
                    system)))
 
+(define* (read-narinfo port #:optional url)
+  "Read a narinfo from PORT in its standard external form.  If URL is true, it
+must be a string used to build full URIs from relative URIs found while
+reading PORT."
+  (alist->record (fields->alist port)
+                 (narinfo-maker url)
+                 '("StorePath" "URL" "Compression"
+                   "FileHash" "FileSize" "NarHash" "NarSize"
+                   "References" "Deriver" "System")))
+
+(define (write-narinfo narinfo port)
+  "Write NARINFO to PORT."
+  (define (empty-string-if-false x)
+    (or x ""))
+
+  (define (number-or-empty-string x)
+    (if (number? x)
+        (number->string x)
+        ""))
+
+  (object->fields narinfo
+                  `(("StorePath" . ,narinfo-path)
+                    ("URL" . ,(compose uri->string narinfo-uri))
+                    ("Compression" . ,narinfo-compression)
+                    ("FileHash" . ,(compose empty-string-if-false
+                                            narinfo-file-hash))
+                    ("FileSize" . ,(compose number-or-empty-string
+                                            narinfo-file-size))
+                    ("NarHash" . ,(compose empty-string-if-false
+                                           narinfo-hash))
+                    ("NarSize" . ,(compose number-or-empty-string
+                                           narinfo-size))
+                    ("References" . ,(compose string-join narinfo-references))
+                    ("Deriver" . ,(compose empty-string-if-false
+                                           narinfo-deriver))
+                    ("System" . ,narinfo-system))
+                  port))
+
+(define (narinfo->string narinfo)
+  "Return the external representation of NARINFO."
+  (call-with-output-string (cut write-narinfo narinfo <>)))
+
+(define (string->narinfo str)
+  "Return the narinfo represented by STR."
+  (call-with-input-string str (cut read-narinfo <>)))
+
 (define (fetch-narinfo cache path)
   "Return the <narinfo> record for PATH, or #f if CACHE does not hold PATH."
   (define (download url)
     ;; Download the `nix-cache-info' from URL, and return its contents as an
     ;; list of key/value pairs.
-    (and=> (false-if-exception (fetch (string->uri url)))
-           fields->alist))
+    (false-if-exception (fetch (string->uri url))))
 
-  (and=> (download (string-append (cache-url cache) "/"
-                                  (store-path-hash-part path)
-                                  ".narinfo"))
-         (lambda (properties)
-           (alist->record properties (narinfo-maker (cache-url cache))
-                          '("StorePath" "URL" "Compression"
-                            "FileHash" "FileSize" "NarHash" "NarSize"
-                            "References" "Deriver" "System")))))
+  (and (string=? (cache-store-directory cache) (%store-prefix))
+       (and=> (download (string-append (cache-url cache) "/"
+                                       (store-path-hash-part path)
+                                       ".narinfo"))
+              (cute read-narinfo <> (cache-url cache)))))
+
+(define (obsolete? date now ttl)
+  "Return #t if DATE is obsolete compared to NOW + TTL seconds."
+  (time>? (subtract-duration now (make-time time-duration 0 ttl))
+          (make-time time-monotonic 0 date)))
+
+(define (lookup-narinfo cache path)
+  "Check locally if we have valid info about PATH, otherwise go to CACHE and
+check what it has."
+  (define now
+    (current-time time-monotonic))
+
+  (define cache-file
+    (string-append %narinfo-cache-directory "/"
+                   (store-path-hash-part path)))
+
+  (define (cache-entry narinfo)
+    `(narinfo (version 0)
+              (date ,(time-second now))
+              (value ,(and=> narinfo narinfo->string))))
+
+  (let*-values (((valid? cached)
+                 (catch 'system-error
+                   (lambda ()
+                     (call-with-input-file cache-file
+                       (lambda (p)
+                         (match (read p)
+                           (('narinfo ('version 0) ('date date)
+                                      ('value #f))
+                            ;; A cached negative lookup.
+                            (if (obsolete? date now %narinfo-negative-ttl)
+                                (values #f #f)
+                                (values #t #f)))
+                           (('narinfo ('version 0) ('date date)
+                                      ('value value))
+                            ;; A cached positive lookup
+                            (if (obsolete? date now %narinfo-ttl)
+                                (values #f #f)
+                                (values #t (string->narinfo value))))))))
+                   (lambda _
+                     (values #f #f)))))
+    (if valid?
+        cached                                    ; including negative caches
+        (let ((narinfo (and=> (force cache)
+                              (cut fetch-narinfo <> path))))
+          (with-atomic-file-output cache-file
+            (lambda (out)
+              (write (cache-entry narinfo) out)))
+          narinfo))))
+
+(define (remove-expired-cached-narinfos)
+  "Remove expired narinfo entries from the cache.  The sole purpose of this
+function is to make sure `%narinfo-cache-directory' doesn't grow
+indefinitely."
+  (define now
+    (current-time time-monotonic))
+
+  (define (expired? file)
+    (catch 'system-error
+      (lambda ()
+        (call-with-input-file file
+          (lambda (port)
+            (match (read port)
+              (('narinfo ('version 0) ('date date)
+                         ('value #f))
+               (obsolete? date now %narinfo-negative-ttl))
+              (('narinfo ('version 0) ('date date)
+                         ('value _))
+               (obsolete? date now %narinfo-ttl))
+              (_ #t)))))
+      (lambda args
+        ;; FILE may have been deleted.
+        #t)))
+
+  (for-each (lambda (file)
+              (let ((file (string-append %narinfo-cache-directory
+                                         "/" file)))
+                (when (expired? file)
+                  ;; Wrap in `false-if-exception' because FILE might have been
+                  ;; deleted in the meantime (TOCTTOU).
+                  (false-if-exception (delete-file file)))))
+            (scandir %narinfo-cache-directory
+                     (lambda (file)
+                       (= (string-length file) 32)))))
+
+(define (maybe-remove-expired-cached-narinfo)
+  "Remove expired narinfo entries from the cache if deemed necessary."
+  (define now
+    (current-time time-monotonic))
+
+  (define expiry-file
+    (string-append %narinfo-cache-directory "/last-expiry-cleanup"))
+
+  (define last-expiry-date
+    (or (false-if-exception
+         (call-with-input-file expiry-file read))
+        0))
+
+  (when (obsolete? last-expiry-date now %narinfo-expired-cache-entry-removal-delay)
+    (remove-expired-cached-narinfos)
+    (call-with-output-file expiry-file
+      (cute write (time-second now) <>))))
 
 (define (filtered-port command input)
   "Return an input port (and PID) where data drained from INPUT is filtered
@@ -214,9 +384,11 @@ through COMMAND.  INPUT must be a file input port."
 
 (define (guix-substitute-binary . args)
   "Implement the build daemon's substituter protocol."
+  (mkdir-p %narinfo-cache-directory)
+  (maybe-remove-expired-cached-narinfo)
   (match args
     (("--query")
-     (let ((cache (open-cache %cache-url)))
+     (let ((cache (delay (open-cache %cache-url))))
        (let loop ((command (read-line)))
          (or (eof-object? command)
              (begin
@@ -225,7 +397,7 @@ through COMMAND.  INPUT must be a file input port."
                   ;; Return the subset of PATHS available in CACHE.
                   (let ((substitutable
                          (if cache
-                             (par-map (cut fetch-narinfo cache <>)
+                             (par-map (cut lookup-narinfo cache <>)
                                       paths)
                              '())))
                     (for-each (lambda (narinfo)
@@ -237,7 +409,7 @@ through COMMAND.  INPUT must be a file input port."
                   ;; Reply info about PATHS if it's in CACHE.
                   (let ((substitutable
                          (if cache
-                             (par-map (cut fetch-narinfo cache <>)
+                             (par-map (cut lookup-narinfo cache <>)
                                       paths)
                              '())))
                     (for-each (lambda (narinfo)
@@ -262,8 +434,8 @@ through COMMAND.  INPUT must be a file input port."
                (loop (read-line)))))))
     (("--substitute" store-path destination)
      ;; Download STORE-PATH and add store it as a Nar in file DESTINATION.
-     (let* ((cache   (open-cache %cache-url))
-            (narinfo (fetch-narinfo cache store-path))
+     (let* ((cache   (delay (open-cache %cache-url)))
+            (narinfo (lookup-narinfo cache store-path))
             (uri     (narinfo-uri narinfo)))
        ;; Tell the daemon what the expected hash of the Nar itself is.
        (format #t "~a~%" (narinfo-hash narinfo))
diff --git a/guix/snix.scm b/guix/snix.scm
index 0c19fecb28..04b5e7db2a 100644
--- a/guix/snix.scm
+++ b/guix/snix.scm
@@ -34,6 +34,7 @@
   #:use-module (guix utils)
   #:use-module (guix base32)
   #:use-module (guix config)
+  #:use-module (guix gnu-maintenance)
   #:export (open-nixpkgs
             xml->snix
             nixpkgs->guix-package))
@@ -435,8 +436,16 @@ location of DERIVATION."
 
              (home-page ,(and=> (find-attribute-by-name "homepage" meta)
                                 attribute-value))
-             (synopsis ,(and=> (find-attribute-by-name "description" meta)
-                               attribute-value))
+             (synopsis
+              ;; For GNU packages, prefer the official synopsis.
+              ,(or (false-if-exception
+                    (and=> (find (lambda (gnu-package)
+                                   (equal? (gnu-package-name gnu-package)
+                                           name))
+                                 (official-gnu-packages))
+                           gnu-package-doc-summary))
+                   (and=> (find-attribute-by-name "description" meta)
+                          attribute-value)))
              (description
               ,(and=> (find-attribute-by-name "longDescription" meta)
                       attribute-value))
diff --git a/guix/store.scm b/guix/store.scm
index b1b60babf0..b82588b2a0 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -336,7 +336,10 @@ encoding conversion errors."
              #f))
           ((= k %stderr-error)
            (let ((error  (read-latin1-string p))
-                 (status (if (>= (nix-server-minor-version server) 8)
+                 ;; Currently the daemon fails to send a status code for early
+                 ;; errors like DB schema version mismatches, so check for EOF.
+                 (status (if (and (>= (nix-server-minor-version server) 8)
+                                  (not (eof-object? (lookahead-u8 p))))
                              (read-int p)
                              1)))
              (raise (condition (&nix-protocol-error
diff --git a/guix/ui.scm b/guix/ui.scm
index dfb6418a10..ff0966e85c 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -40,7 +41,6 @@
             with-error-handling
             read/eval-package-expression
             location->string
-            call-with-temporary-output-file
             switch-symlinks
             config-directory
             fill-paragraph
@@ -64,15 +64,50 @@
 (define _ (cut gettext <> %gettext-domain))
 (define N_ (cut ngettext <> <> <> %gettext-domain))
 
+(define-syntax-rule (define-diagnostic name prefix)
+  "Create a diagnostic macro (i.e., NAME), which will prepend PREFIX to all
+messages."
+  (define-syntax name
+    (lambda (x)
+      (define (augmented-format-string fmt)
+        (string-append "~:[~*~;guix ~a: ~]~a" (syntax->datum fmt)))
+
+      (syntax-case x (N_ _)                    ; these are literals, yeah...
+        ((name (_ fmt) args (... ...))
+         (string? (syntax->datum #'fmt))
+         (with-syntax ((fmt*   (augmented-format-string #'fmt))
+                       (prefix (datum->syntax x prefix)))
+           #'(format (guix-warning-port) (gettext fmt*)
+                     (program-name) (program-name) prefix
+                     args (... ...))))
+        ((name (N_ singular plural n) args (... ...))
+         (and (string? (syntax->datum #'singular))
+              (string? (syntax->datum #'plural)))
+         (with-syntax ((s      (augmented-format-string #'singular))
+                       (p      (augmented-format-string #'plural))
+                       (prefix (datum->syntax x prefix)))
+           #'(format (guix-warning-port)
+                     (ngettext s p n %gettext-domain)
+                     (program-name) (program-name) prefix
+                     args (... ...))))))))
+
+(define-diagnostic warning "warning: ") ; emit a warning
+
+(define-diagnostic report-error "error: ")
+(define-syntax-rule (leave args ...)
+  "Emit an error message and exit."
+  (begin
+    (report-error args ...)
+    (exit 1)))
+
 (define (install-locale)
   "Install the current locale settings."
   (catch 'system-error
     (lambda _
       (setlocale LC_ALL ""))
     (lambda args
-      (format (current-error-port)
-              (_ "warning: failed to install locale: ~a~%")
-              (strerror (system-error-errno args))))))
+      (warning (_ "failed to install locale: ~a~%")
+               (strerror (system-error-errno args))))))
 
 (define (initialize-guix)
   "Perform the usual initialization for stand-alone Guix commands."
@@ -81,12 +116,6 @@
   (setvbuf (current-output-port) _IOLBF)
   (setvbuf (current-error-port) _IOLBF))
 
-(define-syntax-rule (leave fmt args ...)
-  "Format FMT and ARGS to the error port and exit."
-  (begin
-    (format (current-error-port) fmt args ...)
-    (exit 1)))
-
 (define* (show-version-and-exit #:optional (command (car (command-line))))
   "Display version information for COMMAND and `(exit 0)'."
   (simple-format #t "~a (~a) ~a~%"
@@ -111,16 +140,16 @@ General help using GNU software: <http://www.gnu.org/gethelp/>"))
                     (file     (location-file location))
                     (line     (location-line location))
                     (column   (location-column location)))
-               (leave (_ "~a:~a:~a: error: package `~a' has an invalid input: ~s~%")
+               (leave (_ "~a:~a:~a: package `~a' has an invalid input: ~s~%")
                       file line column
                       (package-full-name package) input)))
             ((nix-connection-error? c)
-             (leave (_ "error: failed to connect to `~a': ~a~%")
+             (leave (_ "failed to connect to `~a': ~a~%")
                     (nix-connection-error-file c)
                     (strerror (nix-connection-error-code c))))
             ((nix-protocol-error? c)
              ;; FIXME: Server-provided error messages aren't i18n'd.
-             (leave (_ "error: build failed: ~a~%")
+             (leave (_ "build failed: ~a~%")
                     (nix-protocol-error-message c))))
     (thunk)))
 
@@ -144,33 +173,66 @@ error."
           (leave (_ "expression `~s' does not evaluate to a package~%")
                  exp)))))
 
-(define* (show-what-to-build store drv #:optional dry-run?)
+(define* (show-what-to-build store drv
+                             #:key dry-run? (use-substitutes? #t))
   "Show what will or would (depending on DRY-RUN?) be built in realizing the
 derivations listed in DRV.  Return #t if there's something to build, #f
-otherwise."
-  (let* ((req  (append-map (lambda (drv-path)
-                             (let ((d (call-with-input-file drv-path
-                                        read-derivation)))
-                               (derivation-prerequisites-to-build
-                                store d)))
-                           drv))
-         (req* (delete-duplicates
-                (append (remove (compose (cute valid-path? store <>)
-                                         derivation-path->output-path)
-                                drv)
-                        (map derivation-input-path req)))))
+otherwise.  When USE-SUBSTITUTES?, check and report what is prerequisites are
+available for download."
+  (let*-values (((build download)
+                 (fold2 (lambda (drv-path build download)
+                          (let ((drv (call-with-input-file drv-path
+                                       read-derivation)))
+                            (let-values (((b d)
+                                          (derivation-prerequisites-to-build
+                                           store drv
+                                           #:use-substitutes?
+                                           use-substitutes?)))
+                              (values (append b build)
+                                      (append d download)))))
+                        '() '()
+                        drv))
+                ((build)                          ; add the DRV themselves
+                 (delete-duplicates
+                  (append (remove (compose (lambda (out)
+                                             (or (valid-path? store out)
+                                                 (and use-substitutes?
+                                                      (has-substitutes? store
+                                                                        out))))
+                                           derivation-path->output-path)
+                                  drv)
+                          (map derivation-input-path build))))
+                ((download)                   ; add the references of DOWNLOAD
+                 (delete-duplicates
+                  (append download
+                          (remove (cut valid-path? store <>)
+                                  (append-map
+                                   substitutable-references
+                                   (substitutable-path-info store download)))))))
     (if dry-run?
-        (format (current-error-port)
-                (N_ "~:[the following derivation would be built:~%~{   ~a~%~}~;~]"
-                    "~:[the following derivations would be built:~%~{    ~a~%~}~;~]"
-                    (length req*))
-                (null? req*) req*)
-        (format (current-error-port)
-                (N_ "~:[the following derivation will be built:~%~{   ~a~%~}~;~]"
-                    "~:[the following derivations will be built:~%~{    ~a~%~}~;~]"
-                    (length req*))
-                (null? req*) req*))
-    (pair? req*)))
+        (begin
+          (format (current-error-port)
+                  (N_ "~:[the following derivation would be built:~%~{   ~a~%~}~;~]"
+                      "~:[the following derivations would be built:~%~{    ~a~%~}~;~]"
+                      (length build))
+                  (null? build) build)
+          (format (current-error-port)
+                  (N_ "~:[the following file would be downloaded:~%~{   ~a~%~}~;~]"
+                      "~:[the following files would be downloaded:~%~{    ~a~%~}~;~]"
+                      (length download))
+                  (null? download) download))
+        (begin
+          (format (current-error-port)
+                  (N_ "~:[the following derivation will be built:~%~{   ~a~%~}~;~]"
+                      "~:[the following derivations will be built:~%~{    ~a~%~}~;~]"
+                      (length build))
+                  (null? build) build)
+          (format (current-error-port)
+                  (N_ "~:[the following file will be downloaded:~%~{   ~a~%~}~;~]"
+                      "~:[the following files will be downloaded:~%~{    ~a~%~}~;~]"
+                      (length download))
+                  (null? download) download)))
+    (pair? build)))
 
 (define-syntax with-error-handling
   (syntax-rules ()
@@ -187,21 +249,6 @@ otherwise."
     (($ <location> file line column)
      (format #f "~a:~a:~a" file line column))))
 
-(define (call-with-temporary-output-file proc)
-  "Call PROC with a name of a temporary file and open output port to that
-file; close the file and delete it when leaving the dynamic extent of this
-call."
-  (let* ((template (string-copy "guix-file.XXXXXX"))
-         (out      (mkstemp! template)))
-    (dynamic-wind
-      (lambda ()
-        #t)
-      (lambda ()
-        (proc template out))
-      (lambda ()
-        (false-if-exception (close out))
-        (false-if-exception (delete-file template))))))
-
 (define (switch-symlinks link target)
   "Atomically switch LINK, a symbolic link, to point to TARGET.  Works
 both when LINK already exists and when it does not."
@@ -342,36 +389,6 @@ WIDTH columns."
 (define guix-warning-port
   (make-parameter (current-warning-port)))
 
-(define-syntax warning
-  (lambda (s)
-    "Emit a warming.  The macro assumes that `_' is bound to `gettext'."
-    ;; All this just to preserve `-Wformat' warnings.  Too much?
-
-    (define (augmented-format-string fmt)
-      (string-append "~:[~;guix ~a: ~]~a" (syntax->datum fmt)))
-
-    (define prefix
-      #'(_ "warning: "))
-
-    (syntax-case s (N_ _)                        ; these are literals, yeah...
-      ((warning (_ fmt) args ...)
-       (string? (syntax->datum #'fmt))
-       (with-syntax ((fmt*   (augmented-format-string #'fmt))
-                     (prefix prefix))
-         #'(format (guix-warning-port) (gettext fmt*)
-                   (program-name) (program-name) prefix
-                   args ...)))
-      ((warning (N_ singular plural n) args ...)
-       (and (string? (syntax->datum #'singular))
-            (string? (syntax->datum #'plural)))
-       (with-syntax ((s (augmented-format-string #'singular))
-                     (p (augmented-format-string #'plural))
-                     (b prefix))
-         #'(format (guix-warning-port)
-                   (ngettext s p n %gettext-domain)
-                   (program-name) (program-name) b
-                   args ...))))))
-
 (define (guix-main arg0 . args)
   (initialize-guix)
   (let ()
diff --git a/guix/utils.scm b/guix/utils.scm
index d7c37e37d1..3cbed2fd0f 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -59,7 +59,10 @@
             %current-system
             version-compare
             version>?
-            package-name->name+version))
+            package-name->name+version
+            file-extension
+            call-with-temporary-output-file
+            fold2))
 
 
 ;;;
@@ -463,6 +466,52 @@ introduce the version part."
       ((head tail ...)
        (loop tail (cons head prefix))))))
 
+(define (file-extension file)
+  "Return the extension of FILE or #f if there is none."
+  (let ((dot (string-rindex file #\.)))
+    (and dot (substring file (+ 1 dot) (string-length file)))))
+
+(define (call-with-temporary-output-file proc)
+  "Call PROC with a name of a temporary file and open output port to that
+file; close the file and delete it when leaving the dynamic extent of this
+call."
+  (let* ((template (string-copy "guix-file.XXXXXX"))
+         (out      (mkstemp! template)))
+    (dynamic-wind
+      (lambda ()
+        #t)
+      (lambda ()
+        (proc template out))
+      (lambda ()
+        (false-if-exception (close out))
+        (false-if-exception (delete-file template))))))
+
+(define fold2
+  (case-lambda
+    ((proc seed1 seed2 lst)
+     "Like `fold', but with a single list and two seeds."
+     (let loop ((result1 seed1)
+                (result2 seed2)
+                (lst     lst))
+       (if (null? lst)
+           (values result1 result2)
+           (call-with-values
+               (lambda () (proc (car lst) result1 result2))
+             (lambda (result1 result2)
+               (loop result1 result2 (cdr lst)))))))
+    ((proc seed1 seed2 lst1 lst2)
+     "Like `fold', but with a two lists and two seeds."
+     (let loop ((result1 seed1)
+                (result2 seed2)
+                (lst1    lst1)
+                (lst2    lst2))
+       (if (or (null? lst1) (null? lst2))
+           (values result1 result2)
+           (call-with-values
+               (lambda () (proc (car lst1) (car lst2) result1 result2))
+             (lambda (result1 result2)
+               (fold2 proc result1 result2 (cdr lst1) (cdr lst2)))))))))
+
 
 ;;;
 ;;; Source location.
@@ -490,5 +539,6 @@ etc."
   (let ((file (assq-ref loc 'filename))
         (line (assq-ref loc 'line))
         (col  (assq-ref loc 'column)))
-    ;; In accordance with the GCS, start line and column numbers at 1.
-    (location file (and line (+ line 1)) (and col (+ col 1)))))
+    ;; 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)))
diff --git a/guix/web.scm b/guix/web.scm
new file mode 100644
index 0000000000..9d0ee40624
--- /dev/null
+++ b/guix/web.scm
@@ -0,0 +1,85 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013 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 web)
+  #:use-module (web uri)
+  #:use-module (web client)
+  #:use-module (web response)
+  #:use-module (srfi srfi-11)
+  #:use-module (rnrs io ports)
+  #:use-module (rnrs bytevectors)
+  #:use-module (guix ui)
+  #:use-module (guix utils)
+  #:export (http-fetch))
+
+;;; Commentary:
+;;;
+;;; Web client portable among Guile versions.
+;;;
+;;; Code:
+
+(define* (http-fetch uri #:key (text? #f))
+  "Return an input port containing the data at URI, and the expected number of
+bytes available or #f.  If TEXT? is true, the data at URI is considered to be
+textual.  Follow any HTTP redirection."
+  (let loop ((uri uri))
+    (let*-values (((resp data)
+                   ;; Try hard to use the API du jour to get an input port.
+                   ;; On Guile 2.0.5 and before, we can only get a string or
+                   ;; bytevector, and not an input port.  Work around that.
+                   (if (version>? "2.0.7" (version))
+                       (if (defined? 'http-get*)
+                           (http-get* uri #:decode-body? text?) ; 2.0.7
+                           (http-get uri #:decode-body? text?)) ; 2.0.5-
+                       (http-get uri #:streaming? #t)))         ; 2.0.9+
+                  ((code)
+                   (response-code resp)))
+      (case code
+        ((200)
+         (let ((len (response-content-length resp)))
+           (cond ((not data)
+                  (begin
+                    ;; XXX: Guile 2.0.5 and earlier did not support chunked
+                    ;; transfer encoding, which is required for instance when
+                    ;; fetching %PACKAGE-LIST-URL (see
+                    ;; <http://lists.gnu.org/archive/html/guile-devel/2011-09/msg00089.html>).
+                    ;; Since users may still be using these versions, warn them
+                    ;; and bail out.
+                    (warning (_ "using Guile ~a, ~a ~s encoding~%")
+                             (version)
+                             "which does not support HTTP"
+                             (response-transfer-encoding resp))
+                    (leave (_ "download failed; use a newer Guile~%")
+                           uri resp)))
+                 ((string? data)                   ; `http-get' from 2.0.5-
+                  (values (open-input-string data) len))
+                 ((bytevector? data)               ; likewise
+                  (values (open-bytevector-input-port data) len))
+                 (else                             ; input port
+                  (values data len)))))
+        ((301                                      ; moved permanently
+          302)                                     ; found (redirection)
+         (let ((uri (response-location resp)))
+           (format #t "following redirection to `~a'...~%"
+                   (uri->string uri))
+           (loop uri)))
+        (else
+         (error "download failed" uri code
+                (response-reason-phrase resp)))))))
+
+;;; web.scm ends here