diff --git a/Program/Mighty.hs b/Program/Mighty.hs --- a/Program/Mighty.hs +++ b/Program/Mighty.hs @@ -5,7 +5,6 @@ , module Program.Mighty.Route , module Program.Mighty.Parser -- * State - , module Program.Mighty.FileCache , module Program.Mighty.Report -- * Utilities , module Program.Mighty.ByteString @@ -17,7 +16,6 @@ import Program.Mighty.ByteString import Program.Mighty.Config -import Program.Mighty.FileCache import Program.Mighty.Network import Program.Mighty.Parser import Program.Mighty.Process diff --git a/Program/Mighty/FileCache.hs b/Program/Mighty/FileCache.hs deleted file mode 100644 --- a/Program/Mighty/FileCache.hs +++ /dev/null @@ -1,83 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} - -module Program.Mighty.FileCache ( - -- * Types - GetInfo - , RemoveInfo - -- * Starter - , fileCacheInit - ) where - -import Control.Exception -import Control.Exception.IOChoice -import Control.Reaper -import Data.ByteString (ByteString) -import Data.HashMap.Strict (HashMap) -import qualified Data.HashMap.Strict as M -import Network.HTTP.Date -import Network.Wai.Application.Classic -import System.Posix.Files - -data Entry = Negative | Positive FileInfo -type Cache = HashMap ByteString Entry -type GetInfo = Path -> IO FileInfo -type RemoveInfo = IO () -type FileCache = Reaper Cache (ByteString,Entry) - -fileInfo :: FileCache -> GetInfo -fileInfo reaper@Reaper{..} path = do - cache <- reaperRead - case M.lookup bpath cache of - Just Negative -> throwIO (userError "fileInfo") - Just (Positive x) -> return x - Nothing -> register ||> negative reaper path - where - bpath = pathByteString path - sfile = pathString path - register = do - fs <- getFileStatus sfile - let regular = not (isDirectory fs) - readable = fileMode fs `intersectFileModes` ownerReadMode /= 0 - if regular && readable then - positive reaper fs path - else - goNext - -positive :: FileCache -> FileStatus -> GetInfo -positive Reaper{..} fs path = do - reaperAdd (bpath,entry) - return info - where - info = FileInfo { - fileInfoName = path - , fileInfoSize = size fs - , fileInfoTime = time - , fileInfoDate = formatHTTPDate time - } - size = fromIntegral . fileSize - time = epochTimeToHTTPDate (modificationTime fs) - entry = Positive info - bpath = pathByteString path - -negative :: FileCache -> GetInfo -negative Reaper{..} path = do - reaperAdd (bpath,Negative) - throwIO (userError "fileInfo") - where - bpath = pathByteString path - ----------------------------------------------------------------- - -fileCacheInit :: IO GetInfo -fileCacheInit = mkReaper settings >>= return . fileInfo - where - settings = defaultReaperSettings { - reaperAction = override - , reaperDelay = 10000000 -- 10 seconds - , reaperCons = uncurry M.insert - , reaperNull = M.null - , reaperEmpty = M.empty - } - -override :: Cache -> IO (Cache -> Cache) -override _ = return $ const M.empty diff --git a/mighttpd2.cabal b/mighttpd2.cabal --- a/mighttpd2.cabal +++ b/mighttpd2.cabal @@ -1,5 +1,5 @@ Name: mighttpd2 -Version: 3.2.9 +Version: 3.2.10 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 @@ -26,7 +26,6 @@ Exposed-Modules: Program.Mighty Program.Mighty.ByteString Program.Mighty.Config - Program.Mighty.FileCache Program.Mighty.Network Program.Mighty.Parser Program.Mighty.Process @@ -56,9 +55,9 @@ , unix , unix-time , unordered-containers - , wai >= 3.0 - , wai-app-file-cgi >= 3.0.7 - , warp >= 3.0.11 + , wai >= 3.0 && < 3.1 + , wai-app-file-cgi >= 3.0.9 + , warp >= 3.1.12 && < 3.2 Executable mighty Default-Language: Haskell2010 @@ -81,13 +80,14 @@ , transformers , unix , streaming-commons - , wai >= 3.0 - , wai-app-file-cgi >= 3.0.7 + , wai >= 3.0 && < 3.1 + , wai-app-file-cgi >= 3.0.9 , wai-logger >= 2.2.2 - , warp >= 3.0.11 + , warp >= 3.1.12 && < 3.2 + if flag(tls) Build-Depends: tls - , warp-tls >= 3.0.1 + , warp-tls >= 3.1.5 && < 3.2 Other-Modules: Mighty Server WaiApp @@ -126,7 +126,7 @@ , http-client if flag(tls) Build-Depends: tls - , warp-tls >= 3.0.1 + , warp-tls >= 3.1.5 && < 3.2 Source-Repository head Type: git diff --git a/src/Server.hs b/src/Server.hs --- a/src/Server.hs +++ b/src/Server.hs @@ -65,12 +65,11 @@ ap <- initLogger FromSocket logtype zdater let lgr = apacheLogger ap remover = logRemover ap - getInfo <- fileCacheInit mgr <- getManager opt setHandlers opt rpt svc remover rdr report rpt "Mighty started" - runInUnboundThread $ mighty opt rpt svc lgr getInfo mgr rdr tlsSetting + runInUnboundThread $ mighty opt rpt svc lgr mgr rdr tlsSetting report rpt "Mighty retired" finReporter rpt remover @@ -142,10 +141,10 @@ ---------------------------------------------------------------- mighty :: Option -> Reporter -> Service - -> ApacheLogger -> GetInfo -> ConnPool -> RouteDBRef + -> ApacheLogger -> ConnPool -> RouteDBRef -> TLSSettings -> IO () -mighty opt rpt svc lgr getInfo mgr rdr _tlsSetting +mighty opt rpt svc lgr mgr rdr _tlsSetting = reportDo rpt $ case svc of HttpOnly s -> runSettingsSocket setting s app #ifdef HTTP_OVER_TLS @@ -166,6 +165,7 @@ $ setOnException (if debug then printStdout else warpHandler rpt) $ setTimeout (opt_connection_timeout opt) -- seconds $ setFdCacheDuration (opt_fd_cache_duration opt) + $ setFileInfoCacheDuration 10 $ setServerName serverName defaultSettings serverName = BS.pack $ opt_server_name opt @@ -177,7 +177,6 @@ filespec = FileAppSpec { indexFile = fromString $ opt_index_file opt , isHTML = \x -> ".html" `isSuffixOf` x || ".htm" `isSuffixOf` x - , getFileInfo = getInfo } cgispec = CgiAppSpec { indexCgi = "index.cgi"