Merge branch 'master' into core-updates

Resolved conflicts:
* gnu/packages/scheme.scm: Conflict in import of (guix licenses). On master,
"#:hide (openssl)" was used. On core-updates, "#:select (some licenses)" was
used. The latter won the conflict.
* gnu/packages/version-control.scm (git)[arguments]: Whitespace conflict
in 'install-shell-completion.

6 files changed, 133 insertions, 27 deletions

diff --git a/guix/build/download.scm b/guix/build/download.scm
index 103e784bb1..307258be92 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -737,7 +737,7 @@ or #f."
     (append-map (lambda (make-url)
                   (filter-map (match-lambda
                                 ((hash-algo . hash)
-                                 (string->uri (make-url hash-algo hash))))
+                                 (string->uri (make-url file hash-algo hash))))
                               hashes))
                 content-addressed-mirrors))
 
diff --git a/guix/build/pull.scm b/guix/build/pull.scm
index 4ddb12ac04..ccf1868516 100644
--- a/guix/build/pull.scm
+++ b/guix/build/pull.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -36,7 +36,17 @@
 ;;; Code:
 
 (define* (build-guix out source
-                     #:key gcrypt
+                     #:key
+                     system
+                     storedir localstatedir sysconfdir sbindir
+
+                     (package-name "GNU Guix")
+                     (package-version "0")
+                     (bug-report-address "bug-guix@gnu.org")
+                     (home-page-url "https://gnu.org/s/guix")
+
+                     libgcrypt zlib gzip bzip2 xz
+
                      (debug-port (%make-void-port "w"))
                      (log-port (current-error-port)))
   "Build and install Guix in directory OUT using SOURCE, a directory
@@ -55,13 +65,26 @@ containing the source code.  Write any debugging output to DEBUG-PORT."
     (copy-file "guix.scm" (string-append out "/guix.scm"))
     (copy-file "gnu.scm" (string-append out "/gnu.scm"))
 
-    ;; Add a fake (guix config) module to allow the other modules to be
-    ;; compiled.  The user's (guix config) is the one that will be used.
+    ;; Instantiate a (guix config) module that preserves the original
+    ;; settings.
     (copy-file "guix/config.scm.in"
                (string-append out "/guix/config.scm"))
     (substitute* (string-append out "/guix/config.scm")
-      (("@LIBGCRYPT@")
-       (string-append gcrypt "/lib/libgcrypt")))
+      (("@PACKAGE_NAME@") package-name)
+      (("@PACKAGE_VERSION@") package-version)
+      (("@PACKAGE_BUGREPORT@") bug-report-address)
+      (("@PACKAGE_URL@") home-page-url)
+      (("@storedir@") storedir)
+      (("@guix_localstatedir@") localstatedir)
+      (("@guix_sysconfdir@") sysconfdir)
+      (("@guix_sbindir@") sbindir)
+      (("@guix_system@") system)
+      (("@LIBGCRYPT@") (string-append libgcrypt "/lib/libgcrypt"))
+      (("@LIBZ@") (string-append zlib "/lib/libz"))
+      (("@GZIP@") (string-append gzip "/bin/gzip"))
+      (("@BZIP2@") (string-append bzip2 "/bin/bzip2"))
+      (("@XZ@") (string-append xz "/bin/xz"))
+      (("@NIX_INSTANTIATE@") ""))                 ;remnants from the past
 
     ;; Augment the search path so Scheme code can be compiled.
     (set! %load-path (cons out %load-path))
@@ -119,10 +142,6 @@ containing the source code.  Write any debugging output to DEBUG-PORT."
              (set! completed (+ 1 completed))))
          files))))
 
-  ;; Remove the "fake" (guix config).
-  (delete-file (string-append out "/guix/config.scm"))
-  (delete-file (string-append out "/guix/config.go"))
-
   (newline)
   #t)
 
diff --git a/guix/config.scm.in b/guix/config.scm.in
index 6d42cf233c..8f2c4abd8e 100644
--- a/guix/config.scm.in
+++ b/guix/config.scm.in
@@ -21,10 +21,17 @@
             %guix-version
             %guix-bug-report-address
             %guix-home-page-url
