ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

substitute-binary: Implement `--substitute'.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2013-04-12 17:30:27 +02:00
parent d7c5d27795
commit fe0cff14f6
4 changed files with 154 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
config-daemon.ac
View file

@ -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

14
guix/config.scm.in
View file

@ -26,7 +26,10 @@ (define-module (guix config)
%system
%libgcrypt
%nixpkgs
%nix-instantiate))
%nix-instantiate
%gzip
%bzip2
%xz))
;;; Commentary:
;;;
@ -67,4 +70,13 @@ (define %nixpkgs
(define %nix-instantiate
"@NIX_INSTANTIATE@")
(define %gzip
"@GZIP@")
(define %bzip2
"@BZIP2@")
(define %xz
"@XZ@")
;;; config.scm ends here

100
guix/scripts/substitute-binary.scm
View file

@ -20,10 +20,13 @@ (define-module (guix scripts substitute-binary)
#: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 @@ (define (alist->record alist make keys)
(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 @@ (define (fetch uri)
(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 @@ (define (download-cache-info url)
'("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 @@ (define-record-type <narinfo>
(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 @@ (define (download url)
(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 @@ (define (guix-substitute-binary . args)
(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"))))

55
tests/store.scm
View file

@ -23,9 +23,11 @@ (define-module (test-store)
#: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 @@ (define (random-text)
(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 @@ (define (random-text)
(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")