Commitda32f55bRecorded7 May 2026Repositorysigil-irc
Add IRC WebSocket browser handshake helpers
Message
Expose step-wise CAP and SASL PLAIN helpers for browser/WASM clients using the IRC-over-WebSocket adapter. The step API lets JavaScript yield between WebSocket phases while keeping the adapter free of native socket, TLS, and crypto dependencies. It also records advertised caps, enabled caps, and SASL result on the session for callers that need to bridge protocol state into a UI adapter.
Verification:
- sigil test --redirects ./dev-redirects.sgl
- sh test/integration/test-wasm-irc-websocket.sh
Changed
packages/sigil-irc-websocket/src/sigil/irc/websocket.sgl | 359 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 358 insertions(+), 1 deletion(-)Diff
packages/sigil-irc-websocket/src/sigil/irc/websocket.sglmodified
@@ -8,6 +8,7 @@
8
9
(define-library (sigil irc websocket) 10
(import (sigil core)+11
(sigil math) 12
(sigil string) 13
(sigil struct) 14
(sigil websocket)@@ -23,11 +24,24 @@
24
irc-ws-session-realname 25
irc-ws-session-websocket 26
irc-ws-session-state+27
irc-ws-session-server-caps+28
irc-ws-session-enabled-caps+29
irc-ws-session-sasl-result 30
31
irc-ws-connect 32
irc-ws-close 33
irc-ws-connected? 34
irc-ws-register+35
irc-ws-negotiate-caps+36
irc-ws-authenticate-plain+37
irc-ws-register-with-caps+38
irc-ws-cap-ls+39
irc-ws-cap-req-from-ls+40
irc-ws-cap-ack+41
irc-ws-cap-end+42
irc-ws-authenticate-plain-start+43
irc-ws-authenticate-plain-payload+44
irc-ws-authenticate-finish 45
46
irc-ws-send 47
irc-ws-command@@ -49,7 +63,10 @@
63
(websocket default: #f mutable: #t) 64
(state default: 'disconnected mutable: #t) 65
(buffer default: "" mutable: #t)−52
(queue default: '() mutable: #t))+66
(queue default: '() mutable: #t)+67
(server-caps default: '() mutable: #t)+68
(enabled-caps default: '() mutable: #t)+69
(sasl-result default: #f mutable: #t)) 70
71
(define (make-irc-ws-session (keys: (url #f) 72
(nick #f)@@ -115,6 +132,162 @@
132
(set-irc-ws-session-queue! session (cdr queue)) 133
(parse-irc-message line))))) 134
+135
(define base64-alphabet+136
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")+137
+138
(define (base64-char n)+139
(string (string-ref base64-alphabet n)))+140
+141
(define (base64-encode-string input)+142
(let ((len (string-length input)))+143
(let loop ((i 0) (acc '()))+144
(if (>= i len)+145
(apply string-append (reverse acc))+146
(let* ((remaining (- len i))+147
(b1 (char->integer (string-ref input i)))+148
(b2 (if (> remaining 1)+149
(char->integer (string-ref input (+ i 1)))+150
0))+151
(b3 (if (> remaining 2)+152
(char->integer (string-ref input (+ i 2)))+153
0))+154
(n (+ (* b1 65536) (* b2 256) b3))+155
(s1 (quotient n 262144))+156
(s2 (remainder (quotient n 4096) 64))+157
(s3 (remainder (quotient n 64) 64))+158
(s4 (remainder n 64))+159
(chunk+160
(cond+161
((= remaining 1)+162
(string-append (base64-char s1)+163
(base64-char s2)+164
"=="))+165
((= remaining 2)+166
(string-append (base64-char s1)+167
(base64-char s2)+168
(base64-char s3)+169
"="))+170
(else+171
(string-append (base64-char s1)+172
(base64-char s2)+173
(base64-char s3)+174
(base64-char s4))))))+175
(loop (+ i 3) (cons chunk acc)))))))+176
+177
(define (sasl-plain-payload authcid password . authzid)+178
(base64-encode-string+179
(string-append+180
(if (pair? authzid) (or (car authzid) "") "")+181
(string #\null)+182
authcid+183
(string #\null)+184
password)))+185
+186
(define (line-without-crlf line)+187
(strip-line-ending line))+188
+189
(define (send-wire-lines session lines)+190
(for-each+191
(lambda (line)+192
(irc-ws-send session (line-without-crlf line)))+193
lines))+194
+195
(define (message-command=? msg command)+196
(and (irc-message? msg)+197
(string=? (symbol->string (irc-message-command msg)) command)))+198
+199
(define (cap-subcommand msg)+200
(let ((params (irc-message-params msg)))+201
(and (pair? params)+202
(pair? (cdr params))+203
(cadr params))))+204
+205
(define (cap-body msg)+206
(or (irc-message-trailing msg)+207
(let ((params (irc-message-params msg)))+208
(if (null? params) "" (car (reverse params))))))+209
+210
(define (cap-ls-more? msg)+211
(let ((params (irc-message-params msg)))+212
(and (>= (length params) 3)+213
(string=? (caddr params) "*"))))+214
+215
(define (split-caps text)+216
(if (string=? text "")+217
'()+218
(map+219
(lambda (entry)+220
(let ((eq-pos (string-index entry (lambda (c) (char=? c #\=)))))+221
(if eq-pos+222
(substring entry 0 eq-pos)+223
entry)))+224
(string-split text " "))))+225
+226
(define (append-new-caps existing names)+227
(let loop ((rest names) (acc existing))+228
(cond+229
((null? rest) acc)+230
((member (car rest) acc) (loop (cdr rest) acc))+231
(else (loop (cdr rest) (append acc (list (car rest))))))))+232
+233
(define (filter-offered desired offered)+234
(let loop ((rest desired) (acc '()))+235
(cond+236
((null? rest) (reverse acc))+237
((member (car rest) offered)+238
(loop (cdr rest) (cons (car rest) acc)))+239
(else (loop (cdr rest) acc)))))+240
+241
(define (join-caps caps)+242
(string-join caps " "))+243
+244
(define (read-next-irc-message session max-lines)+245
(let loop ((n 0))+246
(if (>= n max-lines)+247
#f+248
(let ((msg (irc-ws-receive session)))+249
(if (irc-message? msg)+250
msg+251
(loop (+ n 1)))))))+252
+253
(define (read-until-command session command max-lines)+254
(let loop ((n 0))+255
(if (>= n max-lines)+256
#f+257
(let ((msg (irc-ws-receive session)))+258
(cond+259
((not (irc-message? msg)) (loop (+ n 1)))+260
((message-command=? msg command) msg)+261
(else (loop (+ n 1))))))))+262
+263
(define (read-cap-ls session max-lines)+264
(let loop ((n 0) (offered '()))+265
(if (>= n max-lines)+266
#f+267
(let ((msg (read-next-irc-message session 1)))+268
(cond+269
((not msg) (loop (+ n 1) offered))+270
((and (message-command=? msg "CAP")+271
(equal? (cap-subcommand msg) "LS"))+272
(let ((next (append-new-caps offered (split-caps (cap-body msg)))))+273
(if (cap-ls-more? msg)+274
(loop (+ n 1) next)+275
next)))+276
(else (loop (+ n 1) offered)))))))+277
+278
(define (read-cap-ack-or-nak session max-lines)+279
(let loop ((n 0))+280
(if (>= n max-lines)+281
#f+282
(let ((msg (read-next-irc-message session 1)))+283
(cond+284
((not msg) (loop (+ n 1)))+285
((and (message-command=? msg "CAP")+286
(or (equal? (cap-subcommand msg) "ACK")+287
(equal? (cap-subcommand msg) "NAK")))+288
msg)+289
(else (loop (+ n 1))))))))+290
291
(define (irc-ws-register session) 292
(: irc-ws-session? -> void?) 293
(let ((nick (irc-ws-session-nick session)))@@ -128,6 +301,190 @@
301
"*" 302
(or (irc-ws-session-realname session) nick)))) 303
+304
(define (irc-ws-authenticate-plain session authcid password . authzid)+305
(: irc-ws-session? string? string? any? ... -> boolean?)+306
(irc-ws-authenticate-plain-start session)+307
(if (not (apply irc-ws-authenticate-plain-payload+308
session+309
authcid+310
password+311
authzid))+312
#f+313
(irc-ws-authenticate-finish session)))+314
+315
(define (irc-ws-cap-ls session)+316
(: irc-ws-session? -> void?)+317
(irc-ws-command session "CAP" "LS" "302"))+318
+319
(define (irc-ws-cap-req-from-ls session desired . opts)+320
(: irc-ws-session? list? any? ... -> list?)+321
(let parse-opts ((rest opts)+322
(include-sasl? #f)+323
(max-lines 80))+324
(cond+325
((null? rest)+326
(let ((offered (read-cap-ls session max-lines)))+327
(if (not offered)+328
#f+329
(let* ((want (if include-sasl?+330
(append-new-caps desired (list "sasl"))+331
desired))+332
(requested (filter-offered want offered)))+333
(set-irc-ws-session-server-caps! session offered)+334
(if (null? requested)+335
(begin+336
(irc-ws-cap-end session)+337
'())+338
(begin+339
(irc-ws-command session "CAP" "REQ" (join-caps requested))+340
requested))))))+341
((and (pair? rest) (eq? (car rest) include-sasl?:))+342
(parse-opts (cddr rest) (cadr rest) max-lines))+343
((and (pair? rest) (eq? (car rest) max-lines:))+344
(parse-opts (cddr rest) include-sasl? (cadr rest)))+345
(else+346
(error "irc-ws-cap-req-from-ls: unknown option")))))+347
+348
(define (irc-ws-cap-ack session . opts)+349
(: irc-ws-session? any? ... -> list?)+350
(let parse-opts ((rest opts)+351
(max-lines 80))+352
(cond+353
((null? rest)+354
(let ((reply (read-cap-ack-or-nak session max-lines)))+355
(if (not reply)+356
#f+357
(let ((acked (if (equal? (cap-subcommand reply) "ACK")+358
(split-caps (cap-body reply))+359
'())))+360
(set-irc-ws-session-enabled-caps! session acked)+361
acked))))+362
((and (pair? rest) (eq? (car rest) max-lines:))+363
(parse-opts (cddr rest) (cadr rest)))+364
(else+365
(error "irc-ws-cap-ack: unknown option")))))+366
+367
(define (irc-ws-cap-end session)+368
(: irc-ws-session? -> void?)+369
(irc-ws-command session "CAP" "END"))+370
+371
(define (irc-ws-authenticate-plain-start session)+372
(: irc-ws-session? -> void?)+373
(irc-ws-command session "AUTHENTICATE" "PLAIN"))+374
+375
(define (irc-ws-authenticate-plain-payload session authcid password . authzid)+376
(: irc-ws-session? string? string? any? ... -> boolean?)+377
(let ((prompt (read-until-command session "AUTHENTICATE" 40)))+378
(if (not prompt)+379
#f+380
(let ((arg (let ((params (irc-message-params prompt)))+381
(and (pair? params) (car params)))))+382
(if (not (equal? arg "+"))+383
#f+384
(begin+385
(irc-ws-command session+386
"AUTHENTICATE"+387
(apply sasl-plain-payload+388
authcid+389
password+390
authzid))+391
#t))))))+392
+393
(define (irc-ws-authenticate-finish session . opts)+394
(: irc-ws-session? any? ... -> boolean?)+395
(let parse-opts ((rest opts)+396
(max-lines 80))+397
(cond+398
((null? rest)+399
(let ((result+400
(let loop ((n 0))+401
(if (>= n max-lines)+402
#f+403
(let ((msg (read-next-irc-message session 1)))+404
(cond+405
((not msg) (loop (+ n 1)))+406
((message-command=? msg "903") msg)+407
((or (message-command=? msg "904")+408
(message-command=? msg "905")+409
(message-command=? msg "906")+410
(message-command=? msg "907"))+411
msg)+412
(else (loop (+ n 1)))))))))+413
(cond+414
((and result (message-command=? result "903"))+415
(set-irc-ws-session-sasl-result! session 'success)+416
#t)+417
((irc-message? result)+418
(set-irc-ws-session-sasl-result!+419
session+420
(irc-message-command result))+421
#f)+422
(else #f))))+423
((and (pair? rest) (eq? (car rest) max-lines:))+424
(parse-opts (cddr rest) (cadr rest)))+425
(else+426
(error "irc-ws-authenticate-finish: unknown option")))))+427
+428
(define (irc-ws-negotiate-caps session desired . opts)+429
(: irc-ws-session? list? any? ... -> list?)+430
(let parse-opts ((rest opts)+431
(sasl-authcid #f)+432
(sasl-password #f)+433
(max-lines 80))+434
(cond+435
((null? rest)+436
(irc-ws-command session "CAP" "LS" "302")+437
(let ((offered (read-cap-ls session max-lines)))+438
(if (not offered)+439
#f+440
(let* ((want (if sasl-password+441
(append-new-caps desired (list "sasl"))+442
desired))+443
(requested (filter-offered want offered)))+444
(set-irc-ws-session-server-caps! session offered)+445
(if (null? requested)+446
(begin+447
(irc-ws-command session "CAP" "END")+448
'())+449
(begin+450
(irc-ws-command session "CAP" "REQ" (join-caps requested))+451
(let ((reply (read-cap-ack-or-nak session max-lines)))+452
(if (not reply)+453
#f+454
(let ((acked (if (equal? (cap-subcommand reply) "ACK")+455
(split-caps (cap-body reply))+456
'())))+457
(set-irc-ws-session-enabled-caps! session acked)+458
(cond+459
((and sasl-password (member "sasl" acked))+460
(let ((ok (irc-ws-authenticate-plain+461
session+462
(or sasl-authcid+463
(irc-ws-session-nick session))+464
sasl-password)))+465
(irc-ws-command session "CAP" "END")+466
(if ok acked #f)))+467
(else+468
(irc-ws-command session "CAP" "END")+469
acked)))))))))))+470
((and (pair? rest) (eq? (car rest) sasl-authcid:))+471
(parse-opts (cddr rest) (cadr rest) sasl-password max-lines))+472
((and (pair? rest) (eq? (car rest) sasl-password:))+473
(parse-opts (cddr rest) sasl-authcid (cadr rest) max-lines))+474
((and (pair? rest) (eq? (car rest) max-lines:))+475
(parse-opts (cddr rest) sasl-authcid sasl-password (cadr rest)))+476
(else+477
(error "irc-ws-negotiate-caps: unknown option")))))+478
+479
(define (irc-ws-register-with-caps session desired . opts)+480
(: irc-ws-session? list? any? ... -> list?)+481
(let ((acked (apply irc-ws-negotiate-caps session desired opts)))+482
(if (not acked)+483
#f+484
(begin+485
(irc-ws-register session)+486
acked))))+487
488
(define (irc-ws-connect . args) 489
(: any? ... -> any?) 490
(let ((session