redo server routing; in theory faster under some conditions
This commit is contained in:
43
srv/content/comments.hy
Normal file
43
srv/content/comments.hy
Normal file
@ -0,0 +1,43 @@
|
||||
(import urllib.parse [quote-plus urlparse])
|
||||
(import os [mkdir])
|
||||
(import os.path [isdir :as dir? isfile :as file? abspath])
|
||||
(import datetime [datetime])
|
||||
(import bleach [clean])
|
||||
(import validators [domain :as domain?])
|
||||
(require hyrule.destructure [setv+])
|
||||
|
||||
(defn create-comment [request]
|
||||
(setv now (datetime.now))
|
||||
|
||||
(setv url-comment-dir (quote-plus (. request (get "route") (get "parameters") (get "route")) :safe ""))
|
||||
|
||||
(when (not (dir? "./www/data"))
|
||||
(mkdir "./www/data"))
|
||||
|
||||
(when (not (dir? f"./www/data/comments"))
|
||||
(mkdir "./www/data/comments"))
|
||||
|
||||
(when (not (dir? f"./www/data/comments/{url-comment-dir}"))
|
||||
(mkdir f"./www/data/comments/{url-comment-dir}"))
|
||||
|
||||
(setv+ {{comment "comment" name "name" site "site"} "body"} request)
|
||||
|
||||
(when (.startswith site "//")
|
||||
(setv site (.replace site "//" "")))
|
||||
|
||||
(setv [protocol domain path #* _] (urlparse
|
||||
(if (in "://" site)
|
||||
site
|
||||
(+ "http://" site))))
|
||||
|
||||
(setv site-valid? (= (domain? domain) True))
|
||||
|
||||
(when (not protocol)
|
||||
(setv protocol "//"))
|
||||
|
||||
(with [f (open f"./www/data/comments/{url-comment-dir}/{(.strftime now "%Y-%m-%d_%H:%M:%S_%f")}" "w")]
|
||||
(.write f f"<div class=\"comment\"><span style=\"font-weight: bold\">{(if (and site site-valid?) f"<a href=\"{(clean protocol)}://{(clean domain)}{(clean path)}\">" "")}{(clean name)}{(if (and site site-valid?) "</a>" "")}</span> at {(.strftime now "%Y-%m-%d %H:%M:%S")}:<br><pre>{(clean comment)}</pre></div>"))
|
||||
|
||||
(return (dict
|
||||
:code 303
|
||||
:headers {"Location" (. request (get "headers") (get "Referer"))})))
|
||||
@ -1,12 +1,12 @@
|
||||
(require hyrule.destructure [defn+ setv+])
|
||||
(require hyrule.destructure [defn+])
|
||||
(require hyrule.argmove [doto])
|
||||
(require hyrule.oop [meth])
|
||||
(import hyrule.collections [assoc])
|
||||
(import content.file-io [parse-html-file send-raw-file])
|
||||
(import urllib.parse [quote-plus urlparse])
|
||||
(import os [mkdir])
|
||||
(import content.comments [create-comment])
|
||||
(import re)
|
||||
(import functools [lru-cache])
|
||||
(import os.path [isdir :as dir? isfile :as file? abspath])
|
||||
(import datetime [datetime])
|
||||
(import bleach [clean])
|
||||
(import validators [domain :as domain?])
|
||||
|
||||
(defmacro unless [test #* body]
|
||||
`(when (not ~test) (do ~@body)))
|
||||
@ -14,119 +14,87 @@
|
||||
(defn error [code message]
|
||||
(return (dict
|
||||
:code code
|
||||
:body (parse-html-file "./www/site/html/error.html"))))
|
||||
:body (parse-html-file "./www/site/html/error.html" :code code :message message))))
|
||||
|
||||
(defn+ match-request [{method "method" {path "path"} "route" :as request}]
|
||||
(when (.startswith path "/assets/")
|
||||
(when (!= method "GET")
|
||||
(return (error 405 "method not allowed")))
|
||||
(defclass always []
|
||||
(meth __init__ [@value])
|
||||
(meth __getitem__ [_] @value))
|
||||
|
||||
(setv [headers data] (send-raw-file (+ "./www/site" path)))
|
||||
|
||||
(return (dict
|
||||
:code 200
|
||||
:headers headers
|
||||
:body data)))
|
||||
|
||||
(when (.startswith path "/html/")
|
||||
(when (!= method "GET")
|
||||
(return (error 405 "method not allowed")))
|
||||
|
||||
(when (file? (+ "./www/site/html" path))
|
||||
(unless (= path "/html/view-thought.html")
|
||||
(return (dict
|
||||
:code 200
|
||||
:body (parse-html-file f"./www/site/html{path}"))))
|
||||
|
||||
(return (dict
|
||||
:code 200
|
||||
:body (parse-html-file "./www/site/html/html/view-thought.html" #** (dfor [k v] (.items (. request (get "route") (get "parameters"))) k (quote-plus v)))))))
|
||||
|
||||
(when (= path "/style.css")
|
||||
(when (!= method "GET")
|
||||
(return (error 405 "method not allowed")))
|
||||
|
||||
(setv [headers data] (send-raw-file "./www/site/assets/style.css"))
|
||||
(return (dict
|
||||
:code 200
|
||||
:headers headers
|
||||
:body data)))
|
||||
(defclass method-map []
|
||||
(meth __init__ [] (setv @methods {}))
|
||||
|
||||
(meth __getattr__ [attr]
|
||||
(if (in attr @methods)
|
||||
(get @methods attr)
|
||||
(fn [value] (setv (get @methods attr) value))))
|
||||
|
||||
(when (= path "/robots.txt")
|
||||
(when (!= method "GET")
|
||||
(return (error 405 "method not allowed")))
|
||||
(meth __getitem__ [item]
|
||||
(setv item (.get @methods item None))
|
||||
(if item
|
||||
item
|
||||
(fn [#* _] (error 405 "method not allowed")))))
|
||||
|
||||
(return (dict
|
||||
:code 200
|
||||
:headers {"Content-Type" "text/plain"}
|
||||
:body "user-agent: *\ndisallow: /\n")))
|
||||
|
||||
(when (= path "/")
|
||||
(when (!= method "GET")
|
||||
(return (error 405 "method not allowed")))
|
||||
|
||||
(return (dict
|
||||
:code 200
|
||||
:body (parse-html-file "./www/site/html/home.html" :route "/"))))
|
||||
|
||||
(when (= path "/test.html")
|
||||
(when (!= method "GET")
|
||||
(return (error 405 "method not allowed")))
|
||||
|
||||
(return (dict
|
||||
:code 200
|
||||
:body (parse-html-file "./www/site/html/test.html" :route "/test.html"))))
|
||||
|
||||
(when (= path "/files/natalieee.net.png")
|
||||
(return (dict
|
||||
:code 308
|
||||
:headers {"Location" "/assets/88x31/natalieee.net.png"}
|
||||
:body "")))
|
||||
|
||||
(when (= path "/comment")
|
||||
(defclass router []
|
||||
(meth __init__ []
|
||||
(setv @route-map {})
|
||||
(setv @route-cache {}))
|
||||
|
||||
(meth add-route [route]
|
||||
(when (not-in route @route-map)
|
||||
(setv (get @route-map route) (method-map)))
|
||||
|
||||
(return (get @route-map route)))
|
||||
|
||||
(meth [lru-cache] get-route-by-path [path]
|
||||
(cond
|
||||
(= method "POST") (do
|
||||
(setv now (datetime.now))
|
||||
|
||||
(setv url-comment-dir (quote-plus (. request (get "route") (get "parameters") (get "route")) :safe ""))
|
||||
|
||||
(when (not (dir? "./www/data"))
|
||||
(mkdir "./www/data"))
|
||||
|
||||
(when (not (dir? f"./www/data/comments"))
|
||||
(mkdir "./www/data/comments"))
|
||||
|
||||
(when (not (dir? f"./www/data/comments/{url-comment-dir}"))
|
||||
(mkdir f"./www/data/comments/{url-comment-dir}"))
|
||||
|
||||
(setv+ {{comment "comment" name "name" site "site"} "body"} request)
|
||||
|
||||
(when (.startswith site "//")
|
||||
(setv site (.replace site "//" "")))
|
||||
|
||||
(setv [protocol domain path #* _] (urlparse
|
||||
(if (in "://" site)
|
||||
site
|
||||
(+ "http://" site))))
|
||||
|
||||
(setv site-valid? (= (domain? domain) True))
|
||||
|
||||
(when (not protocol)
|
||||
(setv protocol "//"))
|
||||
|
||||
(print protocol domain path site-valid?)
|
||||
|
||||
|
||||
(with [f (open f"./www/data/comments/{url-comment-dir}/{(.strftime now "%Y-%m-%d_%H:%M:%S_%f")}" "w")]
|
||||
(.write f f"<div class=\"comment\"><span style=\"font-weight: bold\">{(if (and site site-valid?) f"<a href=\"{(clean protocol)}://{(clean domain)}{(clean path)}\">" "")}{(clean name)}{(if (and site site-valid?) "</a>" "")}</span> at {(.strftime now "%Y-%m-%d %H:%M:%S")}:<br><pre>{(clean comment)}</pre></div>"))
|
||||
(in path @route-map) (do (get @route-map path))
|
||||
True (do
|
||||
(while (> (.count path "/") 1)
|
||||
(setv path (.join "/" (get (.split path "/") (slice 0 -1))))
|
||||
(when (in (+ path "/*") @route-map)
|
||||
(setv handler (get @route-map (+ path "/*")))
|
||||
(return handler)))
|
||||
|
||||
(return (dict
|
||||
:code 303
|
||||
:headers {"Location" (. request (get "headers") (get "Referer"))})))
|
||||
(always (fn [#* _] (error 404 "not-found)")))))))
|
||||
|
||||
(= method "GET") (error 405 "method not allowed")))
|
||||
(setv routes (router))
|
||||
|
||||
(return (dict
|
||||
:code 404
|
||||
:body (parse-html-file "./www/site/html/error.html" :code 404 :message f"{path} not found"))))
|
||||
(defmacro route [route method]
|
||||
`(. (routes.add-route ~route) ~(hy.models.Symbol method)))
|
||||
|
||||
(defreader route-args
|
||||
(.slurp-space &reader)
|
||||
(if (= (.peekc &reader) "[")
|
||||
`[method path request ~@(.parse-one-form &reader)]
|
||||
'[method path request]))
|
||||
|
||||
(defn if-file-exists [* base-path otherwise]
|
||||
(fn [f]
|
||||
(fn [method path request]
|
||||
(if (file? f"{base-path}{path}")
|
||||
(f method path request)
|
||||
otherwise))))
|
||||
|
||||
(defn forward-params [#* params]
|
||||
(fn [f]
|
||||
(fn [method path request]
|
||||
(f method path request #** (dict (lfor param params
|
||||
:if (setx value (. request (get "route") (get "parameters") (get param None)))
|
||||
#(param value)))))))
|
||||
|
||||
(defn shtml-file-response [file [code 200] [template-params {}]]
|
||||
(dict :code code :body (parse-html-file f"./www/site/html/{file}" #** template-params)))
|
||||
|
||||
(defn raw-file-response [file [code 200]]
|
||||
(dict :code code #** (dict (zip ["headers" "body"] (send-raw-file f"./www/site/{file}")))))
|
||||
|
||||
(defn [(route "/" "GET")] /home #route-args (shtml-file-response "home.html"))
|
||||
(defn [(route "/html/*" "GET") (if-file-exists :base-path "./www/site/html" :otherwise (error 404 "not found"))] /html/* #route-args (shtml-file-response path))
|
||||
(defn [(route "/assets/*" "GET") (if-file-exists :base-path "./www/site/" :otherwise (error 404 "not found"))] /assets/* #route-args (raw-file-response path))
|
||||
(defn [(route "/html/view-thought.html" "GET") (forward-params "thought" "filter-tag")] /html/view-thought #route-args [#** template-args] (shtml-file-response "/html/view-thought.html" :template-params template-args))
|
||||
(defn [(route "/comment" "POST")] /comments #route-args (create-comment request))
|
||||
(defn [(route "/robots.txt" "GET") ] /robots #route-args (dict :code 200 :headers {"Content-Type" "text/plain"} :body "User-agent *\nDisallow: /\n"))
|
||||
|
||||
(defn+ [lru-cache] match-request [{method "method" {path "path"} "route" :as request}]
|
||||
((get (routes.get-route-by-path path) method) method path request))
|
||||
|
||||
|
||||
@ -2,17 +2,27 @@
|
||||
(require hyrule.control [branch])
|
||||
(require hyrule.argmove [doto])
|
||||
(require hyrule.collections :readers [s])
|
||||
(require hyrule.oop [meth])
|
||||
(import urllib.parse [urlsplit unquote-plus parse-qs])
|
||||
|
||||
(defclass hashable-dict [dict]
|
||||
;; this is ok because requests are never mutated after being built.
|
||||
(meth __key []
|
||||
(tuple (sorted (@items))))
|
||||
|
||||
(meth __hash__ []
|
||||
(hash (@__key))))
|
||||
|
||||
(defn parse-url-encoded [query]
|
||||
(dfor pair (.items (parse-qs (unquote-plus query) :keep-blank-values True))
|
||||
(get pair 0)
|
||||
(cond
|
||||
(get pair 1 0) (get pair 1 0)
|
||||
True "")))
|
||||
(hashable-dict
|
||||
(dfor pair (.items (parse-qs (unquote-plus query) :keep-blank-values True))
|
||||
(get pair 0)
|
||||
(cond
|
||||
(get pair 1 0) (get pair 1 0)
|
||||
True ""))))
|
||||
|
||||
(defn parse-data [data]
|
||||
(setv request {})
|
||||
(setv request (hashable-dict))
|
||||
|
||||
(setv [head #* body] (.split data b"\r\n\r\n"))
|
||||
(setv [request-line #* headers] (.split head b"\r\n"))
|
||||
@ -22,7 +32,7 @@
|
||||
(assoc "method" http-method)
|
||||
(assoc "route" (let
|
||||
[[_ _ path query _] (urlsplit route)]
|
||||
(dict
|
||||
(hashable-dict
|
||||
:path (.join "/"
|
||||
(do
|
||||
(setv segments [])
|
||||
@ -36,7 +46,7 @@
|
||||
:parameters (parse-url-encoded query))))
|
||||
|
||||
(assoc "version" http-version)
|
||||
(assoc "headers" (dict
|
||||
(assoc "headers" (hashable-dict
|
||||
(dfor header
|
||||
(map (fn [x]
|
||||
(.split (.decode x "utf-8") ": ")) headers)
|
||||
@ -54,4 +64,4 @@
|
||||
;; (print "boundary" boundary)
|
||||
;; (print (.split (.join b"\n" body) (.encode boundary "utf-8"))))))
|
||||
else (raise (NotImplementedError f"{(get (.split (. request (get "headers") (get "Content-Type")) ";") 0)} parsing is TODO"))))))
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user