From 15ea184fe308cbbc646d6b7d96f6333350fcd3a8 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Thu, 24 Mar 2016 23:35:35 -0400 Subject: Add client module. --- web/socket/client.scm | 143 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 143 insertions(+) create mode 100644 web/socket/client.scm (limited to 'web/socket') diff --git a/web/socket/client.scm b/web/socket/client.scm new file mode 100644 index 0000000..d144890 --- /dev/null +++ b/web/socket/client.scm @@ -0,0 +1,143 @@ +;;; guile-websocket --- WebSocket client/server +;;; Copyright © 2016 David Thompson +;;; +;;; This file is part of guile-websocket. +;;; +;;; Guile-websocket is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU Lesser General Public License as +;;; published by the Free Software Foundation; either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; Guile-websocket is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Lesser General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with guile-websocket. If not, see +;;; . + +;;; Commentary: +;; +;; WebSocket client. +;; +;;; Code: + +(define-module (web socket client) + #:use-module (ice-9 match) + #:use-module (rnrs bytevectors) + #:use-module (srfi srfi-9) + #:use-module (web request) + #:use-module (web response) + #:use-module (web uri) + #:use-module (web socket base64) + #:use-module (web socket frame) + #:use-module (web socket sha-1) + #:export (make-websocket + websocket? + websocket-uri + close-websocket + websocket-send + websocket-receive)) + +;; See Section 3 - WebSocket URIs +(define (encrypted-websocket-scheme? uri) + "Return #t if the scheme for URI is 'wss', the secure WebSocket +scheme." + (eq? (uri-scheme uri) 'wss)) + +(define (unencrypted-websocket-scheme? uri) + "Return #t if the scheme for URI is 'ws', the insecure WebSocket +scheme." + (eq? (uri-scheme uri) 'ws)) + +(define (websocket-uri? uri) + "Return #t if URI is a valid WebSocket URI." + (and (or (encrypted-websocket-scheme? uri) + (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)) + +;; TODO: Add 'state' field (connecting, open, closing, closed) +(define-record-type + (%make-websocket uri socket) + websocket? + (uri websocket-uri) + (socket websocket-socket)) + +;; See Section 4.1 - Client Requirements +(define (make-handshake-request uri) + "Create an HTTP request for initiating a WebSocket connect with the +remote resource described by URI." + (let ((headers `((host . (,(uri-host uri) . #f)) + (upgrade . ("WebSocket")) + (connection . (upgrade)) + ;; TODO: Generate a real key. + (sec-websocket-key . "AQIDBAUGBwgJCgsMDQ4PEC==") + (sec-websocket-version . "13")))) + (build-request uri #:method 'GET #:headers headers))) + +(define (handshake ws) + "Perform the WebSocket handshake for the client WS." + (write-request (make-handshake-request (websocket-uri ws)) + (websocket-socket ws)) + (let* ((response (read-response (websocket-socket ws))) + (headers (response-headers response)) + (upgrade (assoc-ref headers 'upgrade)) + (connection (assoc-ref headers 'connection)) + (accept (assoc-ref headers 'sec-websocket-accept))) + ;; Validate the handshake. + (unless (and (= (response-code response) 101) + (string-ci=? (car upgrade) "websocket") + (equal? connection '(upgrade)) + ;; TODO: authenticate accept key. + ) + (close-websocket ws) + (error "websocket handshake failed" (websocket-uri ws))))) + +(define (make-websocket uri-or-string) + "Create and establish a new WebSocket connection for the remote +resource described by URI-OR-STRING." + (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)))) + (handshake ws) + ws) + (error "not a websocket uri" uri)))) + +(define (close-websocket ws) + "Close the WebSocket connection for the client WS." + (close-port (websocket-socket ws))) + +(define (websocket-send ws data) + "Send DATA, a string or bytevector, to the server that WS is +connected to." + ;; TODO: Generate maskng key. + ;; TODO: Send frames over some threshold in fragments. + (write-frame (make-text-frame data) + (websocket-socket ws))) + +(define (websocket-receive ws) + "Read a response from the server that WS is connected to." + ;; TODO: Handle fragmented frames and control frames. + (let ((frame (read-frame (websocket-socket ws)))) + (if (binary-frame? frame) + (frame-data frame) + (text-frame->string frame)))) -- cgit v1.2.3