diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2012-07-01 00:09:47 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2012-07-01 00:09:47 +0200 |
| commit | e036c31bc607ec1be8037294bdfd90723f3458a8 (patch) | |
| tree | dd251fba9d51d7af5f4e795652ceb26cd6a6798f | |
| parent | 6b1891b0a174f0fcbf26d4f404d3c2b4c63eb3e2 (diff) | |
Add missing `set-build-options' parameters.
* guix/store.scm (set-build-options)[build-cores, use-substitutes?]: New
keyword parameters.
[send]: Change to expect a type, and use `write-arg'.
Send settings for BUILD-CORES and USE-SUBSTITUTES? when the server
supports it.
| -rw-r--r-- | guix/store.scm | 34 |
1 files changed, 18 insertions, 16 deletions
diff --git a/guix/store.scm b/guix/store.scm index e00282ad8ad..1ecb2cc359d 100644 --- a/guix/store.scm +++ b/guix/store.scm | |||
| @@ -331,30 +331,32 @@ again until #t is returned or an error is raised." | |||
| 331 | (use-build-hook? #t) | 331 | (use-build-hook? #t) |
| 332 | (build-verbosity 0) | 332 | (build-verbosity 0) |
| 333 | (log-type 0) | 333 | (log-type 0) |
| 334 | (print-build-trace #t)) | 334 | (print-build-trace #t) |
| 335 | (build-cores 1) | ||
| 336 | (use-substitutes? #t)) | ||
| 335 | ;; Must be called after `open-connection'. | 337 | ;; Must be called after `open-connection'. |
| 336 | 338 | ||
| 337 | (define socket | 339 | (define socket |
| 338 | (nix-server-socket server)) | 340 | (nix-server-socket server)) |
| 339 | 341 | ||
| 340 | (let-syntax ((send (syntax-rules () | 342 | (let-syntax ((send (syntax-rules () |
| 341 | ((_ option ...) | 343 | ((_ (type option) ...) |
| 342 | (for-each (lambda (i) | 344 | (begin |
| 343 | (cond ((boolean? i) | 345 | (write-arg type option socket) |
| 344 | (write-int (if i 1 0) socket)) | 346 | ...))))) |
| 345 | ((integer? i) | 347 | (write-int (operation-id set-options) socket) |
| 346 | (write-int i socket)) | 348 | (send (boolean keep-failed?) (boolean keep-going?) |
| 347 | (else | 349 | (boolean try-fallback?) (integer verbosity) |
| 348 | (error "invalid build option" | 350 | (integer max-build-jobs) (integer max-silent-time)) |
| 349 | i)))) | ||
| 350 | (list option ...)))))) | ||
| 351 | (send (operation-id set-options) | ||
| 352 | keep-failed? keep-going? try-fallback? verbosity | ||
| 353 | max-build-jobs max-silent-time) | ||
| 354 | (if (>= (nix-server-minor-version server) 2) | 351 | (if (>= (nix-server-minor-version server) 2) |
| 355 | (send use-build-hook?)) | 352 | (send (boolean use-build-hook?))) |
| 356 | (if (>= (nix-server-minor-version server) 4) | 353 | (if (>= (nix-server-minor-version server) 4) |
| 357 | (send build-verbosity log-type print-build-trace)) | 354 | (send (integer build-verbosity) (integer log-type) |
| 355 | (boolean print-build-trace))) | ||
| 356 | (if (>= (nix-server-minor-version server) 6) | ||
| 357 | (send (integer build-cores))) | ||
| 358 | (if (>= (nix-server-minor-version server) 10) | ||
| 359 | (send (boolean use-substitutes?))) | ||
| 358 | (let loop ((done? (process-stderr server))) | 360 | (let loop ((done? (process-stderr server))) |
| 359 | (or done? (process-stderr server))))) | 361 | (or done? (process-stderr server))))) |
| 360 | 362 | ||
