basic http server

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)))

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"<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"))))

srv/http_utils/__init__.hy

@@ -0,0 +1,2 @@
+(import http-utils.request)
+(import http-utils.response)

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"))))))
+  

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)))

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")

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")))))