diff --git a/include/http.hrl b/include/http.hrl index 014e058..4af646a 100644 --- a/include/http.hrl +++ b/include/http.hrl @@ -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(), diff --git a/priv/index.html b/priv/index.html index e49fb99..d1870aa 100644 --- a/priv/index.html +++ b/priv/index.html @@ -9,11 +9,17 @@

WFC Demo

+ +
- +

Settings

Auto-resize output
diff --git a/priv/ws-test-echo.html b/priv/ws-test-echo.html new file mode 100644 index 0000000..2c3d47d --- /dev/null +++ b/priv/ws-test-echo.html @@ -0,0 +1,65 @@ + + + + + Websockets echo test + + + +
+

Websockets echo test

+ +
+ + +
+
+ + + + diff --git a/src/fd_client.erl b/src/fd_client.erl index 47fbfa0..c254e74 100644 --- a/src/fd_client.erl +++ b/src/fd_client.erl @@ -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}}) -> diff --git a/src/fd_ws.erl b/src/fd_ws.erl index 1aaa823..a77f562 100644 --- a/src/fd_ws.erl +++ b/src/fd_ws.erl @@ -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, <>) -> +recv_frame(Frame = #frame{fin = none}, Sock, <>, 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, <>) -> +recv_frame(Frame = #frame{rsv = none}, Sock, <>, 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, <>) -> +recv_frame(Frame = #frame{opcode = none}, Sock, <>, Timeout) -> Opcode = case OpcodeInt of 0 -> continuation; @@ -614,55 +548,55 @@ recv_frame(Frame = #frame{opcode = none}, Sock, <>) -> {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, <>) -> +recv_frame(Frame = #frame{mask = none}, Sock, <>, 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, <>) when Len =< 125 -> +recv_frame(Frame = #frame{payload_length = none}, Sock, <>, 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, <>) -> +recv_frame(Frame = #frame{mask = true, masking_key = none}, Sock, <>, 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 <> -> @@ -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, <>); + {tcp, Sock, Bin} -> recv_frame(Frame, Sock, <>, 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