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