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

@ -129,7 +129,7 @@ repairStaleGitLocks r = do
repairStaleLocks lockfiles repairStaleLocks lockfiles
return $ not $ null lockfiles return $ not $ null lockfiles
where where
findgitfiles = dirContentsRecursiveSkipping (== dropTrailingPathSeparator annexDir) . Git.localGitDir findgitfiles = dirContentsRecursiveSkipping (== dropTrailingPathSeparator annexDir) True . Git.localGitDir
repairStaleLocks :: [FilePath] -> Assistant () repairStaleLocks :: [FilePath] -> Assistant ()
repairStaleLocks lockfiles = go =<< getsizes repairStaleLocks lockfiles = go =<< getsizes
where where

View file

@ -27,7 +27,7 @@ listPackFiles r = filter (".pack" `isSuffixOf`)
listLooseObjectShas :: Repo -> IO [Sha] listLooseObjectShas :: Repo -> IO [Sha]
listLooseObjectShas r = catchDefaultIO [] $ listLooseObjectShas r = catchDefaultIO [] $
mapMaybe (extractSha . concat . reverse . take 2 . reverse . splitDirectories) mapMaybe (extractSha . concat . reverse . take 2 . reverse . splitDirectories)
<$> dirContentsRecursiveSkipping (== "pack") (objectsDir r) <$> dirContentsRecursiveSkipping (== "pack") True (objectsDir r)
looseObjectFile :: Repo -> Sha -> FilePath looseObjectFile :: Repo -> Sha -> FilePath
looseObjectFile r sha = objectsDir r </> prefix </> rest looseObjectFile r sha = objectsDir r </> prefix </> rest

View file

@ -61,7 +61,7 @@ withPathContents a params = map a . concat <$> liftIO (mapM get params)
where where
get p = ifM (isDirectory <$> getFileStatus p) get p = ifM (isDirectory <$> getFileStatus p)
( map (\f -> (f, makeRelative (parentDir p) f)) ( map (\f -> (f, makeRelative (parentDir p) f))
<$> dirContentsRecursiveSkipping (".git" `isSuffixOf`) p <$> dirContentsRecursiveSkipping (".git" `isSuffixOf`) True p
, return [(p, takeFileName p)] , return [(p, takeFileName p)]
) )

View file

@ -67,7 +67,9 @@ watchDir dir ignored hooks = do
| otherwise = noop | otherwise = noop
scan d = unless (ignoredPath ignored d) $ 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 where
go f go f
| ignoredPath ignored f = noop | ignoredPath ignored f = noop

View file

@ -42,7 +42,7 @@ watchDir dir ignored hooks = do
runhook h s = maybe noop (\a -> a (filePath evt) s) (h hooks) runhook h s = maybe noop (\a -> a (filePath evt) s) (h hooks)
scan d = unless (ignoredPath ignored d) $ scan d = unless (ignoredPath ignored d) $
mapM_ go =<< dirContentsRecursive d mapM_ go =<< dirContentsRecursiveSkipping (const False) False d
where where
go f go f
| ignoredPath ignored f = noop | ignoredPath ignored f = noop

View file

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

2
debian/changelog vendored
View file

@ -11,6 +11,8 @@ git-annex (5.20131214) UNRELEASED; urgency=low
* Linux standalone build now includes its own glibc and forces the linker to * Linux standalone build now includes its own glibc and forces the linker to
use it, to remove dependence on the host glibc. use it, to remove dependence on the host glibc.
* assistant: Always batch changes found in startup scan. * 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 -- Joey Hess <joeyh@debian.org> Sun, 15 Dec 2013 13:32:49 -0400