diff --git a/CHANGELOG.txt b/CHANGELOG.txt index 4e64538..24099ad 100644 --- a/CHANGELOG.txt +++ b/CHANGELOG.txt @@ -1,3 +1,8 @@ +master, 2025-08-08: + Added ability to follow symlinks during recursive directory traversal via a new SymlinkBehavior option. + Moved doesDirectoryExistFast to a new System.FilePath.Glob.Internal module for better encapsulation. + Renamed the optimized doesDirectoryExist to doesDirectoryExistFast for clarity. + 0.10.2, 2021-11-10: Relaxed transformers-compat version bound. diff --git a/Glob.cabal b/Glob.cabal index 9bd967c..8be06d2 100644 --- a/Glob.cabal +++ b/Glob.cabal @@ -37,7 +37,9 @@ Library Build-Depends: semigroups >= 0.18 if os(windows) - Build-Depends: Win32 >= 2 + Build-Depends: Win32 >= 2 + else + Build-Depends: unix >= 2.7 Default-Language: Haskell98 @@ -45,12 +47,17 @@ Library System.FilePath.Glob.Primitive Other-Modules: System.FilePath.Glob.Base System.FilePath.Glob.Directory + System.FilePath.Glob.Internal System.FilePath.Glob.Match System.FilePath.Glob.Simplify + System.FilePath.Glob.Types System.FilePath.Glob.Utils + System.FilePath.Glob.Utils.Directory + System.FilePath.Glob.Utils.IO GHC-Options: -Wall + Test-Suite glob-tests type: exitcode-stdio-1.0 @@ -66,9 +73,11 @@ Test-Suite glob-tests , transformers-compat >= 0.3 , HUnit >= 1.2 , QuickCheck >= 2 + , temporary >= 1.2 , test-framework >= 0.2 , test-framework-hunit >= 0.2 , test-framework-quickcheck2 >= 0.3 + , unix >= 2.7 if impl(ghc < 8.0) Build-Depends: semigroups >= 0.18 @@ -80,10 +89,14 @@ Test-Suite glob-tests Other-Modules: System.FilePath.Glob.Base System.FilePath.Glob.Directory + System.FilePath.Glob.Internal System.FilePath.Glob.Match System.FilePath.Glob.Primitive System.FilePath.Glob.Simplify + System.FilePath.Glob.Types System.FilePath.Glob.Utils + System.FilePath.Glob.Utils.Directory + System.FilePath.Glob.Utils.IO Tests.Base Tests.Compiler Tests.Directory @@ -93,5 +106,7 @@ Test-Suite glob-tests Tests.Regression Tests.Simplifier Tests.Utils + Tests.Symlinks + Tests.Symlinks.NoSymlinksTree GHC-Options: -Wall diff --git a/System/FilePath/Glob.hs b/System/FilePath/Glob.hs index d118cc3..9e0098d 100644 --- a/System/FilePath/Glob.hs +++ b/System/FilePath/Glob.hs @@ -54,6 +54,7 @@ module System.FilePath.Glob , MatchOptions(..) , matchWith , GlobOptions(..) + , SymlinkBehavior(..) , globDirWith -- **** Predefined option sets , matchDefault, matchPosix @@ -77,3 +78,5 @@ import System.FilePath.Glob.Directory ( GlobOptions(..), globDefault ) import System.FilePath.Glob.Match (match, matchWith) import System.FilePath.Glob.Simplify (simplify) +import System.FilePath.Glob.Types ( SymlinkBehavior(..) + ) diff --git a/System/FilePath/Glob/Directory.hs b/System/FilePath/Glob/Directory.hs index e06c04d..9b2f24d 100644 --- a/System/FilePath/Glob/Directory.hs +++ b/System/FilePath/Glob/Directory.hs @@ -25,24 +25,30 @@ import System.FilePath.Glob.Base ( Pattern(..), Token(..) , compile ) import System.FilePath.Glob.Match (matchWith) -import System.FilePath.Glob.Utils ( getRecursiveContents +import System.FilePath.Glob.Utils ( getRecursiveContentsWithSymlinks , nubOrd , pathParts , partitionDL, tailDL - , catchIO ) --- |Options which can be passed to the 'globDirWith' function. + +import System.FilePath.Glob.Types (SymlinkBehavior(..)) +import System.FilePath.Glob.Utils.IO (catchIO) + +--- |Options which can be passed to the 'globDirWith' function. data GlobOptions = GlobOptions { matchOptions :: MatchOptions -- ^Options controlling how matching is performed; see 'MatchOptions'. , includeUnmatched :: Bool -- ^Whether to include unmatched files in the result. + , symlinkBehavior :: SymlinkBehavior + -- ^Whether to follow symlinked directories during traversal. + -- Note: On Windows, following symlinks is not supported and symlinked directories will not be traversed. } -- |The default set of globbing options: uses the default matching options, and -- does not include unmatched files. globDefault :: GlobOptions -globDefault = GlobOptions matchDefault False +globDefault = GlobOptions matchDefault False DoNotFollowSymlinks -- The Patterns in TypedPattern don't contain PathSeparator or AnyDirectory -- @@ -127,7 +133,7 @@ globDirWith' opts [] dir = if includeUnmatched opts then do dir' <- if null dir then getCurrentDirectory else return dir - c <- getRecursiveContents dir' + c <- getRecursiveContentsWithSymlinks (symlinkBehavior opts) dir' return ([], Just (DL.toList c)) else return ([], Nothing) @@ -215,7 +221,7 @@ matchTypedAndGo opts (AnyDir n p:ps) path absPath = case unconditionalMatch || matchWith (matchOptions opts) p' path of True | isDir -> do - contents <- getRecursiveContents absPath + contents <- getRecursiveContentsWithSymlinks (symlinkBehavior opts) absPath return $ -- foo**/ should match foo/ and nothing below it -- relies on head contents == absPath @@ -288,7 +294,7 @@ didNotMatch opts path absPath isDir = if isDir then if path `elem` [".",".."] then return DL.empty - else getRecursiveContents absPath + else getRecursiveContentsWithSymlinks (symlinkBehavior opts) absPath else return$ DL.singleton absPath else return (DL.empty, DL.empty) diff --git a/System/FilePath/Glob/Internal.hs b/System/FilePath/Glob/Internal.hs new file mode 100644 index 0000000..baa4ec0 --- /dev/null +++ b/System/FilePath/Glob/Internal.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} + +module System.FilePath.Glob.Internal + ( doesDirectoryExistFast + ) where + +#if mingw32_HOST_OS +import Data.Bits ((.&.)) +import System.Win32.Types (LPCTSTR, withTString) +import System.Win32.File (FileAttributeOrFlag, fILE_ATTRIBUTE_DIRECTORY) +#else +import Foreign.C.String (withCString) +import Foreign.Marshal.Alloc (allocaBytes) +import System.FilePath + (isDrive, dropTrailingPathSeparator, addTrailingPathSeparator) +import System.Posix.Internals (sizeof_stat, lstat, s_isdir, st_mode) +#endif + +#if mingw32_HOST_OS +foreign import stdcall unsafe "windows.h GetFileAttributesW" + c_GetFileAttributes :: LPCTSTR -> IO FileAttributeOrFlag +#endif + +-- Significantly speedier than System.Directory.doesDirectoryExistFast. +doesDirectoryExistFast :: FilePath -> IO Bool +#if mingw32_HOST_OS +-- This one allocates more memory since it has to do a UTF-16 conversion, but +-- that can't really be helped: the below version is locale-dependent. +doesDirectoryExistFast = flip withTString $ \s -> do + a <- c_GetFileAttributes s + return (a /= 0xffffffff && a.&.fILE_ATTRIBUTE_DIRECTORY /= 0) +#else +doesDirectoryExistFast s = + allocaBytes sizeof_stat $ \p -> + withCString + (if isDrive s + then addTrailingPathSeparator s + else dropTrailingPathSeparator s) + $ \c -> do + st <- lstat c p + if st == 0 + then fmap s_isdir (st_mode p) + else return False +#endif diff --git a/System/FilePath/Glob/Types.hs b/System/FilePath/Glob/Types.hs new file mode 100644 index 0000000..d0dbaf0 --- /dev/null +++ b/System/FilePath/Glob/Types.hs @@ -0,0 +1,5 @@ +module System.FilePath.Glob.Types where + +-- | How to handle symlinks to directories during globbing +data SymlinkBehavior = FollowSymlinks | DoNotFollowSymlinks + deriving (Eq, Show) diff --git a/System/FilePath/Glob/Utils.hs b/System/FilePath/Glob/Utils.hs index 6763a01..edbdac1 100644 --- a/System/FilePath/Glob/Utils.hs +++ b/System/FilePath/Glob/Utils.hs @@ -11,31 +11,69 @@ module System.FilePath.Glob.Utils , nubOrd , partitionDL, tailDL , getRecursiveContents - , catchIO + , getRecursiveContentsWithSymlinks ) where import Control.Monad (foldM) -import qualified Control.Exception as E import Data.List ((\\)) import qualified Data.DList as DL import Data.DList (DList) import qualified Data.Set as Set -import System.Directory (getDirectoryContents) +import System.Directory (getDirectoryContents, pathIsSymbolicLink) import System.FilePath ((), isPathSeparator, dropDrive) +import System.FilePath.Glob.Internal +import System.FilePath.Glob.Utils.IO (catchIO) import System.IO.Unsafe (unsafeInterleaveIO) +import System.FilePath.Glob.Utils.Directory (isDirectory) +import System.FilePath.Glob.Types (SymlinkBehavior(..)) + #if mingw32_HOST_OS import Data.Bits ((.&.)) import System.Win32.Types (LPCTSTR, withTString) import System.Win32.File (FileAttributeOrFlag, fILE_ATTRIBUTE_DIRECTORY) -#else -import Foreign.C.String (withCString) -import Foreign.Marshal.Alloc (allocaBytes) -import System.FilePath - (isDrive, dropTrailingPathSeparator, addTrailingPathSeparator) -import System.Posix.Internals (sizeof_stat, lstat, s_isdir, st_mode) #endif + +-- | Recursively list all files and directories under the given directory. +-- +-- The traversal behavior for symlinks to directories is controlled by the +-- 'SymlinkBehavior' argument: +-- +-- * 'FollowSymlinks': Symlinks to directories are followed, so the traversal +-- will recurse into them as if they were normal directories. This may result +-- in visiting the same file or directory multiple times if there are cycles. +-- +-- * 'DoNotFollowSymlinks': Symlinks to directories are not followed; the +-- traversal will include the symlink itself in the result, but will not +-- recurse into it. +-- +-- The result is a 'DList' of all files and directories (including the root), +-- in traversal order. The function is robust to IO errors (e.g., permission +-- denied), returning the directory itself if it cannot be read. +-- +-- When there are no symlinks in the directory tree, both behaviors are +-- equivalent and produce the same result. +-- +-- Note: On Windows, following symlinks is not supported and symlinked directories will not be traversed. +getRecursiveContentsWithSymlinks :: SymlinkBehavior -> FilePath -> IO (DList FilePath) +getRecursiveContentsWithSymlinks symlinkBehavior dir = + flip catchIO (\_ -> return $ DL.singleton dir) $ do + isSymDir <- pathIsSymbolicLink dir + let followSymlinks = symlinkBehavior == FollowSymlinks + if isSymDir && not followSymlinks + then return $ DL.singleton dir + else do + raw <- getDirectoryContents dir + let entries = map (dir ) (raw \\ [".",".."]) + entryInfos <- mapM (\e -> do + isDir <- isDirectory followSymlinks e + return (e, isDir)) entries + let (dirs,files) = ([e | (e,True) <- entryInfos], [e | (e,False) <- entryInfos]) + subs <- unsafeInterleaveIO . mapM (getRecursiveContentsWithSymlinks symlinkBehavior) $ dirs + return $ DL.cons dir (DL.fromList files `DL.append` DL.concat subs) + + inRange :: Ord a => (a,a) -> a -> Bool inRange (a,b) c = c >= a && c <= b @@ -104,28 +142,6 @@ pathParts p = p : let d = dropDrive p then xs : f xs else f xs --- Significantly speedier than System.Directory.doesDirectoryExist. -doesDirectoryExist :: FilePath -> IO Bool -#if mingw32_HOST_OS --- This one allocates more memory since it has to do a UTF-16 conversion, but --- that can't really be helped: the below version is locale-dependent. -doesDirectoryExist = flip withTString $ \s -> do - a <- c_GetFileAttributes s - return (a /= 0xffffffff && a.&.fILE_ATTRIBUTE_DIRECTORY /= 0) -#else -doesDirectoryExist s = - allocaBytes sizeof_stat $ \p -> - withCString - (if isDrive s - then addTrailingPathSeparator s - else dropTrailingPathSeparator s) - $ \c -> do - st <- lstat c p - if st == 0 - then fmap s_isdir (st_mode p) - else return False -#endif - #if mingw32_HOST_OS #if defined(i386_HOST_ARCH) foreign import stdcall unsafe "windows.h GetFileAttributesW" c_GetFileAttributes :: LPCTSTR -> IO FileAttributeOrFlag @@ -136,14 +152,19 @@ foreign import ccall unsafe "windows.h GetFileAttributesW" c_GetFileAttributes : #endif #endif +-- | Recursively list all files and directories, not following symlinks (legacy behavior). getRecursiveContents :: FilePath -> IO (DList FilePath) -getRecursiveContents dir = +getRecursiveContents = getRecursiveContentsWithoutSymlinks + + +getRecursiveContentsWithoutSymlinks :: FilePath -> IO (DList FilePath) +getRecursiveContentsWithoutSymlinks dir = flip catchIO (\_ -> return $ DL.singleton dir) $ do raw <- getDirectoryContents dir let entries = map (dir ) (raw \\ [".",".."]) - (dirs,files) <- partitionM doesDirectoryExist entries + (dirs,files) <- partitionM doesDirectoryExistFast entries subs <- unsafeInterleaveIO . mapM getRecursiveContents $ dirs @@ -181,5 +202,3 @@ nubOrd = go Set.empty then go set xs else x : go (Set.insert x set) xs -catchIO :: IO a -> (E.IOException -> IO a) -> IO a -catchIO = E.catch diff --git a/System/FilePath/Glob/Utils/Directory.hs b/System/FilePath/Glob/Utils/Directory.hs new file mode 100644 index 0000000..092dfb9 --- /dev/null +++ b/System/FilePath/Glob/Utils/Directory.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE CPP #-} + +module System.FilePath.Glob.Utils.Directory (isDirectory) where + +-- | Utilities for directory and symlink handling in globbing. + +import System.Directory (doesDirectoryExist) +#if !mingw32_HOST_OS +import System.Directory (pathIsSymbolicLink) +import System.FilePath.Glob.Utils.IO (catchIO) +import qualified System.Posix.Files as Posix +#endif + +-- | Check if a path is a directory, optionally following symlinks. + +isDirectory :: Bool -> FilePath -> IO Bool +#if mingw32_HOST_OS +isDirectory _ = doesDirectoryExist +#else +isDirectory followSymlinks path = do + isSym <- pathIsSymbolicLink path + if isSym + then if followSymlinks + then do + statusResult <- (Just <$> Posix.getFileStatus path) `catchIO` (\_ -> return Nothing) + case statusResult of + Just status -> return (Posix.isDirectory status) + Nothing -> return False + else return False + else doesDirectoryExist path +#endif diff --git a/System/FilePath/Glob/Utils/IO.hs b/System/FilePath/Glob/Utils/IO.hs new file mode 100644 index 0000000..c632cec --- /dev/null +++ b/System/FilePath/Glob/Utils/IO.hs @@ -0,0 +1,7 @@ +-- | Minimal IO utility functions to avoid module cycles. +module System.FilePath.Glob.Utils.IO (catchIO) where + +import qualified Control.Exception as E + +catchIO :: IO a -> (IOError -> IO a) -> IO a +catchIO = E.catch diff --git a/tests/Main.hs b/tests/Main.hs index 8d10b90..891991c 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -13,6 +13,7 @@ import qualified Tests.Optimizer as Optimizer import qualified Tests.Regression as Regression import qualified Tests.Simplifier as Simplifier import qualified Tests.Utils as Utils +import qualified Tests.Symlinks as Symlinks main :: IO () main = do @@ -33,4 +34,5 @@ tests = , Simplifier.tests , Instances.tests , Directory.tests + , Symlinks.tests ] diff --git a/tests/Tests/Directory.hs b/tests/Tests/Directory.hs index 103ce13..709a54e 100644 --- a/tests/Tests/Directory.hs +++ b/tests/Tests/Directory.hs @@ -16,6 +16,7 @@ import qualified Data.DList as DList import System.FilePath.Glob.Base import System.FilePath.Glob.Directory +import System.FilePath.Glob.Types (SymlinkBehavior(..)) import System.FilePath.Glob.Primitive import System.FilePath.Glob.Utils import Tests.Base (Path (Path), PString, unPS) @@ -39,16 +40,18 @@ caseIncludeUnmatched = do everything <- fmap Path <$> getRecursiveContentsDir "System" let expectedMatches :: [[Path]] expectedMatches = - [ [ "System/FilePath/Glob/Directory.hs" ] + [ [ "System/FilePath/Glob/Directory.hs" + , "System/FilePath/Glob/Utils/Directory.hs" + ] , [ "System/FilePath/Glob/Match.hs" , "System/FilePath/Glob/Utils.hs" ] ] let everythingElse = everything \\ concat expectedMatches - result <- globDirWith (GlobOptions matchDefault True) - (map compile pats) - "System" + result <- globDirWith (GlobOptions matchDefault True DoNotFollowSymlinks) + (map compile pats) + "System" mapM_ (uncurry assertEqualUnordered) (zip expectedMatches (fmap Path <$> fst result)) case snd result of @@ -60,7 +63,9 @@ caseOnlyMatched = do let pats = ["**/D*.hs", "**/[MU]*.hs"] let expectedMatches :: [[Path]] expectedMatches = - [ [ "System/FilePath/Glob/Directory.hs" ] + [ [ "System/FilePath/Glob/Directory.hs" + , "System/FilePath/Glob/Utils/Directory.hs" + ] , [ "System/FilePath/Glob/Match.hs" , "System/FilePath/Glob/Utils.hs" ] @@ -101,6 +106,13 @@ getRecursiveContentsDir :: FilePath -> IO [FilePath] getRecursiveContentsDir root = fmap (filter (/= root) . DList.toList) (getRecursiveContents root) +-- Like 'getRecursiveContentsWithSymlinks', except this function removes the root directory +-- from the returned list, so that it should match the union of matched and unmatched files +-- returned from 'globDirWith', where the same directory was given as the directory argument. +getRecursiveContentsDirWithSymlinks :: SymlinkBehavior -> FilePath -> IO [FilePath] +getRecursiveContentsDirWithSymlinks theSymlinkBehavior root = + fmap (filter (/= root) . DList.toList) (getRecursiveContentsWithSymlinks theSymlinkBehavior root) + -- These two patterns should always be equal prop_commonDirectory' :: String -> (Pattern, Pattern) prop_commonDirectory' str = diff --git a/tests/Tests/Symlinks.hs b/tests/Tests/Symlinks.hs new file mode 100644 index 0000000..9d36db7 --- /dev/null +++ b/tests/Tests/Symlinks.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE OverloadedStrings #-} +module Tests.Symlinks (tests) where + +import Data.List (sort) +import System.Directory +import System.FilePath +import System.FilePath.Glob.Base +import System.FilePath.Glob.Directory +import System.FilePath.Glob.Types (SymlinkBehavior(..)) +import System.FilePath.Glob.Utils (getRecursiveContents, getRecursiveContentsWithSymlinks) +import System.IO.Temp (withTempDirectory) +import System.Info (os) +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.HUnit.Base hiding (Test) +import Tests.Symlinks.NoSymlinksTree (withNoSymlinksTree) + +import qualified Data.DList as DL + +-- Helper to create a temp directory with a real dir and a symlink to it +withSymlinkedDir :: (FilePath -> FilePath -> IO a) -> IO a +withSymlinkedDir action = + if os == "mingw32" + then error "Symlink tests are skipped on Windows." + else withTempDirectory "." "glob-symlink-test" $ \tmp -> do + putStrLn $ "[test debug] tmp: " ++ tmp + let realDir = tmp "real" + let linkDir = tmp "link" + createDirectory realDir + writeFile (realDir "foo.txt") "foo" + let relTarget = makeDirectoryRelative (takeDirectory linkDir) realDir + createDirectoryLink relTarget linkDir + action realDir linkDir + where + makeDirectoryRelative base target = + let baseParts = splitDirectories base + targetParts = splitDirectories target + common = length $ takeWhile (uncurry (==)) $ zip baseParts targetParts + up = replicate (length baseParts - common) ".." + down = drop common targetParts + in joinPath (up ++ down) + +-- Test that globDirWith finds files in symlinked directories when followSymlinks is True +caseFollowSymlinks :: Assertion +caseFollowSymlinks = + if os == "mingw32" + then putStrLn "[skip] Symlink test skipped on Windows." >> assertBool "Symlink test skipped on Windows" True + else withSymlinkedDir $ \realDir linkDir -> do + let parent = takeDirectory realDir + entries <- listDirectory parent + mapM_ (\e -> pathIsSymbolicLink (parent e)) entries -- just to force evaluation, no output + let pat = compile "**/foo.txt" + resNoFollow <- globDirWith (GlobOptions matchDefault False DoNotFollowSymlinks) [pat] parent + resFollow <- globDirWith (GlobOptions matchDefault False FollowSymlinks) [pat] parent + let foundNoFollow = concat (fst resNoFollow) + foundFollow = concat (fst resFollow) + -- Should only find the real file if not following symlinks + assertBool "Should not find file via symlink if not following symlinks" $ (linkDir "foo.txt") `notElem` foundNoFollow + -- Should find both real and symlinked file if following symlinks + assertBool "Should find file via symlink if following symlinks" $ (linkDir "foo.txt") `elem` foundFollow + +-- Test that getRecursiveContentsWithSymlinks and getRecursiveContents return the same results when there are no symlinks +caseNoSymlinksEquivalence :: Assertion +caseNoSymlinksEquivalence = withNoSymlinksTree $ \root -> do + let norm = map (drop (length root + 1)) . DL.toList + resNoSymlinks <- getRecursiveContents root + resWithSymlinks <- getRecursiveContentsWithSymlinks FollowSymlinks root + let normNoSymlinks = norm resNoSymlinks + normWithSymlinks = norm resWithSymlinks + assertEqual "Results should be identical when no symlinks are present" (sort normNoSymlinks) (sort normWithSymlinks) + +-- Test that getRecursiveContentsWithSymlinks DoNotFollowSymlinks and FollowSymlinks return the same results when there are no symlinks +caseNoSymlinksEquivalenceBothBehaviors :: Assertion +caseNoSymlinksEquivalenceBothBehaviors = withNoSymlinksTree $ \root -> do + let norm = map (drop (length root + 1)) . DL.toList + resNoFollow <- getRecursiveContentsWithSymlinks DoNotFollowSymlinks root + resFollow <- getRecursiveContentsWithSymlinks FollowSymlinks root + let normNoFollow = norm resNoFollow + normFollow = norm resFollow + assertEqual "Results should be identical for both symlink behaviors when no symlinks are present" (sort normNoFollow) (sort normFollow) + +tests :: Test +tests = testGroup "Symlinks" + [ testCase "followSymlinks option" caseFollowSymlinks + , testCase "getRecursiveContentsWithSymlinks == getRecursiveContents without symlinks" caseNoSymlinksEquivalence + , testCase "getRecursiveContentsWithSymlinks DoNotFollowSymlinks == FollowSymlinks without symlinks" caseNoSymlinksEquivalenceBothBehaviors + ] diff --git a/tests/Tests/Symlinks/NoSymlinksTree.hs b/tests/Tests/Symlinks/NoSymlinksTree.hs new file mode 100644 index 0000000..8a46812 --- /dev/null +++ b/tests/Tests/Symlinks/NoSymlinksTree.hs @@ -0,0 +1,23 @@ +-- | Helper to create a temp directory tree without symlinks for testing +module Tests.Symlinks.NoSymlinksTree (withNoSymlinksTree) where + +import System.IO.Temp (withTempDirectory) +import System.Directory (createDirectory) +import System.FilePath (()) +import Prelude (FilePath, IO, ($), (.), return, writeFile) + +-- | Creates a temp directory with a nested structure and no symlinks. +-- Calls the action with the root directory. +withNoSymlinksTree :: (FilePath -> IO a) -> IO a +withNoSymlinksTree action = + withTempDirectory "." "glob-nosymlink-test" $ \tmp -> do + let d1 = tmp "dir1" + let d2 = d1 "dir2" + let d3 = tmp "dir3" + createDirectory d1 + createDirectory d2 + createDirectory d3 + writeFile (d1 "a.txt") "a" + writeFile (d2 "b.txt") "b" + writeFile (d3 "c.txt") "c" + action tmp