144 |
144 |
145 clientsChans <- liftM (Prelude.map sendChan . Prelude.filter logonPassed) $! allClientsS |
145 clientsChans <- liftM (Prelude.map sendChan . Prelude.filter logonPassed) $! allClientsS |
146 io $ |
146 io $ |
147 infoM "Clients" (show ci ++ " quits: " ++ B.unpack msg) |
147 infoM "Clients" (show ci ++ " quits: " ++ B.unpack msg) |
148 |
148 |
149 processAction $ AnswerClients [chan] ["BYE", msg] |
|
150 when loggedIn $ processAction $ AnswerClients clientsChans ["LOBBY:LEFT", clNick, msg] |
149 when loggedIn $ processAction $ AnswerClients clientsChans ["LOBBY:LEFT", clNick, msg] |
|
150 |
|
151 mapM processAction |
|
152 [ |
|
153 AnswerClients [chan] ["BYE", msg] |
|
154 , ModifyClient (\c -> c{logonPassed = False}) -- this will effectively hide client from others while he isn't deleted from list |
|
155 ] |
151 |
156 |
152 s <- get |
157 s <- get |
153 put $! s{removedClients = ci `Set.insert` removedClients s} |
158 put $! s{removedClients = ci `Set.insert` removedClients s} |
154 |
159 |
155 processAction (DeleteClient ci) = do |
160 processAction (DeleteClient ci) = do |
416 |
421 |
417 |
422 |
418 processAction JoinLobby = do |
423 processAction JoinLobby = do |
419 chan <- client's sendChan |
424 chan <- client's sendChan |
420 clientNick <- client's nick |
425 clientNick <- client's nick |
421 (lobbyNicks, clientsChans) <- liftM (unzip . Prelude.map (nick &&& sendChan) . Prelude.filter logonPassed) $! allClientsS |
426 isAuthenticated <- liftM (not . B.null) $ client's webPassword |
422 mapM_ processAction $ |
427 isAdmin <- client's isAdministrator |
423 AnswerClients clientsChans ["LOBBY:JOINED", clientNick] |
428 loggedInClients <- liftM (Prelude.filter logonPassed) $! allClientsS |
424 : AnswerClients [chan] ("LOBBY:JOINED" : clientNick : lobbyNicks) |
429 let (lobbyNicks, clientsChans) = unzip . L.map (nick &&& sendChan) $ loggedInClients |
425 : [ModifyClient (\cl -> cl{logonPassed = True}), SendServerMessage] |
430 let authenticatedNicks = L.map nick . L.filter (not . B.null . webPassword) $ loggedInClients |
|
431 let adminsNicks = L.map nick . L.filter isAdministrator $ loggedInClients |
|
432 let clFlags = B.concat . L.concat $ [["u" | isAuthenticated], ["a" | isAdmin]] |
|
433 mapM_ processAction . concat $ [ |
|
434 [AnswerClients clientsChans ["LOBBY:JOINED", clientNick]] |
|
435 , [AnswerClients [chan] ("LOBBY:JOINED" : clientNick : lobbyNicks)] |
|
436 , [AnswerClients [chan] ("CLIENT_FLAGS" : "+u" : authenticatedNicks) | not $ null authenticatedNicks] |
|
437 , [AnswerClients [chan] ("CLIENT_FLAGS" : "+a" : adminsNicks) | not $ null adminsNicks] |
|
438 , [AnswerClients (chan : clientsChans) ["CLIENT_FLAGS", B.concat["+" , clFlags], clientNick] | not $ B.null clFlags] |
|
439 , [ModifyClient (\cl -> cl{logonPassed = True})] |
|
440 , [SendServerMessage] |
|
441 ] |
426 |
442 |
427 |
443 |
428 processAction (KickClient kickId) = do |
444 processAction (KickClient kickId) = do |
429 modify (\s -> s{clientIndex = Just kickId}) |
445 modify (\s -> s{clientIndex = Just kickId}) |
430 clHost <- client's host |
446 clHost <- client's host |
520 io $ mapM_ (modifyClient rnc (\cl -> cl{pingsQueue = pingsQueue cl + 1})) cis |
536 io $ mapM_ (modifyClient rnc (\cl -> cl{pingsQueue = pingsQueue cl + 1})) cis |
521 processAction $ AnswerClients chans ["PING"] |
537 processAction $ AnswerClients chans ["PING"] |
522 where |
538 where |
523 kickTimeouted rnc ci = do |
539 kickTimeouted rnc ci = do |
524 pq <- io $ client'sM rnc pingsQueue ci |
540 pq <- io $ client'sM rnc pingsQueue ci |
525 when (pq > 0) $ |
541 when (pq > 0) $ do |
526 withStateT (\as -> as{clientIndex = Just ci}) $ |
542 withStateT (\as -> as{clientIndex = Just ci}) $ |
527 processAction (ByeClient "Ping timeout") |
543 processAction (ByeClient "Ping timeout") |
|
544 when (pq > 1) $ |
|
545 processAction $ DeleteClient ci -- smth went wrong with client io threads, issue DeleteClient here |
528 |
546 |
529 |
547 |
530 processAction StatsAction = do |
548 processAction StatsAction = do |
531 si <- gets serverInfo |
549 si <- gets serverInfo |
532 when (not $ shutdownPending si) $ do |
550 when (not $ shutdownPending si) $ do |