fix socket file removal

This commit is contained in:
nek0 2023-12-12 11:21:25 +01:00
parent eda823bb17
commit 7339587bd1
4 changed files with 19 additions and 13 deletions

View file

@ -1,6 +1,8 @@
{-# LANGUAGE LambdaCase #-}
module Client.Communication where
import Control.Concurrent (threadDelay)
import qualified Control.Concurrent.STM as STM
import Control.Monad (void)
@ -73,9 +75,9 @@ terminateGameOnSigint = do
void $ liftIO $ installHandler
keyboardSignal
(CatchOnce $ do
void $ STM.atomically $ STM.swapTMVar serverState (clientState { clientStop = True })
currentState <- STM.atomically $ STM.readTMVar clientState
threadDelay (10 ^ 6)
sendMessage sock (ClientMessage clientId ClientQuit)
sendMessage (ClientMessage clientId ClientQuit) sock
close sock
-- Raise SIGINT again so it does not get blocked
raiseSignal keyboardSignal

View file

@ -1,5 +1,7 @@
module Client.Types where
import qualified Control.Concurrent.STM as STM
import Control.Monad.RWS
import Data.UUID
@ -28,9 +30,9 @@ data ReaderContainer = ReaderContainer
, rcClientUUID :: UUID
}
newtype StateContainer = StateContainer
data StateContainer = StateContainer
{ scWizard :: Wizard
, scClientState :: ClientState
, scClientState :: STM.TMVar ClientState
}
type Game = RWST ReaderContainer String StateContainer IO

View file

@ -26,6 +26,7 @@ import Server.Communication
import Server.Game
import Server.Map (generateArena)
import Server.Types
import Server.Util
main :: IO ()
main = do
@ -56,12 +57,13 @@ main = do
initState = StateContainer (arenaSpawners arena) [] serverState now sockList messageQueue
(finalState, finalWrite) <- execRWST
(do
terminateGameOnSigint
terminateGameOnSigint setSocketPath
runGame
)
initRead
initState
print finalWrite
removeIfExists setSocketPath
putStrLn "bye bye"
where
opts = info (options <**> helper)
( fullDesc

View file

@ -60,24 +60,24 @@ bindSocket path = do
-- | Function that installs a handler on SIGINT to terminate game
terminateGameOnSigint
:: Game ()
terminateGameOnSigint = do
:: FilePath
-> Game ()
terminateGameOnSigint path = do
sock <- asks rcMainSocket
clients <- liftIO . STM.atomically . STM.readTMVar =<< gets scClientSockets
serverState <- gets scServerState
void $ liftIO $ installHandler
keyboardSignal
sigINT
(CatchOnce $ do
putStrLn "SIGINT caught, terminating…"
void $ STM.atomically $ STM.swapTMVar serverState (ServerState False True)
disconnectClients clients
threadDelay (10 ^ 6)
(SockAddrUnix path) <- getSocketName sock
close sock
removeIfExists path
-- Raise SIGINT again so it does not get blocked
raiseSignal keyboardSignal
raiseSignal sigINT
)
Nothing
(Just emptySignalSet)
where
disconnectClients = mapM_
(\(_, clientSocket) -> do