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

Try harder to handle errors when loading new revisions

Browse source 
If the repl enters a bad state, attempt to exit, and catch failures in the
parent process, and rollback the open transaction.
This commit is contained in:
Christopher Baines 2019-05-01 09:24:38 +01:00
parent 24f234f6d8
commit a171287f27
1 changed files with 41 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -109,12 +109,27 @@
supported-systems supported-systems
(list ,@(map car system-target-pairs)))) (list ,@(map car system-target-pairs))))
'()))) '())))
(lambda args (lambda (key . args)
(simple-format (current-error-port) (if (and (eq? key 'system-error)
"error: while processing ~A ignoring error: ~A\n" (eq? (car args) 'fport_write))
(package-name package) (begin
args) (simple-format
'())))) (current-error-port)
"error: while processing ~A, exiting: ~A: ~A\n"
(package-name package)
key
args)
(force-output)
(exit 1))
(begin
(simple-format
(current-error-port)
"error: while processing ~A ignoring error: ~A: ~A\n"
(package-name package)
key
args)
(force-output)
'()))))))
(list ,@(map inferior-package-id packages))))) (list ,@(map inferior-package-id packages)))))
(append-map (append-map
@ -346,20 +361,29 @@
(inferior-eval '(%graft? #f) inf) (inferior-eval '(%graft? #f) inf)
(exec-query conn "BEGIN") (exec-query conn "BEGIN")
(let ((package-derivation-ids (catch
(inferior-guix->package-derivation-ids store conn inf)) #t
(guix-revision-id (lambda ()
(insert-guix-revision conn url commit store-path))) (let ((package-derivation-ids
(inferior-guix->package-derivation-ids store conn inf))
(guix-revision-id
(insert-guix-revision conn url commit store-path)))
(insert-guix-revision-package-derivations conn (insert-guix-revision-package-derivations conn
guix-revision-id guix-revision-id
package-derivation-ids) package-derivation-ids)
(exec-query conn "COMMIT") (exec-query conn "COMMIT")
(simple-format (simple-format
#t "Successfully loaded ~A package/derivation pairs\n" #t "Successfully loaded ~A package/derivation pairs\n"
(length package-derivation-ids))))) (length package-derivation-ids))))
(lambda (key . args)
(simple-format (current-error-port)
"Failed extracting information: ~A ~A\n"
key args)
(force-output)
(exec-query conn "ROLLBACK")))))
(define (load-new-guix-revision conn url commit) (define (load-new-guix-revision conn url commit)
(if (guix-revision-exists? conn url commit) (if (guix-revision-exists? conn url commit)