diff options
| author | Jan Nieuwenhuizen <janneke@gnu.org> | 2016-09-16 09:25:55 +0200 |
|---|---|---|
| committer | Mathieu Lirzin <mthl@gnu.org> | 2016-09-23 16:53:40 +0200 |
| commit | 686e31c590b4c9ae80304ad873357d3b7dca7641 (patch) | |
| tree | c158885bce989afb47d448e747de97a819d0db80 | |
| parent | f65c62e53af27d3d73b362270084093586d97983 (diff) | |
| download | cuirass-686e31c590b4c9ae80304ad873357d3b7dca7641.tar cuirass-686e31c590b4c9ae80304ad873357d3b7dca7641.tar.gz | |
base: Handle build failure.
* src/cuirass/base.scm (build-packages): Catch build failures, write
error log and update database.
Signed-off-by: Mathieu Lirzin <mthl@gnu.org>
| -rw-r--r-- | src/cuirass/base.scm | 30 |
1 files changed, 21 insertions, 9 deletions
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm index 3d542b1..005632f 100644 --- a/src/cuirass/base.scm +++ b/src/cuirass/base.scm @@ -124,22 +124,34 @@ if required." (define (build-packages store db jobs) "Build JOBS and return a list of Build results." (map (λ (job) - (let ((log-port (%make-void-port "w0")) - (name (assq-ref job #:job-name)) - (drv (assq-ref job #:derivation)) - (eval-id (assq-ref job #:eval-id))) + (let* ((name (assq-ref job #:job-name)) + (drv (assq-ref job #:derivation)) + (eval-id (assq-ref job #:eval-id)) + (success? #t) + (error-log (string-append (%package-cachedir) "/" + name ".log"))) (simple-format #t "building ~A...\n" drv) - (parameterize ((current-build-output-port log-port)) - (build-derivations store (list drv)) - (let* ((output (derivation-path->output-path drv)) - (log (log-file store output)) + (let ((log (call-with-output-string + (λ (port) + (parameterize ((current-build-output-port port)) + (catch 'srfi-34 + (λ () + (build-derivations store (list drv))) + (λ (key . args) + (set! success? #f) + (pk "kets key:" key "args:" args)))))))) + (when (not success?) + (with-output-to-file error-log + (lambda () (display log))) + (simple-format #t "build failed: ~a\n" error-log)) + (let* ((output (and success? (derivation-path->output-path drv))) + (log (if success? (log-file store output) error-log)) (build `((#:derivation . ,drv) (#:eval-id . ,eval-id) (#:log . ,log) (#:output . ,output)))) (db-add-build db build) (simple-format #t "~A\n" output) - (close-port log-port) build)))) jobs)) |