committing brain-damaged websocket extensions bs

this is just retarded, i'm just going to ignore

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
+% YOU are responsible for dealing with any cookie logic, authentication logic,
-% web date, rendering the response, etc.
+% 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)
+    MapHeaders         = maps:from_list(DowncaseHeaders),
-    ClientProtocols  = client_protocols(MapHeaders),
+    ClientProtocols    = client_protocols(MapHeaders),
-    ClientExtensions = client_extensions(MapHeaders),
+    ClientExtensions   = client_extensions(DowncaseHeaders),
-    case validate_headers(MapHeaders) of
+    MaybeResponseToken = validate_headers(MapHeaders),
-        {ok, ResponseToken} ->
+    case {ClientExtensions, MaybeResponseToken} of
-            {ok, ClientProtocols,
+        {{ok, Extensions}, {ok, ResponseToken}} ->
-                 ClientExtensions,
+            DraftResponse =
                  #response{code = 101,
                            slogan = "Switching Protocols",
                            headers = [{"Sec-WebSocket-Accept", ResponseToken},
                                       {"Connection",           "Upgrade"},
-                                      {"Upgrade",              "websocket"}]}};
+                                      {"Upgrade",              "websocket"}]},
-        Error ->
+            {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}};
+        BadUpgrade    -> {error, {bad_upgrade, Upgrade}};
-        bad_connection(Connection) -> {error, {bad_connection, Connection}};
+        BadConnection -> {error, {bad_connection, Connection}};
-        bad_version(WS_Vsn)        -> {error, {bad_version, WS_Vsn}};
+        BadVersion    -> {error, {bad_version, WS_Vsn}};
-        true                       -> {ok, response_token(ChallengeToken)}
+        true          -> {ok, response_token(ChallengeToken)}
-    end.
+    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().