committing brain-damaged websocket extensions bs

this is just retarded, i'm just going to ignore
This commit is contained in:
Peter Harpending 2025-10-20 20:02:02 -07:00
parent 9107679dfc
commit 62d0710fcf

View File

@ -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, <<Char:8, Rest/binary>>, Acc) ->
unquote(Orig, Rest, <<Acc/binary, Char:8>>).
-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().