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