aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/derivations.scm78
-rw-r--r--guix/utils.scm46
-rw-r--r--tests/derivations.scm31
3 files changed, 125 insertions, 30 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 151bff7215..09f58f0fb8 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -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,33 +213,41 @@ in SIZE bytes."
(logxor o (bytevector-u8-ref bv i)))
(loop (+ 1 i))))))
-(define (derivation-hash drv) ; `hashDerivationModulo' in derivations.cc
- "Return the hash of DRV, modulo its fixed-output inputs, as a bytevector."
- (match drv
- (($ <derivation> ((_ . ($ <derivation-output> path
- (? symbol? hash-algo) (? string? hash)))))
- ;; A fixed-output derivation.
- (sha256
- (string->utf8
- (string-append "fixed:out:" 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-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))
- (drv (make-derivation outputs inputs sources
- system builder args env-vars)))
+(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
+ (? symbol? hash-algo) (? string? hash)))))
+ ;; A fixed-output derivation.
(sha256
- (string->utf8 (call-with-output-string
- (cut write-derivation drv <>))))))))
+ (string->utf8
+ (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. 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)
+ (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 <>))))))))))
(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 <>))
diff --git a/guix/utils.scm b/guix/utils.scm
index a5f64f97a9..2ffecbfab9 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -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)))))))
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 64bc678828..f2a3bb2d55 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -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)