1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
;;; 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 (rnrs io ports)
#: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."
(let ((socket (websocket-socket ws)))
(write-frame (make-close-frame (make-bytevector 0)) socket)
;; Per section 5.5.1 , wait for the server to close the connection
;; for a reasonable amount of time.
(let loop ()
(match (select #() (vector socket) #() 1) ; 1 second timeout
((#() #(socket) #()) ; there is output to read
(unless (port-eof? socket)
(read-frame socket) ; throw it away
(loop)))))
(close-port socket)))
(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))))
|
