diff --git a/Network/Shed/Httpd.hs b/Network/Shed/Httpd.hs --- a/Network/Shed/Httpd.hs +++ b/Network/Shed/Httpd.hs @@ -19,11 +19,13 @@ -- Handling of POST-based payloads was been written by Brandon Moore. -- initServerBind support was written by John Van Enk. +{-# LANGUAGE CPP #-} module Network.Shed.Httpd ( Server , initServer , initServerLazy , initServerBind + , initServerLazyBind , Request(..) , Response(..) , queryToArguments @@ -32,23 +34,31 @@ , contentType ) where -import qualified Network as Network import qualified Network.Socket as Socket import Network.URI (URI, parseURIReference, unEscapeString) import Network.BSD (getProtocolNumber) +#if MIN_VERSION_network(3,0,0) +#else +import Network.Socket (iNADDR_ANY) +#endif import Network.Socket ( - SockAddr(SockAddrInet), iNADDR_ANY, - bindSocket, setSocketOption, socket) + SockAddr(SockAddrInet), + setSocketOption, socket) import Control.Concurrent (forkIO) import Control.Exception (finally) -import System.IO (Handle, hPutStr, hClose, hGetLine, hGetContents) +import System.IO (Handle, hPutStr, hClose, hGetLine, hGetContents, IOMode(..)) import qualified Data.Char as Char import Numeric (showHex) +#if MIN_VERSION_network(3,0,0) +iNADDR_ANY :: Socket.HostAddress +iNADDR_ANY = Socket.tupleToHostAddress (0,0,0,0) +#endif + type Server = () -- later, we might have a handle for shutting down a server. {- | @@ -56,9 +66,9 @@ -} initServer - :: Int -- ^ The port number - -> (Request -> IO Response) -- ^ The functionality of the Server - -> IO Server -- ^ A token for the Server + :: Int -- ^ The port number + -> (Request -> IO Response) -- ^ The functionality of the Server + -> IO Server -- ^ A token for the Server initServer port = initServerMain (\body -> ([("Content-Length", show (length body))], body)) @@ -69,13 +79,30 @@ and without content-length header. This way you can ship infinitely big documents. It inserts the transfer encoding header for you. +The server binds to all interfaces -} initServerLazy - :: Int -- ^ Chunk size - -> Int -- ^ The port number - -> (Request -> IO Response) -- ^ The functionality of the Server - -> IO Server -- ^ A token for the Server + :: Int -- ^ Chunk size + -> Int -- ^ The port number + -> (Request -> IO Response) -- ^ The functionality of the Server + -> IO Server -- ^ A token for the Server initServerLazy chunkSize port = + initServerLazyBind chunkSize port iNADDR_ANY + +{- | +This server transfers documents in chunked mode +and without content-length header. +This way you can ship infinitely big documents. +It inserts the transfer encoding header for you. +The server binds to the specified address. +-} +initServerLazyBind + :: Int -- ^ Chunk size + -> Int -- ^ The port number + -> Socket.HostAddress -- ^ The host address + -> (Request -> IO Response) -- ^ The functionality of the Server + -> IO Server -- ^ A token for the Server +initServerLazyBind chunkSize port addr = initServerMain (\body -> ([("Transfer-Encoding", "chunked")], @@ -90,8 +117,9 @@ -- terminating trailer showCRLF : [])) - (SockAddrInet (fromIntegral port) iNADDR_ANY) + (SockAddrInet (fromIntegral port) addr) + showCRLF :: ShowS showCRLF = showString "\r\n" @@ -126,11 +154,12 @@ num <- getProtocolNumber "tcp" sock <- socket Socket.AF_INET Socket.Stream num setSocketOption sock Socket.ReuseAddr 1 - bindSocket sock sockAddr + Socket.bind sock sockAddr Socket.listen sock Socket.maxListenQueue loopIO - (do (h,_nm,_port) <- Network.accept sock + (do (acceptedSock,_) <- Socket.accept sock + h <- Socket.socketToHandle acceptedSock ReadWriteMode forkIO $ do ln <- hGetLine h case words ln of @@ -141,7 +170,7 @@ hClose h _ -> hClose h return () - ) `finally` Socket.sClose sock + ) `finally` Socket.close sock where loopIO m = m >> loopIO m @@ -152,7 +181,7 @@ (name@"Content-Length",':':rest) -> readHeaders h mode uri (hds ++ [(name,dropWhile Char.isSpace rest)]) (Just (read rest)) (name,':':rest) -> readHeaders h mode uri (hds ++ [(name,dropWhile Char.isSpace rest)]) clen - _ -> hClose h -- strange format + _ -> hClose h -- strange format message code = show code ++ " " ++ case lookup code longMessages of @@ -198,7 +227,7 @@ findVal' _ _ = [] data Request = Request - { reqMethod :: String + { reqMethod :: String , reqURI :: URI , reqHeaders :: [(String,String)] , reqBody :: String @@ -206,7 +235,7 @@ deriving Show data Response = Response - { resCode :: Int + { resCode :: Int , resHeaders :: [(String,String)] , resBody :: String } diff --git a/httpd-shed.cabal b/httpd-shed.cabal --- a/httpd-shed.cabal +++ b/httpd-shed.cabal @@ -1,6 +1,5 @@ Name: httpd-shed -Version: 0.4.0.3 -Cabal-Version: >= 1.2 +Version: 0.4.1.0 License: BSD3 License-File: LICENSE Author: Andy Gill, Brandon Moore, Henning Thielemann, John Van Enk. @@ -11,14 +10,14 @@ into a local web server. The user can decide how to interpret the requests, and the library is intended for implementing Ajax APIs. -Maintainer: Andy Gill +Maintainer: Ganesh Sittampalam Copyright: (c) 2009 Andy Gill Build-Type: Simple cabal-version: >= 1.6 Source-Repository head Type: git - Location: https://github.com/andygill/httpd-shed/ + Location: https://github.com/hsenag/httpd-shed/ Flag buildExamples Description: Build example executables @@ -28,13 +27,22 @@ description: Get Network.URI from the network-uri package default: True +flag network-bsd + description: Get Network.BSD from the network-bsd package + default: True + Library if flag(network-uri) build-depends: network-uri >= 2.6, network >= 2.6 else build-depends: network-uri < 2.6, network < 2.6 + if flag(network-bsd) + build-depends: network-bsd >= 2.7 && < 2.9, + network >= 2.7 + else + build-depends: network < 2.7 Build-Depends: - network >=2.3 && <2.7, + network >=2.3 && <3.1, network-uri >=2.5 && <2.7, base >= 4.0 && <5.0 Ghc-Options: -Wall