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