hiro/lack
1
0
Fork 0
mirror of https://github.com/vale981/lack synced 2025-03-05 09:21:39 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Merge pull request #31 from 40ants/uri-scheme-for-request

Browse source 
Now request object has slot uri-scheme, accessible as request-uri-scheme
This commit is contained in:
Eitaro Fukamachi 2018-01-09 18:04:18 +09:00 • committed by GitHub
commit 23c372594b
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
2 changed files with 51 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
src/request.lisp
View file

@ -19,6 +19,7 @@
:request-server-port :request-server-port
:request-server-protocol :request-server-protocol
:request-uri :request-uri
:request-uri-scheme
:request-remote-addr :request-remote-addr
:request-remote-port :request-remote-port
:request-query-string :request-query-string
@ -44,6 +45,7 @@
server-port server-port
server-protocol server-protocol
uri uri
uri-scheme
remote-addr remote-addr
remote-port remote-port
query-string query-string
@ -63,11 +65,14 @@
(defun make-request (env) (defun make-request (env)
(let ((req (apply #'%make-request :env env :allow-other-keys t env))) (let ((req (apply #'%make-request :env env :allow-other-keys t env)))
(with-slots (method uri) req (with-slots (method uri uri-scheme) req
(unless method (unless method
(setf method (getf env :request-method))) (setf method (getf env :request-method)))
(unless uri (unless uri
(setf uri (getf env :request-uri)))) (setf uri (getf env :request-uri)))
(unless uri-scheme
;; for some reason, it is called url-scheme in the environment plist :(
(setf uri-scheme (getf env :url-scheme))))
;; Cookies ;; Cookies
(unless (request-cookies req) (unless (request-cookies req)

69
src/test.lisp
View file

@ -15,36 +15,55 @@
(in-package :lack.test) (in-package :lack.test)
(defun generate-env (uri &key (method :get) content headers cookies) (defun generate-env (uri &key (method :get) content headers cookies)
;; default headers "Creates an ENV plist much like this do all Clack backends.
(setf headers (append '(("host" . "localhost") ("accept" . "*/*")) headers))
(when content Argument `uri' can be just a path or a full url with scheme and optional port."
(let ((content-type (or (cdr (assoc "content-type" headers :test #'string-equal))
(if (find-if #'pathnamep content :key #'cdr) (let* ((uri (quri:uri uri))
"multipart/form-data" (path-with-params (quri:copy-uri uri
"application/x-www-form-urlencoded")))) :host nil
(if (assoc "content-type" headers :test #'string-equal) :port nil
(setf (cdr (assoc "content-type" headers :test #'string-equal)) :scheme nil))
content-type) (host (or (quri:uri-host uri)
(setf headers (append headers `(("content-type" . ,content-type))))))) "localhost"))
(when cookies (port (or (quri:uri-port uri)
(setf headers 80))
(append headers (scheme (or (quri.uri:uri-scheme uri)
`(("cookie" . ,(with-output-to-string (s) "http")))
(format s "~A=~A" (caar cookies) (cdar cookies))
(loop for (k . v) in (cdr cookies) ;; default headers
do (format s "; ~A=~A" k v)))))))) (setf headers (append `(("host" . ,host) ("accept" . "*/*")) headers))
(when content
(setf content (flex:string-to-octets (when content
(quri:url-encode-params content)))) (let ((content-type (or (cdr (assoc "content-type" headers :test #'string-equal))
(let ((uri (quri:uri uri))) (if (find-if #'pathnamep content :key #'cdr)
"multipart/form-data"
"application/x-www-form-urlencoded"))))
(if (assoc "content-type" headers :test #'string-equal)
(setf (cdr (assoc "content-type" headers :test #'string-equal))
content-type)
(setf headers (append headers `(("content-type" . ,content-type)))))))
(when cookies
(setf headers
(append headers
`(("cookie" . ,(with-output-to-string (s)
(format s "~A=~A" (caar cookies) (cdar cookies))
(loop for (k . v) in (cdr cookies)
do (format s "; ~A=~A" k v))))))))
(when content
(setf content (flex:string-to-octets
(quri:url-encode-params content))))
(list :request-method method (list :request-method method
:request-uri (quri:render-uri uri) ;; Seems that all Clack handlers put into this field
;; only pathname with GET parameters
:request-uri (quri:render-uri path-with-params)
:script-name "" :script-name ""
:path-info (quri:uri-path uri) :path-info (quri:uri-path uri)
:query-string (or (quri:uri-query uri) "") :query-string (or (quri:uri-query uri) "")
:server-name "localhost" :server-name host
:server-port 80 :server-port port
:server-protocol :http/1.1 :server-protocol :http/1.1
:url-scheme scheme
:remote-addr "127.0.0.1" :remote-addr "127.0.0.1"
:remote-port 12345 :remote-port 12345
:content-type (cdr (assoc "content-type" headers :test #'string-equal)) :content-type (cdr (assoc "content-type" headers :test #'string-equal))