recurse dirTree and open the directories for kqueue to watch

This commit is contained in:
Joey Hess 2012-06-18 13:01:58 -04:00
parent dc3d9d1e98
commit a39b73d118
2 changed files with 31 additions and 14 deletions

View file

@ -37,8 +37,6 @@ import System.INotify
import Utility.Kqueue
#endif
type Handler = FilePath -> Maybe FileStatus -> DaemonStatusHandle -> Annex (Maybe Change)
checkCanWatch :: Annex ()
checkCanWatch = do
#if (WITH_INOTIFY || WITH_KQUEUE)
@ -66,7 +64,7 @@ watchThread st dstatus changechan = withINotify $ \i -> do
showAction "scanning"
-- This does not return until the startup scan is done.
-- That can take some time for large trees.
watchDir i "." (ignored . takeFileName) hooks
watchDir i "." ignored hooks
runThreadState st $
modifyDaemonStatus dstatus $ \s -> s { scanComplete = True }
-- Notice any files that were deleted before inotify
@ -86,18 +84,24 @@ watchThread st dstatus changechan = withINotify $ \i -> do
}
#else
#ifdef WITH_KQUEUE
watchThread st dstatus changechan = do
print =<< waitChange [stdError, stdOutput]
watchThread st dstatus changechan = forever $ do
dirs <- scanRecursive "." ignored
changeddir <- waitChange dirs
print $ "detected a change in " ++ show changeddir
#else
watchThread = undefined
#endif /* WITH_KQUEUE */
#endif /* WITH_INOTIFY */
ignored :: FilePath -> Bool
ignored ".git" = True
ignored ".gitignore" = True
ignored ".gitattributes" = True
ignored _ = False
ignored = ig . takeFileName
where
ig ".git" = True
ig ".gitignore" = True
ig ".gitattributes" = True
ig _ = False
type Handler = FilePath -> Maybe FileStatus -> DaemonStatusHandle -> Annex (Maybe Change)
{- Runs an action handler, inside the Annex monad, and if there was a
- change, adds it to the ChangeChan.

View file

@ -7,7 +7,10 @@
{-# LANGUAGE ForeignFunctionInterface #-}
module Utility.Kqueue ( waitChange ) where
module Utility.Kqueue (
waitChange,
scanRecursive
) where
import Common
@ -16,16 +19,26 @@ import Foreign.C.Types
import Foreign.C.Error
import Foreign.Ptr
import Foreign.Marshal
import qualified Data.Map as M
type DirMap = M.Map Fd FilePath
foreign import ccall unsafe "libkqueue.h waitchange" c_waitchange
:: Ptr Fd -> IO Fd
waitChange :: [Fd] -> IO (Maybe Fd)
waitChange fds = withArray fds $ \c_fds -> do
ret <- c_waitchange c_fds
waitChange :: DirMap -> IO (Maybe FilePath)
waitChange dirmap = withArray (M.keys dirmap) $ \c_fds -> do
changed <- c_waitchange c_fds
ifM (safeErrno <$> getErrno)
( return $ Just ret
( return $ M.lookup changed dirmap
, return Nothing
)
where
safeErrno (Errno v) = v == 0
scanRecursive :: FilePath -> (FilePath -> Bool) -> IO DirMap
scanRecursive dir prune = M.fromList <$> (mapM opendir =<< dirTree dir prune)
where
opendir d = (,)
<$> openFd d ReadOnly Nothing defaultFileFlags
<*> pure d