store: Add mode parameter to 'build-paths'.
* guix/store.scm (%protocol-version): Set minor to 15. (build-mode): New enumerate type. (build-things): Add 'mode' parameter; pass it to the RPC. * tests/store.scm ("build-things, check mode"): New check.
This commit is contained in:
parent
d203d3d4cb
commit
07e70f4846
@ -53,6 +53,7 @@
|
|||||||
nix-protocol-error-status
|
nix-protocol-error-status
|
||||||
|
|
||||||
hash-algo
|
hash-algo
|
||||||
|
build-mode
|
||||||
|
|
||||||
open-connection
|
open-connection
|
||||||
close-connection
|
close-connection
|
||||||
@ -129,7 +130,7 @@
|
|||||||
direct-store-path
|
direct-store-path
|
||||||
log-file))
|
log-file))
|
||||||
|
|
||||||
(define %protocol-version #x10e)
|
(define %protocol-version #x10f)
|
||||||
|
|
||||||
(define %worker-magic-1 #x6e697863) ; "nixc"
|
(define %worker-magic-1 #x6e697863) ; "nixc"
|
||||||
(define %worker-magic-2 #x6478696f) ; "dxio"
|
(define %worker-magic-2 #x6478696f) ; "dxio"
|
||||||
@ -188,6 +189,12 @@
|
|||||||
(sha1 2)
|
(sha1 2)
|
||||||
(sha256 3))
|
(sha256 3))
|
||||||
|
|
||||||
|
(define-enumerate-type build-mode
|
||||||
|
;; store-api.hh
|
||||||
|
(normal 0)
|
||||||
|
(repair 1)
|
||||||
|
(check 2))
|
||||||
|
|
||||||
(define-enumerate-type gc-action
|
(define-enumerate-type gc-action
|
||||||
;; store-api.hh
|
;; store-api.hh
|
||||||
(return-live 0)
|
(return-live 0)
|
||||||
@ -637,12 +644,17 @@ bits are kept. HASH-ALGO must be a string such as \"sha256\"."
|
|||||||
(hash-set! cache args path)
|
(hash-set! cache args path)
|
||||||
path))))))
|
path))))))
|
||||||
|
|
||||||
(define-operation (build-things (string-list things))
|
(define build-things
|
||||||
|
(let ((build (operation (build-things (string-list things)
|
||||||
|
(integer mode))
|
||||||
|
"Do it!"
|
||||||
|
boolean)))
|
||||||
|
(lambda* (store things #:optional (mode (build-mode normal)))
|
||||||
"Build THINGS, a list of store items which may be either '.drv' files or
|
"Build THINGS, a list of store items which may be either '.drv' files or
|
||||||
outputs, and return when the worker is done building them. Elements of THINGS
|
outputs, and return when the worker is done building them. Elements of THINGS
|
||||||
that are not derivations can only be substituted and not built locally.
|
that are not derivations can only be substituted and not built locally.
|
||||||
Return #t on success."
|
Return #t on success."
|
||||||
boolean)
|
(build store things mode))))
|
||||||
|
|
||||||
(define-operation (add-temp-root (store-path path))
|
(define-operation (add-temp-root (store-path path))
|
||||||
"Make PATH a temporary root for the duration of the current session.
|
"Make PATH a temporary root for the duration of the current session.
|
||||||
|
@ -756,6 +756,41 @@
|
|||||||
;; Delete the corrupt item to leave the store in a clean state.
|
;; Delete the corrupt item to leave the store in a clean state.
|
||||||
(delete-paths s (list file)))))))
|
(delete-paths s (list file)))))))
|
||||||
|
|
||||||
|
(test-assert "build-things, check mode"
|
||||||
|
(with-store store
|
||||||
|
(call-with-temporary-output-file
|
||||||
|
(lambda (entropy entropy-port)
|
||||||
|
(write (random-text) entropy-port)
|
||||||
|
(force-output entropy-port)
|
||||||
|
(let* ((drv (build-expression->derivation
|
||||||
|
store "non-deterministic"
|
||||||
|
`(begin
|
||||||
|
(use-modules (rnrs io ports))
|
||||||
|
(let ((out (assoc-ref %outputs "out")))
|
||||||
|
(call-with-output-file out
|
||||||
|
(lambda (port)
|
||||||
|
(display (call-with-input-file ,entropy
|
||||||
|
get-string-all)
|
||||||
|
port)))
|
||||||
|
#t))
|
||||||
|
#:guile-for-build
|
||||||
|
(package-derivation store %bootstrap-guile (%current-system))))
|
||||||
|
(file (derivation->output-path drv)))
|
||||||
|
(and (build-things store (list (derivation-file-name drv)))
|
||||||
|
(begin
|
||||||
|
(write (random-text) entropy-port)
|
||||||
|
(force-output entropy-port)
|
||||||
|
(guard (c ((nix-protocol-error? c)
|
||||||
|
(pk 'determinism-exception c)
|
||||||
|
(and (not (zero? (nix-protocol-error-status c)))
|
||||||
|
(string-contains (nix-protocol-error-message c)
|
||||||
|
"deterministic"))))
|
||||||
|
;; This one will produce a different result. Since we're in
|
||||||
|
;; 'check' mode, this must fail.
|
||||||
|
(build-things store (list (derivation-file-name drv))
|
||||||
|
(build-mode check))
|
||||||
|
#f))))))))
|
||||||
|
|
||||||
(test-equal "store-lower"
|
(test-equal "store-lower"
|
||||||
"Lowered."
|
"Lowered."
|
||||||
(let* ((add (store-lower text-file))
|
(let* ((add (store-lower text-file))
|
||||||
|
Loading…
Reference in New Issue
Block a user