hiro/lack
1
0
Fork 0
mirror of https://github.com/vale981/lack synced 2025-03-04 17:01:41 -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-protocol
:request-uri
:request-uri-scheme
:request-remote-addr
:request-remote-port
:request-query-string
@ -44,6 +45,7 @@
server-port
server-protocol
uri
uri-scheme
remote-addr
remote-port
query-string
@ -63,11 +65,14 @@
(defun make-request (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
(setf method (getf env :request-method)))
(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
(unless (request-cookies req)

69
src/test.lisp
View file

@ -15,36 +15,55 @@
(in-package :lack.test)
(defun generate-env (uri &key (method :get) content headers cookies)
;; default headers
(setf headers (append '(("host" . "localhost") ("accept" . "*/*")) headers))
(when content
(let ((content-type (or (cdr (assoc "content-type" headers :test #'string-equal))
(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))))
(let ((uri (quri:uri uri)))
"Creates an ENV plist much like this do all Clack backends.
Argument `uri' can be just a path or a full url with scheme and optional port."
(let* ((uri (quri:uri uri))
(path-with-params (quri:copy-uri uri
:host nil
:port nil
:scheme nil))
(host (or (quri:uri-host uri)
"localhost"))
(port (or (quri:uri-port uri)
80))
(scheme (or (quri.uri:uri-scheme uri)
"http")))
;; default headers
(setf headers (append `(("host" . ,host) ("accept" . "*/*")) headers))
(when content
(let ((content-type (or (cdr (assoc "content-type" headers :test #'string-equal))
(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
: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 ""
:path-info (quri:uri-path uri)
:query-string (or (quri:uri-query uri) "")
:server-name "localhost"
:server-port 80
:server-name host
:server-port port
:server-protocol :http/1.1
:url-scheme scheme
:remote-addr "127.0.0.1"
:remote-port 12345
:content-type (cdr (assoc "content-type" headers :test #'string-equal))