Cleanup.

websockets.scm

@@ -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,58 +633,27 @@ static const uint8_t utf8d[] = {
     ws))
 
 (define (with-websocket proc #!optional (concurrent #f))
-  (parameterize
+  (define (handle-error close-reason exn)
-   ((current-websocket (websocket-accept concurrent)))
-   (condition-case
-    (begin (proc)
-           (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)
+    (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)))
-    (exn (websocket invalid-data)
+  (parameterize
-         (set-websocket-state! (current-websocket) 'closing)
+   ((current-websocket (websocket-accept concurrent)))
-         (close-websocket (current-websocket) close-reason: 'invalid-data)
+   (condition-case
-         (unless (port-closed? (request-port (current-request)))
+    (begin (proc)
-                 (close-input-port (request-port (current-request))))
+           (close-websocket)
-         (unless (port-closed? (response-port (current-response)))
+           (close-input-port (request-port (current-request)))
-                 (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)
+    (exn (websocket protocol-error) (handle-error 'protocol-error exn))
-         ;(signal (make-websocket-exception (make-property-condition 'unexpected-error)))
+    (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)))