happstack-server 6.1.5 → 6.1.6
raw patch · 2 files changed
+41/−20 lines, 2 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Happstack.Server.FileServe.BuildingBlocks: Directory :: EntryKind
+ Happstack.Server.FileServe.BuildingBlocks: File :: EntryKind
+ Happstack.Server.FileServe.BuildingBlocks: UnknownKind :: EntryKind
+ Happstack.Server.FileServe.BuildingBlocks: browseIndex :: (ServerMonad m, FilterMonad Response m, MonadIO m, MonadPlus m, ToMessage b) => (FilePath -> [FilePath] -> m b) -> (String -> FilePath -> m Response) -> (FilePath -> m String) -> [String] -> FilePath -> m Response
+ Happstack.Server.FileServe.BuildingBlocks: data EntryKind
+ Happstack.Server.FileServe.BuildingBlocks: isSafePath :: [FilePath] -> Bool
+ Happstack.Server.FileServe.BuildingBlocks: renderDirectoryContents :: MonadIO m => FilePath -> [FilePath] -> m Html
+ Happstack.Server.FileServe.BuildingBlocks: renderDirectoryContentsTable :: [(FilePath, Maybe CalendarTime, Maybe Integer, EntryKind)] -> Html
Files
happstack-server.cabal view
@@ -1,5 +1,5 @@ Name: happstack-server-Version: 6.1.5+Version: 6.1.6 Synopsis: Web related tools and services. Description: Happstack Server provides an HTTP server and a rich set of functions for routing requests, handling query parameters, generating responses, working with cookies, serving files, and more. For in-depth documentation see the Happstack Crash Course <http://happstack.com/docs/crashcourse/index.html> License: BSD3
src/Happstack/Server/FileServe/BuildingBlocks.hs view
@@ -33,9 +33,15 @@ asContentType, guessContentType, guessContentTypeM,+ -- * Directory Browsing+ EntryKind(..),+ browseIndex,+ renderDirectoryContents,+ renderDirectoryContentsTable, -- * Other blockDotFiles, defaultIxFiles,+ isSafePath, tryIndex, doIndex, doIndex',@@ -58,7 +64,7 @@ import Happstack.Server.Response (ToMessage(toResponse), ifModifiedSince, forbidden, ok, seeOther) import Happstack.Server.Types (Length(ContentLength), Request(rqPaths, rqUri), Response(SendFile), RsFlags(rsfLength), nullRsFlags, result, resultBS, setHeader) import System.Directory (doesDirectoryExist, doesFileExist, getDirectoryContents, getModificationTime)-import System.FilePath ((</>), addTrailingPathSeparator, joinPath, splitDirectories, takeExtension)+import System.FilePath ((</>), addTrailingPathSeparator, hasDrive, isPathSeparator, joinPath, splitDirectories, takeExtension, isValid) import System.IO (IOMode(ReadMode), hFileSize, hClose, openBinaryFile, withBinaryFile) import System.Locale (defaultTimeLocale, rfc822DateFormat) import System.Log.Logger (Priority(DEBUG), logM)@@ -340,25 +346,40 @@ -> (FilePath -> m Response) -> FilePath -- ^ file/directory to serve -> m Response-fileServe' serveFn mimeFn indexFn localpath = do+fileServe' serveFn mimeFn indexFn localPath = do rq <- askRq- let safepath = filter (\x->not (null x) && x /= ".." && x /= ".") $ splitDirectories $ joinPath (rqPaths rq)- fp = joinPath (localpath:safepath)- fe <- liftIO $ doesFileExist fp- de <- liftIO $ doesDirectoryExist fp- let status | de = "DIR"- | fe = "file"- | True = "NOT FOUND"- liftIO $ logM "Happstack.Server.FileServe" DEBUG ("fileServe: "++show fp++" \t"++status)- if de- then if last (rqUri rq) == '/'--- then indexFn serveFn mimeFn (ixFiles++defaultIxFiles) fp- then indexFn fp- else do let path' = addTrailingPathSeparator (rqUri rq)- seeOther path' (toResponse path')- else if fe - then serveFileUsing serveFn mimeFn fp- else mzero+ if (not $ isSafePath (rqPaths rq))+ then do liftIO $ logM "Happstack.Server.FileServe" DEBUG ("fileServe: unsafe filepath " ++ show (rqPaths rq))+ mzero+ else do let fp = joinPath (localPath : rqPaths rq)+ fe <- liftIO $ doesFileExist fp+ de <- liftIO $ doesDirectoryExist fp+ let status | de = "DIR"+ | fe = "file"+ | True = "NOT FOUND"+ liftIO $ logM "Happstack.Server.FileServe" DEBUG ("fileServe: "++show fp++" \t"++status)+ if de+ then if last (rqUri rq) == '/'+ then indexFn fp+ else do let path' = addTrailingPathSeparator (rqUri rq)+ seeOther path' (toResponse path')+ else if fe + then serveFileUsing serveFn mimeFn fp+ else mzero++isSafePath :: [FilePath] -> Bool+isSafePath [] = True+isSafePath (s:ss) =+ isValid s + && (all (not . isPathSeparator) s) + && not (hasDrive s)+ && not (isParent s)+ && isSafePath ss++-- note: could be different on other OSs+isParent :: FilePath -> Bool+isParent ".." = True+isParent _ = False -- | Serve files from a directory and its subdirectories using 'sendFile'. --