commit 47867b0c69265a4b21aaac19c042ac2bf23cc967 parent 3eba1eeea34c193050fcac7661d8b4339cfcc337 Author: Daniel Barlow <dan@telent.net> Date: Sun, 20 Jul 2025 18:06:49 +0100 WIP http server Diffstat:
| M | main.fnl | | | 142 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
1 file changed, 142 insertions(+), 0 deletions(-)
diff --git a/main.fnl b/main.fnl @@ -1,6 +1,13 @@ (import-macros { : define-tests : expect : expect= } :assert) (local lfs (require :lfs)) + +(local new-headers (. (require :http.headers) :new)) +(local http-server (require :http.server)) +(local http-util (require :http.util)) +(local http-version (require :http.version)) +(local ce (require :cqueues.errno)) + (local { : view } (require :fennel)) (fn frontmatter [stream] @@ -107,6 +114,141 @@ (tset :path name) (tset :date (and fields.date (parse-timestamp fields.date))))))))))) +(local handlers + [ + #(if (= $1 "/") + { + :command :search + :format :summaries + :filter nil + :order {:date :descending} + :offset 0 + }) + #(case (string.match $1 "/(%d+)/(%d+)/" 1) + (year month) + (let [after (os.time {: year : month :day -2 }) + before (os.time {: year :month (+ month 1) :day 2 })] + { + :command :search + :format :html + :filter {:older before :newer after} + :order {:date :ascending} + :offset 0 + })) + + #(case (string.match $1 "/([%w_]+)$" 1) + slug { :command :show :format :html : slug }) + + ]) + +(fn route-request [path] + (accumulate [matched nil + _ pred (ipairs handlers) + &until matched] + (pred path))) + +(define-tests :route-request + (expect= (route-request "/") + { + :command :search + :format :summaries + :filter nil + :order {:date :descending} + :offset 0 + }) + + (expect= (route-request "/pagename") + { + :command :show + :format :html + :slug "pagename" + }) + + (expect= (route-request "/2004/7/") + { + :command :search + :format :html + :filter {:newer 1088420400 :older 1091444400} + :order {:date :ascending} + :offset 0 + }) + + + ) + +(fn dispatch [route] + (case route.command + :show + "hello this is a post page" + :search + "hello this is a search page" + )) + +(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)))) + +(fn log-request [req-method req-headers stream] + (assert (io.stdout:write + (string.format "[%s] \"%s %s HTTP/%g\" \"%s\" \"%s\"\n" + (os.date "%d/%b/%Y:%H:%M:%S %z") + (or req-method "") + (or (req-headers:get ":path") "") + stream.connection.version + (or (req-headers:get :referer) "-") + (or (req-headers:get :user-agent) + "-"))))) + +(fn reply [myserver stream] + (let [req-headers (assert (stream:get_headers)) + req-method (req-headers:get ":method") + res-headers (new-headers)] + (doto res-headers + (: :append ":status" nil) + (: :append :server (string.format "%s/%s" http-version.name http-version.version)) + (: :append :date (http-util.imf_date))) + + (log-request req-method req-headers stream) + + (let [path (req-headers:get ":path") + route (route-request path)] + (if (and (not= req-method :GET) (not= req-method :HEAD)) + (do + (res-headers:upsert ":status" :405) + (assert (stream:write_headers res-headers true))) + + route + (response-for-route res-headers req-method stream route) + + (do + (res-headers:upsert ":status" :404) + (assert (stream:write_headers res-headers true))))))) + + +(let [myserver + (doto + (http-server.listen + {:host :localhost + :max_concurrent 100 + :onerror (fn [myserver context op err errno] + (let [msg + (.. op " on " + (tostring context) + " failed" + (and err + (.. ": " + (tostring err))))] + (assert (io.stderr:write msg "\n")))) + :onstream reply + :port 3003}) + (: :listen)) + (_family address port) (myserver:localname)] + (print :listening-on address port) + (assert (myserver:loop))) ;; (print (view (index-posts "data/blogs/telent.blog/posts/")))