Send inferior error output to stderr

Ideally this would go in to the database somehow as well, but the only idea I
have for that is pass in a pipe, and then spawn a thread to read from the
other end of that pipe in a loop to send the output to the database.

That hasn't been written yet, so just send the output to stderr for now.
This commit is contained in:
Christopher Baines 2019-10-18 17:15:45 +01:00
parent 917d031d4f
commit c9e0e311bb

View file

@ -89,6 +89,9 @@
(setvbuf port 'line) (setvbuf port 'line)
port)) port))
(define real-error-port
(make-parameter (current-error-port)))
(define* (log-for-job conn job-id (define* (log-for-job conn job-id
#:key #:key
character-limit character-limit
@ -596,7 +599,8 @@ WHERE job_id = $1"
"SSL_CERT_DIR=" (nss-certs-store-path store)))) "SSL_CERT_DIR=" (nss-certs-store-path store))))
(begin (begin
(simple-format #t "debug: using open-inferior\n") (simple-format #t "debug: using open-inferior\n")
(open-inferior (guix-store-path store)))))) (open-inferior (guix-store-path store)
#:error-port (real-error-port))))))
(catch (catch
#t #t
@ -707,7 +711,8 @@ WHERE job_id = $1"
'("/gnu/store")) '("/gnu/store"))
(begin (begin
(simple-format #t "debug: using open-inferior\n") (simple-format #t "debug: using open-inferior\n")
(open-inferior store-path))))) (open-inferior store-path
#:error-port (real-error-port))))))
(inferior-eval '(use-modules (srfi srfi-1) (inferior-eval '(use-modules (srfi srfi-1)
(srfi srfi-34) (srfi srfi-34)
(guix grafts) (guix grafts)
@ -766,7 +771,8 @@ WHERE job_id = $1"
'("/gnu/store")) '("/gnu/store"))
(begin (begin
(simple-format #t "debug: using open-inferior\n") (simple-format #t "debug: using open-inferior\n")
(open-inferior store-path)))))) (open-inferior store-path
#:error-port (real-error-port)))))))
(setenv "GUIX_LOCPATH" guix-locpath) ; restore GUIX_LOCPATH (setenv "GUIX_LOCPATH" guix-locpath) ; restore GUIX_LOCPATH
(when (eq? inf #f) (when (eq? inf #f)
@ -1236,7 +1242,8 @@ SKIP LOCKED")
(set-current-output-port logging-port) (set-current-output-port logging-port)
(set-current-error-port logging-port) (set-current-error-port logging-port)
(let ((result (let ((result
(parameterize ((current-build-output-port logging-port)) (parameterize ((current-build-output-port logging-port)
(real-error-port previous-error-port))
(load-new-guix-revision conn git-repository-id commit)))) (load-new-guix-revision conn git-repository-id commit))))
(combine-log-parts! logging-conn id) (combine-log-parts! logging-conn id)