Allow derivations with input derivations.
* guix/derivations.scm (derivation-path->output-path): New procedure.
(derivation-hash): Call `memoize'. In the fixed-output case, convert
HASH-ALGO to a string. In the other case, sort inputs in the
alphabetical order of their hex hash. For inputs with no sub-drvs,
add "out" as the sub-drv.
* guix/utils.scm (%nixpkgs-directory): New parameter.
(nixpkgs-derivation, memoize): New procedures.
* tests/derivations.scm ("build derivation with 1 source"): Remove
useless shebang.
(%coreutils): New variable.
("build derivation with coreutils"): New test.
This commit is contained in:
Ludovic Courtès
parent
087602b687
commit
de4c3f26cb
|
|
@ -48,6 +48,7 @@
|
|||
|
||||
read-derivation
|
||||
write-derivation
|
||||
derivation-path->output-path
|
||||
derivation))
|
||||
|
||||
;;;
|
||||
|
|
@ -186,6 +187,18 @@ that form."
|
|||
env-vars))
|
||||
(display ")" port))))
|
||||
|
||||
(define* (derivation-path->output-path path #:optional (output "out"))
|
||||
"Read the derivation from PATH (`/nix/store/xxx.drv'), and return the store
|
||||
path of its output OUTPUT."
|
||||
(let* ((drv (call-with-input-file path read-derivation))
|
||||
(outputs (derivation-outputs drv)))
|
||||
(and=> (assoc-ref outputs output) derivation-output-path)))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Derivation primitive.
|
||||
;;;
|
||||
|
||||
(define (compressed-hash bv size) ; `compressHash'
|
||||
"Given the hash stored in BV, return a compressed version thereof that fits
|
||||
in SIZE bytes."
|
||||
|
|
@ -200,7 +213,9 @@ in SIZE bytes."
|
|||
(logxor o (bytevector-u8-ref bv i)))
|
||||
(loop (+ 1 i))))))
|
||||
|
||||
(define (derivation-hash drv) ; `hashDerivationModulo' in derivations.cc
|
||||
(define derivation-hash ; `hashDerivationModulo' in derivations.cc
|
||||
(memoize
|
||||
(lambda (drv)
|
||||
"Return the hash of DRV, modulo its fixed-output inputs, as a bytevector."
|
||||
(match drv
|
||||
(($ <derivation> ((_ . ($ <derivation-output> path
|
||||
|
|
@ -208,25 +223,31 @@ in SIZE bytes."
|
|||
;; A fixed-output derivation.
|
||||
(sha256
|
||||
(string->utf8
|
||||
(string-append "fixed:out:" hash-algo ":" hash ":" path))))
|
||||
(string-append "fixed:out:" (symbol->string hash-algo)
|
||||
":" hash ":" path))))
|
||||
(($ <derivation> outputs inputs sources
|
||||
system builder args env-vars)
|
||||
;; A regular derivation: replace the path of each input with that
|
||||
;; input's hash; return the hash of serialization of the resulting
|
||||
;; derivation.
|
||||
(let* ((inputs (map (match-lambda
|
||||
;; derivation. Note: inputs are sorted as in the order of their hex
|
||||
;; hash representation because that's what the C++ `std::map' code
|
||||
;; does.
|
||||
(let* ((inputs (sort (map (match-lambda
|
||||
(($ <derivation-input> path sub-drvs)
|
||||
(let ((hash (call-with-input-file path
|
||||
(compose bytevector->base16-string
|
||||
derivation-hash
|
||||
read-derivation))))
|
||||
(make-derivation-input hash sub-drvs))))
|
||||
inputs))
|
||||
inputs)
|
||||
(lambda (i1 i2)
|
||||
(string<? (derivation-input-path i1)
|
||||
(derivation-input-path i2)))))
|
||||
(drv (make-derivation outputs inputs sources
|
||||
system builder args env-vars)))
|
||||
(sha256
|
||||
(string->utf8 (call-with-output-string
|
||||
(cut write-derivation drv <>))))))))
|
||||
(cut write-derivation drv <>))))))))))
|
||||
|
||||
(define (store-path type hash name) ; makeStorePath
|
||||
"Return the store path for NAME/HASH/TYPE."
|
||||
|
|
@ -300,7 +321,9 @@ known in advance, such as a file download."
|
|||
(make-derivation-output "" hash-algo hash)))
|
||||
outputs))
|
||||
(inputs (map (match-lambda
|
||||
(((? store-path? input) . sub-drvs)
|
||||
(((? store-path? input))
|
||||
(make-derivation-input input '("out")))
|
||||
(((? store-path? input) sub-drvs ...)
|
||||
(make-derivation-input input sub-drvs))
|
||||
((input . _)
|
||||
(let ((path (add-to-store store
|
||||
|
|
@ -321,6 +344,7 @@ known in advance, such as a file download."
|
|||
inputs)
|
||||
system builder args env-vars))
|
||||
(drv (add-output-paths drv-masked)))
|
||||
|
||||
(values (add-text-to-store store (string-append name ".drv")
|
||||
(call-with-output-string
|
||||
(cut write-derivation drv <>))
|
||||
|
|
|
|||
|
|
@ -19,9 +19,12 @@
|
|||
(define-module (guix utils)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-39)
|
||||
#:use-module (srfi srfi-60)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module (ice-9 format)
|
||||
#:autoload (ice-9 popen) (open-pipe*)
|
||||
#:autoload (ice-9 rdelim) (read-line)
|
||||
#:use-module ((chop hash)
|
||||
#:select (bytevector-hash
|
||||
hash-method/sha256))
|
||||
|
|
@ -29,7 +32,12 @@
|
|||
bytevector->base32-string
|
||||
bytevector->nix-base32-string
|
||||
bytevector->base16-string
|
||||
sha256))
|
||||
sha256
|
||||
|
||||
%nixpkgs-directory
|
||||
nixpkgs-derivation
|
||||
|
||||
memoize))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
@ -198,3 +206,39 @@ the previous application or INIT."
|
|||
"Return the SHA256 of BV as a bytevector."
|
||||
(bytevector-hash hash-method/sha256 bv))
|
||||
|
||||
|
||||
|
||||
;;;
|
||||
;;; Nixpkgs.
|
||||
;;;
|
||||
|
||||
(define %nixpkgs-directory
|
||||
(make-parameter (getenv "NIXPKGS")))
|
||||
|
||||
(define (nixpkgs-derivation attribute)
|
||||
"Return the derivation path of ATTRIBUTE in Nixpkgs."
|
||||
(let* ((p (open-pipe* OPEN_READ "nix-instantiate" "-A"
|
||||
attribute (%nixpkgs-directory)))
|
||||
(l (read-line p))
|
||||
(s (close-pipe p)))
|
||||
(and (zero? (status:exit-val s))
|
||||
(not (eof-object? l))
|
||||
l)))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Miscellaneous.
|
||||
;;;
|
||||
|
||||
(define (memoize proc)
|
||||
"Return a memoizing version of PROC."
|
||||
(let ((cache (make-hash-table)))
|
||||
(lambda args
|
||||
(let ((results (hash-ref cache args)))
|
||||
(if results
|
||||
(apply values results)
|
||||
(let ((results (call-with-values (lambda ()
|
||||
(apply proc args))
|
||||
list)))
|
||||
(hash-set! cache args results)
|
||||
(apply values results)))))))
|
||||
|
|
|
|||
|
|
@ -20,6 +20,7 @@
|
|||
(define-module (test-derivations)
|
||||
#:use-module (guix derivations)
|
||||
#:use-module (guix store)
|
||||
#:use-module (guix utils)
|
||||
#:use-module (srfi srfi-11)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-64)
|
||||
|
|
@ -40,7 +41,7 @@
|
|||
(and (equal? b1 b2)
|
||||
(equal? d1 d2))))
|
||||
|
||||
(test-skip (if %store 0 2))
|
||||
(test-skip (if %store 0 3))
|
||||
|
||||
(test-assert "derivation with no inputs"
|
||||
(let ((builder (add-text-to-store %store "my-builder.sh"
|
||||
|
|
@ -52,7 +53,7 @@
|
|||
(test-assert "build derivation with 1 source"
|
||||
(let*-values (((builder)
|
||||
(add-text-to-store %store "my-builder.sh"
|
||||
"#!/bin/sh\necho hello, world > \"$out\"\n"
|
||||
"echo hello, world > \"$out\"\n"
|
||||
'()))
|
||||
((drv-path drv)
|
||||
(derivation %store "foo" "x86_64-linux"
|
||||
|
|
@ -67,6 +68,32 @@
|
|||
(string=? (call-with-input-file path read-line)
|
||||
"hello, world")))))
|
||||
|
||||
|
||||
(define %coreutils
|
||||
(false-if-exception (nixpkgs-derivation "coreutils")))
|
||||
|
||||
(test-skip (if %coreutils 0 1))
|
||||
|
||||
(test-assert "build derivation with coreutils"
|
||||
(let* ((builder
|
||||
(add-text-to-store %store "build-with-coreutils.sh"
|
||||
"echo $PATH ; mkdir --version ; mkdir $out ; touch $out/good"
|
||||
'()))
|
||||
(drv-path
|
||||
(derivation %store "foo" "x86_64-linux"
|
||||
"/bin/sh" `(,builder)
|
||||
`(("PATH" .
|
||||
,(string-append
|
||||
(derivation-path->output-path %coreutils)
|
||||
"/bin")))
|
||||
`((,builder)
|
||||
(,%coreutils))))
|
||||
(succeeded?
|
||||
(build-derivations %store (list drv-path))))
|
||||
(and succeeded?
|
||||
(let ((p (derivation-path->output-path drv-path)))
|
||||
(file-exists? (string-append p "/good"))))))
|
||||
|
||||
(test-end)
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue