on fe33167 help sign in
1224 lines 38 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.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-- 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 , Toggle (..)
68 , defaultConfig
70 -- ** Watch Behavior
71 , setFollowSymLinks
72 , setUnwatchMoved
73 , setOneShot
74 , setOnlyDir
75 , WhenExists (..)
76 , setWhenExists
78 -- ** Events of Interest
79 -- *** Root Level Events
80 , setRootDeleted
81 , setRootMoved
83 -- *** Item Level Metadata change
84 , setMetadataChanged
86 -- *** Item Level Access
87 , setAccessed
88 , setOpened
89 , setWriteClosed
90 , setNonWriteClosed
92 -- *** Item CRUD events
93 , setCreated
94 , setDeleted
95 , setMovedFrom
96 , setMovedTo
97 , setModified
99 , setAllEvents
101 -- ** Watch APIs
102 -- XXX watchPaths is redundant now because we can use watchTrees with
103 -- setRecursiveMode False. Perhaps we can use a common "watch" API.
104 , watchPathsWith
105 , watchPaths
106 , watchTreesWith
107 , watchTrees
108 , addToWatch
109 , removeFromWatch
111 -- * Handling Events
112 , Event(..)
113 , getRoot
114 , getRelPath
115 , getCookie
117 -- ** Exception Conditions
118 , isOverflow
120 -- ** Root Level Events
121 , isRootUnwatched
122 , isRootDeleted
123 , isRootMoved
124 , isRootUnmounted
126 -- ** Item Level Metadata change
127 , isMetadataChanged
129 -- ** Item Level Access
130 , isAccessed
131 , isOpened
132 , isWriteClosed
133 , isNonWriteClosed
135 -- ** Item CRUD events
136 , isCreated
137 , isDeleted
138 , isMovedFrom
139 , isMovedTo
140 , isModified
142 -- ** Item Path info
143 , isDir
145 -- * Debugging
146 , showEvent
147 )
148where
150import Control.Monad (void, when)
151import Control.Monad.IO.Class (MonadIO, liftIO)
152import Data.Bits ((.|.), (.&.), complement)
153import Data.Char (ord)
154import Data.Foldable (foldlM)
155import Data.Functor.Identity (runIdentity)
156import Data.IntMap.Lazy (IntMap)
157import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef)
158import Data.List.NonEmpty (NonEmpty)
160#if __GLASGOW_HASKELL__ < 808
161import Data.Semigroup (Semigroup(..))
162#endif
163import Data.Word (Word8, Word32)
164import Foreign.C.Error (throwErrnoIfMinus1)
165import Foreign.C.String (CString)
166import Foreign.C.Types (CInt(..), CUInt(..))
167import Foreign.Ptr (Ptr)
168import Foreign.Storable (peek, peekByteOff, sizeOf)
169import GHC.IO.Device (IODeviceType(Stream))
170import GHC.IO.FD (fdFD, mkFD)
171import GHC.IO.Handle.FD (mkHandleFromFD)
172import Streamly.Prelude (SerialT)
173import Streamly.Internal.Data.Parser (Parser)
174import Streamly.Internal.Data.Array.Storable.Foreign.Types (Array(..))
175import System.IO (Handle, hClose, IOMode(ReadMode))
176#if !MIN_VERSION_base(4,10,0)
177import Control.Concurrent.MVar (readMVar)
178import Data.Semigroup (<>)
179import Data.Typeable (cast)
180import GHC.IO.Exception (IOException(..), IOErrorType(..), ioException)
181import GHC.IO.FD (FD)
182import GHC.IO.Handle.Types (Handle__(..), Handle(FileHandle, DuplexHandle))
183#else
184import GHC.IO.Handle.FD (handleToFd)
185#endif
187import qualified Data.IntMap.Lazy as Map
188import qualified Data.List.NonEmpty as NonEmpty
189import qualified Streamly.Internal.Data.Array.Storable.Foreign as A
190import qualified Streamly.Internal.Data.Fold as FL
191import qualified Streamly.Internal.Data.Parser as PR
192import qualified Streamly.Internal.Data.Stream.IsStream as S
193import qualified Streamly.Internal.FileSystem.Dir as Dir
194import qualified Streamly.Internal.FileSystem.Handle as FH
195import qualified Streamly.Internal.Unicode.Stream as U
197-------------------------------------------------------------------------------
198-- Subscription to events
199-------------------------------------------------------------------------------
201-- | Watch configuration, used to specify the events of interest and the
202-- behavior of the watch.
203--
204-- /Internal/
205--
206data Config = Config
207 { watchRec :: Bool
208 , createFlags :: Word32
209 }
211-------------------------------------------------------------------------------
212-- Boolean settings
213-------------------------------------------------------------------------------
215-- | Whether a setting is 'On' or 'Off'.
216--
217-- /Internal/
218--
219data Toggle = On | Off
221toggle :: Toggle -> Toggle
222toggle On = Off
223toggle Off = On
225setFlag :: Word32 -> Toggle -> Config -> Config
226setFlag mask status cfg@Config{..} =
227 let flags =
228 case status of
229 On -> createFlags .|. mask
230 Off -> createFlags .&. complement mask
231 in cfg {createFlags = flags}
233-------------------------------------------------------------------------------
234-- Utilities
235-------------------------------------------------------------------------------
237-- XXX we really do not know the path encoding, all we know is that it is "/"
238-- separated bytes. So these may fail or convert the path in an unexpected
239-- manner. We should ultimately remove all usage of these.
241toUtf8 :: MonadIO m => String -> m (Array Word8)
242toUtf8 = A.fromStream . U.encodeUtf8 . S.fromList
244utf8ToString :: Array Word8 -> String
245utf8ToString = runIdentity . S.toList . U.decodeUtf8' . A.toStream
247-- | Watch the whole directory tree recursively instead of watching just one
248-- level of directory.
249--
250-- /default: Off/
251--
252-- /Internal/
253--
254setRecursiveMode :: Bool -> Config -> Config
255setRecursiveMode rec cfg@Config{} = cfg {watchRec = rec}
257-------------------------------------------------------------------------------
258-- Settings
259-------------------------------------------------------------------------------
261foreign import capi
262 "sys/inotify.h value IN_DONT_FOLLOW" iN_DONT_FOLLOW :: Word32
264-- | If the pathname to be watched is a symbolic link then watch the target of
265-- the symbolic link instead of the symbolic link itself.
266--
267-- /default: On/
268--
269-- /Internal/
270--
271setFollowSymLinks :: Toggle -> Config -> Config
272setFollowSymLinks s = setFlag iN_DONT_FOLLOW (toggle s)
274foreign import capi
275 "sys/inotify.h value IN_EXCL_UNLINK" iN_EXCL_UNLINK :: Word32
277-- | If an object moves out of the directory being watched then stop watching
278-- it.
279--
280-- /default: On/
281--
282-- /Internal/
283--
284setUnwatchMoved :: Toggle -> Config -> Config
285setUnwatchMoved = setFlag iN_EXCL_UNLINK
287#if HAVE_DECL_IN_MASK_CREATE
288foreign import capi
289 "sys/inotify.h value IN_MASK_CREATE" iN_MASK_CREATE :: Word32
290#endif
292foreign import capi
293 "sys/inotify.h value IN_MASK_ADD" iN_MASK_ADD :: Word32
295-- | What to do if a watch already exists when 'openWatch' or 'addToWatch' is
296-- called for a path.
297--
298-- /Internal/
299--
300data WhenExists =
301 AddIfExists -- ^ Do not set an existing setting to 'Off' only set to 'On'
302 | ReplaceIfExists -- ^ Replace the existing settings with new settings
303#if HAVE_DECL_IN_MASK_CREATE
304 | FailIfExists -- ^ Fail the API
305#endif
307-- | When adding a new path to the watch, specify what to do if a watch already
308-- exists on that path.
309--
310-- /default: FailIfExists/
311--
312-- /Internal/
313--
314setWhenExists :: WhenExists -> Config -> Config
315setWhenExists val cfg =
316 case val of
317 AddIfExists -> setFlag iN_MASK_ADD On cfg
318 ReplaceIfExists -> setFlag iN_MASK_ADD Off cfg
319#if HAVE_DECL_IN_MASK_CREATE
320 FailIfExists -> setFlag iN_MASK_CREATE On cfg
321#endif
323foreign import capi
324 "sys/inotify.h value IN_ONESHOT" iN_ONESHOT :: Word32
326-- | Watch the object only for one event and then remove it from the watch.
327--
328-- /default: Off/
329--
330-- /Internal/
331--
332setOneShot :: Toggle -> Config -> Config
333setOneShot = setFlag iN_ONESHOT
335foreign import capi
336 "sys/inotify.h value IN_ONLYDIR" iN_ONLYDIR :: Word32
338-- | Watch the object only if it is a directory. This provides a race-free way
339-- to ensure that the watched object is a directory.
340--
341-- /default: Off/
342--
343-- /Internal/
344--
345setOnlyDir :: Toggle -> Config -> Config
346setOnlyDir = setFlag iN_ONLYDIR
348-------------------------------------------------------------------------------
349-- Event types that can occur
350-------------------------------------------------------------------------------
352foreign import capi
353 "sys/inotify.h value IN_DELETE_SELF" iN_DELETE_SELF :: Word32
355-- | Report when the watched path itself gets deleted.
356--
357-- /default: On/
358--
359-- /Internal/
360--
361setRootDeleted :: Toggle -> Config -> Config
362setRootDeleted = setFlag iN_DELETE_SELF
364foreign import capi
365 "sys/inotify.h value IN_MOVE_SELF" iN_MOVE_SELF :: Word32
367-- | Report when the watched root path itself gets renamed.
368--
369-- /default: On/
370--
371-- /Internal/
372--
373setRootMoved :: Toggle -> Config -> Config
374setRootMoved = setFlag iN_MOVE_SELF
376foreign import capi
377 "sys/inotify.h value IN_ATTRIB" iN_ATTRIB :: Word32
379-- | Report when the metadata e.g. owner, permission modes, modifications times
380-- of an object changes.
381--
382-- /default: On/
383--
384-- /Internal/
385--
386setMetadataChanged :: Toggle -> Config -> Config
387setMetadataChanged = setFlag iN_ATTRIB
389foreign import capi
390 "sys/inotify.h value IN_ACCESS" iN_ACCESS :: Word32
392-- | Report when a file is accessed.
393--
394-- /default: On/
395--
396-- /Internal/
397--
398setAccessed :: Toggle -> Config -> Config
399setAccessed = setFlag iN_ACCESS
401foreign import capi
402 "sys/inotify.h value IN_OPEN" iN_OPEN :: Word32
404-- | Report when a file is opened.
405--
406-- /default: On/
407--
408-- /Internal/
409--
410setOpened :: Toggle -> Config -> Config
411setOpened = setFlag iN_OPEN
413foreign import capi
414 "sys/inotify.h value IN_CLOSE_WRITE" iN_CLOSE_WRITE :: Word32
416-- | Report when a file that was opened for writes is closed.
417--
418-- /default: On/
419--
420-- /Internal/
421--
422setWriteClosed :: Toggle -> Config -> Config
423setWriteClosed = setFlag iN_CLOSE_WRITE
425foreign import capi
426 "sys/inotify.h value IN_CLOSE_NOWRITE" iN_CLOSE_NOWRITE :: Word32
428-- | Report when a file that was opened for not writing is closed.
429--
430-- /default: On/
431--
432-- /Internal/
433--
434setNonWriteClosed :: Toggle -> Config -> Config
435setNonWriteClosed = setFlag iN_CLOSE_NOWRITE
437foreign import capi
438 "sys/inotify.h value IN_CREATE" iN_CREATE :: Word32
440-- | Report when a file is created.
441--
442-- /default: On/
443--
444-- /Internal/
445--
446setCreated :: Toggle -> Config -> Config
447setCreated = setFlag iN_CREATE
449foreign import capi
450 "sys/inotify.h value IN_DELETE" iN_DELETE :: Word32
452-- | Report when a file is deleted.
453--
454-- /default: On/
455--
456-- /Internal/
457--
458setDeleted :: Toggle -> Config -> Config
459setDeleted = setFlag iN_DELETE
461foreign import capi
462 "sys/inotify.h value IN_MOVED_FROM" iN_MOVED_FROM :: Word32
464-- | Report the source of a move.
465--
466-- /default: On/
467--
468-- /Internal/
469--
470setMovedFrom :: Toggle -> Config -> Config
471setMovedFrom = setFlag iN_MOVED_FROM
473foreign import capi
474 "sys/inotify.h value IN_MOVED_TO" iN_MOVED_TO :: Word32
476-- | Report the target of a move.
477--
478-- /default: On/
479--
480-- /Internal/
481--
482setMovedTo :: Toggle -> Config -> Config
483setMovedTo = setFlag iN_MOVED_TO
485foreign import capi
486 "sys/inotify.h value IN_MODIFY" iN_MODIFY :: Word32
488-- | Report when a file is modified.
489--
490-- /default: On/
491--
492-- /Internal/
493--
494setModified :: Toggle -> Config -> Config
495setModified = setFlag iN_MODIFY
497-- | Set all events 'On' or 'Off'.
498--
499-- /default: On/
500--
501-- /Internal/
502--
503setAllEvents :: Toggle -> Config -> Config
504setAllEvents s cfg =
505 ( setRootDeleted s
506 . setRootMoved s
507 . setMetadataChanged s
508 . setAccessed s
509 . setOpened s
510 . setWriteClosed s
511 . setNonWriteClosed s
512 . setCreated s
513 . setDeleted s
514 . setMovedFrom s
515 . setMovedTo s
516 . setModified s
517 ) cfg
519-------------------------------------------------------------------------------
520-- Default config
521-------------------------------------------------------------------------------
523-- The defaults are set in such a way that the behavior on macOS and Linux is
524-- as much compatible as possible.
525--
526-- | The default is:
527--
528-- * 'setFollowSymLinks' 'On'
529-- * 'setUnwatchMoved' 'On'
530-- * 'setOneShot' 'Off'
531-- * 'setOnlyDir' 'Off'
532-- * 'setWhenExists' 'AddIfExists'
533-- * 'setAllEvents' 'On'
534--
535-- /Internal/
536--
537defaultConfig :: Config
538defaultConfig =
539 setWhenExists AddIfExists
540 $ setAllEvents On
541 $ Config {watchRec = True, createFlags = 0}
543-------------------------------------------------------------------------------
544-- Open an event stream
545-------------------------------------------------------------------------------
547-- | A handle for a watch.
548data Watch =
549 Watch
550 Handle -- File handle for the watch
551 (IORef
552 (IntMap -- Key is the watch descriptor
553 ( Array Word8 -- Absolute path of the watch root
554 , Array Word8 -- Path of subdir relative to watch root
555 )
556 )
557 )
559-- Instead of using the watch descriptor we can provide APIs that use the path
560-- itself to identify the watch. That will require us to maintain a map from wd
561-- to path in the Watch handle.
563newtype WD = WD CInt deriving Show
565foreign import ccall unsafe
566 "sys/inotify.h inotify_init" c_inotify_init :: IO CInt
568-- | Create a 'Watch' handle. 'addToWatch' can be used to add paths being
569-- monitored by this watch.
570--
571-- /Internal/
572--
573createWatch :: IO Watch
574createWatch = do
575 rawfd <- throwErrnoIfMinus1 "createWatch" c_inotify_init
576 -- we could use fdToHandle but it cannot determine the fd type
577 -- automatically for the inotify fd
578 (fd, fdType) <-
579 mkFD
580 rawfd
581 ReadMode
582 (Just (Stream, 0, 0)) -- (IODeviceType, CDev, CIno)
583 False -- not a socket
584 False -- non-blocking is false
585 let fdString = "<createWatch file descriptor: " ++ show fd ++ ">"
586 h <-
587 mkHandleFromFD
588 fd
589 fdType
590 fdString
591 ReadMode
592 True -- use non-blocking IO
593 Nothing -- TextEncoding (binary)
594 emptyMapRef <- newIORef Map.empty
595 return $ Watch h emptyMapRef
597foreign import ccall unsafe
598 "sys/inotify.h inotify_add_watch" c_inotify_add_watch
599 :: CInt -> CString -> CUInt -> IO CInt
602#if !MIN_VERSION_base(4,10,0)
603-- | Turn an existing Handle into a file descriptor. This function throws an
604-- IOError if the Handle does not reference a file descriptor.
605handleToFd :: Handle -> IO FD
606handleToFd h = case h of
607 FileHandle _ mv -> do
608 Handle__{haDevice = dev} <- readMVar mv
609 case cast dev of
610 Just fd -> return fd
611 Nothing -> throwErr "not a file descriptor"
612 DuplexHandle{} -> throwErr "not a file handle"
614 where
616 throwErr msg = ioException $ IOError (Just h)
617 InappropriateType "handleToFd" msg Nothing Nothing
618#endif
620-- | Add a trailing "/" at the end of the path if there is none. Do not add a
621-- "/" if the path is empty.
622--
623ensureTrailingSlash :: Array Word8 -> Array Word8
624ensureTrailingSlash path =
625 if A.length path /= 0
626 then
627 let mx = A.readIndex path (A.length path - 1)
628 in case mx of
629 Nothing -> error "ensureTrailingSlash: Bug: Invalid index"
630 Just x ->
631 if x /= fromIntegral (ord '/')
632 then path <> A.fromCString# "/"#
633 else path
634 else path
636-- | @addToWatch cfg watch root subpath@ adds @subpath@ to the list of paths
637-- being monitored under @root@ via the watch handle @watch@. @root@ must be
638-- an absolute path and @subpath@ must be relative to @root@.
639--
640-- /Internal/
641--
642addToWatch :: Config -> Watch -> Array Word8 -> Array Word8 -> IO ()
643addToWatch cfg@Config{..} watch@(Watch handle wdMap) root0 path0 = do
644 -- XXX do not add if the path is already added
645 -- XXX if the watch is added by the scan and not via an event we can
646 -- generate a create event assuming that the create may have been lost. We
647 -- can also mark in the map that this entry was added by the scan. So if an
648 -- actual create event later comes and tries to add this again then we can
649 -- ignore that and drop the create event to avoid duplicate create, because
650 -- we have already emitted it.
651 --
652 -- When a directory is added by the scan we should also emit create events
653 -- for files that may have got added to the dir. However, such create
654 -- events may get duplicated because of a race between the scan generated
655 -- versus real events.
656 --
657 -- Or we may distinguish between scan generated events and real events so
658 -- that the application can assume that other events may been lost and
659 -- handle it. For example, if it is a dir create the application can read
660 -- the dir to scan the files in it.
661 --
662 let root = ensureTrailingSlash root0
663 path = ensureTrailingSlash path0
664 absPath = root <> path
665 fd <- handleToFd handle
667 -- XXX we need to tolerate an error where we are adding a watch for a
668 -- non-existing file because the file may have got deleted by the time we
669 -- added the watch. Perhaps we can have a flag in config for this and keep
670 -- the default value to tolerate the error.
671 --
672 -- XXX The file may have even got deleted and then recreated which we will
673 -- never get to know, document this.
674 wd <- A.asCString absPath $ \pathPtr ->
675 throwErrnoIfMinus1 ("addToWatch: " ++ utf8ToString absPath) $
676 c_inotify_add_watch (fdFD fd) pathPtr (CUInt createFlags)
678 -- We add the parent first so that we start getting events for any new
679 -- creates and add the new subdirectories on creates while we are adding
680 -- the children.
681 modifyIORef wdMap (Map.insert (fromIntegral wd) (root, path))
683 -- Now add the children. If we missed any creates while we were adding the
684 -- parent, this will make sure they are added too.
685 --
686 -- XXX Ensure that we generate events that we may have missed while we were
687 -- adding the dirs.
688 --
689 -- XXX toDirs currently uses paths as String, we need to convert it
690 -- to "/" separated by byte arrays.
691 when watchRec $ do
692 S.mapM_ (\p -> addToWatch cfg watch root (path <> p))
693 $ S.mapM toUtf8
694 $ Dir.toDirs $ utf8ToString absPath
696foreign import ccall unsafe
697 "sys/inotify.h inotify_rm_watch" c_inotify_rm_watch
698 :: CInt -> CInt -> IO CInt
700-- | Remove an absolute root path from a 'Watch', if a path was moved after
701-- adding you need to provide the original path which was used to add the
702-- Watch.
703--
704-- /Internal/
705--
706removeFromWatch :: Watch -> Array Word8 -> IO ()
707removeFromWatch (Watch handle wdMap) path = do
708 fd <- handleToFd handle
709 km <- readIORef wdMap
710 wdMap1 <- foldlM (step fd) Map.empty (Map.toList km)
711 writeIORef wdMap wdMap1
713 where
715 step fd newMap (wd, v) = do
716 if (fst v) == path
717 then do
718 let err = "removeFromWatch: " ++ show (utf8ToString path)
719 rm = c_inotify_rm_watch (fdFD fd) (fromIntegral wd)
720 void $ throwErrnoIfMinus1 err rm
721 return newMap
722 else return $ Map.insert wd v newMap
724-- | Given a 'Config' and list of @paths@ ("/" separated byte arrays) start
725-- monitoring the paths for file system events. Returns a 'Watch' handle which
726-- can then be used to read the event stream or to close the watch.
727--
728-- /Internal/
729--
730openWatch :: Config -> NonEmpty (Array Word8) -> IO Watch
731openWatch cfg paths = do
732 w <- createWatch
733 mapM_ (\p -> addToWatch cfg w p (A.fromList [])) $ NonEmpty.toList paths
734 return w
736-- | Close a 'Watch' handle.
737--
738-- /Internal/
739--
740closeWatch :: Watch -> IO ()
741closeWatch (Watch h _) = hClose h
743-------------------------------------------------------------------------------
744-- Raw events read from the watch file handle
745-------------------------------------------------------------------------------
747newtype Cookie = Cookie Word32 deriving (Show, Eq)
749-- | An Event generated by the file system. Use the accessor functions to
750-- examine the event.
751--
752-- /Internal/
753--
754data Event = Event
755 { eventWd :: CInt
756 , eventFlags :: Word32
757 , eventCookie :: Word32
758 , eventRelPath :: Array Word8
759 , eventMap :: IntMap (Array Word8, Array Word8)
760 } deriving (Show, Ord, Eq)
762-- The inotify event struct from the man page/header file:
763--
764-- struct inotify_event {
765-- int wd; /* Watch descriptor */
766-- uint32_t mask; /* Mask describing event */
767-- uint32_t cookie; /* Unique cookie associating related
768-- events (for rename(2)) */
769-- uint32_t len; /* Size of name field */
770-- char name[]; /* Optional null-terminated name */
771-- };
772--
773-- XXX We can perhaps use parseD monad instance for fusing with parseMany? Need
774-- to measure the perf.
775--
776readOneEvent :: Config -> Watch -> Parser IO Word8 Event
777readOneEvent cfg wt@(Watch _ wdMap) = do
778 let headerLen = (sizeOf (undefined :: CInt)) + 12
779 arr <- PR.takeEQ headerLen (A.writeN headerLen)
780 (ewd, eflags, cookie, pathLen) <- PR.yieldM $ A.asPtr arr readHeader
781 -- XXX need the "initial" in parsers to return a step type so that "take 0"
782 -- can return without an input. otherwise if pathLen is 0 we will keep
783 -- waiting to read one more char before we return this event.
784 path <-
785 if pathLen /= 0
786 then do
787 -- XXX sliceSepByMax drops the separator so assumes a null
788 -- terminated path, we should use a takeWhile nested inside a
789 -- takeP
790 pth <- PR.sliceSepByMax (== 0) pathLen (A.writeN pathLen)
791 let remaining = pathLen - A.length pth - 1
792 when (remaining /= 0) $ PR.takeEQ remaining FL.drain
793 return pth
794 else return $ A.fromList []
795 wdm <- PR.yieldM $ readIORef wdMap
796 let (root, sub) =
797 case Map.lookup (fromIntegral ewd) wdm of
798 Just pair -> pair
799 Nothing ->
800 error $ "readOneEvent: "
801 <> "Unknown watch descriptor: "
802 <> show ewd
803 let -- "sub" is guaranteed to have a trailing "/"
804 sub1 = sub <> path
805 -- Check for "ISDIR" first because it is less likely
806 isDirCreate = eflags .&. iN_ISDIR /= 0 && eflags .&. iN_CREATE /= 0
807 when (watchRec cfg && isDirCreate)
808 $ PR.yieldM $ addToWatch cfg wt root sub1
809 -- XXX Handle IN_DELETE, IN_DELETE_SELF, IN_MOVE_SELF, IN_MOVED_FROM,
810 -- IN_MOVED_TO
811 -- What if a large dir tree gets moved in to our hierarchy? Do we get a
812 -- single event for the top level dir in this case?
813 return $ Event
814 { eventWd = (fromIntegral ewd)
815 , eventFlags = eflags
816 , eventCookie = cookie
817 , eventRelPath = sub1
818 , eventMap = wdm
819 }
821 where
823 readHeader (ptr :: Ptr Word8) = do
824 let len = sizeOf (undefined :: CInt)
825 ewd <- peek ptr
826 eflags <- peekByteOff ptr len
827 cookie <- peekByteOff ptr (len + 4)
828 pathLen :: Word32 <- peekByteOff ptr (len + 8)
829 return (ewd, eflags, cookie, fromIntegral pathLen)
831watchToStream :: Config -> Watch -> SerialT IO Event
832watchToStream cfg wt@(Watch handle _) = do
833 -- Do not use too small a buffer. As per inotify man page:
834 --
835 -- The behavior when the buffer given to read(2) is too small to return
836 -- information about the next event depends on the kernel version: in
837 -- kernels before 2.6.21, read(2) returns 0; since kernel 2.6.21, read(2)
838 -- fails with the error EINVAL. Specifying a buffer of size
839 --
840 -- sizeof(struct inotify_event) + NAME_MAX + 1
841 --
842 -- will be sufficient to read at least one event.
843 S.parseMany (readOneEvent cfg wt) $ S.unfold FH.read handle
845-- | Start monitoring a list of file system paths for file system events with
846-- the supplied configuration operation over the 'defaultConfig'. The
847-- paths could be files or directories. When the path is a directory, only the
848-- files and directories directly under the watched directory are monitored,
849-- contents of subdirectories are not monitored. Monitoring starts from the
850-- current time onwards. The paths are specified as "/" separated 'Array' of
851-- 'Word8'.
852--
853-- @
854-- watchPathsWith
855-- ('setFollowSymLinks' On . 'setUnwatchMoved' Off)
856-- [Array.fromCString\# "dir"#]
857-- @
858--
859-- /Internal/
860--
861watchPathsWith ::
862 (Config -> Config) -> NonEmpty (Array Word8) -> SerialT IO Event
863watchPathsWith f = watchTreesWith (f . setRecursiveMode False)
865-- | Like 'watchPathsWith' but uses the 'defaultConfig' options.
866--
867-- @
868-- watchPaths = watchPathsWith id
869-- @
870--
871-- /Internal/
872--
873watchPaths :: NonEmpty (Array Word8) -> SerialT IO Event
874watchPaths = watchPathsWith id
876-- XXX We should not go across the mount points of network file systems or file
877-- systems that are known to not generate any events.
878--
879-- | Start monitoring a list of file system paths for file system events with
880-- the supplied configuration operation over the 'defaultConfig'. The
881-- paths could be files or directories. When the path is a directory, the
882-- whole directory tree under it is watched recursively. Monitoring starts from
883-- the current time onwards.
884--
885-- Note that recrusive watch on a large directory tree could be expensive. When
886-- starting a watch, the whole tree must be read and watches are started on
887-- each directory in the tree. The initial time to start the watch as well as
888-- the memory required is proportional to the number of directories in the
889-- tree.
890--
891-- When new directories are created under the tree they are added to the watch
892-- on receiving the directory create event. However, the creation of a dir and
893-- adding a watch for it is not atomic. The implementation takes care of this
894-- and makes sure that watches are added for all directories. However, In the
895-- mean time, the directory may have received more events which may get lost.
896-- Handling of any such lost events is yet to be implemented.
897--
898-- See the Linux __inotify__ man page for more details.
899--
900-- /Internal/
901--
902watchTreesWith ::
903 (Config -> Config) -> NonEmpty (Array Word8) -> SerialT IO Event
904watchTreesWith f paths = S.bracket before after (watchToStream cfg)
906 where
908 cfg = f defaultConfig
909 before = liftIO $ openWatch cfg paths
910 after = liftIO . closeWatch
912-- | Like 'watchTreesWith' but uses the 'defaultConfig' options.
913--
914-- @
915-- watchTrees = watchTreesWith id
916-- @
917--
918watchTrees :: NonEmpty (Array Word8) -> SerialT IO Event
919watchTrees = watchTreesWith id
921-------------------------------------------------------------------------------
922-- Examine event stream
923-------------------------------------------------------------------------------
925-- | Get the watch root corresponding to the 'Event'.
926--
927-- Note that if a path was moved after adding to the watch, this will give the
928-- original path and not the new path after moving.
929--
930-- TBD: we can possibly update the watch root on a move self event.
931--
932-- /Internal/
933--
934getRoot :: Event -> Array Word8
935getRoot Event{..} =
936 if (eventWd >= 1)
937 then
938 case Map.lookup (fromIntegral eventWd) eventMap of
939 Just path -> fst path
940 Nothing ->
941 error $ "Bug: getRoot: No path found corresponding to the "
942 ++ "watch descriptor " ++ show eventWd
943 else A.fromList []
945-- XXX should we use a Maybe here?
946-- | Get the file system object path for which the event is generated, relative
947-- to the watched root. The path is a "/" separated array of bytes.
948--
949-- /Internal/
950--
951getRelPath :: Event -> Array Word8
952getRelPath Event{..} = eventRelPath
954-- XXX should we use a Maybe?
955-- | Cookie is set when a rename occurs. The cookie value can be used to
956-- connect the 'isMovedFrom' and 'isMovedTo' events, if both the events belong
957-- to the same move operation then they will have the same cookie value.
958--
959-- /Internal/
960--
961getCookie :: Event -> Cookie
962getCookie Event{..} = Cookie eventCookie
964-------------------------------------------------------------------------------
965-- Event types
966-------------------------------------------------------------------------------
968getFlag :: Word32 -> Event -> Bool
969getFlag mask Event{..} = eventFlags .&. mask /= 0
971-------------------------------------------------------------------------------
972-- Error events
973-------------------------------------------------------------------------------
975foreign import capi
976 "sys/inotify.h value IN_Q_OVERFLOW" iN_Q_OVERFLOW :: Word32
978-- XXX rename to isQOverflowed or hasOverflowed?
979--
980-- macOS overflow API is more specific, it tells which paths have lost the
981-- events due to overflow.
982--
983-- | Event queue overflowed (WD is invalid for this event) and we may have lost
984-- some events.. The user application must scan everything under the watched
985-- paths to know the current state.
986--
987-- /Internal/
988--
989isOverflow :: Event -> Bool
990isOverflow = getFlag iN_Q_OVERFLOW
992-------------------------------------------------------------------------------
993-- Events affecting the watched path only
994-------------------------------------------------------------------------------
996foreign import capi
997 "sys/inotify.h value IN_IGNORED" iN_IGNORED :: Word32
999-- Compare with isRootChanged on macOS. isRootChanged includes all these cases.
1001-- | A path was removed from the watch explicitly using 'removeFromWatch' or
1002-- automatically (file was deleted, or filesystem was unmounted).
1004-- /Occurs only for a watched path/
1006-- /Internal/
1008isRootUnwatched :: Event -> Bool
1009isRootUnwatched = getFlag iN_IGNORED
1011-- | Watched file/directory was itself deleted. (This event also occurs if an
1012-- object is moved to another filesystem, since mv(1) in effect copies the file
1013-- to the other filesystem and then deletes it from the original filesystem.)
1014-- In addition, an 'isRootUnwatched' event will subsequently be generated
1015-- for the watch descriptor.
1017-- /Occurs only for a watched path/
1019-- /Internal/
1021isRootDeleted :: Event -> Bool
1022isRootDeleted = getFlag iN_DELETE_SELF
1024-- | Watched file/directory was itself moved within the file system.
1026-- /Occurs only for a watched path/
1028-- /Internal/
1030isRootMoved :: Event -> Bool
1031isRootMoved = getFlag iN_MOVE_SELF
1033foreign import capi
1034 "sys/inotify.h value IN_UNMOUNT" iN_UNMOUNT :: Word32
1036-- | Filesystem containing watched object was unmounted. In addition, an
1037-- 'isRootUnwatched' event will subsequently be generated for the watch
1038-- descriptor.
1040-- /Occurs only for a watched path/
1042-- /Internal/
1044isRootUnmounted :: Event -> Bool
1045isRootUnmounted = getFlag iN_UNMOUNT
1047-------------------------------------------------------------------------------
1048-- Metadata change Events
1049-------------------------------------------------------------------------------
1051-- macOS has multiple APIs for metadata change for different metadata.
1053-- | Determine whether the event indicates inode metadata change for an object
1054-- contained within the monitored path.
1056-- Metadata change may include, permissions (e.g., chmod(2)), timestamps
1057-- (e.g., utimensat(2)), extended attributes (setxattr(2)), link count (since
1058-- Linux 2.6.25; e.g., for the target of link(2) and for unlink(2)), and
1059-- user/group ID (e.g., chown(2)).
1061-- /Can occur for watched path or a file inside it/
1063-- /Internal/
1065isMetadataChanged :: Event -> Bool
1066isMetadataChanged = getFlag iN_ATTRIB
1068-------------------------------------------------------------------------------
1069-- Access
1070-------------------------------------------------------------------------------
1072-- | File was accessed (e.g. read, execve).
1074-- /Occurs only for a file inside the watched directory/
1076-- /Internal/
1078isAccessed :: Event -> Bool
1079isAccessed = getFlag iN_ACCESS
1081-- | File or directory was opened.
1083-- /Occurs only for a file inside the watched directory/
1085-- /Internal/
1087isOpened :: Event -> Bool
1088isOpened = getFlag iN_OPEN
1090-- | File opened for writing was closed.
1092-- /Occurs only for a file inside the watched directory/
1094-- /Internal/
1096isWriteClosed :: Event -> Bool
1097isWriteClosed = getFlag iN_CLOSE_WRITE
1099-- XXX what if it was opened for append? Does NOWRITE mean all cases where the
1100-- mode was not write? A dir open comes in this category?
1102-- | File or directory opened for read but not write was closed.
1104-- /Can occur for watched path or a file inside it/
1106-- /Internal/
1108isNonWriteClosed :: Event -> Bool
1109isNonWriteClosed = getFlag iN_CLOSE_NOWRITE
1111-------------------------------------------------------------------------------
1112-- CRUD Events
1113-------------------------------------------------------------------------------
1115-- On macOS this is not generated on hard linking but on Linux it is.
1117-- | File/directory created in watched directory (e.g., open(2) O_CREAT,
1118-- mkdir(2), link(2), symlink(2), bind(2) on a UNIX domain socket).
1120-- /Occurs only for an object inside the watched directory/
1122-- /Internal/
1124isCreated :: Event -> Bool
1125isCreated = getFlag iN_CREATE
1127-- | File/directory deleted from watched directory.
1129-- /Occurs only for an object inside the watched directory/
1131-- /Internal/
1133isDeleted :: Event -> Bool
1134isDeleted = getFlag iN_DELETE
1136-- XXX what if an object is moved in from outside or moved out of the monitored
1137-- dir?
1139-- | Generated for the original path when an object is moved from under a
1140-- monitored directory.
1142-- /Occurs only for an object inside the watched directory/
1144-- /Internal/
1146isMovedFrom :: Event -> Bool
1147isMovedFrom = getFlag iN_MOVED_FROM
1149-- | Generated for the new path when an object is moved under a monitored
1150-- directory.
1152-- /Occurs only for an object inside the watched directory/
1154-- /Internal/
1156isMovedTo :: Event -> Bool
1157isMovedTo = getFlag iN_MOVED_TO
1159-- | Determine whether the event indicates modification of an object within the
1160-- monitored path. This event is generated only for files and not directories.
1162-- /Occurs only for an object inside the watched directory/
1164-- /Internal/
1166isModified :: Event -> Bool
1167isModified = getFlag iN_MODIFY
1169-------------------------------------------------------------------------------
1170-- Information about path type (applicable only when 'setFileEvents' is 'On')
1171-------------------------------------------------------------------------------
1173foreign import capi
1174 "sys/inotify.h value IN_ISDIR" iN_ISDIR :: Word32
1176-- | Determine whether the event is for a directory path.
1178-- /Internal/
1180isDir :: Event -> Bool
1181isDir = getFlag iN_ISDIR
1183-------------------------------------------------------------------------------
1184-- Debugging
1185-------------------------------------------------------------------------------
1187-- | Convert an 'Event' record to a String representation.
1188showEvent :: Event -> String
1189showEvent ev@Event{..} =
1190 "--------------------------"
1191 ++ "\nWd = " ++ show eventWd
1192 ++ "\nRoot = " ++ show (utf8ToString $ getRoot ev)
1193 ++ "\nPath = " ++ show (utf8ToString $ getRelPath ev)
1194 ++ "\nCookie = " ++ show (getCookie ev)
1195 ++ "\nFlags " ++ show eventFlags
1197 ++ showev isOverflow "Overflow"
1199 ++ showev isRootUnwatched "RootUnwatched"
1200 ++ showev isRootDeleted "RootDeleted"
1201 ++ showev isRootMoved "RootMoved"
1202 ++ showev isRootUnmounted "RootUnmounted"
1204 ++ showev isMetadataChanged "MetadataChanged"
1206 ++ showev isAccessed "Accessed"
1207 ++ showev isOpened "Opened"
1208 ++ showev isWriteClosed "WriteClosed"
1209 ++ showev isNonWriteClosed "NonWriteClosed"
1211 ++ showev isCreated "Created"
1212 ++ showev isDeleted "Deleted"
1213 ++ showev isModified "Modified"
1214 ++ showev isMovedFrom "MovedFrom"
1215 ++ showev isMovedTo "MovedTo"
1217 ++ showev isDir "Dir"
1218 ++ "\n"
1220 where showev f str = if f ev then "\n" ++ str else ""
1221#else
1222#warning "Disabling module Streamly.Internal.FileSystem.Event.Linux. Does not support kernels older than 2.6.36."
1223module Streamly.Internal.FileSystem.Event.Linux () where
1224#endif