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

Support HEAD and GET for local topics

This commit is contained in:
Tony Garnock-Jones 2016-11-09 05:20:18 +13:00
parent 45c30f6158
commit 91c59988df
1 changed files with 23 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
rmq/server.rkt
View File

@ -201,23 +201,30 @@
(define self-url (canonical-url canonical-host-name `("topic" (,topic ()))))
(define discovery-headers (list (cons 'link (format "<~a>; rel=hub" hub-url))
(cons 'link (format "<~a>; rel=self" self-url))))
(define (topic-response id include-content?) ;; Used in both GET and HEAD requests
(if (current-content)
(web-respond/bytes! id
#:header (web-response-header
#:last-modified-seconds (last-modified-seconds)
#:mime-type (and (current-content-type)
(string->bytes/utf-8
(current-content-type)))
#:headers discovery-headers)
(if include-content? (current-content) #""))
(web-respond/bytes! id
#:header (web-response-header
#:code 204
#:message #"No Content"
#:mime-type #f
#:headers discovery-headers)
#""))) ;; MUST NOT include a response body for 204
(on (web-request-incoming (id req) (vh host-name) 'head ("topic" (,topic ())))
(topic-response id #f))
(on (web-request-get (id req) (vh host-name) ("topic" (,topic ())))
(if (current-content)
(web-respond/bytes! id
#:header (web-response-header
#:last-modified-seconds (last-modified-seconds)
#:mime-type (and (current-content-type)
(string->bytes/utf-8
(current-content-type)))
#:headers discovery-headers)
(current-content))
(web-respond/bytes! id
#:header (web-response-header
#:code 204
#:message #"No Content"
#:mime-type #f
#:headers discovery-headers)
#"")))) ;; MUST NOT include a response body for 204
(topic-response id #t)))
(on (web-request-incoming (id req) (vh host-name) 'post ("topic" (,topic ())) $body)
(define content-type (req-content-type req))
(log-info "Local topic ~a got ~v message ~v" topic content-type body)