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>

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