author | unc0rr |
Sat, 19 Apr 2008 19:34:19 +0000 | |
changeset 852 | f756a1d3324c |
parent 851 | 8ffa4ad0d8ea |
permissions | -rw-r--r-- |
849 | 1 |
module Main where |
2 |
||
3 |
import Network |
|
4 |
import IO |
|
5 |
import System.IO |
|
6 |
import Control.Concurrent |
|
7 |
import Control.Concurrent.STM |
|
8 |
import Control.Exception (finally) |
|
9 |
import Miscutils |
|
10 |
||
11 |
||
12 |
handleCmd :: Handle -> TVar[ClientInfo] -> TVar[RoomInfo] -> (String, [String]) -> IO() |
|
13 |
handleCmd clientHandle clientsList roomsList ("SAY", param) = do |
|
14 |
ls <- atomically(readTVar clientsList) |
|
15 |
sendOthers (map (\x -> handle x) ls) clientHandle (concat param) |
|
16 |
return () |
|
17 |
||
18 |
handleCmd clientHandle clientsList roomsList ("CREATE", [roomname]) = do |
|
852
f756a1d3324c
Handle the case when the room is already created by someone else
unc0rr
parents:
851
diff
changeset
|
19 |
res <- manipState2 clientsList roomsList (hcCreate) |
f756a1d3324c
Handle the case when the room is already created by someone else
unc0rr
parents:
851
diff
changeset
|
20 |
if res then sendMsg clientHandle ("JOINED " ++ roomname) else sendMsg clientHandle "Already exists" |
851 | 21 |
where |
22 |
hcCreate ci ri = if (null $ filter (\ xr -> roomname == name xr) ri) then |
|
23 |
(map |
|
24 |
(\ xc |
|
25 |
-> if (clientHandle == handle xc) then |
|
26 |
xc {isMaster = True, room = roomname} |
|
27 |
else |
|
28 |
xc) |
|
29 |
ci, |
|
852
f756a1d3324c
Handle the case when the room is already created by someone else
unc0rr
parents:
851
diff
changeset
|
30 |
(RoomInfo roomname "") : ri, True) |
851 | 31 |
else |
852
f756a1d3324c
Handle the case when the room is already created by someone else
unc0rr
parents:
851
diff
changeset
|
32 |
(ci, ri, False) |
849 | 33 |
|
34 |
handleCmd clientHandle clientsList roomsList ("LIST", []) = do |
|
35 |
rl <- atomically $ readTVar roomsList |
|
36 |
sendMsg clientHandle (unlines $ map (\x -> name x) rl) |
|
37 |
||
38 |
handleCmd clientHandle _ _ ("PING", _) = sendMsg clientHandle "PONG" |
|
39 |
||
40 |
handleCmd clientHandle _ _ (_, _) = sendMsg clientHandle "Unknown cmd or bad syntax" |
|
41 |
||
42 |
||
43 |
clientLoop :: Handle -> TVar[ClientInfo] -> TVar[RoomInfo] -> IO() |
|
44 |
clientLoop clientHandle clientsList roomsList = do |
|
45 |
cline <- hGetLine clientHandle |
|
46 |
let (cmd, params) = extractCmd cline |
|
47 |
handleCmd clientHandle clientsList roomsList (cmd, params) |
|
48 |
if cmd /= "QUIT" then clientLoop clientHandle clientsList roomsList else return () |
|
49 |
||
50 |
||
51 |
main = do |
|
52 |
clientsList <- atomically $ newTVar[] |
|
53 |
roomsList <- atomically $ newTVar[] |
|
54 |
bracket |
|
851 | 55 |
(listenOn $ Service "hedgewars") |
849 | 56 |
(sClose) |
57 |
(loop clientsList roomsList) |
|
58 |
where |
|
59 |
loop clist rlist sock = accept sock >>= addClient clist rlist >> loop clist rlist sock |
|
60 |
||
61 |
addClient clist rlist (chandle, hostname, port) = do |
|
62 |
putStrLn $ "Client connected: " ++ show hostname |
|
63 |
hSetBuffering chandle LineBuffering |
|
64 |
manipState clist (\x -> (ClientInfo chandle "" "" False):x) -- add client to list |
|
65 |
forkIO $ finally |
|
66 |
(clientLoop chandle clist rlist) |
|
67 |
(do |
|
68 |
manipState clist (\x -> filter (\x -> chandle /= handle x) x) -- remove client from list |
|
69 |
hClose chandle) |