Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

388 lines (323 sloc) 10.685 kb
% -*- Erlang -*-
% File: chat.erl (chat.erl)
% Author: Johan Bevemyr
% Created: Thu Nov 18 21:27:41 2004
% Purpose:
-module('chat').
-author('jb@son.bevemyr.com').
-define(COLOR1, "#ffc197").
-define(COLOR2, "#ff6600").
-define(COLOR3, "#887da7").
-define(COLOR4, "#afa2d3").
-define(LOCATION, "test").
%% There is a bug in the erlang inet driver which causes yaws
%% to ignore requests after a POST. This bug is present in the
%% now current release R10B-3. We have submitted a bugfix to
%% erlbugs so it may be fixed in some future release. Until then...
-define(ERL_BUG, true).
-export([check_session/1, get_user/1, login/2, chat_server_init/0,
session_server/0,dynamic_headers/0, display_login/2]).
-export([chat_read/1, chat_write/1]).
-include("../../../include/yaws_api.hrl").
-record(user, {last_read,
buffer=[],
user,
pid,
color,
cookie}).
login(User, _Password) ->
session_server(),
erlang:send(chat_server, {new_session, User, self()}),
receive
{session_manager, Cookie, _Session} ->
chat_server ! {join_message, User},
{ok, Cookie};
_ ->
error
end.
%% FIXME: way to simple session handling. The system will behave
%% very badly if two users log in with the same user name!!!
check_session(A) ->
H = A#arg.headers,
case yaws_api:find_cookie_val("sessionid", H#headers.cookie) of
[] ->
display_login(A, "not logged in");
CVal ->
case check_cookie(CVal) of
error ->
display_login(A, "not logged in");
Session ->
{ok, Session}
end
end.
check_cookie(Cookie) ->
session_server(),
chat_server ! {get_session, Cookie, self()},
receive
{session_manager, {ok, Session}} ->
Session;
{session_manager, error} ->
error
end.
get_user(Session) ->
Session#user.user.
display_login(_A, Status) ->
(dynamic_headers() ++
[{ehtml,
[{body, [{onload,"document.f.user.focus();"},{bgcolor,?COLOR3}],
[{table, [{border,0},{bgcolor,?COLOR2},{cellspacing,1},
{width,"100%"}],
{tr,[{bgcolor,?COLOR1},{height,30}],
{td,[{nowrap,true},{align,left},{valign,middle}],
{b,[],
{font, [{size,4},{color,black}],
["Chat at ", ?LOCATION]}}}}},
{pre_html, io_lib:format("<p>Your login status is: ~s</p>",
[Status])},
{form,
[{method,post},
{name,f},
{action, "login.yaws"},
{autocomplete,"off"}],
{table,[{cellspacing, "5"}],
[{tr, [],
[{td, [], {p, [], "Username:"}},
{td, [], {input, [{name, user},
{type, text},
{size, "20"}]}}
]},
{tr, [],
[{td, [], {p, [], "Password:"}},
{td, [], {input, [{name, password},
{type, password},
{size, "20"}]}}]},
{tr, [],
{td, [{align, "right"}, {colspan, "2"}],
{input, [{type, submit},
{value, "Login"}]}}}
]}}]
}]
}]).
session_server() ->
case whereis(chat_server) of
undefined ->
Pid = proc_lib:spawn(?MODULE, chat_server_init, []),
register(chat_server, Pid);
_ ->
done
end.
%%
chat_server_init() ->
process_flag(trap_exit, true),
io:format("Starting chat server\n"),
put(color_idx, 0),
chat_server([]).
%%
chat_server(Users0) ->
Users = gc_users(Users0),
%% io:format("Users = ~p\n", [Users]),
receive
{get_session, Cookie, From} ->
%% io:format("get_session ~p\n", [Cookie]),
case lists:keysearch(Cookie, #user.cookie, Users) of
{value, Session} ->
From ! {session_manager, {ok, Session}};
false ->
From ! {session_manager, error}
end,
chat_server(Users);
{new_session, User, From} ->
Cookie = integer_to_list(bin2int(crypto:rand_bytes(16))),
Session = #user{cookie=Cookie, user=User, color=pick_color()},
From ! {session_manager, Cookie, Session},
chat_server([Session|Users]);
{write, Session, Msg} ->
NewUsers = send_to_all(msg,
fmt_msg(Session#user.user, Msg,
Session#user.color),
Users),
chat_server(NewUsers);
{send_to, User, Msg} ->
NewUsers = send_to_one(msg, Msg, Users, User),
chat_server(NewUsers);
{join_message, User} ->
NewUsers0 = send_to_all(msg,fmt_join(User), Users),
NewUsers1 = send_to_all(members,
fmt_members(NewUsers0), NewUsers0),
chat_server(NewUsers1);
{members, User} ->
NewUsers1 = send_to_one(members,
fmt_members(Users),
Users, User),
chat_server(NewUsers1);
{left_message, User} ->
NewUsers0 = send_to_all(msg,fmt_left(User), Users),
NewUsers1 = send_to_all(members,
fmt_members(NewUsers0), NewUsers0),
chat_server(NewUsers1);
{read, Session, Pid} ->
%% io:format("~p want read ~p\n", [Session#user.user, Pid]),
NewUsers = user_read(Users, Session, Pid),
chat_server(NewUsers);
{cancel_read, Pid} ->
NewUsers = cancel_read(Users, Pid),
chat_server(NewUsers)
after
5000 ->
chat_server(Users)
end.
bin2int(Bin) ->
lists:foldl(fun(N, Acc) -> Acc * 256 + N end, 0, binary_to_list(Bin)).
%%
cancel_read([], _Pid) ->
[];
cancel_read([U|Us], Pid) when U#user.pid == Pid ->
Now = inow(now()),
[U#user{pid=undefined,last_read=Now}|Us];
cancel_read([U|Us], Pid) ->
[U|cancel_read(Us, Pid)].
%%
user_read(Users, User, Pid) ->
user_read(Users, User, Pid, Users).
user_read([], _User, _Pid, All) ->
All;
user_read([U|Users], User, Pid, _All) when U#user.cookie == User#user.cookie ->
if U#user.buffer /= [] ->
Pid ! {msgs,lists:reverse(U#user.buffer)},
[U#user{buffer=[]}|Users];
true ->
[U#user{pid=Pid}|Users]
end;
user_read([U|Users], User, Pid, All) ->
[U|user_read(Users, User, Pid, All)].
%%
send_to_all(Type, Msg, Users) ->
Now = inow(now()),
F = fun(U) ->
if U#user.pid /= undefined ->
%% io:format("Sending ~p to ~p\n", [Msg, U#user.user]),
U#user.pid ! {msgs, [{Type, Msg}]},
U#user{pid=undefined, last_read = Now};
true ->
U#user{buffer=[{Type,Msg}|U#user.buffer]}
end
end,
lists:map(F, Users).
%%
send_to_one(Type, Msg, Users, User) ->
Now = inow(now()),
F = fun(U) when U#user.cookie == User#user.cookie ->
if U#user.pid /= undefined ->
%% io:format("Sending ~p to ~p\n", [Msg, U#user.user]),
U#user.pid ! {msgs, [{Type, Msg}]},
U#user{pid=undefined, last_read = Now};
true ->
U#user{buffer=[{Type,Msg}|U#user.buffer]}
end;
(U) ->
U
end,
lists:map(F, Users).
%%
gc_users(Users) ->
Now = inow(now()),
gc_users(Users, Now).
gc_users([], _Now) ->
[];
gc_users([U|Us], Now) ->
if U#user.pid == undefined, (Now-U#user.last_read > 10) ->
self() ! {left_message, U#user.user},
gc_users(Us, Now);
true ->
[U|gc_users(Us, Now)]
end.
%
inow(Now) ->
{MSec, Sec, _} = Now,
MSec*1000000 + Sec.
%
dynamic_headers() ->
[yaws_api:set_content_type("text/html"),
{header, {cache_control, "no-cache"}},
{header, "Expires: -1"}].
%
chat_read(A) ->
session_server(),
case check_session(A) of
{ok, Session} ->
chat_server ! {read, Session, self()},
if length(A#arg.querydata) > 0 ->
chat_server ! {members, Session};
true ->
ok
end,
receive
{msgs, Messages} ->
M = [fmt_type(Type,L) || {Type, L} <- Messages],
dynamic_headers()++[{html, ["ok",M]}, break]
after
20000 ->
catch erlang:send(chat_server, {cancel_read, self()}),
dynamic_headers()++[{html, "timeout"}, break]
end;
_Error ->
dynamic_headers()++[{html, "error"}, break]
end.
type2tag(msg) -> $m;
type2tag(members) -> $e.
%
fmt_type(Type, L) ->
Data = list_to_binary(L),
[type2tag(Type), integer_to_list(size(Data)),":", Data].
%
-ifdef(ERL_BUG).
chat_write(A) ->
session_server(),
case check_session(A) of
{ok, Session} ->
chat_server ! {write, Session, A#arg.clidata},
[{html, "ok"},
break];
Error ->
Error
end.
-else.
chat_write(A) ->
session_server(),
case check_session(A) of
{ok, Session} ->
chat_server ! {write, Session,A#arg.clidata},
[{header, {connection,"close"}},
{html, "ok"},
break];
Error ->
Error
end.
-endif.
%%
fmt_join(User) ->
["<strong>",date_str()," ",User, " joined</strong>"].
%%
fmt_left(User) ->
["<strong>",date_str()," ",User," left</strong>"].
%%
fmt_msg(User, Msg, Color) ->
["<font color=",Color,">",date_str()," <strong>",User,":</strong></font> ",
Msg].
%%
fmt_members(Users) ->
[[U#user.user,"<br>"] || U <- Users].
%%
date_str() ->
{_,{H,M,S}} = calendar:local_time(),
io_lib:format("<small>(~2.2.0w:~2.2.0w:~2.2.0w)</small>", [H,M,S]).
%%
pick_color() ->
Nr = get(color_idx),
put(color_idx, (Nr+1) rem 4),
colors(Nr).
%%
colors(0) -> "blue";
colors(1) -> "orange";
colors(2) -> "red";
colors(3) -> "green".
Jump to Line
Something went wrong with that request. Please try again.