hpath 0.6.0 → 0.7.0

raw patch · 8 files changed

+230/−144 lines, 8 filesdep +simple-sendfiledep ~criteriondep ~filepathPVP ok

version bump matches the API change (PVP)

Dependencies added: simple-sendfile

Dependency ranges changed: criterion, filepath

API changes (from Hackage documentation)

Files

• CHANGELOG +8/−0
• hpath.cabal +5/−3
• src/HPath.hs +0/−3
• src/HPath/IO.hs +44/−23
• src/HPath/IO/Errors.hs +16/−12
• src/System/Posix/Directory/Traversals.hs +52/−61
• src/System/Posix/FD.hs +75/−0
• src/System/Posix/FilePath.hs +30/−42

@@ -1,3 +1,11 @@+0.7.0:+	* use 'sendfile' from 'simple-sendfile' in _copyFile and do read/write as a fallback only+	* add isFileName, hasParentDir, hiddenFile to System.Posix.FilePath+	* add our own openFd version for more control+	* small documentation improvements+	* add a getDirectoryContents' version that works on Fd+	* lift version constraints in benchmark+	* remove fpToString and userStringToFP, use Data.ByteString.UTF8 directly instead 0.6.0: 	* fixes 'throwDestinationInSource' to be more reliable. 	* removes some unused HPathIOException constructors

@@ -1,5 +1,5 @@ name:                hpath-version:             0.6.0+version:             0.7.0 synopsis:            Support for well-typed paths description:         Support for well-typed paths, utilizing ByteString under the hood. license:             GPL-2@@ -29,12 +29,14 @@                      HPath.Internal,                      System.Posix.Directory.Foreign,                      System.Posix.Directory.Traversals,+                     System.Posix.FD,                      System.Posix.FilePath   build-depends:     base >= 4.2 && <5                    , bytestring >= 0.9.2.0                    , deepseq                    , exceptions                    , hspec+                   , simple-sendfile >= 0.2.22                    , unix >= 2.5                    , unix-bytestring                    , utf8-string@@ -110,9 +112,9 @@       bytestring,       unix,       directory  >= 1.1 && < 1.3,-      filepath   >= 1.2 && < 1.4,+      filepath   >= 1.2 && < 1.5,       process    >= 1.0 && < 1.3,-      criterion  >= 0.6 && < 0.9+      criterion  >= 0.6 && < 1.2   ghc-options: -O2  source-repository head

@@ -45,9 +45,6 @@   ,withAbsPath   ,withRelPath   ,withFnPath-  -- * ByteString operations-  ,fpToString-  ,userStringToFP   )   where 

