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

drivers/http: support 405 Method Not Allowed response

This commit is contained in:
Tony Garnock-Jones 2022-12-14 12:10:53 +13:00
parent 271da81942
commit 7f84fb9d10
1 changed files with 24 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
syndicate/drivers/http.rkt
View File

@ -48,22 +48,22 @@
(at ds
(during/spawn (HttpBinding _ $port _ _ _)
#:name `(http-server ,port)
(define routes (make-hash)) ;; hostname -> method -> path-pattern -> (set handler)
(define routes (make-hash)) ;; hostname -> path-pattern -> method -> (set handler)
(run-listener ds port routes)
(at ds
(during (HttpListener port)
(during (HttpBinding $host port $method $path $handler)
(define service (HttpService host port method path))
(define method-map (hash-ref! routes host make-hash))
(define pattern-map (hash-ref! method-map method make-hash))
(define handler-set (hash-ref! pattern-map path mutable-set))
(define pattern-map (hash-ref! routes host make-hash))
(define method-map (hash-ref! pattern-map path make-hash))
(define handler-set (hash-ref! method-map method mutable-set))
(unless (set-empty? handler-set)
(log-syndicate/drivers/http-warning "Multiple active handlers for ~v" service))
(set-add! handler-set handler)
(on-stop (set-remove! handler-set handler)
(when (set-empty? handler-set) (hash-remove! pattern-map path))
(when (hash-empty? pattern-map) (hash-remove! method-map method))
(when (hash-empty? method-map) (hash-remove! routes host)))
(when (set-empty? handler-set) (hash-remove! method-map method))
(when (hash-empty? method-map) (hash-remove! pattern-map path))
(when (hash-empty? pattern-map) (hash-remove! routes host)))
(assert service)))))))
(define (run-listener ds port routes)
@ -174,10 +174,24 @@
(define decoded-req (HttpRequest req-id host port method path headers query body))
(at ds (assert decoded-req))
(define (try-method method-map m)
(define pattern-map (hash-ref method-map m hash))
(for [((path-pattern handler-set) (in-hash pattern-map))]
(define (try-hostname n)
(define pattern-map (hash-ref routes n hash))
(for [((path-pattern method-map) (in-hash pattern-map))]
(when (path-pattern-matches? path-pattern path)
(define handler-set (or (hash-ref method-map method #f)
(hash-ref method-map #f #f)
(let ((methods (string->bytes/utf-8
(string-join
(for/list [(m (in-list (hash-keys method-map)))]
(string-upcase (symbol->string m)))
", "))))
(respond! (response/full 405
#"Method Not Allowed"
(current-seconds)
#"text/plain"
(list (header #"Allow" methods))
(list)))
(return (void)))))
(define handler (set-first handler-set))
(define pending-code #f)
(define pending-message #f)
@ -223,11 +237,6 @@
(at handler (assert (HttpContext decoded-req res)))
(return (void)))))
(define (try-hostname n)
(define method-map (hash-ref routes n hash))
(try-method method-map method)
(try-method method-map #f))
(begin (try-hostname host)
(try-hostname #f)
(respond! (response/full 404