open a socket properly

This commit is contained in:
nek0 2023-12-09 13:24:33 +01:00
parent d109583d66
commit 7a01a2a601
2 changed files with 30 additions and 10 deletions

View file

@ -2,6 +2,8 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Main where module Main where
import Control.Exception (catch, throwIO)
import Control.Monad.RWS.Strict import Control.Monad.RWS.Strict
import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Char8 as B8
@ -12,10 +14,16 @@ import Data.Time
import Data.Yaml import Data.Yaml
import Network.Socket import Network.Socket as Net
import Options.Applicative import Options.Applicative
import System.Posix.Signals
import System.Directory
import System.IO.Error
-- internal imports -- internal imports
import Library.Types import Library.Types
@ -39,15 +47,19 @@ main = do
let sockAddr = SockAddrUnix setSocketPath let sockAddr = SockAddrUnix setSocketPath
unless (isSupportedSockAddr sockAddr) unless (isSupportedSockAddr sockAddr)
(error $ "invalid socket path " <> setSocketPath) (error $ "invalid socket path " <> setSocketPath)
let hints = defaultHints removeIfExists setSocketPath
{ addrFamily = AF_UNIX sock <- socket AF_UNIX Stream 0
, addrSocketType = Stream bind sock sockAddr
, addrAddress = sockAddr touchSocket sock
} void $ installHandler
addr <- head <$> getAddrInfo (Just hints) Nothing Nothing keyboardSignal
sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) (CatchOnce $ do
bind sock (addrAddress addr) close' sock
putStrLn "Bound to socket:" removeIfExists setSocketPath
)
Nothing
Net.listen sock 1024
putStrLn "Bound and listening to socket:"
print =<< getSocketName sock print =<< getSocketName sock
putStrLn "-----------------------------------------------------------------------------------" putStrLn "-----------------------------------------------------------------------------------"
arena <- generateArena setMapRows setMapColumns setSpawnerProbability arena <- generateArena setMapRows setMapColumns setSpawnerProbability
@ -66,3 +78,9 @@ main = do
<> progDesc "Run the \"wizard-wipeout\" Server." <> progDesc "Run the \"wizard-wipeout\" Server."
<> header "wizard-wipeout - Last Mage standing" <> header "wizard-wipeout - Last Mage standing"
) )
removeIfExists :: FilePath -> IO ()
removeIfExists fileName = removeFile fileName `catch` handleExists
where handleExists e
| isDoesNotExistError e = return ()
| otherwise = throwIO e

View file

@ -51,6 +51,7 @@ executable wizard-wipeout-server
build-depends: base ^>=4.17.2.1 build-depends: base ^>=4.17.2.1
, aeson , aeson
, bytestring , bytestring
, directory
, linear , linear
, matrix , matrix
, monad-loops , monad-loops
@ -60,6 +61,7 @@ executable wizard-wipeout-server
, text , text
, time , time
, random , random
, unix
, wizard-wipeout , wizard-wipeout
, yaml , yaml
hs-source-dirs: src-server hs-source-dirs: src-server