derivations: Add support for recursive fixed-output derivations.
* guix/derivations.scm (<derivation-output>): Add 'recursive?' field.
Adjust 'make-derivation-output' callers.
(%read-derivation) <fixed-output>: When HASH-ALGO starts with 'r:',
set the 'recursive?' field and drop 'r:' from the hash algo name.
(write-derivation)[write-output]: Write the algo as 'r:HASH-ALGO' when
the RECURSIVE? field is set.
(derivation-hash) <fixed-output>: Prepend "r:" when RECURSIVE? is set.
(fixed-output-path): New procedure.
(derivation): Add #:recursive? parameter. Use 'fixed-output-path' to
compute the output file name of a fixed output derivation.
(build-expression->derivation): Add #:recursive? parameter. Pass it
to 'derivation'.
* tests/derivations.scm ("fixed-output derivation, recursive",
"build-expression->derivation produces recursive fixed-output",
"build-expression->derivation uses recursive fixed-output"): New
tests.
* doc/guix.texi (Derivations): Document #:recursive? for 'derivation'.
Add #:recursive? for 'build-expression->derivation'.
This commit is contained in:
Ludovic Courtès
parent
3140f2df42
commit
36bbbbd150
|
|
@ -1478,7 +1478,7 @@ a derivation is the @code{derivation} procedure:
|
|||
|
||||
@deffn {Scheme Procedure} derivation @var{store} @var{name} @var{builder} @
|
||||
@var{args} [#:outputs '("out")] [#:hash #f] [#:hash-algo #f] @
|
||||
[#:hash-mode #f] [#:inputs '()] [#:env-vars '()] @
|
||||
[#:recursive? #f] [#:hash-mode #f] [#:inputs '()] [#:env-vars '()] @
|
||||
[#:system (%current-system)] [#:references-graphs #f] @
|
||||
[#:local-build? #f]
|
||||
Build a derivation with the given arguments, and return the resulting
|
||||
|
|
@ -1486,7 +1486,10 @@ Build a derivation with the given arguments, and return the resulting
|
|||
|
||||
When @var{hash}, @var{hash-algo}, and @var{hash-mode} are given, a
|
||||
@dfn{fixed-output derivation} is created---i.e., one whose result is
|
||||
known in advance, such as a file download.
|
||||
known in advance, such as a file download. If, in addition,
|
||||
@var{recursive?} is true, then that fixed output may be an executable
|
||||
file or a directory and @var{hash} must be the hash of an archive
|
||||
containing this output.
|
||||
|
||||
When @var{references-graphs} is true, it must be a list of file
|
||||
name/store path pairs. In that case, the reference graph of each store
|
||||
|
|
@ -1526,7 +1529,7 @@ the caller to directly pass a Guile expression as the build script:
|
|||
@var{name} @var{exp} @
|
||||
[#:system (%current-system)] [#:inputs '()] @
|
||||
[#:outputs '("out")] [#:hash #f] [#:hash-algo #f] @
|
||||
[#:env-vars '()] [#:modules '()] @
|
||||
[#:recursive? #f] [#:env-vars '()] [#:modules '()] @
|
||||
[#:references-graphs #f] [#:local-build? #f] [#:guile-for-build #f]
|
||||
Return a derivation that executes Scheme expression @var{exp} as a
|
||||
builder for derivation @var{name}. @var{inputs} must be a list of
|
||||
|
|
|
|||
|
|
@ -47,6 +47,7 @@
|
|||
derivation-output-path
|
||||
derivation-output-hash-algo
|
||||
derivation-output-hash
|
||||
derivation-output-recursive?
|
||||
|
||||
<derivation-input>
|
||||
derivation-input?
|
||||
|
|
@ -91,11 +92,12 @@
|
|||
(file-name derivation-file-name)) ; the .drv file name
|
||||
|
||||
(define-record-type <derivation-output>
|
||||
(make-derivation-output path hash-algo hash)
|
||||
(make-derivation-output path hash-algo hash recursive?)
|
||||
derivation-output?
|
||||
(path derivation-output-path) ; store path
|
||||
(hash-algo derivation-output-hash-algo) ; symbol | #f
|
||||
(hash derivation-output-hash)) ; bytevector | #f
|
||||
(hash derivation-output-hash) ; bytevector | #f
|
||||
(recursive? derivation-output-recursive?)) ; Boolean
|
||||
|
||||
(define-record-type <derivation-input>
|
||||
(make-derivation-input path sub-derivations)
|
||||
|
|
@ -241,14 +243,19 @@ that second value is the empty list."
|
|||
(match output
|
||||
((name path "" "")
|
||||
(alist-cons name
|
||||
(make-derivation-output path #f #f)
|
||||
(make-derivation-output path #f #f #f)
|
||||
result))
|
||||
((name path hash-algo hash)
|
||||
;; fixed-output
|
||||
(let ((algo (string->symbol hash-algo))
|
||||
(hash (base16-string->bytevector hash)))
|
||||
(let* ((rec? (string-prefix? "r:" hash-algo))
|
||||
(algo (string->symbol
|
||||
(if rec?
|
||||
(string-drop hash-algo 2)
|
||||
hash-algo)))
|
||||
(hash (base16-string->bytevector hash)))
|
||||
(alist-cons name
|
||||
(make-derivation-output path algo hash)
|
||||
(make-derivation-output path algo
|
||||
hash rec?)
|
||||
result)))))
|
||||
'()
|
||||
x))
|
||||
|
|
@ -368,9 +375,12 @@ that form."
|
|||
|
||||
(define (write-output output port)
|
||||
(match output
|
||||
((name . ($ <derivation-output> path hash-algo hash))
|
||||
((name . ($ <derivation-output> path hash-algo hash recursive?))
|
||||
(write-tuple (list name path
|
||||
(or (and=> hash-algo symbol->string) "")
|
||||
(if hash-algo
|
||||
(string-append (if recursive? "r:" "")
|
||||
(symbol->string hash-algo))
|
||||
"")
|
||||
(or (and=> hash bytevector->base16-string)
|
||||
""))
|
||||
write
|
||||
|
|
@ -476,11 +486,14 @@ in SIZE bytes."
|
|||
"Return the hash of DRV, modulo its fixed-output inputs, as a bytevector."
|
||||
(match drv
|
||||
(($ <derivation> ((_ . ($ <derivation-output> path
|
||||
(? symbol? hash-algo) (? bytevector? hash)))))
|
||||
(? symbol? hash-algo) (? bytevector? hash)
|
||||
(? boolean? recursive?)))))
|
||||
;; A fixed-output derivation.
|
||||
(sha256
|
||||
(string->utf8
|
||||
(string-append "fixed:out:" (symbol->string hash-algo)
|
||||
(string-append "fixed:out:"
|
||||
(if recursive? "r:" "")
|
||||
(symbol->string hash-algo)
|
||||
":" (bytevector->base16-string hash)
|
||||
":" path))))
|
||||
(($ <derivation> outputs inputs sources
|
||||
|
|
@ -527,17 +540,33 @@ the derivation called NAME with hash HASH."
|
|||
name
|
||||
(string-append name "-" output))))
|
||||
|
||||
(define (fixed-output-path output hash-algo hash recursive? name)
|
||||
"Return an output path for the fixed output OUTPUT defined by HASH of type
|
||||
HASH-ALGO, of the derivation NAME. RECURSIVE? has the same meaning as for
|
||||
'add-to-store'."
|
||||
(if (and recursive? (eq? hash-algo 'sha256))
|
||||
(store-path "source" hash name)
|
||||
(let ((tag (string-append "fixed:" output ":"
|
||||
(if recursive? "r:" "")
|
||||
(symbol->string hash-algo) ":"
|
||||
(bytevector->base16-string hash) ":")))
|
||||
(store-path (string-append "output:" output)
|
||||
(sha256 (string->utf8 tag))
|
||||
name))))
|
||||
|
||||
(define* (derivation store name builder args
|
||||
#:key
|
||||
(system (%current-system)) (env-vars '())
|
||||
(inputs '()) (outputs '("out"))
|
||||
hash hash-algo hash-mode
|
||||
hash hash-algo hash-mode recursive?
|
||||
references-graphs
|
||||
local-build?)
|
||||
"Build a derivation with the given arguments, and return the resulting
|
||||
<derivation> object. When HASH, HASH-ALGO, and HASH-MODE are given, a
|
||||
fixed-output derivation is created---i.e., one whose result is known in
|
||||
advance, such as a file download.
|
||||
advance, such as a file download. If, in addition, RECURSIVE? is true, then
|
||||
that fixed output may be an executable file or a directory and HASH must be
|
||||
the hash of an archive containing this output.
|
||||
|
||||
When REFERENCES-GRAPHS is true, it must be a list of file name/store path
|
||||
pairs. In that case, the reference graph of each store path is exported in
|
||||
|
|
@ -555,12 +584,16 @@ derivations where the costs of data transfers would outweigh the benefits."
|
|||
(let* ((drv-hash (derivation-hash drv))
|
||||
(outputs (map (match-lambda
|
||||
((output-name . ($ <derivation-output>
|
||||
_ algo hash))
|
||||
(let ((path (output-path output-name
|
||||
drv-hash name)))
|
||||
_ algo hash rec?))
|
||||
(let ((path (if hash
|
||||
(fixed-output-path output-name
|
||||
algo hash
|
||||
rec? name)
|
||||
(output-path output-name
|
||||
drv-hash name))))
|
||||
(cons output-name
|
||||
(make-derivation-output path algo
|
||||
hash)))))
|
||||
hash rec?)))))
|
||||
outputs)))
|
||||
(make-derivation outputs inputs sources system builder args
|
||||
(map (match-lambda
|
||||
|
|
@ -618,7 +651,8 @@ derivations where the costs of data transfers would outweigh the benefits."
|
|||
(let* ((outputs (map (lambda (name)
|
||||
;; Return outputs with an empty path.
|
||||
(cons name
|
||||
(make-derivation-output "" hash-algo hash)))
|
||||
(make-derivation-output "" hash-algo
|
||||
hash recursive?)))
|
||||
outputs))
|
||||
(inputs (map (match-lambda
|
||||
(((? derivation? drv))
|
||||
|
|
@ -909,7 +943,7 @@ they can refer to each other."
|
|||
(system (%current-system))
|
||||
(inputs '())
|
||||
(outputs '("out"))
|
||||
hash hash-algo
|
||||
hash hash-algo recursive?
|
||||
(env-vars '())
|
||||
(modules '())
|
||||
guile-for-build
|
||||
|
|
@ -1056,6 +1090,7 @@ LOCAL-BUILD?."
|
|||
env-vars)
|
||||
|
||||
#:hash hash #:hash-algo hash-algo
|
||||
#:recursive? recursive?
|
||||
#:outputs outputs
|
||||
#:references-graphs references-graphs
|
||||
#:local-build? local-build?)))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
|
@ -23,7 +23,8 @@
|
|||
#:use-module (guix utils)
|
||||
#:use-module (guix hash)
|
||||
#:use-module (guix base32)
|
||||
#:use-module ((guix packages) #:select (package-derivation))
|
||||
#:use-module ((guix packages) #:select (package-derivation base32))
|
||||
#:use-module ((guix build utils) #:select (executable-file?))
|
||||
#:use-module ((gnu packages) #:select (search-bootstrap-binary))
|
||||
#:use-module (gnu packages bootstrap)
|
||||
#:use-module ((gnu packages guile) #:select (guile-1.8))
|
||||
|
|
@ -190,6 +191,23 @@
|
|||
(equal? (derivation->output-path drv1)
|
||||
(derivation->output-path drv2)))))
|
||||
|
||||
(test-assert "fixed-output derivation, recursive"
|
||||
(let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
|
||||
"echo -n hello > $out" '()))
|
||||
(hash (sha256 (string->utf8 "hello")))
|
||||
(drv (derivation %store "fixed-rec"
|
||||
%bash `(,builder)
|
||||
#:inputs `((,builder))
|
||||
#:hash (base32 "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa")
|
||||
#:hash-algo 'sha256
|
||||
#:recursive? #t))
|
||||
(succeeded? (build-derivations %store (list drv))))
|
||||
(and succeeded?
|
||||
(let ((p (derivation->output-path drv)))
|
||||
(and (equal? (string->utf8 "hello")
|
||||
(call-with-input-file p get-bytevector-all))
|
||||
(bytevector? (query-path-hash %store p)))))))
|
||||
|
||||
(test-assert "derivation with a fixed-output input"
|
||||
;; A derivation D using a fixed-output derivation F doesn't has the same
|
||||
;; output path when passed F or F', as long as F and F' have the same output
|
||||
|
|
@ -637,6 +655,54 @@ Deriver: ~a~%"
|
|||
(derivation-file-name final1)))
|
||||
(build-derivations %store (list final1 final2)))))
|
||||
|
||||
(test-assert "build-expression->derivation produces recursive fixed-output"
|
||||
(let* ((builder '(begin
|
||||
(use-modules (srfi srfi-26))
|
||||
(mkdir %output)
|
||||
(chdir %output)
|
||||
(call-with-output-file "exe"
|
||||
(cut display "executable" <>))
|
||||
(chmod "exe" #o777)
|
||||
(symlink "exe" "symlink")
|
||||
(mkdir "subdir")))
|
||||
(drv (build-expression->derivation %store "fixed-rec" builder
|
||||
#:hash-algo 'sha256
|
||||
#:hash (base32
|
||||
"10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p")
|
||||
#:recursive? #t)))
|
||||
(and (build-derivations %store (list drv))
|
||||
(let* ((dir (derivation->output-path drv))
|
||||
(exe (string-append dir "/exe"))
|
||||
(link (string-append dir "/symlink"))
|
||||
(subdir (string-append dir "/subdir")))
|
||||
(and (executable-file? exe)
|
||||
(string=? "executable"
|
||||
(call-with-input-file exe get-string-all))
|
||||
(string=? "exe" (readlink link))
|
||||
(file-is-directory? subdir))))))
|
||||
|
||||
(test-assert "build-expression->derivation uses recursive fixed-output"
|
||||
(let* ((builder '(call-with-output-file %output
|
||||
(lambda (port)
|
||||
(display "hello" port))))
|
||||
(fixed (build-expression->derivation %store "small-fixed-rec"
|
||||
builder
|
||||
#:hash-algo 'sha256
|
||||
#:hash (base32
|
||||
"0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa")
|
||||
#:recursive? #t))
|
||||
(in (derivation->output-path fixed))
|
||||
(builder `(begin
|
||||
(mkdir %output)
|
||||
(chdir %output)
|
||||
(symlink ,in "symlink")))
|
||||
(drv (build-expression->derivation %store "fixed-rec-user"
|
||||
builder
|
||||
#:inputs `(("fixed" ,fixed)))))
|
||||
(and (build-derivations %store (list drv))
|
||||
(let ((out (derivation->output-path drv)))
|
||||
(string=? (readlink (string-append out "/symlink")) in)))))
|
||||
|
||||
(test-assert "build-expression->derivation with #:references-graphs"
|
||||
(let* ((input (add-text-to-store %store "foo" "hello"
|
||||
(list %bash %mkdir)))
|
||||
|
|
|
|||
Loading…
Reference in New Issue