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