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:
parent
9b7f929e96
commit
7a09d74319
6 changed files with 115 additions and 54 deletions
53
Utility/DirWatcher.hs
Normal file
53
Utility/DirWatcher.hs
Normal 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
|
|
@ -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
|
|
@ -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)
|
||||
|
|
22
Utility/Types/DirWatcher.hs
Normal file
22
Utility/Types/DirWatcher.hs
Normal 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
|
||||
}
|
Loading…
Add table
Add a link
Reference in a new issue