src/cuirass/base.scm

@@ -387,7 +387,7 @@ Essentially this procedure inverts the inversion-of-control that
   ;; Our shuffling algorithm is simple: we sort by .drv file name.  :-)
   (sort drv string<?))
 
-(define* (set-build-successful! drv #:optional log)
+(define* (set-build-successful! drv)
   "Update the build status of DRV as successful and register any eventual
 build products."
   (let* ((build (db-get-build drv))
@@ -397,8 +397,7 @@ build products."
     (when (and spec build)
       (create-build-outputs build
                             (specification-build-outputs spec))))
-  (db-update-build-status! drv (build-status succeeded)
-                           #:log-file log))
+  (db-update-build-status! drv (build-status succeeded)))
 
 (define (update-build-statuses! store lst)
   "Update the build status of the derivations listed in LST, which have just
@@ -484,7 +483,7 @@ items."
                                    ;; from PORT and eventually close it.
                                    (catch #t
                                      (lambda ()
-                                       (handle-build-event event))
+                                       (handle-build-event store event))
                                      (exception-reporter state)))
                                  #t)
               (close-port port)
@@ -500,7 +499,7 @@ items."
 
           (loop rest (max (- count max-batch-size) 0))))))
 
-(define* (handle-build-event event)
+(define* (handle-build-event store event)
   "Handle EVENT, a build event sexp as produced by 'build-event-output-port',
 updating the database accordingly."
   (define (valid? file)
@@ -522,7 +521,8 @@ updating the database accordingly."
      (if (valid? drv)
          (begin
            (log-message "build started: '~a'" drv)
-           (db-update-build-status! drv (build-status started)))
+           (db-update-build-status! drv (build-status started)
+                                    #:log-file (log-file store drv)))
          (log-message "bogus build-started event for '~a'" drv)))
     (('build-remote drv host _ ...)
      (log-message "'~a' offloaded to '~a'" drv host)

src/cuirass/http.scm

@@ -485,12 +485,19 @@ into a specification record and return it."
           (respond-file file-path)
           (respond-not-found file-name))))
 
-  (define (respond-gzipped-file file)
-    ;; Return FILE with 'gzip' content-encoding.
-    (respond `((content-type . (text/plain (charset . "UTF-8")))
-               (content-encoding . (gzip))
-               (content-disposition . (inline))
-               (x-raw-file . ,file))))
+  (define (respond-compressed-file file)
+    ;; Return FILE with 'gzip' or 'bzip2' content-encoding.
+    (let ((encoding
+           (cond ((string-suffix? ".gz" file)
+                  '((content-type . (text/plain (charset . "UTF-8")))
+                    (content-encoding . (gzip))))
+                 ((string-suffix? ".bz2" file)
+                  '((content-type . (application/bzip2
+                                     (charset . "ISO-8859-1")))))
+                 (else '()))))
+      (respond `(,@encoding
+                 (content-disposition . (inline))
+                 (x-raw-file . ,file)))))
 
   (define (respond-build-not-found build-id)
     (respond-json-with-error
@@ -668,7 +675,7 @@ into a specification record and return it."
      (let* ((build (and id (db-get-build id)))
             (log   (and build (assq-ref build #:log))))
        (if (and log (file-exists? log))
-           (respond-gzipped-file log)
+           (respond-compressed-file log)
            (respond-not-found (uri->string (request-uri request))))))
     (('GET "output" id)
      (let ((output (db-get-output
@@ -788,7 +795,7 @@ into a specification record and return it."
     (('GET "eval" (= string->number id) "log" "raw")
      (let ((log (and id (evaluation-log-file id))))
        (if (and log (file-exists? log))
-           (respond-gzipped-file log)
+           (respond-compressed-file log)
            (respond-not-found (uri->string (request-uri request))))))
 
     (('GET "search")