diff options
| author | Christopher Baines <mail@cbaines.net> | 2019-05-01 09:24:38 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2019-05-01 09:26:03 +0100 |
| commit | a171287f27c62b57cdb6dbc3dafa0a082cad8831 (patch) | |
| tree | 57b1cf49aa3bc09e56daa6efaa638739da3ece5d | |
| parent | 24f234f6d8d0b5bf90989cc1ae208f75956f2cc1 (diff) | |
| download | data-service-a171287f27c62b57cdb6dbc3dafa0a082cad8831.tar data-service-a171287f27c62b57cdb6dbc3dafa0a082cad8831.tar.gz | |
Try harder to handle errors when loading new revisions
If the repl enters a bad state, attempt to exit, and catch failures in the
parent process, and rollback the open transaction.
| -rw-r--r-- | guix-data-service/jobs/load-new-guix-revision.scm | 58 |
1 files changed, 41 insertions, 17 deletions
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index 4218849..95c2554 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -109,12 +109,27 @@ supported-systems (list ,@(map car system-target-pairs)))) '()))) - (lambda args - (simple-format (current-error-port) - "error: while processing ~A ignoring error: ~A\n" - (package-name package) - args) - '())))) + (lambda (key . args) + (if (and (eq? key 'system-error) + (eq? (car args) 'fport_write)) + (begin + (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))))) (append-map @@ -346,20 +361,29 @@ (inferior-eval '(%graft? #f) inf) (exec-query conn "BEGIN") - (let ((package-derivation-ids - (inferior-guix->package-derivation-ids store conn inf)) - (guix-revision-id - (insert-guix-revision conn url commit store-path))) + (catch + #t + (lambda () + (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 - guix-revision-id - package-derivation-ids) + (insert-guix-revision-package-derivations conn + guix-revision-id + package-derivation-ids) - (exec-query conn "COMMIT") + (exec-query conn "COMMIT") - (simple-format - #t "Successfully loaded ~A package/derivation pairs\n" - (length package-derivation-ids))))) + (simple-format + #t "Successfully loaded ~A package/derivation pairs\n" + (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) (if (guix-revision-exists? conn url commit) |