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
|
@ -13,7 +13,8 @@ import Common.Annex
|
||||||
import Assistant.ThreadedMonad
|
import Assistant.ThreadedMonad
|
||||||
import Assistant.DaemonStatus
|
import Assistant.DaemonStatus
|
||||||
import Assistant.Committer
|
import Assistant.Committer
|
||||||
import Utility.ThreadScheduler
|
import Utility.DirWatcher
|
||||||
|
import Utility.Types.DirWatcher
|
||||||
import qualified Annex.Queue
|
import qualified Annex.Queue
|
||||||
import qualified Git.Command
|
import qualified Git.Command
|
||||||
import qualified Git.UpdateIndex
|
import qualified Git.UpdateIndex
|
||||||
|
@ -29,25 +30,12 @@ import Control.Concurrent.STM
|
||||||
import Data.Bits.Utils
|
import Data.Bits.Utils
|
||||||
import qualified Data.ByteString.Lazy as L
|
import qualified Data.ByteString.Lazy as L
|
||||||
|
|
||||||
#ifdef WITH_INOTIFY
|
|
||||||
import Utility.Inotify
|
|
||||||
import System.INotify
|
|
||||||
#endif
|
|
||||||
#ifdef WITH_KQUEUE
|
|
||||||
import qualified Utility.Kqueue as Kqueue
|
|
||||||
#endif
|
|
||||||
|
|
||||||
checkCanWatch :: Annex ()
|
checkCanWatch :: Annex ()
|
||||||
checkCanWatch = do
|
checkCanWatch
|
||||||
#if (WITH_INOTIFY || WITH_KQUEUE)
|
| canWatch =
|
||||||
unlessM (liftIO (inPath "lsof") <||> Annex.getState Annex.force) $
|
unlessM (liftIO (inPath "lsof") <||> Annex.getState Annex.force) $
|
||||||
needLsof
|
needLsof
|
||||||
#else
|
| otherwise = error "watch mode is not available on this system"
|
||||||
#if defined linux_HOST_OS
|
|
||||||
#warning "Building without inotify support; watch mode will be disabled."
|
|
||||||
#endif
|
|
||||||
error "watch mode is not available on this system"
|
|
||||||
#endif
|
|
||||||
|
|
||||||
needLsof :: Annex ()
|
needLsof :: Annex ()
|
||||||
needLsof = error $ unlines
|
needLsof = error $ unlines
|
||||||
|
@ -58,13 +46,9 @@ needLsof = error $ unlines
|
||||||
]
|
]
|
||||||
|
|
||||||
watchThread :: ThreadState -> DaemonStatusHandle -> ChangeChan -> IO ()
|
watchThread :: ThreadState -> DaemonStatusHandle -> ChangeChan -> IO ()
|
||||||
#ifdef WITH_INOTIFY
|
watchThread st dstatus changechan = watchDir "." ignored hooks startup
|
||||||
watchThread st dstatus changechan = withINotify $ \i -> do
|
|
||||||
statupScan st dstatus $
|
|
||||||
watchDir i "." ignored hooks
|
|
||||||
-- Let the inotify thread run.
|
|
||||||
waitForTermination
|
|
||||||
where
|
where
|
||||||
|
startup = statupScan st dstatus
|
||||||
hook a = Just $ runHandler st dstatus changechan a
|
hook a = Just $ runHandler st dstatus changechan a
|
||||||
hooks = WatchHooks
|
hooks = WatchHooks
|
||||||
{ addHook = hook onAdd
|
{ addHook = hook onAdd
|
||||||
|
@ -73,21 +57,6 @@ watchThread st dstatus changechan = withINotify $ \i -> do
|
||||||
, delDirHook = hook onDelDir
|
, delDirHook = hook onDelDir
|
||||||
, errHook = hook onErr
|
, errHook = hook onErr
|
||||||
}
|
}
|
||||||
#else
|
|
||||||
#ifdef WITH_KQUEUE
|
|
||||||
watchThread st dstatus changechan = do
|
|
||||||
kq <- statupScan st dstatus $
|
|
||||||
Kqueue.initKqueue "." ignored
|
|
||||||
go kq
|
|
||||||
where
|
|
||||||
go kq = do
|
|
||||||
(kq', changes) <- Kqueue.waitChange kq
|
|
||||||
print $ "detected a change in " ++ show changes
|
|
||||||
go kq'
|
|
||||||
#else
|
|
||||||
watchThread = undefined
|
|
||||||
#endif /* WITH_KQUEUE */
|
|
||||||
#endif /* WITH_INOTIFY */
|
|
||||||
|
|
||||||
{- Initial scartup scan. The action should return once the scan is complete. -}
|
{- Initial scartup scan. The action should return once the scan is complete. -}
|
||||||
statupScan :: ThreadState -> DaemonStatusHandle -> IO a -> IO a
|
statupScan :: ThreadState -> DaemonStatusHandle -> IO a -> IO a
|
||||||
|
|
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.
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Utility.Inotify where
|
module Utility.INotify where
|
||||||
|
|
||||||
import Common hiding (isDirectory)
|
import Common hiding (isDirectory)
|
||||||
import Utility.ThreadLock
|
import Utility.ThreadLock
|
||||||
|
import Utility.Types.DirWatcher
|
||||||
|
|
||||||
import System.INotify
|
import System.INotify
|
||||||
import qualified System.Posix.Files as Files
|
import qualified System.Posix.Files as Files
|
||||||
import System.IO.Error
|
import System.IO.Error
|
||||||
import Control.Exception (throw)
|
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
|
{- Watches for changes to files in a directory, and all its subdirectories
|
||||||
- that are not ignored, using inotify. This function returns after
|
- that are not ignored, using inotify. This function returns after
|
||||||
- its initial scan is complete, leaving a thread running. Callbacks are
|
- its initial scan is complete, leaving a thread running. Callbacks are
|
|
@ -15,9 +15,11 @@ module Utility.Kqueue (
|
||||||
changedFile,
|
changedFile,
|
||||||
isAdd,
|
isAdd,
|
||||||
isDelete,
|
isDelete,
|
||||||
|
runHooks,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Common
|
import Common
|
||||||
|
import Utility.Types.DirWatcher
|
||||||
|
|
||||||
import System.Posix.Types
|
import System.Posix.Types
|
||||||
import Foreign.C.Types
|
import Foreign.C.Types
|
||||||
|
@ -187,3 +189,26 @@ handleChange (Kqueue h dirmap pruner) fd olddirinfo =
|
||||||
-- remove it from our map.
|
-- remove it from our map.
|
||||||
newmap <- removeSubDir dirmap (dirName olddirinfo)
|
newmap <- removeSubDir dirmap (dirName olddirinfo)
|
||||||
return (Kqueue h newmap pruner, [])
|
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
|
||||||
|
}
|
7
debian/changelog
vendored
7
debian/changelog
vendored
|
@ -1,8 +1,9 @@
|
||||||
git-annex (3.20120616) UNRELEASED; urgency=low
|
git-annex (3.20120616) UNRELEASED; urgency=low
|
||||||
|
|
||||||
* watch: New subcommand, which uses inotify to watch for changes to
|
* watch: New subcommand, a daemon which notices changes to
|
||||||
files and automatically annexes new files, etc, so you don't need
|
files and automatically annexes new files, etc, so you don't
|
||||||
to manually run git commands when manipulating files.
|
need to manually run git commands when manipulating files.
|
||||||
|
Available on Linux, BSDs, and OSX!
|
||||||
* Enable diskfree on kfreebsd, using statvfs.
|
* Enable diskfree on kfreebsd, using statvfs.
|
||||||
|
|
||||||
-- Joey Hess <joeyh@debian.org> Tue, 12 Jun 2012 11:35:59 -0400
|
-- Joey Hess <joeyh@debian.org> Tue, 12 Jun 2012 11:35:59 -0400
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue