{-# LINE 1 "src/System/Linux/Inotify.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
{-# LANGUAGE BangPatterns, DoAndIfThenElse #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module System.Linux.Inotify
( Inotify
, Watch(..)
, Event(..)
, Mask(..)
, isect
, isSubset
, hasOverlap
, WatchFlag
, EventFlag
, Cookie(..)
, init
, close
, isClosed
, initWith
, InotifyOptions(..)
, defaultInotifyOptions
, addWatch
, addWatch_
, rmWatch
, getEvent
, getEventNonBlocking
, getEventFromBuffer
, peekEvent
, peekEventNonBlocking
, peekEventFromBuffer
, in_ACCESS
, in_ATTRIB
, in_CLOSE
, in_CLOSE_WRITE
, in_CLOSE_NOWRITE
, in_CREATE
, in_DELETE
, in_DELETE_SELF
, in_MODIFY
, in_MOVE_SELF
, in_MOVE
, in_MOVED_FROM
, in_MOVED_TO
, in_OPEN
, in_ALL_EVENTS
, in_DONT_FOLLOW
, in_EXCL_UNLINK
, in_MASK_ADD
, in_ONESHOT
, in_ONLYDIR
, in_IGNORED
, in_ISDIR
, in_Q_OVERFLOW
, in_UNMOUNT
) where
import Prelude hiding (init)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import Data.Monoid
import Data.Typeable
import Data.Function ( on )
import Data.Word
import qualified Data.Semigroup as Sem
import Control.Exception ( IOException, throwIO, mask_, onException )
import GHC.Conc ( closeFdWith, threadWaitReadSTM, atomically )
import GHC.IO.Exception hiding ( IOException )
import Control.Concurrent.MVar
import Control.Monad
import System.Posix
import Data.IORef
import Foreign
import Foreign.C
import qualified Foreign.Concurrent as FC
import System.Posix.ByteString.FilePath (RawFilePath)
import Data.Hashable
data Inotify = Inotify
{ fdRef :: {-# UNPACK #-} !(MVar Fd)
, bufferLock :: {-# UNPACK #-} !(MVar ())
, buffer :: {-# UNPACK #-} !(ForeignPtr CChar)
, bufSize :: {-# UNPACK #-} !Int
, startRef :: {-# UNPACK #-} !(IORef Int)
, endRef :: {-# UNPACK #-} !(IORef Int)
} deriving (Eq, Typeable)
instance Show Inotify where
show Inotify{buffer} = "Inotify { buffer = " ++ show buffer ++ " }"
instance Ord Inotify where
compare = compare `on` buffer
newtype Watch = Watch CInt deriving (Eq, Ord, Show, Typeable)
instance Hashable Watch where
hashWithSalt salt (Watch (CInt x)) = hashWithSalt salt x
newtype Mask a = Mask Word32 deriving (Eq, Show, Typeable)
instance Sem.Semigroup (Mask a) where
Mask a <> Mask b = Mask (a .|. b)
instance Monoid (Mask a) where
mempty = Mask 0
{-# LINE 169 "src/System/Linux/Inotify.hsc" #-}
data EventFlag
data WatchFlag
isect :: Mask a -> Mask a -> Mask a
isect (Mask a) (Mask b) = Mask (a .&. b)
hasOverlap :: Mask a -> Mask a -> Bool
hasOverlap a b = isect a b /= Mask 0
isSubset :: Mask a -> Mask a -> Bool
isSubset a b = isect a b == a
in_ACCESS :: Mask a
in_ACCESS = Mask (1)
{-# LINE 193 "src/System/Linux/Inotify.hsc" #-}
in_ATTRIB :: Mask a
in_ATTRIB = Mask (4)
{-# LINE 199 "src/System/Linux/Inotify.hsc" #-}
in_CLOSE :: Mask a
in_CLOSE = Mask (24)
{-# LINE 204 "src/System/Linux/Inotify.hsc" #-}
in_CLOSE_WRITE :: Mask a
in_CLOSE_WRITE = Mask (8)
{-# LINE 209 "src/System/Linux/Inotify.hsc" #-}
in_CLOSE_NOWRITE :: Mask a
in_CLOSE_NOWRITE = Mask (16)
{-# LINE 214 "src/System/Linux/Inotify.hsc" #-}
in_CREATE :: Mask a
in_CREATE = Mask (256)
{-# LINE 218 "src/System/Linux/Inotify.hsc" #-}
in_DELETE :: Mask a
in_DELETE = Mask (512)
{-# LINE 222 "src/System/Linux/Inotify.hsc" #-}
in_DELETE_SELF :: Mask a
in_DELETE_SELF = Mask (1024)
{-# LINE 226 "src/System/Linux/Inotify.hsc" #-}
in_MODIFY :: Mask a
in_MODIFY = Mask (2)
{-# LINE 231 "src/System/Linux/Inotify.hsc" #-}
in_MOVE_SELF :: Mask a
in_MOVE_SELF = Mask (2048)
{-# LINE 235 "src/System/Linux/Inotify.hsc" #-}
in_MOVE :: Mask a
in_MOVE = Mask (192)
{-# LINE 240 "src/System/Linux/Inotify.hsc" #-}
in_MOVED_FROM :: Mask a
in_MOVED_FROM = Mask (64)
{-# LINE 245 "src/System/Linux/Inotify.hsc" #-}
in_MOVED_TO :: Mask a
in_MOVED_TO = Mask (128)
{-# LINE 250 "src/System/Linux/Inotify.hsc" #-}
in_OPEN :: Mask a
in_OPEN = Mask (32)
{-# LINE 255 "src/System/Linux/Inotify.hsc" #-}
in_ALL_EVENTS :: Mask a
in_ALL_EVENTS = Mask (4095)
{-# LINE 260 "src/System/Linux/Inotify.hsc" #-}
in_DONT_FOLLOW :: Mask WatchFlag
in_DONT_FOLLOW = Mask (33554432)
{-# LINE 264 "src/System/Linux/Inotify.hsc" #-}
in_EXCL_UNLINK :: Mask WatchFlag
in_EXCL_UNLINK = Mask (67108864)
{-# LINE 279 "src/System/Linux/Inotify.hsc" #-}
in_MASK_ADD :: Mask WatchFlag
in_MASK_ADD = Mask (536870912)
{-# LINE 284 "src/System/Linux/Inotify.hsc" #-}
in_ONESHOT :: Mask WatchFlag
in_ONESHOT = Mask (2147483648)
{-# LINE 288 "src/System/Linux/Inotify.hsc" #-}
in_ONLYDIR :: Mask WatchFlag
in_ONLYDIR = Mask (16777216)
{-# LINE 292 "src/System/Linux/Inotify.hsc" #-}
in_IGNORED :: Mask EventFlag
in_IGNORED = Mask (32768)
{-# LINE 297 "src/System/Linux/Inotify.hsc" #-}
in_ISDIR :: Mask EventFlag
in_ISDIR = Mask (1073741824)
{-# LINE 301 "src/System/Linux/Inotify.hsc" #-}
in_Q_OVERFLOW :: Mask EventFlag
in_Q_OVERFLOW = Mask (16384)
{-# LINE 306 "src/System/Linux/Inotify.hsc" #-}
in_UNMOUNT :: Mask EventFlag
in_UNMOUNT = Mask (8192)
{-# LINE 310 "src/System/Linux/Inotify.hsc" #-}
newtype Cookie = Cookie Word32 deriving (Eq, Ord, Show, Typeable, Hashable)
data Event = Event
{ wd :: {-# UNPACK #-} !Watch
, mask :: {-# UNPACK #-} !(Mask EventFlag)
, cookie :: {-# UNPACK #-} !Cookie
, name :: {-# UNPACK #-} !B.ByteString
} deriving (Eq, Show, Typeable)
init :: IO Inotify
init = initWith defaultInotifyOptions
newtype InotifyOptions = InotifyOptions {
bufferSize :: Int
}
defaultInotifyOptions :: InotifyOptions
defaultInotifyOptions = InotifyOptions { bufferSize = 2048 }
initWith :: InotifyOptions -> IO Inotify
initWith InotifyOptions{..} = do
fd <- Fd <$> throwErrnoIfMinus1 "System.Linux.Inotify.initWith"
(c_inotify_init1 flags)
fdRef <- newMVar fd
bufferLock <- newMVar ()
let bufSize = bufferSize
buffer <- mallocForeignPtrBytes bufSize
FC.addForeignPtrFinalizer buffer (closeFdRef fdRef)
startRef <- newIORef 0
endRef <- newIORef 0
return $! Inotify{..}
where flags = (2048) .|. (524288)
{-# LINE 372 "src/System/Linux/Inotify.hsc" #-}
addWatch :: Inotify -> FilePath -> Mask WatchFlag -> IO Watch
addWatch Inotify{fdRef} path !mask = act
where
funcName = "System.Linux.Inotify.addWatch"
act = withCString path $ \cpath -> do
withFdRefError fdRef funcName $ \fd -> do
Watch <$> throwErrnoPathIfMinus1 funcName path
(c_inotify_add_watch fd cpath mask)
addWatch_ :: Inotify -> RawFilePath -> Mask WatchFlag -> IO Watch
addWatch_ Inotify{fdRef} path !mask = act
where
funcName = "System.Linux.Inotify.addWatch_"
act = B.useAsCString path $ \cpath -> do
withFdRefError fdRef funcName $ \fd -> do
Watch <$> throwErrnoPathIfMinus1 funcName (B8.unpack path)
(c_inotify_add_watch fd cpath mask)
rmWatch :: Inotify -> Watch -> IO ()
rmWatch Inotify{fdRef} !wd = act
where
funcName = "System.Linux.Inotify.rmWatch"
act = do
res <- withFdRefError fdRef funcName $ \fd -> c_inotify_rm_watch fd wd
when (res == -1) $ do
err <- getErrno
if err == eINVAL
then return ()
else throwErrno funcName
getEvent :: Inotify -> IO Event
getEvent inotify@Inotify{..} = loop
where
funcName = "System.Linux.Inotify.getEvent"
loop = join $ withLock bufferLock $ do
start <- readIORef startRef
end <- readIORef endRef
if start < end
then (do
evt <- getMessage inotify start True
return (return evt) )
else fillBuffer funcName inotify
(throwIO $! fdClosed funcName)
(\fd -> do
(waitRead,_) <- threadWaitReadSTM fd
return (atomically waitRead >> loop) )
(do
evt <- getMessage inotify 0 True
return (return evt) )
peekEvent :: Inotify -> IO Event
peekEvent inotify@Inotify{..} = loop
where
funcName = "System.Linux.Inotify.peekEvent"
loop = join $ withLock bufferLock $ do
start <- readIORef startRef
end <- readIORef endRef
if start < end
then (do
evt <- getMessage inotify start False
return (return evt) )
else fillBuffer funcName inotify
(throwIO $! fdClosed funcName)
(\fd -> do
(waitRead,_) <- threadWaitReadSTM fd
return (atomically waitRead >> loop) )
(do
writeIORef startRef 0
evt <- getMessage inotify 0 False
return (return evt) )
fillBuffer :: String -> Inotify -> IO a -> (Fd -> IO a) -> IO a -> IO a
fillBuffer funcName Inotify{..} closedHandler wouldBlock done =
withFdRef fdRef closedHandler loop
where
loop fd = do
numBytes <- withForeignPtr buffer $ \ptr -> do
c_unsafe_read fd ptr (fromIntegral bufSize)
if numBytes == -1
then do
errno <- getErrno
if errno == eINTR
then loop fd
else if errno == eAGAIN || errno == eWOULDBLOCK
then wouldBlock fd
else throwErrno funcName
else do
writeIORef endRef (fromIntegral numBytes)
done
{-# INLINE fillBuffer #-}
getMessage :: Inotify -> Int -> Bool -> IO Event
getMessage Inotify{..} start doConsume = withForeignPtr buffer $ \ptr0 -> do
let ptr = ptr0 `plusPtr` start
wd <- Watch <$> (((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr :: IO CInt)
{-# LINE 549 "src/System/Linux/Inotify.hsc" #-}
mask <- Mask <$> (((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr :: IO Word32)
{-# LINE 550 "src/System/Linux/Inotify.hsc" #-}
cookie <- Cookie <$> (((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr :: IO Word32)
{-# LINE 551 "src/System/Linux/Inotify.hsc" #-}
len <- (((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr :: IO Word32)
{-# LINE 552 "src/System/Linux/Inotify.hsc" #-}
name <- if len == 0
then return B.empty
else B.packCString (((\hsc_ptr -> hsc_ptr `plusPtr` 16)) ptr)
{-# LINE 555 "src/System/Linux/Inotify.hsc" #-}
when doConsume $ writeIORef startRef $!
start + ((16)) + fromIntegral len
{-# LINE 557 "src/System/Linux/Inotify.hsc" #-}
return $! Event{..}
{-# INLINE getMessage #-}
getEventNonBlocking :: Inotify -> IO (Maybe Event)
getEventNonBlocking inotify@Inotify{..} = act
where
funcName = "System.Linux.Inotify.getEventNonBlocking"
act = withLock bufferLock $ do
start <- readIORef startRef
end <- readIORef endRef
if start < end
then Just <$> getMessage inotify start True
else fillBuffer funcName inotify
(throwIO $! fdClosed funcName)
(\_fd -> return Nothing)
(Just <$> getMessage inotify 0 True)
peekEventNonBlocking :: Inotify -> IO (Maybe Event)
peekEventNonBlocking inotify@Inotify{..} = act
where
funcName = "System.Linux.Inotify.peekEventNonBlocking"
act = withLock bufferLock $ do
start <- readIORef startRef
end <- readIORef endRef
if start < end
then Just <$> getMessage inotify start False
else fillBuffer funcName inotify
(throwIO $! fdClosed funcName)
(\_fd -> return Nothing)
(do
writeIORef startRef 0
Just <$> getMessage inotify 0 False)
getEventFromBuffer :: Inotify -> IO (Maybe Event)
getEventFromBuffer inotify@Inotify{..} = act
where
act = withLock bufferLock $ do
start <- readIORef startRef
end <- readIORef endRef
if start < end
then Just <$> getMessage inotify start True
else return Nothing
peekEventFromBuffer :: Inotify -> IO (Maybe Event)
peekEventFromBuffer inotify@Inotify{..} = act
where
act = withLock bufferLock $ do
start <- readIORef startRef
end <- readIORef endRef
if start < end
then Just <$> getMessage inotify start False
else return Nothing
close :: Inotify -> IO ()
close Inotify{fdRef} = closeFdRef fdRef
isClosed :: Inotify -> IO Bool
isClosed Inotify{fdRef} = withFdRef fdRef (return True) (const $ return False)
closeFdRef :: MVar Fd -> IO ()
closeFdRef fdRef = mask_ $ do
fd <- swapMVar fdRef (-1)
if fd >= 0
then closeFdWith closeFd fd
else return ()
withFdRef :: MVar Fd -> IO a -> (Fd -> IO a) -> IO a
withFdRef fdRef closed action =
withMVar fdRef $ \fd ->
if fd >= 0
then action fd
else closed
{-# INLINE withFdRef #-}
withFdRefError :: MVar Fd -> String -> (Fd -> IO a) -> IO a
withFdRefError fdRef funcName = withFdRef fdRef (throwIO $! fdClosed funcName)
{-# INLINE withFdRefError #-}
fdClosed :: String -> IOException
fdClosed funcName
= IOError {
ioe_handle = Nothing,
ioe_type = IllegalOperation,
ioe_location = funcName,
ioe_description = "handle is closed",
ioe_errno = Nothing,
ioe_filename = Nothing
}
{-# INLINE withLock #-}
withLock :: MVar () -> IO b -> IO b
withLock m io =
mask_ $ do
_ <- takeMVar m
b <- io `onException` putMVar m ()
putMVar m ()
return b
foreign import ccall unsafe "sys/inotify.h inotify_init1"
c_inotify_init1 :: CInt -> IO CInt
foreign import ccall unsafe "sys/inotify.h inotify_add_watch"
c_inotify_add_watch :: Fd -> CString -> Mask WatchFlag -> IO CInt
foreign import ccall unsafe "sys/inotify.h inotify_rm_watch"
c_inotify_rm_watch :: Fd -> Watch -> IO CInt
foreign import ccall unsafe "unistd.h read"
c_unsafe_read :: Fd -> Ptr CChar -> CSize -> IO CSsize