diff options
| -rw-r--r-- | web/socket/client.scm | 45 | ||||
| -rw-r--r-- | web/socket/frame.scm | 3 |
2 files changed, 27 insertions, 21 deletions
diff --git a/web/socket/client.scm b/web/socket/client.scm index 2017ab8..6561c26 100644 --- a/web/socket/client.scm +++ b/web/socket/client.scm @@ -1,6 +1,7 @@ ;;; guile-websocket --- WebSocket client/server ;;; Copyright © 2016 David Thompson <davet@gnu.org> ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> +;;; Copyright © 2023 Andrew Whatson <whatson@tailcall.au> ;;; ;;; This file is part of guile-websocket. ;;; @@ -30,6 +31,7 @@ #:use-module (rnrs io ports) #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) + #:use-module (web client) #:use-module (web request) #:use-module (web response) #:use-module (web uri) @@ -66,21 +68,22 @@ scheme." (unencrypted-websocket-scheme? uri)) (not (uri-fragment uri)))) -(define (make-client-socket uri) - "Connect a socket to the remote resource described by URI." - (let* ((port (uri-port uri)) - (info (car (getaddrinfo (uri-host uri) - (if port - (number->string port) - (symbol->string (uri-scheme uri))) - (if port - AI_NUMERICSERV - 0)))) - (s (with-fluids ((%default-port-encoding #f)) - (socket (addrinfo:fam info) SOCK_STREAM IPPROTO_IP)))) - ;; TODO: Configure I/O buffering? - (connect s (addrinfo:addr info)) - s)) +(define (make-client-socket uri verify-certificate?) + "Connect a socket to the remote resource described by URI. +When VERIFY-CERTIFICATE? is true, verify HTTPS server certificates." + ;; A ws(s) socket is equivalent to a http(s) socket; pretend to have + ;; a http uri and let guile's (web client) do the heavy lifting. + (let ((uri* (build-uri (match (uri-scheme uri) + ('wss 'https) + ('ws 'http)) + #:userinfo (uri-userinfo uri) + #:host (uri-host uri) + #:port (uri-port uri) + #:path (uri-path uri) + #:query (uri-query uri) + #:fragment (uri-fragment uri) + #:validate? #t))) + (open-socket-for-uri uri* #:verify-certificate? verify-certificate?))) (define-record-type <websocket> (%make-websocket uri socket entropy-port state) @@ -134,8 +137,9 @@ KEY." (define (handshake ws) "Perform the WebSocket handshake for the client WS." (let ((key (generate-client-key ws))) - (write-request (make-handshake-request (websocket-uri ws) key) - (websocket-socket ws)) + (let ((request (make-handshake-request (websocket-uri ws) key))) + (write-request request (websocket-socket ws)) + (force-output (websocket-socket ws))) (let* ((response (read-response (websocket-socket ws))) (headers (response-headers response)) (upgrade (assoc-ref headers 'upgrade)) @@ -163,15 +167,16 @@ current system." (const #f) (const #t)) "r"))) -(define (make-websocket uri-or-string) +(define* (make-websocket uri-or-string #:key (verify-certificate? #t)) "Create and establish a new WebSocket connection for the remote -resource described by URI-OR-STRING." +resource described by URI-OR-STRING. When VERIFY-CERTIFICATE? is +true, verify HTTPS server certificates." (let ((uri (match uri-or-string ((? uri? uri) uri) ((? string? str) (string->uri str))))) (if (websocket-uri? uri) (let ((ws (%make-websocket uri - (make-client-socket uri) + (make-client-socket uri verify-certificate?) (open-entropy-port) 'connecting))) (handshake ws) diff --git a/web/socket/frame.scm b/web/socket/frame.scm index f54f016..f3709f6 100644 --- a/web/socket/frame.scm +++ b/web/socket/frame.scm @@ -372,4 +372,5 @@ MASKING-KEY." (when mask (put-bytevector port mask)) ;; Write data, potentially masked. - (put-bytevector port (if mask (masked-data mask data) data)))) + (put-bytevector port (if mask (masked-data mask data) data)) + (force-output port))) |