From b38ff0788e83c0364b6d6aca2b7acc50cd61dcfc Mon Sep 17 00:00:00 2001
From: "Jakob L. Kreuze" <zerodaysfordays@sdf.org>
Date: Sun, 21 Jul 2024 14:08:42 -0400
Subject: [dynamic] Improve error logging/reporting

---
 api.scm | 25 ++++++++++++++++++++++++-
 1 file changed, 24 insertions(+), 1 deletion(-)

(limited to 'api.scm')

diff --git a/api.scm b/api.scm
index 1e71064..fdc70ee 100644
--- a/api.scm
+++ b/api.scm
@@ -30,6 +30,7 @@
              (rnrs conditions)
              (rnrs exceptions)
              (srfi srfi-1)
+             (srfi srfi-19)
              (web request)
              (web response)
              (web server)
@@ -59,6 +60,20 @@
         (panic "This API is only available on the clearnet." #:code 403)
         (handler request body))))
 
+(define (dump-error request body endpoint)
+  (define file-name (date->string (current-date) "jakob-api-crash-report-~4.txt"))
+  (log-append! 'error (format #f "Unhandled error! Crash report written to ~a" file-name))
+  (call-with-output-file file-name
+    (lambda (port)
+      (format port "Error caused by endpoint `~a'~%~%" endpoint)
+      (format port "Full dump of `request':")
+      (write request port)
+      (format port "~%~%")
+      (format port "Full dump of `body':")
+      (write body port)
+      (format port "~%~%")
+      (display-backtrace (make-stack #t) port))))
+
 (define (handle-api-request request body endpoint)
   "Route handler for the API server."
   (let ((method (request-method request))
@@ -71,7 +86,15 @@
     ;; returning multiple values from a `guard' clause.
     (apply values
       (guard (ex ((reportable-condition? ex)
-                  (values->list (format-error-response ex))))
+                  (values->list (format-error-response ex)))
+                 ((equal? "application/json" (assoc-ref (request-headers request) 'accept))
+                  (dump-error request body endpoint)
+                  (list (build-response #:code 500)
+                        (scm->json-string
+                         '((success . #f) (error . "Internal error.")))))
+                 (#t
+                  (dump-error request body endpoint)
+                  (list (build-response #:code 500) "Internal server error.")))
         (fail-when-ip-blacklisted originating-ip)
         (values->list
          (((if (%debug-enabled) identity rate-limit-wrap)
-- 
cgit v1.3