summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-04-12 17:30:27 +0200
committerLudovic Courtès <ludo@gnu.org>2013-04-12 21:58:47 +0200
commitcdf2022052268b9c517d486294ec34f0c18091aa (patch)
tree45a4ff01fe0186ce9835282b8d2451c55fa8e54e
parentf03f0c9a867e22dd999a8519f4bf03b182739c97 (diff)
substitute-binary: Implement `--substitute'.
This allows build outputs to be transparently downloaded from http://hydra.gnu.org, for example. * config-daemon.ac: Check for `gzip', `bzip2', and `xz'. * guix/config.scm.in (%gzip, %bzip2, %xz): New variable. * guix/scripts/substitute-binary.scm (fetch): Return SIZE as a second value. (<narinfo>): Change `url' to `uri'. (make-narinfo): Rename to... (narinfo-maker): ... this. Handle relative URLs. (fetch-narinfo): Adjust accordingly. (filtered-port, decompressed-port): New procedures. (guix-substitute-binary): Implement the `--substitute' case. * tests/store.scm ("substitute query"): Use (%store-prefix) instead of (getenv "NIX_STORE_DIR"). ("substitute"): New test.
-rw-r--r--config-daemon.ac8
-rw-r--r--guix/config.scm.in14
-rwxr-xr-xguix/scripts/substitute-binary.scm100
-rw-r--r--tests/store.scm55
4 files changed, 154 insertions, 23 deletions
diff --git a/config-daemon.ac b/config-daemon.ac
index eed1e23f9e..7c51f2b95c 100644
--- a/config-daemon.ac
+++ b/config-daemon.ac
@@ -11,6 +11,14 @@ if test "x$guix_build_daemon" = "xyes"; then
AC_PROG_RANLIB
AC_CONFIG_HEADER([nix/config.h])
+ dnl Decompressors, for use by the substituter.
+ AC_PATH_PROG([GZIP], [gzip])
+ AC_PATH_PROG([BZIP2], [bzip2])
+ AC_PATH_PROG([XZ], [xz])
+ AC_SUBST([GZIP])
+ AC_SUBST([BZIP2])
+ AC_SUBST([XZ])
+
dnl Use 64-bit file system calls so that we can support files > 2 GiB.
AC_SYS_LARGEFILE
diff --git a/guix/config.scm.in b/guix/config.scm.in
index ab7b0669b8..772ea8c289 100644
--- a/guix/config.scm.in
+++ b/guix/config.scm.in
@@ -26,7 +26,10 @@
%system
%libgcrypt
%nixpkgs
- %nix-instantiate))
+ %nix-instantiate
+ %gzip
+ %bzip2
+ %xz))
;;; Commentary:
;;;
@@ -67,4 +70,13 @@
(define %nix-instantiate
"@NIX_INSTANTIATE@")
+(define %gzip
+ "@GZIP@")
+
+(define %bzip2
+ "@BZIP2@")
+
+(define %xz
+ "@XZ@")
+
;;; config.scm ends here
diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm
index 64df4f09d6..2b447ce7f2 100755
--- a/guix/scripts/substitute-binary.scm
+++ b/guix/scripts/substitute-binary.scm
@@ -20,10 +20,13 @@
#:use-module (guix ui)
#:use-module (guix store)
#:use-module (guix utils)
+ #:use-module (guix config)
+ #:use-module (guix nar)
#: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 (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
@@ -70,9 +73,12 @@ pairs."
(apply make args)))
(define (fetch uri)
+ "Return a binary input port to URI and the number of bytes it's expected to
+provide."
(case (uri-scheme uri)
((file)
- (open-input-file (uri-path uri)))
+ (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
@@ -86,7 +92,7 @@ pairs."
(response-content-length resp)))
(case code
((200) ; OK
- port)
+ (values port size))
((301 ; moved permanently
302) ; found (redirection)
(let ((uri (response-location resp)))
@@ -120,11 +126,11 @@ failure."
'("StoreDir" "WantMassQuery")))))
(define-record-type <narinfo>
- (%make-narinfo path url compression file-hash file-size nar-hash nar-size
+ (%make-narinfo path uri compression file-hash file-size nar-hash nar-size
references deriver system)
narinfo?
(path narinfo-path)
- (url narinfo-url)
+ (uri narinfo-uri)
(compression narinfo-compression)
(file-hash narinfo-file-hash)
(file-size narinfo-file-size)
@@ -134,18 +140,26 @@ failure."
(deriver narinfo-deriver)
(system narinfo-system))
-(define (make-narinfo path url compression file-hash file-size nar-hash nar-size
- references deriver system)
- "Return a new <narinfo> object."
- (%make-narinfo path url compression file-hash
- (and=> file-size string->number)
- nar-hash
- (and=> nar-size string->number)
- (string-tokenize references)
- (match deriver
- ((or #f "") #f)
- (_ deriver))
- system))
+(define (narinfo-maker cache-url)
+ "Return a narinfo constructor for narinfos originating from CACHE-URL."
+ (lambda (path url compression file-hash file-size nar-hash nar-size
+ references deriver system)
+ "Return a new <narinfo> object."
+ (%make-narinfo path
+
+ ;; Handle the case where URL is a relative URL.
+ (or (string->uri url)
+ (string->uri (string-append cache-url "/" url)))
+
+ compression file-hash
+ (and=> file-size string->number)
+ nar-hash
+ (and=> nar-size string->number)
+ (string-tokenize references)
+ (match deriver
+ ((or #f "") #f)
+ (_ deriver))
+ system)))
(define (fetch-narinfo cache path)
"Return the <narinfo> record for PATH, or #f if CACHE does not hold PATH."
@@ -159,11 +173,36 @@ failure."
(store-path-hash-part path)
".narinfo"))
(lambda (properties)
- (alist->record properties make-narinfo
+ (alist->record properties (narinfo-maker (cache-url cache))
'("StorePath" "URL" "Compression"
"FileHash" "FileSize" "NarHash" "NarSize"
"References" "Deriver" "System")))))
+(define (filtered-port command input)
+ "Return an input port (and PID) where data drained from INPUT is filtered
+through COMMAND. INPUT must be a file input port."
+ (let ((i+o (pipe)))
+ (match (primitive-fork)
+ (0
+ (close-port (car i+o))
+ (close-port (current-input-port))
+ (dup2 (fileno input) 0)
+ (close-port (current-output-port))
+ (dup2 (fileno (cdr i+o)) 1)
+ (apply execl (car command) command))
+ (child
+ (close-port (cdr i+o))
+ (values (car i+o) child)))))
+
+(define (decompressed-port compression input)
+ "Return an input port where INPUT is decompressed according to COMPRESSION."
+ (match compression
+ ("none" (values input #f))
+ ("bzip2" (filtered-port `(,%bzip2 "-dc") input))
+ ("xz" (filtered-port `(,%xz "-dc") input))
+ ("gzip" (filtered-port `(,%gzip "-dc") input))
+ (else (error "unsupported compression scheme" compression))))
+
(define %cache-url
(or (getenv "GUIX_BINARY_SUBSTITUTE_URL")
"http://hydra.gnu.org"))
@@ -222,10 +261,29 @@ failure."
(error "unknown `--query' command" wtf)))
(loop (read-line)))))))
(("--substitute" store-path destination)
- ;; Download PATH and add it to the store.
- ;; TODO: Implement.
- (format (current-error-port) "substitution not implemented yet~%")
- #f)
+ ;; 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))
+ (uri (narinfo-uri narinfo)))
+ ;; Tell the daemon what the expected hash of the Nar itself is.
+ (format #t "~a~%" (narinfo-hash narinfo))
+
+ (let*-values (((raw download-size)
+ (fetch uri))
+ ((input pid)
+ (decompressed-port (narinfo-compression narinfo)
+ raw)))
+ ;; Note that Hydra currently generates Nars on the fly and doesn't
+ ;; specify a Content-Length, so DOWNLOAD-SIZE is #f in practice.
+ (format (current-error-port)
+ (_ "downloading `~a' from `~a'~:[~*~; (~,1f KiB)~]...~%")
+ store-path (uri->string uri)
+ download-size
+ (and=> download-size (cut / <> 1024.0)))
+
+ ;; Unpack the Nar at INPUT into DESTINATION.
+ (restore-file input destination)
+ (or (not pid) (zero? (cdr (waitpid pid)))))))
(("--version")
(show-version-and-exit "guix substitute-binary"))))
diff --git a/tests/store.scm b/tests/store.scm
index c75b99c6a9..4ee20a9352 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -23,9 +23,11 @@
#:use-module (guix base32)
#:use-module (guix packages)
#:use-module (guix derivations)
+ #:use-module (guix nar)
#:use-module (gnu packages)
#:use-module (gnu packages bootstrap)
#:use-module (ice-9 match)
+ #:use-module (rnrs io ports)
#:use-module (web uri)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
@@ -141,7 +143,7 @@
(call-with-output-file (string-append dir "/nix-cache-info")
(lambda (p)
(format p "StoreDir: ~a\nWantMassQuery: 0\n"
- (getenv "NIX_STORE_DIR"))))
+ (%store-prefix))))
(call-with-output-file (string-append dir "/" (store-path-hash-part o)
".narinfo")
(lambda (p)
@@ -167,6 +169,57 @@ Deriver: ~a~%"
(null? (substitutable-references s))
(equal? (substitutable-nar-size s) 1234)))))))
+(test-assert "substitute"
+ (let* ((s (open-connection))
+ (c (random-text)) ; contents of the output
+ (d (build-expression->derivation
+ s "substitute-me" (%current-system)
+ `(call-with-output-file %output
+ (lambda (p)
+ (exit 1) ; would actually fail
+ (display ,c p)))
+ '()
+ #:guile-for-build
+ (package-derivation s %bootstrap-guile (%current-system))))
+ (o (derivation-path->output-path d))
+ (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
+ (compose uri-path string->uri))))
+ ;; Create fake substituter data, to be read by `substitute-binary'.
+ (call-with-output-file (string-append dir "/nix-cache-info")
+ (lambda (p)
+ (format p "StoreDir: ~a\nWantMassQuery: 0\n"
+ (%store-prefix))))
+ (call-with-output-file (string-append dir "/example.out")
+ (lambda (p)
+ (display c p)))
+ (call-with-output-file (string-append dir "/example.nar")
+ (lambda (p)
+ (write-file (string-append dir "/example.out") p)))
+ (call-with-output-file (string-append dir "/" (store-path-hash-part o)
+ ".narinfo")
+ (lambda (p)
+ (format p "StorePath: ~a
+URL: ~a
+Compression: none
+NarSize: 1234
+NarHash: sha256:~a
+References:
+System: ~a
+Deriver: ~a~%"
+ o ; StorePath
+ "example.nar" ; relative URL
+ (call-with-input-file (string-append dir "/example.nar")
+ (compose bytevector->nix-base32-string sha256
+ get-bytevector-all))
+ (%current-system) ; System
+ (basename d)))) ; Deriver
+
+ ;; Make sure we use `substitute-binary'.
+ (set-build-options s #:use-substitutes? #t)
+ (and (has-substitutes? s o)
+ (build-derivations s (list d))
+ (equal? c (call-with-input-file o get-string-all)))))
+
(test-end "store")