diff --git a/hpath.cabal b/hpath.cabal index c07bc6a..2084bb3 100644 --- a/hpath.cabal +++ b/hpath.cabal @@ -29,6 +29,7 @@ library 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 @@ -111,9 +112,9 @@ benchmark bench.hs 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 diff --git a/src/HPath.hs b/src/HPath.hs index 4e364f8..99e69ef 100644 --- a/src/HPath.hs +++ b/src/HPath.hs @@ -45,9 +45,6 @@ module HPath ,withAbsPath ,withRelPath ,withFnPath - -- * ByteString operations - ,fpToString - ,userStringToFP ) where diff --git a/src/HPath/IO.hs b/src/HPath/IO.hs index e4ed62d..4426725 100644 --- a/src/HPath/IO.hs +++ b/src/HPath/IO.hs @@ -182,6 +182,10 @@ import System.Posix.Files.ByteString 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 @@ -415,33 +419,27 @@ _copyFile sflags dflags from to (sendFileCopy from' to') (void $ readWriteCopy from' to') where - -- this is low-level stuff utilizing sendfile(2) for speed - sendFileCopy 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 -> sendfileFd dfd sfd EntireFile (return ()) + $ \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 source dest = - bracket (SPDT.openFd source SPI.ReadOnly sflags Nothing) - SPI.closeFd - $ \sfd -> do - fileM <- System.Posix.Files.ByteString.fileMode - <$> getFdStatus sfd - bracketeer (SPDT.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 + readWriteCopy = copyWith + (\sfd dfd -> allocaBytes (fromIntegral bufSize) + $ \buf -> write' sfd dfd buf 0) where bufSize :: CSize bufSize = 8192 @@ -781,14 +779,12 @@ newDirPerms 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 diff --git a/src/HPath/IO/Errors.hs b/src/HPath/IO/Errors.hs index 6d4cf44..865c47d 100644 --- a/src/HPath/IO/Errors.hs +++ b/src/HPath/IO/Errors.hs @@ -66,6 +66,10 @@ import Data.ByteString ( ByteString ) +import Data.ByteString.UTF8 + ( + toString + ) import Data.Data ( Data(..) @@ -114,20 +118,20 @@ data HPathIOException = FileDoesNotExist ByteString 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 diff --git a/src/System/Posix/Directory/Traversals.hs b/src/System/Posix/Directory/Traversals.hs index ef9a6f4..c72faff 100644 --- a/src/System/Posix/Directory/Traversals.hs +++ b/src/System/Posix/Directory/Traversals.hs @@ -1,5 +1,6 @@ {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} @@ -17,7 +18,7 @@ module System.Posix.Directory.Traversals ( , readDirEnt , packDirStream , unpackDirStream -, openFd +, fdOpendir , realpath ) where @@ -36,6 +37,7 @@ import System.Posix.Directory.ByteString as PosixBS 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 +56,8 @@ import Foreign.Storable -- 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 +75,8 @@ allDirectoryContents topdir = do 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 +86,8 @@ allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp: -- 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 +111,17 @@ actOnDirContents :: RawFilePath -> 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 +162,6 @@ foreign import ccall "realpath" 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 +194,53 @@ readDirEnt (unpackDirStream -> dirp) = 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) +getDirectoryContents' fd = do + dirstream <- fdOpendir fd `catchIOError` \e -> do + closeFd fd + ioError e + -- closeDirStream closes the filedescriptor + finally (_dirloop dirstream) (PosixBS.closeDirStream dirstream) -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. -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 diff --git a/src/System/Posix/FD.hs b/src/System/Posix/FD.hs new file mode 100644 index 0000000..1d9eb15 --- /dev/null +++ b/src/System/Posix/FD.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} + +{-# OPTIONS_GHC -Wall #-} + +-- |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. +module System.Posix.FD ( + openFd + , fooBar +) 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 + + +fooBar :: String -> String +fooBar = undefined diff --git a/src/System/Posix/FilePath.hs b/src/System/Posix/FilePath.hs index ec03f10..6b936c0 100644 --- a/src/System/Posix/FilePath.hs +++ b/src/System/Posix/FilePath.hs @@ -1,21 +1,10 @@ --- | --- Module : System.Posix.FilePath --- Copyright : © 2016 Julian Ospald --- License : BSD3 --- --- Maintainer : Julian Ospald --- Stability : experimental --- Portability : portable --- --- The equivalent of "System.FilePath" on raw (byte string) file paths. --- --- Not all functions of "System.FilePath" are implemented yet. Feel free to contribute! - {-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -Wall #-} - +-- | The equivalent of "System.FilePath" on raw (byte string) file paths. +-- +-- Not all functions of "System.FilePath" are implemented yet. Feel free to contribute! module System.Posix.FilePath ( -- * Separators @@ -72,16 +61,11 @@ module System.Posix.FilePath ( , 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 +78,6 @@ import Control.Arrow (second) -- >>> 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 +424,6 @@ normalise filepath = dropDots :: [ByteString] -> [ByteString] dropDots = filter (BS.singleton _period /=) - ------------------------ -- trailing path separators @@ -524,7 +506,8 @@ isValid filepath | _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 +521,13 @@ isValid filepath -- 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 +543,18 @@ isFileName filepath = -- 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 +587,26 @@ equalFilePath p1 p2 = f p1 == f p2 -- 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 +614,7 @@ userStringToFP = fromString -- 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