Merge branch 'master' into core-updates

22 files changed, 413 insertions, 199 deletions

diff --git a/guix/build-system/emacs.scm b/guix/build-system/emacs.scm
index 03c1eb2baf..a7982002b6 100644
--- a/guix/build-system/emacs.scm
+++ b/guix/build-system/emacs.scm
@@ -47,11 +47,7 @@
   "Return the default Emacs package."
   ;; Lazily resolve the binding to avoid a circular dependency.
   (let ((emacs-mod (resolve-interface '(gnu packages emacs))))
-    ;; we use 'emacs' instead of 'emacs-no-x' because the latter appears not
-    ;; to be loading some macros and causes problems to some packages.  For
-    ;; example, with the latter AUCTeX gives the error message:
-    ;; "(invalid-function dbus-ignore-errors)".
-    (module-ref emacs-mod 'emacs)))
+    (module-ref emacs-mod 'emacs-minimal)))
 
 (define* (lower name
                 #:key source inputs native-inputs outputs system target
diff --git a/guix/build/bournish.scm b/guix/build/bournish.scm
index 4022796658..1f17e0a22d 100644
--- a/guix/build/bournish.scm
+++ b/guix/build/bournish.scm
@@ -134,8 +134,10 @@ commands such as 'ls' and 'cd'; it lacks globbing, pipes---everything.\n"))
 (define (read-bournish port env)
   "Read a Bournish expression from PORT, and return the corresponding Scheme
 code as an sexp."
-  (match (string-tokenize (read-line port))
-    ((command args ...)
+  (match (read-line port)
+    ((? eof-object? eof)
+     eof)
+    ((= string-tokenize (command args ...))
      (match (assoc command %commands)
        ((command proc)                            ;built-in command
         (apply proc (map expand-variable args)))
@@ -147,11 +149,24 @@ code as an sexp."
 
 (define %bournish-language
   (let ((scheme (lookup-language 'scheme)))
+    ;; XXX: The 'scheme' language lacks a "joiner", so we add one here.  This
+    ;; allows us to have 'read-bournish' read one shell statement at a time
+    ;; instead of having to read until EOF.
+    (set! (language-joiner scheme)
+      (lambda (exps env)
+        (match exps
+          (()   '(begin))
+          ((exp) exp)
+          (_    `(begin ,@exps)))))
+
     (make-language #:name 'bournish
                    #:title "Bournish"
+
+                   ;; The reader does all the heavy lifting.
                    #:reader read-bournish
-                   #:compilers (language-compilers scheme)
-                   #:decompilers (language-decompilers scheme)
+                   #:compilers `((scheme . ,(lambda (exp env options)
+                                              (values exp env env))))
+                   #:decompilers '()
                    #:evaluator (language-evaluator scheme)
                    #:printer (language-printer scheme)
                    #:make-default-environment
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 7741726c41..bd011ce878 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -234,9 +234,10 @@ and 'guix publish', something like
         (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)))
+(define* (ftp-fetch uri file #:key timeout)
+  "Fetch data from URI and write it to FILE.  Return FILE on success.  Bail
+out if the connection could not be established in less than TIMEOUT seconds."
+  (let* ((conn (ftp-open (uri-host uri) #:timeout timeout))
          (size (false-if-exception (ftp-size conn (uri-path uri))))
          (in   (ftp-retr conn (basename (uri-path uri))
                          (dirname (uri-path uri)))))
@@ -585,8 +586,10 @@ Return the resulting target URI."
                     #:query    (uri-query    ref)
                     #:fragment (uri-fragment ref)))))
 
-(define (http-fetch uri file)
-  "Fetch data from URI and write it to FILE.  Return FILE on success."
+(define* (http-fetch uri file #:key timeout)
+  "Fetch data from URI and write it to FILE; when TIMEOUT is true, bail out if
+the connection could not be established in less than TIMEOUT seconds.  Return
+FILE on success."
 
   (define post-2.0.7?
     (or (> (string->number (major-version)) 2)
@@ -605,7 +608,7 @@ Return the resulting target URI."
       (Accept . "*/*")))
 
   (let*-values (((connection)
-                 (open-connection-for-uri uri))
+                 (open-connection-for-uri uri #:timeout timeout))
                 ((resp bv-or-port)
                  ;; XXX: `http-get*' was introduced in 2.0.7, and replaced by
                  ;; #:streaming? in 2.0.8.  We know we're using it within the
@@ -646,7 +649,7 @@ Return the resulting target URI."
          (format #t "following redirection to `~a'...~%"
                  (uri->string uri))
          (close connection)
-         (http-fetch uri file)))
+         (http-fetch uri file #:timeout timeout)))
       (else
        (error "download failed" (uri->string uri)
               code (response-reason-phrase resp))))))
@@ -686,6 +689,7 @@ Return a list of URIs."
 
 (define* (url-fetch url file
                     #:key
+                    (timeout 10)
                     (mirrors '()) (content-addressed-mirrors '())
                     (hashes '()))
   "Fetch FILE from URL; URL may be either a single string, or a list of
@@ -711,19 +715,19 @@ or #f."
             file (uri->string uri))
     (case (uri-scheme uri)
       ((http https)
-       (false-if-exception* (http-fetch uri file)))
+       (false-if-exception* (http-fetch uri file #:timeout timeout)))
       ((ftp)
-       (false-if-exception* (ftp-fetch uri file)))
+       (false-if-exception* (ftp-fetch uri file #:timeout timeout)))
       (else
        (format #t "skipping URI with unsupported scheme: ~s~%"
                uri)
        #f)))
 
-  (define content-addressed-urls
+  (define content-addressed-uris
     (append-map (lambda (make-url)
                   (filter-map (match-lambda
                                 ((hash-algo . hash)
-                                 (make-url hash-algo hash)))
+                                 (string->uri (make-url hash-algo hash))))
                               hashes))
                 content-addressed-mirrors))
 
@@ -733,7 +737,7 @@ or #f."
 
   (setvbuf (current-error-port) _IOLBF)
 
-  (let try ((uri (append uri content-addressed-urls)))
+  (let try ((uri (append uri content-addressed-uris)))
     (match uri
       ((uri tail ...)
        (or (fetch uri file)
diff --git a/guix/build/emacs-build-system.scm b/guix/build/emacs-build-system.scm
index f0a9a6e125..ab970012a7 100644
--- a/guix/build/emacs-build-system.scm
+++ b/guix/build/emacs-build-system.scm
@@ -21,6 +21,7 @@
   #:use-module (guix build utils)
   #:use-module (guix build emacs-utils)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 regex)
@@ -39,6 +40,27 @@
 ;; archive signature.
 (define %install-suffix "/share/emacs/site-lisp/guix.d")
 
+(define gnu:unpack (assoc-ref gnu:%standard-phases 'unpack))
+
+(define (store-file->elisp-source-file file)
+  "Convert FILE, a store file name for an Emacs Lisp source file, into a file
+name that has been stripped of the hash and version number."
+  (let-values (((name version)
+                (package-name->name+version
+                 (strip-store-file-name file))))
+    (string-append name ".el")))
+
+(define* (unpack #:key source #:allow-other-keys)
+  "Unpack SOURCE into the build directory.  SOURCE may be a compressed
+archive, a directory, or an Emacs Lisp file."
+  (if (string-suffix? ".el" source)
+      (begin
+        (mkdir "source")
+        (chdir "source")
+        (copy-file source (store-file->elisp-source-file source))
+        #t)
+      (gnu:unpack #:source source)))
+
 (define* (build #:key outputs inputs #:allow-other-keys)
   "Compile .el files."
   (let* ((emacs (string-append (assoc-ref inputs "emacs") "/bin/emacs"))
@@ -151,6 +173,7 @@ second hyphen.  This corresponds to 'name-version' as used in ELPA packages."
 
 (define %standard-phases
   (modify-phases gnu:%standard-phases
+    (replace 'unpack unpack)
     (delete 'configure)
     (delete 'check)
     (delete 'install)
diff --git a/guix/build/graft.scm b/guix/build/graft.scm
index b61982dd64..fb21fc3af3 100644
--- a/guix/build/graft.scm
+++ b/guix/build/graft.scm
@@ -105,6 +105,19 @@ a list of store file name pairs."
                                (string-append (dirname file) "/" target))))
               matches)))
 
+(define (exit-on-exception proc)
+  "Return a procedure that wraps PROC so that 'primitive-exit' is called when
+an exception is caught."
+  (lambda (arg)
+    (catch #t
+      (lambda ()
+        (proc arg))
+      (lambda (key . args)
+        ;; Since ports are not thread-safe as of Guile 2.0, reopen stderr.
+        (let ((port (fdopen 2 "w0")))
+          (print-exception port #f key args)
+          (primitive-exit 1))))))
+
 (define* (rewrite-directory directory output mapping
                             #:optional (store (%store-directory)))
   "Copy DIRECTORY to OUTPUT, replacing strings according to MAPPING, a list of
@@ -147,9 +160,13 @@ file name pairs."
   ;; #o777.
   (umask #o022)
 
+  ;; Use 'exit-on-exception' to force an exit upon I/O errors, given that
+  ;; 'n-par-for-each' silently swallows exceptions.
+  ;; See <http://bugs.gnu.org/23581>.
   (n-par-for-each (parallel-job-count)
-                  rewrite-leaf (find-files directory (const #t)
-                                           #:directories? #t))
+                  (exit-on-exception rewrite-leaf)
+                  (find-files directory (const #t)
+                              #:directories? #t))
   (rename-matching-files output mapping))
 
 ;;; graft.scm ends here
diff --git a/guix/build/ruby-build-system.scm b/guix/build/ruby-build-system.scm
index a4ac3b307c..79ac380cb8 100644
--- a/guix/build/ruby-build-system.scm
+++ b/guix/build/ruby-build-system.scm
@@ -66,14 +66,13 @@ directory."
       ;; Use GNU unpack strategy for things that aren't gem archives.
       (gnu:unpack #:source source)))
 
-(define* (build #:key source #:allow-other-keys)
-  "Build a new gem using the gemspec from the SOURCE gem."
-  (define (first-gemspec)
-    (first-matching-file "\\.gemspec$"))
+(define (first-gemspec)
+  (first-matching-file "\\.gemspec$"))
 
-  ;; Remove the original gemspec, if present, and replace it with a new one.
-  ;; This avoids issues with upstream gemspecs requiring tools such as git to
-  ;; generate the files list.
+(define* (extract-gemspec #:key source #:allow-other-keys)
+  "Remove the original gemspec, if present, and replace it with a new one.
+This avoids issues with upstream gemspecs requiring tools such as git to
+generate the files list."
   (when (gem-archive? source)
     (let ((gemspec (or (false-if-exception (first-gemspec))
                        ;; Make new gemspec if one wasn't shipped.
@@ -94,7 +93,10 @@ directory."
                   (write-char (read-char pipe) out))))
             #t)
           (lambda ()
-            (close-pipe pipe))))))
+            (close-pipe pipe)))))))
+
+(define* (build #:key source #:allow-other-keys)
+  "Build a new gem using the gemspec from the SOURCE gem."
 
   ;; Build a new gem from the current working directory.  This also allows any
   ;; dynamic patching done in previous phases to be present in the installed
@@ -134,6 +136,7 @@ GEM-FLAGS are passed to the 'gem' invokation, if present."
 (define %standard-phases
   (modify-phases gnu:%standard-phases
     (delete 'configure)
+    (add-before 'build 'extract-gemspec extract-gemspec)
     (replace 'build build)
     (replace 'unpack unpack)
     (replace 'install install)
diff --git a/guix/build/union.scm b/guix/build/union.scm
index ccd2d5c103..6640b56523 100644
--- a/guix/build/union.scm
+++ b/guix/build/union.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -53,22 +53,24 @@
 identical, #f otherwise."
   (let ((st1 (stat file1))
         (st2 (stat file2)))
-    (and (eq? (stat:type st1) 'regular)
-         (eq? (stat:type st2) 'regular)
-         (= (stat:size st1) (stat:size st2))
-         (call-with-input-file file1
-           (lambda (port1)
-             (call-with-input-file file2
-               (lambda (port2)
-                 (define len 8192)
-                 (define buf1 (make-bytevector len))
-                 (define buf2 (make-bytevector len))
-                 (let loop ()
-                   (let ((n1 (get-bytevector-n! port1 buf1 0 len))
-                         (n2 (get-bytevector-n! port2 buf2 0 len)))
-                     (and (equal? n1 n2)
-                          (or (eof-object? n1)
-                              (loop))))))))))))
+    ;; When deduplication is enabled, identical files share the same inode.
+    (or (= (stat:ino st1) (stat:ino st2))
+        (and (eq? (stat:type st1) 'regular)
+             (eq? (stat:type st2) 'regular)
+             (= (stat:size st1) (stat:size st2))
+             (call-with-input-file file1
+               (lambda (port1)
+                 (call-with-input-file file2
+                   (lambda (port2)
+                     (define len 8192)
+                     (define buf1 (make-bytevector len))
+                     (define buf2 (make-bytevector len))
+                     (let loop ()
+                       (let ((n1 (get-bytevector-n! port1 buf1 0 len))
+                             (n2 (get-bytevector-n! port2 buf2 0 len)))
+                         (and (equal? n1 n2)
+                              (or (eof-object? n1)
+                                  (loop)))))))))))))
 
 (define* (union-build output inputs
                       #:key (log-port (current-error-port)))
diff --git a/guix/cve.scm b/guix/cve.scm
index 8e76f42f0d..088e39837a 100644
--- a/guix/cve.scm
+++ b/guix/cve.scm
@@ -19,11 +19,14 @@
 (define-module (guix cve)
   #:use-module (guix utils)
   #:use-module (guix http-client)
+  #:use-module ((guix build utils) #:select (mkdir-p))
   #:use-module (sxml ssax)
   #:use-module (web uri)
   #: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 (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 vlist)
@@ -46,8 +49,8 @@
 (define-record-type <vulnerability>
   (vulnerability id packages)
   vulnerability?
-  (id         vulnerability-id)
-  (packages   vulnerability-packages))
+  (id         vulnerability-id)                   ;string
+  (packages   vulnerability-packages))            ;((p1 v1 v2 v3) (p2 v1) ...)
 
 (define %now
   (current-date))
@@ -73,7 +76,7 @@
 
 (define (call-with-cve-port uri ttl proc)
   "Pass PROC an input port from which to read the CVE stream."
-  (let ((port (http-fetch/cached uri #:ttl ttl)))
+  (let ((port (http-fetch uri)))
     (dynamic-wind
       (const #t)
       (lambda ()
@@ -91,18 +94,45 @@
 
 (define (cpe->package-name cpe)
   "Converts the Common Platform Enumeration (CPE) string CPE to a package
-name, in a very naive way.  Return #f if CPE does not look like an application
-CPE string."
-  (and=> (regexp-exec %cpe-package-rx (string-trim-both cpe))
+name, in a very naive way.  Return two values: the package name, and its
+version string.  Return #f and #f if CPE does not look like an application CPE
+string."
+  (cond ((regexp-exec %cpe-package-rx (string-trim-both cpe))
+         =>
          (lambda (matches)
-           (cons (match:substring matches 2)
-                 (string-append (match:substring matches 3)
-                                (match (match:substring matches 4)
-                                  ("" "")
-                                  (patch-level
-                                   ;; Drop the colon from things like
-                                   ;; "cpe:/a:openbsd:openssh:6.8:p1".
-                                   (string-drop patch-level 1))))))))
+           (values (match:substring matches 2)
+                   (string-append (match:substring matches 3)
+                                  (match (match:substring matches 4)
+                                    ("" "")
+                                    (patch-level
+                                     ;; Drop the colon from things like
+                                     ;; "cpe:/a:openbsd:openssh:6.8:p1".
+                                     (string-drop patch-level 1)))))))
+        (else
+         (values #f #f))))
+
+(define (cpe->product-alist products)
+  "Given PRODUCTS, a list of CPE names, return the subset limited to the
+applications listed in PRODUCTS, with names converted to package names:
+
+  (cpe->product-alist
+    '(\"cpe:/a:gnu:libtasn1:4.7\" \"cpe:/a:gnu:libtasn1:4.6\" \"cpe:/a:gnu:cpio:2.11\"))
+  => ((\"libtasn1\" \"4.7\" \"4.6\") (\"cpio\" \"2.11\"))
+"
+  (fold (lambda (product result)
+          (let-values (((name version) (cpe->package-name product)))
+            (if name
+                (match result
+                  (((previous . versions) . tail)
+                   ;; Attempt to coalesce NAME and PREVIOUS.
+                   (if (string=? name previous)
+                       (alist-cons name (cons version versions) tail)
+                       (alist-cons name (list version) result)))
+                  (()
+                   (alist-cons name (list version) result)))
+                result)))
+        '()
+        (sort products string<?)))
 
 (define %parse-vulnerability-feed
   ;; Parse the XML vulnerability feed from
@@ -130,12 +160,12 @@ CPE string."
                             ;; Some entries have no vulnerable-software-list.
                             rest)
                            ((products id . rest)
-                            (match (filter-map cpe->package-name products)
+                            (match (cpe->product-alist products)
                               (()
                                ;; No application among PRODUCTS.
                                rest)
                               (packages
-                               (cons (vulnerability id (reverse packages))
+                               (cons (vulnerability id packages)
                                      rest))))))
                         (x
                          seed)))
@@ -154,28 +184,85 @@ CPE string."
 vulnerability objects."
   (reverse (%parse-vulnerability-feed port '())))
 
-(define (current-vulnerabilities)
-  "Return the current list of Common Vulnerabilities and Exposures (CVE) as
-published by the US NIST."
-  (define (read-vulnerabilities uri ttl)
-    (call-with-cve-port uri ttl
+(define vulnerability->sexp
+  (match-lambda
+    (($ <vulnerability> id packages)
+     `(v ,id ,packages))))
+
+(define sexp->vulnerability
+  (match-lambda
+    (('v id (packages ...))
+     (vulnerability id packages))))
+
+(define (fetch-vulnerabilities year ttl)
+  "Return the list of <vulnerability> for YEAR, assuming the on-disk cache has
+the given TTL (fetch from the NIST web site when TTL has expired)."
+  ;; Note: We used to keep the original XML files in cache but parsing it
+  ;; would take typically ~15s for a year of data.  Thus, we instead store a
+  ;; summarized version thereof as an sexp, which can be parsed in 1s or so.
+  (define cache
+    (string-append (cache-directory) "/cve/" (number->string year)))
+
+  (define (do-fetch)
+    (call-with-cve-port (yearly-feed-uri year) ttl
       (lambda (port)
         ;; XXX: The SSAX "error port" is used to send pointless warnings such as
         ;; "warning: Skipping PI".  Turn that off.
+        (format (current-error-port) "fetching CVE database for ~a...~%" year)
         (parameterize ((current-ssax-error-port (%make-void-port "w")))
           (xml->vulnerabilities port)))))
 
-  (append-map read-vulnerabilities
-              (list (yearly-feed-uri %past-year)
-                    (yearly-feed-uri %current-year))
-              (list %past-year-ttl
-                    %current-year-ttl)))
+  (define (update-cache)
+    (mkdir-p (dirname cache))
+    (let ((vulns (do-fetch)))
+      (with-atomic-file-output cache
+        (lambda (port)
+          (write `(vulnerabilities
+                   1                              ;format version
+                   ,(map vulnerability->sexp vulns))
+                 port)))
+      vulns))
+
+  (define (old? file)
+    ;; Return true if PORT has passed TTL.
+    (let* ((s   (stat file))
+           (now (current-time time-utc)))
+      (< (+ (stat:mtime s) ttl) (time-second now))))
+
+  (catch 'system-error
+    (lambda ()
+      (if (old? cache)
+          (update-cache)
+          (match (call-with-input-file cache read)
+            (('vulnerabilities 1 vulns)
+             (map sexp->vulnerability vulns))
+            (x
+             (update-cache)))))
+    (lambda args
+      (update-cache))))
+
+(define (current-vulnerabilities)
+  "Return the current list of Common Vulnerabilities and Exposures (CVE) as
+published by the US NIST."
+  (let ((past-years (unfold (cut > <> 3)
+                            (lambda (n)
+                              (- %current-year n))
+                            1+
+                            1))
+        (past-ttls  (unfold (cut > <> 3)
+                            (lambda (n)
+                              (* n %past-year-ttl))
+                            1+
+                            1)))
+    (append-map fetch-vulnerabilities
+                (cons %current-year past-years)
+                (cons %current-year-ttl past-ttls))))
 
 (define (vulnerabilities->lookup-proc vulnerabilities)
   "Return a lookup procedure built from VULNERABILITIES that takes a package
 name and optionally a version number.  When the version is omitted, the lookup
-procedure returns a list of version/vulnerability pairs; otherwise, it returns
-a list of vulnerabilities affection the given package version."
+procedure returns a list of vulnerabilities; otherwise, it returns a list of
+vulnerabilities affecting the given package version."
   (define table
     ;; Map package names to lists of version/vulnerability pairs.
     (fold (lambda (vuln table)
@@ -183,8 +270,8 @@ a list of vulnerabilities affection the given package version."
               (($ <vulnerability> id packages)
                (fold (lambda (package table)
                        (match package
-                         ((name . version)
-                          (vhash-cons name (cons version vuln)
+                         ((name . versions)
+                          (vhash-cons name (cons vuln versions)
                                       table))))
                      table
                      packages))))
@@ -195,11 +282,14 @@ a list of vulnerabilities affection the given package version."
     (vhash-fold* (if version
                      (lambda (pair result)
                        (match pair
-                         ((v . vuln)
-                          (if (string=? v version)
+                         ((vuln . versions)
+                          (if (member version versions)
                               (cons vuln result)
                               result))))
-                     cons)
+                     (lambda (pair result)
+                       (match pair
+                         ((vuln . _)
+                          (cons vuln result)))))
                  '()
                  package table)))
 
diff --git a/guix/download.scm b/guix/download.scm
index 67c55aff33..9b238dcbdf 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -98,14 +98,28 @@
        "http://savannah.c3sl.ufpr.br/"
        "http://www.centervenus.com/mirrors/nongnu/"
        "http://download.savannah.gnu.org/releases-noredirect/")
-      (sourceforge
+      (sourceforge ; https://sourceforge.net/p/forge/documentation/Mirrors/
        "http://prdownloads.sourceforge.net/"
        "http://heanet.dl.sourceforge.net/sourceforge/"
-       "http://surfnet.dl.sourceforge.net/sourceforge/"
        "http://dfn.dl.sourceforge.net/sourceforge/"
-       "http://mesh.dl.sourceforge.net/sourceforge/"
-       "http://ovh.dl.sourceforge.net/sourceforge/"
-       "http://osdn.dl.sourceforge.net/sourceforge/")
+       "http://freefr.dl.sourceforge.net/sourceforge/"
+       "http://internode.dl.sourceforge.net/sourceforge/"
+       "http://iweb.dl.sourceforge.net/sourceforge/"
+       "http://jaist.dl.sourceforge.net/sourceforge/"
+       "http://kaz.dl.sourceforge.net/sourceforge/"
+       "http://kent.dl.sourceforge.net/sourceforge/"
+       "http://liquidtelecom.dl.sourceforge.net/sourceforge/"
+       "http://nbtelecom.dl.sourceforge.net/sourceforge/"
+       "http://nchc.dl.sourceforge.net/sourceforge/"
+       "http://ncu.dl.sourceforge.net/sourceforge/"
+       "http://netcologne.dl.sourceforge.net/sourceforge/"
+       "http://netix.dl.sourceforge.net/sourceforge/"
+       "http://pilotfiber.dl.sourceforge.net/sourceforge/"
+       "http://superb-sea2.dl.sourceforge.net/sourceforge/"
+       "http://tenet.dl.sourceforge.net/sourceforge/"
+       "http://ufpr.dl.sourceforge.net/sourceforge/"
+       "http://vorboss.dl.sourceforge.net/sourceforge/"
+       "http://netassist.dl.sourceforge.net/sourceforge/")
       (kernel.org
        "http://www.all.kernel.org/pub/"
        "http://ramses.wh2.tu-dresden.de/pub/mirrors/kernel.org/"
@@ -159,13 +173,22 @@
        "ftp://artfiles.org/cpan.org/"
        "http://www.cpan.org/"
        "ftp://cpan.rinet.ru/pub/mirror/CPAN/"
-       "http://cpan.cu.be/"
        "ftp://cpan.inode.at/"
        "ftp://cpan.iht.co.il/"
        "ftp://ftp.osuosl.org/pub/CPAN/"
        "ftp://ftp.nara.wide.ad.jp/pub/CPAN/"
        "http://mirrors.163.com/cpan/"
-       "ftp://cpan.mirror.ac.za/")
+       "ftp://cpan.mirror.ac.za/"
+       "http://cpan.mirrors.ionfish.org/"
+       "http://cpan.mirror.dkm.cz/pub/CPAN/"
+       "http://cpan.mirror.iphh.net/"
+       "http://mirrors.teentelecom.net/CPAN/"
+       "http://mirror.teklinks.com/CPAN/"
+       "http://cpan.weepeetelecom.be/"
+       "http://mirrors.xservers.ro/CPAN/"
+       "http://cpan.yimg.com/"
+       "http://mirror.yazd.ac.ir/cpan/"
+       "http://ftp.belnet.be/ftp.cpan.org/")
       (cran
        ;; Arbitrary mirrors from http://cran.r-project.org/mirrors.html
        ;; This one automatically redirects to servers worldwide
diff --git a/guix/grafts.scm b/guix/grafts.scm
index 6bec999ad2..53e697688a 100644
--- a/guix/grafts.scm
+++ b/guix/grafts.scm
@@ -252,16 +252,23 @@ derivations to the corresponding set of grafts."
          (deps                                    ;one or more dependencies
           (mlet %state-monad ((grafts (mapm %state-monad dependency-grafts deps))
                               (cache  (current-state)))
-            (let* ((grafts  (delete-duplicates (concatenate grafts) equal?))
-                   (origins (map graft-origin-file-name grafts)))
-              (if (find (cut member <> deps) origins)
-                  (let* ((new    (graft-derivation/shallow store drv grafts
-                                                           #:guile guile
-                                                           #:system system))
-                         (grafts (cons (graft (origin drv) (replacement new))
-                                       grafts)))
-                    (return/cache cache grafts))
-                  (return/cache cache grafts))))))))))
+            (let* ((grafts     (delete-duplicates (concatenate grafts) equal?))
+                   (origins    (map graft-origin-file-name grafts)))
+              (match (filter (lambda (graft)
+                               (member (graft-origin-file-name graft) deps))
+                             grafts)
+                (()
+                 (return/cache cache grafts))
+                ((applicable ..1)
+                 ;; Use APPLICABLE, the subset of GRAFTS that is really
+                 ;; applicable to DRV, to avoid creating several identical
+                 ;; grafted variants of DRV.
+                 (let* ((new    (graft-derivation/shallow store drv applicable
+                                                          #:guile guile
+                                                          #:system system))
+                        (grafts (cons (graft (origin drv) (replacement new))
+                                      grafts)))
+                   (return/cache cache grafts))))))))))))
 
 (define* (graft-derivation store drv grafts
                            #:key (guile (%guile-for-build))
diff --git a/guix/graph.scm b/guix/graph.scm
index ad93403a1e..735d340c2c 100644
--- a/guix/graph.scm
+++ b/guix/graph.scm
@@ -37,7 +37,9 @@
 
             node-edges
             node-back-edges
+            traverse/depth-first
             node-transitive-edges
+            node-reachable-count
 
             %graphviz-backend
             graph-backend?
@@ -99,13 +101,13 @@ returns its back edges.  NODES is taken to be the sinks of the global graph."
                (lambda (source target edges)
                  (vhash-consq target source edges))))
 
-(define (node-transitive-edges nodes node-edges)
-  "Return the list of nodes directly or indirectly connected to NODES
-according to the NODE-EDGES procedure.  NODE-EDGES must be a one-argument
-procedure that, given a node, returns its list of direct dependents; it is
-typically returned by 'node-edges' or 'node-back-edges'."
+(define (traverse/depth-first proc seed nodes node-edges)
+  "Do a depth-first traversal of NODES along NODE-EDGES, calling PROC with
+each node and the current result, and visiting each reachable node exactly
+once.  NODES must be a list of nodes, and NODE-EDGES must be a one-argument
+procedure as returned by 'node-edges' or 'node-back-edges'."
   (let loop ((nodes   (append-map node-edges nodes))
-             (result  '())
+             (result  seed)
              (visited (setq)))
     (match nodes
       (()
@@ -115,9 +117,23 @@ typically returned by 'node-edges' or 'node-back-edges'."
            (loop tail result visited)
            (let ((edges (node-edges head)))
              (loop (append edges tail)
-                   (cons head result)
+                   (proc head result)
                    (set-insert head visited))))))))
 
+(define (node-transitive-edges nodes node-edges)
+  "Return the list of nodes directly or indirectly connected to NODES
+according to the NODE-EDGES procedure.  NODE-EDGES must be a one-argument
+procedure that, given a node, returns its list of direct dependents; it is
+typically returned by 'node-edges' or 'node-back-edges'."
+  (traverse/depth-first cons '() nodes node-edges))
+
+(define (node-reachable-count nodes node-edges)
+  "Return the number of nodes reachable from NODES along NODE-EDGES."
+  (traverse/depth-first (lambda (_ count)
+                          (+ 1 count))
+                        0
+                        nodes node-edges))
+
 
 ;;;
 ;;; Graphviz export.
diff --git a/guix/import/github.scm b/guix/import/github.scm
index 29116d79f0..9ba9a10ba0 100644
--- a/guix/import/github.scm
+++ b/guix/import/github.scm
@@ -43,8 +43,8 @@ failure."
 (define (find-extension url)
   "Return the extension of the archive e.g. '.tar.gz' given a URL, or
 false if none is recognized"
-  (find (lambda x (string-suffix? (first x) url))
-        (list ".tar.gz" ".tar.bz2" ".tar.xz" ".zip" ".tar")))
+  (find (lambda (x) (string-suffix? x url))
+        (list ".tar.gz" ".tar.bz2" ".tar.xz" ".zip" ".tar" ".tgz")))
 
 (define (updated-github-url old-package new-version)
   ;; Return a url for the OLD-PACKAGE with NEW-VERSION.  If no source url in
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 8355af7a48..ce8a11fbe5 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -811,6 +811,7 @@ the monadic procedures listed in HOOKS--such as an Info 'dir' file, etc."
                          #:search-paths search-paths)))
 
     (gexp->derivation "profile" builder
+                      #:system system
                       #:modules '((guix build profiles)
                                   (guix build union)
                                   (guix build utils)
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 9ba487d1eb..ebe966f9cf 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -333,11 +333,11 @@ requisite store items i.e. the union closure of all the inputs."
     (requisites*
      (match input
        ((drv output)
-        (derivation->output-path drv output))
+        (list (derivation->output-path drv output)))
        ((drv)
-        (derivation->output-path drv))
+        (list (derivation->output-path drv)))
        ((? direct-store-path? path)
-        path))))
+        (list path)))))
 
   (mlet %store-monad ((reqs (sequence %store-monad
                                       (map input->requisites inputs))))
diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm
index 4ec9ff9dca..8db28138c8 100644
--- a/guix/scripts/gc.scm
+++ b/guix/scripts/gc.scm
@@ -229,7 +229,8 @@ Invoke the garbage collector.\n"))
         ((list-references)
          (list-relatives references))
         ((list-requisites)
-         (list-relatives requisites))
+         (list-relatives (lambda (store item)
+                           (requisites store (list item)))))
         ((list-referrers)
          (list-relatives referrers))
         ((optimize)
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index d594be18e5..7db0c9d610 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,6 +24,7 @@
   #:use-module (guix serialization)
   #:use-module (guix nar)
   #:use-module (guix utils)
+  #:use-module ((guix build syscalls) #:select (fcntl-flock))
   #:use-module ((guix build utils) #:select (which mkdir-p))
   #:use-module (guix ui)
   #:use-module (srfi srfi-1)
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 697afc17c3..e2e37098fc 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -794,9 +794,13 @@ processed, #f otherwise."
   (define transform (options->transformation opts))
 
   (define (transform-entry entry)
-    (manifest-entry
-      (inherit entry)
-      (item (transform store (manifest-entry-item entry)))))
+    (let ((item (transform store (manifest-entry-item entry))))
+      (manifest-entry
+        (inherit entry)
+        (item item)
+        (version (if (package? item)
+                     (package-version item)
+                     (manifest-entry-version entry))))))
 
   ;; First, process roll-backs, generation removals, etc.
   (for-each (match-lambda
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index 0efc190b22..209f0d8be9 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -258,38 +258,36 @@ downloaded and authenticated; not updating~%")
 
 (define (list-dependents packages)
   "List all the things that would need to be rebuilt if PACKAGES are changed."
-  (with-store store
-    (run-with-store store
-      ;; Using %BAG-NODE-TYPE is more accurate than using %PACKAGE-NODE-TYPE
-      ;; because it includes implicit dependencies.
-      (mlet %store-monad ((edges (node-back-edges %bag-node-type
-                                                  (all-packages))))
-        (let* ((dependents (node-transitive-edges packages edges))
-               (covering   (filter (lambda (node)
-                                     (null? (edges node)))
-                                   dependents)))
-          (match dependents
-            (()
-             (format (current-output-port)
-                     (N_ "No dependents other than itself: ~{~a~}~%"
-                         "No dependents other than themselves: ~{~a~^ ~}~%"
-                         (length packages))
-                     (map package-full-name packages)))
+  ;; Using %BAG-NODE-TYPE is more accurate than using %PACKAGE-NODE-TYPE
+  ;; because it includes implicit dependencies.
+  (mlet %store-monad ((edges (node-back-edges %bag-node-type
+                                              (all-packages))))
+    (let* ((dependents (node-transitive-edges packages edges))
+           (covering   (filter (lambda (node)
+                                 (null? (edges node)))
+                               dependents)))
+      (match dependents
+        (()
+         (format (current-output-port)
+                 (N_ "No dependents other than itself: ~{~a~}~%"
+                     "No dependents other than themselves: ~{~a~^ ~}~%"
+                     (length packages))
+                 (map package-full-name packages)))
 
-            ((x)
-             (format (current-output-port)
-                     (_ "A single dependent package: ~a~%")
-                     (package-full-name x)))
-            (lst
-             (format (current-output-port)
-                     (N_ "Building the following package would ensure ~d \
+        ((x)
+         (format (current-output-port)
+                 (_ "A single dependent package: ~a~%")
+                 (package-full-name x)))
+        (lst
+         (format (current-output-port)
+                 (N_ "Building the following package would ensure ~d \
 dependent packages are rebuilt: ~*~{~a~^ ~}~%"
-                         "Building the following ~d packages would ensure ~d \
+                     "Building the following ~d packages would ensure ~d \
 dependent packages are rebuilt: ~{~a~^ ~}~%"
-                         (length covering))
-                     (length covering) (length dependents)
-                     (map package-full-name covering))))
-          (return #t))))))
+                     (length covering))
+                 (length covering) (length dependents)
+                 (map package-full-name covering))))
+      (return #t))))
 
 
 ;;;
@@ -381,31 +379,36 @@ update would trigger a complete rebuild."
             (some                                 ; user-specified packages
              some))))
     (with-error-handling
-      (cond
-       (list-dependent?
-        (list-dependents packages))
-       (update?
-        (let ((store (open-connection)))
-          (parameterize ((%openpgp-key-server
-                          (or (assoc-ref opts 'key-server)
-                              (%openpgp-key-server)))
-                         (%gpg-command
-                          (or (assoc-ref opts 'gpg-command)
-                              (%gpg-command))))
-            (for-each
-             (cut update-package store <> updaters
-                  #:key-download key-download)
-             packages))))
-       (else
-        (for-each (lambda (package)
-                    (match (package-update-path package updaters)
-                      ((? upstream-source? source)
-                       (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)
-                                 (upstream-source-version source))))
-                      (#f #f)))
-                  packages))))))
+      (with-store store
+        (run-with-store store
+          (cond
+           (list-dependent?
+            (list-dependents packages))
+           (update?
+            (parameterize ((%openpgp-key-server
+                            (or (assoc-ref opts 'key-server)
+                                (%openpgp-key-server)))
+                           (%gpg-command
+                            (or (assoc-ref opts 'gpg-command)
+                                (%gpg-command))))
+              (for-each
+               (cut update-package store <> updaters
+                    #:key-download key-download)
+               packages)
+              (with-monad %store-monad
+                (return #t))))
+           (else
+            (for-each (lambda (package)
+                        (match (package-update-path package updaters)
+                          ((? upstream-source? source)
+                           (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)
+                                     (upstream-source-version source))))
+                          (#f #f)))
+                      packages)
+            (with-monad %store-monad
+              (return #t)))))))))
diff --git a/guix/scripts/size.scm b/guix/scripts/size.scm
index be1e8ca087..f28832ce90 100644
--- a/guix/scripts/size.scm
+++ b/guix/scripts/size.scm
@@ -91,15 +91,16 @@ if ITEM is not in the store."
               (sort profile
                     (match-lambda*
                       ((($ <profile> _ _ total1) ($ <profile> _ _ total2))
-                       (> total1 total2)))))))
+                       (> total1 total2)))))
+    (format port (_ "total: ~,1f MiB~%") (/ whole MiB 1.))))
 
 (define display-profile*
   (lift display-profile %store-monad))
 
-(define (substitutable-requisites store item)
-  "Return the list of requisites of ITEM based on information available in
+(define (substitutable-requisites store items)
+  "Return the list of requisites of ITEMS based on information available in
 substitutes."
-  (let loop ((items  (list item))
+  (let loop ((items  items)
              (result '()))
     (match items
       (()
@@ -113,23 +114,23 @@ substitutes."
                (append (append-map substitutable-references info)
                        result)))))))
 
-(define (requisites* item)
+(define (requisites* items)
   "Return as a monadic value the requisites of ITEMS, based either on the
 information available in the local store or using information about
 substitutes."
   (lambda (store)
     (guard (c ((nix-protocol-error? c)
-               (values (substitutable-requisites store item)
+               (values (substitutable-requisites store items)
                        store)))
-      (values (requisites store item) store))))
+      (values (requisites store items) store))))
 
-(define (store-profile item)
+(define (store-profile items)
   "Return as a monadic value a list of <profile> objects representing the
-profile of ITEM and its requisites."
-  (mlet* %store-monad ((refs  (>>= (requisites* item)
+profile of ITEMS and their requisites."
+  (mlet* %store-monad ((refs  (>>= (requisites* items)
                                    (lambda (refs)
                                      (return (delete-duplicates
-                                              (cons item refs))))))
+                                              (append items refs))))))
                        (sizes (mapm %store-monad
                                     (lambda (item)
                                       (>>= (file-size item)
@@ -137,7 +138,7 @@ profile of ITEM and its requisites."
                                              (return (cons item size)))))
                                     refs)))
     (define (dependency-size item)
-      (mlet %store-monad ((deps (requisites* item)))
+      (mlet %store-monad ((deps (requisites* (list item))))
         (foldm %store-monad
                (lambda (item total)
                  (return (+ (assoc-ref sizes item) total)))
@@ -273,7 +274,7 @@ Report the size of PACKAGE and its dependencies.\n"))
       (match files
         (()
          (leave (_ "missing store item argument\n")))
-        ((file)
+        ((files ..1)
          (leave-on-EPIPE
           ;; Turn off grafts because (1) hydra.gnu.org does not serve grafted
           ;; packages, and (2) they do not make any difference on the
@@ -285,13 +286,12 @@ Report the size of PACKAGE and its dependencies.\n"))
                                  #:substitute-urls urls)
 
               (run-with-store store
-                (mlet* %store-monad ((item    (ensure-store-item file))
-                                     (profile (store-profile item)))
+                (mlet* %store-monad ((items   (mapm %store-monad
+                                                    ensure-store-item files))
+                                     (profile (store-profile items)))
                   (if map-file
                       (begin
                         (profile->page-map profile map-file)
                         (return #t))
                       (display-profile* profile)))
-                #:system system)))))
-        ((files ...)
-         (leave (_ "too many arguments\n")))))))
+                #:system system)))))))))
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 5cdc55f2b2..81ce770dc5 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -889,7 +889,11 @@ DESTINATION as a nar file.  Verify the substitute against ACL."
     ;; Tell the daemon what the expected hash of the Nar itself is.
     (format #t "~a~%" (narinfo-hash narinfo))
 
-    (format (current-error-port) "Downloading ~a~:[~*~; (~a installed)~]...~%"
+    (format (current-error-port)
+            ;; TRANSLATORS: The second part of this message looks like
+            ;; "(4.1MiB installed)"; it shows the size of the package once
+            ;; installed.
+            (_ "Downloading ~a~:[~*~; (~a installed)~]...~%")
             (store-path-abbreviation store-item)
             ;; Use the Nar size as an estimate of the installed size.
             (narinfo-size narinfo)
diff --git a/guix/store.scm b/guix/store.scm
index 4d89f4a413..e3033ee61a 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -803,12 +803,12 @@ the list of references")
             (loop items tail
                   (cons head result)))))))))
 
-(define* (fold-path store proc seed path
+(define* (fold-path store proc seed paths
                     #:optional (relatives (cut references store <>)))
-  "Call PROC for each of the RELATIVES of PATH, exactly once, and return the
+  "Call PROC for each of the RELATIVES of PATHS, exactly once, and return the
 result formed from the successive calls to PROC, the first of which is passed
 SEED."
-  (let loop ((paths  (list path))
+  (let loop ((paths  paths)
              (result seed)
              (seen   vlist-null))
     (match paths
@@ -822,10 +822,10 @@ SEED."
       (()
        result))))
 
-(define (requisites store path)
-  "Return the requisites of PATH, including PATH---i.e., its closure (all its
-references, recursively)."
-  (fold-path store cons '() path))
+(define (requisites store paths)
+  "Return the requisites of PATHS, including PATHS---i.e., their closures (all
+its references, recursively)."
+  (fold-path store cons '() paths))
 
 (define (topologically-sorted store paths)
   "Return a list containing PATHS and all their references sorted in
diff --git a/guix/ui.scm b/guix/ui.scm
index 8310974ac7..cbc9dc841a 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -6,7 +6,7 @@
 ;;; Copyright © 2014 Cyrill Schenkel <cyrill.schenkel@gmail.com>
 ;;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
-;;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
+;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -313,6 +313,10 @@ There is NO WARRANTY, to the extent permitted by law.
   (exit 0))
 
 (define (show-bug-report-information)
+  ;; TRANSLATORS: The placeholder indicates the bug-reporting address for this
+  ;; package.  Please add another line saying "Report translation bugs to
+  ;; ...\n" with the address for translation bugs (typically your translation
+  ;; team's web or email address).
   (format #t (_ "
 Report bugs to: ~a.") %guix-bug-report-address)
   (format #t (_ "