diff options
| author | Christopher Baines <mail@cbaines.net> | 2024-05-13 17:30:19 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2024-05-13 17:30:19 +0100 |
| commit | 89fa440848a2e126c4be8d8632cf438b3a4b31a2 (patch) | |
| tree | a2574cc1a7a5bd22748e3f6cd3f1cc8e5d4eb75d | |
| parent | c592c83cccdc4c33de5bf7557137a2ecaa7b3576 (diff) | |
| download | nar-herder-89fa440848a2e126c4be8d8632cf438b3a4b31a2.tar nar-herder-89fa440848a2e126c4be8d8632cf438b3a4b31a2.tar.gz | |
Show backtraces for exceptions in the recent change listener
| -rw-r--r-- | nar-herder/recent-changes.scm | 60 |
1 files changed, 32 insertions, 28 deletions
diff --git a/nar-herder/recent-changes.scm b/nar-herder/recent-changes.scm index ccfff93..8ef5437 100644 --- a/nar-herder/recent-changes.scm +++ b/nar-herder/recent-changes.scm @@ -137,35 +137,39 @@ (log-msg 'ERROR "exception in recent change listener " exn) #f) (lambda () - (let* ((recent-changes - (database-select-recent-changes database after)) - (unprocessed-recent-changes - (remove + (with-throw-handler #t + (lambda () + (let* ((recent-changes + (database-select-recent-changes database after)) + (unprocessed-recent-changes + (remove + (lambda (change-details) + (member change-details last-processed-recent-changes)) + recent-changes))) + + (unless (null? unprocessed-recent-changes) + (log-msg 'INFO "processing " (length unprocessed-recent-changes) + " recent changes") + + (metric-increment recent-changes-count-metric + #:by (length unprocessed-recent-changes)) + + (for-each (lambda (change-details) - (member change-details last-processed-recent-changes)) - recent-changes))) - - (unless (null? unprocessed-recent-changes) - (log-msg 'INFO "processing " (length unprocessed-recent-changes) - " recent changes") - - (metric-increment recent-changes-count-metric - #:by (length unprocessed-recent-changes)) - - (for-each - (lambda (change-details) - (let ((change (assq-ref change-details 'change))) - (cond - ((string=? change "addition") - (process-addition-change change-details)) - ((string=? change "removal") - (process-removal-change change-details)) - (else #f)))) - unprocessed-recent-changes)) - - ;; Use the unprocessed recent changes here to carry - ;; forward all processed changes to the next pass - unprocessed-recent-changes)) + (let ((change (assq-ref change-details 'change))) + (cond + ((string=? change "addition") + (process-addition-change change-details)) + ((string=? change "removal") + (process-removal-change change-details)) + (else #f)))) + unprocessed-recent-changes)) + + ;; Use the unprocessed recent changes here to carry + ;; forward all processed changes to the next pass + unprocessed-recent-changes)) + (lambda _ + (backtrace)))) #:unwind? #t) (#f (loop after '())) (recent-changes |