10b5f79e2d
Fix behavior when importing a tree from a directory remote when the
directory does not exist. An empty tree was imported, rather than the
import failing. Merging that tree would delete every file in the
branch, if those files had been exported to the directory before.
The problem was that dirContentsRecursive returned [] when the directory
did not exist. Better for it to throw an exception. But in commit
74f0d67aa3 back in 2012, I made it never
theow exceptions, because exceptions throw inside unsafeInterleaveIO become
untrappable when the list is being traversed.
So, changed it to list the contents of the directory before entering
unsafeInterleaveIO. So exceptions are thrown for the directory. But still
not if it's unable to list the contents of a subdirectory. That's less of a
problem, because the subdirectory does exist (or if not, it got removed
after being listed, and it's ok to not include it in the list). A
subdirectory that has permissions that don't allow listing it will have its
contents omitted from the list still.
(Might be better to have it return a type that includes indications of
errors listing contents of subdirectories?)
The rest of the changes are making callers of dirContentsRecursive
use emptyWhenDoesNotExist when they relied on the behavior of it not
throwing an exception when the directory does not exist. Note that
it's possible some callers of dirContentsRecursive that used to ignore
permissions problems listing a directory will now start throwing exceptions
on them.
The fix to the directory special remote consisted of not making its
call in listImportableContentsM use emptyWhenDoesNotExist. So it will
throw an exception as desired.
Sponsored-by: Joshua Antonishen on Patreon
97 lines
3.2 KiB
Haskell
97 lines
3.2 KiB
Haskell
{- FSEvents interface
|
|
-
|
|
- Copyright 2012 Joey Hess <id@joeyh.name>
|
|
-
|
|
- License: BSD-2-clause
|
|
-}
|
|
|
|
module Utility.DirWatcher.FSEvents (watchDir) where
|
|
|
|
import Common
|
|
import Utility.DirWatcher.Types
|
|
import qualified Utility.RawFilePath as R
|
|
|
|
import System.OSX.FSEvents
|
|
import qualified System.Posix.Files as Files
|
|
import Data.Bits ((.&.))
|
|
|
|
watchDir :: FilePath -> (FilePath -> Bool) -> Bool -> WatchHooks -> IO EventStream
|
|
watchDir dir ignored scanevents hooks = do
|
|
unlessM fileLevelEventsSupported $
|
|
giveup "Need at least OSX 10.7.0 for file-level FSEvents"
|
|
scan dir
|
|
eventStreamCreate [dir] 1.0 True True True dispatch
|
|
where
|
|
dispatch evt
|
|
| ignoredPath ignored (eventPath evt) = noop
|
|
| otherwise = do
|
|
{- More than one flag may be set, if events occurred
|
|
- close together.
|
|
-
|
|
- Order is important..
|
|
- If a file is added and then deleted, we'll see it's
|
|
- not present, and addHook won't run.
|
|
- OTOH, if a file is deleted and then re-added,
|
|
- the delHook will run first, followed by the addHook.
|
|
-}
|
|
|
|
when (hasflag eventFlagItemRemoved) $
|
|
if hasflag eventFlagItemIsDir
|
|
then runhook delDirHook Nothing
|
|
else runhook delHook Nothing
|
|
when (hasflag eventFlagItemCreated) $
|
|
maybe noop handleadd =<< getstatus (eventPath evt)
|
|
{- When a file or dir is renamed, a rename event is
|
|
- received for both its old and its new name. -}
|
|
when (hasflag eventFlagItemRenamed) $
|
|
if hasflag eventFlagItemIsDir
|
|
then ifM (doesDirectoryExist $ eventPath evt)
|
|
( scan $ eventPath evt
|
|
, runhook delDirHook Nothing
|
|
)
|
|
else maybe (runhook delHook Nothing) handleadd
|
|
=<< getstatus (eventPath evt)
|
|
{- Add hooks are run when a file is modified for
|
|
- compatibility with INotify, which calls the add
|
|
- hook when a file is closed, and so tends to call
|
|
- both add and modify for file modifications. -}
|
|
when (hasflag eventFlagItemModified && not (hasflag eventFlagItemIsDir)) $ do
|
|
ms <- getstatus $ eventPath evt
|
|
maybe noop handleadd ms
|
|
runhook modifyHook ms
|
|
where
|
|
hasflag f = eventFlags evt .&. f /= 0
|
|
runhook h s = maybe noop (\a -> a (eventPath evt) s) (h hooks)
|
|
handleadd s
|
|
| Files.isSymbolicLink s = runhook addSymlinkHook $ Just s
|
|
| Files.isRegularFile s = runhook addHook $ Just s
|
|
| otherwise = noop
|
|
|
|
scan d = unless (ignoredPath ignored d) $
|
|
-- Do not follow symlinks when scanning.
|
|
-- This mirrors the inotify startup scan behavior.
|
|
mapM_ go =<< emptyWhenDoesNotExist (dirContentsRecursiveSkipping (const False) False d)
|
|
where
|
|
go f
|
|
| ignoredPath ignored f = noop
|
|
| otherwise = do
|
|
ms <- getstatus f
|
|
case ms of
|
|
Nothing -> noop
|
|
Just s
|
|
| Files.isSymbolicLink s ->
|
|
when scanevents $
|
|
runhook addSymlinkHook ms
|
|
| Files.isRegularFile s ->
|
|
when scanevents $
|
|
runhook addHook ms
|
|
| otherwise ->
|
|
noop
|
|
where
|
|
runhook h s = maybe noop (\a -> a f s) (h hooks)
|
|
|
|
getstatus = catchMaybeIO . R.getSymbolicLinkStatus . toRawFilePath
|
|
|
|
{- Check each component of the path to see if it's ignored. -}
|
|
ignoredPath :: (FilePath -> Bool) -> FilePath -> Bool
|
|
ignoredPath ignored = any ignored . map dropTrailingPathSeparator . splitPath
|