Merge branch 'master' into core-updates

11 files changed, 118 insertions, 32 deletions

diff --git a/guix/build-system/r.scm b/guix/build-system/r.scm
index da06cb1358..a8ca354227 100644
--- a/guix/build-system/r.scm
+++ b/guix/build-system/r.scm
@@ -29,7 +29,8 @@
   #:export (%r-build-system-modules
             r-build
             r-build-system
-            cran-uri))
+            cran-uri
+            bioconductor-uri))
 
 ;; Commentary:
 ;;
@@ -46,6 +47,12 @@ available via the first URI, the second URI points to the archived version."
         (string-append "mirror://cran/src/contrib/Archive/"
                        name "/" name "_" version ".tar.gz")))
 
+(define (bioconductor-uri name version)
+  "Return a URI string for the R package archive on Bioconductor for the
+release corresponding to NAME and VERSION."
+  (string-append "http://bioconductor.org/packages/release/bioc/src/contrib/"
+                 name "_" version ".tar.gz"))
+
 (define %r-build-system-modules
   ;; Build-side modules imported by default.
   `((guix build r-build-system)
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 14ced747b2..35adc179a1 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -35,6 +35,7 @@
             local-file
             local-file?
             local-file-file
+            local-file-absolute-file-name
             local-file-name
             local-file-recursive?
 
@@ -182,35 +183,76 @@ cross-compiling.)"
 ;;; File declarations.
 ;;;
 
+;; A local file name.  FILE is the file name the user entered, which can be a
+;; relative file name, and ABSOLUTE is a promise that computes its canonical
+;; absolute file name.  We keep it in a promise to compute it lazily and avoid
+;; repeated 'stat' calls.
 (define-record-type <local-file>
-  (%local-file file name recursive?)
+  (%%local-file file absolute name recursive?)
   local-file?
   (file       local-file-file)                    ;string
+  (absolute   %local-file-absolute-file-name)     ;promise string
   (name       local-file-name)                    ;string
   (recursive? local-file-recursive?))             ;Boolean
 
-(define* (local-file file #:optional (name (basename file))
-                     #:key recursive?)
+(define* (%local-file file promise #:optional (name (basename file))
+                      #:key recursive?)
+  ;; This intermediate procedure is part of our ABI, but the underlying
+  ;; %%LOCAL-FILE is not.
+  (%%local-file file promise name recursive?))
+
+(define (extract-directory properties)
+  "Extract the directory name from source location PROPERTIES."
+  (match (assq 'filename properties)
+    (('filename . (? string? file-name))
+     (dirname file-name))
+    (_
+     #f)))
+
+(define-syntax-rule (current-source-directory)
+  "Expand to the directory of the current source file or #f if it could not
+be determined."
+  (extract-directory (current-source-location)))
+
+(define (absolute-file-name file directory)
+  "Return the canonical absolute file name for FILE, which lives in the
+vicinity of DIRECTORY."
+  (canonicalize-path
+   (cond ((string-prefix? "/" file) file)
+         ((not directory) file)
+         ((string-prefix? "/" directory)
+          (string-append directory "/" file))
+         (else file))))
+
+(define-syntax-rule (local-file file rest ...)
   "Return an object representing local file FILE to add to the store; this
-object can be used in a gexp.  FILE will be added to the store under NAME--by
-default the base name of FILE.
+object can be used in a gexp.  If FILE is a relative file name, it is looked
+up relative to the source file where this form appears.  FILE will be added to
+the store under NAME--by default the base name of FILE.
 
 When RECURSIVE? is true, the contents of FILE are added recursively; if FILE
 designates a flat file and RECURSIVE? is true, its contents are added, and its
 permission bits are kept.
 
 This is the declarative counterpart of the 'interned-file' monadic procedure."
-  ;; Canonicalize FILE so that if it's a symlink, it is resolved.  Failing to
-  ;; do that, when RECURSIVE? is #t, we could end up creating a dangling
-  ;; symlink in the store, and when RECURSIVE? is #f 'add-to-store' would just
-  ;; throw an error, both of which are inconvenient.
-  (%local-file (canonicalize-path file) name recursive?))
+  (%local-file file
+               (delay (absolute-file-name file (current-source-directory)))
+               rest ...))
+
+(define (local-file-absolute-file-name file)
+  "Return the absolute file name for FILE, a <local-file> instance.  A
+'system-error' exception is raised if FILE could not be found."
+  (force (%local-file-absolute-file-name file)))
 
 (define-gexp-compiler (local-file-compiler (file local-file?) system target)
   ;; "Compile" FILE by adding it to the store.
   (match file
-    (($ <local-file> file name recursive?)
-     (interned-file file name #:recursive? recursive?))))
+    (($ <local-file> file (= force absolute) name recursive?)
+     ;; Canonicalize FILE so that if it's a symlink, it is resolved.  Failing
+     ;; to do that, when RECURSIVE? is #t, we could end up creating a dangling
+     ;; symlink in the store, and when RECURSIVE? is #f 'add-to-store' would
+     ;; just throw an error, both of which are inconvenient.
+     (interned-file absolute name #:recursive? recursive?))))
 
 (define-record-type <plain-file>
   (%plain-file name content references)
diff --git a/guix/http-client.scm b/guix/http-client.scm
index eb2c3f4d5f..c7cbc82aac 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -32,6 +32,7 @@
   #:use-module (rnrs bytevectors)
   #:use-module (guix ui)
   #:use-module (guix utils)
+  #:use-module (guix base64)
   #:use-module ((guix build utils)
                 #:select (mkdir-p dump-port))
   #:use-module ((guix build download)
@@ -210,15 +211,23 @@ Raise an '&http-get-error' condition if downloading fails."
   (let loop ((uri (if (string? uri)
                       (string->uri uri)
                       uri)))
-    (let ((port (or port (open-connection-for-uri uri))))
+    (let ((port (or port (open-connection-for-uri uri)))
+          (auth-header (match (uri-userinfo uri)
+                         ((? string? str)
+                          (list (cons 'Authorization
+                                      (string-append "Basic "
+                                                     (base64-encode
+                                                      (string->utf8 str))))))
+                         (_ '()))))
       (unless buffered?
         (setvbuf port _IONBF))
       (let*-values (((resp data)
                      ;; Try hard to use the API du jour to get an input port.
                      (if (guile-version>? "2.0.7")
-                         (http-get uri #:streaming? #t #:port port) ; 2.0.9+
+                         (http-get uri #:streaming? #t #:port port
+                                   #:headers auth-header) ; 2.0.9+
                          (http-get* uri #:decode-body? text?        ; 2.0.7
-                                    #:port port)))
+                                    #:port port #:headers auth-header)))
                     ((code)
                      (response-code resp)))
         (case code
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 845ecb5832..45c679cbe2 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -128,9 +128,12 @@ empty list when the FIELD cannot be found."
                                     #f "( *\\([^\\)]+\\)) *"
                                     value 'pre 'post)
                                    #\,)))
-          ;; When there is whitespace inside of items it is probably because
-          ;; this was not an actual list to begin with.
-          (remove (cut string-any char-set:whitespace <>)
+          (remove (lambda (item)
+                    (or (string-null? item)
+                        ;; When there is whitespace inside of items it is
+                        ;; probably because this was not an actual list to
+                        ;; begin with.
+                        (string-any char-set:whitespace item)))
                   (map string-trim-both items))))))
 
 (define (beautify-description description)
diff --git a/guix/licenses.scm b/guix/licenses.scm
index 7e05b32993..9ace7f543b 100644
--- a/guix/licenses.scm
+++ b/guix/licenses.scm
@@ -30,7 +30,7 @@
             non-copyleft
             bsd-style                             ;deprecated!
             cc0
-            cc-by-sa4.0 cc-by3.0
+            cc-by-sa4.0 cc-by-sa3.0 cc-by3.0
             cddl1.0
             cecill-c
             artistic2.0 clarified-artistic
@@ -144,6 +144,11 @@ at URI, which may be a file:// URI pointing the package's tree."
            "http://creativecommons.org/licenses/by-sa/4.0/"
            "Creative Commons Attribution-ShareAlike 4.0 International"))
 
+(define cc-by-sa3.0
+  (license "CC-BY-SA 3.0"
+           "http://creativecommons.org/licenses/by-sa/3.0/"
+           "Creative Commons Attribution-ShareAlike 3.0 Unported"))
+
 (define cc-by3.0
   (license "CC-BY 3.0"
            "http://creativecommons.org/licenses/by/3.0/"
diff --git a/guix/packages.scm b/guix/packages.scm
index 68fb0916d8..41f3e20c41 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -89,6 +89,7 @@
             package-transitive-target-inputs
             package-transitive-native-inputs
             package-transitive-propagated-inputs
+            package-transitive-native-search-paths
             package-transitive-supported-systems
             package-source-derivation
             package-derivation
@@ -632,6 +633,17 @@ for the host system (\"native inputs\"), and not target inputs."
 recursively."
   (transitive-inputs (package-propagated-inputs package)))
 
+(define (package-transitive-native-search-paths package)
+  "Return the list of search paths for PACKAGE and its propagated inputs,
+recursively."
+  (append (package-native-search-paths package)
+          (append-map (match-lambda
+                        ((label (? package? p) _ ...)
+                         (package-native-search-paths p))
+                        (_
+                         '()))
+                      (package-transitive-propagated-inputs package))))
+
 (define (transitive-input-references alist inputs)
   "Return a list of (assoc-ref ALIST <label>) for each (<label> <package> . _)
 in INPUTS and their transitive propagated inputs."
diff --git a/guix/profiles.scm b/guix/profiles.scm
index c222f4115d..ce86ff8e0a 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -176,7 +176,7 @@ omitted or #f, use the first output of PACKAGE."
      (output (or output (car (package-outputs package))))
      (item package)
      (dependencies (delete-duplicates deps))
-     (search-paths (package-native-search-paths package)))))
+     (search-paths (package-transitive-native-search-paths package)))))
 
 (define (packages->manifest packages)
   "Return a list of manifest entries, one for each item listed in PACKAGES.
@@ -469,7 +469,7 @@ MANIFEST."
         (define (install-info info)
           (setenv "PATH" (string-append #+gzip "/bin")) ;for info.gz files
           (zero?
-           (system* (string-append #+texinfo "/bin/install-info")
+           (system* (string-append #+texinfo "/bin/install-info") "--silent"
                     info (string-append #$output "/share/info/dir"))))
 
         (mkdir-p (string-append #$output "/share/info"))
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 8ecd9560ed..9193ad32b2 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -204,6 +204,7 @@ options handled by 'set-build-options-from-command-line', and listed in
                 (lambda (opt name arg result . rest)
                   ;; XXX: Imperatively modify the search paths.
                   (%package-module-path (cons arg (%package-module-path)))
+                  (%patch-path (cons arg (%patch-path)))
                   (set! %load-path (cons arg %load-path))
                   (set! %load-compiled-path (cons arg %load-compiled-path))
 
@@ -404,10 +405,16 @@ must be one of 'package', 'all', or 'transitive'~%")
 (define (options->things-to-build opts)
   "Read the arguments from OPTS and return a list of high-level objects to
 build---packages, gexps, derivations, and so on."
-  (define ensure-list
-    (match-lambda
-      ((x ...) x)
-      (x       (list x))))
+  (define (validate-type x)
+    (unless (or (package? x) (derivation? x) (gexp? x) (procedure? x))
+      (leave (_ "~s: not something we can build~%") x)))
+
+  (define (ensure-list x)
+    (let ((lst (match x
+                 ((x ...) x)
+                 (x       (list x)))))
+      (for-each validate-type lst)
+      lst))
 
   (append-map (match-lambda
                 (('argument . (? string? spec))
@@ -424,8 +431,6 @@ build---packages, gexps, derivations, and so on."
                  (ensure-list (read/eval str)))
                 (('argument . (? derivation? drv))
                  drv)
-                (('argument . (? derivation-path? drv))
-                 (list ))
                 (_ '()))
               opts))
 
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 9255f0018a..dcc4701779 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -113,7 +113,7 @@ Dependencies may include packages, origin, and file names."
            (((labels things . outputs) ...)
             things)))
         ((origin? thing)
-         (cons (origin-patch-guile thing)
+         (cons (or (origin-patch-guile thing) (default-guile))
                (if (or (pair? (origin-patches thing))
                        (origin-snippet thing))
                    (match (origin-patch-inputs thing)
@@ -171,7 +171,9 @@ GNU-BUILD-SYSTEM have zero dependencies."
    (description "same as 'bag', but without the bootstrap nodes")
    (identifier bag-node-identifier)
    (label node-full-name)
-   (edges (lift1 bag-node-edges-sans-bootstrap %store-monad))))
+   (edges (lift1 (compose (cut filter package? <>)
+                          bag-node-edges-sans-bootstrap)
+                 %store-monad))))
 
 
 ;;;
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 338c7e827d..f296f8a00e 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -587,6 +587,7 @@ be determined."
 Common Platform Enumeration (CPE) name."
   (match name
     ("icecat"   "firefox")                        ;or "firefox_esr"
+    ("grub"     "grub2")
     ;; TODO: Add more.
     (_          name)))
 
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index c62daee9a7..d0b5abd0e2 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -151,7 +151,7 @@ GENERATIONS is a list of generation numbers."
   "Delete from PROFILE all the generations matching PATTERN.  PATTERN must be
 a string denoting a set of generations: the empty list means \"all generations
 but the current one\", a number designates a generation, and other patterns
-denote ranges as interpreted by 'matching-derivations'."
+denote ranges as interpreted by 'matching-generations'."
   (let ((current (generation-number profile)))
     (cond ((not (file-exists? profile))            ; XXX: race condition
            (raise (condition (&profile-not-found-error