1%    -*- Erlang -*-
2%    File:        chat.erl  (chat.erl)
3%    Author:        Johan Bevemyr
4%    Created:        Thu Nov 18 21:27:41 2004
5%    Purpose:
6
7-module('chat').
8-author('jb@son.bevemyr.com').
9
10-define(COLOR1,  "#ffc197").
11-define(COLOR2,  "#ff6600").
12-define(COLOR3,  "#887da7").
13-define(COLOR4,  "#afa2d3").
14-define(LOCATION, "test").
15
16%% There is a bug in the erlang inet driver which causes yaws
17%% to ignore requests after a POST. This bug is present in the
18%% now current release R10B-3. We have submitted a bugfix to
19%% erlbugs so it may be fixed in some future release. Until then...
20
21-define(ERL_BUG, true).
22
23-export([check_session/1, get_user/1, login/2, chat_server_init/0,
24        session_server/0,dynamic_headers/0, display_login/2]).
25
26-export([chat_read/1, chat_write/1]).
27
28-include("../../../include/yaws_api.hrl").
29
30-record(user, {last_read,
31               buffer=[],
32               user,
33               pid,
34               color,
35               cookie}).
36
37
38login(User, _Password) ->
39    session_server(),
40    erlang:send(chat_server, {new_session, User, self()}),
41    receive
42        {session_manager, Cookie, _Session} ->
43            chat_server ! {join_message, User},
44            {ok, Cookie};
45        _ ->
46            error
47    end.
48
49%% FIXME: way to simple session handling. The system will behave
50%% very badly if two users log in with the same user name!!!
51
52check_session(A) ->
53    H = A#arg.headers,
54    case yaws_api:find_cookie_val("sessionid", H#headers.cookie) of
55        [] ->
56            display_login(A, "not logged in");
57        CVal ->
58            case check_cookie(CVal) of
59                error ->
60                    display_login(A, "not logged in");
61                Session ->
62                    {ok, Session}
63            end
64    end.
65
66check_cookie(Cookie) ->
67    session_server(),
68    chat_server ! {get_session, Cookie, self()},
69    receive
70        {session_manager, {ok, Session}} ->
71            Session;
72        {session_manager, error} ->
73            error
74    end.
75
76get_user(Session) ->
77    Session#user.user.
78
79display_login(_A, Status) ->
80    (dynamic_headers() ++
81     [{ehtml,
82       [{body, [{onload,"document.f.user.focus();"},{bgcolor,?COLOR3}],
83         [{table, [{border,0},{bgcolor,?COLOR2},{cellspacing,1},
84                   {width,"100%"}],
85           {tr,[{bgcolor,?COLOR1},{height,30}],
86            {td,[{nowrap,true},{align,left},{valign,middle}],
87                   {b,[],
88                    {font, [{size,4},{color,black}],
89                     ["Chat at ", ?LOCATION]}}}}},
90          {pre_html, io_lib:format("<p>Your login status is: ~s</p>",
91                                   [Status])},
92          {form,
93           [{method,post},
94            {name,f},
95            {action, "login.yaws"},
96            {autocomplete,"off"}],
97           {table,[{cellspacing, "5"}],
98            [{tr, [],
99              [{td, [], {p, [], "Username:"}},
100               {td, [], {input, [{name, user},
101                                 {type, text},
102                                 {size, "20"}]}}
103              ]},
104             {tr, [],
105              [{td, [], {p, [], "Password:"}},
106               {td, [], {input, [{name, password},
107                                 {type, password},
108                                 {size, "20"}]}}]},
109             {tr, [],
110              {td, [{align, "right"}, {colspan, "2"}],
111               {input, [{type, submit},
112                        {value, "Login"}]}}}
113            ]}}]
114        }]
115      }]).
116
117
118session_server() ->
119    case whereis(chat_server) of
120        undefined ->
121            Pid = proc_lib:spawn(?MODULE, chat_server_init, []),
122            register(chat_server, Pid);
123        _ ->
124            done
125    end.
126
127%%
128
129chat_server_init() ->
130    process_flag(trap_exit, true),
131    io:format("Starting chat server\n"),
132    put(color_idx, 0),
133    chat_server([]).
134
135%%
136
137chat_server(Users0) ->
138    Users = gc_users(Users0),
139    %% io:format("Users = ~p\n", [Users]),
140    receive
141        {get_session, Cookie, From} ->
142            %% io:format("get_session ~p\n", [Cookie]),
143            case lists:keysearch(Cookie, #user.cookie, Users) of
144                {value, Session} ->
145                    From ! {session_manager, {ok, Session}};
146                false ->
147                    From ! {session_manager, error}
148            end,
149            chat_server(Users);
150        {new_session, User, From} ->
151            Cookie = integer_to_list(bin2int(crypto:strong_rand_bytes(16))),
152            Session = #user{cookie=Cookie, user=User, color=pick_color()},
153            From ! {session_manager, Cookie, Session},
154            chat_server([Session|Users]);
155        {write, Session, Msg} ->
156            NewUsers = send_to_all(msg,
157                                   fmt_msg(Session#user.user, Msg,
158                                           Session#user.color),
159                                   Users),
160            chat_server(NewUsers);
161        {send_to, User, Msg} ->
162            NewUsers = send_to_one(msg, Msg, Users, User),
163            chat_server(NewUsers);
164        {join_message, User} ->
165            NewUsers0 = send_to_all(msg,fmt_join(User), Users),
166            NewUsers1 = send_to_all(members,
167                                    fmt_members(NewUsers0), NewUsers0),
168            chat_server(NewUsers1);
169        {members, User} ->
170            NewUsers1 = send_to_one(members,
171                                    fmt_members(Users),
172                                    Users, User),
173            chat_server(NewUsers1);
174        {left_message, User} ->
175            NewUsers0 = send_to_all(msg,fmt_left(User), Users),
176            NewUsers1 = send_to_all(members,
177                                    fmt_members(NewUsers0), NewUsers0),
178            chat_server(NewUsers1);
179        {read, Session, Pid} ->
180            %% io:format("~p want read ~p\n", [Session#user.user, Pid]),
181            NewUsers = user_read(Users, Session, Pid),
182            chat_server(NewUsers);
183        {cancel_read, Pid} ->
184            NewUsers = cancel_read(Users, Pid),
185            chat_server(NewUsers)
186    after
187        5000 ->
188            chat_server(Users)
189    end.
190
191bin2int(Bin) ->
192    lists:foldl(fun(N, Acc) -> Acc * 256 + N end, 0, binary_to_list(Bin)).
193
194
195%%
196
197cancel_read([], _Pid) ->
198    [];
199cancel_read([U|Us], Pid) when U#user.pid == Pid ->
200    Now = inow(yaws:get_time_tuple()),
201    [U#user{pid=undefined,last_read=Now}|Us];
202cancel_read([U|Us], Pid) ->
203    [U|cancel_read(Us, Pid)].
204
205%%
206
207user_read(Users, User, Pid) ->
208    user_read(Users, User, Pid, Users).
209
210user_read([], _User, _Pid, All) ->
211    All;
212
213user_read([U|Users], User, Pid, _All) when U#user.cookie == User#user.cookie ->
214    if U#user.buffer /= [] ->
215            Pid ! {msgs,lists:reverse(U#user.buffer)},
216            [U#user{buffer=[]}|Users];
217       true ->
218            [U#user{pid=Pid}|Users]
219    end;
220
221user_read([U|Users], User, Pid, All) ->
222    [U|user_read(Users, User, Pid, All)].
223
224%%
225
226send_to_all(Type, Msg, Users) ->
227    Now = inow(yaws:get_time_tuple()),
228    F = fun(U) ->
229                if U#user.pid /= undefined ->
230                        %% io:format("Sending ~p to ~p\n", [Msg, U#user.user]),
231                        U#user.pid ! {msgs, [{Type, Msg}]},
232                        U#user{pid=undefined, last_read = Now};
233                   true ->
234                        U#user{buffer=[{Type,Msg}|U#user.buffer]}
235                end
236        end,
237    lists:map(F, Users).
238
239%%
240
241send_to_one(Type, Msg, Users, User) ->
242    Now = inow(yaws:get_time_tuple()),
243    F = fun(U) when U#user.cookie == User#user.cookie  ->
244                if U#user.pid /= undefined ->
245                        %% io:format("Sending ~p to ~p\n", [Msg, U#user.user]),
246                        U#user.pid ! {msgs, [{Type, Msg}]},
247                        U#user{pid=undefined, last_read = Now};
248                   true ->
249                        U#user{buffer=[{Type,Msg}|U#user.buffer]}
250                end;
251           (U) ->
252                U
253        end,
254    lists:map(F, Users).
255
256%%
257
258
259gc_users(Users) ->
260    Now = inow(yaws:get_time_tuple()),
261    gc_users(Users, Now).
262
263gc_users([], _Now) ->
264    [];
265gc_users([U|Us], Now) ->
266    if U#user.pid == undefined, (Now-U#user.last_read > 10) ->
267            self() ! {left_message, U#user.user},
268            gc_users(Us, Now);
269       true ->
270            [U|gc_users(Us, Now)]
271    end.
272
273%
274
275inow(Now) ->
276    {MSec, Sec, _} = Now,
277    MSec*1000000 + Sec.
278
279%
280
281dynamic_headers() ->
282    [yaws_api:set_content_type("text/html"),
283     {header, {cache_control, "no-cache"}},
284     {header, "Expires: -1"}].
285
286%
287
288chat_read(A) ->
289    session_server(),
290    case check_session(A) of
291        {ok, Session} ->
292            chat_server ! {read, Session, self()},
293            if length(A#arg.querydata) > 0 ->
294                    chat_server ! {members, Session};
295               true ->
296                    ok
297            end,
298            receive
299                {msgs, Messages} ->
300                    M = [fmt_type(Type,L) || {Type, L} <- Messages],
301                    dynamic_headers()++[{html, ["ok",M]}, break]
302            after
303                20000 ->
304                    catch erlang:send(chat_server, {cancel_read, self()}),
305                    dynamic_headers()++[{html, "timeout"}, break]
306            end;
307        _Error ->
308            dynamic_headers()++[{html, "error"}, break]
309    end.
310
311type2tag(msg) -> $m;
312type2tag(members) -> $e.
313
314%
315
316fmt_type(Type, L) ->
317    Data = list_to_binary(L),
318    [type2tag(Type), integer_to_list(size(Data)),":", Data].
319
320%
321
322-ifdef(ERL_BUG).
323chat_write(A) ->
324    session_server(),
325    case check_session(A) of
326        {ok, Session} ->
327            chat_server ! {write, Session, A#arg.clidata},
328            [{html, "ok"},
329              break];
330        Error ->
331            Error
332    end.
333-else.
334chat_write(A) ->
335    session_server(),
336    case check_session(A) of
337        {ok, Session} ->
338            chat_server ! {write, Session,A#arg.clidata},
339            [{header, {connection,"close"}},
340             {html, "ok"},
341             break];
342        Error ->
343            Error
344    end.
345-endif.
346
347%%
348
349fmt_join(User) ->
350    ["<strong>",date_str()," ",User, " joined</strong>"].
351
352%%
353
354fmt_left(User) ->
355    ["<strong>",date_str()," ",User," left</strong>"].
356
357%%
358
359fmt_msg(User, Msg, Color) ->
360    ["<font color=",Color,">",date_str()," <strong>",User,":</strong></font> ",
361     Msg].
362
363%%
364
365fmt_members(Users) ->
366    [[U#user.user,"<br>"] || U <- Users].
367
368%%
369
370date_str() ->
371    {_,{H,M,S}} = calendar:local_time(),
372    io_lib:format("<small>(~2.2.0w:~2.2.0w:~2.2.0w)</small>", [H,M,S]).
373
374%%
375
376pick_color() ->
377    Nr = get(color_idx),
378    put(color_idx, (Nr+1) rem 4),
379    colors(Nr).
380
381%%
382
383colors(0) -> "blue";
384colors(1) -> "orange";
385colors(2) -> "red";
386colors(3) -> "green".
387
388