zilti
/
spiffy-websockets
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Cleanup.

This commit is contained in:
Thomas Hintz 2014-10-08 17:17:45 -07:00
parent a6570f2659
commit fb9d35db77
1 changed files with 16 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
websockets.scm
View File

@ -336,7 +336,7 @@
frame-fin frame-optype)) frame-fin frame-optype))
(else (else
(signal (make-websocket-exception (signal (make-websocket-exception
(make-property-condition 'unhandled-opcode (make-property-condition 'unhandled-optype
'optype frame-optype))))))))))) 'optype frame-optype)))))))))))
(define (valid-utf8-2? s) (define (valid-utf8-2? s)
@ -501,6 +501,7 @@ static const uint8_t utf8d[] = {
(process-fragments fragments optype))))) (process-fragments fragments optype)))))
; TODO does #!optional and #!key work together? ; TODO does #!optional and #!key work together?
; TODO document websocket state close states
(define (close-websocket #!optional (ws (current-websocket)) (define (close-websocket #!optional (ws (current-websocket))
#!key (close-reason 'normal) (data (make-u8vector 0))) #!key (close-reason 'normal) (data (make-u8vector 0)))
(define invalid-close-reason #f) (define invalid-close-reason #f)
@ -632,6 +633,15 @@ static const uint8_t utf8d[] = {
ws)) ws))
(define (with-websocket proc #!optional (concurrent #f)) (define (with-websocket proc #!optional (concurrent #f))
(define (handle-error close-reason exn)
(set-websocket-state! (current-websocket) 'closing)
(close-websocket (current-websocket) close-reason: close-reason)
(unless (port-closed? (request-port (current-request)))
(close-input-port (request-port (current-request))))
(unless (port-closed? (response-port (current-response)))
(close-output-port (response-port (current-response))))
(when (propagate-common-errors)
(signal exn)))
(parameterize (parameterize
((current-websocket (websocket-accept concurrent))) ((current-websocket (websocket-accept concurrent)))
(condition-case (condition-case
@ -639,51 +649,11 @@ static const uint8_t utf8d[] = {
(close-websocket) (close-websocket)
(close-input-port (request-port (current-request))) (close-input-port (request-port (current-request)))
(close-output-port (response-port (current-response)))) (close-output-port (response-port (current-response))))
(exn (websocket protocol-error) (exn (websocket protocol-error) (handle-error 'protocol-error exn))
(set-websocket-state! (current-websocket) 'closing) (exn (websocket invalid-data) (handle-error 'invalid-data exn))
(close-websocket (current-websocket) close-reason: 'protocol-error) (exn (websocket connection-timeout) (handle-error 'going-away exn))
(unless (port-closed? (request-port (current-request))) (exn (websocket message-too-large) (handle-error 'message-too-large exn))
(close-input-port (request-port (current-request)))) (exn () (handle-error 'unexpected-error exn)))))
(unless (port-closed? (response-port (current-response)))
(close-output-port (response-port (current-response))))
(when (propagate-common-errors)
(signal exn)))
(exn (websocket invalid-data)
(set-websocket-state! (current-websocket) 'closing)
(close-websocket (current-websocket) close-reason: 'invalid-data)
(unless (port-closed? (request-port (current-request)))
(close-input-port (request-port (current-request))))
(unless (port-closed? (response-port (current-response)))
(close-output-port (response-port (current-response))))
(when (propagate-common-errors)
(signal exn)))
(exn (websocket connection-timeout)
(set-websocket-state! (current-websocket) 'closing)
(close-websocket (current-websocket) close-reason: 'going-away)
(unless (port-closed? (request-port (current-request)))
(close-input-port (request-port (current-request))))
(unless (port-closed? (response-port (current-response)))
(close-output-port (response-port (current-response))))
(when (propagate-common-errors)
(signal exn)))
(exn (websocket message-too-large)
(set-websocket-state! (current-websocket) 'closing)
(close-websocket (current-websocket) close-reason: 'message-too-large)
(unless (port-closed? (request-port (current-request)))
(close-input-port (request-port (current-request))))
(unless (port-closed? (response-port (current-response)))
(close-output-port (response-port (current-response))))
(when (propagate-common-errors)
(signal exn)))
(exn ()
(close-websocket (current-websocket) close-reason: 1011)
(unless (port-closed? (request-port (current-request)))
(close-input-port (request-port (current-request))))
(unless (port-closed? (response-port (current-response)))
(close-output-port (response-port (current-response))))
(abort exn)
;(signal (make-websocket-exception (make-property-condition 'unexpected-error)))
))))
(define (with-concurrent-websocket proc) (define (with-concurrent-websocket proc)
(let ((parent-thread (current-thread))) (let ((parent-thread (current-thread)))