pharpend/fewd
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

websockets work

Browse Source
This commit is contained in:
Peter Harpending 2025-10-21 17:12:59 -07:00
parent 7ed8b12c4e
commit 079c47962a
5 changed files with 206 additions and 142 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
include/http.hrl
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(),

8
priv/index.html
View File

@ -9,11 +9,17 @@
<div class="content">
<h1 class="content-title">WFC Demo</h1>
<ul>
<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>
<input autofocus id="wfc-input"></input>
<h2>Settings</h2>
<input type="checkbox" checked id="auto-resize-output">Auto-resize output</input> <br>

65
priv/ws-test-echo.html Normal file
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>

63
src/fd_client.erl
View File

@ -222,11 +222,13 @@ 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);
<<"/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 +239,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 +305,19 @@ 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.
wfcin(Sock, #request{enctype = json,
cookies = Cookies,
body = #{"wfcin" := Input}}) ->

210
src/fd_ws.erl
View File

@ -10,13 +10,16 @@
]).
-export([
%% time units
ms/0, sec/0, min/0, hr/0, day/0,
%% porcelain
handshake/1,
recv/2, recv/3,
recv/3, recv/4,
send/2
]).
-include("http.hrl").
-include("$zx_include/zx_logger.hrl").
-type request() :: #request{}.
-type response() :: #response{}.
@ -57,6 +60,13 @@
| {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(),
@ -114,11 +124,10 @@ handshake(_) ->
-spec casefold_headers(Headers) -> DowncaseHeaders
when Headers :: [{Key, Value}],
when Headers :: #{Key := Value},
Key :: binary(),
Value :: binary(),
DowncaseHeaders :: [{LowercaseKey, Value}],
LowercaseKey :: binary().
DowncaseHeaders :: Headers.
% @private
% casefold all the keys in the header because they're case insensitive
@ -128,16 +137,14 @@ casefold_headers(Headers) ->
NewKey = unicode:characters_to_binary(string:casefold(K)),
{NewKey, V}
end,
lists:map(Downcase, Headers).
maps:from_list(lists:map(Downcase, maps:to_list(Headers))).
-spec handshake2(DowncaseReq) -> Result
when DowncaseReq :: request(),
Result :: {ok, ClientProtocols, ClientExtensions, DraftResponse}
Result :: {ok, DraftResponse}
| {error, Reason},
ClientProtocols :: [binary()],
ClientExtensions :: binary(),
DraftResponse :: response(),
Reason :: any().
% @private
@ -149,10 +156,7 @@ handshake2(#request{headers = DowncaseHeaders}) ->
% sec-websocket-version: 13 % must be EXACTLY 13
% connection: Upgrade % must include the token "Upgrade"
% upgrade: websocket % must include the token "websocket"
ClientProtocols = client_protocols(DowncaseHeaders),
ClientExtensions = client_extensions(DowncaseHeaders),
MapHeaders = maps:from_list(DowncaseHeaders),
MaybeResponseToken = validate_headers(MapHeaders),
MaybeResponseToken = validate_headers(DowncaseHeaders),
case MaybeResponseToken of
{ok, ResponseToken} ->
DraftResponse =
@ -161,86 +165,13 @@ handshake2(#request{headers = DowncaseHeaders}) ->
headers = [{"Sec-WebSocket-Accept", ResponseToken},
{"Connection", "Upgrade"},
{"Upgrade", "websocket"}]},
{ok, ClientProtocols,
ClientExtensions,
DraftResponse};
{ok, DraftResponse};
Error ->
Error
end.
-spec client_protocols(Headers) -> Protocols
when Headers :: [{binary(), binary()}],
Protocols :: [binary()].
% @private
% needs to loop through all the headers and unfuck multiline bullshit
client_protocols(FuckedHeaders) ->
unfuck_protocol_string(FuckedHeaders, []).
unfuck_protocol_string([{<<"sec-websocket-protocol">>, Part} | Rest], Acc) ->
unfuck_protocol_string(Rest, [Part | Acc]);
unfuck_protocol_string([_ | Rest], Acc) ->
unfuck_protocol_string(Rest, Acc);
unfuck_protocol_string([], PartsRev) ->
Parts = lists:reverse(PartsRev),
% have to join everything together and then re-split
CSVBin = unicode:characters_to_binary(lists:join(", ", Parts)),
% after the surgery
TrannyParts = string:split(CSVBin, ",", all),
% trim the parts
JewParts = lists:map(fun circumcise/1, TrannyParts),
JewParts.
-spec client_extensions(Headers) -> binary()
when Headers :: [{Key, Val}],
Key :: binary(),
Val :: binary().
% @private
% 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
%
% basically have to go through the entire proplist of headers, and if it
% matches <<"sec-websocket-extensions">>, then csv its value to the thing
% @end
client_extensions(DowncaseHeaders) ->
unfuck_extensions_string(DowncaseHeaders, []).
unfuck_extensions_string([{<<"sec-websocket-extensions">>, Part} | Rest], Acc) ->
unfuck_extensions_string(Rest, [Part | Acc]);
unfuck_extensions_string([_ | Rest], Acc) ->
unfuck_extensions_string(Rest, Acc);
unfuck_extensions_string([], PartsRev) ->
% in the example above, PartsRev = [<<"bar; baz=2">>, <<"foo">>],
% so need to reverse and then join with commas
circumcise(lists:join(<<", ">>, lists:reverse(PartsRev))).
-spec circumcise(unicode:chardata()) -> binary().
% @private delete leading/trailing whitespace then convert to binary
circumcise(String) ->
unicode:characters_to_binary(string:trim(String)).
-spec validate_headers(HeadersMap) -> Result
when HeadersMap :: #{Key :: binary() := Val :: binary()},
Result :: {ok, ResponseToken}
@ -336,9 +267,10 @@ response_token(ChallengeToken) when is_binary(ChallengeToken) ->
-spec recv(Socket, Received) -> Result
-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(),
@ -348,14 +280,15 @@ response_token(ChallengeToken) when is_binary(ChallengeToken) ->
% @doc
% Equivalent to recv(Socket, Received, [])
recv(Sock, Recv) ->
recv(Sock, Recv, []).
recv(Sock, Recv, TimeoutMS) ->
recv(Sock, Recv, TimeoutMS, []).
-spec recv(Socket, Received, Frames) -> Result
-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},
@ -366,15 +299,15 @@ recv(Sock, Recv) ->
% @doc
% Pull a message off the socket
recv(Sock, Received, Frames) ->
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) of
case recv_frame(#frame{}, Sock, Received, Timeout) of
{ok, Frame, NewReceived} ->
NewFrames = [Frame | Frames],
recv(Sock, NewReceived, NewFrames);
recv(Sock, NewReceived, Timeout, NewFrames);
Error ->
Error
end;
@ -568,10 +501,11 @@ mu(_, _, <<>>, Acc) ->
-spec recv_frame(Parsed, Socket, Received) -> Result
-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(),
@ -581,24 +515,24 @@ mu(_, _, <<>>, Acc) ->
% @end
%% frame: 1 bit
recv_frame(Frame = #frame{fin = none}, Sock, <<FinBit:1, Rest/bits>>) ->
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);
recv_frame(Frame = #frame{fin = none}, Sock, Received = <<>>) ->
recv_frame_await(Frame, Sock, Received);
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>>) ->
recv_frame(Frame = #frame{rsv = none}, Sock, <<RSV:3/bits, Rest/bits>>, Timeout) ->
NewFrame = Frame#frame{rsv = RSV},
recv_frame(NewFrame, Sock, Rest);
recv_frame(Frame = #frame{rsv = none}, Sock, Received) ->
recv_frame_await(Frame, Sock, Received);
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>>) ->
recv_frame(Frame = #frame{opcode = none}, Sock, <<OpcodeInt:4, Rest/bits>>, Timeout) ->
Opcode =
case OpcodeInt of
0 -> continuation;
@ -614,55 +548,55 @@ recv_frame(Frame = #frame{opcode = none}, Sock, <<OpcodeInt:4, Rest/bits>>) ->
{error, {bad_opcode, OpcodeInt}};
_ ->
NewFrame = Frame#frame{opcode = Opcode},
recv_frame(NewFrame, Sock, Rest)
recv_frame(NewFrame, Sock, Rest, Timeout)
end;
recv_frame(Frame = #frame{opcode = none}, Sock, Received) ->
recv_frame_await(Frame, Sock, Received);
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>>) ->
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);
recv_frame(Frame = #frame{mask = none}, Sock, Received = <<>>) ->
recv_frame_await(Frame, Sock, Received);
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>>) when Len =< 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);
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>>) ->
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);
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>>) ->
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>>) ->
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);
recv_frame(NewFrame, Sock, Rest, Timeout);
% otherwise wait
recv_frame(Frame = #frame{payload_length = none}, Sock, Received) ->
recv_frame_await(Frame, Sock, Received);
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) ->
recv_frame(Frame = #frame{mask = false, masking_key = none}, Sock, Received, Timeout) ->
NewFrame = Frame#frame{masking_key = <<>>},
recv_frame(NewFrame, Sock, Received);
recv_frame(NewFrame, Sock, Received, Timeout);
% expecting one
recv_frame(Frame = #frame{mask = true, masking_key = none}, Sock, <<Key:4/bytes, Rest/bits>>) ->
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);
recv_frame(NewFrame, Sock, Rest, Timeout);
% not found
recv_frame(Frame = #frame{mask = true, masking_key = none}, Sock, Received) ->
recv_frame_await(Frame, Sock, Received);
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) when is_integer(Len) ->
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>> ->
@ -670,20 +604,20 @@ recv_frame(Frame = #frame{payload_length = Len, payload = none}, Sock, Received)
{ok, FinalFrame, Rest};
% we do not have enough bytes
_ ->
recv_frame_await(Frame, Sock, Received)
recv_frame_await(Frame, Sock, Received, Timeout)
end.
%% factoring this out into a function to reduce repetition
recv_frame_await(Frame, Sock, Received) ->
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>>);
{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 3000 ->
after Timeout ->
{error, timeout}
end;
{error, Reason} ->
@ -705,8 +639,11 @@ recv_frame_await(Frame, Sock, Received) ->
% @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;
@ -745,6 +682,7 @@ message_to_frame(Control, Payload)
send_frame(Sock, Frame) ->
Binary = render_frame(Frame),
tell("send_frame: rendered frame: ~tp", [Binary]),
gen_tcp:send(Sock, Binary).
@ -809,12 +747,12 @@ render_frame(#frame{fin = Fin,
end,
BOpcode =
case Opcode of
continuation -> << 0:1>>;
text -> << 1:1>>;
binary -> << 2:1>>;
close -> << 8:1>>;
ping -> << 9:1>>;
pong -> <<10:1>>
continuation -> << 0:4>>;
text -> << 1:4>>;
binary -> << 2:4>>;
close -> << 8:4>>;
ping -> << 9:4>>;
pong -> <<10:4>>
end,
BoolMask =
case Mask of