1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
{-# LANGUAGE CPP #-}
module Utility.Inotify where
import Common hiding (isDirectory)
import System.INotify
import qualified System.Posix.Files as Files
import System.Posix.Terminal
import Control.Concurrent.MVar
import System.Posix.Signals
demo :: IO ()
demo = withINotify $ \i -> do
watchDir i (const True) (Just add) (Just del) "/home/joey/tmp/me"
putStrLn "started"
waitForTermination
where
add file = putStrLn $ "add " ++ file
del file = putStrLn $ "del " ++ file
{- Watches for changes to files in a directory, and all its subdirectories
- that match a test, using inotify. This function returns after its initial
- setup is complete, leaving a thread running. Then callbacks are made for
- adding and deleting files.
-
- Inotify is weak at recursive directory watching; the whole directory
- tree must be walked and watches set explicitly for each subdirectory.
-
- To notice newly created subdirectories, inotify is used, and
- watches are registered for those directories. There is a race there;
- things can be added to a directory before the watch gets registered.
-
- To close the inotify race, each time a new directory is found, it also
- recursively scans it, assuming all files in it were just added,
- and registering each subdirectory.
-
- Note: Due to the race amelioration, multiple add events may occur
- for the same file.
-
- Note: Moving a file may involve deleting it from its old location and
- adding it to the new location.
-
- Note: Modification of files is not detected, and it's assumed that when
- a file that was open for write is closed, it's done being written
- to, and can be added.
-
- Note: inotify has a limit to the number of watches allowed,
- /proc/sys/fs/inotify/max_user_watches (default 8192).
- So This will fail if there are too many subdirectories.
-}
watchDir :: INotify -> (FilePath -> Bool) -> Maybe (FilePath -> IO ()) -> Maybe (FilePath -> IO ()) -> FilePath -> IO ()
watchDir i test add del dir = watchDir' False i test add del dir
watchDir' :: Bool -> INotify -> (FilePath -> Bool) -> Maybe (FilePath -> IO ()) -> Maybe (FilePath -> IO ()) -> FilePath -> IO ()
watchDir' scan i test add del dir = do
if test dir
then do
_ <- addWatch i watchevents dir go
_ <- mapM walk =<< dirContents dir
return ()
else return ()
where
watchevents
| isJust add && isJust del =
[Create, MoveIn, MoveOut, Delete, CloseWrite]
| isJust add = [Create, MoveIn, CloseWrite]
| isJust del = [Create, MoveOut, Delete]
| otherwise = [Create]
recurse = watchDir' scan i test add del
walk f = ifM (catchBoolIO $ Files.isDirectory <$> getFileStatus f)
( recurse f
, if scan && isJust add then fromJust add f else return ()
)
go (Created { isDirectory = False }) = return ()
go (Created { filePath = subdir }) = Just recurse <@> subdir
go (Closed { maybeFilePath = Just f }) = add <@> f
go (MovedIn { isDirectory = False, filePath = f }) = add <@> f
go (MovedOut { isDirectory = False, filePath = f }) = del <@> f
go (Deleted { isDirectory = False, filePath = f }) = del <@> f
go _ = return ()
Just a <@> f = a $ dir </> f
Nothing <@> _ = return ()
{- Pauses the main thread, letting children run until program termination. -}
waitForTermination :: IO ()
waitForTermination = do
mv <- newEmptyMVar
check softwareTermination mv
whenM (queryTerminal stdInput) $
check keyboardSignal mv
takeMVar mv
where
check sig mv = do
_ <- installHandler sig (CatchOnce $ putMVar mv ()) Nothing
return ()
|
