gameServer/Actions.hs
changeset 5209 f7a610e2ef5f
parent 5184 bf7bba60ed93
child 5210 a5329e52a71b
equal deleted inserted replaced
5208:878e551f0b4a 5209:f7a610e2ef5f
    16 import Control.DeepSeq
    16 import Control.DeepSeq
    17 import Data.Unique
    17 import Data.Unique
    18 import Control.Arrow
    18 import Control.Arrow
    19 import Control.Exception
    19 import Control.Exception
    20 import OfficialServer.GameReplayStore
    20 import OfficialServer.GameReplayStore
       
    21 import System.Process
       
    22 import Network.Socket
    21 -----------------------------
    23 -----------------------------
    22 import CoreTypes
    24 import CoreTypes
    23 import Utils
    25 import Utils
    24 import ClientIO
    26 import ClientIO
    25 import ServerState
    27 import ServerState
    55     | ProcessAccountInfo AccountInfo
    57     | ProcessAccountInfo AccountInfo
    56     | AddClient ClientInfo
    58     | AddClient ClientInfo
    57     | DeleteClient ClientIndex
    59     | DeleteClient ClientIndex
    58     | PingAll
    60     | PingAll
    59     | StatsAction
    61     | StatsAction
    60     | RestartServer Bool
    62     | RestartServer
    61     | AddNick2Bans B.ByteString B.ByteString UTCTime
    63     | AddNick2Bans B.ByteString B.ByteString UTCTime
    62     | AddIP2Bans B.ByteString B.ByteString UTCTime
    64     | AddIP2Bans B.ByteString B.ByteString UTCTime
    63     | CheckBanned
    65     | CheckBanned
    64     | SaveReplay
    66     | SaveReplay
    65 
    67 
   151     rnc <- gets roomsClients
   153     rnc <- gets roomsClients
   152     io $ removeClient rnc ci
   154     io $ removeClient rnc ci
   153 
   155 
   154     s <- get
   156     s <- get
   155     put $! s{removedClients = ci `Set.delete` removedClients s}
   157     put $! s{removedClients = ci `Set.delete` removedClients s}
       
   158     
       
   159     sp <- gets (shutdownPending . serverInfo)
       
   160     cls <- allClientsS
       
   161     io $ when (sp && null cls) $ throwIO ShutdownException
   156 
   162 
   157 processAction (ModifyClient f) = do
   163 processAction (ModifyClient f) = do
   158     (Just ci) <- gets clientIndex
   164     (Just ci) <- gets clientIndex
   159     rnc <- gets roomsClients
   165     rnc <- gets roomsClients
   160     io $ modifyClient rnc f ci
   166     io $ modifyClient rnc f ci
   465     (roomsNum, clientsNum) <- io $ withRoomsAndClients rnc st
   471     (roomsNum, clientsNum) <- io $ withRoomsAndClients rnc st
   466     io $ writeChan (dbQueries si) $ SendStats clientsNum (roomsNum - 1)
   472     io $ writeChan (dbQueries si) $ SendStats clientsNum (roomsNum - 1)
   467     where
   473     where
   468           st irnc = (length $ allRooms irnc, length $ allClients irnc)
   474           st irnc = (length $ allRooms irnc, length $ allClients irnc)
   469 
   475 
   470 processAction (RestartServer force) = do
   476 processAction RestartServer = do
   471     if force then do
   477     sock <- gets (fromJust . serverSocket . serverInfo)
   472         throw RestartException
   478     io $ do
   473         else
   479         noticeM "Core" "Closing listening socket"
   474         processAction $ ModifyServerInfo (\s -> s{restartPending=True})
   480         sClose sock
       
   481         noticeM "Core" "Spawning new server"
       
   482         _ <- createProcess (proc "./hedgewars-server" [])
       
   483         return ()
       
   484     processAction $ ModifyServerInfo (\s -> s{shutdownPending=True})
   475 
   485 
   476 processAction SaveReplay = do
   486 processAction SaveReplay = do
   477     ri <- clientRoomA
   487     ri <- clientRoomA
   478     rnc <- gets roomsClients
   488     rnc <- gets roomsClients
   479     io $ do
   489     io $ do