summaryrefslogtreecommitdiff
path: root/web
diff options
context:
space:
mode:
Diffstat (limited to 'web')
-rw-r--r--web/socket/client.scm143
1 files changed, 143 insertions, 0 deletions
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 <davet@gnu.org>
+;;;
+;;; 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
+;;; <http://www.gnu.org/licenses/>.
+
+;;; 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 <websocket>
+ (%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))))