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
					
				
					 2 changed files with 51 additions and 4 deletions
				
			
		|  | @ -53,6 +53,7 @@ | |||
|             nix-protocol-error-status | ||||
| 
 | ||||
|             hash-algo | ||||
|             build-mode | ||||
| 
 | ||||
|             open-connection | ||||
|             close-connection | ||||
|  | @ -129,7 +130,7 @@ | |||
|             direct-store-path | ||||
|             log-file)) | ||||
| 
 | ||||
| (define %protocol-version #x10e) | ||||
| (define %protocol-version #x10f) | ||||
| 
 | ||||
| (define %worker-magic-1 #x6e697863)               ; "nixc" | ||||
| (define %worker-magic-2 #x6478696f)               ; "dxio" | ||||
|  | @ -188,6 +189,12 @@ | |||
|   (sha1 2) | ||||
|   (sha256 3)) | ||||
| 
 | ||||
| (define-enumerate-type build-mode | ||||
|   ;; store-api.hh | ||||
|   (normal 0) | ||||
|   (repair 1) | ||||
|   (check 2)) | ||||
| 
 | ||||
| (define-enumerate-type gc-action | ||||
|   ;; store-api.hh | ||||
|   (return-live 0) | ||||
|  | @ -637,12 +644,17 @@ bits are kept.  HASH-ALGO must be a string such as \"sha256\"." | |||
|               (hash-set! cache args path) | ||||
|               path)))))) | ||||
| 
 | ||||
| (define-operation (build-things (string-list things)) | ||||
|   "Build THINGS, a list of store items which may be either '.drv' files or | ||||
| (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 | ||||
| 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. | ||||
| Return #t on success." | ||||
|   boolean) | ||||
|       (build store things mode)))) | ||||
| 
 | ||||
| (define-operation (add-temp-root (store-path path)) | ||||
|   "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-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" | ||||
|   "Lowered." | ||||
|   (let* ((add  (store-lower text-file)) | ||||
|  |  | |||
		Reference in a new issue