diff options
| -rw-r--r-- | guix-qa-frontpage/branch.scm | 51 | ||||
| -rw-r--r-- | guix-qa-frontpage/database.scm | 11 | ||||
| -rw-r--r-- | guix-qa-frontpage/issue.scm | 20 | ||||
| -rw-r--r-- | guix-qa-frontpage/manage-builds.scm | 58 | ||||
| -rw-r--r-- | guix-qa-frontpage/manage-patch-branches.scm | 38 | ||||
| -rw-r--r-- | guix-qa-frontpage/reproducible-builds.scm | 20 | ||||
| -rw-r--r-- | guix-qa-frontpage/utils.scm | 10 |
7 files changed, 102 insertions, 106 deletions
diff --git a/guix-qa-frontpage/branch.scm b/guix-qa-frontpage/branch.scm index 6276476..581c98b 100644 --- a/guix-qa-frontpage/branch.scm +++ b/guix-qa-frontpage/branch.scm @@ -32,6 +32,7 @@ #:use-module ((guix build syscalls) #:select (set-thread-name)) #:use-module (fibers) + #:use-module (knots) #:use-module (knots non-blocking) #:use-module (guix-qa-frontpage utils) #:use-module (guix-qa-frontpage mumi) @@ -83,10 +84,13 @@ (with-exception-handler (lambda (exn) - (simple-format #t "exception listing non master branches: ~A\n" exn) `((exception . ,(simple-format #f "~A" exn)))) (lambda () - (with-throw-handler #t + (with-exception-handler + (lambda (exn) + (simple-format #t "exception listing non master branches\n") + (print-backtrace-and-exception/knots exn) + (raise-exception exn)) (lambda () (let* ((merge-issues (merge-issues-by-branch)) @@ -186,10 +190,7 @@ b-blocked-by))) (if (null? ordering-indexes) b-initial-ordering-index - (apply max ordering-indexes))))))))))) - (lambda args - (display (backtrace) (current-error-port)) - (newline (current-error-port))))) + (apply max ordering-indexes))))))))))))) #:unwind? #t)) (define (branch-derivation-changes-data revisions system) @@ -428,15 +429,16 @@ (with-exception-handler (lambda (exn) - (simple-format - (current-error-port) - "failed fetching derivation changes for branch ~A: ~A\n" - branch-name - exn) - #f) (lambda () - (with-throw-handler #t + (with-exception-handler + (lambda (exn) + (simple-format + (current-error-port) + "failed fetching derivation changes for branch ~A\n" + branch-name) + (print-backtrace-and-exception/knots exn) + (raise-exception exn)) (lambda () (let ((revisions derivation-change-counts @@ -456,9 +458,7 @@ (assq-ref substitute-availability 'exception)) (update-branch-substitute-availability-metrics branch-name - substitute-availability)))) - (lambda _ - (backtrace)))) + substitute-availability)))))) #:unwind? #t)) #t) branches)) @@ -481,18 +481,17 @@ (while #t (let ((start-time (current-time))) (with-exception-handler - (lambda (exn) - (simple-format - (current-error-port) - "exception in branch data refresh thread: ~A\n" - exn)) + (lambda _ #f) (lambda () (with-time-logging "refreshing branch data" - (with-throw-handler #t - refresh-data - (lambda args - (display (backtrace) (current-error-port)) - (newline (current-error-port)))))) + (with-exception-handler + (lambda (exn) + (simple-format + (current-error-port) + "exception in branch data refresh thread\n") + (print-backtrace-and-exception/knots exn) + (raise-exception exn)) + refresh-data))) #:unwind? #t) (let ((time-taken diff --git a/guix-qa-frontpage/database.scm b/guix-qa-frontpage/database.scm index 06ce3bd..34c0ce6 100644 --- a/guix-qa-frontpage/database.scm +++ b/guix-qa-frontpage/database.scm @@ -28,6 +28,7 @@ #:use-module (sqlite3) #:use-module (fibers) #:use-module (prometheus) + #:use-module (knots) #:use-module (knots queue) #:use-module (knots thread-pool) #:use-module (guix narinfo) @@ -475,14 +476,14 @@ SELECT data, timestamp FROM cache WHERE key = :key" (call-with-thread (database-reader-thread-set database) (lambda (db) - (with-throw-handler #t + (with-exception-handler + (lambda (exn) + (print-backtrace-and-exception/knots exn) + (raise-exception exn)) (lambda () (call-with-delay-logging proc - #:args args)) - (lambda args - (display (backtrace) (current-error-port)) - (newline (current-error-port))))))) + #:args args)))))) (lambda vals (when (if (procedure? store-computed-value?) (apply store-computed-value? vals) diff --git a/guix-qa-frontpage/issue.scm b/guix-qa-frontpage/issue.scm index beed41f..6a031e1 100644 --- a/guix-qa-frontpage/issue.scm +++ b/guix-qa-frontpage/issue.scm @@ -27,6 +27,7 @@ #:use-module ((guix build syscalls) #:select (set-thread-name)) #:use-module (fibers) + #:use-module (knots) #:use-module (knots non-blocking) #:use-module (knots parallelism) #:use-module (guix-qa-frontpage utils) @@ -411,23 +412,22 @@ (while #t (let ((start-time (current-time))) (with-exception-handler - (lambda (exn) - (simple-format - (current-error-port) - "exception in data refresh thread: ~A\n" - exn)) + (lambda _ #f) (lambda () (with-time-logging "refreshing data" - (with-throw-handler #t + (with-exception-handler + (lambda (exn) + (simple-format + (current-error-port) + "exception in data refresh thread\n") + (print-backtrace-and-exception/knots exn) + (raise-exception exn)) (lambda () (call-with-duration-metric metrics-registry "refresh_patch_branches_data_duration_seconds" refresh-data - #:buckets (list 30 60 120 240 480 960 1920 3840 (inf)))) - (lambda args - (display (backtrace) (current-error-port)) - (newline (current-error-port)))))) + #:buckets (list 30 60 120 240 480 960 1920 3840 (inf))))))) #:unwind? #t) (let ((time-taken diff --git a/guix-qa-frontpage/manage-builds.scm b/guix-qa-frontpage/manage-builds.scm index f461292..3546fcf 100644 --- a/guix-qa-frontpage/manage-builds.scm +++ b/guix-qa-frontpage/manage-builds.scm @@ -7,6 +7,7 @@ #:use-module (ice-9 threads) #:use-module (ice-9 exceptions) #:use-module (fibers) + #:use-module (knots) #:use-module (knots parallelism) #:use-module (knots non-blocking) #:use-module (knots timeout) @@ -218,13 +219,15 @@ (lambda () (while #t (with-exception-handler - (lambda (exn) - (simple-format - (current-error-port) - "exception in submit patch builds fiber: ~A\n" - exn)) + (lambda _ #f) (lambda () - (with-throw-handler #t + (with-exception-handler + (lambda (exn) + (simple-format + (current-error-port) + "exception in submit patch builds fiber\n") + (print-backtrace-and-exception/knots exn) + (raise-exception exn)) (lambda () (let* ((substitute-availability systems-with-low-substitute-availability @@ -242,10 +245,7 @@ "submit_patch_builds_duration_seconds" submit-builds #:buckets (list 30 60 120 240 480 960 1920 3840 (inf))) - (sleep 900)))) - (lambda args - (display (backtrace) (current-error-port)) - (newline (current-error-port))))) + (sleep 900)))))) #:unwind? #t) (simple-format #t "finished submitting patch builds\n") @@ -478,22 +478,21 @@ (lambda () (while #t (with-exception-handler - (lambda (exn) - (simple-format - (current-error-port) - "exception in submit branch builds fiber: ~A\n" - exn)) + (lambda _ #f) (lambda () - (with-throw-handler #t + (with-exception-handler + (lambda (exn) + (simple-format + (current-error-port) + "exception in submit branch builds fiber\n") + (print-backtrace-and-exception/knots exn) + (raise-exception exn)) (lambda () (call-with-duration-metric metrics-registry "submit_branch_builds_duration_seconds" submit-branch-builds - #:buckets (list 30 60 120 240 480 960 1920 3840 (inf)))) - (lambda args - (display (backtrace) (current-error-port)) - (newline (current-error-port))))) + #:buckets (list 30 60 120 240 480 960 1920 3840 (inf)))))) #:unwind? #t) (sleep 3600))))) @@ -914,22 +913,21 @@ (while #t (with-exception-handler - (lambda (exn) - (simple-format - (current-error-port) - "exception in submit system test builds thread: ~A\n" - exn)) + (lambda _ #f) (lambda () - (with-throw-handler #t + (with-exception-handler + (lambda (exn) + (simple-format + (current-error-port) + "exception in submit system test builds thread\n") + (print-backtrace-and-exception/knots exn) + (raise-exception exn)) (lambda () (call-with-duration-metric metrics-registry "submit_master_branch_system_tests_duration_seconds" submit-builds - #:buckets (list 30 60 120 240 480 960 1920 3840 (inf)))) - (lambda args - (display (backtrace) (current-error-port)) - (newline (current-error-port))))) + #:buckets (list 30 60 120 240 480 960 1920 3840 (inf)))))) #:unwind? #t) (sleep 3600))))) diff --git a/guix-qa-frontpage/manage-patch-branches.scm b/guix-qa-frontpage/manage-patch-branches.scm index 7cb9cee..3aec254 100644 --- a/guix-qa-frontpage/manage-patch-branches.scm +++ b/guix-qa-frontpage/manage-patch-branches.scm @@ -19,6 +19,7 @@ #:use-module (guix build utils) #:use-module ((guix build download) #:select (http-fetch)) #:use-module ((guix build utils) #:select (with-directory-excursion)) + #:use-module (knots) #:use-module (knots thread-pool) #:use-module (guix-qa-frontpage mumi) #:use-module (guix-qa-frontpage database) @@ -274,12 +275,6 @@ (lambda (exn) (simple-format (current-error-port) - "exception when creating branch for ~A: ~A\n" - issue-number - exn) - - (simple-format - (current-error-port) "deleting tag and branch for issue\n") (system* "git" "push" "--delete" "patches" (simple-format #f "base-for-issue-~A" issue-number)) @@ -288,11 +283,15 @@ (raise-exception exn)) (lambda () - (with-throw-handler #t - apply-patches - (lambda args - (display (backtrace) (current-error-port)) - (newline (current-error-port))))) + (with-exception-handler + (lambda (exn) + (simple-format + (current-error-port) + "exception when creating branch for ~A\n" + issue-number) + (print-backtrace-and-exception/knots exn) + (raise-exception exn)) + apply-patches)) #:unwind? #t)) #:remove-after? #t)))) @@ -515,22 +514,21 @@ (while #t (with-exception-handler (lambda (exn) - (simple-format - (current-error-port) - "exception in manage patch branches thread: ~A\n" - exn) (unless (thread-pool-timeout-error? exn) (sleep 240))) (lambda () - (with-throw-handler #t + (with-exception-handler + (lambda (exn) + (simple-format + (current-error-port) + "exception in manage patch branches thread\n") + (print-backtrace-and-exception/knots exn) + (raise-exception exn)) (lambda () (call-with-duration-metric metrics-registry "manage_patch_branches_duration_seconds" perform-pass - #:buckets (list 30 60 120 240 480 960 1920 3840 (inf)))) - (lambda args - (display (backtrace) (current-error-port)) - (newline (current-error-port)))) + #:buckets (list 30 60 120 240 480 960 1920 3840 (inf))))) (sleep 3600)) #:unwind? #t))))) diff --git a/guix-qa-frontpage/reproducible-builds.scm b/guix-qa-frontpage/reproducible-builds.scm index 4211627..20ace13 100644 --- a/guix-qa-frontpage/reproducible-builds.scm +++ b/guix-qa-frontpage/reproducible-builds.scm @@ -3,6 +3,7 @@ #:use-module (ice-9 threads) #:use-module (zlib) #:use-module (json) + #:use-module (knots) #:use-module (guix-qa-frontpage guix-data-service) #:export (start-generate-reproducible.json-thread)) @@ -64,17 +65,16 @@ (lambda () (while #t (with-exception-handler - (lambda (exn) - (simple-format - (current-error-port) - "exception in generate reproducible.json fiber: ~A\n" - exn)) + (lambda _ #f) (lambda () - (with-throw-handler #t - generate - (lambda args - (display (backtrace) (current-error-port)) - (newline (current-error-port))))) + (with-exception-handler + (lambda (exn) + (simple-format + (current-error-port) + "exception in generate reproducible.json fiber\n") + (print-backtrace-and-exception/knots exn) + (raise-exception exn)) + generate)) #:unwind? #t) (simple-format #t "finished generating reproducible.json.gz\n") diff --git a/guix-qa-frontpage/utils.scm b/guix-qa-frontpage/utils.scm index 63b741c..71b0131 100644 --- a/guix-qa-frontpage/utils.scm +++ b/guix-qa-frontpage/utils.scm @@ -38,14 +38,14 @@ (lambda (exn) (put-message channel `(exception ,exn))) (lambda () - (with-throw-handler #t + (with-exception-handler + (lambda (exn) + (print-backtrace-and-exception/knots exn) + (raise-exception exn)) (lambda () (call-with-values thunk (lambda values - (put-message channel `(values ,@values))))) - (lambda args - (display (backtrace) (current-error-port)) - (newline (current-error-port))))) + (put-message channel `(values ,@values))))))) #:unwind? #t))))) (match (get-message channel) (('values . results) |