# HG changeset patch
# User unc0rr
# Date 1305468601 -14400
# Node ID f7a610e2ef5f94d9a93585c3a172dc950e910079
# Parent  878e551f0b4a21eaf8901c3a9c9e5e85e3f21fe3
On restart command close server socket and spawn new server, keep running until last client quits

diff -r 878e551f0b4a -r f7a610e2ef5f gameServer/Actions.hs
--- a/gameServer/Actions.hs	Thu May 12 23:29:31 2011 +0200
+++ b/gameServer/Actions.hs	Sun May 15 18:10:01 2011 +0400
@@ -18,6 +18,8 @@
 import Control.Arrow
 import Control.Exception
 import OfficialServer.GameReplayStore
+import System.Process
+import Network.Socket
 -----------------------------
 import CoreTypes
 import Utils
@@ -57,7 +59,7 @@
     | DeleteClient ClientIndex
     | PingAll
     | StatsAction
-    | RestartServer Bool
+    | RestartServer
     | AddNick2Bans B.ByteString B.ByteString UTCTime
     | AddIP2Bans B.ByteString B.ByteString UTCTime
     | CheckBanned
@@ -153,6 +155,10 @@
 
     s <- get
     put $! s{removedClients = ci `Set.delete` removedClients s}
+    
+    sp <- gets (shutdownPending . serverInfo)
+    cls <- allClientsS
+    io $ when (sp && null cls) $ throwIO ShutdownException
 
 processAction (ModifyClient f) = do
     (Just ci) <- gets clientIndex
@@ -467,11 +473,15 @@
     where
           st irnc = (length $ allRooms irnc, length $ allClients irnc)
 
-processAction (RestartServer force) = do
-    if force then do
-        throw RestartException
-        else
-        processAction $ ModifyServerInfo (\s -> s{restartPending=True})
+processAction RestartServer = do
+    sock <- gets (fromJust . serverSocket . serverInfo)
+    io $ do
+        noticeM "Core" "Closing listening socket"
+        sClose sock
+        noticeM "Core" "Spawning new server"
+        _ <- createProcess (proc "./hedgewars-server" [])
+        return ()
+    processAction $ ModifyServerInfo (\s -> s{shutdownPending=True})
 
 processAction SaveReplay = do
     ri <- clientRoomA
diff -r 878e551f0b4a -r f7a610e2ef5f gameServer/CoreTypes.hs
--- a/gameServer/CoreTypes.hs	Thu May 12 23:29:31 2011 +0200
+++ b/gameServer/CoreTypes.hs	Sun May 15 18:10:01 2011 +0400
@@ -128,14 +128,15 @@
         dbLogin :: B.ByteString,
         dbPassword :: B.ByteString,
         bans :: [BanInfo],
-        restartPending :: Bool,
+        shutdownPending :: Bool,
         coreChan :: Chan CoreMessage,
         dbQueries :: Chan DBQuery,
+        serverSocket :: Maybe Socket,
         serverConfig :: Maybe Conf
     }
 
 
-newServerInfo :: Chan CoreMessage -> Chan DBQuery -> Maybe Conf -> ServerInfo
+newServerInfo :: Chan CoreMessage -> Chan DBQuery -> Maybe Socket -> Maybe Conf -> ServerInfo
 newServerInfo =
     ServerInfo
         True
@@ -181,7 +182,6 @@
 
 data ShutdownException =
     ShutdownException
-    | RestartException
      deriving (Show, Typeable)
 
 instance Exception ShutdownException
diff -r 878e551f0b4a -r f7a610e2ef5f gameServer/HWProtoLobbyState.hs
--- a/gameServer/HWProtoLobbyState.hs	Thu May 12 23:29:31 2011 +0200
+++ b/gameServer/HWProtoLobbyState.hs	Sun May 15 18:10:01 2011 +0400
@@ -178,9 +178,9 @@
     cl <- thisClient
     return [ClearAccountsCache | isAdministrator cl]
 
