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

Allow derivations with input derivations.

Browse source 
* 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 2012-06-07 23:15:00 +02:00
parent 087602b687
commit de4c3f26cb
3 changed files with 125 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

78
guix/derivations.scm
View file

@ -48,6 +48,7 @@ (define-module (guix derivations)
read-derivation
write-derivation
derivation-path->output-path
derivation))
;;;
@ -186,6 +187,18 @@ (define (write-list lst)
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 @@ (define old-size (bytevector-length bv))
(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 @@ (define (env-vars-with-empty-outputs)
(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 @@ (define (env-vars-with-empty-outputs)
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 <>))

46
guix/utils.scm
View file

@ -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 @@ (define-module (guix utils)
bytevector->base32-string
bytevector->nix-base32-string
bytevector->base16-string
sha256))
sha256
%nixpkgs-directory
nixpkgs-derivation
memoize))
;;;
@ -198,3 +206,39 @@ (define (sha256 bv)
"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)))))))

31
tests/derivations.scm
View file

@ -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 @@ (define %store
(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 @@ (define %store
(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 @@ (define %store
(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)