Author: bdonlan
Date: 2005-12-09 15:34:01 -0500 (Fri, 09 Dec 2005)
New Revision: 944
Added:
trunk/erlang/
trunk/erlang/server/
trunk/erlang/server/line_encode.erl
trunk/erlang/server/server.erl
Log:
First-pass erlang server. Still very hacky and stuff.
Added: trunk/erlang/server/line_encode.erl
===================================================================
--- trunk/erlang/server/line_encode.erl 2005-11-27 00:08:28 UTC (rev 943)
+++ trunk/erlang/server/line_encode.erl 2005-12-09 20:34:01 UTC (rev 944)
@@ -0,0 +1,29 @@
+-module(line_encode).
+-export([decode/1, encode/1]).
+
+escape([]) -> [];
+escape([$\t|T]) -> [$\e, $t | escape(T)];
+escape([$\n|T]) -> [$\e, $n | escape(T)];
+escape([$\r|T]) -> [$\e, $r | escape(T)];
+escape([$\e|T]) -> [$\e, $e | escape(T)];
+escape([H|T]) -> [H | escape(T)].
+
+unescape([]) -> [];
+unescape([$\e, $t | T]) -> [$\t | unescape(T)];
+unescape([$\e, $e | T]) -> [$\e | unescape(T)];
+unescape([$\e, $r | T]) -> [$\r | unescape(T)];
+unescape([$\e, $n | T]) -> [$\n | unescape(T)];
+unescape([H|T]) -> [H | unescape(T)].
+
+decode([]) -> [];
+decode(L) ->
+ { Pre, Post } = lists:splitwith(fun(C) -> C =/= $\t end, L),
+ case Post of
+ [] -> [Pre];
+ [_|L2] ->
+ ArgsAfter = decode(L2),
+ [Pre|ArgsAfter]
+ end.
+
+encode([]) -> [];
+encode([H|T]) -> lists:append(H, [$\t|encode(T)]).
Added: trunk/erlang/server/server.erl
===================================================================
--- trunk/erlang/server/server.erl 2005-11-27 00:08:28 UTC (rev 943)
+++ trunk/erlang/server/server.erl 2005-12-09 20:34:01 UTC (rev 944)
@@ -0,0 +1,386 @@
+-module(server).
+-export([cstart/1, start/1, stop/0, worker/2, haver_entry/2, setup_schema/0,
+ clear_transients/0]).
+-include_lib("mnemosyne/include/mnemosyne.hrl").
+
+-record(users, {name,
+ pid}).
+-record(channels, {name, notused}).
+-record(chanjoin, {channel, user}).
+
+
+setup_schema() ->
+ mnesia:delete_table(users),
+ mnesia:create_table(users, [
+ {attributes, record_info(fields, users)},
+ {type, set}
+ ]),
+ mnesia:delete_table(chanjoin),
+ mnesia:create_table(chanjoin, [
+ {attributes, record_info(fields, chanjoin)},
+ {type, bag}
+ ]),
+ mnesia:delete_table(channels),
+ mnesia:create_table(channels, [
+ {attributes, record_info(fields, channels)},
+ {disc_copies, [node()]},
+ {type, set}
+ ]).
+
+clear_transients() ->
+ mnesia:clear_table(users),
+ mnesia:clear_table(chanjoin).
+
+cstart(Port) ->
+ register(haver, self()),
+ clear_transients(),
+ {ok, LSock} = gen_tcp:listen(Port, [list, {packet, 0},
+ {active, true},
+ {reuseaddr, true}]),
+ spawn_link(?MODULE, worker, [self(), LSock]),
+ spawn_loop(LSock).
+
+init_tables() ->
+ mnesia:wait_for_tables([users, chanjoin, channels], 5 * 1000).
+
+start(Port) ->
+ case whereis(haver) of
+ undefined -> do_start(Port);
+ Pid -> { already_running, Pid }
+ end.
+
+do_start(Port) ->
+ mnesia:start(),
+ application:start(mnemosyne),
+ case init_tables() of
+ ok -> { ok, spawn(?MODULE, cstart, [Port]) };
+ Err -> { nok, Err }
+ end.
+stop() -> haver ! shutdown.
+
+reap_child(Pid) ->
+ F = fun() ->
+ Q = query
+ [ E || E <- table(users), E.pid = Pid ]
+ end,
+ R = mnemosyne:eval(Q),
+ case R of
+ [ E ] ->
+ Name = E#users.name,
+ Q2 = query
+ [ J || J <- table(chanjoin), J.user = Name ]
+ end,
+ R2 = mnemosyne:eval(Q2),
+ lists:map(fun(J) -> mnesia:delete_object(J) end, R2),
+ mnesia:delete_object(E),
+ ok;
+ _ -> ok
+ end end,
+ R = mnesia:transaction(F),
+ case R of
+ { atomic, ok } -> { ok };
+ _ -> io:format("Warning: reap failed for pid ~p~n: ~p~n", [Pid,R]),
+ { nok, R }
+ end.
+
+
+spawn_loop(LSock) ->
+ process_flag(trap_exit, true),
+ receive
+ next_worker ->
+ spawn_link(?MODULE, worker, [self(), LSock]),
+ spawn_loop(LSock);
+ shutdown -> ok;
+ { 'EXIT', Pid, Reason } ->
+ io:format("Child ~p~n died with ~p~n", [Pid, Reason]),
+ reap_child(Pid),
+ spawn_loop(LSock);
+ Other ->
+ io:format("Unknown message: ~p~n", Other)
+ end.
+
+worker(Parent, LSock) ->
+ process_flag(trap_exit, false),
+ case gen_tcp:accept(LSock) of
+ {ok, Socket} ->
+ Parent ! next_worker,
+ peer_entry(Parent, Socket),
+ reap_child(self()),
+ gen_tcp:close(Socket);
+ {error, Reason} ->
+ Parent ! next_worker,
+ io:format("Accept error ~p~n", [Reason])
+ end.
+
+peer_entry(Parent, Socket) ->
+ Pid = spawn_link(?MODULE, haver_entry, [Parent, Socket]),
+ peer(Socket, "", Pid).
+
+peer(Socket, Buf, Pid) ->
+ Buf2 = peer_proc(Buf, Pid),
+ receive
+ {tcp, Socket, Data} ->
+ io:format("incoming packet ~p~n", [Data]),
+ peer(Socket, lists:append(Buf2, Data), Pid);
+ {tcp_closed, Why} -> exit({socket_closed, Why});
+ Something ->
+ io:format("Unknown msg ~p~n", [Something]),
+ nok
+ end.
+
+peer_proc(Buf, Pid) ->
+ io:format("peer_proc ~p~n", [Buf]),
+ case lists:partition(fun(C) -> not ((C == $\r) or (C == $\n)) end, Buf) of
+ { _, [] } -> Buf;
+ { L, Rem} ->
+ Pid ! {line, line_encode:decode(L) },
+ Rem2 = lists:dropwhile(fun(C) -> ((C == $\r) or (C == $\n)) end,
Rem),
+ Rem2
+ end.
+
+haver_sendline(Line) ->
+ Socket = get(socket),
+ gen_tcp:send(Socket, line_encode:encode(Line)),
+ gen_tcp:send(Socket, "\r\n").
+
+haver_entry(Parent, Socket) ->
+ link(Parent),
+ put(socket, Socket),
+ receive
+ { line, [ "HAVER", Vers | _ ] } ->
+ haver_sendline(["HAVER", "localhost", "Erver/0.0"]),
+ haver_login();
+ { line, _ } ->
+ gen_tcp:close(Socket),
+ exit(rude_peer);
+ Foo -> io:format("haver_entry unknown msg ~p~n", [Foo])
+
+ end.
+
+handle_ident(Uid) ->
+ F = fun() ->
+ Q = query
+ [ E || E <- table(users), E.name = Uid ]
+ end,
+ R = mnemosyne:eval(Q),
+ io:format("~p~n", [R]),
+ case R of
+ [] -> mnesia:write(#users{name = Uid, pid = self()}),
+ ok;
+ _ -> collision
+ end
+ end,
+ R = mnesia:transaction(F),
+ case R of
+ { atomic, ok } ->
+ haver_sendline(["HELLO", Uid]),
+ put(uid, Uid),
+ haver_mainloop();
+ { atomic, collision } ->
+ haver_sendline(["FAIL", "IDENT", "exists.user", Uid]),
+ haver_login();
+ Wtf -> io:format("wtf: ~p~n", [Wtf])
+ end.
+
+haver_login() ->
+ receive
+ { line, [ "IDENT", Uid ] } -> handle_ident(Uid);
+ { line, _ } ->
+ haver_sendline(["DIE", "ihateyou"]),
+ gen_tcp:close(get(socket)),
+ exit(rudepeer);
+ M -> exit({unexpected, M})
+ end.
+
+find_user(Uid) ->
+ T = fun() ->
+ Q = query
+ [ U.pid || U <- table(users), U.name = Uid ]
+ end,
+ mnemosyne:eval(Q)
+ end,
+ R = mnesia:transaction(T),
+ case R of
+ { atomic, [Pid] } -> Pid;
+ { atomic, [] } -> notfound;
+ { atomic, Wtf } ->
+ io:format("find_user wtf: ~p~n", [Wtf]),
+ notfound;
+ _ ->
+ io:format("find_user err: ~p~n", [R]),
+ notfound
+ end.
+
+haver_open(Channel) ->
+ T = fun() ->
+ Q = query
+ [ C || C <- table(channels), C.name = Channel ]
+ end,
+ R = mnemosyne:eval(Q),
+ case R of
+ [] -> mnesia:write(#channels{name = Channel, notused = Channel}),
+ ok;
+ _ -> collision
+ end end,
+ R = mnesia:transaction(T),
+ case R of
+ { atomic, Result } -> Result
+ end.
+
+chan_broadcast(Channel, Message) ->
+ T = fun() ->
+ Q = query
+ [ U.pid
+ || U <- table(users),
+ J <- table(chanjoin),
+ U.name = J.user,
+ J.channel = Channel
+ ] end,
+ mnemosyne:eval(Q)
+ end,
+ R = mnesia:transaction(T),
+ case R of
+ { atomic, L } -> lists:map(fun(P) -> P ! Message end, L);
+ _ -> io:format("err, bad mnesia txn response ~p~n", [R]),
+ exit({mnesia_fail, R})
+ end.
+
+haver_join(Channel) ->
+ Uid = get(uid),
+ T = fun() ->
+ case mnesia:read({channels, Channel}) of
+ [] -> mnesia:abort(notfound);
+ _ -> ok
+ end,
+ Q = query
+ [ J || J <- table(chanjoin), J.user = Uid, J.channel = Channel ]
+ end,
+ case mnemosyne:eval(Q) of
+ [_]->
+ mnesia:abort(already_joined);
+ [] ->
+ mnesia:write(#chanjoin{channel = Channel, user = Uid}),
+ ok
+ end end,
+ R = mnesia:transaction(T),
+ case R of
+ { aborted, already_joined } -> collision;
+ { aborted, notfound } -> notfound;
+ { atomic, ok } ->
+ chan_broadcast(Channel, { sendline, [ "JOIN", Channel, Uid ] }),
+ ok
+ end.
+
+haver_part(Channel) ->
+ Uid = get(uid),
+ T = fun() ->
+ Q = query
+ [ J || J <- table(chanjoin), J.user = Uid, J.channel = Channel ]
+ end,
+ case mnemosyne:eval(Q) of
+ [] -> notfound;
+ [R]->
+ io:format("R=~p~n", [R]),
+ mnesia:delete_object(R), ok
+ end end,
+ R = mnesia:transaction(T),
+ case R of
+ { atomic, notfound } -> notfound;
+ { atomic, ok } ->
+ chan_broadcast(Channel, { sendline, [ "PART", Channel, Uid ] }),
+ ok
+ end.
+
+haver_getlist("&lobby", "channel") -> { ok, mnesia:dirty_all_keys(channels) };
+haver_getlist("&lobby", "user") -> { ok, mnesia:dirty_all_keys(users) };
+haver_getlist(Channel, "user") ->
+ T = fun() ->
+ case mnesia:read({channels, Channel}) of
+ [] -> mnesia:abort(notfound);
+ _ -> ok
+ end,
+ Records = mnesia:read({chanjoin, Channel}),
+ Uids = lists:map(fun({chanjoin, _, Uid}) -> Uid end, Records),
+ { ok, Uids }
+ end,
+ case mnesia:transaction(T) of
+ { aborted, notfound } -> notfound;
+ { atomic, {ok, Uids} } -> { ok, Uids };
+ Other ->
+ io:format("getlist(~p~n, \"user\") unexpected: ~p~n", [Channel,
Other]),
+ exit(Other)
+ end;
+haver_getlist(_, "channel") -> { ok, [] };
+haver_getlist(_, Type) -> {badtype, Type}.
+
+haver_list(C, T) ->
+ R = haver_getlist(C, T),
+ case R of
+ { ok, Members } -> haver_sendline(["LIST", C, T | Members ]);
+ notfound -> haver_sendline(["FAIL", "LIST", "unknown.channel", C]);
+ badtype -> haver_sendline(["FAIL", "LIST", "unknown.type", C])
+ end.
+
+haver_sendchan(Channel, Message) ->
+ Uid = get(uid),
+ T = fun() ->
+ Q = query
+ [ J || J <- table(chanjoin),
+ J.user = Uid,
+ J.channel = Channel
+ ] end,
+ case mnemosyne:eval(Q) of
+ [] -> mnesis:abort(notjoined);
+ _ -> ok
+ end end,
+ R = mnesia:transaction(T),
+ case R of
+ { aborted, notjoined } ->
+ haver_sendline(["FAIL", "IN", "not.joined", Channel]);
+ { atomic, ok } ->
+ chan_broadcast(Channel, { sendline, ["IN", Channel, Uid | Message]
})
+ end.
+
+haver_mainloop() ->
+ V = receive
+ { line, [ "OPEN", Channel ] } ->
+ case haver_open(Channel) of
+ ok -> haver_sendline(["OPEN", Channel]);
+ collision -> haver_sendline(["FAIL", "OPEN", "exists.channel",
Channel])
+ end, ok;
+ { line, [ "JOIN", Channel ] } ->
+ case haver_join(Channel) of
+ ok -> ok;
+ notfound -> haver_sendline(["FAIL", "JOIN", "unknown.channel",
Channel]);
+ collision -> haver_sendline(["FAIL", "JOIN", "already.joined",
Channel])
+ end, ok;
+ { line, [ "PART", Channel ] } ->
+ case haver_part(Channel) of
+ ok -> haver_sendline(["PART", Channel, get(uid)]);
+ notfound -> haver_sendline(["FAIL", "PART", "not.joined",
Channel])
+ end, ok;
+ { line, [ "TO", Uid | Message ] } ->
+ Pid = find_user(Uid),
+ case Pid of
+ notfound -> haver_sendline(["FAIL", "TO", "unknown.user",
Uid]);
+ _ -> Pid ! { privmsg, get(uid), Message }
+ end, ok;
+ { line, [ "IN", Channel | Message ] } ->
+ haver_sendchan(Channel, Message);
+ { line, [ "LIST", Channel, Type ] } -> haver_list(Channel, Type), ok;
+ { line, [ "POKE" | L ] } -> haver_sendline(["OUCH" | L]);
+ { line, ["DIE"]} ->
+ [] = [1]; % XXX
+ { line, [ L | _ ] } ->
+ io:format("unmatched line: ~p~n", L),
+ haver_sendline(["FAIL", L, "unknown.cmd"]),
+ ok;
+ { line, L } ->
+ exit({err_line, L});
+ { sendline, L } -> haver_sendline(L), ok;
+ { privmsg, From, Message } ->
+ haver_sendline(["FROM", From | Message]),
+ ok;
+ Other -> io:format("unknown msg: ~p~n", Other), ok
+ end,
+ haver_mainloop().
