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:
parent
fcf6384389
commit
c99d6a8151
7 changed files with 23 additions and 13 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
2
Seek.hs
2
Seek.hs
|
@ -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)]
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
2
debian/changelog
vendored
|
@ -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
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue