linux-inotify 0.2.0.1 → 0.3.0.0
raw patch · 3 files changed
+229/−145 lines, 3 filesdep ~basedep ~bytestring
Dependency ranges changed: base, bytestring
Files
- CHANGES.md +12/−0
- linux-inotify.cabal +6/−5
- src/System/Linux/Inotify.hsc +211/−140
+ CHANGES.md view
@@ -0,0 +1,12 @@+Version 0.3.0.0: (2015-11-20)+ * Use-after-close now result in exceptions rather than undefined behavior.++ * All functions are now (intended to be) thread-safe.++ * Masked async exceptions during a buffer fill, which could otherwise+ have resulted in losing an entire buffer of events. In particularly+ unlucky cases, it might have been possible that futher use of the buffer+ could have resulted in memory faults.++ * Masked async exceptions when closing a descriptor, which could otherwise+ have resulted in leaking an inotify file descriptor.
linux-inotify.cabal view
@@ -1,5 +1,5 @@ name: linux-inotify-version: 0.2.0.1+version: 0.3.0.0 synopsis: Thinner binding to the Linux Kernel's inotify interface description: This is a binding for GHC 7 to the Linux Kernel's inotify interface,@@ -31,22 +31,23 @@ on a machine via `uname` `-a`. I would like to fix this at some point, but it isn't a personal priority. .- 2. `linux-inotify` requires GHC 7.0.2 or later, whereas `hinotify`+ 2. `linux-inotify` requires GHC 7.8.1 or later, whereas `hinotify` works with many versions of GHC 6. I have no plans to fix this. license: BSD3 license-file: LICENSE author: Leon P Smith maintainer: leon@melding-monads.com-copyright: (c) 2013-2014 Leon P Smith+copyright: (c) 2013-2015 Leon P Smith category: System build-type: Simple cabal-version: >=1.8+Extra-Doc-Files: CHANGES.md library hs-source-dirs: src exposed-modules: System.Linux.Inotify- build-depends: base >= 4 && < 5,- bytestring >= 0.9,+ build-depends: base >= 4.7 && < 5,+ bytestring >= 0.10.4, hashable >= 1.1.2, unix
src/System/Linux/Inotify.hsc view
@@ -8,7 +8,7 @@ ----------------------------------------------------------------------------- -- | -- Module : System.Linux.Inotify--- Copyright : (c) 2013-2014 Leon P Smith+-- Copyright : (c) 2013-2015 Leon P Smith -- License : BSD3 -- -- Maintainer : leon@melding-monads.com@@ -33,6 +33,7 @@ , Cookie(..) , init , close+ , isClosed , initWith , InotifyOptions(..) , defaultInotifyOptions@@ -83,11 +84,10 @@ import Data.Typeable import Data.Function ( on ) import Data.Word-import Control.Concurrent ( threadWaitRead )-import GHC.Conc ( closeFdWith )-#if __GLASGOW_HASKELL__ < 706+import Control.Exception ( throwIO, mask_, onException )+import GHC.Conc ( closeFdWith, threadWaitReadSTM, atomically )+import GHC.IO.Exception import Control.Concurrent.MVar-#endif import Control.Monad import System.Posix import Data.IORef@@ -104,18 +104,19 @@ -- but haven't been processed. data Inotify = Inotify- { fd :: {-# UNPACK #-} !Fd- , buffer :: {-# UNPACK #-} !(ForeignPtr CChar)- , bufSize :: {-# UNPACK #-} !Int- , startRef :: {-# UNPACK #-} !(IORef Int)- , endRef :: {-# UNPACK #-} !(IORef Int)+ { 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{fd} = "Inotify { fd = " ++ show fd ++ " }"+ show Inotify{buffer} = "Inotify { buffer = " ++ show buffer ++ " }" instance Ord Inotify where- compare = compare `on` fd+ compare = compare `on` buffer {- -- I'm tempted to define 'Watch' as@@ -293,7 +294,8 @@ in_ISDIR :: Mask EventFlag in_ISDIR = Mask (#const IN_ISDIR) --- | Event queue overflowed (wd is -1 for this event).+-- | Event queue overflowed (wd is -1 for this event). The size of the+-- queue is available at @/proc/sys/fs/inotify/max_queued_events@. in_Q_OVERFLOW :: Mask EventFlag in_Q_OVERFLOW = Mask (#const IN_Q_OVERFLOW) @@ -323,22 +325,10 @@ -- to the watched directory. -- -- The proper Haskell interpretation of this seems to be to use- -- 'GHC.IO.getForeignEncoding' and then unpack it to a 'String'+ -- 'GHC.IO.getFileSystemEncoding' and then unpack it to a 'String' -- or decode it using the text package. } deriving (Eq, Show, Typeable) -#if __GLASGOW_HASKELL__ < 706--- | Workaround for bug in 'FC.newForeignPtr' before base 4.6. Ensure the--- finalizer is only run once. See GHC ticket #7170-addFinalizerOnce :: ForeignPtr a -> IO () -> IO ()-addFinalizerOnce ptr fin = do- mv <- newMVar fin- FC.addForeignPtrFinalizer ptr $ tryTakeMVar mv >>= maybe (return ()) id-#else-addFinalizerOnce :: ForeignPtr a -> IO () -> IO ()-addFinalizerOnce = FC.addForeignPtrFinalizer-#endif- -- | Creates an inotify socket descriptor that watches can be -- added to and events can be read from. @@ -365,9 +355,11 @@ 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- addFinalizerOnce buffer (closeFdWith closeFd fd)+ FC.addForeignPtrFinalizer buffer (closeFdRef fdRef) startRef <- newIORef 0 endRef <- newIORef 0 return $! Inotify{..}@@ -378,10 +370,13 @@ -- as well as some additional options. This function is thread safe. addWatch :: Inotify -> FilePath -> Mask WatchFlag -> IO Watch-addWatch Inotify{fd} path !mask =- withCString path $ \cpath -> do- Watch <$> throwErrnoPathIfMinus1 "System.Linux.Inotify.addWatch" path- (c_inotify_add_watch fd cpath mask)+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) -- | A variant of 'addWatch' that operates on a 'RawFilePath', which is -- a file path represented as strict 'ByteString'. One weakness of the@@ -389,11 +384,13 @@ -- then any unicode paths will be mangled in the error message. addWatch_ :: Inotify -> RawFilePath -> Mask WatchFlag -> IO Watch-addWatch_ Inotify{fd} path !mask =- B.useAsCString path $ \cpath -> do- Watch <$> throwErrnoPathIfMinus1 "System.Linux.Inotify.addWatch_"- (B8.unpack path)- (c_inotify_add_watch fd cpath mask)+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) -- | Stops watching a path for changes. This watch descriptor must be@@ -415,18 +412,19 @@ -- distinguish these cases. -- -- Haskell's type system should prevent this from happening in almost--- all cases, but it could be possible in wrap-around situations--- when you use an inotify descriptor after you have closed it. But--- then you deserve (at least some of) what you get anyway.+-- all cases. rmWatch :: Inotify -> Watch -> IO ()-rmWatch Inotify{fd} !wd = do- res <- c_inotify_rm_watch fd wd- when (res == -1) $ do- err <- getErrno- if err == eINVAL- then return ()- else throwErrno "System.Linux.Inotify.rmWatch"+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 {-- -- | Stops watching a path for changes. This version throws an exception@@ -458,13 +456,30 @@ -- | Returns an inotify event, blocking until one is available. ----- It is not safe to call this function from multiple threads at the same--- time. Though this could be fixed, I do not see why it would be useful.+-- If the inotify descriptor is closed, this function will return+-- an event from the buffer, if available. Otherwise, it will+-- throw an 'IOException'. It is safe to call this function from+-- multiple threads at the same time. getEvent :: Inotify -> IO Event-getEvent inotify@Inotify{..} = do- fillBufferBlocking inotify "System.Linux.Inotify.getEvent"- getMessage True inotify+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) ) -- | Returns an inotify event, blocking until one is available. --@@ -472,63 +487,56 @@ -- descriptor will return the same event. This read will not -- result in a system call. ----- It is not safe to call this function from multiple threads at the same--- time. Though this could be fixed, I do not see why it would be useful.+-- If the inotify descriptor is closed, this function will return+-- an event from the buffer, if available. Otherwise, it will+-- throw an 'IOError'.+--+-- It is safe to call this function from multiple threads at the same+-- time. peekEvent :: Inotify -> IO Event-peekEvent inotify@Inotify{..} = do- fillBufferBlocking inotify "System.Linux.Inotify.peekEvent"- getMessage False inotify--hasEmptyBuffer :: Inotify -> IO Bool-hasEmptyBuffer Inotify{..} = do- start <- readIORef startRef- end <- readIORef endRef- return $! (start >= end)-{-# INLINE hasEmptyBuffer #-}--fillBuffer :: Inotify -> a -> (Errno -> IO a) -> IO a-fillBuffer Inotify{..} val errorHandler = do- numBytes <- withForeignPtr buffer $ \ptr -> do- c_unsafe_read fd ptr (fromIntegral bufSize)- if numBytes == -1- then getErrno >>= errorHandler- else do- writeIORef startRef 0- writeIORef endRef (fromIntegral numBytes)- return val-{-# INLINE fillBuffer #-}--fillBufferBlocking :: Inotify -> String -> IO ()-fillBufferBlocking inotify@Inotify{..} funcName = do- isEmpty <- hasEmptyBuffer inotify- when isEmpty loop+peekEvent inotify@Inotify{..} = loop where- loop = do- threadWaitRead fd- fillBuffer inotify () $ \err -> do- if err == eINTR || err == eAGAIN || err == eWOULDBLOCK- then loop- else throwErrno funcName+ 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) ) -fillBufferNonBlocking :: Inotify -> String -> IO Bool-fillBufferNonBlocking inotify@Inotify{..} funcName = do- isEmpty <- hasEmptyBuffer inotify- if isEmpty- then loop- else return False+fillBuffer :: String -> Inotify -> IO a -> (Fd -> IO a) -> IO a -> IO a+fillBuffer funcName Inotify{..} closedHandler wouldBlock done =+ withFdRef fdRef closedHandler loop where- loop = do- fillBuffer inotify False $ \err -> do- if err == eAGAIN || err == eWOULDBLOCK- then return True- else if err == eINTR- then loop+ 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 :: Bool -> Inotify -> IO Event-getMessage doConsume Inotify{..} = withForeignPtr buffer $ \ptr0 -> do- start <- readIORef startRef+getMessage :: Inotify -> Int -> Bool -> IO Event+getMessage Inotify{..} start doConsume = withForeignPtr buffer $ \ptr0 -> do let ptr = ptr0 `plusPtr` start wd <- Watch <$> ((#peek struct inotify_event, wd ) ptr :: IO CInt) mask <- Mask <$> ((#peek struct inotify_event, mask ) ptr :: IO Word32)@@ -537,26 +545,34 @@ name <- if len == 0 then return B.empty else B.packCString ((#ptr struct inotify_event, name) ptr)- when doConsume $ writeIORef startRef $! + when doConsume $ writeIORef startRef $! start + (#size struct inotify_event) + fromIntegral len return $! Event{..} {-# INLINE getMessage #-} -- | Returns an inotify event only if one is immediately available. --+-- If the inotify descriptor is closed, this function will return+-- an event from the buffer, if available. Otherwise, it will+-- return 'Nothing'.+-- -- One possible downside of the current implementation is that--- returning 'Nothing' necessarily results in a system call.+-- returning 'Nothing' necessarily results in a system call, unless+-- the inotify descriptor has been closed. getEventNonBlocking :: Inotify -> IO (Maybe Event)-getEventNonBlocking inotify@Inotify{..} = do- isEmpty <- fillBufferNonBlocking inotify funcName- if isEmpty- then return Nothing- else do- evt <- getMessage True inotify- return $! Just evt+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+ (return Nothing)+ (\_fd -> return Nothing)+ (Just <$> getMessage inotify 0 True) -- | Returns an inotify event only if one is immediately available. --@@ -564,33 +580,44 @@ -- descriptor will return the same event, and this read will -- not result in a system call. --+-- If the inotify descriptor is closed, this function will return+-- an event from the buffer, if available. Otherwise, it will+-- return 'Nothing'.+-- -- One possible downside of the current implementation is that--- returning 'Nothing' necessarily results in a system call.+-- returning 'Nothing' necessarily results in a system call, unless+-- the inotify descriptor has been closed. peekEventNonBlocking :: Inotify -> IO (Maybe Event)-peekEventNonBlocking inotify@Inotify{..} = do- isEmpty <- fillBufferNonBlocking inotify funcName- if isEmpty- then return Nothing- else do- evt <- getMessage False inotify- return $! Just evt+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+ (return Nothing)+ (\_fd -> return Nothing)+ (do+ writeIORef startRef 0+ Just <$> getMessage inotify 0 False) --- | Returns an inotify event only if one is available in 'Inotify's+-- | Returns an inotify event only if one is available in 'Inotify'\'s -- buffer. This won't ever make a system call. getEventFromBuffer :: Inotify -> IO (Maybe Event)-getEventFromBuffer inotify = do- isEmpty <- hasEmptyBuffer inotify- if isEmpty- then return Nothing- else do- evt <- getMessage True inotify- return $! Just evt+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 --- | Returns an inotify event only if one is available in 'Inotify's+-- | Returns an inotify event only if one is available in 'Inotify'\'s -- buffer. This won't ever make a system call. -- -- If this returns an event, then the next read from the inotify@@ -598,28 +625,72 @@ -- result in a system call. peekEventFromBuffer :: Inotify -> IO (Maybe Event)-peekEventFromBuffer inotify@Inotify{..} = do- isEmpty <- hasEmptyBuffer inotify- if isEmpty- then return Nothing- else do- evt <- getMessage False inotify- return $! Just evt+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 -- | Closes an inotify descriptor, freeing the resources associated -- with it. This will also raise an 'IOException' in any threads that--- are blocked on 'getEvent'.+-- are blocked on 'getEvent'. ----- Although using a descriptor after it is closed is likely to raise--- an exception, it is not safe to use the descriptor after it is closed.--- However, it is safe to call 'close' multiple times; this binding--- ensures that only one system call will be made.+-- Attempting to use a descriptor after it is closed will safely raise+-- an exception. It is perfectly safe to call 'close' multiple times, which+-- is idempotent and will not result in an exception. -- -- Descriptors will be closed after they are garbage collected, via -- a finalizer, although it is often preferable to call 'close' yourself. close :: Inotify -> IO ()-close Inotify{buffer} = finalizeForeignPtr buffer+close Inotify{fdRef} = closeFdRef fdRef++-- | Has the inotify descriptor been closed?++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