diff options
| -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)) |