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

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

@ -28,10 +28,23 @@
;; Creates a response that's coupled to an output-port: whatever you ;; Creates a response that's coupled to an output-port: whatever you
;; write into the output will be pushed into the response. ;; write into the output will be pushed into the response.
(define (make-port-response #:mime-type (mime-type #"application/octet-stream") (define (make-port-response #:mime-type (mime-type #"application/octet-stream")
#:with-gzip? (with-gzip? #t)) #:with-gzip? (with-gzip? #t)
(define headers (if with-gzip? #:with-cors? (with-cors? #f))
(list (header #"Content-Encoding" #"gzip")) (define headers
(list))) (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)) (define-values (in out) (make-pipe))
(values (response (values (response
200 #"OK" 200 #"OK"
@ -50,7 +63,7 @@
(define (start req) (define (start req)
(define-values (response op) (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 text-src (extract-binding/single 'src (request-bindings req)))
(define as-mod? (match (extract-bindings 'm (request-bindings req)) (define as-mod? (match (extract-bindings 'm (request-bindings req))
[(list (or "t" "true")) [(list (or "t" "true"))
@ -113,4 +126,4 @@
#:servlet-path "/compile" #:servlet-path "/compile"
#:extra-files-paths (list htdocs) #:extra-files-paths (list htdocs)
#:launch-browser? #f #:launch-browser? #f
#:port (current-port)) #:port (current-port))