@@ -0,0 +1,1012 @@
1+-- |
2+-- Module : Streamly.Internal.FileSystem.Event.Linux
3+-- Copyright : (c) 2020 Composewell Technologies
4+-- License : BSD-3-Clause
5+-- Maintainer : streamly@composewell.com
6+-- Stability : experimental
7+-- Portability : GHC
8+--
9+-- =Overview
10+--
11+-- Use 'watchPaths' with a list of file system paths you want to watch as
12+-- argument. It returns a stream of 'Event' representing the file system events
13+-- occurring under the watched paths.
14+--
15+-- @
16+-- Stream.mapM_ (putStrLn . 'showEvent') $ 'watchPaths' [Array.fromCString\# "dir"#]
17+-- @
18+--
19+-- 'Event' is an opaque type. Accessor functions (e.g. 'showEvent' above)
20+-- provided in this module are used to determine the attributes of the event.
21+--
22+-- =Design notes
23+--
24+-- For reference documentation see:
25+--
26+-- * <https://man7.org/linux/man-pages/man7/inotify.7.html inotify man page>
27+--
28+-- We try to keep the macOS\/Linux/Windows event handling APIs and defaults
29+-- semantically and syntactically as close as possible.
30+--
31+-- =BUGs
32+--
33+-- When testing on Linux Kernel version @5.3.0-53-generic #47-Ubuntu@, the last
34+-- event for the root path seems to be delayed until one more event occurs.
35+--
36+-- = Differences between macOS and Linux APIs:
37+--
38+-- 1. macOS watch is based on the path provided to it, if the path is
39+-- deleted and recreated it will still be watched, if the path moves to another
40+-- path it won't be watched anymore. Whereas Linux watch is based on a handle
41+-- to the path, if the path is deleted and recreated it won't be watched, if
42+-- the path moves to another it can still be watched (though this is
43+-- configurable).
44+--
45+-- 2. macOS watches the directory hierarchy recursively, Linux watches only one
46+-- level of dir, recursive watch has to be built in user space by watching for
47+-- create events and adding the new directories to the watch. Not sure how this
48+-- will scale for too many paths.
49+--
50+-- 3. In macOS the path of the subject of the event is absolute, in Linux the
51+-- path is the name of the object inside the dir being watched.
52+--
53+-- 4. On Linux 'watchPaths' fails if a path does not exist, on macOS it does
54+-- not fail.
55+
56+module Streamly.Internal.FileSystem.Event.Linux
57+ (
58+ -- * Subscribing to events
59+
60+ -- ** Default configuration
61+ Config
62+ , Toggle (..)
63+ , defaultConfig
64+
65+ -- ** Watch Behavior
66+ , setFollowSymLinks
67+ , setUnwatchMoved
68+ , setOneShot
69+ , setOnlyDir
70+ , WhenExists (..)
71+ , setWhenExists
72+
73+ -- ** Events of Interest
74+ -- *** Root Level Events
75+ , setRootDeleted
76+ , setRootMoved
77+
78+ -- *** Item Level Metadata change
79+ , setMetadataChanged
80+
81+ -- *** Item Level Access
82+ , setAccessed
83+ , setOpened
84+ , setWriteClosed
85+ , setNonWriteClosed
86+
87+ -- *** Item CRUD events
88+ , setCreated
89+ , setDeleted
90+ , setMovedFrom
91+ , setMovedTo
92+ , setModified
93+
94+ , setAllEvents
95+
96+ -- ** Watch APIs
97+ , watchPathsWith
98+ , watchPaths
99+ , addToWatch
100+ , removeFromWatch
101+
102+ -- * Handling Events
103+ , Event
104+ , getRoot
105+ , getRelPath
106+ , getCookie
107+
108+ -- ** Exception Conditions
109+ , isOverflow
110+
111+ -- ** Root Level Events
112+ , isRootUnwatched
113+ , isRootDeleted
114+ , isRootMoved
115+ , isRootUnmounted
116+
117+ -- ** Item Level Metadata change
118+ , isMetadataChanged
119+
120+ -- ** Item Level Access
121+ , isAccessed
122+ , isOpened
123+ , isWriteClosed
124+ , isNonWriteClosed
125+
126+ -- ** Item CRUD events
127+ , isCreated
128+ , isDeleted
129+ , isMovedFrom
130+ , isMovedTo
131+ , isModified
132+
133+ -- ** Item Path info
134+ , isDir
135+
136+ -- * Debugging
137+ , showEvent
138+ )
139+where
140+
141+import Control.Monad (void, when)
142+import Control.Monad.IO.Class (liftIO)
143+import Data.Bits ((.|.), (.&.), complement)
144+import Data.Foldable (foldlM)
145+import Data.Functor.Identity (runIdentity)
146+import Data.IntMap.Lazy (IntMap)
147+import Data.Word (Word8, Word32)
148+import Foreign.C.Error (throwErrnoIfMinus1)
149+import Foreign.C.String (CString)
150+import Foreign.C.Types (CInt(..), CUInt(..))
151+import Foreign.Ptr (Ptr)
152+import Foreign.Storable (peek, peekByteOff, sizeOf)
153+import GHC.IO.Device (IODeviceType(Stream))
154+import GHC.IO.FD (fdFD, mkFD)
155+import GHC.IO.Handle.FD (mkHandleFromFD, handleToFd)
156+import Streamly (SerialT)
157+import Streamly.Internal.Data.Parser (Parser)
158+import Streamly.Internal.Memory.Array.Types (Array(..))
159+import System.IO (Handle, hClose, IOMode(ReadMode))
160+
161+import qualified Data.IntMap.Lazy as Map
162+import qualified Streamly.Internal.Data.Fold as FL
163+import qualified Streamly.Internal.Data.Parser as PR
164+import qualified Streamly.Internal.Data.Stream.IsStream as S
165+import qualified Streamly.Internal.Data.Unicode.Stream as U
166+import qualified Streamly.Internal.FileSystem.Handle as FH
167+import qualified Streamly.Internal.Memory.Array as A
168+
169+-------------------------------------------------------------------------------
170+-- Subscription to events
171+-------------------------------------------------------------------------------
172+
173+-- | Watch configuration, used to specify the events of interest and the
174+-- behavior of the watch.
175+--
176+-- /Internal/
177+--
178+data Config = Config
179+ { createFlags :: Word32 }
180+
181+-------------------------------------------------------------------------------
182+-- Boolean settings
183+-------------------------------------------------------------------------------
184+
185+-- | Whether a setting is 'On' or 'Off'.
186+--
187+-- /Internal/
188+--
189+data Toggle = On | Off
190+
191+toggle :: Toggle -> Toggle
192+toggle On = Off
193+toggle Off = On
194+
195+setFlag :: Word32 -> Toggle -> Config -> Config
196+setFlag mask status cfg@Config{..} =
197+ let flags =
198+ case status of
199+ On -> createFlags .|. mask
200+ Off -> createFlags .&. complement mask
201+ in cfg {createFlags = flags}
202+
203+-------------------------------------------------------------------------------
204+-- Settings
205+-------------------------------------------------------------------------------
206+
207+
208+foreign import capi
209+ "sys/inotify.h value IN_DONT_FOLLOW" iN_DONT_FOLLOW :: Word32
210+
211+-- | If the pathname to be watched is a symbolic link then watch the target of
212+-- the symbolic link instead of the symbolic link itself.
213+--
214+-- /default: On/
215+--
216+-- /Internal/
217+--
218+setFollowSymLinks :: Toggle -> Config -> Config
219+setFollowSymLinks s = setFlag iN_DONT_FOLLOW (toggle s)
220+
221+foreign import capi
222+ "sys/inotify.h value IN_EXCL_UNLINK" iN_EXCL_UNLINK :: Word32
223+
224+-- | If an object moves out of the directory being watched then stop watching
225+-- it.
226+--
227+-- /default: On/
228+--
229+-- /Internal/
230+--
231+setUnwatchMoved :: Toggle -> Config -> Config
232+setUnwatchMoved = setFlag iN_EXCL_UNLINK
233+
234+foreign import capi
235+ "sys/inotify.h value IN_MASK_CREATE" iN_MASK_CREATE :: Word32
236+foreign import capi
237+ "sys/inotify.h value IN_MASK_ADD" iN_MASK_ADD :: Word32
238+
239+-- | What to do if a watch already exists when 'openWatch' or 'addToWatch' is
240+-- called for a path.
241+--
242+-- /Internal/
243+--
244+data WhenExists =
245+ FailIfExists -- ^ Fail the API
246+ | AddIfExists -- ^ Do not set an existing setting to 'Off' only set to 'On'
247+ | ReplaceIfExists -- ^ Replace the existing settings with new settings
248+
249+-- | When adding a new path to the watch, specify what to do if a watch already
250+-- exists on that path.
251+--
252+-- /default: FailIfExists/
253+--
254+-- /Internal/
255+--
256+setWhenExists :: WhenExists -> Config -> Config
257+setWhenExists val cfg =
258+ case val of
259+ FailIfExists -> setFlag iN_MASK_CREATE On cfg
260+ AddIfExists -> setFlag iN_MASK_ADD On cfg
261+ ReplaceIfExists -> setFlag iN_MASK_ADD Off cfg
262+
263+foreign import capi
264+ "sys/inotify.h value IN_ONESHOT" iN_ONESHOT :: Word32
265+
266+-- | Watch the object only for one event and then remove it from the watch.
267+--
268+-- /default: Off/
269+--
270+-- /Internal/
271+--
272+setOneShot :: Toggle -> Config -> Config
273+setOneShot = setFlag iN_ONESHOT
274+
275+foreign import capi
276+ "sys/inotify.h value IN_ONLYDIR" iN_ONLYDIR :: Word32
277+
278+-- | Watch the object only if it is a directory. This provides a race-free way
279+-- to ensure that the watched object is a directory.
280+--
281+-- /default: Off/
282+--
283+-- /Internal/
284+--
285+setOnlyDir :: Toggle -> Config -> Config
286+setOnlyDir = setFlag iN_ONLYDIR
287+
288+-------------------------------------------------------------------------------
289+-- Event types that can occur
290+-------------------------------------------------------------------------------
291+
292+foreign import capi
293+ "sys/inotify.h value IN_DELETE_SELF" iN_DELETE_SELF :: Word32
294+
295+-- | Report when the watched path itself gets deleted.
296+--
297+-- /default: On/
298+--
299+-- /Internal/
300+--
301+setRootDeleted :: Toggle -> Config -> Config
302+setRootDeleted = setFlag iN_DELETE_SELF
303+
304+foreign import capi
305+ "sys/inotify.h value IN_MOVE_SELF" iN_MOVE_SELF :: Word32
306+
307+-- | Report when the watched root path itself gets renamed.
308+--
309+-- /default: On/
310+--
311+-- /Internal/
312+--
313+setRootMoved :: Toggle -> Config -> Config
314+setRootMoved = setFlag iN_MOVE_SELF
315+
316+foreign import capi
317+ "sys/inotify.h value IN_ATTRIB" iN_ATTRIB :: Word32
318+
319+-- | Report when the metadata e.g. owner, permission modes, modifications times
320+-- of an object changes.
321+--
322+-- /default: On/
323+--
324+-- /Internal/
325+--
326+setMetadataChanged :: Toggle -> Config -> Config
327+setMetadataChanged = setFlag iN_ATTRIB
328+
329+foreign import capi
330+ "sys/inotify.h value IN_ACCESS" iN_ACCESS :: Word32
331+
332+-- | Report when a file is accessed.
333+--
334+-- /default: On/
335+--
336+-- /Internal/
337+--
338+setAccessed :: Toggle -> Config -> Config
339+setAccessed = setFlag iN_ACCESS
340+
341+foreign import capi
342+ "sys/inotify.h value IN_OPEN" iN_OPEN :: Word32
343+
344+-- | Report when a file is opened.
345+--
346+-- /default: On/
347+--
348+-- /Internal/
349+--
350+setOpened :: Toggle -> Config -> Config
351+setOpened = setFlag iN_OPEN
352+
353+foreign import capi
354+ "sys/inotify.h value IN_CLOSE_WRITE" iN_CLOSE_WRITE :: Word32
355+
356+-- | Report when a file that was opened for writes is closed.
357+--
358+-- /default: On/
359+--
360+-- /Internal/
361+--
362+setWriteClosed :: Toggle -> Config -> Config
363+setWriteClosed = setFlag iN_CLOSE_WRITE
364+
365+foreign import capi
366+ "sys/inotify.h value IN_CLOSE_NOWRITE" iN_CLOSE_NOWRITE :: Word32
367+
368+-- | Report when a file that was opened for not writing is closed.
369+--
370+-- /default: On/
371+--
372+-- /Internal/
373+--
374+setNonWriteClosed :: Toggle -> Config -> Config
375+setNonWriteClosed = setFlag iN_CLOSE_NOWRITE
376+
377+foreign import capi
378+ "sys/inotify.h value IN_CREATE" iN_CREATE :: Word32
379+
380+-- | Report when a file is created.
381+--
382+-- /default: On/
383+--
384+-- /Internal/
385+--
386+setCreated :: Toggle -> Config -> Config
387+setCreated = setFlag iN_CREATE
388+
389+foreign import capi
390+ "sys/inotify.h value IN_DELETE" iN_DELETE :: Word32
391+
392+-- | Report when a file is deleted.
393+--
394+-- /default: On/
395+--
396+-- /Internal/
397+--
398+setDeleted :: Toggle -> Config -> Config
399+setDeleted = setFlag iN_DELETE
400+
401+foreign import capi
402+ "sys/inotify.h value IN_MOVED_FROM" iN_MOVED_FROM :: Word32
403+
404+-- | Report the source of a move.
405+--
406+-- /default: On/
407+--
408+-- /Internal/
409+--
410+setMovedFrom :: Toggle -> Config -> Config
411+setMovedFrom = setFlag iN_MOVED_FROM
412+
413+foreign import capi
414+ "sys/inotify.h value IN_MOVED_TO" iN_MOVED_TO :: Word32
415+
416+-- | Report the target of a move.
417+--
418+-- /default: On/
419+--
420+-- /Internal/
421+--
422+setMovedTo :: Toggle -> Config -> Config
423+setMovedTo = setFlag iN_MOVED_TO
424+
425+foreign import capi
426+ "sys/inotify.h value IN_MODIFY" iN_MODIFY :: Word32
427+
428+-- | Report when a file is modified.
429+--
430+-- /default: On/
431+--
432+-- /Internal/
433+--
434+setModified :: Toggle -> Config -> Config
435+setModified = setFlag iN_MODIFY
436+
437+-- | Set all events 'On' or 'Off'.
438+--
439+-- /default: On/
440+--
441+-- /Internal/
442+--
443+setAllEvents :: Toggle -> Config -> Config
444+setAllEvents s cfg =
445+ ( setRootDeleted s
446+ . setRootMoved s
447+ . setMetadataChanged s
448+ . setAccessed s
449+ . setOpened s
450+ . setWriteClosed s
451+ . setNonWriteClosed s
452+ . setCreated s
453+ . setDeleted s
454+ . setMovedFrom s
455+ . setMovedTo s
456+ . setModified s
457+ ) cfg
458+
459+-------------------------------------------------------------------------------
460+-- Default config
461+-------------------------------------------------------------------------------
462+
463+-- The defaults are set in such a way that the behavior on macOS and Linux is
464+-- as much compatible as possible.
465+--
466+-- | The default is:
467+--
468+-- * 'setFollowSymLinks' 'On'
469+-- * 'setUnwatchMoved' 'On'
470+-- * 'setOneShot' 'Off'
471+-- * 'setOnlyDir' 'Off'
472+-- * 'setWhenExists' 'AddIfExists'
473+-- * 'setAllEvents' 'On'
474+--
475+-- /Internal/
476+--
477+defaultConfig :: Config
478+defaultConfig =
479+ setWhenExists AddIfExists
480+ $ setAllEvents On
481+ $ Config { createFlags = 0 }
482+
483+-------------------------------------------------------------------------------
484+-- Open an event stream
485+-------------------------------------------------------------------------------
486+
487+-- | A handle for a watch.
488+data Watch = Watch Handle (IntMap (Array Word8))
489+
490+-- Instead of using the watch descriptor we can provide APIs that use the path
491+-- itself to identify the watch. That will require us to maintain a map from wd
492+-- to path in the Watch handle.
493+
494+newtype WD = WD CInt deriving Show
495+
496+foreign import ccall unsafe
497+ "sys/inotify.h inotify_init" c_inotify_init :: IO CInt
498+
499+-- | Create a 'Watch' handle. 'addToWatch' can be used to add paths being
500+-- monitored by this watch.
501+--
502+-- /Internal/
503+--
504+createWatch :: IO Watch
505+createWatch = do
506+ rawfd <- throwErrnoIfMinus1 "createWatch" c_inotify_init
507+ -- we could use fdToHandle but it cannot determine the fd type
508+ -- automatically for the inotify fd
509+ (fd, fdType) <-
510+ mkFD
511+ rawfd
512+ ReadMode
513+ (Just (Stream, 0, 0)) -- (IODeviceType, CDev, CIno)
514+ False -- not a socket
515+ False -- non-blocking is false
516+ let fdString = "<createWatch file descriptor: " ++ show fd ++ ">"
517+ h <-
518+ mkHandleFromFD
519+ fd
520+ fdType
521+ fdString
522+ ReadMode
523+ True -- use non-blocking IO
524+ Nothing -- TextEncoding (binary)
525+ return $ Watch h Map.empty
526+
527+foreign import ccall unsafe
528+ "sys/inotify.h inotify_add_watch" c_inotify_add_watch
529+ :: CInt -> CString -> CUInt -> IO CInt
530+
531+utf8ToString :: Array Word8 -> String
532+utf8ToString = runIdentity . S.toList . U.decodeUtf8 . A.toStream
533+
534+-- | Given a 'Config' and a @path@ supplied as a UTF-8 encoded byte array, add
535+-- the path to the list of paths being monitored by the given watch 'Handle'.
536+-- Returns a "watch descriptor" which is used as an idenitfier in the events
537+-- generated for this particular path and also to remove the path from this
538+-- watch.
539+--
540+-- /Internal/
541+--
542+addToWatch :: Config -> Watch -> Array Word8 -> IO Watch
543+addToWatch Config{..} (Watch handle wdMap) path = do
544+ fd <- handleToFd handle
545+ wd <- A.asCString path $ \pathPtr ->
546+ throwErrnoIfMinus1 ("addToWatch " ++ utf8ToString path) $
547+ c_inotify_add_watch (fdFD fd) pathPtr (CUInt createFlags)
548+ return $ Watch handle (Map.insert (fromIntegral wd) path wdMap)
549+
550+foreign import ccall unsafe
551+ "sys/inotify.h inotify_rm_watch" c_inotify_rm_watch
552+ :: CInt -> CInt -> IO CInt
553+
554+-- | Remove a path from a 'Watch', if a path was moved after adding you need to
555+-- need to provide the original path which was used to add the Watch.
556+--
557+-- /Internal/
558+--
559+removeFromWatch :: Watch -> Array Word8 -> IO Watch
560+removeFromWatch (Watch handle wdMap) path = do
561+ fd <- handleToFd handle
562+ wdMap1 <- foldlM (step fd) Map.empty (Map.toList wdMap)
563+ return $ Watch handle wdMap1
564+
565+ where
566+
567+ step fd newMap (wd, v) = do
568+ if v == path
569+ then do
570+ let err = "removeFromWatch " ++ show (utf8ToString path)
571+ rm = c_inotify_rm_watch (fdFD fd) (fromIntegral wd)
572+ void $ throwErrnoIfMinus1 err rm
573+ return newMap
574+ else return $ Map.insert wd v newMap
575+
576+-- | Given a 'Config' and list of @paths@ (UTF-8 encoded byte arrays) start
577+-- monitoring the paths for file system events. Returns a 'Watch' handle which
578+-- can then be used to read the event stream or to close the watch.
579+--
580+-- /Internal/
581+--
582+openWatch :: Config -> [Array Word8] -> IO Watch
583+openWatch cfg paths = do
584+ w <- createWatch
585+ foldlM (\w1 pth -> addToWatch cfg w1 pth) w paths
586+
587+-- | Close a 'Watch' handle.
588+--
589+-- /Internal/
590+--
591+closeWatch :: Watch -> IO ()
592+closeWatch (Watch h _) = hClose h
593+
594+-------------------------------------------------------------------------------
595+-- Raw events read from the watch file handle
596+-------------------------------------------------------------------------------
597+
598+newtype Cookie = Cookie Word32 deriving (Show, Eq)
599+
600+-- | An Event generated by the file system. Use the accessor functions to
601+-- examine the event.
602+--
603+-- /Internal/
604+--
605+data Event = Event
606+ { eventWd :: CInt
607+ , eventFlags :: Word32
608+ , eventCookie :: Word32
609+ , eventRelPath :: Array Word8
610+ , eventMap :: IntMap (Array Word8)
611+ } deriving (Show, Ord, Eq)
612+
613+-- The inotify event struct from the man page/header file:
614+--
615+-- struct inotify_event {
616+-- int wd; /* Watch descriptor */
617+-- uint32_t mask; /* Mask describing event */
618+-- uint32_t cookie; /* Unique cookie associating related
619+-- events (for rename(2)) */
620+-- uint32_t len; /* Size of name field */
621+-- char name[]; /* Optional null-terminated name */
622+-- };
623+--
624+-- XXX We can perhaps use parseD monad instance for fusing with parseMany? Need
625+-- to measure the perf.
626+--
627+readOneEvent :: IntMap (Array Word8) -> Parser IO Word8 Event
628+readOneEvent wdMap = do
629+ let headerLen = (sizeOf (undefined :: CInt)) + 12
630+ arr <- PR.takeEQ headerLen (A.writeN headerLen)
631+ (ewd, eflags, cookie, pathLen) <- PR.yieldM $ A.asPtr arr readHeader
632+ -- XXX need the "initial" in parsers to return a step type so that "take 0"
633+ -- can return without an input. otherwise if pathLen is 0 we will keep
634+ -- waiting to read one more char before we return this event.
635+ path <-
636+ if pathLen /= 0
637+ then do
638+ -- XXX sliceSepByMax drops the separator so assumes a null
639+ -- terminated path, we should use a takeWhile nested inside a
640+ -- takeP
641+ pth <- PR.sliceSepByMax (== 0) pathLen (A.writeN pathLen)
642+ let remaining = pathLen - A.length pth - 1
643+ when (remaining /= 0) $ PR.takeEQ remaining FL.drain
644+ return pth
645+ else return $ A.fromList []
646+ return $ Event
647+ { eventWd = (fromIntegral ewd)
648+ , eventFlags = eflags
649+ , eventCookie = cookie
650+ , eventRelPath = path
651+ , eventMap = wdMap
652+ }
653+
654+ where
655+
656+ readHeader (ptr :: Ptr Word8) = do
657+ let len = sizeOf (undefined :: CInt)
658+ ewd <- peek ptr
659+ eflags <- peekByteOff ptr len
660+ cookie <- peekByteOff ptr (len + 4)
661+ pathLen :: Word32 <- peekByteOff ptr (len + 8)
662+ return (ewd, eflags, cookie, fromIntegral pathLen)
663+
664+watchToStream :: Watch -> SerialT IO Event
665+watchToStream (Watch handle wdMap) =
666+ -- Do not use too small a buffer. As per inotify man page:
667+ --
668+ -- The behavior when the buffer given to read(2) is too small to return
669+ -- information about the next event depends on the kernel version: in
670+ -- kernels before 2.6.21, read(2) returns 0; since kernel 2.6.21, read(2)
671+ -- fails with the error EINVAL. Specifying a buffer of size
672+ --
673+ -- sizeof(struct inotify_event) + NAME_MAX + 1
674+ --
675+ -- will be sufficient to read at least one event.
676+ S.parseMany (readOneEvent wdMap) $ S.unfold FH.read handle
677+
678+-- | Start monitoring a list of file system paths for file system events with
679+-- the supplied configuration operation over the 'defaultConfig'. The
680+-- paths could be files or directories. When the path is a directory, only the
681+-- files and directories directly under the watched directory are monitored,
682+-- contents of subdirectories are not monitored. Monitoring starts from the
683+-- current time onwards. The paths are specified as UTF-8 encoded 'Array' of
684+-- 'Word8'.
685+--
686+-- @
687+-- watchPathsWith
688+-- ('setFollowSymLinks' On . 'setUnwatchMoved' Off)
689+-- [Array.fromCString\# "dir"#]
690+-- @
691+--
692+-- /Internal/
693+--
694+watchPathsWith :: (Config -> Config) -> [Array Word8] -> SerialT IO Event
695+watchPathsWith f paths = S.bracket before after watchToStream
696+
697+ where
698+
699+ before = liftIO $ openWatch (f defaultConfig) paths
700+ after = liftIO . closeWatch
701+
702+-- | Like 'watchPathsWith' but uses the 'defaultConfig' options.
703+--
704+-- @
705+-- watchPaths = watchPathsWith id
706+-- @
707+--
708+-- /Internal/
709+--
710+watchPaths :: [Array Word8] -> SerialT IO Event
711+watchPaths = watchPathsWith id
712+
713+-------------------------------------------------------------------------------
714+-- Examine event stream
715+-------------------------------------------------------------------------------
716+
717+-- | Get the watch descriptor corresponding to the 'Event'. A watch descriptor
718+-- identifies which of the paths being monitored has generated this event.
719+--
720+-- Note that if a path was moved after adding to the watch, this will give the
721+-- original path and not the new path after moving.
722+--
723+-- /Internal/
724+--
725+getRoot :: Event -> Array Word8
726+getRoot Event{..} =
727+ if (eventWd >= 1)
728+ then
729+ case Map.lookup (fromIntegral eventWd) eventMap of
730+ Just path -> path
731+ Nothing ->
732+ error $ "Bug: getRoot: No path found corresponding to the "
733+ ++ "watch descriptor " ++ show eventWd
734+ else A.fromList []
735+
736+
737+-- XXX should we use a Maybe here?
738+-- | Get the file system object path for which the event is generated, relative
739+-- to the watched root. The path is a UTF-8 encoded array of bytes.
740+--
741+-- /Internal/
742+--
743+getRelPath :: Event -> Array Word8
744+getRelPath Event{..} = eventRelPath
745+
746+-- XXX should we use a Maybe?
747+-- | Cookie is set when a rename occurs. The cookie value can be used to
748+-- connect the 'isMovedFrom' and 'isMovedTo' events, if both the events belong
749+-- to the same move operation then they will have the same cookie value.
750+--
751+-- /Internal/
752+--
753+getCookie :: Event -> Cookie
754+getCookie Event{..} = Cookie eventCookie
755+
756+-------------------------------------------------------------------------------
757+-- Event types
758+-------------------------------------------------------------------------------
759+
760+getFlag :: Word32 -> Event -> Bool
761+getFlag mask Event{..} = eventFlags .&. mask /= 0
762+
763+-------------------------------------------------------------------------------
764+-- Error events
765+-------------------------------------------------------------------------------
766+
767+foreign import capi
768+ "sys/inotify.h value IN_Q_OVERFLOW" iN_Q_OVERFLOW :: Word32
769+
770+-- XXX rename to isQOverflowed or hasOverflowed?
771+--
772+-- macOS overflow API is more specific, it tells which paths have lost the
773+-- events due to overflow.
774+--
775+-- | Event queue overflowed (WD is invalid for this event) and we may have lost
776+-- some events.. The user application must scan everything under the watched
777+-- paths to know the current state.
778+--
779+-- /Internal/
780+--
781+isOverflow :: Event -> Bool
782+isOverflow = getFlag iN_Q_OVERFLOW
783+
784+-------------------------------------------------------------------------------
785+-- Events affecting the watched path only
786+-------------------------------------------------------------------------------
787+
788+foreign import capi
789+ "sys/inotify.h value IN_IGNORED" iN_IGNORED :: Word32
790+
791+-- Compare with isRootChanged on macOS. isRootChanged includes all these cases.
792+--
793+-- | A path was removed from the watch explicitly using 'removeFromWatch' or
794+-- automatically (file was deleted, or filesystem was unmounted).
795+--
796+-- /Occurs only for a watched path/
797+--
798+-- /Internal/
799+--
800+isRootUnwatched :: Event -> Bool
801+isRootUnwatched = getFlag iN_IGNORED
802+
803+-- | Watched file/directory was itself deleted. (This event also occurs if an
804+-- object is moved to another filesystem, since mv(1) in effect copies the file
805+-- to the other filesystem and then deletes it from the original filesystem.)
806+-- In addition, an 'isRootUnwatched' event will subsequently be generated
807+-- for the watch descriptor.
808+--
809+-- /Occurs only for a watched path/
810+--
811+-- /Internal/
812+--
813+isRootDeleted :: Event -> Bool
814+isRootDeleted = getFlag iN_DELETE_SELF
815+
816+-- | Watched file/directory was itself moved within the file system.
817+--
818+-- /Occurs only for a watched path/
819+--
820+-- /Internal/
821+--
822+isRootMoved :: Event -> Bool
823+isRootMoved = getFlag iN_MOVE_SELF
824+
825+foreign import capi
826+ "sys/inotify.h value IN_UNMOUNT" iN_UNMOUNT :: Word32
827+
828+-- | Filesystem containing watched object was unmounted. In addition, an
829+-- 'isRootUnwatched' event will subsequently be generated for the watch
830+-- descriptor.
831+--
832+-- /Occurs only for a watched path/
833+--
834+-- /Internal/
835+--
836+isRootUnmounted :: Event -> Bool
837+isRootUnmounted = getFlag iN_UNMOUNT
838+
839+-------------------------------------------------------------------------------
840+-- Metadata change Events
841+-------------------------------------------------------------------------------
842+
843+-- macOS has multiple APIs for metadata change for different metadata.
844+--
845+-- | Determine whether the event indicates inode metadata change for an object
846+-- contained within the monitored path.
847+--
848+-- Metadata change may include, permissions (e.g., chmod(2)), timestamps
849+-- (e.g., utimensat(2)), extended attributes (setxattr(2)), link count (since
850+-- Linux 2.6.25; e.g., for the target of link(2) and for unlink(2)), and
851+-- user/group ID (e.g., chown(2)).
852+--
853+-- /Can occur for watched path or a file inside it/
854+--
855+-- /Internal/
856+--
857+isMetadataChanged :: Event -> Bool
858+isMetadataChanged = getFlag iN_ATTRIB
859+
860+-------------------------------------------------------------------------------
861+-- Access
862+-------------------------------------------------------------------------------
863+
864+-- | File was accessed (e.g. read, execve).
865+--
866+-- /Occurs only for a file inside the watched directory/
867+--
868+-- /Internal/
869+--
870+isAccessed :: Event -> Bool
871+isAccessed = getFlag iN_ACCESS
872+
873+-- | File or directory was opened.
874+--
875+-- /Occurs only for a file inside the watched directory/
876+--
877+-- /Internal/
878+--
879+isOpened :: Event -> Bool
880+isOpened = getFlag iN_OPEN
881+
882+-- | File opened for writing was closed.
883+--
884+-- /Occurs only for a file inside the watched directory/
885+--
886+-- /Internal/
887+--
888+isWriteClosed :: Event -> Bool
889+isWriteClosed = getFlag iN_CLOSE_WRITE
890+
891+-- XXX what if it was opened for append? Does NOWRITE mean all cases where the
892+-- mode was not write? A dir open comes in this category?
893+--
894+-- | File or directory opened for read but not write was closed.
895+--
896+-- /Can occur for watched path or a file inside it/
897+--
898+-- /Internal/
899+--
900+isNonWriteClosed :: Event -> Bool
901+isNonWriteClosed = getFlag iN_CLOSE_NOWRITE
902+
903+-------------------------------------------------------------------------------
904+-- CRUD Events
905+-------------------------------------------------------------------------------
906+
907+-- On macOS this is not generated on hard linking but on Linux it is.
908+--
909+-- | File/directory created in watched directory (e.g., open(2) O_CREAT,
910+-- mkdir(2), link(2), symlink(2), bind(2) on a UNIX domain socket).
911+--
912+-- /Occurs only for an object inside the watched directory/
913+--
914+-- /Internal/
915+--
916+isCreated :: Event -> Bool
917+isCreated = getFlag iN_CREATE
918+
919+-- | File/directory deleted from watched directory.
920+--
921+-- /Occurs only for an object inside the watched directory/
922+--
923+-- /Internal/
924+--
925+isDeleted :: Event -> Bool
926+isDeleted = getFlag iN_DELETE
927+
928+-- XXX what if an object is moved in from outside or moved out of the monitored
929+-- dir?
930+--
931+-- | Generated for the original path when an object is moved from under a
932+-- monitored directory.
933+--
934+-- /Occurs only for an object inside the watched directory/
935+--
936+-- /Internal/
937+--
938+isMovedFrom :: Event -> Bool
939+isMovedFrom = getFlag iN_MOVED_FROM
940+
941+-- | Generated for the new path when an object is moved under a monitored
942+-- directory.
943+--
944+-- /Occurs only for an object inside the watched directory/
945+--
946+-- /Internal/
947+--
948+isMovedTo :: Event -> Bool
949+isMovedTo = getFlag iN_MOVED_TO
950+
951+-- | Determine whether the event indicates modification of an object within the
952+-- monitored path. This event is generated only for files and not directories.
953+--
954+-- /Occurs only for an object inside the watched directory/
955+--
956+-- /Internal/
957+--
958+isModified :: Event -> Bool
959+isModified = getFlag iN_MODIFY
960+
961+-------------------------------------------------------------------------------
962+-- Information about path type (applicable only when 'setFileEvents' is 'On')
963+-------------------------------------------------------------------------------
964+
965+foreign import capi
966+ "sys/inotify.h value IN_ISDIR" iN_ISDIR :: Word32
967+
968+-- | Determine whether the event is for a directory path.
969+--
970+-- /Internal/
971+--
972+isDir :: Event -> Bool
973+isDir = getFlag iN_ISDIR
974+
975+-------------------------------------------------------------------------------
976+-- Debugging
977+-------------------------------------------------------------------------------
978+
979+-- | Convert an 'Event' record to a String representation.
980+showEvent :: Event -> String
981+showEvent ev@Event{..} =
982+ "--------------------------"
983+ ++ "\nWd = " ++ show eventWd
984+ ++ "\nRoot = " ++ show (utf8ToString $ getRoot ev)
985+ ++ "\nPath = " ++ show (utf8ToString $ getRelPath ev)
986+ ++ "\nCookie = " ++ show (getCookie ev)
987+ ++ "\nFlags " ++ show eventFlags
988+
989+ ++ showev isOverflow "Overflow"
990+
991+ ++ showev isRootUnwatched "RootUnwatched"
992+ ++ showev isRootDeleted "RootDeleted"
993+ ++ showev isRootMoved "RootMoved"
994+ ++ showev isRootUnmounted "RootUnmounted"
995+
996+ ++ showev isMetadataChanged "MetadataChanged"
997+
998+ ++ showev isAccessed "Accessed"
999+ ++ showev isOpened "Opened"
1000+ ++ showev isWriteClosed "WriteClosed"
1001+ ++ showev isNonWriteClosed "NonWriteClosed"
1002+
1003+ ++ showev isCreated "Created"
1004+ ++ showev isDeleted "Deleted"
1005+ ++ showev isModified "Modified"
1006+ ++ showev isMovedFrom "MovedFrom"
1007+ ++ showev isMovedTo "MovedTo"
1008+
1009+ ++ showev isDir "Dir"
1010+ ++ "\n"
1011+
1012+ where showev f str = if f ev then "\n" ++ str else ""