on bb74cdd help sign in
1274 lines 39 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 , setMetadataChanged
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 , isMetadataChanged
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(..))
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
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 :: Bool -> Config -> Config
249setRecursiveMode rec cfg@Config{} = cfg {watchRec = rec}
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-- /default: On/
258--
259-- /Pre-release/
260--
261setFollowSymLinks :: Toggle -> Config -> Config
262setFollowSymLinks s = setFlag iN_DONT_FOLLOW (toggle s)
264foreign import capi
265 "sys/inotify.h value IN_EXCL_UNLINK" iN_EXCL_UNLINK :: Word32
267-- | If an object moves out of the directory being watched then stop watching
268-- it.
269--
270-- /default: On/
271--
272-- /Pre-release/
273--
274setUnwatchMoved :: Toggle -> Config -> Config
275setUnwatchMoved = setFlag iN_EXCL_UNLINK
277#if HAVE_DECL_IN_MASK_CREATE
278foreign import capi
279 "sys/inotify.h value IN_MASK_CREATE" iN_MASK_CREATE :: Word32
280#endif
282foreign import capi
283 "sys/inotify.h value IN_MASK_ADD" iN_MASK_ADD :: Word32
285-- | What to do if a watch already exists when 'openWatch' or 'addToWatch' is
286-- called for a path.
287--
288-- /Pre-release/
289--
290data WhenExists =
291 AddIfExists -- ^ Do not set an existing setting to 'Off' only set to 'On'
292 | ReplaceIfExists -- ^ Replace the existing settings with new settings
293#if HAVE_DECL_IN_MASK_CREATE
294 | FailIfExists -- ^ Fail the API
295#endif
297-- | When adding a new path to the watch, specify what to do if a watch already
298-- exists on that path.
299--
300-- /default: FailIfExists/
301--
302-- /Pre-release/
303--
304setWhenExists :: WhenExists -> Config -> Config
305setWhenExists val cfg =
306 case val of
307 AddIfExists -> setFlag iN_MASK_ADD On cfg
308 ReplaceIfExists -> setFlag iN_MASK_ADD Off cfg
309#if HAVE_DECL_IN_MASK_CREATE
310 FailIfExists -> setFlag iN_MASK_CREATE On cfg
311#endif
313foreign import capi
314 "sys/inotify.h value IN_ONESHOT" iN_ONESHOT :: Word32
316-- | Watch the object only for one event and then remove it from the watch.
317--
318-- /default: Off/
319--
320-- /Pre-release/
321--
322setOneShot :: Toggle -> Config -> Config
323setOneShot = setFlag iN_ONESHOT
325foreign import capi
326 "sys/inotify.h value IN_ONLYDIR" iN_ONLYDIR :: Word32
328-- | Watch the object only if it is a directory. This provides a race-free way
329-- to ensure that the watched object is a directory.
330--
331-- /default: Off/
332--
333-- /Pre-release/
334--
335setOnlyDir :: Toggle -> Config -> Config
336setOnlyDir = setFlag iN_ONLYDIR
338-------------------------------------------------------------------------------
339-- Event types that can occur
340-------------------------------------------------------------------------------
342foreign import capi
343 "sys/inotify.h value IN_DELETE_SELF" iN_DELETE_SELF :: Word32
345-- | Report when the watched path itself gets deleted.
346--
347-- /default: On/
348--
349-- /Pre-release/
350--
351setRootDeleted :: Toggle -> Config -> Config
352setRootDeleted = setFlag iN_DELETE_SELF
354foreign import capi
355 "sys/inotify.h value IN_MOVE_SELF" iN_MOVE_SELF :: Word32
357-- | Report when the watched root path itself gets renamed.
358--
359-- /default: On/
360--
361-- /Pre-release/
362--
363setRootMoved :: Toggle -> Config -> Config
364setRootMoved = setFlag iN_MOVE_SELF
366-- | Report when the watched root path itself gets deleted or renamed.
367--
368-- /default: On/
369--
370-- /Pre-release/
371--
372setRootPathEvents :: Toggle -> Config -> Config
373setRootPathEvents = setFlag (iN_DELETE_SELF .|. iN_MOVE_SELF)
375foreign import capi
376 "sys/inotify.h value IN_ATTRIB" iN_ATTRIB :: Word32
378-- | Report when the metadata e.g. owner, permission modes, modifications times
379-- of an object changes.
380--
381-- /default: On/
382--
383-- /Pre-release/
384--
385setMetadataChanged :: Toggle -> Config -> Config
386setMetadataChanged = setFlag iN_ATTRIB
388foreign import capi
389 "sys/inotify.h value IN_ACCESS" iN_ACCESS :: Word32
391-- | Report when a file is accessed.
392--
393-- /default: On/
394--
395-- /Pre-release/
396--
397setAccessed :: Toggle -> Config -> Config
398setAccessed = setFlag iN_ACCESS
400foreign import capi
401 "sys/inotify.h value IN_OPEN" iN_OPEN :: Word32
403-- | Report when a file is opened.
404--
405-- /default: On/
406--
407-- /Pre-release/
408--
409setOpened :: Toggle -> Config -> Config
410setOpened = setFlag iN_OPEN
412foreign import capi
413 "sys/inotify.h value IN_CLOSE_WRITE" iN_CLOSE_WRITE :: Word32
415-- | Report when a file that was opened for writes is closed.
416--
417-- /default: On/
418--
419-- /Pre-release/
420--
421setWriteClosed :: Toggle -> Config -> Config
422setWriteClosed = setFlag iN_CLOSE_WRITE
424foreign import capi
425 "sys/inotify.h value IN_CLOSE_NOWRITE" iN_CLOSE_NOWRITE :: Word32
427-- | Report when a file that was opened for not writing is closed.
428--
429-- /default: On/
430--
431-- /Pre-release/
432--
433setNonWriteClosed :: Toggle -> Config -> Config
434setNonWriteClosed = setFlag iN_CLOSE_NOWRITE
436foreign import capi
437 "sys/inotify.h value IN_CREATE" iN_CREATE :: Word32
439-- | Report when a file is created.
440--
441-- /default: On/
442--
443-- /Pre-release/
444--
445setCreated :: Toggle -> Config -> Config
446setCreated = setFlag iN_CREATE
448foreign import capi
449 "sys/inotify.h value IN_DELETE" iN_DELETE :: Word32
451-- | Report when a file is deleted.
452--
453-- /default: On/
454--
455-- /Pre-release/
456--
457setDeleted :: Toggle -> Config -> Config
458setDeleted = setFlag iN_DELETE
460foreign import capi
461 "sys/inotify.h value IN_MOVED_FROM" iN_MOVED_FROM :: Word32
463-- | Report the source of a move.
464--
465-- /default: On/
466--
467-- /Pre-release/
468--
469setMovedFrom :: Toggle -> Config -> Config
470setMovedFrom = setFlag iN_MOVED_FROM
472foreign import capi
473 "sys/inotify.h value IN_MOVED_TO" iN_MOVED_TO :: Word32
475-- | Report the target of a move.
476--
477-- /default: On/
478--
479-- /Pre-release/
480--
481setMovedTo :: Toggle -> Config -> Config
482setMovedTo = setFlag iN_MOVED_TO
484foreign import capi
485 "sys/inotify.h value IN_MODIFY" iN_MODIFY :: Word32
487-- | Report when a file is modified.
488--
489-- /default: On/
490--
491-- /Pre-release/
492--
493setModified :: Toggle -> Config -> Config
494setModified = setFlag iN_MODIFY
496-- | Set all tunable events 'On' or 'Off'. Equivalent to setting:
497--
498-- * setRootDeleted
499-- * setRootMoved
500-- * setMetadataChanged
501-- * setAccessed
502-- * setOpened
503-- * setWriteClosed
504-- * setNonWriteClosed
505-- * setCreated
506-- * setDeleted
507-- * setMovedFrom
508-- * setMovedTo
509-- * setModified
510--
511-- /Pre-release/
512--
513setAllEvents :: Toggle -> Config -> Config
514setAllEvents s cfg =
515 ( setRootDeleted s
516 . setRootMoved s
517 . setMetadataChanged s
518 . setAccessed s
519 . setOpened s
520 . setWriteClosed s
521 . setNonWriteClosed s
522 . setCreated s
523 . setDeleted s
524 . setMovedFrom s
525 . setMovedTo s
526 . setModified s
527 ) cfg
529-------------------------------------------------------------------------------
530-- Default config
531-------------------------------------------------------------------------------
533-- The defaults are set in such a way that the behavior on macOS and Linux is
534-- as much compatible as possible.
535--
536-- | The default configuration settings are:
537--
538-- * 'setFollowSymLinks' 'On'
539-- * 'setUnwatchMoved' 'On'
540-- * 'setOneShot' 'Off'
541-- * 'setOnlyDir' 'Off'
542-- * 'setWhenExists' 'AddIfExists'
543--
544-- The tunable events enabled by default are:
545--
546-- * setCreated On
547-- * setDeleted On
548-- * setMovedFrom On
549-- * setMovedTo On
550-- * setModified On
551--
552-- /Pre-release/
553--
554defaultConfig :: Config
555defaultConfig =
556 setWhenExists AddIfExists
557 $ setCreated On
558 $ setDeleted On
559 $ setMovedFrom On
560 $ setMovedTo On
561 $ setModified On
562 $ Config
563 { watchRec = True
564 , createFlags = 0
565 }
567-------------------------------------------------------------------------------
568-- Open an event stream
569-------------------------------------------------------------------------------
571-- | A handle for a watch.
572data Watch =
573 Watch
574 Handle -- File handle for the watch
575 (IORef
576 (IntMap -- Key is the watch descriptor
577 ( Array Word8 -- Absolute path of the watch root
578 , Array Word8 -- Path of subdir relative to watch root
579 )
580 )
581 )
583-- Instead of using the watch descriptor we can provide APIs that use the path
584-- itself to identify the watch. That will require us to maintain a map from wd
585-- to path in the Watch handle.
587newtype WD = WD CInt deriving Show
589foreign import ccall unsafe
590 "sys/inotify.h inotify_init" c_inotify_init :: IO CInt
592-- | Create a 'Watch' handle. 'addToWatch' can be used to add paths being
593-- monitored by this watch.
594--
595-- /Pre-release/
596--
597createWatch :: IO Watch
598createWatch = do
599 rawfd <- throwErrnoIfMinus1 "createWatch" c_inotify_init
600 -- we could use fdToHandle but it cannot determine the fd type
601 -- automatically for the inotify fd
602 (fd, fdType) <-
603 mkFD
604 rawfd
605 ReadMode
606 (Just (Stream, 0, 0)) -- (IODeviceType, CDev, CIno)
607 False -- not a socket
608 False -- non-blocking is false
609 let fdString = "<createWatch file descriptor: " ++ show fd ++ ">"
610 h <-
611 mkHandleFromFD
612 fd
613 fdType
614 fdString
615 ReadMode
616 True -- use non-blocking IO
617 Nothing -- TextEncoding (binary)
618 emptyMapRef <- newIORef Map.empty
619 return $ Watch h emptyMapRef
621foreign import ccall unsafe
622 "sys/inotify.h inotify_add_watch" c_inotify_add_watch
623 :: CInt -> CString -> CUInt -> IO CInt
625-- XXX we really do not know the path encoding, all we know is that it is "/"
626-- separated bytes. So these may fail or convert the path in an unexpected
627-- manner. We should ultimately remove all usage of these.
629toUtf8 :: MonadIO m => String -> m (Array Word8)
630toUtf8 = A.fromStream . U.encodeUtf8 . S.fromList
632utf8ToString :: Array Word8 -> String
633utf8ToString = runIdentity . S.toList . U.decodeUtf8' . A.toStream
635#if !MIN_VERSION_base(4,10,0)
636-- | Turn an existing Handle into a file descriptor. This function throws an
637-- IOError if the Handle does not reference a file descriptor.
638handleToFd :: Handle -> IO FD
639handleToFd h = case h of
640 FileHandle _ mv -> do
641 Handle__{haDevice = dev} <- readMVar mv
642 case cast dev of
643 Just fd -> return fd
644 Nothing -> throwErr "not a file descriptor"
645 DuplexHandle{} -> throwErr "not a file handle"
647 where
649 throwErr msg = ioException $ IOError (Just h)
650 InappropriateType "handleToFd" msg Nothing Nothing
651#endif
653-- | Add a trailing "/" at the end of the path if there is none. Do not add a
654-- "/" if the path is empty.
655--
656ensureTrailingSlash :: Array Word8 -> Array Word8
657ensureTrailingSlash path =
658 if A.length path /= 0
659 then
660 let mx = A.getIndex path (A.length path - 1)
661 in case mx of
662 Nothing -> error "ensureTrailingSlash: Bug: Invalid index"
663 Just x ->
664 if x /= fromIntegral (ord '/')
665 then path <> A.fromCString# "/"#
666 else path
667 else path
669-- | @addToWatch cfg watch root subpath@ adds @subpath@ to the list of paths
670-- being monitored under @root@ via the watch handle @watch@. @root@ must be
671-- an absolute path and @subpath@ must be relative to @root@.
672--
673-- /Pre-release/
674--
675addToWatch :: Config -> Watch -> Array Word8 -> Array Word8 -> IO ()
676addToWatch cfg@Config{..} watch0@(Watch handle wdMap) root0 path0 = do
677 -- XXX do not add if the path is already added
678 -- XXX if the watch is added by the scan and not via an event we can
679 -- generate a create event assuming that the create may have been lost. We
680 -- can also mark in the map that this entry was added by the scan. So if an
681 -- actual create event later comes and tries to add this again then we can
682 -- ignore that and drop the create event to avoid duplicate create, because
683 -- we have already emitted it.
684 --
685 -- When a directory is added by the scan we should also emit create events
686 -- for files that may have got added to the dir. However, such create
687 -- events may get duplicated because of a race between the scan generated
688 -- versus real events.
689 --
690 -- Or we may distinguish between scan generated events and real events so
691 -- that the application can assume that other events may been lost and
692 -- handle it. For example, if it is a dir create the application can read
693 -- the dir to scan the files in it.
694 --
695 let root = ensureTrailingSlash root0
696 path = ensureTrailingSlash path0
697 absPath = root <> path
698 fd <- handleToFd handle
700 -- XXX we need to tolerate an error where we are adding a watch for a
701 -- non-existing file because the file may have got deleted by the time we
702 -- added the watch. Perhaps we can have a flag in config for this and keep
703 -- the default value to tolerate the error.
704 --
705 -- XXX The file may have even got deleted and then recreated which we will
706 -- never get to know, document this.
707 wd <- A.unsafeAsCString absPath $ \pathPtr ->
708 throwErrnoIfMinus1 ("addToWatch: " ++ utf8ToString absPath) $
709 c_inotify_add_watch (fdFD fd) pathPtr (CUInt createFlags)
711 -- We add the parent first so that we start getting events for any new
712 -- creates and add the new subdirectories on creates while we are adding
713 -- the children.
714 modifyIORef wdMap (Map.insert (fromIntegral wd) (root, path))
716 -- Now add the children. If we missed any creates while we were adding the
717 -- parent, this will make sure they are added too.
718 --
719 -- XXX Ensure that we generate events that we may have missed while we were
720 -- adding the dirs.
721 --
722 -- XXX toDirs currently uses paths as String, we need to convert it
723 -- to "/" separated by byte arrays.
724 when watchRec $ do
725 S.mapM_ (\p -> addToWatch cfg watch0 root (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_ (\p -> addToWatch cfg w p (A.fromList [])) $ NonEmpty.toList paths
767 return w
769-- | Close a 'Watch' handle.
770--
771-- /Pre-release/
772--
773closeWatch :: Watch -> IO ()
774closeWatch (Watch h _) = hClose h
776-------------------------------------------------------------------------------
777-- Raw events read from the watch file handle
778-------------------------------------------------------------------------------
780newtype Cookie = Cookie Word32 deriving (Show, Eq)
782-- | An Event generated by the file system. Use the accessor functions to
783-- examine the event.
784--
785-- /Pre-release/
786--
787data Event = Event
788 { eventWd :: CInt
789 , eventFlags :: Word32
790 , eventCookie :: Word32
791 , eventRelPath :: Array Word8
792 , eventMap :: IntMap (Array Word8, Array Word8)
793 } deriving (Show, Ord, Eq)
795-- The inotify event struct from the man page/header file:
796--
797-- struct inotify_event {
798-- int wd; /* Watch descriptor */
799-- uint32_t mask; /* Mask describing event */
800-- uint32_t cookie; /* Unique cookie associating related
801-- events (for rename(2)) */
802-- uint32_t len; /* Size of name field */
803-- char name[]; /* Optional null-terminated name */
804-- };
805--
806-- XXX We can perhaps use parseD monad instance for fusing with parseMany? Need
807-- to measure the perf.
808--
809readOneEvent :: Config -> Watch -> Parser IO Word8 Event
810readOneEvent cfg wt@(Watch _ wdMap) = do
811 let headerLen = (sizeOf (undefined :: CInt)) + 12
812 arr <- PR.takeEQ headerLen (A.writeN headerLen)
813 (ewd, eflags, cookie, pathLen) <- PR.fromEffect $ A.unsafeAsPtr arr readHeader
814 -- XXX need the "initial" in parsers to return a step type so that "take 0"
815 -- can return without an input. otherwise if pathLen is 0 we will keep
816 -- waiting to read one more char before we return this event.
817 path <-
818 if pathLen /= 0
819 then do
820 -- XXX takeEndBy_ drops the separator so assumes a null
821 -- terminated path, we should use a takeWhile nested inside a
822 -- takeP
823 pth <-
824 PR.fromFold
825 $ FL.takeEndBy_ (== 0)
826 $ FL.take pathLen (A.writeN pathLen)
827 let remaining = pathLen - A.length pth - 1
828 when (remaining /= 0) $ PR.takeEQ remaining FL.drain
829 return pth
830 else return $ A.fromList []
831 wdm <- PR.fromEffect $ readIORef wdMap
832 let (root, sub) =
833 case Map.lookup (fromIntegral ewd) wdm of
834 Just pair -> pair
835 Nothing ->
836 error $ "readOneEvent: "
837 <> "Unknown watch descriptor: "
838 <> show ewd
839 let -- "sub" is guaranteed to have a trailing "/"
840 sub1 = sub <> path
841 -- Check for "ISDIR" first because it is less likely
842 isDirCreate = eflags .&. iN_ISDIR /= 0 && eflags .&. iN_CREATE /= 0
843 when (watchRec cfg && isDirCreate)
844 $ PR.fromEffect $ addToWatch cfg wt root sub1
845 -- XXX Handle IN_DELETE, IN_DELETE_SELF, IN_MOVE_SELF, IN_MOVED_FROM,
846 -- IN_MOVED_TO
847 -- What if a large dir tree gets moved in to our hierarchy? Do we get a
848 -- single event for the top level dir in this case?
849 return $ Event
850 { eventWd = (fromIntegral ewd)
851 , eventFlags = eflags
852 , eventCookie = cookie
853 , eventRelPath = sub1
854 , eventMap = wdm
855 }
857 where
859 readHeader (ptr :: Ptr Word8) = do
860 let len = sizeOf (undefined :: CInt)
861 ewd <- peek ptr
862 eflags <- peekByteOff ptr len
863 cookie <- peekByteOff ptr (len + 4)
864 pathLen :: Word32 <- peekByteOff ptr (len + 8)
865 return (ewd, eflags, cookie, fromIntegral pathLen)
867watchToStream :: Config -> Watch -> SerialT IO Event
868watchToStream cfg wt@(Watch handle _) = do
869 -- Do not use too small a buffer. As per inotify man page:
870 --
871 -- The behavior when the buffer given to read(2) is too small to return
872 -- information about the next event depends on the kernel version: in
873 -- kernels before 2.6.21, read(2) returns 0; since kernel 2.6.21, read(2)
874 -- fails with the error EINVAL. Specifying a buffer of size
875 --
876 -- sizeof(struct inotify_event) + NAME_MAX + 1
877 --
878 -- will be sufficient to read at least one event.
879 S.parseMany (readOneEvent cfg wt) $ S.unfold FH.read handle
881-- XXX We should not go across the mount points of network file systems or file
882-- systems that are known to not generate any events.
883--
884-- | Start monitoring a list of file system paths for file system events with
885-- the supplied configuration operation over the 'defaultConfig'. The
886-- paths could be files or directories. When recursive mode is set and the
887-- path is a directory, the whole directory tree under it is watched
888-- recursively. Monitoring starts from the current time onwards. The paths are
889-- specified as UTF-8 encoded 'Array' of 'Word8'.
890--
891-- Note that recrusive watch on a large directory tree could be expensive. When
892-- starting a watch, the whole tree must be read and watches are started on
893-- each directory in the tree. The initial time to start the watch as well as
894-- the memory required is proportional to the number of directories in the
895-- tree.
896--
897-- When new directories are created under the tree they are added to the watch
898-- on receiving the directory create event. However, the creation of a dir and
899-- adding a watch for it is not atomic. The implementation takes care of this
900-- and makes sure that watches are added for all directories. However, In the
901-- mean time, the directory may have received more events which may get lost.
902-- Handling of any such lost events is yet to be implemented.
903--
904-- See the Linux __inotify__ man page for more details.
905--
906-- @
907-- watchwith
908-- ('setFollowSymLinks' On . 'setUnwatchMoved' Off)
909-- [Array.fromCString\# "dir"#]
910-- @
911--
912-- /Pre-release/
913--
914watchWith :: (Config -> Config) -> NonEmpty (Array Word8) -> SerialT IO Event
915watchWith f paths = S.bracket before after (watchToStream cfg)
917 where
919 cfg = f defaultConfig
920 before = liftIO $ openWatch cfg paths
921 after = liftIO . closeWatch
923-- | Same as 'watchWith' using 'defaultConfig' and recursive mode.
924--
925-- >>> watchRecursive = watchWith id
926--
927-- /Pre-release/
928--
929watchRecursive :: NonEmpty (Array Word8) -> SerialT IO Event
930watchRecursive = watchWith id
932-- | Same as 'watchWith' using defaultConfig and non-recursive mode.
933--
934-- >>> watch = watchWith (setRecursiveMode False)
935--
936-- /Pre-release/
937--
938watch :: NonEmpty (Array Word8) -> SerialT IO Event
939watch = watchWith (setRecursiveMode False)
941-------------------------------------------------------------------------------
942-- Examine event stream
943-------------------------------------------------------------------------------
945-- | Get the watch root corresponding to the 'Event'.
946--
947-- Note that if a path was moved after adding to the watch, this will give the
948-- original path and not the new path after moving.
949--
950-- TBD: we can possibly update the watch root on a move self event.
951--
952-- /Pre-release/
953--
954getRoot :: Event -> Array Word8
955getRoot Event{..} =
956 if (eventWd >= 1)
957 then
958 case Map.lookup (fromIntegral eventWd) eventMap of
959 Just path -> fst path
960 Nothing ->
961 error $ "Bug: getRoot: No path found corresponding to the "
962 ++ "watch descriptor " ++ show eventWd
963 else A.fromList []
965-- XXX should we use a Maybe here?
966-- | Get the file system object path for which the event is generated, relative
967-- to the watched root. The path is a "/" separated array of bytes.
968--
969-- /Pre-release/
970--
971getRelPath :: Event -> Array Word8
972getRelPath Event{..} = eventRelPath
974-- | Get the absolute file system object path for which the event is generated.
975--
976-- /Pre-release/
977--
978getAbsPath :: Event -> Array Word8
979getAbsPath ev = ensureTrailingSlash (getRoot ev) <> getRelPath ev
981-- XXX should we use a Maybe?
982-- | Cookie is set when a rename occurs. The cookie value can be used to
983-- connect the 'isMovedFrom' and 'isMovedTo' events, if both the events belong
984-- to the same move operation then they will have the same cookie value.
985--
986-- /Pre-release/
987--
988getCookie :: Event -> Cookie
989getCookie Event{..} = Cookie eventCookie
991-------------------------------------------------------------------------------
992-- Event types
993-------------------------------------------------------------------------------
995getFlag :: Word32 -> Event -> Bool
996getFlag mask Event{..} = eventFlags .&. mask /= 0
998-------------------------------------------------------------------------------
999-- Error events
1000-------------------------------------------------------------------------------
1002foreign import capi
1003 "sys/inotify.h value IN_Q_OVERFLOW" iN_Q_OVERFLOW :: Word32
1005-- XXX rename to isQOverflowed or hasOverflowed?
1007-- macOS overflow API is more specific, it tells which paths have lost the
1008-- events due to overflow.
1010-- | Event queue overflowed (WD is invalid for this event) and we may have lost
1011-- some events.. The user application must scan everything under the watched
1012-- paths to know the current state.
1014-- /Pre-release/
1016isEventsLost :: Event -> Bool
1017isEventsLost = getFlag iN_Q_OVERFLOW
1019-------------------------------------------------------------------------------
1020-- Events affecting the watched path only
1021-------------------------------------------------------------------------------
1023foreign import capi
1024 "sys/inotify.h value IN_IGNORED" iN_IGNORED :: Word32
1026-- Compare with isRootChanged on macOS. isRootChanged includes all these cases.
1028-- | A path was removed from the watch explicitly using 'removeFromWatch' or
1029-- automatically (file was deleted, or filesystem was unmounted).
1031-- /Occurs only for a watched path/
1033-- /Pre-release/
1035isRootUnwatched :: Event -> Bool
1036isRootUnwatched = getFlag iN_IGNORED
1038-- | Watched file/directory was itself deleted. (This event also occurs if an
1039-- object is moved to another filesystem, since mv(1) in effect copies the file
1040-- to the other filesystem and then deletes it from the original filesystem.)
1041-- In addition, an 'isRootUnwatched' event will subsequently be generated
1042-- for the watch descriptor.
1044-- /Occurs only for a watched path/
1046-- /Pre-release/
1048isRootDeleted :: Event -> Bool
1049isRootDeleted = getFlag iN_DELETE_SELF
1051-- | Watched file/directory was itself moved within the file system.
1053-- /Occurs only for a watched path/
1055-- /Pre-release/
1057isRootMoved :: Event -> Bool
1058isRootMoved = getFlag iN_MOVE_SELF
1060foreign import capi
1061 "sys/inotify.h value IN_UNMOUNT" iN_UNMOUNT :: Word32
1063-- | Filesystem containing watched object was unmounted. In addition, an
1064-- 'isRootUnwatched' event will subsequently be generated for the watch
1065-- descriptor.
1067-- /Occurs only for a watched path/
1069-- /Pre-release/
1071isRootUnmounted :: Event -> Bool
1072isRootUnmounted = getFlag iN_UNMOUNT
1074-- | Determine whether the event indicates a change of path of the monitored
1075-- object itself. Note that the object may become unreachable or deleted after
1076-- a change of path.
1078-- /Occurs only for a watched path/
1080-- /Pre-release/
1082isRootPathEvent :: Event -> Bool
1083isRootPathEvent = getFlag (iN_DELETE_SELF .|. iN_MOVE_SELF .|. iN_UNMOUNT)
1085-------------------------------------------------------------------------------
1086-- Metadata change Events
1087-------------------------------------------------------------------------------
1089-- macOS has multiple APIs for metadata change for different metadata.
1091-- | Determine whether the event indicates inode metadata change for an object
1092-- contained within the monitored path.
1094-- Metadata change may include, permissions (e.g., chmod(2)), timestamps
1095-- (e.g., utimensat(2)), extended attributes (setxattr(2)), link count (since
1096-- Linux 2.6.25; e.g., for the target of link(2) and for unlink(2)), and
1097-- user/group ID (e.g., chown(2)).
1099-- /Can occur for watched path or a file inside it/
1101-- /Pre-release/
1103isMetadataChanged :: Event -> Bool
1104isMetadataChanged = getFlag iN_ATTRIB
1106-------------------------------------------------------------------------------
1107-- Access
1108-------------------------------------------------------------------------------
1110-- | File was accessed (e.g. read, execve).
1112-- /Occurs only for a file inside the watched directory/
1114-- /Pre-release/
1116isAccessed :: Event -> Bool
1117isAccessed = getFlag iN_ACCESS
1119-- | File or directory was opened.
1121-- /Occurs only for a file inside the watched directory/
1123-- /Pre-release/
1125isOpened :: Event -> Bool
1126isOpened = getFlag iN_OPEN
1128-- | File opened for writing was closed.
1130-- /Occurs only for a file inside the watched directory/
1132-- /Pre-release/
1134isWriteClosed :: Event -> Bool
1135isWriteClosed = getFlag iN_CLOSE_WRITE
1137-- XXX what if it was opened for append? Does NOWRITE mean all cases where the
1138-- mode was not write? A dir open comes in this category?
1140-- | File or directory opened for read but not write was closed.
1142-- /Can occur for watched path or a file inside it/
1144-- /Pre-release/
1146isNonWriteClosed :: Event -> Bool
1147isNonWriteClosed = getFlag iN_CLOSE_NOWRITE
1149-------------------------------------------------------------------------------
1150-- CRUD Events
1151-------------------------------------------------------------------------------
1153-- On macOS this is not generated on hard linking but on Linux it is.
1155-- | File/directory created in watched directory (e.g., open(2) O_CREAT,
1156-- mkdir(2), link(2), symlink(2), bind(2) on a UNIX domain socket).
1158-- /Occurs only for an object inside the watched directory/
1160-- /Pre-release/
1162isCreated :: Event -> Bool
1163isCreated = getFlag iN_CREATE
1165-- | File/directory deleted from watched directory.
1167-- /Occurs only for an object inside the watched directory/
1169-- /Pre-release/
1171isDeleted :: Event -> Bool
1172isDeleted = getFlag iN_DELETE
1174-- XXX what if an object is moved in from outside or moved out of the monitored
1175-- dir?
1177-- | Generated for the original path when an object is moved from under a
1178-- monitored directory.
1180-- /Occurs only for an object inside the watched directory/
1182-- /Pre-release/
1184isMovedFrom :: Event -> Bool
1185isMovedFrom = getFlag iN_MOVED_FROM
1187-- | Generated for the new path when an object is moved under a monitored
1188-- directory.
1190-- /Occurs only for an object inside the watched directory/
1192-- /Pre-release/
1194isMovedTo :: Event -> Bool
1195isMovedTo = getFlag iN_MOVED_TO
1197-- | Generated for a path that is moved from or moved to the monitored
1198-- directory.
1200-- >>> isMoved ev = isMovedFrom ev || isMovedTo ev
1202-- /Occurs only for an object inside the watched directory/
1204-- /Pre-release/
1206isMoved :: Event -> Bool
1207isMoved ev = isMovedFrom ev || isMovedTo ev
1209-- | Determine whether the event indicates modification of an object within the
1210-- monitored path. This event is generated only for files and not directories.
1212-- /Occurs only for an object inside the watched directory/
1214-- /Pre-release/
1216isModified :: Event -> Bool
1217isModified = getFlag iN_MODIFY
1219-------------------------------------------------------------------------------
1220-- Information about path type (applicable only when 'setFileEvents' is 'On')
1221-------------------------------------------------------------------------------
1223foreign import capi
1224 "sys/inotify.h value IN_ISDIR" iN_ISDIR :: Word32
1226-- | Determine whether the event is for a directory path.
1228-- /Pre-release/
1230isDir :: Event -> Bool
1231isDir = getFlag iN_ISDIR
1233-------------------------------------------------------------------------------
1234-- Debugging
1235-------------------------------------------------------------------------------
1237-- | Convert an 'Event' record to a String representation.
1238showEvent :: Event -> String
1239showEvent ev@Event{..} =
1240 "--------------------------"
1241 ++ "\nWd = " ++ show eventWd
1242 ++ "\nRoot = " ++ show (utf8ToString $ getRoot ev)
1243 ++ "\nPath = " ++ show (utf8ToString $ getRelPath ev)
1244 ++ "\nCookie = " ++ show (getCookie ev)
1245 ++ "\nFlags " ++ show eventFlags
1247 ++ showev isEventsLost "Overflow"
1249 ++ showev isRootUnwatched "RootUnwatched"
1250 ++ showev isRootDeleted "RootDeleted"
1251 ++ showev isRootMoved "RootMoved"
1252 ++ showev isRootUnmounted "RootUnmounted"
1254 ++ showev isMetadataChanged "MetadataChanged"
1256 ++ showev isAccessed "Accessed"
1257 ++ showev isOpened "Opened"
1258 ++ showev isWriteClosed "WriteClosed"
1259 ++ showev isNonWriteClosed "NonWriteClosed"
1261 ++ showev isCreated "Created"
1262 ++ showev isDeleted "Deleted"
1263 ++ showev isModified "Modified"
1264 ++ showev isMovedFrom "MovedFrom"
1265 ++ showev isMovedTo "MovedTo"
1267 ++ showev isDir "Dir"
1268 ++ "\n"
1270 where showev f str = if f ev then "\n" ++ str else ""
1271#else
1272#warning "Disabling module Streamly.Internal.FileSystem.Event.Linux. Does not support kernels older than 2.6.36."
1273module Streamly.Internal.FileSystem.Event.Linux () where
1274#endif