cl-rw

Layered streams for Common Lisp
git clone https://logand.com/git/cl-rw.git/
Log | Files | Refs

commit 6c6504e9313ac0d19cca34338ebb6f05910dcaee
parent 6be18fd8a742c248248813b3b6dd425e5282e987
Author: Tomas Hlavaty <tom@logand.com>
Date:   Thu, 24 Dec 2015 18:53:46 +0100

prepare serve-proxy

Diffstat:
Mdemo-webserver.lisp | 89++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---------------
1 file changed, 73 insertions(+), 16 deletions(-)

diff --git a/demo-webserver.lisp b/demo-webserver.lisp @@ -77,26 +77,83 @@ (or (cdr (assoc (pathname-type pathname) rw.http:*mime-types* :test #'equalp)) rw.http:*default-mime-type*)) +(defun serve-file (method query) + (when (member method '(:get :head)) + (let ((f (or (query-file query "index" "html") + #+nil(query-file query "index" "htm") + #+nil(query-file query "README" nil)))) + (when f + `(:http-1.0 + :code 200 + :headers (("Connection" . "close") + ("Content-Type" . ,(content-type f))) + :body ,(and (eq :get method) f)))))) + +(defun update-headers (old new) + (loop + for x in old + collect (let ((v (cdr (assoc (car x) new :test #'equalp)))) + (if v + (cons (car x) v) + x)))) + +(defun serve-proxy (host port method query protocol headers body) + (or (ignore-errors + (let ((host "ondoc.logand.com") + (port 80)) + (with-open-stream (s (rw.socket:make-tcp-client-socket host port)) + #+nil + (rw.http::%client1 s host port query #+nil path query-string + (update-headers headers + `(("Host" . ,host))))))) + '(:http-1.0 + :code 200 + :headers (("Connection" . "close") + ("Content-Type" . "text/plain;charset=UTF-8")) + :body "TODO SERVE-PROXY"))) + +(defun serve-not-found () + '(:http-1.0 + :code 404 + :headers (("Connection" . "close") + ("Content-Type" . "text/plain;charset=UTF-8")) + :body "404 Not Found")) + +(defun parse-host-header (v) + (let ((r (rw:peek-reader (rw:reader v)))) + (values (let ((x (rw:till r '(#\:)))) + (when x + (coerce x 'string))) + (progn + (rw:next r) + (rw:next-z0 r))))) + (defun webserver-handler (msg stream method query protocol headers &optional body) - (declare (ignore stream protocol headers body)) + (declare (ignore stream #+nil protocol #+nil body)) (ecase msg ;;(:read (rw:till (rw:peek-reader stream))) (:write - (or (when (member method '(:get :head)) - (let ((f (or (query-file query "index" "html") - #+nil(query-file query "index" "htm") - #+nil(query-file query "README" nil)))) - (when f - `(:http-1.0 - :code 200 - :headers (("Connection" . "close") - ("Content-Type" . ,(content-type f))) - :body ,(and (eq :get method) f))))) - '(:http-1.0 - :code 404 - :headers (("Connection" . "close") - ("Content-Type" . "text/plain;charset=UTF-8")) - :body "404 Not Found"))))) + (or (multiple-value-bind (host port) + (parse-host-header (cdr (assoc "Host" headers :test #'equalp))) + (cond + ((or (equalp "ondoc.logand.com" host) + #+nil(equalp "127.0.0.1" host)) + ;; proxy_set_header Host $host; + ;; proxy_set_header Gate "$scheme $remote_addr"; + ;; proxy_pass http://127.0.0.1:1431; + (serve-proxy host port method query protocol headers body)) + ;; TODO ?rewrite ondoc.logand.com$ -> http://ondoc.logand.com/$1 + ((or (not host) + (equalp "logand.com" host) + (equalp "82.192.70.8" host) + (equalp "localhost" host) + (equalp "127.0.0.1" host)) + ;; TODO redirect ^/pico[wW]iki/ -> http://logand.com/picowiki.html + ;; TODO serve-file-or-directory + (serve-file method query)) + ;; TODO ?rewrite .logand.com$ -> http://logand.com/$1 + )) + (serve-not-found))))) (defun start () (rw.http:server (rw.socket:make-ipv4-address "0.0.0.0")