cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Use with-postgresql-transaction always in load-new-guix-revision

Browse source
This commit is contained in:
Christopher Baines 2025-06-25 12:46:37 +02:00
parent 5d1233ccd0
commit f7f4e70d28
1 changed files with 85 additions and 84 deletions
Download patch file Download diff file Expand all files Collapse all files

169
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -3044,99 +3044,100 @@ SKIP LOCKED")
(define finished-channel (define finished-channel
(make-channel)) (make-channel))
(define job-not-found-exception
(make-exception-with-message
(simple-format #f "job ~A not found to be processed\n"
id)))
(define result (define result
(parameterize (with-postgresql-connection
;; Mimic the behaviour of with-postgresql-transaction (simple-format #f "load-new-guix-revision ~A" id)
((%postgresql-in-transaction? #t)) (lambda (conn)
(with-postgresql-connection ;; Fix the hash encoding of derivation_output_details. This'll only run
(simple-format #f "load-new-guix-revision ~A" id) ;; once on any given database, but is kept here just to make sure any
(lambda (conn) ;; instances have the data updated.
;; Fix the hash encoding of derivation_output_details. This'll only run (fix-derivation-output-details-hash-encoding conn)
;; once on any given database, but is kept here just to make sure any
;; instances have the data updated.
(fix-derivation-output-details-hash-encoding conn)
(add-hook! after-gc-hook (add-hook! after-gc-hook
(lambda () (lambda ()
(simple-format (current-error-port) (simple-format (current-error-port)
"after gc\n"))) "after gc\n")))
(exec-query conn "BEGIN") (with-exception-handler
(lambda (exn)
(unless (eq? job-not-found-exception)
;; Use a new connection in case the outer conn is unusable
(with-postgresql-connection
(simple-format #f "load-new-guix-revision ~A record failure" id)
(lambda (conn)
(record-job-event conn id "failure"))))
#f)
(lambda ()
(with-exception-handler
(lambda (exn)
(simple-format (current-error-port)
"error: load-new-guix-revision: ~A\n"
exn)
(print-backtrace-and-exception/knots exn)
(raise-exception exn))
(lambda ()
(with-postgresql-transaction
conn
(lambda (conn)
(spawn-fiber
(lambda ()
(while (perform-operation
(choice-operation
(wrap-operation (get-operation finished-channel)
(const #f))
(wrap-operation (sleep-operation 20)
(const #t))))
(spawn-fiber (let ((stats (gc-stats)))
(lambda () (simple-format
(while (perform-operation (current-error-port)
(choice-operation "process-job heap: ~a MiB used (~a MiB heap)~%"
(wrap-operation (get-operation finished-channel) (round
(const #f)) (/ (- (assoc-ref stats 'heap-size)
(wrap-operation (sleep-operation 20) (assoc-ref stats 'heap-free-size))
(const #t)))) (expt 2. 20)))
(round
(/ (assoc-ref stats 'heap-size)
(expt 2. 20))))))))
(let ((stats (gc-stats))) (match (select-job-for-update conn id)
(simple-format (((id commit source git-repository-id))
(current-error-port)
"process-job heap: ~a MiB used (~a MiB heap)~%"
(round
(/ (- (assoc-ref stats 'heap-size)
(assoc-ref stats 'heap-free-size))
(expt 2. 20)))
(round
(/ (assoc-ref stats 'heap-size)
(expt 2. 20))))))))
(match (select-job-for-update conn id) ;; With a separate connection, outside of the transaction so the event
(((id commit source git-repository-id)) ;; gets persisted regardless.
(with-postgresql-connection
(simple-format #f "load-new-guix-revision ~A start-event" id)
(lambda (start-event-conn)
(record-job-event start-event-conn id "start")))
;; With a separate connection, outside of the transaction so the event (simple-format
;; gets persisted regardless. #t "Processing job ~A (commit: ~A, source: ~A)\n\n"
(with-postgresql-connection id commit source)
(simple-format #f "load-new-guix-revision ~A start-event" id)
(lambda (start-event-conn)
(record-job-event start-event-conn id "start")))
(simple-format #t "Processing job ~A (commit: ~A, source: ~A)\n\n" (with-time-logging
id commit source) (string-append "processing revision " commit)
(load-new-guix-revision
conn
git-repository-id
commit
#:skip-system-tests? skip-system-tests?
#:extra-inferior-environment-variables
extra-inferior-environment-variables
#:ignore-systems ignore-systems
#:ignore-targets ignore-targets
#:parallelism parallelism))
(if (eq? (record-job-succeeded conn id)
(with-time-logging (string-append "processing revision " commit) (record-job-event conn id "success"))
(with-exception-handler (()
(const #f) (raise-exception
(lambda () job-not-found-exception))))))))
(with-exception-handler #:unwind? #t))))
(lambda (exn)
(simple-format (current-error-port)
"error: load-new-guix-revision: ~A\n"
exn)
(print-backtrace-and-exception/knots exn)
(raise-exception exn))
(lambda ()
(load-new-guix-revision
conn
git-repository-id
commit
#:skip-system-tests? skip-system-tests?
#:extra-inferior-environment-variables
extra-inferior-environment-variables
#:ignore-systems ignore-systems
#:ignore-targets ignore-targets
#:parallelism parallelism))))
#:unwind? #t))
#t)
(begin
(record-job-succeeded conn id)
(record-job-event conn id "success")
(exec-query conn "COMMIT")
#t)
(begin
(exec-query conn "ROLLBACK")
(record-job-event conn id "failure")
#f)))
(()
(exec-query conn "ROLLBACK")
(simple-format #t "job ~A not found to be processed\n"
id)))))))
(when result (when result
(fibers-parallel (fibers-parallel