commit 716a88e1e80ed8c5673d3588108d05e7e2d27c20
parent 6c6504e9313ac0d19cca34338ebb6f05910dcaee
Author: Tomas Hlavaty <tom@logand.com>
Date: Sun, 10 Jan 2016 20:12:59 +0100
better proxy
Diffstat:
| M | demo-webserver.lisp | | | 44 | ++++++++++++++++++++++++++++++++------------ |
| M | http.lisp | | | 88 | ++++++++++++++++++++++++++++++++++++++++++++++++++----------------------------- |
2 files changed, 88 insertions(+), 44 deletions(-)
diff --git a/demo-webserver.lisp b/demo-webserver.lisp
@@ -99,18 +99,38 @@
(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)))))))
+ (with-open-stream (s (rw.socket:make-tcp-client-socket host port))
+ (multiple-value-bind (protocol code message headers2 body)
+ ;; TODO forward upload body
+ (rw.http::%client1 s host port method protocol query nil ;;TODO split into path query-string
+ (update-headers headers
+ `(("Host" . ,host))))
+ (declare (ignore protocol))
+ ;;(print (list :@@@ headers2))
+ (list
+ :http-1.0
+ :code code
+ :message message
+ :headers (flet ((allow (k)
+ (let ((x (find k headers2
+ :test #'equalp :key #'car)))
+ (when x
+ (list x)))))
+ (append
+ '(("Connection" . "close"))
+ ;;(allow "Cache-Control")
+ (allow "Content-Disposition")
+ (allow "Content-Length")
+ (allow "Content-Type")
+ ;;(allow "Last-Modified")
+ (allow "Location")
+ (allow "Set-Cookie")))
+ :body body))))
'(:http-1.0
- :code 200
+ :code #1=502
:headers (("Connection" . "close")
("Content-Type" . "text/plain;charset=UTF-8"))
- :body "TODO SERVE-PROXY")))
+ :body #.(format nil "~a ~a" #1# (cdr (assoc #1# rw.http:*http-codes*))))))
(defun serve-not-found ()
'(:http-1.0
@@ -129,7 +149,7 @@
(rw:next-z0 r)))))
(defun webserver-handler (msg stream method query protocol headers &optional body)
- (declare (ignore stream #+nil protocol #+nil body))
+ (declare (ignore stream protocol #+nil body))
(ecase msg
;;(:read (rw:till (rw:peek-reader stream)))
(:write
@@ -140,8 +160,8 @@
#+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))
+ (assert (not body))
+ (serve-proxy "ondoc.logand.com" 1431 method query :http-1.0 headers body))
;; TODO ?rewrite ondoc.logand.com$ -> http://ondoc.logand.com/$1
((or (not host)
(equalp "logand.com" host)
diff --git a/http.lisp b/http.lisp
@@ -196,18 +196,38 @@
(next-eol reader)))
(defun next-body (reader) ;; TODO better, respect content-length!
- (coerce (rw:till reader) 'string))
+ (coerce (rw:till reader) '(vector (unsigned-byte 8))))
(defun write-crlf (writer)
(rw:write-octets writer '(13 10)))
-(defun write-headers (writer headers)
- (dolist (x headers)
- (rw:write-utf8-string writer (car x))
+(defun write-header (writer k v)
+ (when v
+ (rw:write-utf8-string writer k)
(rw:write-octets writer #.(rw.string:string-to-octets ": " :utf-8))
- (rw:write-utf8-string writer (cdr x))
+ (etypecase v
+ (string (rw:write-utf8-string writer v))
+ (integer (rw:write-utf8-string writer (princ-to-string v)))
+ (cons
+ (loop
+ for part in v
+ for i from 0
+ do (progn
+ (when (plusp i)
+ (rw:write-octets writer #.(rw.string:string-to-octets ";" :utf-8)))
+ (etypecase part
+ (string (rw:write-utf8-string writer part))
+ (cons
+ (rw:write-utf8-string writer (car part))
+ (when (cdr part)
+ (rw:write-octets writer #.(rw.string:string-to-octets "=" :utf-8))
+ (rw:write-utf8-string writer (cdr part)))))))))
(write-crlf writer)))
+(defun write-headers (writer headers)
+ (dolist (x headers)
+ (write-header writer (car x) (cdr x))))
+
(defun write-protocol (writer protocol)
(rw:write-octets
writer
@@ -215,32 +235,35 @@
(:http-1.0 #.(rw.string:string-to-octets "HTTP/1.0" :utf-8))
(:http-1.1 #.(rw.string:string-to-octets "HTTP/1.1" :utf-8)))))
-(defun write-query (stream method protocol path query-string)
- (write-string (ecase method
- (:get "GET")
- (:post "POST"))
- stream)
- (write-char #\space stream)
- (write-string (or path "/") stream)
+(defun write-query (writer method protocol path query-string)
+ (rw:write-utf8-string writer (ecase method
+ (:get "GET")
+ (:head "HEAD")
+ (:post "POST")
+ (:put "PUT")))
+ (rw:write-utf8-char writer #\space)
+ (rw:write-utf8-string writer (or path "/"))
(when query-string
- (write-char #\? stream)
- (write-string query-string stream))
- (write-char #\space stream)
- (write-protocol stream protocol)
- (write-crlf stream))
-
-(defun %client1 (stream host port path query-string headers)
- (write-query stream :get :http-1.0 path query-string)
- (write-headers (or headers
- `(("Host" . ,(if port
- (format nil "~a:~a" host port)
- host))))
- stream)
- (write-crlf stream)
+ (rw:write-utf8-char writer #\?)
+ (rw:write-utf8-string writer query-string))
+ (rw:write-utf8-char writer #\space)
+ (write-protocol writer protocol)
+ (write-crlf writer))
+
+(defun %client1 (stream host port method protocol path query-string headers)
+ (let ((w (rw:byte-writer stream)))
+ (write-query w method protocol path query-string)
+ (write-headers w (or headers
+ `(("Host" . ,(if port
+ (format nil "~a:~a" host port)
+ host)))))
+ (write-crlf w))
(finish-output stream)
- (let ((r (rw:peek-reader (rw:char-reader stream))))
- (multiple-value-bind (protocol code message) (next-status r)
- (values protocol code message (next-headers r) (next-body r)))))
+ (assert (eq :http-1.0 protocol)) ;; TODO chunked encoding with http-1.1
+ (let* ((rb (rw:peek-reader (rw:byte-reader stream)))
+ (rc (rw:peek-reader (rw:utf8-reader rb :charp t))))
+ (multiple-value-bind (protocol code message) (next-status rc)
+ (values protocol code message (next-headers rc) (next-body rb)))))
(defun client1 (url headers)
(destructuring-bind (&key scheme host port path query-string fragment)
@@ -250,7 +273,7 @@
(declare (ignore fragment))
(assert (equal "http" scheme))
(with-open-stream (s (rw.socket:make-tcp-client-socket host (or port 80)))
- (%client1 s host port path query-string headers))))
+ (%client1 s host port :get :http-1.0 path query-string headers))))
(defun client (url &key headers (redirect 5))
(do (protocol code message headers2 body)
@@ -261,9 +284,8 @@
(setq url (cdr (assoc "Location" headers2 :test #'equalp))) ;; TODO update "Host" header
(return-from client (values protocol code message headers2 body)))))
-;;(client "http://127.0.0.1:1234/")
+;;(client "http://127.0.0.1:2341")
;;(client "http://logand.com")
-;;(client "http://logand.com:2234")
@@ -382,6 +404,8 @@
(pathname
(with-open-file (s body :element-type '(unsigned-byte 8))
(rw:copy (rw:byte-reader s) writer)))
+ ((vector (unsigned-byte 8))
+ (rw:copy (rw:reader body) writer))
(cons
(rw:write-utf8-string writer
(with-output-to-string (*standard-output*)
