From 62d0710fcf8c47bf5a17bfbbcfd659f6cfe16359 Mon Sep 17 00:00:00 2001 From: Peter Harpending Date: Mon, 20 Oct 2025 20:02:02 -0700 Subject: [PATCH] committing brain-damaged websocket extensions bs this is just retarded, i'm just going to ignore --- src/fd_ws.erl | 318 +++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 276 insertions(+), 42 deletions(-) diff --git a/src/fd_ws.erl b/src/fd_ws.erl index 8ff67b6..c1ac61d 100644 --- a/src/fd_ws.erl +++ b/src/fd_ws.erl @@ -22,7 +22,9 @@ Result :: {ok, ClientProtocols, ClientExtensions, DraftResponse} | {error, Reason}, ClientProtocols :: [binary()], - ClientExtensions :: [binary()], + ClientExtensions :: [Extension], + Extension :: Naked :: binary(), + | Pair :: {binary(), binary()}, DraftResponse :: response(), Reason :: any(). % @doc @@ -41,88 +43,320 @@ % {"Connection", "Upgrade"}, % {"Upgrade", "websocket"}]. % -% YOU are responsible for dealing with any cookie logic, adding the retarded -% web date, rendering the response, etc. +% 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. 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_request}. + {error, bad_method}. -casefold_headers([{K, V} | Rest]) -> - [{unicode:characters_to_binary(string:casefold(K)), V} | casefold_headers(Rest)]; -casefold_headers([]) -> - []. -handshake2(Req = #request{headers = DowncaseHeaders}) -> +-spec casefold_headers(Headers) -> DowncaseHeaders + when Proplist :: [{Key, Value}], + Key :: binary(), + Value :: binary(), + LCProplist :: [{LowercaseKey, Value}], + LowercaseKey :: binary(). +% @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, + lists:map(Downcase, Headers). + + + +-spec handshake2(DowncaseReq) -> Result + when DowncaseReq :: request(), + Result :: {ok, ClientProtocols, ClientExtensions, DraftResponse} + | {error, Reason}, + ClientProtocols :: [binary()], + ClientExtensions :: [Extension] + Extension :: binary() | Option, + Option :: {Key :: binary(), Value :: binary()}, + 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" - MapHeaders = maps:from_list(DowncaseHeaders) - ClientProtocols = client_protocols(MapHeaders), - ClientExtensions = client_extensions(MapHeaders), - case validate_headers(MapHeaders) of - {ok, ResponseToken} -> - {ok, ClientProtocols, - ClientExtensions, + MapHeaders = maps:from_list(DowncaseHeaders), + ClientProtocols = client_protocols(MapHeaders), + ClientExtensions = client_extensions(DowncaseHeaders), + MaybeResponseToken = validate_headers(MapHeaders), + case {ClientExtensions, MaybeResponseToken} of + {{ok, Extensions}, {ok, ResponseToken}} -> + DraftResponse = #response{code = 101, slogan = "Switching Protocols", headers = [{"Sec-WebSocket-Accept", ResponseToken}, {"Connection", "Upgrade"}, - {"Upgrade", "websocket"}]}}; - Error -> + {"Upgrade", "websocket"}]}, + {ok, ClientProtocols, + Extensions, + DraftResponse}; + {{ok, _, _}, Error} -> + Error; + {Error, _} -> Error end. -client_protocols(#{<<"sec-websocket-protocol">> := CommaSeparatedProtocols}) -> - Protocols = string:split(CommaSeparatedProtocols, ",", all), - Clean = - fun(String) -> - unicode:characters_to_binary(string:trim(String)) - end, - lists:map(Clean, Protocols). -client_extensions(#{<<"sec-websocket-extensions">> := CommaSeparatedExtensions}) -> - Extensions = string:split(CommaSeparatedExtensions, ",", all), - Clean = - fun(String) -> - unicode:characters_to_binary(string:trim(String)) - end, - lists:map(Clean, Extensions). +-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) -> Result + when Headers :: [{Key, Val}], + Key :: binary(), + Val :: binary(), + Result :: {ok, Extensions} + | {error, Reason}, + Extensions :: [Extension], + Extension :: binary() + | {Key, Val}, + Reason :: any(). + +client_extensions(DowncaseHeaders) -> + UnfuckedExtensionsStr = unfuck_extensions_string(DowncaseHeaders, []), + client_extensions2(UnfuckedExtensionsStr). + + +-spec client_extensions2(UnfuckedExtensionsStr) +% > 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; az=2 +% +% Un is the unfucked (i.e. last version of that) +% +% it may be empty, meaning either +% +% 1. the client was being inarticulate, meaning they sent a +% "Sec-Websocket-Extensions: \r\n" header +% 2. there was no such header +% +% strictly speaking, we're supposed to close the connection if the client is +% being inarticulate. I don't feel like coding all that complexity in, so we're +% just going to treat that exactly as if the client had just not sent +% "sec-websocket-extensions". +client_extensions2(<<>>) -> + {ok, {[], []}}; +client_extensions2(UnfuckedExtensionsStr) -> + case string:split(UnfuckedExtensionsStr, ";", all) of + [CommaFields] -> + {ok, unfuck_comma_fields(CommaFields), []}; + [CommaFields | OptFields] -> + Extensions = unfuck_comma_fields(CommaFields), + case unfuck_options(OptFields, []) of + {ok, Options} -> {ok, Extensions, Options}; + Error -> Error + end; + _ -> + {error, {bad_extensions, UnfuckedExtensionsStr}} + end. + +% <<"hello, world, blah">> -> [<<"hello">>, <<"world">>, <<"blah">>] +unfuck_comma_fields(CSV0) -> + CSV1 = string:trim(CSV0), + Fields = string:split(CSV1, ","), + lists:map(fun circumcise/1, Fields). + + +circumcise(String) -> + unicode:characters_to_binary(string:trim(String)). + +% [<<"foo">>, <<"bar=baz">>, <<"quux">>, <<"fuzz=\"fizz\"">>] -> +% [<<"foo">>, {<<"bar">>, <<"baz">>}, <<"quux">>, {<<"fuzz">>, <<"fizz">>}] +unfuck_options([Optstr | Rest], Acc) -> + case unfuck_option(Optstr) of + {ok, Opt} -> unfuck_options(Rest, [Opt | Acc]); + Error -> Error + end; +unfuck_options([], Acc) -> + lists:reverse(Acc). + + +% <<"foo=bar">> -> {<<"foo", "bar">>} +unfuck_option(Str) -> + case string:split(Str, "=") of + [K, V] -> + case unfuck_val(circumcise(V)) of + {ok, Val} -> {ok, {circumcise(K), Val}}; + Error -> Error + end; + [Opt] -> {ok, circumcise(Opt)}; + _ -> {error, {bad_extension_param, Str}} + end. + + +% val can either be a naked string or a quoted string +unfuck_val(Whole = <<$":8, Rest/binary>>) -> + unquote(Whole, Rest, <<>>); +unfuck_val(X) -> + {ok, X}. + + + +-spec unquote(Orig, Parsing, Acc) -> Result + when Orig :: binary(), + Parsing :: binary(), + Acc :: binary(), + Result :: {ok, Unquoted} + | {error, Reason} + Unquoted :: binary(), + Reason :: any(). +% @private +% take the shit out of the quotes + +% trailing quote -> success +unquote(_, <<$">>, Acc) -> + {ok, Acc}; +% trailing quote and more stuff -> error +unquote(Orig, <<$", _/binary>>, _) -> + {error, {bad_extension_param, Orig}}; +% end of string before trailing quote +unquote(Orig, <<>>, _) -> + {error, {bad_extension_param, Orig}}; +unquote(Orig, <>, Acc) -> + unquote(Orig, Rest, <>). + + + +-spec unfuck_extensions_string(KVPairs) -> Unfucked + when KVPairs :: [{Key, Val}], + Key :: binary(), + Val :: binary(), + Unfucked :: 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 + +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 validate_headers(HeadersMap) -> Result + when HeadersMap :: #{Key :: binary() := Val :: binary()}, + Result :: {ok, ResponseToken} + | {error, Reason} + ResponseToken :: binary(), + Reason :: any(). +% @private +% validate: +% Upgrade: websocket +% Connection: 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 - bad_upgrade(Upgrade) -> {error, {bad_upgrade, Upgrade}}; - bad_connection(Connection) -> {error, {bad_connection, Connection}}; - bad_version(WS_Vsn) -> {error, {bad_version, WS_Vsn}}; - true -> {ok, response_token(ChallengeToken)} - end. + 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 -% string must include "websocket" as a token bad_upgrade(Str) -> case string:find(Str, "websocket") of nomatch -> true; _ -> false end. -% string must include "Upgrade" as a token + + +-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. -% version must be EXACTLY <<"13">> -bad_version(<<"13">> -> false; -bad_version(_) -> true. + + +-spec bad_version(binary()) +% @private version must be EXACTLY <<"13">> + +bad_version(<<"13">>) -> false; +bad_version(_) -> true. + -spec response_token(binary()) -> binary().