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:
Ludovic Courtès 2015-12-03 19:08:35 +02:00
parent d203d3d4cb
commit 07e70f4846
2 changed files with 51 additions and 4 deletions

@ -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))