X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FHttpd.hs;h=1d0f2b8a5c626d3aa8175c7d07927b88fdeff1cc;hp=bab8d72ff5639362d1aee310ef7e189c5fc4bf84;hb=f504167b85561373b4c444e2d37a513e0ab504a9;hpb=201e1fc5d37d4ad6e43188c4ce86bfb87b67d6b8 diff --git a/Network/HTTP/Lucu/Httpd.hs b/Network/HTTP/Lucu/Httpd.hs index bab8d72..1d0f2b8 100644 --- a/Network/HTTP/Lucu/Httpd.hs +++ b/Network/HTTP/Lucu/Httpd.hs @@ -6,15 +6,13 @@ module Network.HTTP.Lucu.Httpd where import Control.Concurrent -import Network -import qualified Network.Socket as So +import Network hiding (accept) import Network.HTTP.Lucu.Config import Network.HTTP.Lucu.Interaction import Network.HTTP.Lucu.RequestReader import Network.HTTP.Lucu.Resource.Tree import Network.HTTP.Lucu.ResponseWriter -import qualified OpenSSL.Session as SSL -import System.IO +import Network.HTTP.Lucu.SocketLike import System.Posix.Signals -- |This is the entry point of Lucu httpd. It listens to a socket and @@ -60,36 +58,15 @@ runHttpd cnf tree fbs -> return () Just scnf -> do so <- listenOn (sslServerPort scnf) - _loopTID <- forkIO $ httpsLoop (sslContext scnf) so + _loopTID <- forkIO $ httpLoop (sslContext scnf, so) return () httpLoop =<< listenOn (cnfServerPort cnf) where - httpLoop :: Socket -> IO () + httpLoop :: SocketLike s => s -> IO () httpLoop so - = do (h, addr) <- acceptHTTP so + = do (h, addr) <- accept so tQueue <- newInteractionQueue readerTID <- forkIO $ requestReader cnf tree fbs h addr tQueue _writerTID <- forkIO $ responseWriter cnf h tQueue readerTID httpLoop so - - httpsLoop :: SSL.SSLContext -> Socket -> IO () - httpsLoop ctx so - = do (ssl, addr) <- acceptHTTPS ctx so - tQueue <- newInteractionQueue - readerTID <- forkIO $ requestReader cnf tree fbs ssl addr tQueue - _writerTID <- forkIO $ responseWriter cnf ssl tQueue readerTID - httpsLoop ctx so - - acceptHTTP :: Socket -> IO (Handle, So.SockAddr) - acceptHTTP soSelf - = do (soPeer, addr) <- So.accept soSelf - hPeer <- So.socketToHandle soPeer ReadWriteMode - return (hPeer, addr) - - acceptHTTPS :: SSL.SSLContext -> Socket -> IO (SSL.SSL, So.SockAddr) - acceptHTTPS ctx so - = do (so', addr) <- So.accept so - ssl <- SSL.connection ctx so' - SSL.accept ssl - return (ssl, addr)