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