diff --git a/srv/content/file_io.hy b/srv/content/file_io.hy new file mode 100644 index 0000000..f0fd2d1 --- /dev/null +++ b/srv/content/file_io.hy @@ -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))) diff --git a/srv/content/router.hy b/srv/content/router.hy new file mode 100644 index 0000000..441b5cf --- /dev/null +++ b/srv/content/router.hy @@ -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"
{(if (and site site-valid?) f"" "")}{(clean name)}{(if (and site site-valid?) "" "")} at {(.strftime now "%Y-%m-%d %H:%M:%S")}:
{(clean comment)}
")) + + (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")))) diff --git a/srv/http_utils/__init__.hy b/srv/http_utils/__init__.hy new file mode 100644 index 0000000..cf128e6 --- /dev/null +++ b/srv/http_utils/__init__.hy @@ -0,0 +1,2 @@ +(import http-utils.request) +(import http-utils.response) diff --git a/srv/http_utils/request.hy b/srv/http_utils/request.hy new file mode 100644 index 0000000..8990275 --- /dev/null +++ b/srv/http_utils/request.hy @@ -0,0 +1,57 @@ +(import hyrule.collections [assoc]) +(require hyrule.control [branch]) +(require hyrule.argmove [doto]) +(require hyrule.collections :readers [s]) +(import urllib.parse [urlsplit unquote-plus parse-qs]) + +(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 ""))) + +(defn parse-data [data] + (setv request {}) + + (setv [head #* body] (.split data b"\r\n\r\n")) + (setv [request-line #* headers] (.split head b"\r\n")) + (setv [http-method route http-version] (.split (.decode request-line "utf-8") " ")) + + (doto request + (assoc :method http-method) + (assoc :route (let + [[_ _ path query _] (urlsplit route)] + (dict + :path (.join "/" + (do + (setv segments []) + (for [segment (.split (unquote-plus path) "/")] + (cond + (!= segment "..") (.append segments segment) + (and segments (!= (get segments -1) "..")) (.pop segments))) + + segments)) + + :parameters (parse-url-encoded query)))) + + (assoc :version http-version) + (assoc :headers (dict + (dfor header + (map (fn [x] + (.split (.decode x "utf-8") ": ")) headers) + (get header 0) + (get header 1)))) + + + (assoc :body (branch (in it (. request (get "headers") (get "Content-Type" ""))) + "application/x-www-form-urlencoded" (parse-url-encoded (.decode (.join b"\n" body) "utf-8")) + "" "" + ;;"multipart/form-data" ;(do + ;; (setv content-type-header (. request (get "headers") (get "Content-Type"))) + ;; (when (in "=" content-type-header) (do + ;; (setv boundary (get (.split content-type-header "=") -1)) + ;; (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")))))) + diff --git a/srv/http_utils/response.hy b/srv/http_utils/response.hy new file mode 100644 index 0000000..5aa705d --- /dev/null +++ b/srv/http_utils/response.hy @@ -0,0 +1,26 @@ +(import hyrule.collections [assoc]) + +(defn send-code [code] + (.encode f"HTTP/1.1 {code}\r\n" "utf-8")) + +(defn send-headers [headers] + (.encode (+ (.join "\r\n" (lfor [k v] (.items headers) f"{k}: {v}")) "\r\n\r\n") "utf-8")) + +(defn send-body [body] + (cond + (isinstance body bytes) body + (isinstance body str) (.encode body "utf-8"))) + +(defn send [[code 200] [headers None] [body ""]] + (when (is headers None) + (setv headers {})) + + (assoc headers "WHAT...-your-trans-gener..." "that is so cool...") + + (when (not-in "Content-Type" headers) + (assoc headers "Content-Type" "text/html")) + + (+ + (send-code code) + (send-headers headers) + (send-body body))) diff --git a/srv/log.hy b/srv/log.hy new file mode 100644 index 0000000..ba03d0f --- /dev/null +++ b/srv/log.hy @@ -0,0 +1,21 @@ +(import logging) + +(setv log (.getLogger logging)) + +(log.setLevel logging.DEBUG) + +(setv formatter (logging.Formatter "%(asctime)s | %(name)s | %(threadName)s | %(levelname)s: %(message)s")) + +(setv file_logger (logging.FileHandler "log")) +(setv stream_logger (logging.StreamHandler)) + +(file_logger.setLevel logging.DEBUG) +(stream_logger.setLevel logging.INFO) + +(file_logger.setFormatter formatter) +(stream_logger.setFormatter formatter) + +(log.addHandler file_logger) +(log.addHandler stream_logger) + +(log.info "log initialized") diff --git a/srv/main.hy b/srv/main.hy new file mode 100644 index 0000000..f013dd2 --- /dev/null +++ b/srv/main.hy @@ -0,0 +1,55 @@ +(import socket [socket AF_INET SOCK_STREAM SOL_SOCKET SO_REUSEADDR]) +(import threading [Thread]) +(import log [log]) +(import traceback [format-exc]) +(import http-utils :as http) +(import content.router [match-request]) + +(require hyrule.control [defmain]) + +(setv [ADDRESS PORT] ["127.0.0.1" 5000]) + +(defmain [] + (let [socket (socket AF_INET SOCK_STREAM)] + (try + (.setsockopt socket SOL_SOCKET SO_REUSEADDR 1) + (.bind socket #(ADDRESS PORT)) + (.listen socket 10) + (.debug log "socket bound") + + (while True + (try + (.start + (Thread + :target (fn [client-socket address] + (try + (setv request-data (bytes)) + (while (setx data (.recv client-socket 1024)) + (+= request-data data) + (when (< (len data) 1024) + (break))) + + (setv parsed-request (http.request.parse-data request-data)) + (.debug log parsed-request) + (.info log (+ (str (cond + (in "X-Real-IP" (. parsed-request (get "headers"))) (. parsed-request (get "headers") (get "X-Real-IP")) + True (get address 0))) f": {(. parsed-request (get "method"))} {(. parsed-request (get "route") (get "path"))}")) + + (setv response (match-request parsed-request)) + (.sendall client-socket (http.response.send #** response)) + + (except [e Exception] + (.warn log (format-exc)) + (.close client-socket)))) + + :args #(#* (socket.accept)))) + + (except [e Exception] + (.warn log (format-exc))))) + + (except [e Exception] + (.critical log (format-exc))) + + (finally + (.close socket) + (.info log "server shut down")))))