QPQ-AG/GajuDesk
10
0
Fork 0
Code Issues 8 Pull Requests Actions Packages Projects Releases Wiki Activity

WIP

Browse Source
This commit is contained in:
Craig Everett
2026-05-21 14:32:38 +09:00
parent 3259e802db
commit 77ff0ca084
4 changed files with 252 additions and 85 deletions
Download Patch File Download Diff File Expand all files Collapse all files
include/gd_sock.hrl
+9
View File
@@ -0,0 +1,9 @@
send(Socket, Binary) ->
case gen_tcp:send(Socket, Binary) of
ok ->
ok;
Error ->
ok = tell(info, "Failure on ~w:send/2: ~p", [?MODULE, Error]),
ok = zx_net:disconnect(Socket),
exit(normal)
end.
src/gd_gui.erl
+2 -2
View File
@@ -206,8 +206,8 @@ init(Prefs) ->
ok = gd_v:safe_size(Frame, Prefs),
HK_Express = wxAcceleratorEntry:new([{flags, ?wxACCEL_CTRL}, {keyCode, $E}, {cmd, ?openEXPRESS}]),
HK_FWeaver = wxAcceleratorEntry:new([{flags, ?wxACCEL_CTRL}, {keyCode, $F}, {cmd, ?openFWEAVER}]),
HK_Express = wxAcceleratorEntry:new([{flags, ?wxACCEL_NORMAL}, {keyCode, $E}, {cmd, ?openEXPRESS}]),
HK_FWeaver = wxAcceleratorEntry:new([{flags, ?wxACCEL_NORMAL}, {keyCode, $F}, {cmd, ?openFWEAVER}]),
Entries = [HK_Express, HK_FWeaver],
Hotkeys = wxAcceleratorTable:new(length(Entries), Entries),
ok = wxFrame:setAcceleratorTable(Frame, Hotkeys),
src/gd_n_recvr.erl
+155 -66
View File
@@ -11,24 +11,62 @@
-copyright("QPQ AG <info@qpq.swiss>").
-license("GPL-3.0-or-later").
-export([fetch/2]).
-export([check/1, response/2, fetch/2]).
-export([init/2, stop/1]).
-include("$zx_include/zx_logger.hrl").
-record(s,
{id = <<>> :: binary(),
host = none :: none | {Addr :: term(), Port :: term()}, % FIXME, obvsly
host = none :: none | host(),
socket = none :: none | gen_tcp:socket()}).
-type host() :: {Addr :: inet:ip_address() | inet:hostname(),
Port :: inet:port_number()}.
%%% Service interface
-spec fetch(Rider, ParcelID) -> ok
when Rider :: pid(),
-spec check(Recvr) -> Result
when Recvr :: pid(),
Result :: {ok, Challenge} | {error, Reason},
Challenge :: binary(),
Reason :: term().
check(Recvr) ->
call(Recvr, check).
-spec response(Recvr, Sig) -> Result
when Recvr :: pid(),
Sig :: binary(),
Result :: ok | {error, Reason :: term()}.
response(Recvr, Sig) ->
call(Recvr, {response, Sig}).
-spec fetch(Recvr, ParcelID) -> ok
when Recvr :: pid(),
ParcelID :: binary().
fetch(Rider, Parcel) ->
Rider ! {fetch, Parcel},
fetch(Recvr, Parcel) ->
Recvr ! {fetch, Parcel},
ok.
call(Recvr, Message) ->
Ref = make_ref(),
Recvr ! {Ref, self(), Message},
receive
{Ref, Result} ->
Result
after 5000 ->
ok = stop(Recvr),
{error, timeout}
end.
stop(Recvr) ->
Recvr ! retire,
ok.
@@ -36,86 +74,124 @@ fetch(Rider, Parcel) ->
init(ID, Host = {Addr, Port}) ->
ok = tell(info, "Addr: ~p, Port: ~p", [Addr, Port]),
Options = [{mode, binary}, {active, once}, {packet, 4}, {keepalive, true}],
State = #s{id = ID, host = Host},
disconnected(State).
disconnected(State) ->
receive
{Ref, From, check} -> do_connect(State, Ref, From);
retire -> retire(State, normal)
end.
do_connect(State = #s{host = Host = {Addr, Port}, id = ID}, Ref, From) ->
Options = [{mode, binary}, {active, once}, {packet, 4}, {keepalive, true}],
case gen_tcp:connect(Addr, Port, Options, 5000) of
{ok, Socket} ->
ok = tell(info, "Socket: ~p", [Socket]),
NextState = State#s{socket = Socket},
ok = gen_tcp:send(Socket, <<"GajuExpress 1 RECVR">>),
authenticate(NextState);
ok = send(Socket, <<"GajuExpress 1 RECVR:", ID/binary>>),
handshake(NextState, Ref, From);
Error ->
ok = tell(warning, "Failed to connect to ~p with ~p", [Host, Error]),
retire(State, normal)
retire(State, normal, "Connect failed")
end.
stop(Rider) ->
Rider ! retire,
ok.
handshake(State = #s{socket = Socket}, Ref, From) ->
ok = active_once(State),
receive
{tcp, Socket, <<"GajuExpress 1 RECVR:", Challenge/binary>>} ->
case is_sus(Challenge) of
false ->
From ! {Ref, {ok, Challenge}},
authenticate(State);
true ->
From ! {Ref, {error, "Challenge was sus."}},
retire(State, normal)
end;
{tcp_closed, Socket} ->
From ! {Ref, {error, tcp_closed}},
retire(State, normal, "Handshake died")
after 5000 ->
From ! {Ref, {error, timeout}},
retire(State, normal, "Handshake timed out")
end.
is_sus(Challenge) ->
case string:split(Challenge, "_", all) of
[<<"GajuExpress-Challenge">>, <<"TS-", TS/binary>>, Rand] -> is_sus2(TS, Rand);
_ -> true
end.
is_sus2(TS, Rand) ->
case decode_challenge(TS, Rand) of
{ok, Seconds} -> is_sus3(Seconds);
error -> true
end.
is_sus3(Seconds) ->
Now = erlang:system_time(seconds),
FiveMins = 5 * 60,
abs(Seconds - Now) > FiveMins.
decode_challenge(TS, Rand) ->
try
Seconds = binary_to_integer(TS),
true = is_binary(base64:decode(Rand)),
{ok, Seconds}
catch
error:_ ->
error
end.
authenticate(State = #s{socket = Socket}) ->
ok = inet:setopts(Socket, [{active, once}]),
receive
{tcp, Socket, Binary} ->
read_challenge(State, Binary);
{tcp_closed, Socket} ->
retire(State, normal)
after 5000 ->
ok = tell(info, "GajuExpress timed out."),
retire(State, normal)
end.
read_challenge(State, Binary) ->
case zx_lib:b_to_ts(Binary) of
{ok, {challenge, Message = <<"GajuExpress-Challenge", _/binary>>}} ->
accept_challenge(State, Message);
error ->
ok = tell(info, "handle_challenge: bad_term"),
{Ref, From, {response, Sig}} ->
ok = send(Socket, Sig),
await_auth(State, Ref, From);
nope ->
retire(State, normal);
Garbage ->
ok = tell(info, "GajuExpress sent garbage: ~p", [Garbage]),
retire(State, normal)
retire ->
retire(State, normal);
Other ->
ok = tell(info, "Got weird message in authenticate/1: ~p", [Other]),
authenticate(State)
end.
accept_challenge(State = #s{id = ID, socket = Socket}, Message) ->
case gd_con:sign_binary(ID, Message) of
{ok, Sig} ->
Credential = term_to_binary({cred, ID, Sig}),
ok = gen_tcp:send(Socket, Credential),
get_list(State);
{error, bad_key} ->
ok = tell(info, "Bad ID: ~p", [ID]),
retire(State, normal)
end.
get_list(State = #s{socket = Socket}) ->
ok = inet:setopts(Socket, [{active, once}]),
await_auth(State = #s{socket = Socket}, Ref, From) ->
ok = active_once(State),
receive
{tcp, Socket, Binary} ->
read_manifest(State, Binary)
after 5000 ->
ok = tell(info, "Timed out on get_list/1"),
retire(State, normal)
end.
read_manifest(State, Binary) ->
{tcp, Socket, <<"ok:", Binary/binary>>} ->
From ! {Ref, ok},
case zx_lib:b_to_ts(Binary) of
{ok, {pending, Manifest}} ->
{ok, {manifest, Manifest}} ->
ok = gd_v_express:pending(Manifest),
loop(State);
error ->
ok = tell(info, "GajuExpress sent a bad binary manifest"),
retire(State, normal);
Garbage ->
ok = tell(info, "Decoded garbage binary manifest: ~p", [Garbage]),
retire(State, normal)
Error ->
Info = io_lib:format("Reading manifest failed with ~p", [Error]),
retire(State, normal, Info)
end;
{tcp, Socket, <<"nope">>} ->
From ! {Ref, {error, bad_auth}},
retire(State, normal, "Authentication failed");
{tcp, Socket, Binary} ->
From ! {Ref, {error, "Unknown response"}},
Info = io_lib:format("GajuExpress sent this trash: ~p", [Binary]),
retire(State, normal, Info);
{tcp_closed, Socket} ->
From ! {Ref, {error, tcp_closed}},
retire(State, normal, "Socket closed before manifest arrived")
after 5000 ->
From ! {Ref, {error, timeout}},
retire(State, normal, "GajuExpress timeout")
end.
loop(State = #s{socket = Socket}) ->
ok = inet:setopts(Socket, [{active, once}]),
ok = active_once(State),
receive
{tcp, Socket, Message} ->
ok = tell(info, "Got: ~tp", [Message]),
@@ -126,7 +202,7 @@ loop(State = #s{socket = Socket}) ->
{tcp_closed, Socket} ->
retire(State, normal);
retire ->
ok = gen_tcp:send(<<"bye">>),
ok = send(Socket, <<"bye">>),
retire(State, normal)
end.
@@ -136,10 +212,23 @@ do_fetch(State, ParcelID) ->
ok.
retire(#s{socket = none}, Reason) ->
gd_v_express ! {retiring, self(), Reason},
active_once(State = #s{socket = Socket}) ->
case inet:setopts(Socket, [{active, once}]) of
ok -> ok;
Error -> retire(State, normal, Error)
end.
retire(State, Reason) ->
retire(State, Reason, Reason).
retire(#s{socket = none}, Reason, Info) ->
ok = gd_v_express:retire(self(), Info),
exit(Reason);
retire(#s{socket = Socket}, Reason) ->
retire(#s{socket = Socket}, Reason, Info) ->
ok = zx_net:disconnect(Socket),
gd_v_express ! {retiring, self(), Reason},
ok = gd_v_express:retire(self(), Info),
exit(Reason).
-include("gd_sock.hrl").
src/gd_v_express.erl
+82 -13
View File
@@ -44,7 +44,7 @@
%-behavior(gd_v).
-include_lib("wx/include/wx.hrl").
-export([to_front/0, to_front/1, trouble/1]).
-export([pending/1, accounts/1]).
-export([pending/1, accounts/1, retire/2]).
-export([start_link/1]).
-export([init/1, terminate/2, code_change/3,
handle_call/3, handle_cast/2, handle_info/2, handle_event/2]).
@@ -62,6 +62,7 @@
keys = #w{} :: #w{},
accs = [] :: [#wr{}],
rider = none :: none | pid(),
recvr = none :: none | pid(),
check = #w{} :: #w{},
list = #w{} :: #w{},
dl = #w{} :: #w{},
@@ -115,6 +116,14 @@ accounts(Manifest) ->
wx_object:cast(?MODULE, {accounts, Manifest}).
-spec retire(PID, Info) -> ok
when PID :: pid(),
Info :: term().
retire(PID, Info) ->
gen_server:cast(?MODULE, {retire, PID, Info}).
%%% Startup
@@ -210,8 +219,10 @@ init({Prefs, {Selected, Keys}}) ->
ok = gd_v:safe_size(Frame, NewPrefs),
ok = wxFrame:connect(Frame, command_button_clicked),
ok = wxFrame:connect(Frame, command_choice_selected),
ok = wxFrame:connect(Frame, close_window),
ok = wxListBox:connect(DownloadP, command_listbox_doubleclicked),
true = wxFrame:show(Frame),
State = #s{wx = Wx, frame = Frame, lang = Lang, j = J, prefs = Prefs,
keys = KP, accs = Keys,
check = CheckB, list = DL_L,
@@ -239,6 +250,9 @@ handle_cast({pending, Manifest}, State) ->
handle_cast({accounts, Manifest}, State) ->
NewState = do_accounts(Manifest, State),
{noreply, NewState};
handle_cast({retire, PID, Info}, State) ->
NewState = do_retire(PID, Info, State),
{noreply, NewState};
handle_cast(to_front, State = #s{frame = Frame}) ->
ok = ensure_shown(Frame),
ok = wxFrame:raise(Frame),
@@ -251,9 +265,6 @@ handle_cast(Unexpected, State) ->
{noreply, State}.
handle_info({retiring, PID, Reason}, State = #s{rider = PID}) ->
ok = tell(info, "Rider retired with: ~p", [Reason]),
{noreply, State#s{rider = none}};
handle_info(Unexpected, State) ->
ok = log(warning, "Unexpected info: ~tp~n", [Unexpected]),
{noreply, State}.
@@ -271,8 +282,10 @@ handle_event(#wx{event = #wxCommand{type = command_button_clicked}, id = ID},
State = #s{ul = #w{id = ID}}) ->
NewState = do_ul(State),
{noreply, NewState};
handle_event(#wx{event = #wxCommand{type = command_listbox_doubleclicked}},
State) ->
handle_event(#wx{event = #wxCommand{type = command_choice_selected}}, State) ->
ok = kill_recvr(State),
{noreply, State};
handle_event(#wx{event = #wxCommand{type = command_listbox_doubleclicked}}, State) ->
NewState = do_dl(State),
{noreply, NewState};
handle_event(#wx{event = #wxClose{}}, State) ->
@@ -310,14 +323,55 @@ do_accounts(State, Manifest) ->
State.
do_check(State = #s{rider = none}) ->
PID = spawn_link(gd_n_rider, init, [{"localhost", 7777}]),
do_check(State#s{rider = PID});
do_check(State = #s{rider = PID, keys = #w{wx = KeyP}}) ->
ok =
do_check(State = #s{recvr = none, keys = #w{wx = KeyP}}) ->
case wxChoice:getStringSelection(KeyP) of
"" -> ok;
KeyID -> gd_n_rider:check(PID, KeyID)
"" ->
State;
KeyID ->
PubKey = list_to_binary(KeyID),
PID = spawn_link(gd_n_recvr, init, [PubKey, {"localhost", 7777}]),
do_check2(State#s{recvr = PID})
end;
do_check(State = #s{recvr = PID}) ->
case gd_n_recvr:check(PID) of
ok -> State;
{ok, Challenge} -> challenge(State, Challenge)
end.
do_check2(State = #s{recvr = PID}) ->
case gd_n_recvr:check(PID) of
{ok, Challenge} ->
challenge(State, Challenge);
{error, Reason} ->
ok = tell(info, "GajuExpress connection failed with: ~p", [Reason]),
State#s{recvr = none}
end.
challenge(State = #s{recvr = PID, keys = KeyP}, Challenge) ->
case wxChoice:getStringSelection(KeyP) of
"" ->
ok = gd_n_recvr:stop(PID),
State;
KeyID ->
PubKey = list_to_binary(KeyID),
handle_challenge(State, PubKey, Challenge)
end.
handle_challenge(State = #s{recvr = PID}, PubKey, Challenge) ->
case gd_con:sign_binary(PubKey, Challenge) of
{ok, Sig} ->
respond(State, Sig);
{error, bad_key} ->
ok = gd_n_recvr:stop(PID),
State
end.
respond(State = #s{recvr = PID}, Sig) ->
ok =
case gd_n_recvr:response(PID, Sig) of
ok -> ok;
{error, Reason} -> ok = tell(info, "~p: ~p", [PID, Reason])
end,
State.
@@ -354,6 +408,21 @@ do_close(#s{frame = Frame, prefs = Prefs}) ->
% unicode:characters_to_list(Name ++ ".gaju").
kill_recvr(#s{recvr = none}) -> ok;
kill_recvr(#s{recvr = PID}) -> gd_n_recvr:stop(PID).
do_retire(PID, Info, State = #s{rider = PID}) ->
ok = tell(info, "Rider retired with: ~p", [Info]),
State#s{rider = none};
do_retire(PID, Info, State = #s{recvr = PID}) ->
ok = tell(info, "Rider retired with: ~p", [Info]),
State#s{recvr = none};
do_retire(PID, Info, State) ->
ok = tell(info, "~p retired with: ~p", [PID, Info]),
State.
ensure_shown(Frame) ->
case wxWindow:isShown(Frame) of
true ->