Use with-postgresql-transaction always in load-new-guix-revision
This commit is contained in:
parent
5d1233ccd0
commit
f7f4e70d28
1 changed files with 85 additions and 84 deletions
|
|
@ -3044,10 +3044,12 @@ 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
|
|
||||||
;; Mimic the behaviour of with-postgresql-transaction
|
|
||||||
((%postgresql-in-transaction? #t))
|
|
||||||
(with-postgresql-connection
|
(with-postgresql-connection
|
||||||
(simple-format #f "load-new-guix-revision ~A" id)
|
(simple-format #f "load-new-guix-revision ~A" id)
|
||||||
(lambda (conn)
|
(lambda (conn)
|
||||||
|
|
@ -3061,8 +3063,27 @@ SKIP LOCKED")
|
||||||
(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
|
(spawn-fiber
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(while (perform-operation
|
(while (perform-operation
|
||||||
|
|
@ -3094,22 +3115,12 @@ SKIP LOCKED")
|
||||||
(lambda (start-event-conn)
|
(lambda (start-event-conn)
|
||||||
(record-job-event start-event-conn id "start")))
|
(record-job-event start-event-conn id "start")))
|
||||||
|
|
||||||
(simple-format #t "Processing job ~A (commit: ~A, source: ~A)\n\n"
|
(simple-format
|
||||||
|
#t "Processing job ~A (commit: ~A, source: ~A)\n\n"
|
||||||
id commit source)
|
id commit source)
|
||||||
|
|
||||||
(if (eq?
|
(with-time-logging
|
||||||
(with-time-logging (string-append "processing revision " commit)
|
(string-append "processing revision " commit)
|
||||||
(with-exception-handler
|
|
||||||
(const #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 ()
|
|
||||||
(load-new-guix-revision
|
(load-new-guix-revision
|
||||||
conn
|
conn
|
||||||
git-repository-id
|
git-repository-id
|
||||||
|
|
@ -3119,24 +3130,14 @@ SKIP LOCKED")
|
||||||
extra-inferior-environment-variables
|
extra-inferior-environment-variables
|
||||||
#:ignore-systems ignore-systems
|
#:ignore-systems ignore-systems
|
||||||
#:ignore-targets ignore-targets
|
#:ignore-targets ignore-targets
|
||||||
#:parallelism parallelism))))
|
#:parallelism parallelism))
|
||||||
#:unwind? #t))
|
|
||||||
#t)
|
|
||||||
(begin
|
|
||||||
(record-job-succeeded conn id)
|
(record-job-succeeded conn id)
|
||||||
(record-job-event conn id "success")
|
(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")
|
(raise-exception
|
||||||
(simple-format #t "job ~A not found to be processed\n"
|
job-not-found-exception))))))))
|
||||||
id)))))))
|
#:unwind? #t))))
|
||||||
|
|
||||||
(when result
|
(when result
|
||||||
(fibers-parallel
|
(fibers-parallel
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue