assistant: Fix OSX-specific bug that caused the startup scan to try to follow symlinks to other directories, and add their contents to the annex.

This commit is contained in:
Joey Hess 2013-12-18 15:05:29 -04:00
parent fcf6384389
commit c99d6a8151
7 changed files with 23 additions and 13 deletions

View file

@ -35,14 +35,18 @@ dirContents :: FilePath -> IO [FilePath]
dirContents d = map (d </>) . filter (not . dirCruft) <$> getDirectoryContents d
{- Gets files in a directory, and then its subdirectories, recursively,
- and lazily. If the directory does not exist, no exception is thrown,
- and lazily.
-
- Follows symlinks to other subdirectories.
-
- When the directory does not exist, no exception is thrown,
- instead, [] is returned. -}
dirContentsRecursive :: FilePath -> IO [FilePath]
dirContentsRecursive topdir = dirContentsRecursiveSkipping (const False) topdir
dirContentsRecursive topdir = dirContentsRecursiveSkipping (const False) True topdir
{- Skips directories whose basenames match the skipdir. -}
dirContentsRecursiveSkipping :: (FilePath -> Bool) -> FilePath -> IO [FilePath]
dirContentsRecursiveSkipping skipdir topdir = go [topdir]
dirContentsRecursiveSkipping :: (FilePath -> Bool) -> Bool -> FilePath -> IO [FilePath]
dirContentsRecursiveSkipping skipdir followsubdirsymlinks topdir = go [topdir]
where
go [] = return []
go (dir:dirs)
@ -56,10 +60,12 @@ dirContentsRecursiveSkipping skipdir topdir = go [topdir]
collect files dirs' (entry:entries)
| dirCruft entry = collect files dirs' entries
| otherwise = do
ifM (doesDirectoryExist entry)
( collect files (entry:dirs') entries
, collect (entry:files) dirs' entries
)
ms <- catchMaybeIO $ getFileStatus entry
case ms of
(Just s) | isDirectory s || (isSymbolicLink s && followsubdirsymlinks) ->
collect files (entry:dirs') entries
_ ->
collect (entry:files) dirs' entries
{- Moves one filename to another.
- First tries a rename, but falls back to moving across devices if needed. -}