This commit is contained in:
Peter Harpending 2025-12-16 22:09:10 -08:00
parent cbfc496057
commit e160701403
11 changed files with 95 additions and 156 deletions

View File

@ -23,11 +23,17 @@ start_link() ->
init([]) ->
RestartStrategy = {one_for_one, 1, 60},
Clerks = {fd_httpd_clerks,
{fd_httpd_clerks, start_link, []},
FileCache = {fd_httpd_sfc,
{fd_httpd_sfc, start_link, []},
permanent,
5000,
worker,
[fd_httpd_sfc]},
Clients = {fd_httpd_clients,
{fd_httpd_clients, start_link, []},
permanent,
5000,
supervisor,
[fd_httpd_clerks]},
Children = [Clerks],
[fd_httpd_clients]},
Children = [FileCache, Clients],
{ok, {RestartStrategy, Children}}.

View File

@ -13,7 +13,7 @@
%%% http://erlang.org/doc/design_principles/spec_proc.html
%%% @end
-module(fd_http_client).
-module(fd_httpd_client).
-vsn("0.1.0").
-author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("Peter Harpending <peterharpending@qpq.swiss>").
@ -52,11 +52,11 @@
| {shutdown, term()}
| term().
%% @private
%% How the fd_client_man or a prior fd_client kicks things off.
%% This is called in the context of fd_client_man or the prior fd_client.
%% How the fd_httpd_client_man or a prior fd_httpd_client kicks things off.
%% This is called in the context of fd_httpd_client_man or the prior fd_httpd_client.
start(ListenSocket) ->
fd_client_sup:start_acceptor(ListenSocket).
fd_httpd_client_sup:start_acceptor(ListenSocket).
-spec start_link(ListenSocket) -> Result
@ -67,7 +67,7 @@ start(ListenSocket) ->
| {shutdown, term()}
| term().
%% @private
%% This is called by the fd_client_sup. While start/1 is called to iniate a startup
%% This is called by the fd_httpd_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.
@ -86,7 +86,7 @@ start_link(ListenSocket) ->
%% call to listen/3.
init(Parent, ListenSocket) ->
ok = io:format("~p Listening.~n", [self()]),
ok = tell("~p Listening.~n", [self()]),
Debug = sys:debug_options([]),
ok = proc_lib:init_ack(Parent, {ok, self()}),
listen(Parent, Debug, ListenSocket).
@ -98,7 +98,7 @@ init(Parent, ListenSocket) ->
ListenSocket :: gen_tcp:socket().
%% @private
%% This function waits for a TCP connection. The owner of the socket is still
%% the fd_client_man (so it can still close it on a call to fd_client_man:ignore/0),
%% the fd_httpd_client_man (so it can still close it on a call to fd_httpd_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.
@ -110,12 +110,12 @@ listen(Parent, Debug, ListenSocket) ->
{ok, Socket} ->
{ok, _} = start(ListenSocket),
{ok, Peer} = inet:peername(Socket),
ok = io:format("~p Connection accepted from: ~p~n", [self(), Peer]),
ok = fd_client_man:enroll(),
ok = tell("~p Connection accepted from: ~p~n", [self(), Peer]),
ok = fd_httpd_client_man:enroll(),
State = #s{socket = Socket},
loop(Parent, Debug, State);
{error, closed} ->
ok = io:format("~p Retiring: Listen socket closed.~n", [self()]),
ok = tell("~p Retiring: Listen socket closed.~n", [self()]),
exit(normal)
end.
@ -142,17 +142,17 @@ loop(Parent, Debug, State = #s{socket = Socket, next = Next0}) ->
%% should trigger bad request
tell(error, "~p QHL parse error: ~tp", [?LINE, Error]),
tell(error, "~p bad request:~n~ts", [?LINE, Received]),
fd_http_utils:http_err(Socket, 400),
fd_httpd_utils:http_err(Socket, 400),
gen_tcp:shutdown(Socket, read_write),
exit(normal)
end;
{tcp_closed, Socket} ->
ok = io:format("~p Socket closed, retiring.~n", [self()]),
ok = tell("~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]),
ok = tell("~p Unexpected message: ~tp", [self(), Unexpected]),
loop(Parent, Debug, State)
end.
@ -232,7 +232,6 @@ handle_request(Sock, R = #request{method = M, path = P}, Received) when M =/= un
route(Sock, get, Route, Request, Received) ->
case Route of
<<"/ws/tetris">> -> ws_tetris(Sock, Request, Received);
<<"/ws/echo">> -> ws_echo(Sock, Request) , Received;
<<"/">> -> route_static(Sock, <<"/index.html">>) , Received;
_ -> route_static(Sock, Route) , Received
@ -240,10 +239,10 @@ route(Sock, get, Route, Request, Received) ->
route(Sock, post, Route, Request, Received) ->
case Route of
<<"/wfcin">> -> wfcin(Sock, Request) , Received;
_ -> fd_http_utils:http_err(Sock, 404) , Received
_ -> fd_httpd_utils:http_err(Sock, 404) , Received
end;
route(Sock, _, _, _, Received) ->
fd_http_utils:http_err(Sock, 404),
fd_httpd_utils:http_err(Sock, 404),
Received.
@ -253,13 +252,13 @@ route(Sock, _, _, _, Received) ->
Route :: binary().
route_static(Sock, Route) ->
respond_static(Sock, fd_sfc:query(Route)).
respond_static(Sock, fd_httpd_sfc:query(Route)).
-spec respond_static(Sock, MaybeEty) -> ok
when Sock :: gen_tcp:socket(),
MaybeEty :: fd_sfc:maybe_entry().
MaybeEty :: fd_httpd_sfc:maybe_entry().
respond_static(Sock, {found, Entry}) ->
% -record(e, {fs_path :: file:filename(),
@ -268,87 +267,18 @@ respond_static(Sock, {found, Entry}) ->
% encoding :: encoding(),
% contents :: binary()}).
Headers0 =
case fd_sfc_entry:encoding(Entry) of
case fd_httpd_sfc_entry:encoding(Entry) of
gzip -> [{"content-encoding", "gzip"}];
none -> []
end,
Headers1 = [{"content-type", fd_sfc_entry:mime_type(Entry)} | Headers0],
Headers1 = [{"content-type", fd_httpd_sfc_entry:mime_type(Entry)} | Headers0],
Response = #response{headers = Headers1,
body = fd_sfc_entry:contents(Entry)},
fd_http_utils:respond(Sock, Response);
body = fd_httpd_sfc_entry:contents(Entry)},
fd_httpd_utils:respond(Sock, Response);
respond_static(Sock, not_found) ->
fd_http_utils:http_err(Sock, 404).
fd_httpd_utils:http_err(Sock, 404).
%% ------------------------------
%% tetris
%% ------------------------------
-spec ws_tetris(Sock, Request, Received) -> NewReceived
when Sock :: gen_tcp:socket(),
Request :: request(),
Received :: binary(),
NewReceived :: binary().
ws_tetris(Sock, Request, Received) ->
error(nyi).
-spec ws_tetris2(Sock, Request, Received) -> NewReceived
when Sock :: gen_tcp:socket(),
Request :: request(),
Received :: binary(),
NewReceived :: binary().
ws_tetris2(Sock, Request, Received) ->
%tell("~p: ws_tetris request: ~tp", [?LINE, Request]),
case qhl_ws:handshake(Request) of
{ok, Response} ->
fd_http_utils:respond(Sock, Response),
{ok, TetrisPid} = fd_tetris:start_link(),
ws_tetris_loop(Sock, TetrisPid, [], Received);
Error ->
tell("ws_tetris: error: ~tp", [Error]),
fd_http_utils:http_err(Sock, 400)
end.
-spec ws_tetris_loop(Sock, Tetris, Frames, Received) -> NewReceived
when Sock :: gen_tcp:socket(),
Tetris :: pid(),
Frames :: [qhl_ws:frame()],
Received :: binary(),
NewReceived :: binary().
ws_tetris_loop(Sock, Tetris, Frames, Received) ->
tell("~p:ws_tetris_loop(Sock, ~p, ~p, ~p)", [?MODULE, Tetris, Frames, Received]),
%% create tetris state
case inet:setopts(Sock, [{active, once}]) of
ok ->
receive
{tcp, Sock, Bin} ->
Rcv1 = <<Received/binary, Bin/binary>>,
case qhl_ws:recv(Sock, Rcv1, 3_000, Frames) of
{ok, WsMsg, NewFrames, Rcv2} ->
ok = fd_tetris:ws_msg(Tetris, WsMsg),
ws_tetris_loop(Sock, Tetris, NewFrames, Rcv2);
Error ->
error(Error)
end;
{tetris, Message} ->
ok = log(info, "~p tetris: ~p", [self(), Message]),
ok = qhl_ws:send(Sock, {text, Message}),
ws_tetris_loop(Sock, Tetris, Frames, Received);
{tcp_closed, Sock} -> {error, tcp_closed};
{tcp_error, Sock, Reason} -> {error, {tcp_error, Reason}}
after 30_000 ->
{error, timeout}
end;
{error, Reason} ->
{error, {inet, Reason}}
end.
%% ------------------------------
%% echo
%% ------------------------------
@ -359,17 +289,17 @@ ws_echo(Sock, Request) ->
catch
X:Y:Z ->
tell(error, "CRASH ws_echo: ~tp:~tp:~tp", [X, Y, Z]),
fd_http_utils:http_err(Sock, 500)
fd_httpd_utils:http_err(Sock, 500)
end.
ws_echo2(Sock, Request) ->
case qhl_ws:handshake(Request) of
{ok, Response} ->
fd_http_utils:respond(Sock, Response),
fd_httpd_utils:respond(Sock, Response),
ws_echo_loop(Sock);
Error ->
tell("ws_echo: error: ~tp", [Error]),
fd_http_utils:http_err(Sock, 400)
fd_httpd_utils:http_err(Sock, 400)
end.
ws_echo_loop(Sock) ->
@ -405,17 +335,17 @@ wfcin(Sock, #request{enctype = json,
case wfc_read:expr(Input) of
{ok, Expr, _Rest} ->
case wfc_eval:eval(Expr, Ctx0) of
{ok, noop, Ctx1} -> {fd_http_utils:jsgud("<noop>"), Ctx1};
{ok, Sentence, Ctx1} -> {fd_http_utils:jsgud(wfc_pp:sentence(Sentence)), Ctx1};
{error, Message} -> {fd_http_utils:jsbad(Message), Ctx0}
{ok, noop, Ctx1} -> {fd_httpd_utils:jsgud("<noop>"), Ctx1};
{ok, Sentence, Ctx1} -> {fd_httpd_utils:jsgud(wfc_pp:sentence(Sentence)), Ctx1};
{error, Message} -> {fd_httpd_utils:jsbad(Message), Ctx0}
end;
{error, Message} ->
{fd_http_utils:jsbad(Message), Ctx0}
{fd_httpd_utils:jsbad(Message), Ctx0}
end
catch
error:E:S ->
ErrorMessage = unicode:characters_to_list(io_lib:format("parser crashed: ~p:~p", [E, S])),
{fd_http_utils:jsbad(ErrorMessage), Ctx0}
{fd_httpd_utils:jsbad(ErrorMessage), Ctx0}
end,
% update cache with new context
ok = fd_cache:set(Cookie, NewCtx),
@ -423,10 +353,10 @@ wfcin(Sock, #request{enctype = json,
Response = #response{headers = [{"content-type", "application/json"},
{"set-cookie", ["wfc=", Cookie]}],
body = Body},
fd_http_utils:respond(Sock, Response);
fd_httpd_utils:respond(Sock, Response);
wfcin(Sock, Request) ->
tell("wfcin: bad request: ~tp", [Request]),
fd_http_utils:http_err(Sock, 400).
fd_httpd_utils:http_err(Sock, 400).
@ -441,7 +371,7 @@ ctx(#{<<"wfc">> := Cookie}) ->
error -> {Cookie, wfc_eval_context:default()}
end;
ctx(_) ->
{fd_http_utils:new_cookie(), wfc_eval_context:default()}.
{fd_httpd_utils:new_cookie(), wfc_eval_context:default()}.

View File

@ -9,7 +9,7 @@
%%% OTP should take care of for us.
%%% @end
-module(fd_http_client_man).
-module(fd_httpd_client_man).
-vsn("0.1.0").
-behavior(gen_server).
-author("Peter Harpending <peterharpending@qpq.swiss>").
@ -23,6 +23,8 @@
code_change/3, terminate/2]).
-include("$zx_include/zx_logger.hrl").
%%% Type and Record Definitions
@ -92,7 +94,7 @@ echo(Message) ->
when Result :: {ok, pid()}
| {error, Reason :: term()}.
%% @private
%% This should only ever be called by fd_clients (the service-level supervisor).
%% This should only ever be called by fd_httpd_clients (the service-level supervisor).
start_link() ->
gen_server:start_link({local, ?MODULE}, ?MODULE, none, []).
@ -104,8 +106,9 @@ start_link() ->
%% preparatory work necessary for proper function.
init(none) ->
ok = io:format("Starting.~n"),
ok = tell("Starting fd_httpd_client_man."),
State = #s{},
ok = tell("fd_httpd_client_man init state: ~tp", [State]),
{ok, State}.
@ -130,7 +133,7 @@ handle_call({listen, PortNum}, _, State) ->
{Response, NewState} = do_listen(PortNum, State),
{reply, Response, NewState};
handle_call(Unexpected, From, State) ->
ok = io:format("~p Unexpected call from ~tp: ~tp~n", [self(), From, Unexpected]),
ok = tell("~p Unexpected call from ~tp: ~tp~n", [self(), From, Unexpected]),
{noreply, State}.
@ -152,7 +155,7 @@ handle_cast(ignore, State) ->
NewState = do_ignore(State),
{noreply, NewState};
handle_cast(Unexpected, State) ->
ok = io:format("~p Unexpected cast: ~tp~n", [self(), Unexpected]),
ok = tell("~p Unexpected cast: ~tp~n", [self(), Unexpected]),
{noreply, State}.
@ -168,7 +171,7 @@ handle_info({'DOWN', Mon, process, Pid, Reason}, State) ->
NewState = handle_down(Mon, Pid, Reason, State),
{noreply, NewState};
handle_info(Unexpected, State) ->
ok = io:format("~p Unexpected info: ~tp~n", [self(), Unexpected]),
ok = tell("~p Unexpected info: ~tp~n", [self(), Unexpected]),
{noreply, State}.
@ -225,10 +228,10 @@ do_listen(PortNum, State = #s{port_num = none}) ->
{keepalive, true},
{reuseaddr, true}],
{ok, Listener} = gen_tcp:listen(PortNum, SocketOptions),
{ok, _} = fd_client:start(Listener),
{ok, _} = fd_httpd_client:start(Listener),
{ok, State#s{port_num = PortNum, listener = Listener}};
do_listen(_, State = #s{port_num = PortNum}) ->
ok = io:format("~p Already listening on ~p~n", [self(), PortNum]),
ok = tell("~p Already listening on ~p~n", [self(), PortNum]),
{{error, {listening, PortNum}}, State}.
@ -254,7 +257,7 @@ do_enroll(Pid, State = #s{clients = Clients}) ->
case lists:member(Pid, Clients) of
false ->
Mon = monitor(process, Pid),
ok = io:format("Monitoring ~tp @ ~tp~n", [Pid, Mon]),
ok = tell("Monitoring ~tp @ ~tp~n", [Pid, Mon]),
State#s{clients = [Pid | Clients]};
true ->
State
@ -292,6 +295,6 @@ handle_down(Mon, Pid, Reason, State = #s{clients = Clients}) ->
State#s{clients = NewClients};
false ->
Unexpected = {'DOWN', Mon, process, Pid, Reason},
ok = io:format("~p Unexpected info: ~tp~n", [self(), Unexpected]),
ok = tell("~p Unexpected info: ~tp~n", [self(), Unexpected]),
State
end.

View File

@ -2,8 +2,8 @@
%%% front end web development lab Client Supervisor
%%%
%%% This process supervises the client socket handlers themselves. It is a peer of the
%%% fd_client_man (the manager interface to this network service component),
%%% and a child of the supervisor named fd_clients.
%%% fd_httpd_client_man (the manager interface to this network service component),
%%% and a child of the supervisor named fd_httpd_clients.
%%%
%%% Because we don't know (or care) how many client connections the server may end up
%%% handling this is a simple_one_for_one supervisor which can spawn and manage as
@ -13,7 +13,7 @@
%%% http://erlang.org/doc/design_principles/sup_princ.html#id79244
%%% @end
-module(fd_http_client_sup).
-module(fd_httpd_client_sup).
-vsn("0.1.0").
-behaviour(supervisor).
-author("Peter Harpending <peterharpending@qpq.swiss>").
@ -35,9 +35,9 @@
| {shutdown, term()}
| term().
%% @private
%% Spawns the first listener at the request of the fd_client_man when
%% Spawns the first listener at the request of the fd_httpd_client_man when
%% fewd:listen/1 is called, or the next listener at the request of the
%% currently listening fd_client when a connection is made.
%% currently listening fd_httpd_client when a connection is made.
%%
%% Error conditions, supervision strategies and other important issues are
%% explained in the supervisor module docs:
@ -61,10 +61,10 @@ start_link() ->
init(none) ->
RestartStrategy = {simple_one_for_one, 1, 60},
Client = {fd_client,
{fd_client, start_link, []},
Client = {fd_httpd_client,
{fd_httpd_client, start_link, []},
temporary,
brutal_kill,
worker,
[fd_client]},
[fd_httpd_client]},
{ok, {RestartStrategy, [Client]}}.

View File

@ -1,14 +1,14 @@
%%% @doc
%%% front end web development lab Clerk Service Supervisor
%%% front end web development lab Client Service Supervisor
%%%
%%% This is the service-level supervisor of the system. It is the parent of both the
%%% clerk connection handlers and the clerk manager (which manages the clerk
%%% client connection handlers and the client manager (which manages the client
%%% connection handlers). This is the child of fd_sup.
%%%
%%% See: http://erlang.org/doc/apps/kernel/application.html
%%% @end
-module(fd_httpd_clerks).
-module(fd_httpd_clients).
-vsn("0.1.0").
-behavior(supervisor).
-author("Peter Harpending <peterharpending@qpq.swiss>").
@ -32,17 +32,17 @@ start_link() ->
init(none) ->
RestartStrategy = {rest_for_one, 1, 60},
HttpClerkMan = {fd_http_clerk_man,
{fd_http_clerk_man, start_link, []},
HttpClientMan = {fd_httpd_client_man,
{fd_httpd_client_man, start_link, []},
permanent,
5000,
worker,
[fd_http_clerk_man]},
HttpClerkSup = {fd_http_clerk_sup,
{fd_http_clerk_sup, start_link, []},
[fd_httpd_client_man]},
HttpClientSup = {fd_httpd_client_sup,
{fd_httpd_client_sup, start_link, []},
permanent,
5000,
supervisor,
[fd_http_clerk_sup]},
Children = [HttpClerkSup, HttpClerkMan],
[fd_httpd_client_sup]},
Children = [HttpClientSup, HttpClientMan],
{ok, {RestartStrategy, Children}}.

View File

@ -21,12 +21,12 @@
-include("$zx_include/zx_logger.hrl").
-type entry() :: fd_sfc_entry:entry().
-type maybe_entry() :: {found, fd_sfc_entry:entry()} | not_found.
-type entry() :: fd_httpd_sfc_entry:entry().
-type maybe_entry() :: {found, fd_httpd_sfc_entry:entry()} | not_found.
-record(s, {base_path = base_path() :: file:filename(),
cache = fd_sfc_cache:new(base_path()) :: fd_sfc_cache:cache(),
cache = fd_httpd_sfc_cache:new(base_path()) :: fd_httpd_sfc_cache:cache(),
auto_renew = 0_500 :: pos_integer()}).
%-type state() :: #s{}.
@ -62,14 +62,14 @@ start_link() ->
%% gen_server callbacks
init(none) ->
tell("starting fd_sfc"),
tell("starting fd_httpd_sfc"),
InitState = #s{},
erlang:send_after(InitState#s.auto_renew, self(), auto_renew),
{ok, InitState}.
handle_call({query, Path}, _, State = #s{cache = Cache}) ->
Reply = fd_sfc_cache:query(Path, Cache),
Reply = fd_httpd_sfc_cache:query(Path, Cache),
{reply, Reply, State};
handle_call(Unexpected, From, State) ->
tell("~tp: unexpected call from ~tp: ~tp", [?MODULE, Unexpected, From]),
@ -106,6 +106,6 @@ terminate(_, _) ->
%%-----------------------------------------------------------------------------
i_renew(State = #s{base_path = BasePath}) ->
NewCache = fd_sfc_cache:new(BasePath),
NewCache = fd_httpd_sfc_cache:new(BasePath),
NewState = State#s{cache = NewCache},
NewState.

View File

@ -1,6 +1,6 @@
% @doc
% cache data management
-module(fd_sfc_cache).
-module(fd_httpd_sfc_cache).
-export_type([
cache/0
@ -13,7 +13,7 @@
-include("$zx_include/zx_logger.hrl").
-type cache() :: #{HttpPath :: binary() := Entry :: fd_sfc_entry:entry()}.
-type cache() :: #{HttpPath :: binary() := Entry :: fd_httpd_sfc_entry:entry()}.
-spec query(HttpPath, Cache) -> Result
@ -21,7 +21,7 @@
Cache :: cache(),
Result :: {found, Entry}
| not_found,
Entry :: fd_sfc_entry:entry().
Entry :: fd_httpd_sfc_entry:entry().
query(HttpPath, Cache) ->
case maps:find(HttpPath, Cache) of
@ -63,7 +63,7 @@ new2(BasePath) ->
BAbsPath = unicode:characters_to_binary(AbsPath),
HttpPath = remove_prefix(BBaseDir, BAbsPath),
NewCache =
case fd_sfc_entry:new(AbsPath) of
case fd_httpd_sfc_entry:new(AbsPath) of
{found, Entry} -> maps:put(HttpPath, Entry, AccCache);
not_found -> AccCache
end,

View File

@ -1,7 +1,7 @@
% @doc non-servery functions for static file caching
%
% this spams the filesystem, so it's not "pure" code
-module(fd_sfc_entry).
-module(fd_httpd_sfc_entry).
-export_type([
encoding/0,

View File

@ -1,5 +1,5 @@
% @doc http utility functions
-module(fd_http_utils).
-module(fd_httpd_utils).
-export([
new_cookie/0,

View File

@ -36,17 +36,17 @@ start_link() ->
init([]) ->
RestartStrategy = {one_for_one, 1, 60},
Httpd = {fd_httpd,
{fd_httpd, start_link, []},
permanent,
5000,
supervisor,
[fd_httpd]},
Cache = {fd_cache,
{fd_cache, start_link, []},
permanent,
5000,
worker,
[fd_cache]},
Children = [Httpd, Cache],
Httpd = {fd_httpd,
{fd_httpd, start_link, []},
permanent,
5000,
supervisor,
[fd_httpd]},
Children = [Cache, Httpd],
{ok, {RestartStrategy, Children}}.

View File

@ -24,7 +24,7 @@
%% Returns an {error, Reason} tuple if it is already listening.
listen(PortNum) ->
fd_http:listen(PortNum).
fd_httpd_client_man:listen(PortNum).
-spec ignore() -> ok.
@ -32,7 +32,7 @@ listen(PortNum) ->
%% Make the server stop listening if it is, or continue to do nothing if it isn't.
ignore() ->
fd_http:ignore().
fd_httpd_client_man:ignore().
-spec start(normal, term()) -> {ok, pid()}.