Correct and improve header upgrade error handling.
This commit is contained in:
parent
9312d6d5ca
commit
a79b61968f
|
@ -38,6 +38,8 @@
|
|||
(define accept-connection (make-parameter (lambda (origin) #t)))
|
||||
(define drop-incoming-pings (make-parameter #t))
|
||||
(define propagate-common-errors (make-parameter #f))
|
||||
(define access-denied ; TODO test
|
||||
(make-parameter (lambda () (send-status 'forbidden "<h1>Access denied</h1>"))))
|
||||
|
||||
(define max-frame-size (make-parameter 1048576)) ; 1MiB
|
||||
(define max-message-size
|
||||
|
@ -51,11 +53,6 @@
|
|||
(apply make-composite-condition (append `(,(make-property-condition 'websocket))
|
||||
conditions)))
|
||||
|
||||
(define (make-invalid-header-exception type k v)
|
||||
(make-composite-condition (make-websocket-exception
|
||||
(make-property-condition type k v))
|
||||
(make-property-condition 'invalid-header)))
|
||||
|
||||
(define (make-protocol-violation-exception msg)
|
||||
(make-composite-condition (make-property-condition 'websocket)
|
||||
(make-property-condition 'protocol-error 'msg msg)))
|
||||
|
@ -78,7 +75,8 @@
|
|||
('connection-close 8)
|
||||
('ping 9)
|
||||
('pong 10)
|
||||
(else (error "bad optype")))) ; TODO
|
||||
(else (signal (make-websocket-exception
|
||||
(make-property-condition 'invalid-optype))))))
|
||||
|
||||
(define (control-frame? optype)
|
||||
(or (eq? optype 'ping) (eq? optype 'pong) (eq? optype 'connection-close)))
|
||||
|
@ -553,7 +551,6 @@ static const uint8_t utf8d[] = {
|
|||
|
||||
(define (websocket-compute-handshake client-key)
|
||||
(let* ((key-and-magic
|
||||
; TODO generate new, randome, secure key every time
|
||||
(string-append client-key "258EAFA5-E914-47DA-95CA-C5AB0DC85B11"))
|
||||
(key-and-magic-sha1 (sha1-sum key-and-magic)))
|
||||
(base64-encode key-and-magic-sha1)))
|
||||
|
@ -595,15 +592,14 @@ static const uint8_t utf8d[] = {
|
|||
; make sure the request meets the spec for websockets
|
||||
(cond ((not (and (eq? (header-value 'connection headers #f) 'upgrade)
|
||||
(string-ci= (car (header-value 'upgrade headers '(""))) "websocket")))
|
||||
(signal (make-invalid-header-exception 'upgrade 'value
|
||||
(header-value 'upgrade headers #f))))
|
||||
(signal (make-websocket-exception
|
||||
(make-property-condition 'missing-upgrade-header))))
|
||||
((not (string= (header-value 'sec-websocket-version headers "") "13"))
|
||||
(signal (make-invalid-header-exception
|
||||
'websocket-version 'version
|
||||
(header-value 'sec-websocket-version headers #f))))
|
||||
(with-headers ; TODO test
|
||||
`((sec-websocket-version "13"))
|
||||
(lambda () (send-status 'upgrade-required))))
|
||||
((not ((accept-connection) (header-value 'origin headers "")))
|
||||
(signal (make-invalid-header-exception 'origin 'value
|
||||
(header-value 'origin headers #f)))))
|
||||
((access-denied))))
|
||||
|
||||
(with-headers
|
||||
`((upgrade ("WebSocket" . #f))
|
||||
|
|
Loading…
Reference in New Issue