cripslock

commit 5102db3391da246c70bb0210aac54777fc703671
parent 04feb1138d79d5408574f0598f7045ecde4ee1d8
Author: Daniel Barlow <dan@telent.net>
Date:   Tue, 22 Jul 2025 18:06:28 +0100

send headers in dispatch fn instead of beforehand

this allows us to send responses with content-type
other than text/html

Diffstat:
M
main.fnl
 | 
19
+++++--------------
M
server.fnl
 | 
19
+++++++++++++------

2 files changed, 18 insertions(+), 20 deletions(-)
diff --git a/main.fnl b/main.fnl
@@ -88,7 +88,6 @@
   )
 
 
-
 (fn dispatch [route stream]
   (let [s { :write #(stream:write_chunk $2) } ]
     (case route.command
@@ -96,6 +95,7 @@
       (let [post (post-index:get route.slug)
             path (. post :full-path)]
         (print :path path)
+        (server.headers stream { })
         (with-open [f (io.open path  )]
           (when f
             (f:seek :set post.body-offset)
@@ -108,9 +108,11 @@
         (stream:write_chunk "" true))
       :sendfile
       (with-open [f (io.open route.pathname :r)]
+        (server.headers stream { :content-type "application/octet-stream" })
         (stream:write_body_from_file f))
       :search
       (do
+        (server.headers stream { })
         (stream:write_chunk "<p><ul>")
         (each [slug post (pairs (post-index:search))]
           (stream:write_chunk
@@ -120,26 +122,15 @@
             (or post.title post.subject))))
         (stream:write_chunk "</ul>" true)))))
 
-(fn response-for-route [headers method stream route]
-  (headers:upsert ":status" :200)
-  (headers:append :content-type "text/html")
-  (assert (stream:write_headers headers (= method :HEAD)))
-  (when (not= method :HEAD)
-    (stream:write_body_from_string
-     (dispatch route stream))))
-
 (fn http-handler [_ stream]
   (let [req-headers (assert (stream:get_headers))
         path (req-headers:get ":path")
         method (req-headers:get ":method")
-        res-headers (server.default-headers)
         route (route-request method path)]
     (server.log-request req-headers stream)
     (if route
-        (response-for-route res-headers method stream route)
-        (do
-          (res-headers:upsert ":status" :404)
-          (assert (stream:write_headers res-headers true))))))
+        (dispatch route stream)
+        (server.headers stream { ":status" :404 } true))))
 
 (fn run []
   (let [myserver (server.new { :onstream http-handler } )]
diff --git a/server.fnl b/server.fnl
@@ -4,11 +4,18 @@
 (local http-version (require :http.version))
 (local ce (require :cqueues.errno))
 
-(fn default-headers []
-  (doto (new-headers)
-    (: :append ":status" nil)
-    (: :append :server (string.format "%s/%s" http-version.name http-version.version))
-    (: :append :date (http-util.imf_date))))
+(local { : view } (require :fennel))
+
+(fn headers [stream more-headers finished?]
+  (let [headers
+        (doto (new-headers)
+          (: :append ":status" "200")
+          (: :append :content-type "text/html")
+          (: :append :server (string.format "%s/%s" http-version.name http-version.version))
+          (: :append :date (http-util.imf_date)))]
+    (each [name value (pairs more-headers)]
+      (headers:upsert name value))
+    (stream:write_headers headers (not (not finished?)))))
 
 (fn new [options]
   (let [defaults
@@ -44,4 +51,4 @@
                           (or (req-headers:get :referer) "-")
                           (or (req-headers:get :user-agent)
                               "-")))))
-{ : new : default-headers : log-request }
+{ : new : headers : log-request }