on 25ada4e help sign in
1288 lines 40 kB history raw
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.fromList "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-- Identical successive events may be coalesced into a single event.
23--
24-- =Design notes
25--
26-- For reference documentation see:
27--
28-- * <https://man7.org/linux/man-pages/man7/inotify.7.html inotify man page>
29--
30-- We try to keep the macOS\/Linux/Windows event handling APIs and defaults
31-- semantically and syntactically as close as possible.
32--
33-- =BUGs
34--
35-- When testing on Linux Kernel version @5.3.0-53-generic #47-Ubuntu@, the last
36-- event for the root path seems to be delayed until one more event occurs.
37--
38-- = Differences between macOS and Linux APIs:
39--
40-- 1. macOS watch is based on the path provided to it, if the path is
41-- deleted and recreated it will still be watched, if the path moves to another
42-- path it won't be watched anymore. Whereas Linux watch is based on a handle
43-- to the path, if the path is deleted and recreated it won't be watched, if
44-- the path moves to another it can still be watched (though this is
45-- configurable).
46--
47-- 2. macOS watches the directory hierarchy recursively, Linux watches only one
48-- level of dir, recursive watch has to be built in user space by watching for
49-- create events and adding the new directories to the watch. Not sure how this
50-- will scale for too many paths.
51--
52-- 3. In macOS the path of the subject of the event is absolute, in Linux the
53-- path is the name of the object inside the dir being watched.
54--
55-- 4. On Linux 'watchPaths' fails if a path does not exist, on macOS it does
56-- not fail.
58#include "config.h"
60#if HAVE_DECL_IN_EXCL_UNLINK
61module Streamly.Internal.FileSystem.Event.Linux
62 (
63 -- * Subscribing to events
65 -- ** Default configuration
66 Config (..)
67 , defaultConfig
69 -- ** Watch Behavior
70 , setRecursiveMode
71 , setFollowSymLinks
72 , setUnwatchMoved
73 , setOneShot
74 , setOnlyDir
75 , WhenExists (..)
76 , setWhenExists
78 -- ** Events of Interest
79 -- *** Root Path Events
80 , setRootDeleted
81 , setRootMoved
82 , setRootPathEvents
84 -- *** Item Level Metadata change
85 , setAttrsModified
87 -- *** Item Level Access
88 , setAccessed
89 , setOpened
90 , setWriteClosed
91 , setNonWriteClosed
93 -- *** Item CRUD events
94 , setCreated
95 , setDeleted
96 , setMovedFrom
97 , setMovedTo
98 , setModified
100 , setAllEvents
102 -- ** Watch APIs
103 , watch
104 , watchRecursive
105 , watchWith
107 -- Low level watch APIs
108 , addToWatch
109 , removeFromWatch
111 -- * Handling Events
112 , Event(..)
113 , getRoot
114 , getRelPath
115 , getAbsPath
116 , getCookie
118 -- ** Root Level Events
119 , isRootPathEvent
120 , isRootUnwatched
121 , isRootDeleted
122 , isRootMoved
123 , isRootUnmounted
125 -- ** Item Level Metadata change
126 , isAttrsModified
128 -- ** Item Level Access
129 , isAccessed
130 , isOpened
131 , isWriteClosed
132 , isNonWriteClosed
134 -- ** Item Level CRUD events
135 , isCreated
136 , isDeleted
137 , isMovedFrom
138 , isMovedTo
139 , isMoved
140 , isModified
142 -- ** Item Path info
143 , isDir
145 -- ** Exception Conditions
146 , isEventsLost
148 -- * Debugging
149 , showEvent
150 )
151where
153import Control.Monad (void, when)
154import Control.Monad.IO.Class (MonadIO)
155import Data.Bits ((.|.), (.&.), complement)
156import Data.Char (ord)
157import Data.Foldable (foldlM)
158import Data.Functor.Identity (runIdentity)
159import Data.IntMap.Lazy (IntMap)
160import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef)
161import Data.List.NonEmpty (NonEmpty)
162#if !(MIN_VERSION_base(4,13,0))
163import Data.Semigroup (Semigroup(..))
164#endif
165import Data.Word (Word8, Word32)
166import Foreign.C.Error (throwErrnoIfMinus1)
167import Foreign.C.String (CString)
168import Foreign.C.Types (CInt(..), CUInt(..))
169import Foreign.Ptr (Ptr)
170import Foreign.Storable (peek, peekByteOff, sizeOf)
171import GHC.IO.Device (IODeviceType(Stream))
172import GHC.IO.FD (fdFD, mkFD)
173import GHC.IO.Handle.FD (mkHandleFromFD)
174import Streamly.Internal.Data.Stream (Stream)
175import Streamly.Internal.Data.Parser (Parser)
176import Streamly.Internal.Data.Array.Type (Array(..), byteLength)
177import System.Directory (doesDirectoryExist)
178import System.IO (Handle, hClose, IOMode(ReadMode))
179import GHC.IO.Handle.FD (handleToFd)
181import qualified Data.IntMap.Lazy as Map
182import qualified Data.List.NonEmpty as NonEmpty
183import qualified Streamly.Internal.Data.Array as A
184import qualified Streamly.Data.Fold as FL
185import qualified Streamly.Internal.Data.Parser as PR
186 (takeEQ, fromEffect, fromFold)
187import qualified Streamly.Internal.Data.Stream as S
188import qualified Streamly.Internal.FileSystem.Dir as Dir
189import qualified Streamly.Internal.FileSystem.Handle as FH
190import qualified Streamly.Internal.Unicode.Stream as U
192-------------------------------------------------------------------------------
193-- Subscription to events
194-------------------------------------------------------------------------------
196-- | Watch configuration, used to specify the events of interest and the
197-- behavior of the watch.
198--
199-- /Pre-release/
200--
201data Config = Config
202 { watchRec :: Bool
203 , createFlags :: Word32
204 }
206-------------------------------------------------------------------------------
207-- Boolean settings
208-------------------------------------------------------------------------------
210setFlag :: Word32 -> Bool -> Config -> Config
211setFlag mask status cfg@Config{..} =
212 let flags =
213 if status
214 then createFlags .|. mask
215 else createFlags .&. complement mask
216 in cfg {createFlags = flags}
218-------------------------------------------------------------------------------
219-- Settings
220-------------------------------------------------------------------------------
222-- | Watch the whole directory tree recursively instead of watching just one
223-- level of directory.
224--
225-- /default: False/
226--
227-- /Pre-release/
228--
229setRecursiveMode :: Bool -> Config -> Config
230setRecursiveMode recursive cfg@Config{} = cfg {watchRec = recursive}
232foreign import capi
233 "sys/inotify.h value IN_DONT_FOLLOW" iN_DONT_FOLLOW :: Word32
235-- | If the pathname to be watched is a symbolic link then watch the target of
236-- the symbolic link instead of the symbolic link itself.
237--
238-- Note that the path location in the events is through the original symbolic
239-- link path rather than the resolved path.
240--
241-- /default: True/
242--
243-- /Pre-release/
244--
245setFollowSymLinks :: Bool -> Config -> Config
246setFollowSymLinks s = setFlag iN_DONT_FOLLOW (not s)
248foreign import capi
249 "sys/inotify.h value IN_EXCL_UNLINK" iN_EXCL_UNLINK :: Word32
251-- | If an object moves out of the directory being watched then stop watching
252-- it.
253--
254-- /default: True/
255--
256-- /Pre-release/
257--
258setUnwatchMoved :: Bool -> Config -> Config
259setUnwatchMoved = setFlag iN_EXCL_UNLINK
261#if HAVE_DECL_IN_MASK_CREATE
262foreign import capi
263 "sys/inotify.h value IN_MASK_CREATE" iN_MASK_CREATE :: Word32
264#endif
266foreign import capi
267 "sys/inotify.h value IN_MASK_ADD" iN_MASK_ADD :: Word32
269-- | What to do if a watch already exists when 'openWatch' or 'addToWatch' is
270-- called for a path.
271--
272-- /Pre-release/
273--
274data WhenExists =
275 AddIfExists -- ^ Do not set an existing setting to 'False' only set to 'True'
276 | ReplaceIfExists -- ^ Replace the existing settings with new settings
277#if HAVE_DECL_IN_MASK_CREATE
278 | FailIfExists -- ^ Fail the API
279#endif
281-- | When adding a new path to the watch, specify what to do if a watch already
282-- exists on that path.
283--
284-- /default: FailIfExists/
285--
286-- /Pre-release/
287--
288setWhenExists :: WhenExists -> Config -> Config
289setWhenExists val cfg =
290 case val of
291 AddIfExists -> setFlag iN_MASK_ADD True cfg
292 ReplaceIfExists -> setFlag iN_MASK_ADD False cfg
293#if HAVE_DECL_IN_MASK_CREATE
294 FailIfExists -> setFlag iN_MASK_CREATE True cfg
295#endif
297foreign import capi
298 "sys/inotify.h value IN_ONESHOT" iN_ONESHOT :: Word32
300-- | Watch the object only for one event and then remove it from the watch.
301--
302-- /default: False/
303--
304-- /Pre-release/
305--
306setOneShot :: Bool -> Config -> Config
307setOneShot = setFlag iN_ONESHOT
309foreign import capi
310 "sys/inotify.h value IN_ONLYDIR" iN_ONLYDIR :: Word32
312-- | Watch the object only if it is a directory. This provides a race-free way
313-- to ensure that the watched object is a directory.
314--
315-- /default: False/
316--
317-- /Pre-release/
318--
319setOnlyDir :: Bool -> Config -> Config
320setOnlyDir = setFlag iN_ONLYDIR
322-------------------------------------------------------------------------------
323-- Event types that can occur
324-------------------------------------------------------------------------------
326foreign import capi
327 "sys/inotify.h value IN_DELETE_SELF" iN_DELETE_SELF :: Word32
329-- | Report when the watched path itself gets deleted.
330--
331-- /default: True/
332--
333-- /Pre-release/
334--
335setRootDeleted :: Bool -> Config -> Config
336setRootDeleted = setFlag iN_DELETE_SELF
338foreign import capi
339 "sys/inotify.h value IN_MOVE_SELF" iN_MOVE_SELF :: Word32
341-- | Report when the watched root path itself gets renamed.
342--
343-- /default: True/
344--
345-- /Pre-release/
346--
347setRootMoved :: Bool -> Config -> Config
348setRootMoved = setFlag iN_MOVE_SELF
350-- | Report when the watched root path itself gets deleted or renamed.
351--
352-- /default: True/
353--
354-- /Pre-release/
355--
356setRootPathEvents :: Bool -> Config -> Config
357setRootPathEvents = setFlag (iN_DELETE_SELF .|. iN_MOVE_SELF)
359foreign import capi
360 "sys/inotify.h value IN_ATTRIB" iN_ATTRIB :: Word32
362-- | Report when the metadata e.g. owner, permission modes, modifications times
363-- of an object changes.
364--
365-- /default: True/
366--
367-- /Pre-release/
368--
369setAttrsModified :: Bool -> Config -> Config
370setAttrsModified = setFlag iN_ATTRIB
372foreign import capi
373 "sys/inotify.h value IN_ACCESS" iN_ACCESS :: Word32
375-- | Report when a file is accessed.
376--
377-- /default: True/
378--
379-- /Pre-release/
380--
381setAccessed :: Bool -> Config -> Config
382setAccessed = setFlag iN_ACCESS
384foreign import capi
385 "sys/inotify.h value IN_OPEN" iN_OPEN :: Word32
387-- | Report when a file is opened.
388--
389-- /default: True/
390--
391-- /Pre-release/
392--
393setOpened :: Bool -> Config -> Config
394setOpened = setFlag iN_OPEN
396foreign import capi
397 "sys/inotify.h value IN_CLOSE_WRITE" iN_CLOSE_WRITE :: Word32
399-- | Report when a file that was opened for writes is closed.
400--
401-- /default: True/
402--
403-- /Pre-release/
404--
405setWriteClosed :: Bool -> Config -> Config
406setWriteClosed = setFlag iN_CLOSE_WRITE
408foreign import capi
409 "sys/inotify.h value IN_CLOSE_NOWRITE" iN_CLOSE_NOWRITE :: Word32
411-- | Report when a file that was opened for not writing is closed.
412--
413-- /default: True/
414--
415-- /Pre-release/
416--
417setNonWriteClosed :: Bool -> Config -> Config
418setNonWriteClosed = setFlag iN_CLOSE_NOWRITE
420foreign import capi
421 "sys/inotify.h value IN_CREATE" iN_CREATE :: Word32
423-- | Report when a file is created.
424--
425-- /default: True/
426--
427-- /Pre-release/
428--
429setCreated :: Bool -> Config -> Config
430setCreated = setFlag iN_CREATE
432foreign import capi
433 "sys/inotify.h value IN_DELETE" iN_DELETE :: Word32
435-- | Report when a file is deleted.
436--
437-- /default: True/
438--
439-- /Pre-release/
440--
441setDeleted :: Bool -> Config -> Config
442setDeleted = setFlag iN_DELETE
444foreign import capi
445 "sys/inotify.h value IN_MOVED_FROM" iN_MOVED_FROM :: Word32
447-- | Report the source of a move.
448--
449-- /default: True/
450--
451-- /Pre-release/
452--
453setMovedFrom :: Bool -> Config -> Config
454setMovedFrom = setFlag iN_MOVED_FROM
456foreign import capi
457 "sys/inotify.h value IN_MOVED_TO" iN_MOVED_TO :: Word32
459-- | Report the target of a move.
460--
461-- /default: True/
462--
463-- /Pre-release/
464--
465setMovedTo :: Bool -> Config -> Config
466setMovedTo = setFlag iN_MOVED_TO
468foreign import capi
469 "sys/inotify.h value IN_MODIFY" iN_MODIFY :: Word32
471-- | Report when a file is modified.
472--
473-- /default: True/
474--
475-- /Pre-release/
476--
477setModified :: Bool -> Config -> Config
478setModified = setFlag iN_MODIFY
480-- | Set all tunable events 'True' or 'False'. Equivalent to setting:
481--
482-- * setRootDeleted
483-- * setRootMoved
484-- * setAttrsModified
485-- * setAccessed
486-- * setOpened
487-- * setWriteClosed
488-- * setNonWriteClosed
489-- * setCreated
490-- * setDeleted
491-- * setMovedFrom
492-- * setMovedTo
493-- * setModified
494--
495-- /Pre-release/
496--
497setAllEvents :: Bool -> Config -> Config
498setAllEvents s =
499 setRootDeleted s
500 . setRootMoved s
501 . setAttrsModified s
502 . setAccessed s
503 . setOpened s
504 . setWriteClosed s
505 . setNonWriteClosed s
506 . setCreated s
507 . setDeleted s
508 . setMovedFrom s
509 . setMovedTo s
510 . setModified s
512-------------------------------------------------------------------------------
513-- Default config
514-------------------------------------------------------------------------------
516-- The defaults are set in such a way that the behavior on macOS and Linux is
517-- as much compatible as possible.
518--
519-- | The default configuration settings are:
520--
521-- * 'setFollowSymLinks' 'True'
522-- * 'setUnwatchMoved' 'True'
523-- * 'setOneShot' 'False'
524-- * 'setOnlyDir' 'False'
525-- * 'setWhenExists' 'AddIfExists'
526--
527-- The tunable events enabled by default are:
528--
529-- * setCreated True
530-- * setDeleted True
531-- * setMovedFrom True
532-- * setMovedTo True
533-- * setModified True
534--
535-- /Pre-release/
536--
537defaultConfig :: Config
538defaultConfig =
539 setWhenExists AddIfExists
540 $ setCreated True
541 $ setDeleted True
542 $ setMovedFrom True
543 $ setMovedTo True
544 $ setModified True
545 $ Config
546 { watchRec = False
547 , createFlags = 0
548 }
550-------------------------------------------------------------------------------
551-- Open an event stream
552-------------------------------------------------------------------------------
554-- | A handle for a watch.
555data Watch =
556 Watch
557 Handle -- File handle for the watch
558 (IORef
559 (IntMap -- Key is the watch descriptor
560 ( Array Word8 -- Absolute path of the watch root
561 , Array Word8 -- Path of subdir relative to watch root
562 )
563 )
564 )
566-- Instead of using the watch descriptor we can provide APIs that use the path
567-- itself to identify the watch. That will require us to maintain a map from wd
568-- to path in the Watch handle.
570newtype WD = WD CInt deriving Show
572foreign import ccall unsafe
573 "sys/inotify.h inotify_init" c_inotify_init :: IO CInt
575-- | Create a 'Watch' handle. 'addToWatch' can be used to add paths being
576-- monitored by this watch.
577--
578-- /Pre-release/
579--
580createWatch :: IO Watch
581createWatch = do
582 rawfd <- throwErrnoIfMinus1 "createWatch" c_inotify_init
583 -- we could use fdToHandle but it cannot determine the fd type
584 -- automatically for the inotify fd
585 (fd, fdType) <-
586 mkFD
587 rawfd
588 ReadMode
589 (Just (Stream, 0, 0)) -- (IODeviceType, CDev, CIno)
590 False -- not a socket
591 False -- non-blocking is false
592 let fdString = "<createWatch file descriptor: " ++ show fd ++ ">"
593 h <-
594 mkHandleFromFD
595 fd
596 fdType
597 fdString
598 ReadMode
599 True -- use non-blocking IO
600 Nothing -- TextEncoding (binary)
601 emptyMapRef <- newIORef Map.empty
602 return $ Watch h emptyMapRef
604foreign import ccall unsafe
605 "sys/inotify.h inotify_add_watch" c_inotify_add_watch
606 :: CInt -> CString -> CUInt -> IO CInt
608-- XXX we really do not know the path encoding, all we know is that it is "/"
609-- separated bytes. So these may fail or convert the path in an unexpected
610-- manner. We should ultimately remove all usage of these.
612toUtf8 :: MonadIO m => String -> m (Array Word8)
613toUtf8 = A.fromStream . U.encodeUtf8 . S.fromList
615utf8ToString :: Array Word8 -> String
616utf8ToString = runIdentity . S.fold FL.toList . U.decodeUtf8' . A.read
618-- | Add a trailing "/" at the end of the path if there is none. Do not add a
619-- "/" if the path is empty.
620--
621ensureTrailingSlash :: Array Word8 -> Array Word8
622ensureTrailingSlash path =
623 if byteLength path /= 0
624 then
625 let mx = A.getIndex (byteLength path - 1) path
626 in case mx of
627 Nothing -> error "ensureTrailingSlash: Bug: Invalid index"
628 Just x ->
629 if x /= forwardSlashByte
630 then path <> forwardSlash
631 else path
632 else path
633 where forwardSlash = A.fromList [ forwardSlashByte ]
634 forwardSlashByte = fromIntegral (ord '/')
636removeTrailingSlash :: Array Word8 -> Array Word8
637removeTrailingSlash path =
638 if byteLength path /= 0
639 then
640 let n = byteLength path - 1
641 mx = A.getIndex n path
642 in case mx of
643 Nothing -> error "removeTrailingSlash: Bug: Invalid index"
644 Just x ->
645 if x == fromIntegral (ord '/')
646 then A.getSliceUnsafe 0 n path
647 else path
648 else path
650appendPaths :: Array Word8 -> Array Word8 -> Array Word8
651appendPaths a b
652 | byteLength a == 0 = b
653 | byteLength b == 0 = a
654 | otherwise = ensureTrailingSlash a <> b
656-- | @addToWatch cfg watch root subpath@ adds @subpath@ to the list of paths
657-- being monitored under @root@ via the watch handle @watch@. @root@ must be
658-- an absolute path and @subpath@ must be relative to @root@.
659--
660-- /Pre-release/
661--
662addToWatch :: Config -> Watch -> Array Word8 -> Array Word8 -> IO ()
663addToWatch cfg@Config{..} watch0@(Watch handle wdMap) root0 path0 = do
664 -- XXX do not add if the path is already added
665 -- XXX if the watch is added by the scan and not via an event we can
666 -- generate a create event assuming that the create may have been lost. We
667 -- can also mark in the map that this entry was added by the scan. So if an
668 -- actual create event later comes and tries to add this again then we can
669 -- ignore that and drop the create event to avoid duplicate create, because
670 -- we have already emitted it.
671 --
672 -- When a directory is added by the scan we should also emit create events
673 -- for files that may have got added to the dir. However, such create
674 -- events may get duplicated because of a race between the scan generated
675 -- versus real events.
676 --
677 -- Or we may distinguish between scan generated events and real events so
678 -- that the application can assume that other events may been lost and
679 -- handle it. For example, if it is a dir create the application can read
680 -- the dir to scan the files in it.
681 --
682 let root = removeTrailingSlash root0
683 path = removeTrailingSlash path0
684 absPath = appendPaths root path
685 putStrLn $ "root = " ++ utf8ToString root ++ " path = " ++ utf8ToString path ++ " absPath = " ++ utf8ToString absPath
687 fd <- handleToFd handle
689 -- XXX we need to tolerate an error where we are adding a watch for a
690 -- non-existing file because the file may have got deleted by the time we
691 -- added the watch. Perhaps we can have a flag in config for this and keep
692 -- the default value to tolerate the error.
693 --
694 -- XXX The file may have even got deleted and then recreated which we will
695 -- never get to know, document this.
696 wd <- A.asCStringUnsafe absPath $ \pathPtr ->
697 throwErrnoIfMinus1 ("addToWatch: " ++ utf8ToString absPath) $
698 c_inotify_add_watch (fdFD fd) pathPtr (CUInt createFlags)
700 -- We add the parent first so that we start getting events for any new
701 -- creates and add the new subdirectories on creates while we are adding
702 -- the children.
703 modifyIORef wdMap (Map.insert (fromIntegral wd) (root, path))
705 -- Now add the children. If we missed any creates while we were adding the
706 -- parent, this will make sure they are added too.
707 --
708 -- XXX Ensure that we generate events that we may have missed while we were
709 -- adding the dirs. That may generate spurious events though.
710 --
711 -- XXX readDirs currently uses paths as String, we need to convert it
712 -- to "/" separated by byte arrays.
713 pathIsDir <- doesDirectoryExist $ utf8ToString absPath
714 when (watchRec && pathIsDir) $ do
715 let f = addToWatch cfg watch0 root . appendPaths path
716 in S.fold (FL.drainMapM f)
717 $ S.mapM toUtf8
718 $ Dir.readDirs $ utf8ToString absPath
720foreign import ccall unsafe
721 "sys/inotify.h inotify_rm_watch" c_inotify_rm_watch
722 :: CInt -> CInt -> IO CInt
724-- | Remove an absolute root path from a 'Watch', if a path was moved after
725-- adding you need to provide the original path which was used to add the
726-- Watch.
727--
728-- /Pre-release/
729--
730removeFromWatch :: Watch -> Array Word8 -> IO ()
731removeFromWatch (Watch handle wdMap) path = do
732 fd <- handleToFd handle
733 km <- readIORef wdMap
734 wdMap1 <- foldlM (step fd) Map.empty (Map.toList km)
735 writeIORef wdMap wdMap1
737 where
739 step fd newMap (wd, v) = do
740 if fst v == path
741 then do
742 let err = "removeFromWatch: " ++ show (utf8ToString path)
743 rm = c_inotify_rm_watch (fdFD fd) (fromIntegral wd)
744 void $ throwErrnoIfMinus1 err rm
745 return newMap
746 else return $ Map.insert wd v newMap
748-- | Given a 'Config' and list of @paths@ ("/" separated byte arrays) start
749-- monitoring the paths for file system events. Returns a 'Watch' handle which
750-- can then be used to read the event stream or to close the watch.
751--
752-- /Pre-release/
753--
754openWatch :: Config -> NonEmpty (Array Word8) -> IO Watch
755openWatch cfg paths = do
756 w <- createWatch
757 mapM_
758 (\root -> addToWatch cfg w root (A.fromList []))
759 $ NonEmpty.toList paths
760 return w
762-- | Close a 'Watch' handle.
763--
764-- /Pre-release/
765--
766closeWatch :: Watch -> IO ()
767closeWatch (Watch h _) = hClose h
769-------------------------------------------------------------------------------
770-- Raw events read from the watch file handle
771-------------------------------------------------------------------------------
773newtype Cookie = Cookie Word32 deriving (Show, Eq)
775-- | An Event generated by the file system. Use the accessor functions to
776-- examine the event.
777--
778-- /Pre-release/
779--
780data Event = Event
781 { eventWd :: CInt
782 , eventFlags :: Word32
783 , eventCookie :: Word32
784 , eventRelPath :: Array Word8
785 , eventMap :: IntMap (Array Word8, Array Word8)
786 } deriving (Show, Ord, Eq)
788-- The inotify event struct from the man page/header file:
789--
790-- struct inotify_event {
791-- int wd; /* Watch descriptor */
792-- uint32_t mask; /* Mask describing event */
793-- uint32_t cookie; /* Unique cookie associating related
794-- events (for rename(2)) */
795-- uint32_t len; /* Size of name field */
796-- char name[]; /* Optional null-terminated name */
797-- };
798--
799-- XXX We can perhaps use parseD monad instance for fusing with parseMany? Need
800-- to measure the perf.
801--
802readOneEvent :: Config -> Watch -> Parser Word8 IO Event
803readOneEvent cfg wt@(Watch _ wdMap) = do
804 let headerLen = sizeOf (undefined :: CInt) + 12
805 arr <- PR.takeEQ headerLen (A.writeN headerLen)
806 (ewd, eflags, cookie, pathLen) <- PR.fromEffect $ A.asPtrUnsafe arr readHeader
807 -- XXX need the "initial" in parsers to return a step type so that "take 0"
808 -- can return without an input. otherwise if pathLen is 0 we will keep
809 -- waiting to read one more char before we return this event.
810 path <-
811 if pathLen /= 0
812 then do
813 -- XXX takeEndBy_ drops the separator so assumes a null
814 -- terminated path, we should use a takeWhile nested inside a
815 -- takeP
816 pth <-
817 PR.fromFold
818 $ FL.takeEndBy_ (== 0)
819 $ FL.take pathLen (A.writeN pathLen)
820 let remaining = pathLen - byteLength pth - 1
821 when (remaining /= 0) $ PR.takeEQ remaining FL.drain
822 return pth
823 else return $ A.fromList []
824 wdm <- PR.fromEffect $ readIORef wdMap
825 let (root, sub) =
826 case Map.lookup (fromIntegral ewd) wdm of
827 Just pair -> pair
828 Nothing ->
829 error $ "readOneEvent: "
830 <> "Unknown watch descriptor: "
831 <> show ewd
832 let sub1 = appendPaths sub path
833 -- Check for "ISDIR" first because it is less likely
834 isDirCreate = eflags .&. iN_ISDIR /= 0 && eflags .&. iN_CREATE /= 0
835 when (watchRec cfg && isDirCreate)
836 $ PR.fromEffect $ addToWatch cfg wt root sub1
837 -- XXX Handle IN_DELETE, IN_DELETE_SELF, IN_MOVE_SELF, IN_MOVED_FROM,
838 -- IN_MOVED_TO
839 -- What if a large dir tree gets moved in to our hierarchy? Do we get a
840 -- single event for the top level dir in this case?
841 return $ Event
842 { eventWd = fromIntegral ewd
843 , eventFlags = eflags
844 , eventCookie = cookie
845 , eventRelPath = sub1
846 , eventMap = wdm
847 }
849 where
851 readHeader (ptr :: Ptr Word8) = do
852 let len = sizeOf (undefined :: CInt)
853 ewd <- peek ptr
854 eflags <- peekByteOff ptr len
855 cookie <- peekByteOff ptr (len + 4)
856 pathLen :: Word32 <- peekByteOff ptr (len + 8)
857 return (ewd, eflags, cookie, fromIntegral pathLen)
859watchToStream :: Config -> Watch -> Stream IO Event
860watchToStream cfg wt@(Watch handle _) = do
861 -- Do not use too small a buffer. As per inotify man page:
862 --
863 -- The behavior when the buffer given to read(2) is too small to return
864 -- information about the next event depends on the kernel version: in
865 -- kernels before 2.6.21, read(2) returns 0; since kernel 2.6.21, read(2)
866 -- fails with the error EINVAL. Specifying a buffer of size
867 --
868 -- sizeof(struct inotify_event) + NAME_MAX + 1
869 --
870 -- will be sufficient to read at least one event.
871 S.catRights $ S.parseMany (readOneEvent cfg wt) $ S.unfold FH.reader handle
873-- XXX We should not go across the mount points of network file systems or file
874-- systems that are known to not generate any events.
875--
876-- | Start monitoring a list of file system paths for file system events with
877-- the supplied configuration operation over the 'defaultConfig'. The
878-- paths could be files or directories. When recursive mode is set and the
879-- path is a directory, the whole directory tree under it is watched
880-- recursively. Monitoring starts from the current time onwards. The paths are
881-- specified as UTF-8 encoded 'Array' of 'Word8'.
882--
883-- /Non-existing Paths:/ the API fails if a watch is started on a non-exsting
884-- path.
885--
886-- /Performance:/ Note that recursive watch on a large directory tree could be
887-- expensive. When starting a watch, the whole tree must be read and watches
888-- are started on each directory in the tree. The initial time to start the
889-- watch as well as the memory required is proportional to the number of
890-- directories in the tree.
891--
892-- /Bugs:/ When new directories are created under the tree they are added to
893-- the watch on receiving the directory create event. However, the creation of
894-- a dir and adding a watch for it is not atomic. The implementation takes
895-- care of this and makes sure that watches are added for all directories.
896-- However, In the mean time, the directory may have received more events which
897-- may get lost. Handling of any such lost events is yet to be implemented.
898--
899-- See the Linux __inotify__ man page for more details.
900--
901-- @
902-- watchwith
903-- ('setFollowSymLinks' True . 'setUnwatchMoved' False)
904-- [Array.fromList "dir"]
905-- @
906--
907-- /Pre-release/
908--
909watchWith :: (Config -> Config) -> NonEmpty (Array Word8) -> Stream IO Event
910watchWith f paths = S.bracketIO before after (watchToStream cfg)
912 where
914 cfg = f defaultConfig
915 before = openWatch cfg paths
916 after = closeWatch
918-- | Same as 'watchWith' using 'defaultConfig' and recursive mode.
919--
920-- >>> watchRecursive = watchWith (setRecursiveMode True)
921--
922-- See 'watchWith' for pitfalls and bugs when using recursive watch on Linux.
923--
924-- /Pre-release/
925--
926watchRecursive :: NonEmpty (Array Word8) -> Stream IO Event
927watchRecursive = watchWith (setRecursiveMode True)
929-- | Same as 'watchWith' using defaultConfig and non-recursive mode.
930--
931-- >>> watch = watchWith id
932--
933-- /Pre-release/
934--
935watch :: NonEmpty (Array Word8) -> Stream IO Event
936watch = watchWith id
938-------------------------------------------------------------------------------
939-- Examine event stream
940-------------------------------------------------------------------------------
942-- | Get the watch root corresponding to the 'Event'.
943--
944-- Note that if a path was moved after adding to the watch, this will give the
945-- original path and not the new path after moving.
946--
947-- TBD: we can possibly update the watch root on a move self event.
948--
949-- /Pre-release/
950--
951getRoot :: Event -> Array Word8
952getRoot Event{..} =
953 if eventWd >= 1
954 then
955 case Map.lookup (fromIntegral eventWd) eventMap of
956 Just path -> fst path
957 Nothing ->
958 error $ "Bug: getRoot: No path found corresponding to the "
959 ++ "watch descriptor " ++ show eventWd
960 else A.fromList []
962-- XXX should we use a Maybe here?
963-- | Get the file system object path for which the event is generated, relative
964-- to the watched root. The path is a "/" separated array of bytes.
965--
966-- /Pre-release/
967--
968getRelPath :: Event -> Array Word8
969getRelPath Event{..} = eventRelPath
971-- | Get the absolute file system object path for which the event is generated.
972--
973-- When the watch root is a symlink, the absolute path returned is via the
974-- original symlink and not through the resolved path.
975--
976-- /Pre-release/
977--
978getAbsPath :: Event -> Array Word8
979getAbsPath ev =
980 let relpath = getRelPath ev
981 root = getRoot ev
982 in if byteLength relpath /= 0
983 then ensureTrailingSlash root <> relpath
984 else removeTrailingSlash root
986-- XXX should we use a Maybe?
987-- | Cookie is set when a rename occurs. The cookie value can be used to
988-- connect the 'isMovedFrom' and 'isMovedTo' events, if both the events belong
989-- to the same move operation then they will have the same cookie value.
990--
991-- /Pre-release/
992--
993getCookie :: Event -> Cookie
994getCookie Event{..} = Cookie eventCookie
996-------------------------------------------------------------------------------
997-- Event types
998-------------------------------------------------------------------------------
1000getFlag :: Word32 -> Event -> Bool
1001getFlag mask Event{..} = eventFlags .&. mask /= 0
1003-------------------------------------------------------------------------------
1004-- Error events
1005-------------------------------------------------------------------------------
1007foreign import capi
1008 "sys/inotify.h value IN_Q_OVERFLOW" iN_Q_OVERFLOW :: Word32
1010-- XXX rename to isQOverflowed or hasOverflowed?
1012-- macOS overflow API is more specific, it tells which paths have lost the
1013-- events due to overflow.
1015-- | Event queue overflowed (WD is invalid for this event) and we may have lost
1016-- some events.. The user application must scan everything under the watched
1017-- paths to know the current state.
1019-- /Pre-release/
1021isEventsLost :: Event -> Bool
1022isEventsLost = getFlag iN_Q_OVERFLOW
1024-------------------------------------------------------------------------------
1025-- Events affecting the watched path only
1026-------------------------------------------------------------------------------
1028foreign import capi
1029 "sys/inotify.h value IN_IGNORED" iN_IGNORED :: Word32
1031-- Compare with isRootChanged on macOS. isRootChanged includes all these cases.
1033-- | A path was removed from the watch explicitly using 'removeFromWatch' or
1034-- automatically (file was deleted, or filesystem was unmounted).
1036-- Note that in recursive watch mode all the subdirectories are watch roots,
1037-- therefore, they will all generate this event.
1039-- /Occurs only for a watched path/
1041-- /Pre-release/
1043isRootUnwatched :: Event -> Bool
1044isRootUnwatched = getFlag iN_IGNORED
1046-- | Watched file/directory was itself deleted. (This event also occurs if an
1047-- object is moved to another filesystem, since mv(1) in effect copies the file
1048-- to the other filesystem and then deletes it from the original filesystem.)
1049-- In addition, an 'isRootUnwatched' event will subsequently be generated
1050-- for the watch descriptor.
1052-- Note that in recursive watch mode all the subdirectories are watch roots,
1053-- therefore, they will all generate this event.
1055-- /Occurs only for a watched path/
1057-- /Pre-release/
1059isRootDeleted :: Event -> Bool
1060isRootDeleted = getFlag iN_DELETE_SELF
1062-- | Watched file/directory was itself moved within the file system.
1064-- Note that in recursive watch mode all the subdirectories are watch roots,
1065-- therefore, they will all generate this event.
1067-- /Occurs only for a watched path/
1069-- /Pre-release/
1071isRootMoved :: Event -> Bool
1072isRootMoved = getFlag iN_MOVE_SELF
1074foreign import capi
1075 "sys/inotify.h value IN_UNMOUNT" iN_UNMOUNT :: Word32
1077-- | Filesystem containing watched object was unmounted. In addition, an
1078-- 'isRootUnwatched' event will subsequently be generated for the watch
1079-- descriptor.
1081-- /Occurs only for a watched path/
1083-- /Pre-release/
1085isRootUnmounted :: Event -> Bool
1086isRootUnmounted = getFlag iN_UNMOUNT
1088-- | Determine whether the event indicates a change of path of the monitored
1089-- object itself. Note that the object may become unreachable or deleted after
1090-- a change of path.
1092-- /Occurs only for a watched path/
1094-- /Pre-release/
1096isRootPathEvent :: Event -> Bool
1097isRootPathEvent = getFlag (iN_DELETE_SELF .|. iN_MOVE_SELF .|. iN_UNMOUNT)
1099-------------------------------------------------------------------------------
1100-- Metadata change Events
1101-------------------------------------------------------------------------------
1103-- macOS has multiple APIs for metadata change for different metadata.
1105-- | Determine whether the event indicates inode metadata change for an object
1106-- contained within the monitored path.
1108-- Metadata change may include, permissions (e.g., chmod(2)), timestamps
1109-- (e.g., utimensat(2)), extended attributes (setxattr(2)), link count (since
1110-- Linux 2.6.25; e.g., for the target of link(2) and for unlink(2)), and
1111-- user/group ID (e.g., chown(2)).
1113-- /Can occur for watched path or a file inside it/
1115-- /Pre-release/
1117isAttrsModified :: Event -> Bool
1118isAttrsModified = getFlag iN_ATTRIB
1120-------------------------------------------------------------------------------
1121-- Access
1122-------------------------------------------------------------------------------
1124-- | File was accessed (e.g. read, execve).
1126-- /Occurs only for a file inside the watched directory/
1128-- /Pre-release/
1130isAccessed :: Event -> Bool
1131isAccessed = getFlag iN_ACCESS
1133-- | File or directory was opened.
1135-- /Occurs only for a file inside the watched directory/
1137-- /Pre-release/
1139isOpened :: Event -> Bool
1140isOpened = getFlag iN_OPEN
1142-- | File opened for writing was closed.
1144-- /Occurs only for a file inside the watched directory/
1146-- /Pre-release/
1148isWriteClosed :: Event -> Bool
1149isWriteClosed = getFlag iN_CLOSE_WRITE
1151-- XXX what if it was opened for append? Does NOWRITE mean all cases where the
1152-- mode was not write? A dir open comes in this category?
1154-- | File or directory opened for read but not write was closed.
1156-- /Can occur for watched path or a file inside it/
1158-- /Pre-release/
1160isNonWriteClosed :: Event -> Bool
1161isNonWriteClosed = getFlag iN_CLOSE_NOWRITE
1163-------------------------------------------------------------------------------
1164-- CRUD Events
1165-------------------------------------------------------------------------------
1167-- On macOS this is not generated on hard linking but on Linux it is.
1169-- | File/directory created in watched directory (e.g., open(2) O_CREAT,
1170-- mkdir(2), link(2), symlink(2), bind(2) on a UNIX domain socket).
1172-- /Occurs only for an object inside the watched directory/
1174-- /Pre-release/
1176isCreated :: Event -> Bool
1177isCreated = getFlag iN_CREATE
1179-- | File/directory deleted from watched directory.
1181-- /Occurs only for an object inside the watched directory/
1183-- /Pre-release/
1185isDeleted :: Event -> Bool
1186isDeleted = getFlag iN_DELETE
1188-- XXX what if an object is moved in from outside or moved out of the monitored
1189-- dir?
1191-- | Generated for the original path when an object is moved from under a
1192-- monitored directory.
1194-- /Occurs only for an object inside the watched directory/
1196-- /Pre-release/
1198isMovedFrom :: Event -> Bool
1199isMovedFrom = getFlag iN_MOVED_FROM
1201-- | Generated for the new path when an object is moved under a monitored
1202-- directory.
1204-- /Occurs only for an object inside the watched directory/
1206-- /Pre-release/
1208isMovedTo :: Event -> Bool
1209isMovedTo = getFlag iN_MOVED_TO
1211-- | Generated for a path that is moved from or moved to the monitored
1212-- directory.
1214-- >>> isMoved ev = isMovedFrom ev || isMovedTo ev
1216-- /Occurs only for an object inside the watched directory/
1218-- /Pre-release/
1220isMoved :: Event -> Bool
1221isMoved ev = isMovedFrom ev || isMovedTo ev
1223-- | Determine whether the event indicates modification of an object within the
1224-- monitored path. This event is generated only for files and not directories.
1226-- /Occurs only for an object inside the watched directory/
1228-- /Pre-release/
1230isModified :: Event -> Bool
1231isModified = getFlag iN_MODIFY
1233-------------------------------------------------------------------------------
1234-- Information about path type (applicable only when 'setFileEvents' is 'True')
1235-------------------------------------------------------------------------------
1237foreign import capi
1238 "sys/inotify.h value IN_ISDIR" iN_ISDIR :: Word32
1240-- | Determine whether the event is for a directory path.
1242-- /Pre-release/
1244isDir :: Event -> Bool
1245isDir = getFlag iN_ISDIR
1247-------------------------------------------------------------------------------
1248-- Debugging
1249-------------------------------------------------------------------------------
1251-- | Convert an 'Event' record to a String representation.
1252showEvent :: Event -> String
1253showEvent ev@Event{..} =
1254 "--------------------------"
1255 ++ "\nWd = " ++ show eventWd
1256 ++ "\nRoot = " ++ show (utf8ToString $ getRoot ev)
1257 ++ "\nPath = " ++ show (utf8ToString $ getRelPath ev)
1258 ++ "\nCookie = " ++ show (getCookie ev)
1259 ++ "\nFlags " ++ show eventFlags
1261 ++ showev isEventsLost "Overflow"
1263 ++ showev isRootUnwatched "RootUnwatched"
1264 ++ showev isRootDeleted "RootDeleted"
1265 ++ showev isRootMoved "RootMoved"
1266 ++ showev isRootUnmounted "RootUnmounted"
1268 ++ showev isAttrsModified "AttrsModified"
1270 ++ showev isAccessed "Accessed"
1271 ++ showev isOpened "Opened"
1272 ++ showev isWriteClosed "WriteClosed"
1273 ++ showev isNonWriteClosed "NonWriteClosed"
1275 ++ showev isCreated "Created"
1276 ++ showev isDeleted "Deleted"
1277 ++ showev isModified "Modified"
1278 ++ showev isMovedFrom "MovedFrom"
1279 ++ showev isMovedTo "MovedTo"
1281 ++ showev isDir "Dir"
1282 ++ "\n"
1284 where showev f str = if f ev then "\n" ++ str else ""
1285#else
1286#warning "Disabling module Streamly.Internal.FileSystem.Event.Linux. Does not support kernels older than 2.6.36."
1287module Streamly.Internal.FileSystem.Event.Linux () where
1288#endif