equal
deleted
inserted
replaced
28 atomically $ writeTChan messagesChan ["PING"] |
28 atomically $ writeTChan messagesChan ["PING"] |
29 |
29 |
30 acceptLoop :: Socket -> TChan ClientInfo -> IO () |
30 acceptLoop :: Socket -> TChan ClientInfo -> IO () |
31 acceptLoop servSock acceptChan = Control.Exception.handle (const $ putStrLn "exception on connect" >> acceptLoop servSock acceptChan) $ do |
31 acceptLoop servSock acceptChan = Control.Exception.handle (const $ putStrLn "exception on connect" >> acceptLoop servSock acceptChan) $ do |
32 (cHandle, host, port) <- accept servSock |
32 (cHandle, host, port) <- accept servSock |
|
33 putStrLn "new client" |
33 cChan <- atomically newTChan |
34 cChan <- atomically newTChan |
34 forkIO $ clientLoop cHandle cChan |
35 forkIO $ clientLoop cHandle cChan |
35 atomically $ writeTChan acceptChan (ClientInfo cChan cHandle "" 0 "" False False False) |
36 atomically $ writeTChan acceptChan (ClientInfo cChan cHandle "" 0 "" False False False) |
36 atomically $ writeTChan cChan ["ASKME"] |
37 atomically $ writeTChan cChan ["ASKME"] |
37 acceptLoop servSock acceptChan |
38 acceptLoop servSock acceptChan |
72 hPutStrLn ch "" |
73 hPutStrLn ch "" |
73 hFlush ch |
74 hFlush ch |
74 if head answer == "BYE" then return [ch] else return [] |
75 if head answer == "BYE" then return [ch] else return [] |
75 |
76 |
76 let outHandles = concat clHandles' |
77 let outHandles = concat clHandles' |
|
78 unless (null outHandles) $ putStrLn ("bye: " ++ (show $ length outHandles) ++ "/" ++ (show $ length clients) ++ " clients") |
77 mapM_ (\ch -> Control.Exception.handle (const $ putStrLn "error on hClose") (hClose ch)) outHandles |
79 mapM_ (\ch -> Control.Exception.handle (const $ putStrLn "error on hClose") (hClose ch)) outHandles |
78 let mclients = remove clients outHandles |
80 let mclients = remove clients outHandles |
79 |
81 |
80 sendAnswers answers client mclients rooms |
82 sendAnswers answers client mclients rooms |
81 where |
83 where |