-handleCmd_lobby ["RESTART_SERVER", restartType] = do
+handleCmd_lobby ["RESTART_SERVER"] = do
     cl <- thisClient
-    return [RestartServer f | let f = restartType == "FORCE", isAdministrator cl]
+    return [RestartServer]
 
 
 handleCmd_lobby _ = return [ProtocolError "Incorrect command (state: in lobby)"]
diff -r 878e551f0b4a -r f7a610e2ef5f gameServer/NetRoutines.hs
--- a/gameServer/NetRoutines.hs	Thu May 12 23:29:31 2011 +0200
+++ b/gameServer/NetRoutines.hs	Sun May 15 18:10:01 2011 +0400
@@ -14,8 +14,6 @@
 
 acceptLoop :: Socket -> Chan CoreMessage -> IO ()
 acceptLoop servSock chan = forever $
-    Exception.handle
-        (\(_ :: Exception.IOException) -> putStrLn "exception on connect") $
         do
         (sock, sockAddr) <- Network.Socket.accept servSock
 
diff -r 878e551f0b4a -r f7a610e2ef5f gameServer/ServerCore.hs
--- a/gameServer/ServerCore.hs	Thu May 12 23:29:31 2011 +0200
+++ b/gameServer/ServerCore.hs	Sun May 15 18:10:01 2011 +0400
@@ -10,6 +10,7 @@
 import qualified Data.ByteString.Char8 as B
 import Control.DeepSeq
 import Data.Unique
+import Data.Maybe
 --------------------------------------
 import CoreTypes
 import NetRoutines
@@ -65,13 +66,13 @@
                     PingAll : [StatsAction | even tick]
 
 
-startServer :: ServerInfo -> Socket -> IO ()
-startServer si serverSocket = do
-    putStrLn $ "Listening on port " ++ show (listenPort si)
+startServer :: ServerInfo -> IO ()
+startServer si = do
+    noticeM "Core" $ "Listening on port " ++ show (listenPort si)
 
     _ <- forkIO $
         acceptLoop
-            serverSocket
+            (fromJust $ serverSocket si)
             (coreChan si)
 
     return ()
diff -r 878e551f0b4a -r f7a610e2ef5f gameServer/hedgewars-server.hs
--- a/gameServer/hedgewars-server.hs	Thu May 12 23:29:31 2011 +0200
+++ b/gameServer/hedgewars-server.hs	Sun May 15 18:10:01 2011 +0400
@@ -7,7 +7,6 @@
 import Control.Concurrent.Chan
 import qualified Control.Exception as E
 import System.Log.Logger
-import System.Process
 -----------------------------------
 import Opts
 import CoreTypes
@@ -22,9 +21,9 @@
 
 
 setupLoggers :: IO ()
-setupLoggers =
-    updateGlobalLogger "Clients"
-        (setLevel NOTICE)
+setupLoggers = do
+    updateGlobalLogger "Clients" (setLevel NOTICE)
+    updateGlobalLogger "Core" (setLevel NOTICE)
 
 
 server :: ServerInfo -> IO ()
@@ -37,13 +36,12 @@
             setSocketOption sock ReuseAddr 1
             bindSocket sock (SockAddrInet (listenPort si) iNADDR_ANY)
             listen sock maxListenQueue
-            startServer si sock
+            startServer si{serverSocket = Just sock}
         )
 
 handleRestart :: ShutdownException -> IO ()
-handleRestart ShutdownException = return ()
-handleRestart RestartException = do
-    _ <- createProcess (proc "./hedgewars-server" [])
+handleRestart ShutdownException = do
+    noticeM "Core" "Shutting down"
     return ()
 
 main :: IO ()
@@ -57,7 +55,7 @@
 
     dbQueriesChan <- newChan
     coreChan' <- newChan
-    serverInfo' <- getOpts $ newServerInfo coreChan' dbQueriesChan Nothing
+    serverInfo' <- getOpts $ newServerInfo coreChan' dbQueriesChan Nothing Nothing
 
 #if defined(OFFICIAL_SERVER)
     si <- readServerConfig serverInfo'