syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Very basic inbound cookie support

This commit is contained in:
Tony Garnock-Jones 2016-11-23 22:05:49 +13:00
parent 257c0bf628
commit f0f29007df
1 changed files with 7 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
racket/syndicate/drivers/web.rkt
View File

@ -8,6 +8,7 @@
(struct-out web-request)
(struct-out web-request-header)
(struct-out web-request-cookie)
web-request-header-content-type
(rename-out [web-response-header <web-response-header>])
@ -52,6 +53,8 @@
(require (only-in racket/list flatten))
(require (only-in racket/port port->bytes))
(require web-server/http/bindings)
(require web-server/http/cookie)
(require web-server/http/cookie-parse)
(require web-server/http/request)
(require web-server/http/request-structs)
(require web-server/http/response)
@ -73,6 +76,7 @@
(struct web-request (id direction header* body) #:prefab)
(struct web-request-header (method resource headers query) #:prefab)
(struct web-request-cookie (id name value domain path) #:prefab)
(struct web-response-header (code message last-modified-seconds mime-type headers) #:prefab)
(struct web-response-complete (id header body) #:prefab)
@ -257,6 +261,9 @@
(url-query (request-uri lowlevel-req)))
(request-post-data/raw lowlevel-req)))
(actor #:name (list 'web-req id)
(for [(c (request-cookies lowlevel-req))]
(match-define (client-cookie n v d p) c)
(assert (web-request-cookie id n v d p)))
(on-start (send! (set-timer (list 'web-req id) 100 'relative))
(send! web-req))
;; TODO: protocol for 500 Internal server error