lifted out the kqueue and inotify to a generic DirWatcher interface

Kqueue code for dispatching events is not tested and probably doesn't
build.
This commit is contained in:
Joey Hess 2012-06-18 23:47:48 -04:00
parent 9b7f929e96
commit 7a09d74319
6 changed files with 115 additions and 54 deletions

53
Utility/DirWatcher.hs Normal file
View file

@ -0,0 +1,53 @@
{- generic directory watching interface
-
- Uses either inotify or kqueue to watch a directory (and subdirectories)
- for changes, and runs hooks for different sorts of events as they occur.
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
module Utility.DirWatcher where
import Utility.Types.DirWatcher
#if WITH_INOTIFY
import qualified Utility.INotify as INotify
import qualified System.INotify as INotify
import Utility.ThreadScheduler
#endif
#if WITH_KQUEUE
import qualified Utility.Kqueue as Kqueue
#endif
type Pruner = FilePath -> Bool
canWatch :: Bool
#if (WITH_INOTIFY || WITH_KQUEUE)
canWatch = True
#else
#if defined linux_HOST_OS
#warning "Building without inotify support"
#endif
canWatch = False
#endif
#if WITH_INOTIFY
watchDir :: FilePath -> Pruner -> WatchHooks -> (IO () -> IO ()) -> IO ()
watchDir dir prune hooks runstartup = INotify.withINotify $ \i -> do
runstartup $ INotify.watchDir i dir prune hooks
waitForTermination -- Let the inotify thread run.
#else
#if WITH_KQUEUE
watchDir :: FilePath -> Pruner -> WatchHooks -> (IO Kqueue.Kqueue -> IO Kqueue.Kqueue) -> IO ()
watchDir dir ignored hooks runstartup = do
kq <- runstartup $ Kqueue.initKqueue dir ignored
Kqueue.runHooks kq hooks
#else
watchDir :: FilePath -> Pruner -> WatchHooks -> (IO () -> IO ()) -> IO ()
watchDir = undefined
#endif
#endif

View file

@ -5,26 +5,17 @@
- Licensed under the GNU GPL version 3 or higher.
-}
module Utility.Inotify where
module Utility.INotify where
import Common hiding (isDirectory)
import Utility.ThreadLock
import Utility.Types.DirWatcher
import System.INotify
import qualified System.Posix.Files as Files
import System.IO.Error
import Control.Exception (throw)
type Hook a = Maybe (a -> Maybe FileStatus -> IO ())
data WatchHooks = WatchHooks
{ addHook :: Hook FilePath
, addSymlinkHook :: Hook FilePath
, delHook :: Hook FilePath
, delDirHook :: Hook FilePath
, errHook :: Hook String -- error message
}
{- Watches for changes to files in a directory, and all its subdirectories
- that are not ignored, using inotify. This function returns after
- its initial scan is complete, leaving a thread running. Callbacks are

View file

@ -15,9 +15,11 @@ module Utility.Kqueue (
changedFile,
isAdd,
isDelete,
runHooks,
) where
import Common
import Utility.Types.DirWatcher
import System.Posix.Types
import Foreign.C.Types
@ -187,3 +189,26 @@ handleChange (Kqueue h dirmap pruner) fd olddirinfo =
-- remove it from our map.
newmap <- removeSubDir dirmap (dirName olddirinfo)
return (Kqueue h newmap pruner, [])
{- Processes changes on the Kqueue, calling the hooks as appropriate.
- Never returns. -}
runHooks :: Kqueue -> WatchHooks -> IO ()
runHooks kq hooks = do
(kq', changes) <- Kqueue.waitChange kq
forM_ changes $ dispatch kq'
runHooks kq' hooks
where
-- Kqueue returns changes for both whole directories
-- being added and deleted, and individual files being
-- added and deleted.
dispatch q change status
| isAdd change = withstatus s (dispatchadd q)
| isDelete change = callhook delDirHook change
dispatchadd q change s
| Files.isSymbolicLink = callhook addSymlinkHook change
| Files.isDirectory = print $ "TODO: recursive directory add: " ++ show change
| Files.isRegularFile = callhook addHook change
| otherwise = noop
callhook h change = hooks h $ changedFile change
withstatus change a = maybe noop (a change) =<<
(catchMaybeIO (getSymbolicLinkStatus (changedFile change)

View file

@ -0,0 +1,22 @@
{- generic directory watching types
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
module Utility.Types.DirWatcher where
import Common
type Hook a = Maybe (a -> Maybe FileStatus -> IO ())
data WatchHooks = WatchHooks
{ addHook :: Hook FilePath
, addSymlinkHook :: Hook FilePath
, delHook :: Hook FilePath
, delDirHook :: Hook FilePath
, errHook :: Hook String -- error message
}