Wrap main in a layer of custodian, so we can get debug info on running threads.

Exploit this in a new signal handler, listening for `signals/.dumpinfo`.

src/debug.rkt

@@ -0,0 +1,36 @@
+#lang racket/base
+;; Code for debugging a live server.
+
+(provide debug-information-dump!)
+
+(require "main.rkt")
+(require racket/exn)
+(require racket/tcp)
+(require (only-in racket/string string-join))
+
+(define (format-path path)
+  (string-join (map number->string (reverse path)) "."))
+
+(define (enumerate-custodian-managed-items cust super path)
+  (for [(index (in-naturals))
+        (item (custodian-managed-list cust super))]
+    (eprintf "\nItem ~a.\n~v\n" (format-path (cons index path)) item)
+    (cond
+      [(thread? item)
+       (eprintf "~a" (exn->string (exn "Stack snapshot:" (continuation-marks item))))]
+      [(tcp-port? item)
+       (eprintf "TCP port: (addresses ~v)\n"
+                (call-with-values (lambda () (tcp-addresses item #t)) list))]
+      [(custodian? item)
+       (enumerate-custodian-managed-items item cust (cons index path))]
+      [else (void)])))
+
+(define (debug-information-dump!)
+  (eprintf "===========================================================================\n")
+  (eprintf "======================================================================\n")
+  (eprintf "=================================================================")
+  (collect-garbage)
+  (enumerate-custodian-managed-items (current-custodian) (outermost-custodian) '())
+  (eprintf "=================================================================\n")
+  (eprintf "======================================================================\n")
+  (eprintf "===========================================================================\n"))

src/main-inner.rkt

@@ -0,0 +1,21 @@
+#lang racket/base
+;; Inner startup module - required after establishment of server-wide custodian.
+
+(provide main)
+
+(require reloadable)
+(require "entrypoint.rkt")
+
+(define (main [config (hash)])
+  (make-persistent-state '*config* (lambda () config))
+  (void (make-reloadable-entry-point 'refresh-packages! "packages.rkt"))
+  (void (make-reloadable-entry-point 'rerender! "site.rkt"))
+  (void (make-reloadable-entry-point 'debug-information-dump! "debug.rkt"))
+  (start-service #:port (hash-ref config 'port (lambda ()
+                                                 (let ((port-str (getenv "SITE_PORT")))
+                                                   (if port-str (string->number port-str) 7443))))
+                 #:ssl? (hash-ref config 'ssl? (lambda () #t))
+                 #:reloadable? (hash-ref config 'reloadable? (lambda () (getenv "SITE_RELOADABLE")))
+                 (make-reloadable-entry-point 'request-handler "site.rkt")
+                 (make-reloadable-entry-point 'on-continuation-expiry "site.rkt")
+                 (make-reloadable-entry-point 'extra-files-paths "static.rkt")))

src/main.rkt

@@ -1,19 +1,12 @@
 #lang racket/base
+;; Outer startup module - delegates to main-inner.rkt after installing a custodian
 
-(provide main)
+(provide main
+         outermost-custodian)
 
-(require reloadable)
-(require "entrypoint.rkt")
+(define *outermost-custodian* (current-custodian))
+(define (outermost-custodian) *outermost-custodian*)
 
 (define (main [config (hash)])
-  (make-persistent-state '*config* (lambda () config))
-  (void (make-reloadable-entry-point 'refresh-packages! "packages.rkt"))
-  (void (make-reloadable-entry-point 'rerender! "site.rkt"))
-  (start-service #:port (hash-ref config 'port (lambda ()
-                                                 (let ((port-str (getenv "SITE_PORT")))
-                                                   (if port-str (string->number port-str) 7443))))
-                 #:ssl? (hash-ref config 'ssl? (lambda () #t))
-                 #:reloadable? (hash-ref config 'reloadable? (lambda () (getenv "SITE_RELOADABLE")))
-                 (make-reloadable-entry-point 'request-handler "site.rkt")
-                 (make-reloadable-entry-point 'on-continuation-expiry "site.rkt")
-                 (make-reloadable-entry-point 'extra-files-paths "static.rkt")))
+  (parameterize ((current-custodian (make-custodian (outermost-custodian))))
+    ((dynamic-require "main-inner.rkt" 'main) config)))

src/signals.rkt

@@ -51,5 +51,10 @@
                        (if (eof-object? items-to-rerender)
                            #f
                            items-to-rerender))))
+       (poll-signal "../signals/.dumpinfo"
+                    "Debug information dump request received"
+                    (lambda ()
+                      ((reloadable-entry-point->procedure
+                        (lookup-reloadable-entry-point 'debug-information-dump! "debug.rkt")))))
        (sleep 0.5)
        (loop)))))