mighttpd2 2.2.1 → 2.2.2

raw patch · 4 files changed

+70/−5 lines, 4 filesdep +hashmapdep +http-date

Dependencies added: hashmap, http-date

Files

• FileCache.hs +61/−0
• Mighty.hs +5/−2
• Types.hs +1/−1
• mighttpd2.cabal +3/−2

@@ -0,0 +1,61 @@+module FileCache where++import Control.Concurrent+import Control.Exception+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS+import Data.HashMap (Map)+import qualified Data.HashMap as M+import Data.IORef+import Network.HTTP.Date+import Network.Wai.Application.Classic+import System.IO.Unsafe+import System.Posix.Files++data Entry = Negative | Positive FileInfo+type Cache = Map ByteString Entry+type GetInfo = ByteString -> IO (Maybe FileInfo)++fileInfo :: IORef Cache -> GetInfo+fileInfo ref path = atomicModifyIORef ref (lok path)++lok :: ByteString -> Cache -> (Cache, Maybe FileInfo)+lok path cache = unsafePerformIO $ do+    let ment = M.lookup path cache+    case ment of+        Nothing -> handle handler $ do+            let sfile =  BS.unpack path+            fs <- getFileStatus sfile+            if doesExist fs then pos fs sfile else neg+        Just Negative     -> return (cache, Nothing)+        Just (Positive x) -> return (cache, Just x)+  where+    size = fromIntegral . fileSize+    mtime = epochTimeToHTTPDate . modificationTime+    doesExist = not . isDirectory+    pos fs sfile = do+        let info = FileInfo {+                fileInfoName = sfile+              , fileInfoSize = size fs+              , fileInfoTime = mtime fs+              }+            entry = Positive info+            cache' = M.insert path entry cache+        return (cache', Just info)+    neg = do+        let cache' = M.insert path Negative cache+        return (cache', Nothing)+    handler :: SomeException -> IO (Cache, Maybe FileInfo)+    handler _ = neg++initialize :: IO (GetInfo)+initialize = do+    ref <- newIORef M.empty+    forkIO (remover ref)+    return $ fileInfo ref++remover :: IORef Cache -> IO ()+remover ref = do+    threadDelay 10000000+    _ <- atomicModifyIORef ref (\_ -> (M.empty, undefined))+    remover ref

@@ -18,6 +18,7 @@ import System.IO import System.Posix import Types+import FileCache  main :: IO () main = do@@ -45,17 +46,19 @@                chan <- if debug then stdoutInit else fileInit logspec                return $ mightyLogger chan               else return (\_ _ _ -> return ())-    runSettingsSocket setting s $ fileCgiApp (spec lgr) route+    fif <- initialize+    runSettingsSocket setting s $ fileCgiApp (spec lgr fif) route   where     debug = opt_debug_mode opt     port = opt_port opt     ignore = const $ return ()     sOpen = listenOn (PortNumber . fromIntegral $ port)-    spec lgr = AppSpec {+    spec lgr fif = AppSpec {         softwareName = BS.pack $ opt_server_name opt       , indexFile = BS.pack $ opt_index_file opt       , isHTML = \x -> ".html" `BS.isSuffixOf` x || ".htm" `BS.isSuffixOf` x       , logger = lgr+      , getFileInfo = fif       }     logspec = FileLogSpec {         log_file          = opt_log_file opt

@@ -15,4 +15,4 @@ programName = "Mighttpd"  programVersion :: String-programVersion = "2.2.1"+programVersion = "2.2.2"

@@ -1,5 +1,5 @@ Name:                   mighttpd2-Version:                2.2.1+Version:                2.2.2 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3@@ -26,7 +26,7 @@                         unix, bytestring, warp, old-locale, time,                         wai-app-file-cgi, wai, transformers, http-types,                         directory, filepath,-                        haskell98+                        haskell98, http-date, hashmap   Other-Modules:	Config                         Config.Internal                         FileCGIApp@@ -35,6 +35,7 @@                         Parser                         Route                         Types+                        FileCache Executable mkindex   Main-Is:              mkindex.hs   if impl(ghc >= 6.12)