diff --git a/websockets.scm b/websockets.scm index 8f6c86d..8ac7a45 100644 --- a/websockets.scm +++ b/websockets.scm @@ -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 "

Access denied

")))) (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))