+
+            %storedir
+            %localstatedir
+            %sysconfdir
+            %sbindir
+
             %store-directory
             %state-directory
             %config-directory
             %guix-register-program
+
             %system
             %libgcrypt
             %libz
@@ -35,7 +42,8 @@
 
 ;;; Commentary:
 ;;;
-;;; Compile-time configuration of Guix.
+;;; Compile-time configuration of Guix.  When adding a substitution variable
+;;; here, make sure to equip (guix scripts pull) to substitute it.
 ;;;
 ;;; Code:
 
@@ -51,21 +59,36 @@
 (define %guix-home-page-url
   "@PACKAGE_URL@")
 
+(define %storedir
+  "@storedir@")
+
+(define %localstatedir
+  "@guix_localstatedir@")
+
+(define %sysconfdir
+  "@guix_sysconfdir@")
+
+(define %sbindir
+  "@guix_sbindir@")
+
 (define %store-directory
   (or (and=> (getenv "NIX_STORE_DIR") canonicalize-path)
-      "@storedir@"))
+      %storedir))
 
 (define %state-directory
   ;; This must match `NIX_STATE_DIR' as defined in `nix/local.mk'.
-  (or (getenv "NIX_STATE_DIR") "@guix_localstatedir@/guix"))
+  (or (getenv "NIX_STATE_DIR")
+      (string-append %localstatedir "/guix")))
 
 (define %config-directory
   ;; This must match `GUIX_CONFIGURATION_DIRECTORY' as defined in `nix/local.mk'.
-  (or (getenv "GUIX_CONFIGURATION_DIRECTORY") "@guix_sysconfdir@/guix"))
+  (or (getenv "GUIX_CONFIGURATION_DIRECTORY")
+      (string-append %sysconfdir "/guix")))
 
 (define %guix-register-program
   ;; The 'guix-register' program.
-  (or (getenv "GUIX_REGISTER") "@guix_sbindir@/guix-register"))
+  (or (getenv "GUIX_REGISTER")
+      (string-append %sbindir "/guix-register")))
 
 (define %system
   "@guix_system@")
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 76593f373b..7f74ed6c77 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -73,6 +73,7 @@
             derivation-name
             derivation-output-names
             fixed-output-derivation?
+            fixed-output-path
             offloadable-derivation?
             substitutable-derivation?
             substitution-oracle
@@ -676,7 +677,11 @@ the derivation called NAME with hash HASH."
                   name
                   (string-append name "-" output))))
 
