%%% @doc %%% Gajumaru DEX HTTP Daemon Client %%% %%% An extremely naive (currently Telnet) client handler. %%% Unlike other modules that represent discrete processes, this one does not adhere %%% to any OTP behavior. It does, however, adhere to OTP. %%% %%% In some cases it is more comfortable to write socket handlers or a certain %%% category of state machines as "pure" Erlang processes. This approach is made %%% OTP-able by use of the proc_lib module, which is the underlying library used %%% to write the stdlib's behaviors like gen_server, gen_statem, gen_fsm, etc. %%% %%% http://erlang.org/doc/design_principles/spec_proc.html %%% @end -module(gh_client). -vsn("0.1.0"). -author("Peter Harpending "). -copyright("Peter Harpending "). -export([start/1]). -export([start_link/1, init/2]). -export([system_continue/3, system_terminate/4, system_get_state/1, system_replace_state/2]). -include("http.hrl"). %%% Type and Record Definitions -record(s, {socket = none :: none | gen_tcp:socket(), received = none :: none | binary()}). %% An alias for the state record above. Aliasing state can smooth out annoyances %% that can arise from using the record directly as its own type all over the code. -type state() :: #s{}. %%% Service Interface -spec start(ListenSocket) -> Result when ListenSocket :: gen_tcp:socket(), Result :: {ok, pid()} | {error, Reason}, Reason :: {already_started, pid()} | {shutdown, term()} | term(). %% @private %% How the gh_client_man or a prior gh_client kicks things off. %% This is called in the context of gh_client_man or the prior gh_client. start(ListenSocket) -> gh_client_sup:start_acceptor(ListenSocket). -spec start_link(ListenSocket) -> Result when ListenSocket :: gen_tcp:socket(), Result :: {ok, pid()} | {error, Reason}, Reason :: {already_started, pid()} | {shutdown, term()} | term(). %% @private %% This is called by the gh_client_sup. While start/1 is called to iniate a startup %% (essentially requesting a new worker be started by the supervisor), this is %% actually called in the context of the supervisor. start_link(ListenSocket) -> proc_lib:start_link(?MODULE, init, [self(), ListenSocket]). -spec init(Parent, ListenSocket) -> no_return() when Parent :: pid(), ListenSocket :: gen_tcp:socket(). %% @private %% This is the first code executed in the context of the new worker itself. %% This function does not have any return value, as the startup return is %% passed back to the supervisor by calling proc_lib:init_ack/2. %% We see the initial form of the typical arity-3 service loop form here in the %% call to listen/3. init(Parent, ListenSocket) -> ok = io:format("~p Listening.~n", [self()]), Debug = sys:debug_options([]), ok = proc_lib:init_ack(Parent, {ok, self()}), listen(Parent, Debug, ListenSocket). -spec listen(Parent, Debug, ListenSocket) -> no_return() when Parent :: pid(), Debug :: [sys:dbg_opt()], ListenSocket :: gen_tcp:socket(). %% @private %% This function waits for a TCP connection. The owner of the socket is still %% the gh_client_man (so it can still close it on a call to gh_client_man:ignore/0), %% but the only one calling gen_tcp:accept/1 on it is this process. Closing the socket %% is one way a manager process can gracefully unblock child workers that are blocking %% on a network accept. %% %% Once it makes a TCP connection it will call start/1 to spawn its successor. listen(Parent, Debug, ListenSocket) -> case gen_tcp:accept(ListenSocket) of {ok, Socket} -> {ok, _} = start(ListenSocket), {ok, Peer} = inet:peername(Socket), ok = io:format("~p Connection accepted from: ~p~n", [self(), Peer]), ok = gh_client_man:enroll(), State = #s{socket = Socket}, loop(Parent, Debug, State); {error, closed} -> ok = io:format("~p Retiring: Listen socket closed.~n", [self()]), exit(normal) end. -spec loop(Parent, Debug, State) -> no_return() when Parent :: pid(), Debug :: [sys:dbg_opt()], State :: state(). %% @private %% The service loop itself. This is the service state. The process blocks on receive %% of Erlang messages, TCP segments being received themselves as Erlang messages. loop(Parent, Debug, State = #s{socket = Socket, received = Received}) -> ok = inet:setopts(Socket, [{active, once}]), receive {tcp, Socket, Message} -> ok = io:format("~p received: ~tp~n", [self(), Message]), %% Received exists because web browsers usually use the same %% acceptor socket for sequential requests %% %% QHL parses a request off the socket, and consumes all the data %% pertinent to said task. Any additional data it finds on the %% socket it hands back to us. %% %% That additional data, as I said, is usually the next request. %% %% We store that in our process state in the received=Received field Message2 = case Received of none -> Message; _ -> <> end, %% beware: wrong typespec in QHL 0.1.0 %% see: https://git.qpq.swiss/QPQ-AG/QHL/pulls/1 case qhl:parse(Socket, Message2) of {ok, Request, NewReceived} -> ok = handle_request(Socket, Request), NewState = State#s{received = NewReceived}, loop(Parent, Debug, NewState); {error, Reason} -> io:format("~p error: ~tp~n", [self(), Reason]), ok = http_err(Socket, 500), exit(normal) end; {tcp_closed, Socket} -> ok = io:format("~p Socket closed, retiring.~n", [self()]), exit(normal); {system, From, Request} -> sys:handle_system_msg(Request, From, Parent, ?MODULE, Debug, State); Unexpected -> ok = io:format("~p Unexpected message: ~tp", [self(), Unexpected]), loop(Parent, Debug, State) end. -spec system_continue(Parent, Debug, State) -> no_return() when Parent :: pid(), Debug :: [sys:dbg_opt()], State :: state(). %% @private %% The function called by the OTP internal functions after a system message has been %% handled. If the worker process has several possible states this is one place %% resumption of a specific state can be specified and dispatched. system_continue(Parent, Debug, State) -> loop(Parent, Debug, State). -spec system_terminate(Reason, Parent, Debug, State) -> no_return() when Reason :: term(), Parent :: pid(), Debug :: [sys:dbg_opt()], State :: state(). %% @private %% Called by the OTP inner bits to allow the process to terminate gracefully. %% Exactly when and if this is callback gets called is specified in the docs: %% See: http://erlang.org/doc/design_principles/spec_proc.html#msg system_terminate(Reason, _Parent, _Debug, _State) -> exit(Reason). -spec system_get_state(State) -> {ok, State} when State :: state(). %% @private %% This function allows the runtime (or anything else) to inspect the running state %% of the worker process at any arbitrary time. system_get_state(State) -> {ok, State}. -spec system_replace_state(StateFun, State) -> {ok, NewState, State} when StateFun :: fun(), State :: state(), NewState :: term(). %% @private %% This function allows the system to update the process state in-place. This is most %% useful for state transitions between code types, like when performing a hot update %% (very cool, but sort of hard) or hot patching a running system (living on the edge!). system_replace_state(StateFun, State) -> {ok, StateFun(State), State}. %%%------------------------------------------- %%% http request handling %%%------------------------------------------- -spec handle_request(Socket, Request) -> ok when Socket :: gen_tcp:socket(), Request :: #request{}. %% ref: https://git.qpq.swiss/QPQ-AG/QHL/src/commit/7f77f9e3b19f58006df88a2a601e85835d300c37/include/http.hrl handle_request(Socket, #request{method = get, path = <<"/">>}) -> IndexHtmlPath = filename:join([zx:get_home(), "priv", "index.html"]), case file:read_file(IndexHtmlPath) of {ok, ResponseBody} -> %% see https://developer.mozilla.org/en-US/docs/Web/HTTP/Guides/Messages#http_responses Headers = [{"content-type", "text/html"}], Response = #response{headers = Headers, body = ResponseBody}, respond(Socket, Response); Error -> io:format("~p error: ~p~n", [self(), Error]), http_err(Socket, 500) end; handle_request(Socket, _) -> http_err(Socket, 404). http_err(Socket, 404) -> HtmlPath = filename:join([zx:get_home(), "priv", "404.html"]), {ok, ResponseBody} = file:read_file(HtmlPath), Headers = [{"content-type", "text/html"}], Response = #response{headers = Headers, code = 404, body = ResponseBody}, respond(Socket, Response); % default error is 500 http_err(Socket, _) -> HtmlPath = filename:join([zx:get_home(), "priv", "500.html"]), {ok, ResponseBody} = file:read_file(HtmlPath), Headers = [{"content-type", "text/html"}], Response = #response{headers = Headers, code = 500, body = ResponseBody}, respond(Socket, Response). respond(Socket, R = #response{code = Code, headers = Headers, body = Body}) -> Slogan = slogan(Code), ContentLength = byte_size(Body), DefaultHeaders = [{"date", qhl:ridiculous_web_date()}, {"content-length", integer_to_list(ContentLength)}], Headers2 = merge_headers(DefaultHeaders, Headers), really_respond(Socket, R#response{slogan = Slogan, headers = Headers2}). really_respond(Socket, #response{code = Code, slogan = Slogan, headers = Headers, body = Body}) -> Response = ["HTTP/1.1 ", integer_to_list(Code), " ", Slogan, "\r\n", render_headers(Headers), "\r\n", Body], gen_tcp:send(Socket, Response). merge_headers(Defaults, Overwrites) -> DefaultsMap = proplists:to_map(Defaults), OverwritesMap = proplists:to_map(Overwrites), FinalMap = maps:merge(DefaultsMap, OverwritesMap), proplists:from_map(FinalMap). render_headers([{K, V} | Rest]) -> [K, ": ", V, "\r\n", render_headers(Rest)]; render_headers([]) -> []. slogan(200) -> "OK"; slogan(404) -> "Not Found"; slogan(500) -> "Internal Server Error".