wai-app-file-cgi 0.7.2 → 0.8.0
raw patch · 5 files changed
+29/−18 lines, 5 filesdep +date-cachedep +fast-logger
Dependencies added: date-cache, fast-logger
Files
- Network/Wai/Application/Classic/CGI.hs +13/−6
- Network/Wai/Application/Classic/Field.hs +4/−5
- Network/Wai/Application/Classic/File.hs +6/−5
- Network/Wai/Application/Classic/Types.hs +2/−0
- wai-app-file-cgi.cabal +4/−2
Network/Wai/Application/Classic/CGI.hs view
@@ -4,7 +4,7 @@ cgiApp ) where -import Control.Exception (SomeException)+import Control.Exception (SomeException, IOException, try) import Control.Exception.Lifted (catch) import Control.Monad (when) import Control.Monad.IO.Class (liftIO)@@ -24,6 +24,7 @@ import Network.Wai.Application.Classic.Types import Network.Wai.Logger.Utils import Prelude hiding (catch)+import System.Environment import System.IO import System.Process @@ -66,6 +67,8 @@ ---------------------------------------------------------------- +type TRYPATH = Either IOException String+ toCGI :: Handle -> Request -> ResourceT IO () toCGI whdl req = requestBody req $$ CB.sinkHandle whdl @@ -98,15 +101,16 @@ execProcess :: ClassicAppSpec -> CgiAppSpec -> CgiRoute -> Request -> IO (Handle, Handle, ProcessHandle) execProcess cspec spec cgii req = do let naddr = showSockAddr . remoteHost $ req- (Just whdl,Just rhdl,_,pid) <- createProcess . proSpec $ naddr+ epath <- try (getEnv "PATH") :: IO TRYPATH+ (Just whdl,Just rhdl,_,pid) <- createProcess $ proSpec naddr epath hSetEncoding rhdl latin1 hSetEncoding whdl latin1 return (rhdl, whdl, pid) where- proSpec naddr = CreateProcess {+ proSpec naddr epath = CreateProcess { cmdspec = RawCommand prog [] , cwd = Nothing- , env = Just (makeEnv req naddr scriptName pathinfo (softwareName cspec))+ , env = Just $ makeEnv req naddr scriptName pathinfo (softwareName cspec) epath , std_in = CreatePipe , std_out = CreatePipe , std_err = Inherit@@ -121,8 +125,9 @@ (fromByteString (rawPathInfo req)) (indexCgi spec) -makeEnv :: Request -> NumericAddress -> String -> String -> ByteString -> ENVVARS-makeEnv req naddr scriptName pathinfo sname = addLen . addType . addCookie $ baseEnv+makeEnv :: Request -> NumericAddress -> String -> String -> ByteString ->+ TRYPATH -> ENVVARS+makeEnv req naddr scriptName pathinfo sname epath = addPath epath . addLen . addType . addCookie $ baseEnv where baseEnv = [ ("GATEWAY_INTERFACE", gatewayInterface)@@ -140,6 +145,8 @@ addLen = addEnv "CONTENT_LENGTH" $ lookup hContentLength headers addType = addEnv "CONTENT_TYPE" $ lookup hContentType headers addCookie = addEnv "HTTP_COOKIE" $ lookup hCookie headers+ addPath (Left _) ev = ev+ addPath (Right path) ev = ("PATH", path) : ev query = BS.unpack . safeTail . rawQueryString where safeTail "" = ""
Network/Wai/Application/Classic/Field.hs view
@@ -2,7 +2,6 @@ module Network.Wai.Application.Classic.Field where -import Control.Applicative import Control.Arrow (first) import Control.Monad (mplus) import Data.ByteString (ByteString)@@ -22,7 +21,7 @@ import Network.Wai.Application.Classic.Lang import Network.Wai.Application.Classic.Types import Network.Wai.Logger.Utils-import System.Posix.Time+import System.Date.Cache ---------------------------------------------------------------- @@ -104,7 +103,7 @@ defaultMimeTypes' :: StaticHash ByteString MimeType defaultMimeTypes' = SH.fromList $ map (first (BS.pack . T.unpack)) $ Map.toList defaultMimeMap -addDate :: ResponseHeaders -> IO ResponseHeaders-addDate hdr = do- date <- formatHTTPDate . epochTimeToHTTPDate <$> epochTime+addDate :: DateCacheGetter -> ResponseHeaders -> IO ResponseHeaders+addDate zdater hdr = do+ date <- zdater return $ (hDate,date) : hdr
Network/Wai/Application/Classic/File.hs view
@@ -76,28 +76,29 @@ ishtml = isHTML spec file rfile = redirectPath spec path langs = langSuffixes req+ zdater = dater cspec noBody st = do- hdr <- liftIO . addDate $ addServer cspec []+ hdr <- liftIO . addDate zdater $ addServer cspec [] return (responseLBS st hdr "", Nothing) bodyStatus st = liftIO (getStatusInfo cspec spec langs st) >>= statusBody st statusBody st StatusNone = noBody st statusBody st (StatusByteString bd) = do- hdr <- liftIO . addDate $ addServer cspec textPlainHeader+ hdr <- liftIO . addDate zdater $ addServer cspec textPlainHeader return (responseLBS st hdr bd, Just (len bd)) where len = fromIntegral . BL.length statusBody st (StatusFile afile len) = do- hdr <- liftIO . addDate $ addServer cspec textHtmlHeader+ hdr <- liftIO . addDate zdater $ addServer cspec textHtmlHeader return (ResponseFile st hdr fl mfp, Just len) where mfp = Just (FilePart 0 len) fl = pathString afile bodyFileNoBody st hdr = do- hdr' <- liftIO . addDate $ addServer cspec hdr+ hdr' <- liftIO . addDate zdater $ addServer cspec hdr return (responseLBS st hdr' "", Nothing) bodyFile st hdr afile rng = do- hdr' <- liftIO . addDate $ addLength len $ addServer cspec hdr+ hdr' <- liftIO . addDate zdater $ addLength len $ addServer cspec hdr return (ResponseFile st hdr' fl mfp, Just len) where (len, mfp) = case rng of
Network/Wai/Application/Classic/Types.hs view
@@ -7,6 +7,7 @@ import Network.HTTP.Types import Network.Wai.Application.Classic.Path import Network.Wai.Logger+import System.Log.FastLogger ---------------------------------------------------------------- @@ -16,6 +17,7 @@ -- | A function for logging. The third argument is a body size. , logger :: ApacheLogger -- | A function to get the HTTP body of status.+ , dater :: IO ZonedDate , statusFileDir :: Path }
wai-app-file-cgi.cabal view
@@ -1,5 +1,5 @@ Name: wai-app-file-cgi-Version: 0.7.2+Version: 0.8.0 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3@@ -38,14 +38,16 @@ , case-insensitive , conduit >= 0.5 && < 0.6 , containers+ , date-cache , directory+ , fast-logger >= 0.3 , filepath , http-conduit , http-date , http-types >= 0.7- , mime-types , io-choice , lifted-base+ , mime-types , network , process , resourcet