X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;ds=sidebyside;f=Network%2FHTTP%2FLucu%2FHttpd.hs;h=9632b298193e30a24b4711519896be32b3fa72dd;hb=1e53b8533fa22640147cc4ca4ce5075c8e39b0d8;hp=b8e1845dd32e41edfb966dbc6f460ba936948b90;hpb=5b255535f2c7d2a6d4622ad164b31e63746b906e;p=Lucu.git diff --git a/Network/HTTP/Lucu/Httpd.hs b/Network/HTTP/Lucu/Httpd.hs index b8e1845..9632b29 100644 --- a/Network/HTTP/Lucu/Httpd.hs +++ b/Network/HTTP/Lucu/Httpd.hs @@ -1,6 +1,7 @@ --- | The entry point of Lucu httpd. +-- |The entry point of Lucu httpd. module Network.HTTP.Lucu.Httpd - ( runHttpd + ( FallbackHandler + , runHttpd ) where @@ -15,14 +16,15 @@ import Network.HTTP.Lucu.ResponseWriter import System.IO import System.Posix.Signals --- | This is the entry point of Lucu httpd. It listens to a socket and +-- |This is the entry point of Lucu httpd. It listens to a socket and -- waits for clients. Computation of 'runHttpd' never stops by itself -- so the only way to stop it is to raise an exception in the thread -- computing it. -- -- Note that 'runHttpd' automatically makes SIGPIPE be ignored by --- computing @installHandler sigPIPE Ignore Nothing@. This can hardly --- cause a problem but it may do. +-- computing @'System.Posix.Signals.installHandler' +-- 'System.Posix.Signals.sigPIPE' 'System.Posix.Signals.Ignore' +-- 'Prelude.Nothing'@. This can hardly cause a problem but it may do. -- -- Example: -- @@ -33,22 +35,22 @@ import System.Posix.Signals -- > main = let config = defaultConfig -- > resources = mkResTree [ ([], helloWorld) ] -- > in --- > runHttpd config resourcees +-- > runHttpd config resourcees [] -- > -- > helloWorld :: ResourceDef -- > helloWorld = ResourceDef { -- > resUsesNativeThread = False -- > , resIsGreedy = False -- > , resGet --- > = Just $ do setContentType $ "text" "plain" +-- > = Just $ do setContentType $ read "text/plain" -- > output "Hello, world!" -- > , resHead = Nothing -- > , resPost = Nothing -- > , resPut = Nothing -- > , resDelete = Nothing -- > } -runHttpd :: Config -> ResTree -> IO () -runHttpd cnf tree +runHttpd :: Config -> ResTree -> [FallbackHandler] -> IO () +runHttpd cnf tree fbs = withSocketsDo $ do installHandler sigPIPE Ignore Nothing so <- listenOn (cnfServerPort cnf) @@ -60,7 +62,7 @@ runHttpd cnf tree -- リモートのIPを逆引きするので、使へない。 = do (h, addr) <- accept' so tQueue <- newInteractionQueue - readerTID <- forkIO $ requestReader cnf tree h addr tQueue + readerTID <- forkIO $ requestReader cnf tree fbs h addr tQueue writerTID <- forkIO $ responseWriter cnf h tQueue readerTID loop so