Commit703395e4Recorded6 May 2026Repositorysigil-websocket

Use WASM bridge events for WebSocket connections

Message

Update the wasm cond-expand path to send text and binary payloads through the browser bridge socket and to consume bridge open/message/error/close events instead of native RFC6455 frames.

Native frame handling is left unchanged for non-WASM builds.

Verification: SIGIL_FEATURES=wasm import of (sigil websocket connection); native frame tests 9/9; native server tests 14/14.

Changed
 src/sigil/websocket/connection.sgl | 196 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-------------------------------------------------------------
 1 file changed, 120 insertions(+), 76 deletions(-)
Diff
src/sigil/websocket/connection.sglmodified
@@ -314,33 +314,45 @@
314
(define (ws-send conn message)
315
(: ws-connection? string? -> void?)
316
(when (ws-connected? conn)
317
(let ((frame (encode-text-frame message)))
318
(conn-write (ws-connection-socket conn)
319
(if (string? frame)
320
frame
321
(utf8->string frame))))))
+317
(cond-expand
+318
(wasm
+319
(conn-write (ws-connection-socket conn) message))
+320
(else
+321
(let ((frame (encode-text-frame message)))
+322
(conn-write (ws-connection-socket conn)
+323
(if (string? frame)
+324
frame
+325
(utf8->string frame))))))))
326
327
;;; Send a binary message
328
(define (ws-send-binary conn data)
329
(: ws-connection? bytevector? -> void?)
330
(when (ws-connected? conn)
327
(let ((frame (encode-binary-frame data)))
328
(conn-write (ws-connection-socket conn)
329
(if (string? frame)
330
frame
331
(utf8->string frame))))))
+331
(cond-expand
+332
(wasm
+333
(conn-write (ws-connection-socket conn) data))
+334
(else
+335
(let ((frame (encode-binary-frame data)))
+336
(conn-write (ws-connection-socket conn)
+337
(if (string? frame)
+338
frame
+339
(utf8->string frame))))))))
340
341
;;; Send a ping frame
342
(define (ws-ping conn . payload)
343
(: ws-connection? bytevector? ... -> void?)
344
(when (ws-connected? conn)
337
(let ((frame (if (null? payload)
338
(encode-ping-frame)
339
(encode-ping-frame (car payload)))))
340
(conn-write (ws-connection-socket conn)
341
(if (string? frame)
342
frame
343
(utf8->string frame))))))
+345
(cond-expand
+346
(wasm
+347
#t)
+348
(else
+349
(let ((frame (if (null? payload)
+350
(encode-ping-frame)
+351
(encode-ping-frame (car payload)))))
+352
(conn-write (ws-connection-socket conn)
+353
(if (string? frame)
+354
frame
+355
(utf8->string frame))))))))
356
357
;;; Receive a message (with async I/O support)
358
;;; Returns ws-message, 'closed, or #f on error
@@ -349,64 +361,92 @@
361
(: ws-connection? -> any?)
362
(if (not (ws-connected? conn))
363
'closed
352
(let ((socket (ws-connection-socket conn)))
353
(let loop ()
354
;; A prior socket read can contain multiple complete
355
;; WebSocket frames. Drain that buffer before waiting
356
;; for more readability; otherwise the async path can
357
;; block forever even though a frame is already local.
358
(let ((buffered
359
(let ((buffer (ws-connection-buffer conn)))
360
(if (> (bytevector-length buffer) 0)
361
(try-decode-message conn)
362
'need-more))))
363
(cond
364
((or (ws-message? buffered) (eq? buffered 'closed))
365
buffered)
366
((and buffered (not (eq? buffered 'need-more)))
367
#f)
368
(else
369
;; Wait for data (yields to scheduler if in async context)
370
(when (current-scheduler)
371
(await-readable socket))
372
;; Try to read and process
373
(let ((result (receive-message conn)))
374
(cond
375
;; Got a complete message or connection closed
376
((or (ws-message? result) (eq? result 'closed))
377
result)
378
;; Need more data - loop and wait again
379
((eq? result 'need-more)
380
(loop))
381
;; Error
382
(else #f))))))))))
+364
(cond-expand
+365
(wasm
+366
(let ((result (receive-message conn)))
+367
(if (eq? result 'need-more)
+368
#f
+369
result)))
+370
(else
+371
(let ((socket (ws-connection-socket conn)))
+372
(let loop ()
+373
;; A prior socket read can contain multiple complete
+374
;; WebSocket frames. Drain that buffer before waiting
+375
;; for more readability; otherwise the async path can
+376
;; block forever even though a frame is already local.
+377
(let ((buffered
+378
(let ((buffer (ws-connection-buffer conn)))
+379
(if (> (bytevector-length buffer) 0)
+380
(try-decode-message conn)
+381
'need-more))))
+382
(cond
+383
((or (ws-message? buffered) (eq? buffered 'closed))
+384
buffered)
+385
((and buffered (not (eq? buffered 'need-more)))
+386
#f)
+387
(else
+388
;; Wait for data (yields to scheduler if in async context)
+389
(when (current-scheduler)
+390
(await-readable socket))
+391
;; Try to read and process
+392
(let ((result (receive-message conn)))
+393
(cond
+394
;; Got a complete message or connection closed
+395
((or (ws-message? result) (eq? result 'closed))
+396
result)
+397
;; Need more data - loop and wait again
+398
((eq? result 'need-more)
+399
(loop))
+400
;; Error
+401
(else #f)))))))))))))
402
403
;;; Internal: Read data and try to decode a message
404
;;; Returns ws-message, 'closed, 'need-more, or #f on error
405
(define (receive-message conn)
387
(let* ((socket (ws-connection-socket conn))
388
(buffer (ws-connection-buffer conn))
389
;; Read data (blocking or non-blocking depending on socket mode).
390
;; conn-read returns a bytevector for TCP and a string for TLS
391
;; (legacy tls-read interface). Empty bytevector OR empty string
392
;; means "no data right now" in non-blocking mode.
393
(chunk (conn-read socket 4096)))
394
(cond
395
((or (not chunk) (eof-object? chunk))
396
(set-ws-connection-state! conn 'closed)
397
'closed)
398
((or (and (string? chunk) (string=? chunk ""))
399
(and (bytevector? chunk) (zero? (bytevector-length chunk))))
400
;; No data available, try to decode from existing buffer
401
(try-decode-message conn))
402
(else
403
;; Append to buffer
404
(let ((chunk-bv (if (string? chunk)
405
(string->utf8 chunk)
406
chunk)))
407
(set-ws-connection-buffer! conn
408
(bytevector-append buffer chunk-bv))
409
(try-decode-message conn))))))
+406
(cond-expand
+407
(wasm
+408
(process-wasm-event conn (conn-read (ws-connection-socket conn) 4096)))
+409
(else
+410
(let* ((socket (ws-connection-socket conn))
+411
(buffer (ws-connection-buffer conn))
+412
;; Read data (blocking or non-blocking depending on socket mode).
+413
;; conn-read returns a bytevector for TCP and a string for TLS
+414
;; (legacy tls-read interface). Empty bytevector OR empty string
+415
;; means "no data right now" in non-blocking mode.
+416
(chunk (conn-read socket 4096)))
+417
(cond
+418
((or (not chunk) (eof-object? chunk))
+419
(set-ws-connection-state! conn 'closed)
+420
'closed)
+421
((or (and (string? chunk) (string=? chunk ""))
+422
(and (bytevector? chunk) (zero? (bytevector-length chunk))))
+423
;; No data available, try to decode from existing buffer
+424
(try-decode-message conn))
+425
(else
+426
;; Append to buffer
+427
(let ((chunk-bv (if (string? chunk)
+428
(string->utf8 chunk)
+429
chunk)))
+430
(set-ws-connection-buffer! conn
+431
(bytevector-append buffer chunk-bv))
+432
(try-decode-message conn))))))))
+433
+434
(define (process-wasm-event conn event)
+435
(cond
+436
((not event)
+437
'need-more)
+438
((eq? (car event) 'open)
+439
'need-more)
+440
((eq? (car event) 'message)
+441
(ws-message type: (cadr event)
+442
data: (caddr event)))
+443
((eq? (car event) 'close)
+444
(set-ws-connection-state! conn 'closed)
+445
'closed)
+446
((eq? (car event) 'error)
+447
#f)
+448
(else
+449
#f)))
450
451
;;; Try to decode a complete message from buffer
452
;;; Returns ws-message, 'closed, 'need-more, or #f on error
@@ -511,12 +551,16 @@
551
(: ws-connection? -> void?)
552
(when (ws-connected? conn)
553
(set-ws-connection-state! conn 'closing)
514
;; Send close frame
515
(let ((close-frame (encode-close-frame 1000))) ; 1000 = normal closure
516
(conn-write (ws-connection-socket conn)
517
(utf8->string close-frame)))
+554
(cond-expand
+555
(wasm
+556
#t)
+557
(else
+558
;; Send close frame
+559
(let ((close-frame (encode-close-frame 1000))) ; 1000 = normal closure
+560
(conn-write (ws-connection-socket conn)
+561
(utf8->string close-frame)))))
562
;; Close socket
563
(conn-close (ws-connection-socket conn))
564
(set-ws-connection-state! conn 'closed)))
565
522
))
+566
)