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