From c99d6a8151c753284f328f7158546fea2a8092ef Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 18 Dec 2013 15:05:29 -0400 Subject: [PATCH] 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. --- Assistant/Repair.hs | 2 +- Git/Objects.hs | 2 +- Seek.hs | 2 +- Utility/DirWatcher/FSEvents.hs | 4 +++- Utility/DirWatcher/Win32Notify.hs | 2 +- Utility/Directory.hs | 22 ++++++++++++++-------- debian/changelog | 2 ++ 7 files changed, 23 insertions(+), 13 deletions(-) diff --git a/Assistant/Repair.hs b/Assistant/Repair.hs index 2567e1be44..52754a4248 100644 --- a/Assistant/Repair.hs +++ b/Assistant/Repair.hs @@ -129,7 +129,7 @@ repairStaleGitLocks r = do repairStaleLocks lockfiles return $ not $ null lockfiles where - findgitfiles = dirContentsRecursiveSkipping (== dropTrailingPathSeparator annexDir) . Git.localGitDir + findgitfiles = dirContentsRecursiveSkipping (== dropTrailingPathSeparator annexDir) True . Git.localGitDir repairStaleLocks :: [FilePath] -> Assistant () repairStaleLocks lockfiles = go =<< getsizes where diff --git a/Git/Objects.hs b/Git/Objects.hs index d9d2c67018..bb492f558d 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 b2782fc360..a4e9a2fe53 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 18c73ec57c..db6ac04344 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 74b36b4f1d..27175e1c8b 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 4918d20bef..27fbb22c65 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 6283076717..afdc51038b 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 Sun, 15 Dec 2013 13:32:49 -0400