@@ -80,7 +80,6 @@ import Control.Exception   (     bracket-  , bracketOnError   , throwIO   ) import Control.Monad@@ -107,6 +106,8 @@ import Foreign.C.Error   (     eEXIST+  , eINVAL+  , eNOSYS   , eNOTEMPTY   , eXDEV   )@@ -136,6 +137,14 @@     catchIOError   , ioeGetErrorType   )+import System.Linux.Sendfile+  (+    sendfileFd+  )+import Network.Sendfile+  (+    FileRange(..)+  ) import System.Posix.ByteString   (     exclusive@@ -172,6 +181,10 @@ import qualified System.Posix.Files.ByteString as PF import qualified "unix" System.Posix.IO.ByteString as SPI import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB+import System.Posix.FD+  (+    openFd+  ) import qualified System.Posix.Directory.Traversals as SPDT import qualified System.Posix.Directory.Foreign as SPDF import qualified System.Posix.Process.ByteString as SPP@@ -341,7 +354,7 @@ --    - `SameFile` if source and destination are the same file (`HPathIOException`) --    - `AlreadyExists` if destination already exists ----- Note: calls `sendfile`+-- Note: calls `sendfile` and possibly `read`/`write` as fallback copyFile :: Path Abs  -- ^ source file          -> Path Abs  -- ^ destination file          -> IO ()@@ -358,8 +371,7 @@ -- -- Safety/reliability concerns: -----    * not atomic---    * falls back to delete-copy method with explicit checks+--    * not atomic, since it uses read/write -- -- Throws: --@@ -370,7 +382,7 @@ --    - `InvalidArgument` if source file is wrong type (directory) --    - `SameFile` if source and destination are the same file (`HPathIOException`) ----- Note: calls `sendfile`+-- Note: calls `sendfile` and possibly `read`/`write` as fallback copyFileOverwrite :: Path Abs  -- ^ source file                   -> Path Abs  -- ^ destination file                   -> IO ()@@ -398,24 +410,35 @@           -> IO () _copyFile sflags dflags from to   =-  -- TODO: add sendfile support-  void $ readWriteCopy (fromAbs from) (fromAbs to)+    -- from sendfile(2) manpage:+    --   Applications  may  wish  to  fall back to read(2)/write(2) in the case+    --   where sendfile() fails with EINVAL or ENOSYS.+    withAbsPath to $ \to' -> withAbsPath from $ \from' ->+      catchErrno [eINVAL, eNOSYS]+                 (sendFileCopy from' to')+                 (void $ readWriteCopy from' to')   where-    -- low-level copy operation utilizing read(2)/write(2)-    -- in case `sendFileCopy` fails/is unsupported-    readWriteCopy :: ByteString -> ByteString -> IO Int-    readWriteCopy source dest =-      bracket (SPDT.openFd source SPI.ReadOnly sflags Nothing)+    copyWith copyAction source dest =+      bracket (openFd source SPI.ReadOnly sflags Nothing)               SPI.closeFd               $ \sfd -> do                 fileM <- System.Posix.Files.ByteString.fileMode                          <$> getFdStatus sfd-                bracketeer (SPDT.openFd dest SPI.WriteOnly+                bracketeer (openFd dest SPI.WriteOnly                              dflags $ Just fileM)                            SPI.closeFd                            (\fd -> SPI.closeFd fd >> deleteFile to)-                            $ \dfd -> allocaBytes (fromIntegral bufSize) $ \buf ->-                                        write' sfd dfd buf 0+                           $ \dfd -> copyAction sfd dfd+    -- this is low-level stuff utilizing sendfile(2) for speed+    sendFileCopy :: ByteString -> ByteString -> IO ()+    sendFileCopy = copyWith+      (\sfd dfd -> sendfileFd dfd sfd EntireFile $ return ())+    -- low-level copy operation utilizing read(2)/write(2)+    -- in case `sendFileCopy` fails/is unsupported+    readWriteCopy :: ByteString -> ByteString -> IO Int+    readWriteCopy = copyWith+      (\sfd dfd -> allocaBytes (fromIntegral bufSize)+                     $ \buf -> write' sfd dfd buf 0)       where         bufSize :: CSize         bufSize = 8192@@ -755,14 +778,12 @@ getDirsFiles :: Path Abs        -- ^ dir to read              -> IO [Path Abs] getDirsFiles p =-  withAbsPath p $ \fp ->-    bracketOnError (SPDT.openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing)-            SPI.closeFd-            $ \fd ->-              return-                . catMaybes-                .   fmap (\x -> (</>) p <$> (parseMaybe . snd $ x))-                =<< getDirectoryContents' fd+  withAbsPath p $ \fp -> do+    fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing+    return+      . catMaybes+      .   fmap (\x -> (</>) p <$> (parseMaybe . snd $ x))+      =<< getDirectoryContents' fd   where     parseMaybe :: ByteString -> Maybe (Path Fn)     parseMaybe = parseFn

@@ -66,6 +66,10 @@   (     ByteString   )+import Data.ByteString.UTF8+  (+    toString+  ) import Data.Data   (     Data(..)@@ -114,20 +118,20 @@   instance Show HPathIOException where-  show (FileDoesNotExist fp) = "File does not exist:" ++ fpToString fp+  show (FileDoesNotExist fp) = "File does not exist:" ++ toString fp   show (DirDoesNotExist fp) = "Directory does not exist: "-                              ++ fpToString fp-  show (SameFile fp1 fp2) = fpToString fp1-                            ++ " and " ++ fpToString fp2+                              ++ toString fp+  show (SameFile fp1 fp2) = toString fp1+                            ++ " and " ++ toString fp2                             ++ " are the same file!"-  show (DestinationInSource fp1 fp2) = fpToString fp1+  show (DestinationInSource fp1 fp2) = toString fp1                                        ++ " is contained in "-                                       ++ fpToString fp2-  show (FileDoesExist fp) = "File does exist: " ++ fpToString fp-  show (DirDoesExist fp) = "Directory does exist: " ++ fpToString fp+                                       ++ toString fp2+  show (FileDoesExist fp) = "File does exist: " ++ toString fp+  show (DirDoesExist fp) = "Directory does exist: " ++ toString fp   show (InvalidOperation str) = "Invalid operation: " ++ str   show (Can'tOpenDirectory fp) = "Can't open directory: "-                                 ++ fpToString fp+                                 ++ toString fp   show (CopyFailed str) = "Copying failed: " ++ str  @@ -266,7 +270,7 @@     return True  --- |Throws a `Can'tOpenDirectory` FmIOException if the directory at the given+-- |Throws a `Can'tOpenDirectory` HPathIOException if the directory at the given -- path cannot be opened. throwCantOpenDirectory :: Path Abs -> IO () throwCantOpenDirectory fp =@@ -332,8 +336,8 @@   reactOnError :: IO a-             -> [(IOErrorType, IO a)]   -- ^ reaction on IO errors-             -> [(HPathIOException, IO a)] -- ^ reaction on FmIOException+             -> [(IOErrorType, IO a)]      -- ^ reaction on IO errors+             -> [(HPathIOException, IO a)] -- ^ reaction on HPathIOException              -> IO a reactOnError a ios fmios =   a `catches` [iohandler, fmiohandler]

@@ -1,9 +1,24 @@+-- |+-- Module      :  System.Posix.Directory.Traversals+-- Copyright   :  © 2016 Julian Ospald+-- License     :  BSD3+--+-- Maintainer  :  Julian Ospald <hasufell@posteo.de>+-- Stability   :  experimental+-- Portability :  portable+--+-- Traversal and read operations on directories.++ {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-}  {-# OPTIONS_GHC -Wall #-}++ module System.Posix.Directory.Traversals (    getDirectoryContents@@ -17,7 +32,7 @@ , readDirEnt , packDirStream , unpackDirStream-, openFd+, fdOpendir  , realpath ) where@@ -36,6 +51,7 @@ import System.Posix.Files.ByteString  import System.IO.Unsafe+import "unix" System.Posix.IO.ByteString (closeFd) import Unsafe.Coerce (unsafeCoerce) import Foreign.C.Error import Foreign.C.String@@ -54,6 +70,8 @@ -- Upon entering a directory, 'allDirectoryContents' will get all entries -- strictly.  However the returned list is lazy in that directories will only -- be accessed on demand.+--+-- Follows symbolic links for the input dir. allDirectoryContents :: RawFilePath -> IO [RawFilePath] allDirectoryContents topdir = do     namesAndTypes <- getDirectoryContents topdir@@ -71,6 +89,8 @@     return (topdir : concat paths)  -- | Get all files from a directory and its subdirectories strictly.+--+-- Follows symbolic links for the input dir. allDirectoryContents' :: RawFilePath -> IO [RawFilePath] allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp:acc)) [] -- this uses traverseDirectory because it's more efficient than forcing the@@ -80,6 +100,8 @@ -- files/subdirectories. -- -- This function allows for memory-efficient traversals.+--+-- Follows symbolic links for the input dir. traverseDirectory :: (s -> RawFilePath -> IO s) -> s -> RawFilePath -> IO s traverseDirectory act s0 topdir = toploop   where@@ -103,17 +125,17 @@                  -> IO b actOnDirContents pathRelToTop b f =   modifyIOError ((`ioeSetFileName` (BS.unpack pathRelToTop)) .-                 (`ioeSetLocation` "findBSTypRel")) $ do+                 (`ioeSetLocation` "findBSTypRel")) $     bracket       (openDirStream pathRelToTop)-      (Posix.closeDirStream)+      Posix.closeDirStream       (\dirp -> loop dirp b)  where   loop dirp b' = do     (typ,e) <- readDirEnt dirp     if (e == "")       then return b'-      else do+      else           if (e == "." || e == "..")               then loop dirp b'               else f typ (pathRelToTop </> e) b' >>= loop dirp@@ -154,9 +176,6 @@ foreign import ccall unsafe "fdopendir"   c_fdopendir :: Posix.Fd -> IO (Ptr ()) -foreign import ccall unsafe "open"-   c_open :: CString -> CInt -> Posix.CMode -> IO CInt- ---------------------------------------------------------- -- less dodgy but still lower-level @@ -189,81 +208,53 @@                     else throwErrno "readDirEnt"  +-- |Gets all directory contents (not recursively). getDirectoryContents :: RawFilePath -> IO [(DirType, RawFilePath)] getDirectoryContents path =   modifyIOError ((`ioeSetFileName` (BS.unpack path)) .-                 (`ioeSetLocation` "System.Posix.Directory.Traversals.getDirectoryContents")) $ do+                 (`ioeSetLocation` "System.Posix.Directory.Traversals.getDirectoryContents")) $     bracket       (PosixBS.openDirStream path)       PosixBS.closeDirStream-      loop- where-  loop dirp = do-     t@(_typ,e) <- readDirEnt dirp-     if BS.null e then return [] else do-       es <- loop dirp-       return (t:es)+      _dirloop  +-- |Binding to @fdopendir(3)@. fdOpendir :: Posix.Fd -> IO DirStream fdOpendir fd =     packDirStream <$> throwErrnoIfNull "fdOpendir" (c_fdopendir fd)  +-- |Like `getDirectoryContents` except for a file descriptor.+--+-- To avoid complicated error checks, the file descriptor is+-- __always__ closed, even if `fdOpendir` fails. Usually, this+-- only happens on successful `fdOpendir` and after the directory+-- stream is closed. Also see the manpage of @fdopendir(3)@ for+-- more details. getDirectoryContents' :: Posix.Fd -> IO [(DirType, RawFilePath)]-getDirectoryContents' fd =-    bracket-      (fdOpendir fd)-      PosixBS.closeDirStream-      loop- where-  loop dirp = do-     t@(_typ,e) <- readDirEnt dirp-     if BS.null e then return [] else do-       es <- loop dirp-       return (t:es)---open_  :: CString-       -> Posix.OpenMode-       -> [Flags]-       -> Maybe Posix.FileMode-       -> IO Posix.Fd-open_ str how optional_flags maybe_mode = do-    fd <- c_open str all_flags mode_w-    return (Posix.Fd fd)-  where-    all_flags  = unionFlags $ optional_flags ++ [open_mode] ++ creat---    (creat, mode_w) = case maybe_mode of-                        Nothing -> ([],0)-                        Just x  -> ([oCreat], x)--    open_mode = case how of-                   Posix.ReadOnly  -> oRdonly-                   Posix.WriteOnly -> oWronly-                   Posix.ReadWrite -> oRdwr+getDirectoryContents' fd = do+  dirstream <- fdOpendir fd `catchIOError` \e -> do+    closeFd fd+    ioError e+  -- closeDirStream closes the filedescriptor+  finally (_dirloop dirstream) (PosixBS.closeDirStream dirstream)  --- |Open and optionally create this file.  See 'System.Posix.Files'--- for information on how to use the 'FileMode' type.-openFd :: RawFilePath-       -> Posix.OpenMode-       -> [Flags]-       -> Maybe Posix.FileMode-       -> IO Posix.Fd-openFd name how optional_flags maybe_mode =-   withFilePath name $ \str ->-     throwErrnoPathIfMinus1Retry "openFd" name $-       open_ str how optional_flags maybe_mode+_dirloop :: DirStream -> IO [(DirType, RawFilePath)]+{-# INLINE _dirloop #-}+_dirloop dirp = do+   t@(_typ,e) <- readDirEnt dirp+   if BS.null e then return [] else do+     es <- _dirloop dirp+     return (t:es)   -- | return the canonicalized absolute pathname ----- like canonicalizePath, but uses realpath(3)+-- like canonicalizePath, but uses @realpath(3)@ realpath :: RawFilePath -> IO RawFilePath-realpath inp = do+realpath inp =     allocaBytes pathMax $ \tmp -> do         void $ BS.useAsCString inp $ \cstr -> throwErrnoIfNull "realpath" $ c_realpath cstr tmp         BS.packCString tmp

@@ -0,0 +1,75 @@+-- |+-- Module      :  System.Posix.FD+-- Copyright   :  © 2016 Julian Ospald+-- License     :  BSD3+--+-- Maintainer  :  Julian Ospald <hasufell@posteo.de>+-- Stability   :  experimental+-- Portability :  portable+--+-- Provides an alternative for `System.Posix.IO.ByteString.openFd`+-- which gives us more control on what status flags to pass to the+-- low-level @open(2)@ call, in contrast to the unix package.+++{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}++{-# OPTIONS_GHC -Wall #-}+++module System.Posix.FD (+    openFd+) where+++import Foreign.C.String+import Foreign.C.Types+import System.Posix.Directory.Foreign+import qualified System.Posix as Posix+import System.Posix.ByteString.FilePath+++foreign import ccall unsafe "open"+   c_open :: CString -> CInt -> Posix.CMode -> IO CInt+++open_  :: CString+       -> Posix.OpenMode+       -> [Flags]+       -> Maybe Posix.FileMode+       -> IO Posix.Fd+open_ str how optional_flags maybe_mode = do+    fd <- c_open str all_flags mode_w+    return (Posix.Fd fd)+  where+    all_flags  = unionFlags $ optional_flags ++ [open_mode] ++ creat+++    (creat, mode_w) = case maybe_mode of+                        Nothing -> ([],0)+                        Just x  -> ([oCreat], x)++    open_mode = case how of+                   Posix.ReadOnly  -> oRdonly+                   Posix.WriteOnly -> oWronly+                   Posix.ReadWrite -> oRdwr+++-- |Open and optionally create this file. See 'System.Posix.Files'+-- for information on how to use the 'FileMode' type.+--+-- Note that passing `Just x` as the 4th argument triggers the+-- `oCreat` status flag, which must be set when you pass in `oExcl`+-- to the status flags. Also see the manpage for @open(2)@.+openFd :: RawFilePath+       -> Posix.OpenMode+       -> [Flags]               -- ^ status flags of @open(2)@+       -> Maybe Posix.FileMode  -- ^ Just x => creates the file with the given modes, Nothing => the file must exist.+       -> IO Posix.Fd+openFd name how optional_flags maybe_mode =+   withFilePath name $ \str ->+     throwErrnoPathIfMinus1Retry "openFd" name $+       open_ str how optional_flags maybe_mode+

@@ -11,6 +11,7 @@ -- -- Not all functions of "System.FilePath" are implemented yet. Feel free to contribute! + {-# LANGUAGE TupleSections #-}  {-# OPTIONS_GHC -Wall #-}@@ -72,16 +73,11 @@ , equalFilePath , hiddenFile -  -- * Type conversion-, fpToString-, userStringToFP- , module System.Posix.ByteString.FilePath ) where  import           Data.ByteString (ByteString) import qualified Data.ByteString as BS-import           Data.ByteString.UTF8 (fromString, toString) import           System.Posix.ByteString.FilePath  import           Data.Maybe (isJust)@@ -94,7 +90,6 @@ -- >>> import Test.QuickCheck -- >>> import Control.Applicative -- >>> import qualified Data.ByteString as BS--- >>> import Data.ByteString (ByteString) -- >>> instance Arbitrary ByteString where arbitrary = BS.pack <$> arbitrary -- >>> instance CoArbitrary ByteString where coarbitrary = coarbitrary . BS.unpack --@@ -441,7 +436,6 @@     dropDots :: [ByteString] -> [ByteString]     dropDots = filter (BS.singleton _period /=) - ------------------------ -- trailing path separators @@ -524,7 +518,8 @@   | _nul `BS.elem` filepath = False   | otherwise               = True --- | Is the given filename a valid filename?+-- | Is the given path a valid filename? This includes+-- "." and "..". -- -- >>> isFileName "lal" -- True@@ -538,13 +533,13 @@ -- False -- >>> isFileName "/random_ path:*" -- False-isFileName :: ByteString -> Bool+isFileName :: RawFilePath -> Bool isFileName filepath =   not (BS.singleton pathSeparator `BS.isInfixOf` filepath) &&   not (BS.null filepath) &&   not (_nul `BS.elem` filepath) --- | Helper function: check if the filepath has any parent directories in it.+-- | Check if the filepath has any parent directories in it. -- -- >>> hasParentDir "/.." -- True@@ -560,19 +555,18 @@ -- False -- >>> hasParentDir ".." -- False-hasParentDir :: ByteString -> Bool+hasParentDir :: RawFilePath -> Bool hasParentDir filepath =-  ((pathSeparator `BS.cons` pathDoubleDot)-    `BS.isSuffixOf` filepath-  ) ||-  ((BS.singleton pathSeparator-     `BS.append` pathDoubleDot-     `BS.append` BS.singleton pathSeparator-   ) `BS.isInfixOf`  filepath-  ) ||-  ((pathDoubleDot `BS.append` BS.singleton pathSeparator-   ) `BS.isPrefixOf` filepath-  )+    (pathSeparator `BS.cons` pathDoubleDot)+     `BS.isSuffixOf` filepath+   ||+    (BS.singleton pathSeparator+        `BS.append` pathDoubleDot+        `BS.append` BS.singleton pathSeparator)+     `BS.isInfixOf`  filepath+   ||+    (pathDoubleDot `BS.append` BS.singleton pathSeparator)+      `BS.isPrefixOf` filepath   where     pathDoubleDot = BS.pack [_period, _period] @@ -605,32 +599,26 @@ -- True -- >>> hiddenFile "..foo.bar" -- True+-- >>> hiddenFile "some/path/.bar"+-- True -- >>> hiddenFile "..." -- True--- >>> hiddenFile "dod"--- False -- >>> hiddenFile "dod.bar" -- False+-- >>> hiddenFile "."+-- False+-- >>> hiddenFile ".."+-- False+-- >>> hiddenFile ""+-- False hiddenFile :: RawFilePath -> Bool hiddenFile fp-  | fp == BS.pack [_period, _period] = False-  | fp == BS.pack [_period]          = False+  | fn == BS.pack [_period, _period] = False+  | fn == BS.pack [_period]          = False   | otherwise                        = BS.pack [extSeparator]-                                         `BS.isPrefixOf` fp----------------------------- conversion---- |Uses UTF-8 decoding to convert the bytestring into a String.-fpToString :: ByteString -> String-fpToString = toString----- |Uses UTF-8 encoding to convert a user provided String into--- a ByteString, which represents a filepath.-userStringToFP :: String -> ByteString-userStringToFP = fromString-+                                         `BS.isPrefixOf` fn+  where+    fn = takeFileName fp  ------------------------ -- internal stuff@@ -638,7 +626,7 @@ -- Just split the input FileName without adding/normalizing or changing -- anything. splitFileNameRaw :: RawFilePath -> (RawFilePath, RawFilePath)-splitFileNameRaw x = BS.breakEnd isPathSeparator x+splitFileNameRaw = BS.breakEnd isPathSeparator  -- | Combine two paths, assuming rhs is NOT absolute. combineRaw :: RawFilePath -> RawFilePath -> RawFilePath