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.

3 files changed, 18 insertions, 10 deletions

diff --git a/Utility/DirWatcher/FSEvents.hs b/Utility/DirWatcher/FSEvents.hs
index 18c73ec57..db6ac0434 100644
--- a/Utility/DirWatcher/FSEvents.hs
+++ b/Utility/DirWatcher/FSEvents.hs
@@ -67,7 +67,9 @@ watchDir dir ignored hooks = do
 			| otherwise = noop
 	
 	scan d = unless (ignoredPath ignored d) $
-		mapM_ go =<< dirContentsRecursive d
+		-- Do not follow symlinks when scanning.
+		-- This mirrors the inotify startup scan behavior.
+		mapM_ go =<< dirContentsRecursiveSkipping (const False) False d
 	  where		
 		go f
 			| ignoredPath ignored f = noop
diff --git a/Utility/DirWatcher/Win32Notify.hs b/Utility/DirWatcher/Win32Notify.hs
index 74b36b4f1..27175e1c8 100644
--- a/Utility/DirWatcher/Win32Notify.hs
+++ b/Utility/DirWatcher/Win32Notify.hs
@@ -42,7 +42,7 @@ watchDir dir ignored hooks = do
 		runhook h s = maybe noop (\a -> a (filePath evt) s) (h hooks)
 
 	scan d = unless (ignoredPath ignored d) $
-		mapM_ go =<< dirContentsRecursive d
+		mapM_ go =<< dirContentsRecursiveSkipping (const False) False d
 	  where		
 		go f
 			| ignoredPath ignored f = noop
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. -}