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.

6 files changed, 22 insertions, 12 deletions

diff --git a/Git/Objects.hs b/Git/Objects.hs
index d9d2c6701..bb492f558 100644
--- a/Git/Objects.hs
+++ b/Git/Objects.hs
@@ -27,7 +27,7 @@ listPackFiles r = filter (".pack" `isSuffixOf`)
 listLooseObjectShas :: Repo -> IO [Sha]
 listLooseObjectShas r = catchDefaultIO [] $
 	mapMaybe (extractSha . concat . reverse . take 2 . reverse . splitDirectories)
-		<$> dirContentsRecursiveSkipping (== "pack") (objectsDir r)
+		<$> dirContentsRecursiveSkipping (== "pack") True (objectsDir r)
 
 looseObjectFile :: Repo -> Sha -> FilePath
 looseObjectFile r sha = objectsDir r </> prefix </> rest
diff --git a/Seek.hs b/Seek.hs
index b2782fc36..a4e9a2fe5 100644
--- a/Seek.hs
+++ b/Seek.hs
@@ -61,7 +61,7 @@ withPathContents a params = map a . concat <$> liftIO (mapM get params)
   where
 	get p = ifM (isDirectory <$> getFileStatus p)
 		( map (\f -> (f, makeRelative (parentDir p) f))
-			<$> dirContentsRecursiveSkipping (".git" `isSuffixOf`) p
+			<$> dirContentsRecursiveSkipping (".git" `isSuffixOf`) True p
 		, return [(p, takeFileName p)]
 		)
 
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. -}
diff --git a/debian/changelog b/debian/changelog
index 628307671..afdc51038 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -11,6 +11,8 @@ git-annex (5.20131214) UNRELEASED; urgency=low
   * Linux standalone build now includes its own glibc and forces the linker to
     use it, to remove dependence on the host glibc.
   * assistant: Always batch changes found in startup scan.
+  * 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.
 
  -- Joey Hess <joeyh@debian.org>  Sun, 15 Dec 2013 13:32:49 -0400