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.

1 files changed, 14 insertions, 8 deletions

diff --git a/Utility/Directory.hs b/Utility/Directory.hs
index 4918d20be..27fbb22c6 100644
--- a/Utility/Directory.hs
+++ b/Utility/Directory.hs
@@ -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. -}