-
-
Notifications
You must be signed in to change notification settings - Fork 33
/
request.lisp
124 lines (110 loc) · 3.66 KB
/
request.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
(in-package :cl-user)
(defpackage lack.request
(:use :cl)
(:import-from :quri
:url-decode-params)
(:import-from :http-body
:parse)
(:import-from :circular-streams
:make-circular-input-stream)
(:import-from :cl-ppcre
:split)
(:export :request
:make-request
:request-env
:request-method
:request-script-name
:request-path-info
:request-server-name
:request-server-port
:request-server-protocol
:request-uri
:request-uri-scheme
:request-remote-addr
:request-remote-port
:request-query-string
:request-raw-body
:request-content-length
:request-content-type
:request-headers
:request-cookies
:request-body-parameters
:request-query-parameters
:request-parameters
:request-content
:request-has-body-p))
(in-package :lack.request)
(defstruct (request (:constructor %make-request))
env
method
script-name
path-info
server-name
server-port
server-protocol
uri
uri-scheme
remote-addr
remote-port
query-string
raw-body
content-length
content-type
headers
cookies
body-parameters
query-parameters)
(declaim (inline request-has-body-p))
(defun request-has-body-p (req)
(or (request-content-length req)
(string= (gethash "transfer-encoding" (request-headers req)) "chunked")))
(defun make-request (env)
(let ((req (apply #'%make-request :env env :allow-other-keys t env)))
(with-slots (method uri uri-scheme) req
(unless method
(setf method (getf env :request-method)))
(unless 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)
(let* ((headers (request-headers req))
(cookie (and (hash-table-p headers)
(gethash "cookie" headers))))
(when cookie
(setf (request-cookies req)
(loop for kv in (ppcre:split "\\s*[,;]\\s*" cookie)
append (quri:url-decode-params kv :lenient t)))
(rplacd (last env) (list :cookies (request-cookies req))))))
;; GET parameters
(with-slots (query-parameters query-string) req
(when (and (null query-parameters)
query-string)
(setf query-parameters
(quri:url-decode-params query-string :lenient t))
(rplacd (last env) (list :query-parameters query-parameters))))
(with-slots (body-parameters raw-body content-length content-type) req
(when raw-body
(setf raw-body (make-circular-input-stream raw-body))
;; POST parameters
(when (and (null body-parameters)
(request-has-body-p req))
(setf body-parameters
(http-body:parse content-type content-length raw-body))
(file-position raw-body 0)
(rplacd (last env) (list :body-parameters body-parameters)))))
(setf (request-env req) env)
req))
(defun request-parameters (req)
(append (request-query-parameters req)
(request-body-parameters req)))
(defun request-content (req)
(if (request-has-body-p req)
(let ((raw-body (request-raw-body req)))
(prog1
(http-body.util:slurp-stream raw-body (request-content-length req))
(file-position raw-body 0)))
#.(make-array 0 :element-type '(unsigned-byte 8))))
(declaim (notinline request-has-body-p))