-(define (fixed-output-path output hash-algo hash recursive? name)
+(define* (fixed-output-path name hash
+                            #:key
+                            (output "out")
+                            (hash-algo 'sha256)
+                            (recursive? #t))
   "Return an output path for the fixed output OUTPUT defined by HASH of type
 HASH-ALGO, of the derivation NAME.  RECURSIVE? has the same meaning as for
 'add-to-store'."
@@ -736,12 +741,14 @@ output should not be used."
               (outputs  (map (match-lambda
                               ((output-name . ($ <derivation-output>
                                                  _ algo hash rec?))
-                               (let ((path (if hash
-                                               (fixed-output-path output-name
-                                                                  algo hash
-                                                                  rec? name)
-                                               (output-path output-name
-                                                            drv-hash name))))
+                               (let ((path
+                                      (if hash
+                                          (fixed-output-path name hash
+                                                             #:hash-algo algo
+                                                             #:output output-name
+                                                             #:recursive? rec?)
+                                          (output-path output-name
+                                                       drv-hash name))))
                                  (cons output-name
                                        (make-derivation-output path algo
                                                                hash rec?)))))
diff --git a/guix/download.scm b/guix/download.scm
index bcb043ba80..8f38a4f552 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -232,10 +232,10 @@
 
 (define %content-addressed-mirrors
   ;; List of content-addressed mirrors.  Each mirror is represented as a
-  ;; procedure that takes an algorithm (symbol) and a hash (bytevector), and
-  ;; returns a URL or #f.
+  ;; procedure that takes a file name, an algorithm (symbol) and a hash
+  ;; (bytevector), and returns a URL or #f.
   ;; TODO: Add more.
-  '(list (lambda (algo hash)
+  '(list (lambda (file algo hash)
            ;; 'tarballs.nixos.org' supports several algorithms.
            (string-append "http://tarballs.nixos.org/"
                           (symbol->string algo) "/"
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 3baceaf645..2ca2aeebe3 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -31,6 +31,7 @@
   #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-37)
   #:use-module (web http)
   #:use-module (web request)
@@ -49,6 +50,7 @@
   #:use-module (guix zlib)
   #:use-module (guix ui)
   #:use-module (guix scripts)
+  #:use-module ((guix build utils) #:select (dump-port))
   #:export (guix-publish))
 
 (define (show-help)
@@ -308,6 +310,25 @@ appropriate duration."
                 store-path)
         (not-found request))))
 
+(define (render-content-addressed-file store request
+                                       name algo hash)
+  "Return the content of the result of the fixed-output derivation NAME that
+has the given HASH of type ALGO."
+  ;; TODO: Support other hash algorithms.
+  (if (and (eq? algo 'sha256) (= 32 (bytevector-length hash)))
+      (let ((item (fixed-output-path name hash
+                                     #:hash-algo algo
+                                     #:recursive? #f)))
+        (if (valid-path? store item)
+            (values `((content-type . (application/octet-stream
+                                       (charset . "ISO-8859-1"))))
+                    ;; XXX: We're not returning the actual contents, deferring
+                    ;; instead to 'http-write'.  This is a hack to work around
+                    ;; <http://bugs.gnu.org/21093>.
+                    item)
+            (not-found request)))
+      (not-found request)))
+
 (define extract-narinfo-hash
   (let ((regexp (make-regexp "^([a-df-np-sv-z0-9]{32}).narinfo$")))
     (lambda (str)
@@ -398,6 +419,34 @@ blocking."
           (swallow-zlib-error
            (close-port port))
           (values)))))
+    (('application/octet-stream . _)
+     ;; Send a raw file in a separate thread.
+     (call-with-new-thread
+      (lambda ()
+        (catch 'system-error
+          (lambda ()
+            (call-with-input-file (utf8->string body)
+              (lambda (input)
+                (let* ((size     (stat:size (stat input)))
+                       (headers  (alist-cons 'content-length size
+                                             (alist-delete 'content-length
+                                                           (response-headers response)
+                                                           eq?)))
+                       (response (write-response (set-field response
+                                                            (response-headers)
+                                                            headers)
+                                                 client))
+                       (output   (response-port response)))
+                  (dump-port input output)
+                  (close-port output)
+                  (values)))))
+          (lambda args
+            ;; If the file was GC'd behind our back, that's fine.  Likewise if
+            ;; the client closes the connection.
+            (unless (memv (system-error-errno args)
+                          (list ENOENT EPIPE ECONNRESET))
+              (apply throw args))
+            (values))))))
     (_
      ;; Handle other responses sequentially.
      (%http-write server client response body))))
@@ -418,7 +467,7 @@ blocking."
     (format #t "~a ~a~%"
             (request-method request)
             (uri-path (request-uri request)))
-    (if (get-request? request) ; reject POST, PUT, etc.
+    (if (get-request? request)                    ;reject POST, PUT, etc.
         (match (request-path-components request)
           ;; /nix-cache-info
           (("nix-cache-info")
@@ -450,6 +499,14 @@ blocking."
                              (_
                               %default-gzip-compression)))
                (not-found request)))
+
+          ;; /nar/file/NAME/sha256/HASH
+          (("file" name "sha256" hash)
+           (guard (c ((invalid-base32-character? c)
+                      (not-found request)))
+             (let ((hash (nix-base32-string->bytevector hash)))
+               (render-content-addressed-file store request
+                                              name 'sha256 hash))))
           (_ (not-found request)))
         (not-found request))))