equal
deleted
inserted
replaced
18 |
18 |
19 #if !defined(mingw32_HOST_OS) |
19 #if !defined(mingw32_HOST_OS) |
20 import System.Posix |
20 import System.Posix |
21 #endif |
21 #endif |
22 |
22 |
23 #define IOException Exception |
23 -- #define IOException Exception |
24 |
24 |
25 data Messages = |
25 data Messages = |
26 Accept ClientInfo |
26 Accept ClientInfo |
27 | ClientMessage ([String], ClientInfo) |
27 | ClientMessage ([String], ClientInfo) |
28 | CoreMessage [String] |
28 | CoreMessage [String] |
105 if head answer == "BYE" then return [ch] else return [] |
105 if head answer == "BYE" then return [ch] else return [] |
106 |
106 |
107 let outHandles = concat clHandles' |
107 let outHandles = concat clHandles' |
108 unless (null outHandles) $ putStrLn ((show $ length outHandles) ++ " / " ++ (show $ length clients) ++ " : " ++ (show answer)) |
108 unless (null outHandles) $ putStrLn ((show $ length outHandles) ++ " / " ++ (show $ length clients) ++ " : " ++ (show answer)) |
109 |
109 |
110 -- strange, but this seems to be a bad idea to manually close these handles as it causes hangs |
|
111 let mclients = deleteFirstsBy (==) clients outHandles |
110 let mclients = deleteFirstsBy (==) clients outHandles |
112 |
111 |
113 sendAnswers answers client mclients rooms |
112 sendAnswers answers client mclients rooms |
114 |
113 |
115 |
114 |
137 (CoreMessage `fmap` readTChan messagesChan) |
136 (CoreMessage `fmap` readTChan messagesChan) |
138 |
137 |
139 case r of |
138 case r of |
140 Accept ci -> do |
139 Accept ci -> do |
141 let sameHostClients = filter (\cl -> host ci == host cl) clients |
140 let sameHostClients = filter (\cl -> host ci == host cl) clients |
142 let haveJustConnected = False--not $ null $ filter (\cl -> connectTime ci `diffUTCTime` connectTime cl <= 25) sameHostClients |
141 let haveJustConnected = not $ null $ filter (\cl -> connectTime ci `diffUTCTime` connectTime cl <= 25) sameHostClients |
143 |
142 |
144 when haveJustConnected $ do |
143 when haveJustConnected $ do |
145 atomically $ do |
144 atomically $ do |
146 writeTChan (chan ci) ["QUIT", "Reconnected too fast"] |
145 writeTChan (chan ci) ["QUIT", "Reconnected too fast"] |
147 |
146 |