import Control.Concurrent
import Control.Exception
import Control.Monad
+import Data.Maybe
import Network.BSD
import Network.Socket
import Network.HTTP.Lucu.Config
= withSocketsDo $
do _ <- installHandler sigPIPE Ignore Nothing
- -- FIXME: TERRIBLE CODE. NEED MAJOR REWRITE.
- case cnfSSLConfig cnf of
- Nothing
- -> return ()
- Just scnf
- -> do case cnfServerV4Addr cnf of
- Nothing
- -> return ()
- Just v4addr
- -> do so <- listenOn AF_INET v4addr (sslServerPort scnf)
- p <- socketPort so
- -- FIXME: Don't throw away the thread
- -- ID as we can't kill it later
- -- then. [1]
- _ <- forkIO $ httpLoop p (sslContext scnf, so)
- return ()
-
- case cnfServerV6Addr cnf of
- Nothing
- -> return ()
- Just v6addr
- -> do so <- listenOn AF_INET6 v6addr (sslServerPort scnf)
- p <- socketPort so
- -- FIXME: [1]
- _ <- forkIO $ httpLoop p (sslContext scnf, so)
- return ()
-
- case cnfServerV4Addr cnf of
- Nothing
- -> return ()
- Just v4addr
- -> do so <- listenOn AF_INET v4addr (cnfServerPort cnf)
- p <- socketPort so
- -- FIXME: [1]
- _ <- forkIO $ httpLoop p so
- return ()
-
- case cnfServerV6Addr cnf of
- Nothing
- -> return ()
- Just v6addr
- -> do so <- listenOn AF_INET6 v6addr (cnfServerPort cnf)
- p <- socketPort so
- -- FIXME: [1]
- _ <- forkIO $ httpLoop p so
- return ()
+ let launchers
+ = catMaybes
+ [ do scnf <- cnfSSLConfig cnf
+ addr <- cnfServerV4Addr cnf
+ return ( do so <- listenOn AF_INET addr (sslServerPort scnf)
+ launchListener (sslContext scnf, so)
+ )
+ , do scnf <- cnfSSLConfig cnf
+ addr <- cnfServerV6Addr cnf
+ return ( do so <- listenOn AF_INET6 addr (sslServerPort scnf)
+ launchListener (sslContext scnf, so)
+ )
+ , do addr <- cnfServerV4Addr cnf
+ return ( launchListener =<< listenOn AF_INET addr (cnfServerPort cnf)
+ )
+ , do addr <- cnfServerV6Addr cnf
+ return ( launchListener =<< listenOn AF_INET6 addr (cnfServerPort cnf)
+ )
+ ]
+ sequence_ launchers
waitForever
where
+ launchListener :: SocketLike s => s -> IO ()
+ launchListener so
+ = do p <- SL.socketPort so
+ -- FIXME: Don't throw away the thread ID as we can't
+ -- kill it later then. [1]
+ _ <- forkIO $ httpLoop p so
+ return ()
+
listenOn :: Family -> HostName -> ServiceName -> IO Socket
listenOn fam host srv
= do proto <- getProtocolNumber "tcp"