15 Commits

Author SHA1 Message Date
pharpend 2151fff0fa wip on static cache 2025-10-21 22:38:48 -07:00
pharpend 73fc38b7ad begin static file caching 2025-10-21 22:20:24 -07:00
pharpend a0418788c5 the shed biketh 2025-10-21 22:16:58 -07:00
pharpend cb600dc0da starting chat service 2025-10-21 22:09:04 -07:00
pharpend 027c020a34 begin to add chat function 2025-10-21 21:06:35 -07:00
Peter Harpending 079c47962a websockets work 2025-10-21 17:12:59 -07:00
Peter Harpending 7ed8b12c4e painting bike shed 2025-10-21 14:55:51 -07:00
Peter Harpending 4509a328a8 fix type error 2025-10-21 13:22:37 -07:00
Peter Harpending 04970142aa painting the bike shed 2025-10-21 12:37:33 -07:00
Peter Harpending b44292a790 websockets I think are done 2025-10-21 12:28:45 -07:00
Peter Harpending 1865f03085 Almost done... have to fix send
and then of course test it

there will be no bugs, right?
2025-10-21 12:10:28 -07:00
Peter Harpending 5824aaaf36 continuing with websockets
am now working on popping messages off the frame stack
2025-10-21 11:17:27 -07:00
Peter Harpending 35dbf06a55 wip: websocket frame parsing 2025-10-20 22:07:53 -07:00
Peter Harpending 62d0710fcf committing brain-damaged websocket extensions bs
this is just retarded, i'm just going to ignore
2025-10-20 20:02:02 -07:00
Peter Harpending 9107679dfc start websocket stuff 2025-10-20 15:43:52 -07:00
14 changed files with 1913 additions and 10 deletions
+1 -1
View File
@@ -4,7 +4,7 @@
qargs = undefined :: undefined | #{Key :: binary() := Value :: binary()},
fragment = undefined :: undefined | none | binary(),
version = undefined :: undefined | http10 | http11 | http20,
headers = undefined :: undefined | [{Key :: binary(), Value :: binary()}],
headers = undefined :: undefined | #{Key :: binary() := Value :: binary()},
cookies = undefined :: undefined | #{Key :: binary() := Value :: binary()},
enctype = undefined :: undefined | none | urlencoded | json | multipart(),
size = undefined :: undefined | none | non_neg_integer(),
+100
View File
@@ -0,0 +1,100 @@
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<title>Chat with Websockets</title>
<link rel="stylesheet" href="./default.css">
</head>
<body>
<div class="content">
<h1 class="content-title">Chat with websockets</h1>
<div class="content-body">
<input autofocus label="Nick" id="nick"></input>
<textarea hidden disabled id="wfc-output"></textarea>
<input hidden id="wfc-input"></input>
</div>
</div>
<script>
let nelt = document.getElementById('nick');
let ielt = document.getElementById('wfc-input');
let oelt = document.getElementById('wfc-output');
let ws = new WebSocket("/ws/chat");
let nick = '';
// when user hits any key while typing in nick
function on_nick(evt) {
if (evt.key === 'Enter') {
// don't do default thing
evt.preventDefault();
// grab contents
let contents = nelt.value;
let trimmed = contents.trim();
// if contents are nonempty
let nonempty_contents = trimmed.length > 0;
if (nonempty_contents) {
nick = trimmed;
let msg_obj = ['nick', nick];
let msg_str = JSON.stringify(msg_obj);
console.log('message to server:', contents.trim());
// query backend for result
ws.send(msg_str);
// delete element from dom
nelt.remove();
oelt.hidden = false;
ielt.hidden = false;
ielt.autofocus = true;
}
}
}
// when user hits any key while typing in ielt
function on_input_key(evt) {
if (evt.key === 'Enter') {
// don't do default thing
evt.preventDefault();
// grab contents
let contents = ielt.value;
let trimmed = contents.trim();
// if contents are nonempty
let nonempty_contents = trimmed.length > 0;
if (nonempty_contents) {
let msg_obj = ['chat', trimmed];
let msg_str = JSON.stringify(msg_obj);
console.log('message to server:', contents.trim());
// query backend for result
ws.send(msg_str);
// clear input
ielt.value = '';
// add to output
oelt.value += '> ';
oelt.value += trimmed;
oelt.value += '\n';
}
}
}
function main() {
nelt.addEventListener('keydown', on_nick);
ielt.addEventListener('keydown', on_input_key);
ws.onmessage =
function (msg_evt) {
console.log('message from server:', msg_evt);
let msg_str = msg_evt.data;
let msg_obj = JSON.parse(msg_str);
oelt.value += msg_obj.nick;
oelt.value += '> ';
oelt.value += msg_obj.msg;
oelt.value += '\n';
};
}
main();
</script>
</body>
</html>
+7 -4
View File
@@ -9,11 +9,14 @@
<div class="content">
<h1 class="content-title">WFC Demo</h1>
<ul>
<li><a href="/chat.html">Websocket Chatroom</a></li>
<li><a href="/ws-test-echo.html">Websocket Echo Test</a></li>
</ul>
<div class="content-body">
<textarea id="wfc-output"
disabled
></textarea>
<input autofocus id="wfc-input"></textarea>
<textarea disabled id="wfc-output"></textarea>
<input autofocus id="wfc-input"></input>
<h2>Settings</h2>
<input type="checkbox" checked id="auto-resize-output">Auto-resize output</input> <br>
+100
View File
@@ -0,0 +1,100 @@
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<title>Chat with Websockets</title>
<link rel="stylesheet" href="./default.css">
</head>
<body>
<div class="content">
<h1 class="content-title">Chat with websockets</h1>
<div class="content-body">
<input autofocus label="Nick" id="nick"></input>
<textarea hidden disabled id="wfc-output"></textarea>
<input hidden id="wfc-input"></input>
</div>
</div>
<script>
let nelt = document.getElementById('nick');
let ielt = document.getElementById('wfc-input');
let oelt = document.getElementById('wfc-output');
let ws = new WebSocket("/ws/chat");
let nick = '';
// when user hits any key while typing in nick
function on_nick(evt) {
if (evt.key === 'Enter') {
// don't do default thing
evt.preventDefault();
// grab contents
let contents = nelt.value;
let trimmed = contents.trim();
// if contents are nonempty
let nonempty_contents = trimmed.length > 0;
if (nonempty_contents) {
nick = trimmed;
let msg_obj = ['nick', nick];
let msg_str = JSON.stringify(msg_obj);
console.log('message to server:', contents.trim());
// query backend for result
ws.send(msg_str);
// delete element from dom
nelt.remove();
oelt.hidden = false;
ielt.hidden = false;
ielt.autofocus = true;
}
}
}
// when user hits any key while typing in ielt
function on_input_key(evt) {
if (evt.key === 'Enter') {
// don't do default thing
evt.preventDefault();
// grab contents
let contents = ielt.value;
let trimmed = contents.trim();
// if contents are nonempty
let nonempty_contents = trimmed.length > 0;
if (nonempty_contents) {
let msg_obj = ['chat', trimmed];
let msg_str = JSON.stringify(msg_obj);
console.log('message to server:', contents.trim());
// query backend for result
ws.send(msg_str);
// clear input
ielt.value = '';
// add to output
oelt.value += '> ';
oelt.value += trimmed;
oelt.value += '\n';
}
}
}
function main() {
nelt.addEventListener('keydown', on_nick);
ielt.addEventListener('keydown', on_input_key);
ws.onmessage =
function (msg_evt) {
console.log('message from server:', msg_evt);
let msg_str = msg_evt.data;
let msg_obj = JSON.parse(msg_str);
oelt.value += msg_obj.nick;
oelt.value += '> ';
oelt.value += msg_obj.msg;
oelt.value += '\n';
};
}
main();
</script>
</body>
</html>
+95
View File
@@ -0,0 +1,95 @@
/* color pallette */
* {
--white: #f7f8fb;
--lgray0: #f5fbfd;
--lgray1: #daddd6;
--lgray2: #d3d8d5;
--mgray1: #687864;
--dgreen1: #21341e;
--lgreen1: #e5eef2;
--black: #003d27;
--sans: Helvetica, Liberation Sans, FreeSans, Roboto, sans-serif;
--mono: Liberation Mono, FreeMono, Roboto Mono, monospace;
--fsdef: 12pt;
}
/* body */
body {
background: var(--white);
color: var(--dgray1);
font-size: var(--fsdef);
font-family: var(--sans);
margin: 0;
padding: 0;
line-height: 1.4;
}
.content {
max-width: 800px;
margin: 0 auto;
/*
background: #ff0;
*/
}
/* add some top padding to content */
.content-title {
text-align: center;
text-decoration: underline;
}
.content-body {
width: 100%;
margin: 0 auto;
/*
background: #f00;
*/
padding-left: 10px;
padding-right: 10px;
box-sizing: border-box;
}
/* element-specific styling */
a {
color: var(--mgray1);
}
#wfc-input {
font-family: var(--mono);
font-size: var(--fsdef);
background: var(--lgreen1);
width: 100%;
box-sizing: border-box;
border-radius: 6px;
border: 1px solid var(--lgray1);
padding: 5px;
}
#wfc-output {
background: var(--lgray0);
font-family: var(--mono);
font-size: var(--fsdef);
width: 100%;
resize: vertical;
box-sizing: border-box;
border-radius: 6px;
border: 1px solid var(--lgray1);
padding: 5px;
}
+138
View File
@@ -0,0 +1,138 @@
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<title>WF Compiler Demo</title>
<link rel="stylesheet" href="./default.css">
</head>
<body>
<div class="content">
<h1 class="content-title">WFC Demo</h1>
<ul>
<li><a href="/chat.html">Websocket Chatroom</a></li>
<li><a href="/ws-test-echo.html">Websocket Echo Test</a></li>
</ul>
<div class="content-body">
<textarea disabled id="wfc-output"></textarea>
<input autofocus id="wfc-input"></input>
<h2>Settings</h2>
<input type="checkbox" checked id="auto-resize-output">Auto-resize output</input> <br>
<input type="checkbox" checked id="auto-scroll" >Auto-scroll output to bottom</input>
</div>
</div>
<script>
let ielt = document.getElementById('wfc-input');
let oelt = document.getElementById('wfc-output');
let MAX_OELT_HEIGHT = 300;
function auto_resize_output() {
// if the user has manually resized their output, we do nothing
if (document.getElementById('auto-resize-output').checked) {
// resize it automagically up to 500px
if (oelt.scrollHeight < MAX_OELT_HEIGHT) {
oelt.style.height = String(oelt.scrollHeight) + 'px';
}
else {
oelt.style.height = String(MAX_OELT_HEIGHT) + 'px';
}
}
}
function auto_scroll_to_bottom() {
if (document.getElementById('auto-scroll').checked) {
// scroll to bottom
oelt.scrollTop = oelt.scrollHeight;
}
}
async function on_server_return(response) {
console.log('on_server_return:', response);
if (response.ok) {
let jsbs = await response.json();
console.log('jsbs', jsbs);
// jsbs: {ok: true, result: string} | {ok: false, error: string}
if (jsbs.ok) {
// this means got a result back from server
// put it in
oelt.value += jsbs.result;
oelt.value += '\n';
}
else {
// this is an error at the WFC level
oelt.value += jsbs.error;
oelt.value += '\n';
}
}
// this means we sent an invalid request
else {
oelt.value += 'HTTP ERROR, SEE BROWSER CONSOLE\n'
}
}
function on_some_bullshit(x) {
console.log('on_some_bullshit:', x);
oelt.value += 'NETWORK ERROR, SEE BROWSER CONSOLE\n'
}
function fetch_wfcin(user_line) {
let req_body_obj = {wfcin: user_line};
// let req_body_str = JSON.stringify(req_body_obj, undefined, 4);
let req_body_str = JSON.stringify(req_body_obj);
let req_options = {method: 'POST',
headers: {'content-type': 'application/json'},
body: req_body_str};
let response_promise = fetch('/wfcin', req_options);
response_promise.then(on_server_return, on_some_bullshit);
// this is a promise for a response
//console.log(response_promise);
}
// when user hits any key
function on_input_key(evt) {
if (evt.key === 'Enter') {
// don't do default thing
evt.preventDefault();
// grab contents
let contents = ielt.value;
// if contents are nonempty
let nonempty_contents = contents.trim().length > 0;
if (nonempty_contents) {
// put in output
// // if it's nonempty add a newline
// if (oelt.value.length > 0) {
// oelt.value += '\n';
// }
oelt.value += '> ' + contents + '\n';
oelt.hidden = false;
// query backend for result
fetch_wfcin(contents.trim());
// clear input
ielt.value = '';
// auto-resize
auto_resize_output();
auto_scroll_to_bottom();
}
}
}
function main() {
ielt.addEventListener('keydown', on_input_key);
}
main();
</script>
</body>
</html>
+56
View File
@@ -0,0 +1,56 @@
/* header */
div#header {
background: var(--lgray2);
height: 50px;
width: 100%;
}
img#header-logo {
height: 40px;
margin-top: 5px;
margin-bottom: 5px;
margin-left: 5px;
}
.main {
padding-top: 20px;
}
.content-diagram {
max-width: 100%;
margin: 0 auto;
padding: 0 auto;
}
/* Pandoc makes some wacky choices with how it lays out code blocks
*
* this means all <code> blocks that do not have a <pre> block as an ancestor
*
* ie the `inline code`
*/
code:not(pre *) {
border-radius: 6px;
border: 1px solid var(--lgray1);
padding-left: 3px;
padding-right: 3px;
padding-top: 1px;
padding-bottom: 1px;
background: var(--lgreen1);
}
/* this is specifically for ```fenced blocks``` */
pre {
border-radius: 6px;
border: 1px solid var(--lgray1);
padding: 5px;
background: var(--lgreen1);
overflow: scroll;
}
/* All `unfenced` or ```fenced``` blocks */
code {
font-family: Liberation Mono, Roboto Mono, monospace;
color: var(--dgreen1);
}
+65
View File
@@ -0,0 +1,65 @@
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<title>Websockets echo test</title>
<link rel="stylesheet" href="./default.css">
</head>
<body>
<div class="content">
<h1 class="content-title">Websockets echo test</h1>
<div class="content-body">
<textarea id="wfc-output"
disabled></textarea>
<input autofocus id="wfc-input"></input>
</div>
</div>
<script>
let ielt = document.getElementById('wfc-input');
let oelt = document.getElementById('wfc-output');
let ws = new WebSocket("/ws/echo");
// when user hits any key while typing in ielt
function on_input_key(evt) {
if (evt.key === 'Enter') {
// don't do default thing
evt.preventDefault();
// grab contents
let contents = ielt.value;
let trimmed = contents.trim();
// if contents are nonempty
let nonempty_contents = trimmed.length > 0;
if (nonempty_contents) {
console.log('message to server:', contents.trim());
// query backend for result
ws.send(contents.trim());
// clear input
ielt.value = '';
// add to output
oelt.value += '> ';
oelt.value += trimmed;
oelt.value += '\n';
}
}
}
function main() {
ielt.addEventListener('keydown', on_input_key);
ws.onmessage =
function (msg_evt) {
console.log('message from server:', msg_evt);
let msg_str = msg_evt.data;
oelt.value += '< ';
oelt.value += msg_str;
oelt.value += '\n';
};
}
main();
</script>
</body>
</html>
+65
View File
@@ -0,0 +1,65 @@
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<title>Websockets echo test</title>
<link rel="stylesheet" href="./default.css">
</head>
<body>
<div class="content">
<h1 class="content-title">Websockets echo test</h1>
<div class="content-body">
<textarea id="wfc-output"
disabled></textarea>
<input autofocus id="wfc-input"></input>
</div>
</div>
<script>
let ielt = document.getElementById('wfc-input');
let oelt = document.getElementById('wfc-output');
let ws = new WebSocket("/ws/echo");
// when user hits any key while typing in ielt
function on_input_key(evt) {
if (evt.key === 'Enter') {
// don't do default thing
evt.preventDefault();
// grab contents
let contents = ielt.value;
let trimmed = contents.trim();
// if contents are nonempty
let nonempty_contents = trimmed.length > 0;
if (nonempty_contents) {
console.log('message to server:', contents.trim());
// query backend for result
ws.send(contents.trim());
// clear input
ielt.value = '';
// add to output
oelt.value += '> ';
oelt.value += trimmed;
oelt.value += '\n';
}
}
}
function main() {
ielt.addEventListener('keydown', on_input_key);
ws.onmessage =
function (msg_evt) {
console.log('message from server:', msg_evt);
let msg_str = msg_evt.data;
oelt.value += '< ';
oelt.value += msg_str;
oelt.value += '\n';
};
}
main();
</script>
</body>
</html>
+262
View File
@@ -0,0 +1,262 @@
% @doc
% controller for chat
-module(fd_chat).
-vsn("0.1.0").
-behavior(gen_server).
-author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("Peter Harpending <peterharpending@qpq.swiss>").
-license("BSD-2-Clause-FreeBSD").
-export([
join/1,
relay/1,
nick_available/1
]).
-export([start_link/0]).
-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
code_change/3, terminate/2]).
-include("$zx_include/zx_logger.hrl").
-record(o, {pid :: pid(),
nick :: string()}).
-type orator() :: #o{}.
-record(s, {orators = [] :: [orator()]}).
-type state() :: #s{}.
%%% Service Interface
-spec join(Nick) -> Result
when Nick :: string(),
Result :: ok
| {error, Reason :: any()}.
join(Nick) ->
gen_server:call(?MODULE, {join, Nick}).
-spec nick_available(Nick) -> Result
when Nick :: string(),
Result :: boolean().
nick_available(Nick) ->
gen_server:call(?MODULE, {nick_available, Nick}).
-spec relay(Message) -> ok
when Message :: string().
relay(Message) ->
gen_server:cast(?MODULE, {relay, self(), Message}).
%%% Startup Functions
-spec start_link() -> Result
when Result :: {ok, pid()}
| {error, Reason :: term()}.
%% @private
%% This should only ever be called by fd_chat_orators (the service-level supervisor).
start_link() ->
gen_server:start_link({local, ?MODULE}, ?MODULE, none, []).
-spec init(none) -> {ok, state()}.
%% @private
%% Called by the supervisor process to give the process a chance to perform any
%% preparatory work necessary for proper function.
init(none) ->
ok = tell("~p Starting.", [?MODULE]),
State = #s{},
{ok, State}.
%%% gen_server Message Handling Callbacks
-spec handle_call(Message, From, State) -> Result
when Message :: term(),
From :: {pid(), reference()},
State :: state(),
Result :: {reply, Response, NewState}
| {noreply, State},
Response :: term(),
NewState :: state().
%% @private
%% The gen_server:handle_call/3 callback.
%% See: http://erlang.org/doc/man/gen_server.html#Module:handle_call-3
handle_call({join, Nick}, {Pid, _}, State) ->
{Reply, NewState} = do_join(Pid, Nick, State),
{reply, Reply, NewState};
handle_call({nick_available, Nick}, _, State = #s{orators = Orators}) ->
Reply = is_nick_available(Nick, Orators),
{reply, Reply, State};
handle_call(Unexpected, From, State) ->
ok = tell("~p Unexpected call from ~tp: ~tp~n", [?MODULE, From, Unexpected]),
{noreply, State}.
-spec handle_cast(Message, State) -> {noreply, NewState}
when Message :: term(),
State :: state(),
NewState :: state().
%% @private
%% The gen_server:handle_cast/2 callback.
%% See: http://erlang.org/doc/man/gen_server.html#Module:handle_cast-2
handle_cast({relay, From, Message}, State = #s{orators = Orators}) ->
do_relay(From, Message, Orators),
{noreply, State};
handle_cast(Unexpected, State) ->
ok = tell("~p Unexpected cast: ~tp~n", [?MODULE, Unexpected]),
{noreply, State}.
-spec handle_info(Message, State) -> {noreply, NewState}
when Message :: term(),
State :: state(),
NewState :: state().
%% @private
%% The gen_server:handle_info/2 callback.
%% See: http://erlang.org/doc/man/gen_server.html#Module:handle_info-2
handle_info(Msg = {'DOWN', _Mon, process, _Pid, _Reason}, State) ->
NewState = handle_down(Msg, State),
{noreply, NewState};
handle_info(Unexpected, State) ->
ok = tell("~p Unexpected info: ~tp~n", [?MODULE, Unexpected]),
{noreply, State}.
%%% OTP Service Functions
-spec code_change(OldVersion, State, Extra) -> Result
when OldVersion :: {down, Version} | Version,
Version :: term(),
State :: state(),
Extra :: term(),
Result :: {ok, NewState}
| {error, Reason :: term()},
NewState :: state().
%% @private
%% The gen_server:code_change/3 callback.
%% See: http://erlang.org/doc/man/gen_server.html#Module:code_change-3
code_change(_, State, _) ->
{ok, State}.
-spec terminate(Reason, State) -> no_return()
when Reason :: normal
| shutdown
| {shutdown, term()}
| term(),
State :: state().
%% @private
%% The gen_server:terminate/2 callback.
%% See: http://erlang.org/doc/man/gen_server.html#Module:terminate-2
terminate(_, _) ->
ok.
%%% internals
-spec do_join(Pid, Nick, State) -> {Reply, NewState}
when Pid :: pid(),
Nick :: string(),
Reply :: ok | {error, Reason :: any()},
NewState :: State.
do_join(Pid, Nick, State = #s{orators = Orators}) ->
case ensure_can_join(Pid, Nick, Orators) of
ok -> do_join2(Pid, Nick, State);
Error -> {Error, State}
end.
do_join2(Pid, Nick, State = #s{orators = Orators}) ->
_Monitor = erlang:monitor(process, Pid),
NewOrator = #o{pid = Pid, nick = Nick},
NewOrators = [NewOrator | Orators],
NewState = State#s{orators = NewOrators},
{ok, NewState}.
-spec ensure_can_join(Pid, Nick, Orators) -> Result
when Pid :: pid(),
Nick :: string(),
Orators :: [orator()],
Result :: ok
| {error, Reason},
Reason :: any().
% @private
% ensures both Pid and Nick are unique
ensure_can_join(Pid, _ , [#o{pid = Pid} | _ ]) -> {error, already_joined};
ensure_can_join(_ , Nick, [#o{nick = Nick} | _ ]) -> {error, {nick_taken, Nick}};
ensure_can_join(Pid, Nick, [_ | Rest]) -> ensure_can_join(Pid, Nick, Rest);
ensure_can_join(_ , _ , [] ) -> ok.
-spec is_nick_available(Nick, Orators) -> boolean()
when Nick :: string(),
Orators :: [orator()].
is_nick_available(Nick, [#o{nick = Nick} | _ ]) -> false;
is_nick_available(Nick, [_ | Rest]) -> is_nick_available(Nick, Rest);
is_nick_available(_ , [] ) -> true.
-spec handle_down(Msg, State) -> NewState
when Msg :: {'DOWN', Mon, process, Pid, Reason},
Mon :: erlang:monitor(),
Pid :: pid(),
Reason :: any(),
State :: state(),
NewState :: State.
handle_down(Msg = {'DOWN', _, process, Pid, _}, State = #s{orators = Orators}) ->
NewOrators = hdn(Msg, Pid, Orators, []),
NewState = State#s{orators = NewOrators},
NewState.
% encountered item, removing
hdn(_, Pid, [#o{pid = Pid} | Rest], Acc) -> Rest ++ Acc;
hdn(Msg, Pid, [Skip | Rest], Acc) -> hdn(Msg, Pid, Rest, [Skip | Acc]);
hdn(Msg, _, [] , Acc) ->
log("~tp: Unexpected message: ~tp", [?MODULE, Msg]),
Acc.
do_relay(Pid, Message, Orators) ->
case lists:keyfind(Pid, #o.pid, Orators) of
#o{nick = Nick} ->
do_relay2(Nick, Message, Orators);
false ->
tell("~tp: Message received from outsider ~tp: ~tp", [?MODULE, Pid, Message]),
error
end.
% skip
do_relay2(Nick, Msg, [#o{nick = Nick} | Rest]) ->
do_relay2(Nick, Msg, Rest);
do_relay2(Nick, Msg, [#o{pid = Pid} | Rest]) ->
Pid ! {chat, {relay, Nick, Msg}},
do_relay2(Nick, Msg, Rest);
do_relay2(_, _, []) ->
ok.
+73 -4
View File
@@ -222,11 +222,14 @@ handle_request(Sock, R = #request{method = M, path = P}) when M =/= undefined, P
route(Sock, M, P, R).
route(Sock, get, Route, _Request) ->
route(Sock, get, Route, Request) ->
case Route of
<<"/">> -> home(Sock);
<<"/default.css">> -> default_css(Sock);
_ -> http_err(Sock, 404)
<<"/">> -> home(Sock);
<<"/default.css">> -> default_css(Sock);
<<"/chat.html">> -> chat_html(Sock);
<<"/ws-test-echo.html">> -> ws_test_echo_html(Sock);
<<"/ws/echo">> -> ws_echo(Sock, Request);
_ -> http_err(Sock, 404)
end;
route(Sock, post, Route, Request) ->
case Route of
@@ -237,6 +240,46 @@ route(Sock, _, _, _) ->
http_err(Sock, 404).
ws_echo(Sock, Request) ->
try
ws_echo2(Sock, Request)
catch
X:Y:Z ->
tell(error, "CRASH ws_echo: ~tp:~tp:~tp", [X, Y, Z]),
http_err(Sock, 500)
end.
ws_echo2(Sock, Request) ->
tell("~p: ws_echo request: ~tp", [?LINE, Request]),
case fd_ws:handshake(Request) of
{ok, Response} ->
tell("~p: ws_echo response: ~tp", [?LINE, Response]),
respond(Sock, Response),
tell("~p: ws_echo: entering loop", [?LINE]),
ws_echo_loop(Sock);
Error ->
tell("ws_echo: error: ~tp", [Error]),
http_err(Sock, 400)
end.
ws_echo_loop(Sock) ->
ws_echo_loop(Sock, [], <<>>).
ws_echo_loop(Sock, Frames, Received) ->
tell("~p: ws_echo_loop: entering loop", [?LINE]),
case fd_ws:recv(Sock, Received, 5*fd_ws:min(), Frames) of
Result = {ok, Message, NewFrames, NewReceived} ->
tell("~p: ws_echo_loop ok: ~tp", [?LINE, Result]),
% send the same message back
ok = fd_ws:send(Sock, Message),
ws_echo_loop(Sock, NewFrames, NewReceived);
Error ->
tell("ws_echo_loop: error: ~tp", [Error]),
fd_ws:send(Sock, {close, <<>>}),
error(Error)
end.
home(Sock) ->
%% fixme: cache
Path_IH = filename:join([zx:get_home(), "priv", "index.html"]),
@@ -263,6 +306,32 @@ default_css(Sock) ->
http_err(Sock, 500)
end.
ws_test_echo_html(Sock) ->
%% fixme: cache
Path_IH = filename:join([zx:get_home(), "priv", "ws-test-echo.html"]),
case file:read_file(Path_IH) of
{ok, Body} ->
Resp = #response{headers = [{"content-type", "text/html"}],
body = Body},
respond(Sock, Resp);
Error ->
io:format("~p error: ~p~n", [self(), Error]),
http_err(Sock, 500)
end.
chat_html(Sock) ->
%% fixme: cache
Path_IH = filename:join([zx:get_home(), "priv", "chat.html"]),
case file:read_file(Path_IH) of
{ok, Body} ->
Resp = #response{headers = [{"content-type", "text/html"}],
body = Body},
respond(Sock, Resp);
Error ->
io:format("~p error: ~p~n", [self(), Error]),
http_err(Sock, 500)
end.
wfcin(Sock, #request{enctype = json,
cookies = Cookies,
body = #{"wfcin" := Input}}) ->
+125
View File
@@ -0,0 +1,125 @@
% @doc static file cache
-module(fd_static_cache).
-behavior(gen_server).
-export([
start_link/0,
query/1, set/2, unset/1,
%%---
%% everything below here runs in process context
%%--
%% gen_server callbacks
init/1, handle_call/3, handle_cast/2, handle_info/2,
code_change/3, terminate/2
]).
-include("$zx_include/zx_logger.hrl").
-record(f, {http_path :: binary(),
fs_path :: file:filename(),
last_modified :: file:date_time(),
mime_type :: string(),
contents :: binary()}).
-type context() :: wfc_eval_context:context().
-record(s,
{cookies = #{} :: #{Cookie :: binary() := context()}}).
% -type state() :: #s{}.
%%--------------------------------
%% api (runs in context of caller)
%%--------------------------------
-spec start_link() -> {ok, pid()} | {error, term()}.
start_link() ->
gen_server:start_link({local, ?MODULE}, ?MODULE, none, []).
-spec query(Cookie) -> {ok, Context} | error
when Cookie :: binary(),
Context :: context().
query(Cookie) ->
gen_server:call(?MODULE, {query, Cookie}).
-spec set(Cookie, Context) -> ok
when Cookie :: binary(),
Context :: context().
set(Cookie, Context) ->
gen_server:cast(?MODULE, {set, Cookie, Context}).
-spec unset(Cookie) -> ok
when Cookie :: binary().
unset(Cookie) ->
gen_server:cast(?MODULE, {unset, Cookie}).
%%----------------------
%% gen-server bs
%%----------------------
init(none) ->
log(info, "starting fd_cache"),
InitState = #s{},
{ok, InitState}.
handle_call({query, Cookie}, _, State) ->
Result = do_query(Cookie, State),
{reply, Result, State};
handle_call(Unexpected, From, State) ->
tell("~tp: unexpected call from ~tp: ~tp", [?MODULE, Unexpected, From]),
{noreply, State}.
handle_cast({set, Cookie, Context}, State) ->
NewState = do_set(Cookie, Context, State),
{noreply, NewState};
handle_cast({unset, Cookie}, State) ->
NewState = do_unset(Cookie, State),
{noreply, NewState};
handle_cast(Unexpected, State) ->
tell("~tp: unexpected cast: ~tp", [?MODULE, Unexpected]),
{noreply, State}.
handle_info(Unexpected, State) ->
tell("~tp: unexpected info: ~tp", [?MODULE, Unexpected]),
{noreply, State}.
code_change(_, State, _) ->
{ok, State}.
terminate(_, _) ->
ok.
%%---------------------
%% doers
%%---------------------
do_set(Cookie, Context, State = #s{cookies = Cookies}) ->
NewCookies = maps:put(Cookie, Context, Cookies),
NewState = State#s{cookies = NewCookies},
NewState.
do_unset(Cookie, State = #s{cookies = Cookies}) ->
NewCookies = maps:remove(Cookie, Cookies),
NewState = State#s{cookies = NewCookies},
NewState.
do_query(Cookie, _State = #s{cookies = Cookies}) ->
maps:find(Cookie, Cookies).
+7 -1
View File
@@ -42,11 +42,17 @@ init([]) ->
5000,
supervisor,
[fd_clients]},
Chat = {fd_chat,
{fd_chat, start_link, []},
permanent,
5000,
worker,
[fd_chat]},
Cache = {fd_cache,
{fd_cache, start_link, []},
permanent,
5000,
worker,
[fd_cache]},
Children = [Clients, Cache],
Children = [Clients, Chat, Cache],
{ok, {RestartStrategy, Children}}.
+819
View File
@@ -0,0 +1,819 @@
% @doc websockets
%
% ref: https://datatracker.ietf.org/doc/html/rfc6455
-module(fd_ws).
-export_type([
opcode/0,
frame/0,
ws_msg/0
]).
-export([
%% time units
ms/0, sec/0, min/0, hr/0, day/0,
%% porcelain
handshake/1,
recv/3, recv/4,
send/2
]).
-include("http.hrl").
-include("$zx_include/zx_logger.hrl").
-type request() :: #request{}.
-type response() :: #response{}.
-type tcp_error() :: closed
| {timeout, RestData :: binary() | erlang:iovec()}
| inet:posix().
-define(MAX_PAYLOAD_SIZE, ((1 bsl 63) - 1)).
%% Frames
%% https://datatracker.ietf.org/doc/html/rfc6455#section-5.2
-type opcode() :: continuation
| text
| binary
| close
| ping
| pong.
-record(frame,
{fin = none :: none | boolean(),
rsv = none :: none | <<_:3>>,
opcode = none :: none | opcode(),
mask = none :: none | boolean(),
payload_length = none :: none | non_neg_integer(),
masking_key = none :: none | <<>> | <<_:32>>,
payload = none :: none | binary()}).
-type frame() :: #frame{}.
%% porcelain messages
-type ws_msg() :: {text, Payload :: iodata()}
| {binary, Payload :: iodata()}
| {close, Payload :: iodata()}
| {ping, Payload :: iodata()}
| {pong, Payload :: iodata()}.
%% time units
ms() -> 1.
sec() -> 1_000.
min() -> 60*sec().
hr() -> 60*min().
day() -> 24*hr().
-spec handshake(Req) -> Result
when Req :: request(),
Result :: {ok, ClientProtocols, ClientExtensions, DraftResponse}
| {error, Reason},
ClientProtocols :: [binary()],
ClientExtensions :: binary(),
DraftResponse :: response(),
Reason :: any().
% @doc
% This mostly just validates that all the 't's have been dotted and 'i's have
% been crossed.
%
% given an HTTP request:
%
% - if it is NOT a valid websocket handshake request, error
% - if it IS a valid websocket handshake request, form an initial candidate
% response record with the following fields:
%
% code = 101
% slogan = "Switching Protocols"
% headers = [{"Sec-WebSocket-Accept", ChallengeResponse},
% {"Connection", "Upgrade"},
% {"Upgrade", "websocket"}].
%
% YOU are responsible for dealing with any cookie logic, authentication logic,
% validating the Origin field, implementing cross-site-request-forgery, adding
% the retarded web date, rendering the response, sending it over the socket,
% etc.
%
% The returned ClientExtensions is the result of joining the
% <<"sec-websocket-extensions">> fields with ", "
%
% quoth section 9.1: https://datatracker.ietf.org/doc/html/rfc6455#section-9.1
%
% > Note that like other HTTP header fields, this header field MAY be
% > split or combined across multiple lines. Ergo, the following are
% > equivalent:
% >
% > Sec-WebSocket-Extensions: foo
% > Sec-WebSocket-Extensions: bar; baz=2
% >
% > is exactly equivalent to
% >
% > Sec-WebSocket-Extensions: foo, bar; baz=2
%
% Nobody actually uses extensions, so how you choose to parse this is on you.
handshake(R = #request{method = get, headers = Hs}) ->
%% downcase the headers because have to match on them
handshake2(R#request{headers = casefold_headers(Hs)});
handshake(_) ->
{error, bad_method}.
-spec casefold_headers(Headers) -> DowncaseHeaders
when Headers :: #{Key := Value},
Key :: binary(),
Value :: binary(),
DowncaseHeaders :: Headers.
% @private
% casefold all the keys in the header because they're case insensitive
casefold_headers(Headers) ->
Downcase =
fun({K, V}) ->
NewKey = unicode:characters_to_binary(string:casefold(K)),
{NewKey, V}
end,
maps:from_list(lists:map(Downcase, maps:to_list(Headers))).
-spec handshake2(DowncaseReq) -> Result
when DowncaseReq :: request(),
Result :: {ok, DraftResponse}
| {error, Reason},
DraftResponse :: response(),
Reason :: any().
% @private
% we may assume (WMA) method=get and headers have all been downcased
handshake2(#request{headers = DowncaseHeaders}) ->
% headers MUST contain fields:
% sec-websocket-key: _ % arbitrary
% sec-websocket-version: 13 % must be EXACTLY 13
% connection: Upgrade % must include the token "Upgrade"
% upgrade: websocket % must include the token "websocket"
MaybeResponseToken = validate_headers(DowncaseHeaders),
case MaybeResponseToken of
{ok, ResponseToken} ->
DraftResponse =
#response{code = 101,
slogan = "Switching Protocols",
headers = [{"Sec-WebSocket-Accept", ResponseToken},
{"Connection", "Upgrade"},
{"Upgrade", "websocket"}]},
{ok, DraftResponse};
Error ->
Error
end.
-spec validate_headers(HeadersMap) -> Result
when HeadersMap :: #{Key :: binary() := Val :: binary()},
Result :: {ok, ResponseToken}
| {error, Reason},
ResponseToken :: binary(),
Reason :: any().
% @private
% validate:
% Upgrade: websocket
% Connection: Upgrade
% Sec-WebSocket-Version: 13
validate_headers(#{<<"sec-websocket-key">> := ChallengeToken,
<<"sec-websocket-version">> := WS_Vsn,
<<"connection">> := Connection,
<<"upgrade">> := Upgrade}) ->
BadUpgrade = bad_upgrade(Upgrade),
BadConnection = bad_connection(Connection),
BadVersion = bad_version(WS_Vsn),
if
BadUpgrade -> {error, {bad_upgrade, Upgrade}};
BadConnection -> {error, {bad_connection, Connection}};
BadVersion -> {error, {bad_version, WS_Vsn}};
true -> {ok, response_token(ChallengeToken)}
end;
validate_headers(_) ->
{error, bad_request}.
-spec bad_upgrade(binary()) -> true | false.
% @private string must include "websocket" as a token
bad_upgrade(Str) ->
case string:find(Str, "websocket") of
nomatch -> true;
_ -> false
end.
-spec bad_connection(binary()) -> true | false.
% @private string must include "Upgrade" as a token
bad_connection(Str) ->
case string:find(Str, "Upgrade") of
nomatch -> true;
_ -> false
end.
-spec bad_version(binary()) -> true | false.
% @private version must be EXACTLY <<"13">>
bad_version(<<"13">>) -> false;
bad_version(_) -> true.
-spec response_token(binary()) -> binary().
% @doc
% Quoth the RFC:
%
% > Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==
% >
% > For this header field, the server has to take the value (as present
% > in the header field, e.g., the base64-encoded [RFC4648] version minus
% > any leading and trailing whitespace) and concatenate this with the
% > Globally Unique Identifier (GUID, [RFC4122]) "258EAFA5-E914-47DA-
% > 95CA-C5AB0DC85B11" in string form, which is unlikely to be used by
% > network endpoints that do not understand the WebSocket Protocol. A
% > SHA-1 hash (160 bits) [FIPS.180-3], base64-encoded (see Section 4 of
% > [RFC4648]), of this concatenation is then returned in the server's
% > handshake.
% >
% > Concretely, if as in the example above, the |Sec-WebSocket-Key|
% > header field had the value "dGhlIHNhbXBsZSBub25jZQ==", the server
% > would concatenate the string "258EAFA5-E914-47DA-95CA-C5AB0DC85B11"
% > to form the string "dGhlIHNhbXBsZSBub25jZQ==258EAFA5-E914-47DA-95CA-
% > C5AB0DC85B11". The server would then take the SHA-1 hash of this,
% > giving the value 0xb3 0x7a 0x4f 0x2c 0xc0 0x62 0x4f 0x16 0x90 0xf6
% > 0x46 0x06 0xcf 0x38 0x59 0x45 0xb2 0xbe 0xc4 0xea. This value is
% > then base64-encoded (see Section 4 of [RFC4648]), to give the value
% > "s3pPLMBiTxaQ9kYGzzhZRbK+xOo=". This value would then be echoed in
% > the |Sec-WebSocket-Accept| header field.
response_token(ChallengeToken) when is_binary(ChallengeToken) ->
MagicString = <<"258EAFA5-E914-47DA-95CA-C5AB0DC85B11">>,
ConcatString = <<ChallengeToken/binary, MagicString/binary>>,
Sha1 = crypto:hash(sha, ConcatString),
base64:encode(Sha1).
-spec recv(Socket, Received, TimeoutMS) -> Result
when Socket :: gen_tcp:socket(),
Received :: binary(),
TimeoutMS :: non_neg_integer(),
Result :: {ok, Message, Frames, Remainder}
| {error, Reason},
Message :: ws_msg(),
Frames :: [frame()],
Remainder :: binary(),
Reason :: any().
% @doc
% Equivalent to recv(Socket, Received, [])
recv(Sock, Recv, TimeoutMS) ->
recv(Sock, Recv, TimeoutMS, []).
-spec recv(Socket, Received, TimeoutMS, Frames) -> Result
when Socket :: gen_tcp:socket(),
Received :: binary(),
TimeoutMS :: non_neg_integer(),
Frames :: [frame()],
Result :: {ok, Message, NewFrames, Remainder}
| {error, Reason},
Message :: ws_msg(),
NewFrames :: Frames,
Remainder :: binary(),
Reason :: any().
% @doc
% Pull a message off the socket
recv(Sock, Received, Timeout, Frames) ->
case maybe_pop_msg(Frames) of
{ok, Message, NewFrames} ->
{ok, Message, NewFrames, Received};
incomplete ->
case recv_frame(#frame{}, Sock, Received, Timeout) of
{ok, Frame, NewReceived} ->
NewFrames = [Frame | Frames],
recv(Sock, NewReceived, Timeout, NewFrames);
Error ->
Error
end;
Error ->
Error
end.
-spec maybe_pop_msg(Frames) -> Result
when Frames :: [frame()],
Result :: {ok, Message, NewFrames}
| incomplete
| {error, Reason},
Message :: ws_msg(),
NewFrames :: Frames,
Reason :: any().
% @private
% try to parse the stack of frames into a single message
%
% ignores RSV bits
% @end
maybe_pop_msg([]) ->
incomplete;
% case 1: control frames
% note that maybe_control_msg checks that the fin bit is true
%
% meaning if the client sends a malicious control frame with fin=false, that
% error will be caught in maybe_control_msg
maybe_pop_msg([Frame = #frame{opcode = ControlOpcode} | Frames])
when (ControlOpcode =:= close)
orelse (ControlOpcode =:= ping)
orelse (ControlOpcode =:= pong) ->
case maybe_control_msg(Frame) of
{ok, Msg} -> {ok, Msg, Frames};
Error -> Error
end;
% case 2: messages
% finished message in a single frame, just pull here
maybe_pop_msg([Frame = #frame{fin = true,
opcode = DataOpcode,
mask = Mask,
masking_key = Key,
payload = Payload}
| Rest])
when DataOpcode =:= text; DataOpcode =:= binary ->
case maybe_unmask(Frame, Mask, Key, Payload) of
{ok, Unmasked} ->
Message = {DataOpcode, Unmasked},
{ok, Message, Rest};
Error ->
Error
end;
% end of a long message
maybe_pop_msg(Frames = [#frame{fin = true,
opcode = continuation} | _]) ->
maybe_long_data_msg(Frames);
% unfinished message, say we need more
maybe_pop_msg([#frame{fin = false,
opcode = continuation}
| _]) ->
incomplete;
% wtf... this case should be impossible
maybe_pop_msg([Frame | _]) ->
{error, {wtf_frame, Frame}}.
-spec maybe_long_data_msg(Frames) -> Result
when Frames :: [frame()],
Result :: {ok, Message, NewFrames}
| {error, Reason},
Message :: ws_msg(),
NewFrames :: Frames,
Reason :: any().
% @private
% assumes:
% 1. top of stack is a finished frame
% 2. top opcode is continuation
% 3. the stack corresponds to a linear sequence of frames all corresponding to
% one message, until we get to the leading frame of the message, which must
% have opcode text|binary
%
% the reason we can make this assumption is because anterior in the call
% chain is recv/3, which eagerly consumes control messages
%
% meaning if we encounter a control frame in the middle here, we can assume
% there is some sort of bug
%
% TODO: I am NOT enforcing that the data message consumes the entire stack of
% frames. Given that the context here is eager consumption, this might be a
% point of enforcement. Need to think about this.
% @end
maybe_long_data_msg(Frames) ->
mldm(Frames, Frames, <<>>).
% general case: decode the payload in this frame
mldm(OrigFrames, [Frame | Rest], Acc) ->
Opcode = Frame#frame.opcode,
Mask = Frame#frame.mask,
Key = Frame#frame.masking_key,
Payload = Frame#frame.payload,
case maybe_unmask(Frame, Mask, Key, Payload) of
{ok, Unmasked} ->
NewAcc = <<Unmasked/binary, Acc/binary>>,
case Opcode of
continuation -> mldm(OrigFrames, Rest, NewAcc);
text -> {ok, {text, NewAcc}, Rest};
binary -> {ok, {binary, NewAcc}, Rest};
_ -> {error, {illegal_data_frame, Frame, OrigFrames, Acc}}
end;
Error ->
Error
end;
% out of frames
mldm(OrigFrames, [], Acc) ->
{error, {no_start_frame, Acc, OrigFrames}}.
-spec maybe_control_msg(Frame) -> Result
when Frame :: frame(),
Result :: {ok, Message}
| {error, Reason},
Message :: ws_msg(),
Reason :: any().
% @private
% assume the frame is a control frame, validate it, and unmask the payload
%
% TODO: this doesn't enforce that messages from the client HAVE to be masked,
% which strictly speaking is part of the protocol.
maybe_control_msg(F = #frame{fin = true,
opcode = Opcode,
mask = Mask,
payload_length = Len,
masking_key = Key,
payload = Payload})
when ((Opcode =:= close) orelse (Opcode =:= ping) orelse (Opcode =:= pong))
andalso (Len =< 125) ->
case maybe_unmask(F, Mask, Key, Payload) of
{ok, UnmaskedPayload} ->
Msg = {Opcode, UnmaskedPayload},
{ok, Msg};
Error ->
Error
end;
maybe_control_msg(F) ->
{error, {illegal_frame, F}}.
-spec maybe_unmask(Frame, Mask, Key, Payload) -> Result
when Frame :: frame(),
Mask :: boolean(),
Key :: <<>> | <<_:32>>,
Payload :: binary(),
Result :: {ok, Unmasked}
| {error, Reason},
Unmasked :: binary(),
Reason :: any().
% @private
% unmask the payload
% @end
% eliminate invalid pairs of {mask, masking_key}
maybe_unmask(_, true, <<Key:4/bytes>>, Payload) -> {ok, mask_unmask(Key, Payload)};
maybe_unmask(_, false, <<>>, Payload) -> {ok, Payload};
maybe_unmask(F, true, <<>>, _) -> {error, {illegal_frame, F}};
maybe_unmask(F, false, <<_:4/bytes>>, _) -> {error, {illegal_frame, F}}.
%% invertible
%% see: https://datatracker.ietf.org/doc/html/rfc6455#section-5.3
mask_unmask(Key = <<_:4/bytes>>, Payload) ->
mu(Key, Key, Payload, <<>>).
% essentially this is a modular zipWith xor of the masking key with the payload
mu(Key, <<KeyByte:8, KeyRest/binary>>, <<PayloadByte:8, PayloadRest/binary>>, Acc) ->
NewByte = KeyByte bxor PayloadByte,
NewAcc = <<Acc/binary, NewByte:8>>,
mu(Key, KeyRest, PayloadRest, NewAcc);
% this is the case where we need to refresh the active key
mu(Key, <<>>, Payload, Acc) ->
mu(Key, Key, Payload, Acc);
% done
mu(_, _, <<>>, Acc) ->
Acc.
-spec recv_frame(Parsed, Socket, Received, TimeoutMS) -> Result
when Parsed :: frame(),
Socket :: gen_tcp:socket(),
Received :: bitstring(),
TimeoutMS :: non_neg_integer(),
Result :: {ok, frame(), Remainder}
| {error, Reason},
Remainder :: bitstring(),
Reason :: any().
% @private
% parse a single frame off the socket
% @end
%% frame: 1 bit
recv_frame(Frame = #frame{fin = none}, Sock, <<FinBit:1, Rest/bits>>, Timeout) ->
NewFin =
case FinBit of
0 -> false;
1 -> true
end,
NewFrame = Frame#frame{fin = NewFin},
recv_frame(NewFrame, Sock, Rest, Timeout);
recv_frame(Frame = #frame{fin = none}, Sock, Received = <<>>, Timeout) ->
recv_frame_await(Frame, Sock, Received, Timeout);
%% rsv: 3 bits
recv_frame(Frame = #frame{rsv = none}, Sock, <<RSV:3/bits, Rest/bits>>, Timeout) ->
NewFrame = Frame#frame{rsv = RSV},
recv_frame(NewFrame, Sock, Rest, Timeout);
recv_frame(Frame = #frame{rsv = none}, Sock, Received, Timeout) ->
recv_frame_await(Frame, Sock, Received, Timeout);
%% opcode: 4 bits
recv_frame(Frame = #frame{opcode = none}, Sock, <<OpcodeInt:4, Rest/bits>>, Timeout) ->
Opcode =
case OpcodeInt of
0 -> continuation;
1 -> text;
2 -> binary;
8 -> close;
9 -> ping;
10 -> pong;
_ -> bad_opcode
end,
case Opcode of
bad_opcode ->
{error, {bad_opcode, OpcodeInt}};
_ ->
NewFrame = Frame#frame{opcode = Opcode},
recv_frame(NewFrame, Sock, Rest, Timeout)
end;
recv_frame(Frame = #frame{opcode = none}, Sock, Received, Timeout) ->
recv_frame_await(Frame, Sock, Received, Timeout);
%% mask: 1 bit
recv_frame(Frame = #frame{mask = none}, Sock, <<MaskBit:1, Rest/bits>>, Timeout) ->
NewMask =
case MaskBit of
0 -> false;
1 -> true
end,
NewFrame = Frame#frame{mask = NewMask},
recv_frame(NewFrame, Sock, Rest, Timeout);
recv_frame(Frame = #frame{mask = none}, Sock, Received = <<>>, Timeout) ->
recv_frame_await(Frame, Sock, Received, Timeout);
%% payload length: variable (yay)
% first case: short length 0..125
recv_frame(Frame = #frame{payload_length = none}, Sock, <<Len:7, Rest/bits>>, Timeout) when Len =< 125 ->
NewFrame = Frame#frame{payload_length = Len},
recv_frame(NewFrame, Sock, Rest, Timeout);
% second case: 126 -> 2 bytes to follow
recv_frame(Frame = #frame{payload_length = none}, Sock, <<126:7, Len:16, Rest/bits>>, Timeout) ->
NewFrame = Frame#frame{payload_length = Len},
recv_frame(NewFrame, Sock, Rest, Timeout);
% third case: 127 -> 8 bytes to follow
% bytes must start with a 0 bit
recv_frame(_Frame = #frame{payload_length = none}, _Sock, <<127:7, 1:1, _/bits>>, _Timeout) ->
{error, {illegal_frame, "payload length >= 1 bsl 63"}};
% 127, next is a legal length, continue
recv_frame(Frame = #frame{payload_length = none}, Sock, <<127:7, Len:64, Rest/bits>>, Timeout) ->
NewFrame = Frame#frame{payload_length = Len},
recv_frame(NewFrame, Sock, Rest, Timeout);
% otherwise wait
recv_frame(Frame = #frame{payload_length = none}, Sock, Received, Timeout) ->
recv_frame_await(Frame, Sock, Received, Timeout);
%% masking key: 0 or 4 bits
% not expecting a masking key, fill in that field here
recv_frame(Frame = #frame{mask = false, masking_key = none}, Sock, Received, Timeout) ->
NewFrame = Frame#frame{masking_key = <<>>},
recv_frame(NewFrame, Sock, Received, Timeout);
% expecting one
recv_frame(Frame = #frame{mask = true, masking_key = none}, Sock, <<Key:4/bytes, Rest/bits>>, Timeout) ->
NewFrame = Frame#frame{masking_key = Key},
recv_frame(NewFrame, Sock, Rest, Timeout);
% not found
recv_frame(Frame = #frame{mask = true, masking_key = none}, Sock, Received, Timeout) ->
recv_frame_await(Frame, Sock, Received, Timeout);
%% payload
recv_frame(Frame = #frame{payload_length = Len, payload = none}, Sock, Received, Timeout) when is_integer(Len) ->
case Received of
% we have enough bytes
<<Payload:Len/bytes, Rest/bits>> ->
FinalFrame = Frame#frame{payload = Payload},
{ok, FinalFrame, Rest};
% we do not have enough bytes
_ ->
recv_frame_await(Frame, Sock, Received, Timeout)
end.
%% factoring this out into a function to reduce repetition
recv_frame_await(Frame, Sock, Received, Timeout) ->
case inet:setopts(Sock, [{active, once}]) of
ok ->
receive
{tcp, Sock, Bin} -> recv_frame(Frame, Sock, <<Received/bits, Bin/binary>>, Timeout);
{tcp_closed, Sock} -> {error, tcp_closed};
{tcp_error, Sock, Reason} -> {error, {tcp_error, Reason}}
after Timeout ->
{error, timeout}
end;
{error, Reason} ->
{error, {inet, Reason}}
end.
-spec send(Socket, Message) -> Result
when Socket :: gen_tcp:socket(),
Message :: ws_msg(),
Result :: ok
| {error, Reason},
Reason :: any().
% @doc
% send message to client over Socket. handles frame nonsense
%
% max payload size is 2^63 - 1 bytes
% @end
send(Socket, {Type, Payload}) ->
tell("fd_ws: send(~tp, {~tp, ~tp})", [Socket, Type, Payload]),
BPayload = payload_to_binary(Payload),
tell("fd_ws: BPayload = ~tp", [BPayload]),
Frame = message_to_frame(Type, BPayload),
tell("fd_ws: Frame = ~tp", [Frame]),
send_frame(Socket, Frame).
payload_to_binary(Bin) when is_binary(Bin) -> Bin;
payload_to_binary(X) -> unicode:characters_to_binary(X).
% data messages
message_to_frame(Data, Payload)
when ((Data =:= text) orelse (Data =:= binary)),
is_binary(Payload),
(byte_size(Payload) =< ?MAX_PAYLOAD_SIZE) ->
#frame{fin = true,
opcode = Data,
payload_length = byte_size(Payload),
payload = Payload};
message_to_frame(Control, Payload)
when ((Control =:= close) orelse (Control =:= ping) orelse (Control =:= pong)),
is_binary(Payload),
(byte_size(Payload) =< 125) ->
#frame{fin = true,
opcode = Control,
payload_length = byte_size(Payload),
payload = Payload}.
-spec send_frame(Sock, Frame) -> Result
when Sock :: gen_tcp:socket(),
Frame :: frame(),
Result :: ok
| {error, Reason},
Reason :: tcp_error().
% @private
% send a frame on the socket
% @end
send_frame(Sock, Frame) ->
Binary = render_frame(Frame),
tell("send_frame: rendered frame: ~tp", [Binary]),
gen_tcp:send(Sock, Binary).
-spec render_frame(Frame) -> Binary
when Frame :: frame(),
Binary :: binary().
% @private
% render a frame
%
% All fields in a `#frame{}` record have default values of `none`.
%
% ```erlang
% -record(frame,
% {fin = none :: none | boolean(),
% rsv = none :: none | <<_:3>>,
% opcode = none :: none | opcode(),
% mask = none :: none | boolean(),
% payload_length = none :: none | non_neg_integer(),
% masking_key = none :: none | <<>> | <<_:32>>,
% payload = none :: none | binary()}).
% ```
%
% Given a value of `none`, some of these fields are inferred, some cannot be
% inferred.
%
% Inference cases:
%
% ```
% rsv = none -> <<0:3>>
% mask = none -> false
% masking_key = none -> <<>>
% payload_length = none -> byte_size(Payload)
% ```
%
% Non-inference:
%
% ```
% fin
% opcode
% payload
% ```
% @end
render_frame(#frame{fin = Fin,
rsv = RSV,
opcode = Opcode,
mask = Mask,
payload_length = Len,
masking_key = MaskingKey,
payload = Payload}) ->
BFin =
case Fin of
true -> <<1:1>>;
false -> <<0:1>>
end,
BRSV =
case RSV of
none -> <<0:3>>;
<<_:3>> -> RSV;
_ -> error({illegal_rsv, RSV})
end,
BOpcode =
case Opcode of
continuation -> << 0:4>>;
text -> << 1:4>>;
binary -> << 2:4>>;
close -> << 8:4>>;
ping -> << 9:4>>;
pong -> <<10:4>>
end,
BoolMask =
case Mask of
none -> false;
false -> false;
true -> true
end,
BMask =
case BoolMask of
true -> <<1:1>>;
false -> <<0:1>>
end,
IntPayloadLength =
case Len of
none -> byte_size(Payload);
_ -> Len
end,
BPayloadLength = render_payload_length(IntPayloadLength),
BMaskingKey =
case {BoolMask, MaskingKey} of
{false, none} -> <<>>;
{false, <<>>} -> <<>>;
{true, <<BKey:4/bytes>>} -> BKey;
{false, _} -> error({not_masking_but_have_masking_key, {Mask, MaskingKey}});
{true, _} -> error({illegal_masking_key, MaskingKey})
end,
% failure case here is same as error case just above, so no need to worry
% about cryptic "illegal frame" message
%
% masking = unmasking, so `maybe_unmask` is a bit of a misnomer
{ok, BPayload} = maybe_unmask(#frame{}, BoolMask, BMaskingKey, Payload),
<<BFin/bits,
BRSV/bits,
BOpcode/bits,
BMask/bits,
BPayloadLength/bits,
BMaskingKey/binary,
BPayload/binary>>.
-spec render_payload_length(non_neg_integer()) -> binary().
% @private
% > Payload length: 7 bits, 7+16 bits, or 7+64 bits
% >
% > The length of the "Payload data", in bytes: if 0-125, that is the
% > payload length. If 126, the following 2 bytes interpreted as a
% > 16-bit unsigned integer are the payload length. If 127, the
% > following 8 bytes interpreted as a 64-bit unsigned integer (the
% > most significant bit MUST be 0) are the payload length. Multibyte
% > length quantities are expressed in network byte order. Note that
% > in all cases, the minimal number of bytes MUST be used to encode
% > the length, for example, the length of a 124-byte-long string
% > can't be encoded as the sequence 126, 0, 124. The payload length
% > is the length of the "Extension data" + the length of the
% > "Application data". The length of the "Extension data" may be
% > zero, in which case the payload length is the length of the
% > "Application data".
render_payload_length(Len) when 0 =< Len, Len =< 125 ->
<<Len:7>>;
render_payload_length(Len) when 126 =< Len, Len =< 2#1111_1111_1111_1111 ->
<<126:7, Len:16>>;
render_payload_length(Len) when (1 bsl 16) =< Len, Len =< ?MAX_PAYLOAD_SIZE ->
<<127:7, Len:64>>.