%%% @doc %%% The Quick HTTP Library %%% This is not an HTTP server, but rather a library from which a fast HTTP server %%% can be built. Building out a server with QHL requires minimum effort but maximum %%% knowledge. Calling code needs to maintain the socket, own the process loop, etc. %%% %%% QHL does not help you form the return response body -- that is entirely up to you. %%% @end -module(qhl). -vsn("0.2.0"). -author("Craig Everett "). -copyright("Craig Everett "). -license("MIT"). -export([parse/2, parse/3, recv/2, resp/2, percent_encode/1, percent_decode/1, join/1, ridiculous_web_date/0, ridiculous_web_date/1, slogan/1, break_nl/1, unbreak_nl/1, clean/1, bin_to_int/1]). -include("http.hrl"). -spec parse(Socket, Received) -> Result when Socket :: gen_tcp:socket(), Received :: binary(), Result :: {ok, #request{}} | {error, Reason}, Reason :: term(). % FIXME %% @doc %% @equiv parse(Socket, Received, #request{}) parse(Socket, Received) -> parse(Socket, Received, #request{}). -spec parse(Socket, Received, Request) -> Result when Socket :: gen_tcp:socket(), Received :: binary(), Request :: #request{}, Result :: {ok, #request{}} | {error, Reason}, Reason :: term(). % FIXME %5 @doc %% Pass this function the connection socket and whatever the receive loop has acquired, %% and receive back a parsed #request{} record. This requires that you have imported %% the `http.hrl' and set `{mode, binary}' and `{active, once}' options on the %% socket. parse(Socket, Received, M = #request{method = undefined}) -> io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]), case read_method(Socket, Received) of {ok, Method, Rest} -> parse(Socket, Rest, M#request{method = Method}); Error -> Error end; parse(Socket, Received, M = #request{path = undefined}) -> io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]), case read_path(Socket, Received) of {ok, Path, Rest} -> parse(Socket, Rest, M#request{path = Path}); Error -> Error end; parse(Socket, Received, M = #request{qargs = undefined}) -> io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]), case read_qargs(Socket, Received) of {ok, Qargs, Rest} -> parse(Socket, Rest, M#request{qargs = Qargs}); Error -> Error end; parse(Socket, Received, M = #request{fragment = undefined}) -> io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]), case read_fragment(Socket, Received) of {ok, Fragment, Rest} -> parse(Socket, Rest, M#request{fragment = Fragment}); Error -> Error end; parse(Socket, Received, M = #request{version = undefined}) -> io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]), case read_version(Socket, Received) of {ok, Version, Rest} -> parse(Socket, Rest, M#request{version = Version}); Error -> Error end; parse(Socket, Received, M = #request{headers = undefined}) -> io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]), case read_headers(Socket, Received) of {ok, Headers, Rest} -> parse(Socket, Rest, M#request{headers = Headers}); Error -> Error end; parse(Socket, Received, M = #request{enctype = undefined}) -> io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]), case read_enctype(M) of {ok, Enctype} -> parse(Socket, Received, M#request{enctype = Enctype}); Error -> Error end; parse(Socket, Received, M = #request{cookies = undefined}) -> io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]), case read_cookies(M) of {ok, Cookies} -> parse(Socket, Received, M#request{cookies = Cookies}); Error -> Error end; parse(Socket, Received, M = #request{size = undefined}) -> io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]), case read_size(M) of {ok, 0} -> {ok, M#request{size = 0}, none}; {ok, Size} -> parse(Socket, Received, M#request{size = Size}); Error -> Error end; parse(Socket, Received, M = #request{method = get, body = undefined, size = Size}) -> io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]), case read_body(Received, Size) of {ok, Body} -> {ok, M#request{body = Body}, none}; {ok, Body, Next} -> {ok, M#request{body = Body}, Next}; {incomplete, Body} -> accumulate(Socket, M#request{body = Body}); Error -> Error end; parse(Socket, Received, M = #request{body = undefined, method = post, enctype = urlencoded, size = Size}) -> io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]), case read_body(Received, Size) of {ok, Body} -> {ok, M#request{body = parts_to_map(posted(Body))}, none}; {ok, Body, Next} -> {ok, M#request{body = parts_to_map(posted(Body))}, Next}; {incomplete, Body} -> case accumulate(Socket, M#request{body = Body}) of {ok, NewM = #request{body = NewBody}} -> {ok, NewM#request{body = parts_to_map(posted(NewBody))}, none}; {ok, NewM = #request{body = NewBody}, More} -> {ok, NewM#request{body = parts_to_map(posted(NewBody))}, More}; Error -> Error end; Error -> Error end; parse(Socket, Received, M = #request{body = undefined, method = post, enctype = {multipart, Boundary}, size = Size}) -> io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]), case read_multipart(Socket, Received, Boundary, Size) of {ok, Parts} -> {ok, M#request{body = parts_to_map(Parts)}, none}; {ok, Parts, Next} -> {ok, M#request{body = parts_to_map(Parts)}, Next}; Error -> Error end; parse(Socket, Received, M = #request{body = undefined, method = post, enctype = json, size = Size}) -> io:format("~p parse(~p, ~p, ~p)~n", [?LINE, Socket, Received, M]), case read_body(Received, Size) of {ok, Body} -> read_json(M#request{body = Body}, none); {ok, Body, Next} -> read_json(M#request{body = Body}, Next); {incomplete, Body} -> io:format("~p {incomplete, ~p}~n", [?LINE, Body]), case accumulate(Socket, M#request{body = Body}) of {ok, NewM = #request{body = NewBody}} -> read_json(NewM#request{body = NewBody}, none); {ok, NewM = #request{body = NewBody}, More} -> read_json(NewM#request{body = NewBody}, More); Error -> Error end; Error -> Error end. read_json(R = #request{body = Text}, Next) -> case zj:decode(Text) of {ok, JSON} -> {ok, R#request{body = JSON}, Next}; Error -> Error end. % FIXME: The map version of body elements is inferior to the proplist version. % When checking input elements it is much nicer to have a general return % over a fold that can contain errors and use this as a universal idiom % and then build "unfuck your input please" type error pages for the user % based on that than matching map keys and then writing exhaustive drop-through % checks when all this could happen in a single pass more simply. parts_to_map(Parts) -> lists:foldl(fun parts_to_map/2, #{}, Parts). parts_to_map({Key, Value}, Map) -> AddPart = fun(Values) -> [Value | Values] end, maps:update_with(Key, AddPart, [Value], Map). read_method(_, <<"GET ", Rest/binary>>) -> {ok, get, Rest}; read_method(_, <<"POST ", Rest/binary>>) -> {ok, post, Rest}; read_method(_, <<"OPTIONS ", Rest/binary>>) -> {ok, options, Rest}; read_method(Socket, Received) when byte_size(Received) < 7 -> case inet:setopts(Socket, [{active, once}]) of ok -> receive {tcp, Socket, Bin} -> read_method(Socket, <>); {tcp_closed, Socket} -> {error, tcp_closed}; {tcp_error, Socket, Reason} -> {error, {tcp_error, Reason}} after 3000 -> {error, timeout} end; {error, Reason} -> {error, {inet, Reason}} end; read_method(_, _) -> {error, method}. read_path(Socket, Received) -> read_path(Socket, Received, <<>>). read_path(_, <<" ", _/binary>>, <<>>) -> {error, path}; read_path(_, <<"\r", _/binary>>, _) -> {error, path}; read_path(_, <<"\n", _/binary>>, _) -> {error, path}; read_path(_, <<" ", Rest/binary>>, Path) -> {ok, Path, Rest}; read_path(_, Rest = <<"?", _/binary>>, Path) -> {ok, Path, Rest}; read_path(Socket, <<>>, Acc) -> ok = inet:setopts(Socket, [{active, once}]), receive {tcp, Socket, Bin} -> read_path(Socket, Bin, Acc); {tcp_closed, Socket} -> {error, tcp_closed}; {tcp_error, Socket, Reason} -> {error, {tcp_error, Reason}} after 3000 -> {error, timeout} end; read_path(Socket, <>, Acc) -> read_path(Socket, Rest, <>). read_qargs(_, <<"? ", Other/binary>>) -> {ok, #{}, Other}; read_qargs(Socket, <<"?", QString/binary>>) -> read_qargs(Socket, QString, #{}); read_qargs(_, Other) -> {ok, #{}, Other}. read_qargs(Socket, Bin, Qargs) -> read_qkey(Socket, Bin, <<>>, Qargs). read_qkey(_, <<" ", _/binary>>, _, _) -> {error, qargs}; read_qkey(_, <<"\r", _/binary>>, _, _) -> {error, qargs}; read_qkey(_, <<"\n", _/binary>>, _, _) -> {error, qargs}; read_qkey(_, <<"=", _/binary>>, <<>>, _) -> {error, qargs}; read_qkey(Socket, <<"=", Rest/binary>>, Key, Qargs) -> read_qval(Socket, Rest, <<>>, Key, Qargs); read_qkey(Socket, <>, Acc, Qargs) -> read_qkey(Socket, Rest, <>, Qargs); read_qkey(Socket, <<>>, Acc, Qargs) -> ok = inet:setopts(Socket, [{active, once}]), receive {tcp, Socket, Bin} -> read_qkey(Socket, Bin, Acc, Qargs); {tcp_closed, Socket} -> {error, tcp_closed}; {tcp_error, Socket, Reason} -> {error, {tcp_error, Reason}} after 3000 -> {error, timeout} end. read_qval(_, <<" ", _/binary>>, <<>>, _, _) -> {error, qargs}; read_qval(_, <<" ", Rest/binary>>, Val, Key, Qargs) -> {ok, maps:put(Key, Val, Qargs), Rest}; read_qval(_, <<"&", _/binary>>, <<>>, _, _) -> {error, qargs}; read_qval(Socket, <<"&", Rest/binary>>, Val, Key, Qargs) -> read_qargs(Socket, Rest, maps:put(Key, Val, Qargs)); read_qval(_, <<"?", _/binary>>, _, _, _) -> {error, qargs}; read_qval(_, <<"\r", _/binary>>, _, _, _) -> {error, qargs}; read_qval(_, <<"\n", _/binary>>, _, _, _) -> {error, qargs}; read_qval(Socket, <>, Acc, Key, Qargs) -> read_qval(Socket, Rest, <>, Key, Qargs); read_qval(Socket, <<>>, Acc, Key, Qargs) -> ok = inet:setopts(Socket, [{active, once}]), receive {tcp, Socket, Bin} -> read_qval(Socket, Bin, Acc, Key, Qargs); {tcp_closed, Socket} -> {error, tcp_closed}; {tcp_error, Socket, Reason} -> {error, {tcp_error, Reason}} after 3000 -> {error, timeout} end. read_fragment(Socket, <<"#", Rest/binary>>) -> read_fragment(Socket, Rest, <<>>); read_fragment(_, Rest) -> {ok, none, Rest}. read_fragment(_, <<" ", Rest/binary>>, <<>>) -> {ok, none, Rest}; read_fragment(_, <<" ", Rest/binary>>, Fragment) -> {ok, Fragment, Rest}; read_fragment(_, <<"\r", _/binary>>, _) -> {error, fragment}; read_fragment(_, <<"\n", _/binary>>, _) -> {error, fragment}; read_fragment(Socket, <>, Acc) -> read_fragment(Socket, Rest, <>); read_fragment(Socket, <<>>, Acc) -> ok = inet:setopts(Socket, [{active, once}]), receive {tcp, Socket, Bin} -> read_fragment(Socket, Bin, Acc); {tcp_closed, Socket} -> {error, tcp_closed}; {tcp_error, Socket, Reason} -> {error, {tcp_error, Reason}} after 3000 -> {error, timeout} end. read_version(_, <<"HTTP/1.0\r\n", Rest/binary>>) when byte_size(Rest) > 0 -> {ok, http10, Rest}; read_version(_, <<"HTTP/1.1\r\n", Rest/binary>>) when byte_size(Rest) > 0 -> {ok, http11, Rest}; read_version(_, <<"HTTP/2.0\r\n", Rest/binary>>) when byte_size(Rest) > 0 -> {ok, http20, Rest}; read_version(Socket, Acc) when byte_size(Acc) =< 10 -> ok = inet:setopts(Socket, [{active, once}]), receive {tcp, Socket, Bin} -> read_version(Socket, <>); {tcp_closed, Socket} -> {error, tcp_closed}; {tcp_error, Socket, Reason} -> {error, {tcp_error, Reason}} after 3000 -> {error, timeout} end; read_version(_, _) -> {error, version}. read_headers(Socket, <<"\r">>) -> ok = inet:setopts(Socket, [{active, once}]), receive {tcp, Socket, Bin} -> read_headers(Socket, <<"\r", Bin/binary>>); {tcp_closed, Socket} -> {error, tcp_closed}; {tcp_error, Socket, Reason} -> {error, {tcp_error, Reason}} after 3000 -> {error, timeout} end; read_headers(_, <<"\r\n", _/binary>>) -> {error, headers}; read_headers(Socket, Received) -> read_hkey(Socket, Received, <<>>, #{}). read_hkey(Socket, <>, Acc, Headers) when $A =< Char, Char =< $Z -> read_hkey(Socket, Rest, <>, Headers); read_hkey(Socket, <>, Acc, Headers) when 32 =< Char, Char =< 57; 59 =< Char, Char =< 126 -> read_hkey(Socket, Rest, <>, Headers); read_hkey(Socket, <<":", Rest/binary>>, Key, Headers) -> skip_hblanks(Socket, Rest, Key, Headers); read_hkey(_, <<"\r\n", Rest/binary>>, <<>>, Headers) -> {ok, Headers, Rest}; read_hkey(Socket, <<>>, Acc, Headers) -> ok = inet:setopts(Socket, [{active, once}]), receive {tcp, Socket, Bin} -> read_hkey(Socket, Bin, Acc, Headers); {tcp_closed, Socket} -> {error, tcp_closed}; {tcp_error, Socket, Reason} -> {error, {tcp_error, Reason}} after 3000 -> {error, timeout} end; read_hkey(_, _, _, _) -> {error, headers}. skip_hblanks(Socket, <<" ", Rest/binary>>, Key, Headers) -> skip_hblanks(Socket, Rest, Key, Headers); skip_hblanks(Socket, <<>>, Key, Headers) -> ok = inet:setopts(Socket, [{active, once}]), receive {tcp, Socket, Bin} -> skip_hblanks(Socket, Bin, Key, Headers); {tcp_closed, Socket} -> {error, tcp_closed}; {tcp_error, Socket, Reason} -> {error, {tcp_error, Reason}} after 3000 -> {error, timeout} end; skip_hblanks(Socket, Rest, Key, Headers) -> read_hval(Socket, Rest, <<>>, Key, Headers). read_hval(Socket, <<"\r\n", Rest/binary>>, Val, Key, Headers) -> read_hkey(Socket, Rest, <<>>, maps:put(Key, Val, Headers)); read_hval(Socket, <>, Acc, Key, Headers) -> read_hval(Socket, Rest, <>, Key, Headers); read_hval(Socket, <<>>, Val, Key, Headers) -> ok = inet:setopts(Socket, [{active, once}]), receive {tcp, Socket, Bin} -> read_hval(Socket, Bin, Val, Key, Headers); {tcp_closed, Socket} -> {error, tcp_closed}; {tcp_error, Socket, Reason} -> {error, {tcp_error, Reason}} after 3000 -> {error, timeout} end; read_hval(_, _, _, _, _) -> {error, headers}. read_enctype(#request{method = get}) -> {ok, none}; read_enctype(#request{method = post, headers = Headers}) -> case maps:find(<<"content-type">>, Headers) of {ok, <<"multipart/form-data;", Rest/binary>>} -> get_boundary(Rest); {ok, <<"application/x-www-form-urlencoded">>} -> {ok, urlencoded}; {ok, <<"application/json">>} -> {ok, json}; {ok, WTF} -> {error, {enctype, WTF}}; error -> {error, no_enctype} end; read_enctype(#request{method = options}) -> {ok, none}. get_boundary(<<"boundary=", Boundary/binary>>) -> {ok, {multipart, Boundary}}; get_boundary(<<" ", Rest/binary>>) -> get_boundary(Rest); get_boundary(<<>>) -> {error, no_boundary}; get_boundary(_) -> {error, bad_enctype}. read_cookies(#request{headers = Headers}) -> case maps:find(<<"cookie">>, Headers) of {ok, Values} -> parse_cookies(Values); error -> {ok, #{}} end. parse_cookies(Values) -> {ok, read_ckey(Values, <<>>, #{})}. read_ckey(<<"=", Rest/binary>>, Acc, Cookies) -> read_cval(Rest, <<>>, Acc, Cookies); read_ckey(<>, Acc, Cookies) -> read_ckey(Rest, <>, Cookies); read_ckey(<<>>, <<>>, Cookies) -> Cookies; read_ckey(<<>>, Key, Cookies) -> case maps:is_key(Key, Cookies) of true -> Cookies; false -> maps:put(Key, <<>>, Cookies) end. read_cval(<<>>, Val, Key, Cookies) -> maps:put(Key, Val, Cookies); read_cval(<<";", Rest/binary>>, Val, Key, Cookies) -> skip_cblanks(Rest, maps:put(Key, Val, Cookies)); read_cval(<<",", Rest/binary>>, Val, Key, Cookies) -> skip_cblanks(Rest, maps:put(Key, Val, Cookies)); read_cval(<>, Acc, Key, Cookies) -> read_cval(Rest, <>, Key, Cookies). skip_cblanks(<<" ", Rest/binary>>, Cookies) -> skip_cblanks(Rest, Cookies); skip_cblanks(Rest, Cookies) -> read_ckey(Rest, <<>>, Cookies). read_size(#request{method = get}) -> {ok, 0}; read_size(#request{method = post, enctype = {multipart, _}, headers = Headers}) -> case maps:find(<<"content-length">>, Headers) of error -> {ok, none}; {ok, Size} -> try {ok, binary_to_integer(Size)} catch error:badarg -> {error, headers} end end; read_size(#request{method = post, headers = Headers}) -> case maps:find(<<"content-length">>, Headers) of error -> {ok, 0}; {ok, Size} -> try {ok, binary_to_integer(Size)} catch error:badarg -> {error, headers} end end; read_size(#request{method = options}) -> {ok, 0}. read_body(Received, Size) -> io:format("~p read_body(~p, ~p)~n", [?LINE, Received, Size]), case Received of <> -> {ok, Bin}; <> -> {ok, Bin, Next}; Bin when byte_size(Bin) < Size -> {incomplete, Bin} end. read_multipart(Socket, Received, Boundary, none) -> read_multipart3(Socket, Received, Boundary); read_multipart(Socket, Received, Boundary, Size) -> Remaining = Size - byte_size(Received), case accumulate(Socket, Remaining, Received) of {ok, Complete} -> read_multipart3(Socket, Complete, Boundary); {ok, Complete, Next} -> read_multipart2(Socket, Complete, Boundary, Next); Error -> Error end. read_multipart2(Socket, Received, Boundary, Next) -> case read_multipart3(Socket, Received, Boundary) of {ok, Parts} -> {ok, Parts, Next}; {ok, Parts, Cont} -> {ok, Parts, <>}; Error -> Error end. read_multipart3(Socket, Received, Boundary) -> SEP = <<"--", Boundary/binary, "\r\n">>, SS = byte_size(SEP), EOF = <<"--", Boundary/binary, "--\r\n">>, ES = byte_size(EOF), Seps = [{{SEP, SS}, {EOF, ES}}], case simple_multipart(Socket, Received, Seps, []) of {ok, Parts} -> {ok, lists:reverse(Parts)}; {ok, Parts, Next} -> {ok, lists:reverse(Parts), Next}; Error -> Error end. simple_multipart(Socket, Received, [{{SEP, SS}, {EOF, ES}} | RemSeps], Parts) when byte_size(Received) >= ES -> case Received of <> -> NewSep = {{<<"\r\n", SEP/binary>>, SS + 2}, {<<"\r\n", EOF/binary>>, ES + 2}}, NewSeps = [NewSep | RemSeps], simple_multipart2(Socket, Rest, NewSeps, Parts); <> -> simple_multipart2(Socket, Rest, RemSeps, Parts) end; simple_multipart(_, Received, [], Parts) -> {ok, Parts, Received}; simple_multipart(Socket, Received, Seps, Parts) -> ok = inet:setopts(Socket, [{active, once}]), receive {tcp, Socket, Bin} -> simple_multipart(Socket, <>, Seps, Parts); {tcp_closed, Socket} -> {error, tcp_closed}; {tcp_error, Socket, Reason} -> {error, {tcp_error, Reason}} after 3000 -> {error, timeout} end. simple_multipart2(Socket, Received, Seps, Parts) -> case read_headers(Socket, Received) of {ok, Headers, Rest} -> check_multipart_headers(Socket, Rest, Seps, Headers, Parts); Error -> Error end. check_multipart_headers(Socket, Received, Seps, Headers, Parts) -> case maps:find(<<"content-disposition">>, Headers) of {ok, StupidShit} -> case sort_out(StupidShit) of [<<"form-data">> | Shit] -> read_form_data(Socket, Shit, Received, Seps, Headers, Parts); [<<"file">> | Shit] -> read_file_data(Socket, Shit, Received, Seps, Parts); COVID -> {error, {form_had, COVID}} end; error -> {error, bad_disposition} end. read_form_data(Socket, Shit, Received, Seps, Headers, Parts) -> case proplists:is_defined(<<"filename">>, Shit) of true -> read_file_data(Socket, Shit, Received, Seps, Parts); false -> read_form_data2(Socket, Shit, Received, Seps, Headers, Parts) end. read_form_data2(Socket, Shit, Received, Seps, Headers, Parts) -> case maps:find(<<"content-type">>, Headers) of {ok, StupidShit} -> case sort_out(StupidShit) of [<<"multipart/mixed">> | Shit] -> read_multipart_mixed(Socket, Shit, Received, Seps, Parts); _ -> read_form_data3(Socket, Shit, Received, Seps, Parts) end; error -> read_form_data3(Socket, Shit, Received, Seps, Parts) end. read_form_data3(Socket, Shit, Received, Seps, Parts) -> case proplists:get_value(<<"name">>, Shit) of undefined -> {error, fucked_up_form}; Name -> read_form_data4(Socket, Received, Name, Seps, Parts) end. read_form_data4(Socket, Received, Name, Seps = [CurrSep | PrevSeps], Parts) -> case unfuck_form_data(Socket, Received, <<>>, CurrSep) of {ok, Data, Rest} -> NewParts = [{Name, Data} | Parts], simple_multipart2(Socket, Rest, Seps, NewParts); {done, Data, Rest} -> NewParts = [{Name, Data} | Parts], simple_multipart(Socket, Rest, PrevSeps, NewParts); Error -> Error end. read_multipart_mixed(Socket, Shit, Received, Seps, Parts) -> case proplists:get_value(<<"boundary">>, Shit) of undefined -> {error, no_boundary}; Boundary -> SEP = <<"--", Boundary/binary, "\r\n">>, SS = byte_size(SEP), EOF = <<"--", Boundary/binary, "--\r\n">>, ES = byte_size(EOF), NewSeps = [{{SEP, SS}, {EOF, ES}} | Seps], simple_multipart(Socket, Received, NewSeps, Parts) end. read_file_data(Socket, Shit, Received, Seps = [CurrSep | PrevSeps], Parts) -> case {proplists:get_value(<<"name">>, Shit), proplists:get_value(<<"filename">>, Shit)} of {undefined, undefined} -> {error, fucked_up_form}; {_, undefined} -> {error, fucked_up_form}; {undefined, _} -> {error, fucked_up_form}; {Name, Filename} -> case unfuck_form_data(Socket, Received, <<>>, CurrSep) of {ok, Data, Rest} -> NewParts = [{Name, {Filename, Data}} | Parts], simple_multipart2(Socket, Rest, Seps, NewParts); {done, Data, Rest} -> NewParts = [{Name, {Filename, Data}} | Parts], simple_multipart(Socket, Rest, PrevSeps, NewParts); Error -> Error end end. unfuck_form_data(Socket, Received, Acc, Seps) -> unfuck_form_data(Socket, Received, Acc, Seps, byte_size(Received)). unfuck_form_data(Socket, Received, Acc, Seps = {{SEP, SS}, {EOF, ES}}, Size) when byte_size(Received) >= SS andalso Size < 52428800 -> case Received of <> -> {ok, Acc, Rest}; <> -> {done, Acc, Rest}; <> when byte_size(Received) >= byte_size(SEP) -> unfuck_form_data(Socket, Rest, <>, Seps) end; unfuck_form_data(Socket, Received, Acc, Seps, Size) when Size < 52428800 -> ok = inet:setopts(Socket, [{active, once}]), receive {tcp, Socket, Bin} -> NewBin = <>, unfuck_form_data(Socket, NewBin, Acc, Seps); {tcp_closed, Socket} -> {error, tcp_closed}; {tcp_error, Socket, Reason} -> {error, {tcp_error, Reason}} after 3000 -> {error, timeout} end; unfuck_form_data(_, _, _, _, Size) -> {error, {size, Size}}. sort_out(StupidShit) -> read_shitkey(StupidShit, <<>>, []). posted(Body) -> read_pkey(Body, <<>>, []). read_pkey(<<$%, A, B, Rest/binary>>, Acc, Data) -> read_pkey(Rest, <>, Data); read_pkey(<<"=", Rest/binary>>, Acc, Data) -> read_pval(Rest, <<>>, Acc, Data); read_pkey(<<"&", Rest/binary>>, Acc, Data) -> read_pkey(Rest, <<>>, [{Acc, <<>>} | Data]); read_pkey(<>, Acc, Data) -> read_pkey(Rest, <>, Data); read_pkey(<<>>, <<>>, Data) -> Data; read_pkey(<<>>, Acc, Data) -> [{Acc, <<>>} | Data]. read_pval(<<$%, $3, $C, Rest/binary>>, Acc, Key, Data) -> read_pval(Rest, <>, Key, Data); read_pval(<<$%, $3, $c, Rest/binary>>, Acc, Key, Data) -> read_pval(Rest, <>, Key, Data); read_pval(<<$%, $3, $E, Rest/binary>>, Acc, Key, Data) -> read_pval(Rest, <>, Key, Data); read_pval(<<$%, $3, $e, Rest/binary>>, Acc, Key, Data) -> read_pval(Rest, <>, Key, Data); read_pval(<<$%, A, B, Rest/binary>>, Acc, Key, Data) -> read_pval(Rest, <>, Key, Data); read_pval(<<"&", Rest/binary>>, Val, Key, Data) -> read_pkey(Rest, <<>>, [{Key, Val} | Data]); read_pval(<<"+", Rest/binary>>, Acc, Key, Data) -> read_pval(Rest, <>, Key, Data); read_pval(<>, Acc, Key, Data) -> read_pval(Rest, <>, Key, Data); read_pval(<<>>, Val, Key, Data) -> [{Key, Val} | Data]. read_shitkey(<<";", Rest/binary>>, Key, Values) -> Tail = skip_blanks(Rest), read_shitkey(Tail, <<>>, [Key | Values]); read_shitkey(<<"=\"", Rest/binary>>, Key, Values) -> case read_quote(Rest) of {ok, Val, <<";", Tail/binary>>} -> read_shitkey(skip_blanks(Tail), <<>>, [{Key, Val} | Values]); {ok, Val, Tail} -> read_shitkey(skip_blanks(Tail), <<>>, [{Key, Val} | Values]); {ok, <<>>} -> [Key | Values]; {ok, Val} -> [{Key, Val} | Values] end; read_shitkey(<<"=", Rest/binary>>, Key, Values) -> read_shitval(Rest, <<>>, Key, Values); read_shitkey(<>, Acc, Values) -> read_shitkey(Rest, <>, Values); read_shitkey(<<>>, <<>>, Values) -> lists:reverse(Values); read_shitkey(<<>>, Key, Values) -> lists:reverse([Key | Values]). read_shitval(<<";", Rest/binary>>, <<>>, Key, Values) -> read_shitkey(skip_blanks(Rest), <<>>, [Key | Values]); read_shitval(<<";", Rest/binary>>, Val, Key, Values) -> read_shitkey(skip_blanks(Rest), <<>>, [{Key, Val} | Values]); read_shitval(<>, Acc, Key, Values) -> read_shitval(Rest, <>, Key, Values); read_shitval(<<>>, <<>>, Key, Values) -> [{Key, none} | Values]; read_shitval(<<>>, Val, Key, Values) -> [{Key, Val} | Values]. skip_blanks(<<" ", Rest/binary>>) -> <<(skip_blanks(Rest))/binary>>; skip_blanks(<<>>) -> <<>>; skip_blanks(<>) -> Rest. read_quote(Bin) -> read_quote(Bin, <<>>). read_quote(<<"\"", Rest/binary>>, Acc) -> {ok, Acc, Rest}; read_quote(<<"\"">>, Acc) -> {ok, Acc}; read_quote(<<"\\\"", Rest/binary>>, Acc) -> read_quote(Rest, <>); read_quote(<>, Acc) -> read_quote(Rest, <>). accumulate(Socket, M = #request{size = Size, body = Body}) -> Remaining = Size - byte_size(Body), case accumulate(Socket, Remaining, Body) of {ok, Received} -> {ok, M#request{body = Received}, none}; {ok, Received, Next} -> {ok, M#request{body = Received}, Next}; Error -> Error end. accumulate(Socket, Remaining, Received) when Remaining > 0 -> io:format("~p accumulate(~p, ~p, ~p)~n", [?LINE, Socket, Remaining, Received]), ok = inet:setopts(Socket, [{active, once}]), receive {tcp, Socket, Bin} -> io:format("~p~n", [?LINE]), Size = byte_size(Bin), if Size == Remaining -> {ok, <>}; Size < Remaining -> NewRemaining = Remaining - Size, NewReceived = <>, accumulate(Socket, NewRemaining, NewReceived); Size > Remaining -> <> = Bin, NewReceived = <>, {ok, NewReceived, Next} end; {tcp_closed, Socket} -> io:format("~p~n", [?LINE]), {error, tcp_closed}; {tcp_error, Socket, Reason} -> io:format("~p~n", [?LINE]), {error, {tcp_error, Reason}}; X -> io:format("~p raseevd: ~p~n", [?LINE, X]) after 10_000 -> io:format("~p~n", [?LINE]), {error, timeout} end; accumulate(_, 0, Received) -> {ok, Received}; accumulate(_, Remaining, Received) when Remaining =< 0 -> {error, {oversend, Received}}. %%% Websocket insanity -spec recv(Socket, Received) -> Result when Socket :: gen_tcp:socket(), Received :: binary(), Result :: {ok, Message} | {error, Reason}, Message :: binary(), Reason :: term(). % FIXME recv(_, _) -> {error, nih}. -spec resp(Socket, Binary) -> Result when Socket :: gen_tcp:socket(), Binary :: binary(), Result :: ok | {error, Reason}, Reason :: term(). % FIXME resp(_, _) -> {error, nih}. %%% Utility Functions -spec percent_encode(RawBinary) -> EncodedBinary when RawBinary :: binary(), EncodedBinary :: binary(). %% @doc %% Percent encodes a binary string as per RFC-3986 Section 2.1 %% https://datatracker.ietf.org/doc/html/rfc3986#section-2.1 percent_encode(<>) when $0 =< C, C =< $9; $A =< C, C =< $Z; $a =< C, C =< $z; C == $-; C == $.; C == $_; C == $~ -> <>; percent_encode(<>) -> case integer_to_list(C, 16) of [A, B] -> <<$%, A, B, (percent_encode(Rest))/binary>>; [B] -> <<$%, $0, B, (percent_encode(Rest))/binary>> end; percent_encode(<<>>) -> <<>>. -spec percent_decode(EncodedBinary) -> RawBinary when EncodedBinary :: binary(), RawBinary :: binary(). %% @doc %% Decodes a percent encoded binary as per RFC-3986 Section 2.1 %% https://datatracker.ietf.org/doc/html/rfc3986#section-2.1 percent_decode(<<$%, A, B, Rest/binary>>) -> <<(list_to_integer([A, B], 16)), (percent_decode(Rest))/binary>>; percent_decode(<<$+, Rest/binary>>) -> <<" ", (percent_decode(Rest))/binary>>; percent_decode(<>) -> <>; percent_decode(<<>>) -> <<>>. -spec join(Headers) -> IOListHeaders when Headers :: [{Key, Value}], IOListHeaders :: iolist(), Key :: binary(), Value :: binary(). %% @doc %% Convert a header K/V tuple list to an `iolist()' of the form %% `[Key, ": ", Value, "\r\n"]' that can be consumed by iolist %% operations such as those in the unicode module. join([{K, V} | Rest]) -> [K, ": ", V, "\r\n" | join(Rest)]; join([]) -> []. -spec ridiculous_web_date() -> iolist(). %% @equiv ridiculous_web_data(Date). ridiculous_web_date() -> ridiculous_web_date(calendar:universal_time()). -spec ridiculous_web_date(Date) -> StupifyinglyRetardedDateFormat when Date :: calendar:datetime(), StupifyinglyRetardedDateFormat :: iolist(). %% @doc %% Perform the humiliation ritual satirically known in the business as %% web date format generation and return it as an `iolist()'. ridiculous_web_date({DS = {Y, M, D}, {Hr, Mn, Sc}}) -> Day = case calendar:day_of_the_week(DS) of 1 -> "Mon"; 2 -> "Tue"; 3 -> "Wed"; 4 -> "Thu"; 5 -> "Fri"; 6 -> "Sat"; 7 -> "Sun" end, Year = integer_to_list(Y), Month = case M of 1 -> "Jan"; 2 -> "Feb"; 3 -> "Mar"; 4 -> "Apr"; 5 -> "May"; 6 -> "Jun"; 7 -> "Jul"; 8 -> "Aug"; 9 -> "Sep"; 10 -> "Oct"; 11 -> "Nov"; 12 -> "Dec" end, Date = ridiculous_bullshit_fixed_width_garbage(D), Hour = ridiculous_bullshit_fixed_width_garbage(Hr), Minute = ridiculous_bullshit_fixed_width_garbage(Mn), Second = ridiculous_bullshit_fixed_width_garbage(Sc), [Day, ", ", Date, " ", Month, " ", Year, " ", Hour, ":", Minute, ":", Second, " GMT"]. ridiculous_bullshit_fixed_width_garbage(N) when N < 10 -> [$0, integer_to_list(N)]; ridiculous_bullshit_fixed_width_garbage(N) -> integer_to_list(N). -spec slogan(Code) -> Slogan when Code :: pos_integer(), Slogan :: string(). %% @doc %% A convenience function that returns the standard slogan of a number of well-known %% HTTP response codes. Take note of which codes are not supported and manually %% intervene accordingly. slogan(100) -> "Continue"; slogan(101) -> "Switching Protocols"; slogan(102) -> "Early Hints"; slogan(200) -> "OK"; slogan(201) -> "Created"; slogan(202) -> "Accepted"; slogan(203) -> "Non-Authoritative Information"; slogan(204) -> "No Content"; slogan(301) -> "Moved Permanently"; slogan(302) -> "Found"; slogan(303) -> "See Other"; slogan(304) -> "Not Modified"; slogan(307) -> "Temporary Redirect"; slogan(308) -> "Permanent Redirect"; slogan(400) -> "Bad Request"; slogan(401) -> "Unauthorized"; slogan(402) -> "Payment Required"; slogan(403) -> "Forbidden"; slogan(404) -> "Not Found"; slogan(405) -> "Method Not Allowed"; slogan(409) -> "Conflict"; slogan(410) -> "Gone"; slogan(413) -> "Content Too Large"; slogan(414) -> "URI Too Long"; slogan(426) -> "Upgrade Required"; slogan(429) -> "Too Many Requests"; slogan(451) -> "Unavailable for Legal Reasons"; slogan(500) -> "Internal Server Error"; slogan(501) -> "Not Implemented"; slogan(503) -> "Service Unavailable". -spec break_nl(WithOrdinaryRN_Newlines) -> WithBR_TaggedHTML when WithOrdinaryRN_Newlines :: binary(), WithBR_TaggedHTML :: binary(). %% @doc %% Substitute `<<"\\r\\n">>' with `<<"
">>' in a binary string. break_nl(<<"\r\n", Rest/binary>>) -> <<"
", (break_nl(Rest))/binary>>; break_nl(<>) -> <>; break_nl(<<>>) -> <<>>. -spec unbreak_nl(WithBR_TaggedHTML) -> WithOrdinaryRN_Newlines when WithBR_TaggedHTML :: binary(), WithOrdinaryRN_Newlines :: binary(). %% @doc %% Substitute `<<"
">>' with `<<"\\r\\n">>' in a binary string. unbreak_nl(<<"
", Rest/binary>>) -> <<"\r\n", (unbreak_nl(Rest))/binary>>; unbreak_nl(<>) -> <>; unbreak_nl(<<>>) -> <<>>. -spec clean(MessyAngleBracketyHTML) -> MessierEscapedHTML when MessyAngleBracketyHTML :: binary(), MessierEscapedHTML :: binary(). %% @doc %% Receive HTML input and convert reserved characters to the comedy versions. clean(<<"<", Rest/binary>>) -> <<"<", (clean(Rest))/binary>>; clean(<<">", Rest/binary>>) -> <<">", (clean(Rest))/binary>>; clean(<<"\"", Rest/binary>>) -> <<""", (clean(Rest))/binary>>; clean(<>) -> <>; clean(<<>>) -> <<>>. -spec bin_to_int(IntegerBinaryString) -> Result when IntegerBinaryString :: binary(), Result :: {ok, integer()} | error. %% @doc %% Convert an input to a binary string the old-fashioned non-exploding way. %% (The caller gets to decide whether this explodes depending on how it is called, %% without the `try .. catch' mess. bin_to_int(Bin) -> case bin_to_int(Bin, <<>>) of {ok, Clean} -> {ok, binary_to_integer(Clean)}; error -> error end. bin_to_int(<>, Acc) when $0 =< C andalso C =< $9 -> bin_to_int(Rest, <>); bin_to_int(<<"/">>, Acc) -> {ok, Acc}; bin_to_int(<<>>, Acc) -> {ok, Acc}; bin_to_int(_, _) -> error.