mirrors
/
cuirass
mirror of https://notabug.org/mthl/cuirass.git
1
0
Fork 0
Code Issues Releases Wiki Activity

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>
pull/3/head
Jan Nieuwenhuizen 2016-09-16 09:25:55 +02:00 committed by Mathieu Lirzin
parent f65c62e53a
commit 686e31c590
No known key found for this signature in database
GPG Key ID: 0ADEE10094604D37
1 changed files with 21 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
src/cuirass/base.scm
View File

@ -124,22 +124,34 @@ if required."
(define (build-packages store db jobs) (define (build-packages store db jobs)
"Build JOBS and return a list of Build results." "Build JOBS and return a list of Build results."
(map (λ (job) (map (λ (job)
(let ((log-port (%make-void-port "w0")) (let* ((name (assq-ref job #:job-name))
(name (assq-ref job #:job-name)) (drv (assq-ref job #:derivation))
(drv (assq-ref job #:derivation)) (eval-id (assq-ref job #:eval-id))
(eval-id (assq-ref job #:eval-id))) (success? #t)
(error-log (string-append (%package-cachedir) "/"
name ".log")))
(simple-format #t "building ~A...\n" drv) (simple-format #t "building ~A...\n" drv)
(parameterize ((current-build-output-port log-port)) (let ((log (call-with-output-string
(build-derivations store (list drv)) (λ (port)
(let* ((output (derivation-path->output-path drv)) (parameterize ((current-build-output-port port))
(log (log-file store output)) (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) (build `((#:derivation . ,drv)
(#:eval-id . ,eval-id) (#:eval-id . ,eval-id)
(#:log . ,log) (#:log . ,log)
(#:output . ,output)))) (#:output . ,output))))
(db-add-build db build) (db-add-build db build)
(simple-format #t "~A\n" output) (simple-format #t "~A\n" output)
(close-port log-port)
build)))) build))))
jobs)) jobs))