{-# LANGUAGE Strict, CPP #-}
module Network.ServerStarter.Socket
( listenAll
) where
import qualified Data.Char as Char
import Foreign.C.Types (CInt)
import qualified Network.Socket as Socket
import qualified System.Directory as Dir
import qualified System.Environment as Env
import qualified System.Posix.Internals
import qualified Text.Read as Read
ssEnvVarName :: String
ssEnvVarName = "SERVER_STARTER_PORT"
data SSPort = SSPort Socket.Family String CInt
makeSocket :: CInt -> Socket.Family -> IO Socket.Socket
#if MIN_VERSION_network(3, 0, 0)
makeSocket fd _ = Socket.mkSocket fd
#else
makeSocket fd fam = Socket.mkSocket
fd
fam
Socket.Stream
Socket.defaultProtocol
Socket.Listening
#endif
serverPorts :: String -> [SSPort]
serverPorts cs = go cs
where
go cs = let (portFd, cs') = break (== ';') cs
left = case cs' of ';' : cs'' -> go cs''
otherwise -> []
in ssport portFd : left
ssport portFd = let (str, '=' : fd) = break (== '=') portFd
fdcint = read fd :: CInt
fam = socketFamily str
in SSPort fam str fdcint
socketFamily :: String -> Socket.Family
socketFamily str = if looksLikeHostPort str
then Socket.AF_INET
else Socket.AF_UNIX
looksLikeHostPort :: String -> Bool
looksLikeHostPort str =
let revstr = reverse str
(revPort, revHost) = break (not . Char.isDigit) revstr
in case revHost of
"" -> True
(':':']':revHost')
-> let revHost'' = init revHost'
isHostValid = and $ map (\c -> Char.isDigit c || c == ':') revHost''
paren = last revHost'
in isHostValid && paren == '['
(':':revHost')
-> and $ map (\c -> Char.isDigit c || c == '.') revHost'
otherwise -> False
listenSSPort (SSPort fam _ fd) = do
System.Posix.Internals.setNonBlockingFD fd True
makeSocket fd fam
checkUnixPort :: SSPort -> IO Bool
checkUnixPort (SSPort Socket.AF_UNIX str _) = Dir.doesPathExist str
checkUnixPort _ = return True
listenAll :: IO [Socket.Socket]
listenAll = do
ssenv <- Env.getEnv ssEnvVarName
let ssports = serverPorts ssenv
okUnixPort <- mapM checkUnixPort ssports
if and okUnixPort then return()
else error "unix domein socket not found"
mapM listenSSPort ssports