on e856425 help sign in
1299 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 , Switch (..)
68 , defaultConfig
70 -- ** Watch Behavior
71 , setRecursiveMode
72 , setFollowSymLinks
73 , setUnwatchMoved
74 , setOneShot
75 , setOnlyDir
76 , WhenExists (..)
77 , setWhenExists
79 -- ** Events of Interest
80 -- *** Root Path Events
81 , setRootDeleted
82 , setRootMoved
83 , setRootPathEvents
85 -- *** Item Level Metadata change
86 , setAttrsModified
88 -- *** Item Level Access
89 , setAccessed
90 , setOpened
91 , setWriteClosed
92 , setNonWriteClosed
94 -- *** Item CRUD events
95 , setCreated
96 , setDeleted
97 , setMovedFrom
98 , setMovedTo
99 , setModified
101 , setAllEvents
103 -- ** Watch APIs
104 , watch
105 , watchRecursive
106 , watchWith
108 -- Low level watch APIs
109 , addToWatch
110 , removeFromWatch
112 -- * Handling Events
113 , Event(..)
114 , getRoot
115 , getRelPath
116 , getAbsPath
117 , getCookie
119 -- ** Root Level Events
120 , isRootPathEvent
121 , isRootUnwatched
122 , isRootDeleted
123 , isRootMoved
124 , isRootUnmounted
126 -- ** Item Level Metadata change
127 , isAttrsModified
129 -- ** Item Level Access
130 , isAccessed
131 , isOpened
132 , isWriteClosed
133 , isNonWriteClosed
135 -- ** Item Level CRUD events
136 , isCreated
137 , isDeleted
138 , isMovedFrom
139 , isMovedTo
140 , isMoved
141 , isModified
143 -- ** Item Path info
144 , isDir
146 -- ** Exception Conditions
147 , isEventsLost
149 -- * Debugging
150 , showEvent
151 )
152where
154import Control.Monad (void, when)
155import Control.Monad.IO.Class (MonadIO, liftIO)
156import Data.Bits ((.|.), (.&.), complement)
157import Data.Char (ord)
158import Data.Foldable (foldlM)
159import Data.Functor.Identity (runIdentity)
160import Data.IntMap.Lazy (IntMap)
161import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef)
162import Data.List.NonEmpty (NonEmpty)
163#if !(MIN_VERSION_base(4,13,0))
164import Data.Semigroup (Semigroup(..))
165#endif
166import Data.Word (Word8, Word32)
167import Foreign.C.Error (throwErrnoIfMinus1)
168import Foreign.C.String (CString)
169import Foreign.C.Types (CInt(..), CUInt(..))
170import Foreign.Ptr (Ptr)
171import Foreign.Storable (peek, peekByteOff, sizeOf)
172import GHC.IO.Device (IODeviceType(Stream))
173import GHC.IO.FD (fdFD, mkFD)
174import GHC.IO.Handle.FD (mkHandleFromFD)
175import Streamly.Internal.Data.Stream (Stream)
176import Streamly.Internal.Data.Parser (Parser)
177import Streamly.Internal.Data.Array.Unboxed.Type (Array(..), byteLength)
178import System.Directory (doesDirectoryExist)
179import System.IO (Handle, hClose, IOMode(ReadMode))
180import GHC.IO.Handle.FD (handleToFd)
182import qualified Data.IntMap.Lazy as Map
183import qualified Data.List.NonEmpty as NonEmpty
184import qualified Streamly.Internal.Data.Array.Unboxed as A
185import qualified Streamly.Data.Fold as FL
186import qualified Streamly.Internal.Data.Parser as PR
187 (takeEQ, fromEffect, fromFold)
188import qualified Streamly.Internal.Data.Stream as S
189import qualified Streamly.Internal.FileSystem.Dir as Dir
190import qualified Streamly.Internal.FileSystem.Handle as FH
191import qualified Streamly.Internal.Unicode.Stream as U
193-------------------------------------------------------------------------------
194-- Subscription to events
195-------------------------------------------------------------------------------
197-- | Watch configuration, used to specify the events of interest and the
198-- behavior of the watch.
199--
200-- /Pre-release/
201--
202data Config = Config
203 { watchRec :: Bool
204 , createFlags :: Word32
205 }
207-------------------------------------------------------------------------------
208-- Boolean settings
209-------------------------------------------------------------------------------
211-- | Whether a setting is 'On' or 'Off'.
212--
213-- /Pre-release/
214--
215data Switch = On | Off deriving (Show, Eq)
217toggle :: Switch -> Switch
218toggle On = Off
219toggle Off = On
221setFlag :: Word32 -> Switch -> Config -> Config
222setFlag mask status cfg@Config{..} =
223 let flags =
224 case status of
225 On -> createFlags .|. mask
226 Off -> createFlags .&. complement mask
227 in cfg {createFlags = flags}
229-------------------------------------------------------------------------------
230-- Settings
231-------------------------------------------------------------------------------
233-- | Watch the whole directory tree recursively instead of watching just one
234-- level of directory.
235--
236-- /default: Off/
237--
238-- /Pre-release/
239--
240setRecursiveMode :: Switch -> Config -> Config
241setRecursiveMode rec cfg@Config{} = cfg {watchRec = rec == On}
243foreign import capi
244 "sys/inotify.h value IN_DONT_FOLLOW" iN_DONT_FOLLOW :: Word32
246-- | If the pathname to be watched is a symbolic link then watch the target of
247-- the symbolic link instead of the symbolic link itself.
248--
249-- Note that the path location in the events is through the original symbolic
250-- link path rather than the resolved path.
251--
252-- /default: On/
253--
254-- /Pre-release/
255--
256setFollowSymLinks :: Switch -> Config -> Config
257setFollowSymLinks s = setFlag iN_DONT_FOLLOW (toggle s)
259foreign import capi
260 "sys/inotify.h value IN_EXCL_UNLINK" iN_EXCL_UNLINK :: Word32
262-- | If an object moves out of the directory being watched then stop watching
263-- it.
264--
265-- /default: On/
266--
267-- /Pre-release/
268--
269setUnwatchMoved :: Switch -> Config -> Config
270setUnwatchMoved = setFlag iN_EXCL_UNLINK
272#if HAVE_DECL_IN_MASK_CREATE
273foreign import capi
274 "sys/inotify.h value IN_MASK_CREATE" iN_MASK_CREATE :: Word32
275#endif
277foreign import capi
278 "sys/inotify.h value IN_MASK_ADD" iN_MASK_ADD :: Word32
280-- | What to do if a watch already exists when 'openWatch' or 'addToWatch' is
281-- called for a path.
282--
283-- /Pre-release/
284--
285data WhenExists =
286 AddIfExists -- ^ Do not set an existing setting to 'Off' only set to 'On'
287 | ReplaceIfExists -- ^ Replace the existing settings with new settings
288#if HAVE_DECL_IN_MASK_CREATE
289 | FailIfExists -- ^ Fail the API
290#endif
292-- | When adding a new path to the watch, specify what to do if a watch already
293-- exists on that path.
294--
295-- /default: FailIfExists/
296--
297-- /Pre-release/
298--
299setWhenExists :: WhenExists -> Config -> Config
300setWhenExists val cfg =
301 case val of
302 AddIfExists -> setFlag iN_MASK_ADD On cfg
303 ReplaceIfExists -> setFlag iN_MASK_ADD Off cfg
304#if HAVE_DECL_IN_MASK_CREATE
305 FailIfExists -> setFlag iN_MASK_CREATE On cfg
306#endif
308foreign import capi
309 "sys/inotify.h value IN_ONESHOT" iN_ONESHOT :: Word32
311-- | Watch the object only for one event and then remove it from the watch.
312--
313-- /default: Off/
314--
315-- /Pre-release/
316--
317setOneShot :: Switch -> Config -> Config
318setOneShot = setFlag iN_ONESHOT
320foreign import capi
321 "sys/inotify.h value IN_ONLYDIR" iN_ONLYDIR :: Word32
323-- | Watch the object only if it is a directory. This provides a race-free way
324-- to ensure that the watched object is a directory.
325--
326-- /default: Off/
327--
328-- /Pre-release/
329--
330setOnlyDir :: Switch -> Config -> Config
331setOnlyDir = setFlag iN_ONLYDIR
333-------------------------------------------------------------------------------
334-- Event types that can occur
335-------------------------------------------------------------------------------
337foreign import capi
338 "sys/inotify.h value IN_DELETE_SELF" iN_DELETE_SELF :: Word32
340-- | Report when the watched path itself gets deleted.
341--
342-- /default: On/
343--
344-- /Pre-release/
345--
346setRootDeleted :: Switch -> Config -> Config
347setRootDeleted = setFlag iN_DELETE_SELF
349foreign import capi
350 "sys/inotify.h value IN_MOVE_SELF" iN_MOVE_SELF :: Word32
352-- | Report when the watched root path itself gets renamed.
353--
354-- /default: On/
355--
356-- /Pre-release/
357--
358setRootMoved :: Switch -> Config -> Config
359setRootMoved = setFlag iN_MOVE_SELF
361-- | Report when the watched root path itself gets deleted or renamed.
362--
363-- /default: On/
364--
365-- /Pre-release/
366--
367setRootPathEvents :: Switch -> Config -> Config
368setRootPathEvents = setFlag (iN_DELETE_SELF .|. iN_MOVE_SELF)
370foreign import capi
371 "sys/inotify.h value IN_ATTRIB" iN_ATTRIB :: Word32
373-- | Report when the metadata e.g. owner, permission modes, modifications times
374-- of an object changes.
375--
376-- /default: On/
377--
378-- /Pre-release/
379--
380setAttrsModified :: Switch -> Config -> Config
381setAttrsModified = setFlag iN_ATTRIB
383foreign import capi
384 "sys/inotify.h value IN_ACCESS" iN_ACCESS :: Word32
386-- | Report when a file is accessed.
387--
388-- /default: On/
389--
390-- /Pre-release/
391--
392setAccessed :: Switch -> Config -> Config
393setAccessed = setFlag iN_ACCESS
395foreign import capi
396 "sys/inotify.h value IN_OPEN" iN_OPEN :: Word32
398-- | Report when a file is opened.
399--
400-- /default: On/
401--
402-- /Pre-release/
403--
404setOpened :: Switch -> Config -> Config
405setOpened = setFlag iN_OPEN
407foreign import capi
408 "sys/inotify.h value IN_CLOSE_WRITE" iN_CLOSE_WRITE :: Word32
410-- | Report when a file that was opened for writes is closed.
411--
412-- /default: On/
413--
414-- /Pre-release/
415--
416setWriteClosed :: Switch -> Config -> Config
417setWriteClosed = setFlag iN_CLOSE_WRITE
419foreign import capi
420 "sys/inotify.h value IN_CLOSE_NOWRITE" iN_CLOSE_NOWRITE :: Word32
422-- | Report when a file that was opened for not writing is closed.
423--
424-- /default: On/
425--
426-- /Pre-release/
427--
428setNonWriteClosed :: Switch -> Config -> Config
429setNonWriteClosed = setFlag iN_CLOSE_NOWRITE
431foreign import capi
432 "sys/inotify.h value IN_CREATE" iN_CREATE :: Word32
434-- | Report when a file is created.
435--
436-- /default: On/
437--
438-- /Pre-release/
439--
440setCreated :: Switch -> Config -> Config
441setCreated = setFlag iN_CREATE
443foreign import capi
444 "sys/inotify.h value IN_DELETE" iN_DELETE :: Word32
446-- | Report when a file is deleted.
447--
448-- /default: On/
449--
450-- /Pre-release/
451--
452setDeleted :: Switch -> Config -> Config
453setDeleted = setFlag iN_DELETE
455foreign import capi
456 "sys/inotify.h value IN_MOVED_FROM" iN_MOVED_FROM :: Word32
458-- | Report the source of a move.
459--
460-- /default: On/
461--
462-- /Pre-release/
463--
464setMovedFrom :: Switch -> Config -> Config
465setMovedFrom = setFlag iN_MOVED_FROM
467foreign import capi
468 "sys/inotify.h value IN_MOVED_TO" iN_MOVED_TO :: Word32
470-- | Report the target of a move.
471--
472-- /default: On/
473--
474-- /Pre-release/
475--
476setMovedTo :: Switch -> Config -> Config
477setMovedTo = setFlag iN_MOVED_TO
479foreign import capi
480 "sys/inotify.h value IN_MODIFY" iN_MODIFY :: Word32
482-- | Report when a file is modified.
483--
484-- /default: On/
485--
486-- /Pre-release/
487--
488setModified :: Switch -> Config -> Config
489setModified = setFlag iN_MODIFY
491-- | Set all tunable events 'On' or 'Off'. Equivalent to setting:
492--
493-- * setRootDeleted
494-- * setRootMoved
495-- * setAttrsModified
496-- * setAccessed
497-- * setOpened
498-- * setWriteClosed
499-- * setNonWriteClosed
500-- * setCreated
501-- * setDeleted
502-- * setMovedFrom
503-- * setMovedTo
504-- * setModified
505--
506-- /Pre-release/
507--
508setAllEvents :: Switch -> Config -> Config
509setAllEvents s =
510 setRootDeleted s
511 . setRootMoved s
512 . setAttrsModified s
513 . setAccessed s
514 . setOpened s
515 . setWriteClosed s
516 . setNonWriteClosed s
517 . setCreated s
518 . setDeleted s
519 . setMovedFrom s
520 . setMovedTo s
521 . setModified s
523-------------------------------------------------------------------------------
524-- Default config
525-------------------------------------------------------------------------------
527-- The defaults are set in such a way that the behavior on macOS and Linux is
528-- as much compatible as possible.
529--
530-- | The default configuration settings are:
531--
532-- * 'setFollowSymLinks' 'On'
533-- * 'setUnwatchMoved' 'On'
534-- * 'setOneShot' 'Off'
535-- * 'setOnlyDir' 'Off'
536-- * 'setWhenExists' 'AddIfExists'
537--
538-- The tunable events enabled by default are:
539--
540-- * setCreated On
541-- * setDeleted On
542-- * setMovedFrom On
543-- * setMovedTo On
544-- * setModified On
545--
546-- /Pre-release/
547--
548defaultConfig :: Config
549defaultConfig =
550 setWhenExists AddIfExists
551 $ setCreated On
552 $ setDeleted On
553 $ setMovedFrom On
554 $ setMovedTo On
555 $ setModified On
556 $ Config
557 { watchRec = False
558 , createFlags = 0
559 }
561-------------------------------------------------------------------------------
562-- Open an event stream
563-------------------------------------------------------------------------------
565-- | A handle for a watch.
566data Watch =
567 Watch
568 Handle -- File handle for the watch
569 (IORef
570 (IntMap -- Key is the watch descriptor
571 ( Array Word8 -- Absolute path of the watch root
572 , Array Word8 -- Path of subdir relative to watch root
573 )
574 )
575 )
577-- Instead of using the watch descriptor we can provide APIs that use the path
578-- itself to identify the watch. That will require us to maintain a map from wd
579-- to path in the Watch handle.
581newtype WD = WD CInt deriving Show
583foreign import ccall unsafe
584 "sys/inotify.h inotify_init" c_inotify_init :: IO CInt
586-- | Create a 'Watch' handle. 'addToWatch' can be used to add paths being
587-- monitored by this watch.
588--
589-- /Pre-release/
590--
591createWatch :: IO Watch
592createWatch = do
593 rawfd <- throwErrnoIfMinus1 "createWatch" c_inotify_init
594 -- we could use fdToHandle but it cannot determine the fd type
595 -- automatically for the inotify fd
596 (fd, fdType) <-
597 mkFD
598 rawfd
599 ReadMode
600 (Just (Stream, 0, 0)) -- (IODeviceType, CDev, CIno)
601 False -- not a socket
602 False -- non-blocking is false
603 let fdString = "<createWatch file descriptor: " ++ show fd ++ ">"
604 h <-
605 mkHandleFromFD
606 fd
607 fdType
608 fdString
609 ReadMode
610 True -- use non-blocking IO
611 Nothing -- TextEncoding (binary)
612 emptyMapRef <- newIORef Map.empty
613 return $ Watch h emptyMapRef
615foreign import ccall unsafe
616 "sys/inotify.h inotify_add_watch" c_inotify_add_watch
617 :: CInt -> CString -> CUInt -> IO CInt
619-- XXX we really do not know the path encoding, all we know is that it is "/"
620-- separated bytes. So these may fail or convert the path in an unexpected
621-- manner. We should ultimately remove all usage of these.
623toUtf8 :: MonadIO m => String -> m (Array Word8)
624toUtf8 = A.fromStream . U.encodeUtf8 . S.fromList
626utf8ToString :: Array Word8 -> String
627utf8ToString = runIdentity . S.fold FL.toList . U.decodeUtf8' . A.read
629-- | Add a trailing "/" at the end of the path if there is none. Do not add a
630-- "/" if the path is empty.
631--
632ensureTrailingSlash :: Array Word8 -> Array Word8
633ensureTrailingSlash path =
634 if byteLength path /= 0
635 then
636 let mx = A.getIndex (byteLength path - 1) path
637 in case mx of
638 Nothing -> error "ensureTrailingSlash: Bug: Invalid index"
639 Just x ->
640 if x /= forwardSlashByte
641 then path <> forwardSlash
642 else path
643 else path
644 where forwardSlash = A.fromList [ forwardSlashByte ]
645 forwardSlashByte = fromIntegral (ord '/')
647removeTrailingSlash :: Array Word8 -> Array Word8
648removeTrailingSlash path =
649 if byteLength path /= 0
650 then
651 let n = byteLength path - 1
652 mx = A.getIndex n path
653 in case mx of
654 Nothing -> error "removeTrailingSlash: Bug: Invalid index"
655 Just x ->
656 if x == fromIntegral (ord '/')
657 then A.getSliceUnsafe 0 n path
658 else path
659 else path
661appendPaths :: Array Word8 -> Array Word8 -> Array Word8
662appendPaths a b
663 | byteLength a == 0 = b
664 | byteLength b == 0 = a
665 | otherwise = ensureTrailingSlash a <> b
667-- | @addToWatch cfg watch root subpath@ adds @subpath@ to the list of paths
668-- being monitored under @root@ via the watch handle @watch@. @root@ must be
669-- an absolute path and @subpath@ must be relative to @root@.
670--
671-- /Pre-release/
672--
673addToWatch :: Config -> Watch -> Array Word8 -> Array Word8 -> IO ()
674addToWatch cfg@Config{..} watch0@(Watch handle wdMap) root0 path0 = do
675 -- XXX do not add if the path is already added
676 -- XXX if the watch is added by the scan and not via an event we can
677 -- generate a create event assuming that the create may have been lost. We
678 -- can also mark in the map that this entry was added by the scan. So if an
679 -- actual create event later comes and tries to add this again then we can
680 -- ignore that and drop the create event to avoid duplicate create, because
681 -- we have already emitted it.
682 --
683 -- When a directory is added by the scan we should also emit create events
684 -- for files that may have got added to the dir. However, such create
685 -- events may get duplicated because of a race between the scan generated
686 -- versus real events.
687 --
688 -- Or we may distinguish between scan generated events and real events so
689 -- that the application can assume that other events may been lost and
690 -- handle it. For example, if it is a dir create the application can read
691 -- the dir to scan the files in it.
692 --
693 let root = removeTrailingSlash root0
694 path = removeTrailingSlash path0
695 absPath = appendPaths root path
696 putStrLn $ "root = " ++ utf8ToString root ++ " path = " ++ utf8ToString path ++ " absPath = " ++ utf8ToString absPath
698 fd <- handleToFd handle
700 -- XXX we need to tolerate an error where we are adding a watch for a
701 -- non-existing file because the file may have got deleted by the time we
702 -- added the watch. Perhaps we can have a flag in config for this and keep
703 -- the default value to tolerate the error.
704 --
705 -- XXX The file may have even got deleted and then recreated which we will
706 -- never get to know, document this.
707 wd <- A.asCStringUnsafe absPath $ \pathPtr ->
708 throwErrnoIfMinus1 ("addToWatch: " ++ utf8ToString absPath) $
709 c_inotify_add_watch (fdFD fd) pathPtr (CUInt createFlags)
711 -- We add the parent first so that we start getting events for any new
712 -- creates and add the new subdirectories on creates while we are adding
713 -- the children.
714 modifyIORef wdMap (Map.insert (fromIntegral wd) (root, path))
716 -- Now add the children. If we missed any creates while we were adding the
717 -- parent, this will make sure they are added too.
718 --
719 -- XXX Ensure that we generate events that we may have missed while we were
720 -- adding the dirs. That may generate spurious events though.
721 --
722 -- XXX toDirs currently uses paths as String, we need to convert it
723 -- to "/" separated by byte arrays.
724 pathIsDir <- doesDirectoryExist $ utf8ToString absPath
725 when (watchRec && pathIsDir) $ do
726 let f = addToWatch cfg watch0 root . appendPaths path
727 in S.fold (FL.drainBy f)
728 $ S.mapM toUtf8
729 $ Dir.toDirs $ utf8ToString absPath
731foreign import ccall unsafe
732 "sys/inotify.h inotify_rm_watch" c_inotify_rm_watch
733 :: CInt -> CInt -> IO CInt
735-- | Remove an absolute root path from a 'Watch', if a path was moved after
736-- adding you need to provide the original path which was used to add the
737-- Watch.
738--
739-- /Pre-release/
740--
741removeFromWatch :: Watch -> Array Word8 -> IO ()
742removeFromWatch (Watch handle wdMap) path = do
743 fd <- handleToFd handle
744 km <- readIORef wdMap
745 wdMap1 <- foldlM (step fd) Map.empty (Map.toList km)
746 writeIORef wdMap wdMap1
748 where
750 step fd newMap (wd, v) = do
751 if fst v == path
752 then do
753 let err = "removeFromWatch: " ++ show (utf8ToString path)
754 rm = c_inotify_rm_watch (fdFD fd) (fromIntegral wd)
755 void $ throwErrnoIfMinus1 err rm
756 return newMap
757 else return $ Map.insert wd v newMap
759-- | Given a 'Config' and list of @paths@ ("/" separated byte arrays) start
760-- monitoring the paths for file system events. Returns a 'Watch' handle which
761-- can then be used to read the event stream or to close the watch.
762--
763-- /Pre-release/
764--
765openWatch :: Config -> NonEmpty (Array Word8) -> IO Watch
766openWatch cfg paths = do
767 w <- createWatch
768 mapM_
769 (\root -> addToWatch cfg w root (A.fromList []))
770 $ NonEmpty.toList paths
771 return w
773-- | Close a 'Watch' handle.
774--
775-- /Pre-release/
776--
777closeWatch :: Watch -> IO ()
778closeWatch (Watch h _) = hClose h
780-------------------------------------------------------------------------------
781-- Raw events read from the watch file handle
782-------------------------------------------------------------------------------
784newtype Cookie = Cookie Word32 deriving (Show, Eq)
786-- | An Event generated by the file system. Use the accessor functions to
787-- examine the event.
788--
789-- /Pre-release/
790--
791data Event = Event
792 { eventWd :: CInt
793 , eventFlags :: Word32
794 , eventCookie :: Word32
795 , eventRelPath :: Array Word8
796 , eventMap :: IntMap (Array Word8, Array Word8)
797 } deriving (Show, Ord, Eq)
799-- The inotify event struct from the man page/header file:
800--
801-- struct inotify_event {
802-- int wd; /* Watch descriptor */
803-- uint32_t mask; /* Mask describing event */
804-- uint32_t cookie; /* Unique cookie associating related
805-- events (for rename(2)) */
806-- uint32_t len; /* Size of name field */
807-- char name[]; /* Optional null-terminated name */
808-- };
809--
810-- XXX We can perhaps use parseD monad instance for fusing with parseMany? Need
811-- to measure the perf.
812--
813readOneEvent :: Config -> Watch -> Parser IO Word8 Event
814readOneEvent cfg wt@(Watch _ wdMap) = do
815 let headerLen = sizeOf (undefined :: CInt) + 12
816 arr <- PR.takeEQ headerLen (A.writeN headerLen)
817 (ewd, eflags, cookie, pathLen) <- PR.fromEffect $ A.asPtrUnsafe arr readHeader
818 -- XXX need the "initial" in parsers to return a step type so that "take 0"
819 -- can return without an input. otherwise if pathLen is 0 we will keep
820 -- waiting to read one more char before we return this event.
821 path <-
822 if pathLen /= 0
823 then do
824 -- XXX takeEndBy_ drops the separator so assumes a null
825 -- terminated path, we should use a takeWhile nested inside a
826 -- takeP
827 pth <-
828 PR.fromFold
829 $ FL.takeEndBy_ (== 0)
830 $ FL.take pathLen (A.writeN pathLen)
831 let remaining = pathLen - byteLength pth - 1
832 when (remaining /= 0) $ PR.takeEQ remaining FL.drain
833 return pth
834 else return $ A.fromList []
835 wdm <- PR.fromEffect $ readIORef wdMap
836 let (root, sub) =
837 case Map.lookup (fromIntegral ewd) wdm of
838 Just pair -> pair
839 Nothing ->
840 error $ "readOneEvent: "
841 <> "Unknown watch descriptor: "
842 <> show ewd
843 let sub1 = appendPaths sub path
844 -- Check for "ISDIR" first because it is less likely
845 isDirCreate = eflags .&. iN_ISDIR /= 0 && eflags .&. iN_CREATE /= 0
846 when (watchRec cfg && isDirCreate)
847 $ PR.fromEffect $ addToWatch cfg wt root sub1
848 -- XXX Handle IN_DELETE, IN_DELETE_SELF, IN_MOVE_SELF, IN_MOVED_FROM,
849 -- IN_MOVED_TO
850 -- What if a large dir tree gets moved in to our hierarchy? Do we get a
851 -- single event for the top level dir in this case?
852 return $ Event
853 { eventWd = fromIntegral ewd
854 , eventFlags = eflags
855 , eventCookie = cookie
856 , eventRelPath = sub1
857 , eventMap = wdm
858 }
860 where
862 readHeader (ptr :: Ptr Word8) = do
863 let len = sizeOf (undefined :: CInt)
864 ewd <- peek ptr
865 eflags <- peekByteOff ptr len
866 cookie <- peekByteOff ptr (len + 4)
867 pathLen :: Word32 <- peekByteOff ptr (len + 8)
868 return (ewd, eflags, cookie, fromIntegral pathLen)
870watchToStream :: Config -> Watch -> Stream IO Event
871watchToStream cfg wt@(Watch handle _) = do
872 -- Do not use too small a buffer. As per inotify man page:
873 --
874 -- The behavior when the buffer given to read(2) is too small to return
875 -- information about the next event depends on the kernel version: in
876 -- kernels before 2.6.21, read(2) returns 0; since kernel 2.6.21, read(2)
877 -- fails with the error EINVAL. Specifying a buffer of size
878 --
879 -- sizeof(struct inotify_event) + NAME_MAX + 1
880 --
881 -- will be sufficient to read at least one event.
882 S.parseMany (readOneEvent cfg wt) $ S.unfold FH.reader handle
884-- XXX We should not go across the mount points of network file systems or file
885-- systems that are known to not generate any events.
886--
887-- | Start monitoring a list of file system paths for file system events with
888-- the supplied configuration operation over the 'defaultConfig'. The
889-- paths could be files or directories. When recursive mode is set and the
890-- path is a directory, the whole directory tree under it is watched
891-- recursively. Monitoring starts from the current time onwards. The paths are
892-- specified as UTF-8 encoded 'Array' of 'Word8'.
893--
894-- /Non-existing Paths:/ the API fails if a watch is started on a non-exsting
895-- path.
896--
897-- /Performance:/ Note that recursive watch on a large directory tree could be
898-- expensive. When starting a watch, the whole tree must be read and watches
899-- are started on each directory in the tree. The initial time to start the
900-- watch as well as the memory required is proportional to the number of
901-- directories in the tree.
902--
903-- /Bugs:/ When new directories are created under the tree they are added to
904-- the watch on receiving the directory create event. However, the creation of
905-- a dir and adding a watch for it is not atomic. The implementation takes
906-- care of this and makes sure that watches are added for all directories.
907-- However, In the mean time, the directory may have received more events which
908-- may get lost. Handling of any such lost events is yet to be implemented.
909--
910-- See the Linux __inotify__ man page for more details.
911--
912-- @
913-- watchwith
914-- ('setFollowSymLinks' On . 'setUnwatchMoved' Off)
915-- [Array.fromList "dir"]
916-- @
917--
918-- /Pre-release/
919--
920watchWith :: (Config -> Config) -> NonEmpty (Array Word8) -> Stream IO Event
921watchWith f paths = S.bracket before after (watchToStream cfg)
923 where
925 cfg = f defaultConfig
926 before = liftIO $ openWatch cfg paths
927 after = liftIO . closeWatch
929-- | Same as 'watchWith' using 'defaultConfig' and recursive mode.
930--
931-- >>> watchRecursive = watchWith (setRecursiveMode On)
932--
933-- See 'watchWith' for pitfalls and bugs when using recursive watch on Linux.
934--
935-- /Pre-release/
936--
937watchRecursive :: NonEmpty (Array Word8) -> Stream IO Event
938watchRecursive = watchWith (setRecursiveMode On)
940-- | Same as 'watchWith' using defaultConfig and non-recursive mode.
941--
942-- >>> watch = watchWith id
943--
944-- /Pre-release/
945--
946watch :: NonEmpty (Array Word8) -> Stream IO Event
947watch = watchWith id
949-------------------------------------------------------------------------------
950-- Examine event stream
951-------------------------------------------------------------------------------
953-- | Get the watch root corresponding to the 'Event'.
954--
955-- Note that if a path was moved after adding to the watch, this will give the
956-- original path and not the new path after moving.
957--
958-- TBD: we can possibly update the watch root on a move self event.
959--
960-- /Pre-release/
961--
962getRoot :: Event -> Array Word8
963getRoot Event{..} =
964 if eventWd >= 1
965 then
966 case Map.lookup (fromIntegral eventWd) eventMap of
967 Just path -> fst path
968 Nothing ->
969 error $ "Bug: getRoot: No path found corresponding to the "
970 ++ "watch descriptor " ++ show eventWd
971 else A.fromList []
973-- XXX should we use a Maybe here?
974-- | Get the file system object path for which the event is generated, relative
975-- to the watched root. The path is a "/" separated array of bytes.
976--
977-- /Pre-release/
978--
979getRelPath :: Event -> Array Word8
980getRelPath Event{..} = eventRelPath
982-- | Get the absolute file system object path for which the event is generated.
983--
984-- When the watch root is a symlink, the absolute path returned is via the
985-- original symlink and not through the resolved path.
986--
987-- /Pre-release/
988--
989getAbsPath :: Event -> Array Word8
990getAbsPath ev =
991 let relpath = getRelPath ev
992 root = getRoot ev
993 in if byteLength relpath /= 0
994 then ensureTrailingSlash root <> relpath
995 else removeTrailingSlash root
997-- XXX should we use a Maybe?
998-- | Cookie is set when a rename occurs. The cookie value can be used to
999-- connect the 'isMovedFrom' and 'isMovedTo' events, if both the events belong
1000-- to the same move operation then they will have the same cookie value.
1002-- /Pre-release/
1004getCookie :: Event -> Cookie
1005getCookie Event{..} = Cookie eventCookie
1007-------------------------------------------------------------------------------
1008-- Event types
1009-------------------------------------------------------------------------------
1011getFlag :: Word32 -> Event -> Bool
1012getFlag mask Event{..} = eventFlags .&. mask /= 0
1014-------------------------------------------------------------------------------
1015-- Error events
1016-------------------------------------------------------------------------------
1018foreign import capi
1019 "sys/inotify.h value IN_Q_OVERFLOW" iN_Q_OVERFLOW :: Word32
1021-- XXX rename to isQOverflowed or hasOverflowed?
1023-- macOS overflow API is more specific, it tells which paths have lost the
1024-- events due to overflow.
1026-- | Event queue overflowed (WD is invalid for this event) and we may have lost
1027-- some events.. The user application must scan everything under the watched
1028-- paths to know the current state.
1030-- /Pre-release/
1032isEventsLost :: Event -> Bool
1033isEventsLost = getFlag iN_Q_OVERFLOW
1035-------------------------------------------------------------------------------
1036-- Events affecting the watched path only
1037-------------------------------------------------------------------------------
1039foreign import capi
1040 "sys/inotify.h value IN_IGNORED" iN_IGNORED :: Word32
1042-- Compare with isRootChanged on macOS. isRootChanged includes all these cases.
1044-- | A path was removed from the watch explicitly using 'removeFromWatch' or
1045-- automatically (file was deleted, or filesystem was unmounted).
1047-- Note that in recursive watch mode all the subdirectories are watch roots,
1048-- therefore, they will all generate this event.
1050-- /Occurs only for a watched path/
1052-- /Pre-release/
1054isRootUnwatched :: Event -> Bool
1055isRootUnwatched = getFlag iN_IGNORED
1057-- | Watched file/directory was itself deleted. (This event also occurs if an
1058-- object is moved to another filesystem, since mv(1) in effect copies the file
1059-- to the other filesystem and then deletes it from the original filesystem.)
1060-- In addition, an 'isRootUnwatched' event will subsequently be generated
1061-- for the watch descriptor.
1063-- Note that in recursive watch mode all the subdirectories are watch roots,
1064-- therefore, they will all generate this event.
1066-- /Occurs only for a watched path/
1068-- /Pre-release/
1070isRootDeleted :: Event -> Bool
1071isRootDeleted = getFlag iN_DELETE_SELF
1073-- | Watched file/directory was itself moved within the file system.
1075-- Note that in recursive watch mode all the subdirectories are watch roots,
1076-- therefore, they will all generate this event.
1078-- /Occurs only for a watched path/
1080-- /Pre-release/
1082isRootMoved :: Event -> Bool
1083isRootMoved = getFlag iN_MOVE_SELF
1085foreign import capi
1086 "sys/inotify.h value IN_UNMOUNT" iN_UNMOUNT :: Word32
1088-- | Filesystem containing watched object was unmounted. In addition, an
1089-- 'isRootUnwatched' event will subsequently be generated for the watch
1090-- descriptor.
1092-- /Occurs only for a watched path/
1094-- /Pre-release/
1096isRootUnmounted :: Event -> Bool
1097isRootUnmounted = getFlag iN_UNMOUNT
1099-- | Determine whether the event indicates a change of path of the monitored
1100-- object itself. Note that the object may become unreachable or deleted after
1101-- a change of path.
1103-- /Occurs only for a watched path/
1105-- /Pre-release/
1107isRootPathEvent :: Event -> Bool
1108isRootPathEvent = getFlag (iN_DELETE_SELF .|. iN_MOVE_SELF .|. iN_UNMOUNT)
1110-------------------------------------------------------------------------------
1111-- Metadata change Events
1112-------------------------------------------------------------------------------
1114-- macOS has multiple APIs for metadata change for different metadata.
1116-- | Determine whether the event indicates inode metadata change for an object
1117-- contained within the monitored path.
1119-- Metadata change may include, permissions (e.g., chmod(2)), timestamps
1120-- (e.g., utimensat(2)), extended attributes (setxattr(2)), link count (since
1121-- Linux 2.6.25; e.g., for the target of link(2) and for unlink(2)), and
1122-- user/group ID (e.g., chown(2)).
1124-- /Can occur for watched path or a file inside it/
1126-- /Pre-release/
1128isAttrsModified :: Event -> Bool
1129isAttrsModified = getFlag iN_ATTRIB
1131-------------------------------------------------------------------------------
1132-- Access
1133-------------------------------------------------------------------------------
1135-- | File was accessed (e.g. read, execve).
1137-- /Occurs only for a file inside the watched directory/
1139-- /Pre-release/
1141isAccessed :: Event -> Bool
1142isAccessed = getFlag iN_ACCESS
1144-- | File or directory was opened.
1146-- /Occurs only for a file inside the watched directory/
1148-- /Pre-release/
1150isOpened :: Event -> Bool
1151isOpened = getFlag iN_OPEN
1153-- | File opened for writing was closed.
1155-- /Occurs only for a file inside the watched directory/
1157-- /Pre-release/
1159isWriteClosed :: Event -> Bool
1160isWriteClosed = getFlag iN_CLOSE_WRITE
1162-- XXX what if it was opened for append? Does NOWRITE mean all cases where the
1163-- mode was not write? A dir open comes in this category?
1165-- | File or directory opened for read but not write was closed.
1167-- /Can occur for watched path or a file inside it/
1169-- /Pre-release/
1171isNonWriteClosed :: Event -> Bool
1172isNonWriteClosed = getFlag iN_CLOSE_NOWRITE
1174-------------------------------------------------------------------------------
1175-- CRUD Events
1176-------------------------------------------------------------------------------
1178-- On macOS this is not generated on hard linking but on Linux it is.
1180-- | File/directory created in watched directory (e.g., open(2) O_CREAT,
1181-- mkdir(2), link(2), symlink(2), bind(2) on a UNIX domain socket).
1183-- /Occurs only for an object inside the watched directory/
1185-- /Pre-release/
1187isCreated :: Event -> Bool
1188isCreated = getFlag iN_CREATE
1190-- | File/directory deleted from watched directory.
1192-- /Occurs only for an object inside the watched directory/
1194-- /Pre-release/
1196isDeleted :: Event -> Bool
1197isDeleted = getFlag iN_DELETE
1199-- XXX what if an object is moved in from outside or moved out of the monitored
1200-- dir?
1202-- | Generated for the original path when an object is moved from under a
1203-- monitored directory.
1205-- /Occurs only for an object inside the watched directory/
1207-- /Pre-release/
1209isMovedFrom :: Event -> Bool
1210isMovedFrom = getFlag iN_MOVED_FROM
1212-- | Generated for the new path when an object is moved under a monitored
1213-- directory.
1215-- /Occurs only for an object inside the watched directory/
1217-- /Pre-release/
1219isMovedTo :: Event -> Bool
1220isMovedTo = getFlag iN_MOVED_TO
1222-- | Generated for a path that is moved from or moved to the monitored
1223-- directory.
1225-- >>> isMoved ev = isMovedFrom ev || isMovedTo ev
1227-- /Occurs only for an object inside the watched directory/
1229-- /Pre-release/
1231isMoved :: Event -> Bool
1232isMoved ev = isMovedFrom ev || isMovedTo ev
1234-- | Determine whether the event indicates modification of an object within the
1235-- monitored path. This event is generated only for files and not directories.
1237-- /Occurs only for an object inside the watched directory/
1239-- /Pre-release/
1241isModified :: Event -> Bool
1242isModified = getFlag iN_MODIFY
1244-------------------------------------------------------------------------------
1245-- Information about path type (applicable only when 'setFileEvents' is 'On')
1246-------------------------------------------------------------------------------
1248foreign import capi
1249 "sys/inotify.h value IN_ISDIR" iN_ISDIR :: Word32
1251-- | Determine whether the event is for a directory path.
1253-- /Pre-release/
1255isDir :: Event -> Bool
1256isDir = getFlag iN_ISDIR
1258-------------------------------------------------------------------------------
1259-- Debugging
1260-------------------------------------------------------------------------------
1262-- | Convert an 'Event' record to a String representation.
1263showEvent :: Event -> String
1264showEvent ev@Event{..} =
1265 "--------------------------"
1266 ++ "\nWd = " ++ show eventWd
1267 ++ "\nRoot = " ++ show (utf8ToString $ getRoot ev)
1268 ++ "\nPath = " ++ show (utf8ToString $ getRelPath ev)
1269 ++ "\nCookie = " ++ show (getCookie ev)
1270 ++ "\nFlags " ++ show eventFlags
1272 ++ showev isEventsLost "Overflow"
1274 ++ showev isRootUnwatched "RootUnwatched"
1275 ++ showev isRootDeleted "RootDeleted"
1276 ++ showev isRootMoved "RootMoved"
1277 ++ showev isRootUnmounted "RootUnmounted"
1279 ++ showev isAttrsModified "AttrsModified"
1281 ++ showev isAccessed "Accessed"
1282 ++ showev isOpened "Opened"
1283 ++ showev isWriteClosed "WriteClosed"
1284 ++ showev isNonWriteClosed "NonWriteClosed"
1286 ++ showev isCreated "Created"
1287 ++ showev isDeleted "Deleted"
1288 ++ showev isModified "Modified"
1289 ++ showev isMovedFrom "MovedFrom"
1290 ++ showev isMovedTo "MovedTo"
1292 ++ showev isDir "Dir"
1293 ++ "\n"
1295 where showev f str = if f ev then "\n" ++ str else ""
1296#else
1297#warning "Disabling module Streamly.Internal.FileSystem.Event.Linux. Does not support kernels older than 2.6.36."
1298module Streamly.Internal.FileSystem.Event.Linux () where
1299#endif