on a05abfc help sign in
1321 lines 41 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 , 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.Foreign.Type (Array(..), byteLength)
178import System.IO (Handle, hClose, IOMode(ReadMode))
179#if !MIN_VERSION_base(4,10,0)
180import Control.Concurrent.MVar (readMVar)
181import Data.Typeable (cast)
182import GHC.IO.Exception (IOException(..), IOErrorType(..), ioException)
183import GHC.IO.FD (FD)
184import GHC.IO.Handle.Types (Handle__(..), Handle(FileHandle, DuplexHandle))
185#else
186import GHC.IO.Handle.FD (handleToFd)
187#endif
189import qualified Data.IntMap.Lazy as Map
190import qualified Data.List.NonEmpty as NonEmpty
191import qualified Streamly.Internal.Data.Array.Foreign as A
192import qualified Streamly.Internal.Data.Fold as FL
193import qualified Streamly.Internal.Data.Parser as PR
194import qualified Streamly.Internal.Data.Stream.IsStream as S
195import qualified Streamly.Internal.FileSystem.Dir as Dir
196import qualified Streamly.Internal.FileSystem.Handle as FH
197import qualified Streamly.Internal.Unicode.Stream as U
199-------------------------------------------------------------------------------
200-- Subscription to events
201-------------------------------------------------------------------------------
203-- | Watch configuration, used to specify the events of interest and the
204-- behavior of the watch.
205--
206-- /Pre-release/
207--
208data Config = Config
209 { watchRec :: Bool
210 , createFlags :: Word32
211 }
213-------------------------------------------------------------------------------
214-- Boolean settings
215-------------------------------------------------------------------------------
217-- XXX Change Toggle to "OnOff" or "Switch". The name Toggle may be confusing.
218--
219-- | Whether a setting is 'On' or 'Off'.
220--
221-- /Pre-release/
222--
223data Toggle = On | Off deriving (Show, Eq)
225toggle :: Toggle -> Toggle
226toggle On = Off
227toggle Off = On
229setFlag :: Word32 -> Toggle -> Config -> Config
230setFlag mask status cfg@Config{..} =
231 let flags =
232 case status of
233 On -> createFlags .|. mask
234 Off -> createFlags .&. complement mask
235 in cfg {createFlags = flags}
237-------------------------------------------------------------------------------
238-- Settings
239-------------------------------------------------------------------------------
241-- | Watch the whole directory tree recursively instead of watching just one
242-- level of directory.
243--
244-- /default: Off/
245--
246-- /Pre-release/
247--
248setRecursiveMode :: Toggle -> Config -> Config
249setRecursiveMode rec cfg@Config{} = cfg {watchRec = rec == On}
251foreign import capi
252 "sys/inotify.h value IN_DONT_FOLLOW" iN_DONT_FOLLOW :: Word32
254-- | If the pathname to be watched is a symbolic link then watch the target of
255-- the symbolic link instead of the symbolic link itself.
256--
257-- Note that the path location in the events is through the original symbolic
258-- link path rather than the resolved path.
259--
260-- /default: On/
261--
262-- /Pre-release/
263--
264setFollowSymLinks :: Toggle -> Config -> Config
265setFollowSymLinks s = setFlag iN_DONT_FOLLOW (toggle s)
267foreign import capi
268 "sys/inotify.h value IN_EXCL_UNLINK" iN_EXCL_UNLINK :: Word32
270-- | If an object moves out of the directory being watched then stop watching
271-- it.
272--
273-- /default: On/
274--
275-- /Pre-release/
276--
277setUnwatchMoved :: Toggle -> Config -> Config
278setUnwatchMoved = setFlag iN_EXCL_UNLINK
280#if HAVE_DECL_IN_MASK_CREATE
281foreign import capi
282 "sys/inotify.h value IN_MASK_CREATE" iN_MASK_CREATE :: Word32
283#endif
285foreign import capi
286 "sys/inotify.h value IN_MASK_ADD" iN_MASK_ADD :: Word32
288-- | What to do if a watch already exists when 'openWatch' or 'addToWatch' is
289-- called for a path.
290--
291-- /Pre-release/
292--
293data WhenExists =
294 AddIfExists -- ^ Do not set an existing setting to 'Off' only set to 'On'
295 | ReplaceIfExists -- ^ Replace the existing settings with new settings
296#if HAVE_DECL_IN_MASK_CREATE
297 | FailIfExists -- ^ Fail the API
298#endif
300-- | When adding a new path to the watch, specify what to do if a watch already
301-- exists on that path.
302--
303-- /default: FailIfExists/
304--
305-- /Pre-release/
306--
307setWhenExists :: WhenExists -> Config -> Config
308setWhenExists val cfg =
309 case val of
310 AddIfExists -> setFlag iN_MASK_ADD On cfg
311 ReplaceIfExists -> setFlag iN_MASK_ADD Off cfg
312#if HAVE_DECL_IN_MASK_CREATE
313 FailIfExists -> setFlag iN_MASK_CREATE On cfg
314#endif
316foreign import capi
317 "sys/inotify.h value IN_ONESHOT" iN_ONESHOT :: Word32
319-- | Watch the object only for one event and then remove it from the watch.
320--
321-- /default: Off/
322--
323-- /Pre-release/
324--
325setOneShot :: Toggle -> Config -> Config
326setOneShot = setFlag iN_ONESHOT
328foreign import capi
329 "sys/inotify.h value IN_ONLYDIR" iN_ONLYDIR :: Word32
331-- | Watch the object only if it is a directory. This provides a race-free way
332-- to ensure that the watched object is a directory.
333--
334-- /default: Off/
335--
336-- /Pre-release/
337--
338setOnlyDir :: Toggle -> Config -> Config
339setOnlyDir = setFlag iN_ONLYDIR
341-------------------------------------------------------------------------------
342-- Event types that can occur
343-------------------------------------------------------------------------------
345foreign import capi
346 "sys/inotify.h value IN_DELETE_SELF" iN_DELETE_SELF :: Word32
348-- | Report when the watched path itself gets deleted.
349--
350-- /default: On/
351--
352-- /Pre-release/
353--
354setRootDeleted :: Toggle -> Config -> Config
355setRootDeleted = setFlag iN_DELETE_SELF
357foreign import capi
358 "sys/inotify.h value IN_MOVE_SELF" iN_MOVE_SELF :: Word32
360-- | Report when the watched root path itself gets renamed.
361--
362-- /default: On/
363--
364-- /Pre-release/
365--
366setRootMoved :: Toggle -> Config -> Config
367setRootMoved = setFlag iN_MOVE_SELF
369-- | Report when the watched root path itself gets deleted or renamed.
370--
371-- /default: On/
372--
373-- /Pre-release/
374--
375setRootPathEvents :: Toggle -> Config -> Config
376setRootPathEvents = setFlag (iN_DELETE_SELF .|. iN_MOVE_SELF)
378foreign import capi
379 "sys/inotify.h value IN_ATTRIB" iN_ATTRIB :: Word32
381-- | Report when the metadata e.g. owner, permission modes, modifications times
382-- of an object changes.
383--
384-- /default: On/
385--
386-- /Pre-release/
387--
388setAttrsModified :: Toggle -> Config -> Config
389setAttrsModified = setFlag iN_ATTRIB
391foreign import capi
392 "sys/inotify.h value IN_ACCESS" iN_ACCESS :: Word32
394-- | Report when a file is accessed.
395--
396-- /default: On/
397--
398-- /Pre-release/
399--
400setAccessed :: Toggle -> Config -> Config
401setAccessed = setFlag iN_ACCESS
403foreign import capi
404 "sys/inotify.h value IN_OPEN" iN_OPEN :: Word32
406-- | Report when a file is opened.
407--
408-- /default: On/
409--
410-- /Pre-release/
411--
412setOpened :: Toggle -> Config -> Config
413setOpened = setFlag iN_OPEN
415foreign import capi
416 "sys/inotify.h value IN_CLOSE_WRITE" iN_CLOSE_WRITE :: Word32
418-- | Report when a file that was opened for writes is closed.
419--
420-- /default: On/
421--
422-- /Pre-release/
423--
424setWriteClosed :: Toggle -> Config -> Config
425setWriteClosed = setFlag iN_CLOSE_WRITE
427foreign import capi
428 "sys/inotify.h value IN_CLOSE_NOWRITE" iN_CLOSE_NOWRITE :: Word32
430-- | Report when a file that was opened for not writing is closed.
431--
432-- /default: On/
433--
434-- /Pre-release/
435--
436setNonWriteClosed :: Toggle -> Config -> Config
437setNonWriteClosed = setFlag iN_CLOSE_NOWRITE
439foreign import capi
440 "sys/inotify.h value IN_CREATE" iN_CREATE :: Word32
442-- | Report when a file is created.
443--
444-- /default: On/
445--
446-- /Pre-release/
447--
448setCreated :: Toggle -> Config -> Config
449setCreated = setFlag iN_CREATE
451foreign import capi
452 "sys/inotify.h value IN_DELETE" iN_DELETE :: Word32
454-- | Report when a file is deleted.
455--
456-- /default: On/
457--
458-- /Pre-release/
459--
460setDeleted :: Toggle -> Config -> Config
461setDeleted = setFlag iN_DELETE
463foreign import capi
464 "sys/inotify.h value IN_MOVED_FROM" iN_MOVED_FROM :: Word32
466-- | Report the source of a move.
467--
468-- /default: On/
469--
470-- /Pre-release/
471--
472setMovedFrom :: Toggle -> Config -> Config
473setMovedFrom = setFlag iN_MOVED_FROM
475foreign import capi
476 "sys/inotify.h value IN_MOVED_TO" iN_MOVED_TO :: Word32
478-- | Report the target of a move.
479--
480-- /default: On/
481--
482-- /Pre-release/
483--
484setMovedTo :: Toggle -> Config -> Config
485setMovedTo = setFlag iN_MOVED_TO
487foreign import capi
488 "sys/inotify.h value IN_MODIFY" iN_MODIFY :: Word32
490-- | Report when a file is modified.
491--
492-- /default: On/
493--
494-- /Pre-release/
495--
496setModified :: Toggle -> Config -> Config
497setModified = setFlag iN_MODIFY
499-- | Set all tunable events 'On' or 'Off'. Equivalent to setting:
500--
501-- * setRootDeleted
502-- * setRootMoved
503-- * setAttrsModified
504-- * setAccessed
505-- * setOpened
506-- * setWriteClosed
507-- * setNonWriteClosed
508-- * setCreated
509-- * setDeleted
510-- * setMovedFrom
511-- * setMovedTo
512-- * setModified
513--
514-- /Pre-release/
515--
516setAllEvents :: Toggle -> Config -> Config
517setAllEvents s =
518 setRootDeleted s
519 . setRootMoved s
520 . setAttrsModified s
521 . setAccessed s
522 . setOpened s
523 . setWriteClosed s
524 . setNonWriteClosed s
525 . setCreated s
526 . setDeleted s
527 . setMovedFrom s
528 . setMovedTo s
529 . setModified s
531-------------------------------------------------------------------------------
532-- Default config
533-------------------------------------------------------------------------------
535-- The defaults are set in such a way that the behavior on macOS and Linux is
536-- as much compatible as possible.
537--
538-- | The default configuration settings are:
539--
540-- * 'setFollowSymLinks' 'On'
541-- * 'setUnwatchMoved' 'On'
542-- * 'setOneShot' 'Off'
543-- * 'setOnlyDir' 'Off'
544-- * 'setWhenExists' 'AddIfExists'
545--
546-- The tunable events enabled by default are:
547--
548-- * setCreated On
549-- * setDeleted On
550-- * setMovedFrom On
551-- * setMovedTo On
552-- * setModified On
553--
554-- /Pre-release/
555--
556defaultConfig :: Config
557defaultConfig =
558 setWhenExists AddIfExists
559 $ setCreated On
560 $ setDeleted On
561 $ setMovedFrom On
562 $ setMovedTo On
563 $ setModified On
564 $ Config
565 { watchRec = False
566 , createFlags = 0
567 }
569-------------------------------------------------------------------------------
570-- Open an event stream
571-------------------------------------------------------------------------------
573-- | A handle for a watch.
574data Watch =
575 Watch
576 Handle -- File handle for the watch
577 (IORef
578 (IntMap -- Key is the watch descriptor
579 ( Array Word8 -- Absolute path of the watch root
580 , Array Word8 -- Path of subdir relative to watch root
581 )
582 )
583 )
585-- Instead of using the watch descriptor we can provide APIs that use the path
586-- itself to identify the watch. That will require us to maintain a map from wd
587-- to path in the Watch handle.
589newtype WD = WD CInt deriving Show
591foreign import ccall unsafe
592 "sys/inotify.h inotify_init" c_inotify_init :: IO CInt
594-- | Create a 'Watch' handle. 'addToWatch' can be used to add paths being
595-- monitored by this watch.
596--
597-- /Pre-release/
598--
599createWatch :: IO Watch
600createWatch = do
601 rawfd <- throwErrnoIfMinus1 "createWatch" c_inotify_init
602 -- we could use fdToHandle but it cannot determine the fd type
603 -- automatically for the inotify fd
604 (fd, fdType) <-
605 mkFD
606 rawfd
607 ReadMode
608 (Just (Stream, 0, 0)) -- (IODeviceType, CDev, CIno)
609 False -- not a socket
610 False -- non-blocking is false
611 let fdString = "<createWatch file descriptor: " ++ show fd ++ ">"
612 h <-
613 mkHandleFromFD
614 fd
615 fdType
616 fdString
617 ReadMode
618 True -- use non-blocking IO
619 Nothing -- TextEncoding (binary)
620 emptyMapRef <- newIORef Map.empty
621 return $ Watch h emptyMapRef
623foreign import ccall unsafe
624 "sys/inotify.h inotify_add_watch" c_inotify_add_watch
625 :: CInt -> CString -> CUInt -> IO CInt
627-- XXX we really do not know the path encoding, all we know is that it is "/"
628-- separated bytes. So these may fail or convert the path in an unexpected
629-- manner. We should ultimately remove all usage of these.
631toUtf8 :: MonadIO m => String -> m (Array Word8)
632toUtf8 = A.fromStream . U.encodeUtf8 . S.fromList
634utf8ToString :: Array Word8 -> String
635utf8ToString = runIdentity . S.toList . U.decodeUtf8' . A.toStream
637#if !MIN_VERSION_base(4,10,0)
638-- | Turn an existing Handle into a file descriptor. This function throws an
639-- IOError if the Handle does not reference a file descriptor.
640handleToFd :: Handle -> IO FD
641handleToFd h = case h of
642 FileHandle _ mv -> do
643 Handle__{haDevice = dev} <- readMVar mv
644 case cast dev of
645 Just fd -> return fd
646 Nothing -> throwErr "not a file descriptor"
647 DuplexHandle{} -> throwErr "not a file handle"
649 where
651 throwErr msg = ioException $ IOError (Just h)
652 InappropriateType "handleToFd" msg Nothing Nothing
653#endif
655-- | Add a trailing "/" at the end of the path if there is none. Do not add a
656-- "/" if the path is empty.
657--
658ensureTrailingSlash :: Array Word8 -> Array Word8
659ensureTrailingSlash path =
660 if byteLength path /= 0
661 then
662 let mx = A.getIndex path (byteLength path - 1)
663 in case mx of
664 Nothing -> error "ensureTrailingSlash: Bug: Invalid index"
665 Just x ->
666 if x /= fromIntegral (ord '/')
667 then path <> A.fromCString# "/"#
668 else path
669 else path
671removeTrailingSlash :: Array Word8 -> Array Word8
672removeTrailingSlash path =
673 if byteLength path /= 0
674 then
675 let n = byteLength path - 1
676 mx = A.getIndex path n
677 in case mx of
678 Nothing -> error "removeTrailingSlash: Bug: Invalid index"
679 Just x ->
680 if x == fromIntegral (ord '/')
681 then A.getSliceUnsafe 0 n path
682 else path
683 else path
685appendPaths :: Array Word8 -> Array Word8 -> Array Word8
686appendPaths a b
687 | byteLength a == 0 = b
688 | byteLength b == 0 = a
689 | otherwise = ensureTrailingSlash a <> b
691-- | @addToWatch cfg watch root subpath@ adds @subpath@ to the list of paths
692-- being monitored under @root@ via the watch handle @watch@. @root@ must be
693-- an absolute path and @subpath@ must be relative to @root@.
694--
695-- /Pre-release/
696--
697addToWatch :: Config -> Watch -> Array Word8 -> Array Word8 -> IO ()
698addToWatch cfg@Config{..} watch0@(Watch handle wdMap) root0 path0 = do
699 -- XXX do not add if the path is already added
700 -- XXX if the watch is added by the scan and not via an event we can
701 -- generate a create event assuming that the create may have been lost. We
702 -- can also mark in the map that this entry was added by the scan. So if an
703 -- actual create event later comes and tries to add this again then we can
704 -- ignore that and drop the create event to avoid duplicate create, because
705 -- we have already emitted it.
706 --
707 -- When a directory is added by the scan we should also emit create events
708 -- for files that may have got added to the dir. However, such create
709 -- events may get duplicated because of a race between the scan generated
710 -- versus real events.
711 --
712 -- Or we may distinguish between scan generated events and real events so
713 -- that the application can assume that other events may been lost and
714 -- handle it. For example, if it is a dir create the application can read
715 -- the dir to scan the files in it.
716 --
717 let root = removeTrailingSlash root0
718 path = removeTrailingSlash path0
719 absPath = appendPaths root path
720 putStrLn $ "root = " ++ utf8ToString root ++ " path = " ++ utf8ToString path ++ " absPath = " ++ utf8ToString absPath
722 fd <- handleToFd handle
724 -- XXX we need to tolerate an error where we are adding a watch for a
725 -- non-existing file because the file may have got deleted by the time we
726 -- added the watch. Perhaps we can have a flag in config for this and keep
727 -- the default value to tolerate the error.
728 --
729 -- XXX The file may have even got deleted and then recreated which we will
730 -- never get to know, document this.
731 wd <- A.unsafeAsCString absPath $ \pathPtr ->
732 throwErrnoIfMinus1 ("addToWatch: " ++ utf8ToString absPath) $
733 c_inotify_add_watch (fdFD fd) pathPtr (CUInt createFlags)
735 -- We add the parent first so that we start getting events for any new
736 -- creates and add the new subdirectories on creates while we are adding
737 -- the children.
738 modifyIORef wdMap (Map.insert (fromIntegral wd) (root, path))
740 -- Now add the children. If we missed any creates while we were adding the
741 -- parent, this will make sure they are added too.
742 --
743 -- XXX Ensure that we generate events that we may have missed while we were
744 -- adding the dirs. That may generate spurious events though.
745 --
746 -- XXX toDirs currently uses paths as String, we need to convert it
747 -- to "/" separated by byte arrays.
748 when watchRec $ do
749 S.mapM_ (\p -> addToWatch cfg watch0 root (appendPaths path p))
750 $ S.mapM toUtf8
751 $ Dir.toDirs $ utf8ToString absPath
753foreign import ccall unsafe
754 "sys/inotify.h inotify_rm_watch" c_inotify_rm_watch
755 :: CInt -> CInt -> IO CInt
757-- | Remove an absolute root path from a 'Watch', if a path was moved after
758-- adding you need to provide the original path which was used to add the
759-- Watch.
760--
761-- /Pre-release/
762--
763removeFromWatch :: Watch -> Array Word8 -> IO ()
764removeFromWatch (Watch handle wdMap) path = do
765 fd <- handleToFd handle
766 km <- readIORef wdMap
767 wdMap1 <- foldlM (step fd) Map.empty (Map.toList km)
768 writeIORef wdMap wdMap1
770 where
772 step fd newMap (wd, v) = do
773 if fst v == path
774 then do
775 let err = "removeFromWatch: " ++ show (utf8ToString path)
776 rm = c_inotify_rm_watch (fdFD fd) (fromIntegral wd)
777 void $ throwErrnoIfMinus1 err rm
778 return newMap
779 else return $ Map.insert wd v newMap
781-- | Given a 'Config' and list of @paths@ ("/" separated byte arrays) start
782-- monitoring the paths for file system events. Returns a 'Watch' handle which
783-- can then be used to read the event stream or to close the watch.
784--
785-- /Pre-release/
786--
787openWatch :: Config -> NonEmpty (Array Word8) -> IO Watch
788openWatch cfg paths = do
789 w <- createWatch
790 mapM_
791 (\root -> addToWatch cfg w root (A.fromList []))
792 $ NonEmpty.toList paths
793 return w
795-- | Close a 'Watch' handle.
796--
797-- /Pre-release/
798--
799closeWatch :: Watch -> IO ()
800closeWatch (Watch h _) = hClose h
802-------------------------------------------------------------------------------
803-- Raw events read from the watch file handle
804-------------------------------------------------------------------------------
806newtype Cookie = Cookie Word32 deriving (Show, Eq)
808-- | An Event generated by the file system. Use the accessor functions to
809-- examine the event.
810--
811-- /Pre-release/
812--
813data Event = Event
814 { eventWd :: CInt
815 , eventFlags :: Word32
816 , eventCookie :: Word32
817 , eventRelPath :: Array Word8
818 , eventMap :: IntMap (Array Word8, Array Word8)
819 } deriving (Show, Ord, Eq)
821-- The inotify event struct from the man page/header file:
822--
823-- struct inotify_event {
824-- int wd; /* Watch descriptor */
825-- uint32_t mask; /* Mask describing event */
826-- uint32_t cookie; /* Unique cookie associating related
827-- events (for rename(2)) */
828-- uint32_t len; /* Size of name field */
829-- char name[]; /* Optional null-terminated name */
830-- };
831--
832-- XXX We can perhaps use parseD monad instance for fusing with parseMany? Need
833-- to measure the perf.
834--
835readOneEvent :: Config -> Watch -> Parser IO Word8 Event
836readOneEvent cfg wt@(Watch _ wdMap) = do
837 let headerLen = sizeOf (undefined :: CInt) + 12
838 arr <- PR.takeEQ headerLen (A.writeN headerLen)
839 (ewd, eflags, cookie, pathLen) <- PR.fromEffect $ A.unsafeAsPtr arr readHeader
840 -- XXX need the "initial" in parsers to return a step type so that "take 0"
841 -- can return without an input. otherwise if pathLen is 0 we will keep
842 -- waiting to read one more char before we return this event.
843 path <-
844 if pathLen /= 0
845 then do
846 -- XXX takeEndBy_ drops the separator so assumes a null
847 -- terminated path, we should use a takeWhile nested inside a
848 -- takeP
849 pth <-
850 PR.fromFold
851 $ FL.takeEndBy_ (== 0)
852 $ FL.take pathLen (A.writeN pathLen)
853 let remaining = pathLen - byteLength pth - 1
854 when (remaining /= 0) $ PR.takeEQ remaining FL.drain
855 return pth
856 else return $ A.fromList []
857 wdm <- PR.fromEffect $ readIORef wdMap
858 let (root, sub) =
859 case Map.lookup (fromIntegral ewd) wdm of
860 Just pair -> pair
861 Nothing ->
862 error $ "readOneEvent: "
863 <> "Unknown watch descriptor: "
864 <> show ewd
865 let sub1 = appendPaths sub path
866 -- Check for "ISDIR" first because it is less likely
867 isDirCreate = eflags .&. iN_ISDIR /= 0 && eflags .&. iN_CREATE /= 0
868 when (watchRec cfg && isDirCreate)
869 $ PR.fromEffect $ addToWatch cfg wt root sub1
870 -- XXX Handle IN_DELETE, IN_DELETE_SELF, IN_MOVE_SELF, IN_MOVED_FROM,
871 -- IN_MOVED_TO
872 -- What if a large dir tree gets moved in to our hierarchy? Do we get a
873 -- single event for the top level dir in this case?
874 return $ Event
875 { eventWd = fromIntegral ewd
876 , eventFlags = eflags
877 , eventCookie = cookie
878 , eventRelPath = sub1
879 , eventMap = wdm
880 }
882 where
884 readHeader (ptr :: Ptr Word8) = do
885 let len = sizeOf (undefined :: CInt)
886 ewd <- peek ptr
887 eflags <- peekByteOff ptr len
888 cookie <- peekByteOff ptr (len + 4)
889 pathLen :: Word32 <- peekByteOff ptr (len + 8)
890 return (ewd, eflags, cookie, fromIntegral pathLen)
892watchToStream :: Config -> Watch -> SerialT IO Event
893watchToStream cfg wt@(Watch handle _) = do
894 -- Do not use too small a buffer. As per inotify man page:
895 --
896 -- The behavior when the buffer given to read(2) is too small to return
897 -- information about the next event depends on the kernel version: in
898 -- kernels before 2.6.21, read(2) returns 0; since kernel 2.6.21, read(2)
899 -- fails with the error EINVAL. Specifying a buffer of size
900 --
901 -- sizeof(struct inotify_event) + NAME_MAX + 1
902 --
903 -- will be sufficient to read at least one event.
904 S.parseMany (readOneEvent cfg wt) $ S.unfold FH.read handle
906-- XXX We should not go across the mount points of network file systems or file
907-- systems that are known to not generate any events.
908--
909-- | Start monitoring a list of file system paths for file system events with
910-- the supplied configuration operation over the 'defaultConfig'. The
911-- paths could be files or directories. When recursive mode is set and the
912-- path is a directory, the whole directory tree under it is watched
913-- recursively. Monitoring starts from the current time onwards. The paths are
914-- specified as UTF-8 encoded 'Array' of 'Word8'.
915--
916-- /Non-existing Paths:/ the API fails if a watch is started on a non-exsting
917-- path.
918--
919-- /Performance:/ Note that recursive watch on a large directory tree could be
920-- expensive. When starting a watch, the whole tree must be read and watches
921-- are started on each directory in the tree. The initial time to start the
922-- watch as well as the memory required is proportional to the number of
923-- directories in the tree.
924--
925-- /Bugs:/ When new directories are created under the tree they are added to
926-- the watch on receiving the directory create event. However, the creation of
927-- a dir and adding a watch for it is not atomic. The implementation takes
928-- care of this and makes sure that watches are added for all directories.
929-- However, In the mean time, the directory may have received more events which
930-- may get lost. Handling of any such lost events is yet to be implemented.
931--
932-- See the Linux __inotify__ man page for more details.
933--
934-- @
935-- watchwith
936-- ('setFollowSymLinks' On . 'setUnwatchMoved' Off)
937-- [Array.fromCString\# "dir"#]
938-- @
939--
940-- /Pre-release/
941--
942watchWith :: (Config -> Config) -> NonEmpty (Array Word8) -> SerialT IO Event
943watchWith f paths = S.bracket before after (watchToStream cfg)
945 where
947 cfg = f defaultConfig
948 before = liftIO $ openWatch cfg paths
949 after = liftIO . closeWatch
951-- | Same as 'watchWith' using 'defaultConfig' and recursive mode.
952--
953-- >>> watchRecursive = watchWith (setRecursiveMode On)
954--
955-- See 'watchWith' for pitfalls and bugs when using recursive watch on Linux.
956--
957-- /Pre-release/
958--
959watchRecursive :: NonEmpty (Array Word8) -> SerialT IO Event
960watchRecursive = watchWith (setRecursiveMode On)
962-- | Same as 'watchWith' using defaultConfig and non-recursive mode.
963--
964-- >>> watch = watchWith id
965--
966-- /Pre-release/
967--
968watch :: NonEmpty (Array Word8) -> SerialT IO Event
969watch = watchWith id
971-------------------------------------------------------------------------------
972-- Examine event stream
973-------------------------------------------------------------------------------
975-- | Get the watch root corresponding to the 'Event'.
976--
977-- Note that if a path was moved after adding to the watch, this will give the
978-- original path and not the new path after moving.
979--
980-- TBD: we can possibly update the watch root on a move self event.
981--
982-- /Pre-release/
983--
984getRoot :: Event -> Array Word8
985getRoot Event{..} =
986 if eventWd >= 1
987 then
988 case Map.lookup (fromIntegral eventWd) eventMap of
989 Just path -> fst path
990 Nothing ->
991 error $ "Bug: getRoot: No path found corresponding to the "
992 ++ "watch descriptor " ++ show eventWd
993 else A.fromList []
995-- XXX should we use a Maybe here?
996-- | Get the file system object path for which the event is generated, relative
997-- to the watched root. The path is a "/" separated array of bytes.
998--
999-- /Pre-release/
1001getRelPath :: Event -> Array Word8
1002getRelPath Event{..} = eventRelPath
1004-- | Get the absolute file system object path for which the event is generated.
1006-- When the watch root is a symlink, the absolute path returned is via the
1007-- original symlink and not through the resolved path.
1009-- /Pre-release/
1011getAbsPath :: Event -> Array Word8
1012getAbsPath ev =
1013 let relpath = getRelPath ev
1014 root = getRoot ev
1015 in if byteLength relpath /= 0
1016 then ensureTrailingSlash root <> relpath
1017 else removeTrailingSlash root
1019-- XXX should we use a Maybe?
1020-- | Cookie is set when a rename occurs. The cookie value can be used to
1021-- connect the 'isMovedFrom' and 'isMovedTo' events, if both the events belong
1022-- to the same move operation then they will have the same cookie value.
1024-- /Pre-release/
1026getCookie :: Event -> Cookie
1027getCookie Event{..} = Cookie eventCookie
1029-------------------------------------------------------------------------------
1030-- Event types
1031-------------------------------------------------------------------------------
1033getFlag :: Word32 -> Event -> Bool
1034getFlag mask Event{..} = eventFlags .&. mask /= 0
1036-------------------------------------------------------------------------------
1037-- Error events
1038-------------------------------------------------------------------------------
1040foreign import capi
1041 "sys/inotify.h value IN_Q_OVERFLOW" iN_Q_OVERFLOW :: Word32
1043-- XXX rename to isQOverflowed or hasOverflowed?
1045-- macOS overflow API is more specific, it tells which paths have lost the
1046-- events due to overflow.
1048-- | Event queue overflowed (WD is invalid for this event) and we may have lost
1049-- some events.. The user application must scan everything under the watched
1050-- paths to know the current state.
1052-- /Pre-release/
1054isEventsLost :: Event -> Bool
1055isEventsLost = getFlag iN_Q_OVERFLOW
1057-------------------------------------------------------------------------------
1058-- Events affecting the watched path only
1059-------------------------------------------------------------------------------
1061foreign import capi
1062 "sys/inotify.h value IN_IGNORED" iN_IGNORED :: Word32
1064-- Compare with isRootChanged on macOS. isRootChanged includes all these cases.
1066-- | A path was removed from the watch explicitly using 'removeFromWatch' or
1067-- automatically (file was deleted, or filesystem was unmounted).
1069-- Note that in recursive watch mode all the subdirectories are watch roots,
1070-- therefore, they will all generate this event.
1072-- /Occurs only for a watched path/
1074-- /Pre-release/
1076isRootUnwatched :: Event -> Bool
1077isRootUnwatched = getFlag iN_IGNORED
1079-- | Watched file/directory was itself deleted. (This event also occurs if an
1080-- object is moved to another filesystem, since mv(1) in effect copies the file
1081-- to the other filesystem and then deletes it from the original filesystem.)
1082-- In addition, an 'isRootUnwatched' event will subsequently be generated
1083-- for the watch descriptor.
1085-- Note that in recursive watch mode all the subdirectories are watch roots,
1086-- therefore, they will all generate this event.
1088-- /Occurs only for a watched path/
1090-- /Pre-release/
1092isRootDeleted :: Event -> Bool
1093isRootDeleted = getFlag iN_DELETE_SELF
1095-- | Watched file/directory was itself moved within the file system.
1097-- Note that in recursive watch mode all the subdirectories are watch roots,
1098-- therefore, they will all generate this event.
1100-- /Occurs only for a watched path/
1102-- /Pre-release/
1104isRootMoved :: Event -> Bool
1105isRootMoved = getFlag iN_MOVE_SELF
1107foreign import capi
1108 "sys/inotify.h value IN_UNMOUNT" iN_UNMOUNT :: Word32
1110-- | Filesystem containing watched object was unmounted. In addition, an
1111-- 'isRootUnwatched' event will subsequently be generated for the watch
1112-- descriptor.
1114-- /Occurs only for a watched path/
1116-- /Pre-release/
1118isRootUnmounted :: Event -> Bool
1119isRootUnmounted = getFlag iN_UNMOUNT
1121-- | Determine whether the event indicates a change of path of the monitored
1122-- object itself. Note that the object may become unreachable or deleted after
1123-- a change of path.
1125-- /Occurs only for a watched path/
1127-- /Pre-release/
1129isRootPathEvent :: Event -> Bool
1130isRootPathEvent = getFlag (iN_DELETE_SELF .|. iN_MOVE_SELF .|. iN_UNMOUNT)
1132-------------------------------------------------------------------------------
1133-- Metadata change Events
1134-------------------------------------------------------------------------------
1136-- macOS has multiple APIs for metadata change for different metadata.
1138-- | Determine whether the event indicates inode metadata change for an object
1139-- contained within the monitored path.
1141-- Metadata change may include, permissions (e.g., chmod(2)), timestamps
1142-- (e.g., utimensat(2)), extended attributes (setxattr(2)), link count (since
1143-- Linux 2.6.25; e.g., for the target of link(2) and for unlink(2)), and
1144-- user/group ID (e.g., chown(2)).
1146-- /Can occur for watched path or a file inside it/
1148-- /Pre-release/
1150isAttrsModified :: Event -> Bool
1151isAttrsModified = getFlag iN_ATTRIB
1153-------------------------------------------------------------------------------
1154-- Access
1155-------------------------------------------------------------------------------
1157-- | File was accessed (e.g. read, execve).
1159-- /Occurs only for a file inside the watched directory/
1161-- /Pre-release/
1163isAccessed :: Event -> Bool
1164isAccessed = getFlag iN_ACCESS
1166-- | File or directory was opened.
1168-- /Occurs only for a file inside the watched directory/
1170-- /Pre-release/
1172isOpened :: Event -> Bool
1173isOpened = getFlag iN_OPEN
1175-- | File opened for writing was closed.
1177-- /Occurs only for a file inside the watched directory/
1179-- /Pre-release/
1181isWriteClosed :: Event -> Bool
1182isWriteClosed = getFlag iN_CLOSE_WRITE
1184-- XXX what if it was opened for append? Does NOWRITE mean all cases where the
1185-- mode was not write? A dir open comes in this category?
1187-- | File or directory opened for read but not write was closed.
1189-- /Can occur for watched path or a file inside it/
1191-- /Pre-release/
1193isNonWriteClosed :: Event -> Bool
1194isNonWriteClosed = getFlag iN_CLOSE_NOWRITE
1196-------------------------------------------------------------------------------
1197-- CRUD Events
1198-------------------------------------------------------------------------------
1200-- On macOS this is not generated on hard linking but on Linux it is.
1202-- | File/directory created in watched directory (e.g., open(2) O_CREAT,
1203-- mkdir(2), link(2), symlink(2), bind(2) on a UNIX domain socket).
1205-- /Occurs only for an object inside the watched directory/
1207-- /Pre-release/
1209isCreated :: Event -> Bool
1210isCreated = getFlag iN_CREATE
1212-- | File/directory deleted from watched directory.
1214-- /Occurs only for an object inside the watched directory/
1216-- /Pre-release/
1218isDeleted :: Event -> Bool
1219isDeleted = getFlag iN_DELETE
1221-- XXX what if an object is moved in from outside or moved out of the monitored
1222-- dir?
1224-- | Generated for the original path when an object is moved from under a
1225-- monitored directory.
1227-- /Occurs only for an object inside the watched directory/
1229-- /Pre-release/
1231isMovedFrom :: Event -> Bool
1232isMovedFrom = getFlag iN_MOVED_FROM
1234-- | Generated for the new path when an object is moved under a monitored
1235-- directory.
1237-- /Occurs only for an object inside the watched directory/
1239-- /Pre-release/
1241isMovedTo :: Event -> Bool
1242isMovedTo = getFlag iN_MOVED_TO
1244-- | Generated for a path that is moved from or moved to the monitored
1245-- directory.
1247-- >>> isMoved ev = isMovedFrom ev || isMovedTo ev
1249-- /Occurs only for an object inside the watched directory/
1251-- /Pre-release/
1253isMoved :: Event -> Bool
1254isMoved ev = isMovedFrom ev || isMovedTo ev
1256-- | Determine whether the event indicates modification of an object within the
1257-- monitored path. This event is generated only for files and not directories.
1259-- /Occurs only for an object inside the watched directory/
1261-- /Pre-release/
1263isModified :: Event -> Bool
1264isModified = getFlag iN_MODIFY
1266-------------------------------------------------------------------------------
1267-- Information about path type (applicable only when 'setFileEvents' is 'On')
1268-------------------------------------------------------------------------------
1270foreign import capi
1271 "sys/inotify.h value IN_ISDIR" iN_ISDIR :: Word32
1273-- | Determine whether the event is for a directory path.
1275-- /Pre-release/
1277isDir :: Event -> Bool
1278isDir = getFlag iN_ISDIR
1280-------------------------------------------------------------------------------
1281-- Debugging
1282-------------------------------------------------------------------------------
1284-- | Convert an 'Event' record to a String representation.
1285showEvent :: Event -> String
1286showEvent ev@Event{..} =
1287 "--------------------------"
1288 ++ "\nWd = " ++ show eventWd
1289 ++ "\nRoot = " ++ show (utf8ToString $ getRoot ev)
1290 ++ "\nPath = " ++ show (utf8ToString $ getRelPath ev)
1291 ++ "\nCookie = " ++ show (getCookie ev)
1292 ++ "\nFlags " ++ show eventFlags
1294 ++ showev isEventsLost "Overflow"
1296 ++ showev isRootUnwatched "RootUnwatched"
1297 ++ showev isRootDeleted "RootDeleted"
1298 ++ showev isRootMoved "RootMoved"
1299 ++ showev isRootUnmounted "RootUnmounted"
1301 ++ showev isAttrsModified "AttrsModified"
1303 ++ showev isAccessed "Accessed"
1304 ++ showev isOpened "Opened"
1305 ++ showev isWriteClosed "WriteClosed"
1306 ++ showev isNonWriteClosed "NonWriteClosed"
1308 ++ showev isCreated "Created"
1309 ++ showev isDeleted "Deleted"
1310 ++ showev isModified "Modified"
1311 ++ showev isMovedFrom "MovedFrom"
1312 ++ showev isMovedTo "MovedTo"
1314 ++ showev isDir "Dir"
1315 ++ "\n"
1317 where showev f str = if f ev then "\n" ++ str else ""
1318#else
1319#warning "Disabling module Streamly.Internal.FileSystem.Event.Linux. Does not support kernels older than 2.6.36."
1320module Streamly.Internal.FileSystem.Event.Linux () where
1321#endif