diff options
| author | Christopher Baines <mail@cbaines.net> | 2020-02-24 18:46:53 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2020-02-24 18:46:53 +0000 |
| commit | cee9acaa87212c84d09500c5cda823746a8ee18d (patch) | |
| tree | 520d57549020b58acbf98c388b626c76b35456de | |
| parent | 0c726b9fe731490c6ddfc147cbaf7fb925332447 (diff) | |
| download | data-service-cee9acaa87212c84d09500c5cda823746a8ee18d.tar data-service-cee9acaa87212c84d09500c5cda823746a8ee18d.tar.gz | |
Refactor the logging setup out of process-load-new-guix-revision-job
To simplify both procedures.
| -rw-r--r-- | guix-data-service/jobs/load-new-guix-revision.scm | 89 |
1 files changed, 48 insertions, 41 deletions
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index efeb788..0025227 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -1554,6 +1554,37 @@ SKIP LOCKED") (f store))) +(define (setup-logging id thunk) + (let* ((previous-output-port (current-output-port)) + (previous-error-port (current-error-port)) + (result + (with-postgresql-connection + (simple-format #f "load-new-guix-revision ~A logging" id) + (lambda (logging-conn) + (insert-empty-log-entry logging-conn id) + (let ((logging-port + (log-port id logging-conn + #:delete-existing-log-parts? #t))) + (set-current-output-port logging-port) + (set-current-error-port logging-port) + (let ((result + (parameterize ((current-build-output-port logging-port) + (real-error-port previous-error-port) + (inferior-error-port + (setup-port-for-inferior-error-output + id previous-error-port))) + (thunk)))) + (combine-log-parts! logging-conn id) + (drop-log-parts-sequence logging-conn id) + + ;; This can happen with GC, so do it explicitly + (close-port logging-port) + + result)))))) + (set-current-output-port previous-output-port) + (set-current-error-port previous-error-port) + result)) + (define (process-load-new-guix-revision-job id) (with-postgresql-connection (simple-format #f "load-new-guix-revision ~A" id) @@ -1584,47 +1615,23 @@ SKIP LOCKED") (log-time (string-append "loading revision " commit) (lambda () - (let* ((previous-output-port (current-output-port)) - (previous-error-port (current-error-port)) - (result - (with-postgresql-connection - (simple-format #f "load-new-guix-revision ~A logging" id) - (lambda (logging-conn) - (insert-empty-log-entry logging-conn id) - (let ((logging-port - (log-port id logging-conn - #:delete-existing-log-parts? #t))) - (set-current-output-port logging-port) - (set-current-error-port logging-port) - (let ((result - (parameterize ((current-build-output-port logging-port) - (real-error-port previous-error-port) - (inferior-error-port - (setup-port-for-inferior-error-output id previous-error-port))) - (catch #t - (lambda () - (with-store-connection - (lambda (store) - (load-new-guix-revision conn - store - git-repository-id - commit)))) - (lambda (key . args) - (simple-format - (current-error-port) - "error: load-new-guix-revision: ~A ~A\n" - key args) - #f))))) - (combine-log-parts! logging-conn id) - (drop-log-parts-sequence logging-conn id) - - ;; This can happen with GC, so do it explicitly - (close-port logging-port) - - result)))))) - (set-current-output-port previous-output-port) - (set-current-error-port previous-error-port) - result))) + (setup-logging + id + (lambda () + (catch #t + (lambda () + (with-store-connection + (lambda (store) + (load-new-guix-revision conn + store + git-repository-id + commit)))) + (lambda (key . args) + (simple-format + (current-error-port) + "error: load-new-guix-revision: ~A ~A\n" + key args) + #f)))))) #t)) (begin (record-job-succeeded conn id) |