suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Turning on CORS support.

Browse Source
This commit is contained in:
Danny Yoo 2013-03-18 10:05:20 -06:00
parent 0e379fe831
commit 646ab10d82
1 changed files with 19 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
whalesong/repl-prototype/server.rkt
View File

@ -28,10 +28,23 @@
;; Creates a response that's coupled to an output-port: whatever you
;; write into the output will be pushed into the response.
(define (make-port-response #:mime-type (mime-type #"application/octet-stream")
#:with-gzip? (with-gzip? #t))
(define headers (if with-gzip?
(list (header #"Content-Encoding" #"gzip"))
(list)))
#:with-gzip? (with-gzip? #t)
#:with-cors? (with-cors? #f))
(define headers
(filter values
(list (if with-gzip?
(header #"Content-Encoding" #"gzip")
#f)
(cond [(not with-cors?)
#f]
[(bytes? with-cors?)
(header #"Access-Control-Allow-Origin" with-cors?)]
[(eq? with-cors? #t)
(header #"Access-Control-Allow-Origin" #"*")]
[else
(raise-argument-error 'make-port-response
"byte string or boolean"
with-cors?)]))))
(define-values (in out) (make-pipe))
(values (response
200 #"OK"
@ -50,7 +63,7 @@
(define (start req)
(define-values (response op)
(make-port-response #:mime-type #"text/json"))
(make-port-response #:mime-type #"text/json" #:with-cors? #t))
(define text-src (extract-binding/single 'src (request-bindings req)))
(define as-mod? (match (extract-bindings 'm (request-bindings req))
[(list (or "t" "true"))