basic http server
This commit is contained in:
32
srv/content/file_io.hy
Normal file
32
srv/content/file_io.hy
Normal file
@ -0,0 +1,32 @@
|
||||
(import bleach [clean])
|
||||
(import mimetypes [guess-type])
|
||||
(import subprocess [check-output])
|
||||
(import re [sub])
|
||||
(import os [environ :as hy-env])
|
||||
|
||||
(setv (get hy-env "PATH") (+ (get hy-env "PATH") ":./www/site/scripts"))
|
||||
|
||||
(defn execute-bash [data]
|
||||
(sub r"\$\[(.*?)\]" (fn [sequence]
|
||||
(. (check-output (.group sequence 1) :shell True :executable "/bin/bash" :env hy-env) (decode) (strip)))
|
||||
data))
|
||||
|
||||
(defn parse-html-file [path #** kwargs]
|
||||
(with [f (open path "r")]
|
||||
(setv data (.read f)))
|
||||
|
||||
(for [[k v] (.items kwargs)]
|
||||
(setv data (.replace data f"{"{"}{k}{"}"}" (str v))))
|
||||
|
||||
(execute-bash data))
|
||||
|
||||
(defn send-raw-file [path]
|
||||
(setv [mime-type _] (guess-type path))
|
||||
|
||||
(when (not mime-type)
|
||||
(setv mime-type "text/plain"))
|
||||
|
||||
(with [f (open path "rb")]
|
||||
(setv data (.read f)))
|
||||
|
||||
(return #({"Content-Type" mime-type "Cache-Control" "max-age=0, stale-while-revalidate=31536000"} data)))
|
109
srv/content/router.hy
Normal file
109
srv/content/router.hy
Normal file
@ -0,0 +1,109 @@
|
||||
(require hyrule.destructure [defn+ setv+])
|
||||
(require hyrule.argmove [doto])
|
||||
(import content.file-io [parse-html-file send-raw-file])
|
||||
(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?])
|
||||
|
||||
(defn error [code message]
|
||||
(return (dict
|
||||
:code code
|
||||
:body (parse-html-file "./www/site/html/error.html"))))
|
||||
|
||||
(defn+ match-request [{method "method" {path "path"} "route" :as request}]
|
||||
(when (.startswith path "/assets/")
|
||||
(when (!= method "GET")
|
||||
(return (error 405 "method not allowed")))
|
||||
|
||||
(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))
|
||||
(return (dict
|
||||
:code 200
|
||||
:body (parse-html-file f"./www/site/html{path}")))))
|
||||
|
||||
(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)))
|
||||
|
||||
(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 "/comment")
|
||||
(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>"))
|
||||
|
||||
(return (dict
|
||||
:code 301
|
||||
:headers {"Location" (. request (get "headers") (get "Referer"))})))
|
||||
|
||||
(= method "GET") (error 405 "method not allowed")))
|
||||
|
||||
(return (dict
|
||||
:code 404
|
||||
:body (parse-html-file "./www/site/html/error.html" :code 404 :message f"{path} not found"))))
|
Reference in New Issue
Block a user