-- | -- Copyright : (c) Sam Truzjan 2013 -- License : BSD3 -- Maintainer : pxqr.sta@gmail.com -- Stability : experimental -- Portability : portable -- -- Connects to a device event source. -- {-# LANGUAGE OverloadedStrings #-} module System.UDev.Monitor ( Monitor -- * Creation , SourceId (..) , newFromNetlink -- * Receiving , enableReceiving , setReceiveBufferSize , getFd , getHandle , receiveDevice -- * Filter , filterAddMatchSubsystemDevtype , filterAddMatchTag , filterUpdate , filterRemove ) where import Control.Applicative import Control.Monad import Data.ByteString as BS import Foreign import Foreign.C.Error import Foreign.C.String import Foreign.C.Types import System.Posix.Types import System.Posix.IO import System.IO import System.UDev.Context import System.UDev.Device import System.UDev.Types -- | Opaque object handling an event source. newtype Monitor = Monitor { getMonitor :: Ptr Monitor } foreign import ccall unsafe "udev_monitor_get_udev" c_getUDev :: Monitor -> UDev instance UDevChild Monitor where getUDev = c_getUDev foreign import ccall unsafe "udev_monitor_ref" c_ref :: Monitor -> IO Monitor foreign import ccall unsafe "udev_monitor_unref" c_unref :: Monitor -> IO Monitor instance Ref Monitor where ref = c_ref unref = c_unref foreign import ccall unsafe "udev_monitor_new_from_netlink" c_newFromNetlink :: UDev -> CString -> IO Monitor -- | Event source identifier. data SourceId = -- | Events are sent out just after kernel processes them. -- -- Applications should usually not connect directly to the -- \"kernel\" events, because the devices might not be useable at -- that time, before udev has configured them, and created device -- nodes. Use 'UDevId' instead. -- KernelId | -- | Events are sent out after udev has finished its event processing, -- all rules have been processed, and needed device nodes are created. UDevId | -- | For extensibility. OtherId ByteString deriving (Show, Read, Eq, Ord) unmarshalSourceId :: SourceId -> ByteString unmarshalSourceId KernelId = "kernel" unmarshalSourceId UDevId = "udev" unmarshalSourceId (OtherId i) = i {-# INLINE unmarshalSourceId #-} -- | Create new udev monitor and connect to a specified event source. newFromNetlink :: UDev -> SourceId -> IO Monitor newFromNetlink udev sid = Monitor <$> do throwErrnoIfNull "newFromNetlink" $ useAsCString (unmarshalSourceId sid) $ \ c_name -> getMonitor <$> c_newFromNetlink udev c_name foreign import ccall unsafe "udev_monitor_enable_receiving" c_enableReceiving :: Monitor -> IO CInt -- | Binds the 'Monitor' socket to the event source. enableReceiving :: Monitor -> IO () enableReceiving monitor = throwErrnoIfMinus1_ "enableReceiving" $ c_enableReceiving monitor foreign import ccall unsafe "udev_monitor_set_receive_buffer_size" c_setReceiveBufferSize :: Monitor -> CInt -> IO CInt -- | Set the size of the kernel socket buffer. setReceiveBufferSize :: Monitor -> Int -> IO () setReceiveBufferSize monitor size = throwErrnoIfMinus1_ "setReceiveBufferSize" $ c_setReceiveBufferSize monitor (fromIntegral size) foreign import ccall unsafe "udev_monitor_get_fd" c_getFd :: Monitor -> IO CInt -- | Retrieve the socket file descriptor associated with the monitor. getFd :: Monitor -> IO Fd getFd monitor = Fd <$> c_getFd monitor -- | Similar to 'getFd' but retrieves the socket /handle/ associated -- with the monitor. getHandle :: Monitor -> IO Handle getHandle = getFd >=> fdToHandle foreign import ccall unsafe "udev_monitor_receive_device" c_receiveDevice :: Monitor -> IO Device -- | Receive data from the udev monitor socket, allocate a new udev -- device, fill in the received data, and return the device. -- receiveDevice :: Monitor -> IO Device receiveDevice monitor = Device <$> throwErrnoIfNull "receiveDevice" (getDevice <$> c_receiveDevice monitor) foreign import ccall unsafe "udev_monitor_filter_add_match_subsystem_devtype" c_filterAddMatchSubsystemDevtype :: Monitor -> CString -> CString -> IO CInt -- | Filter events by subsystem and device type. -- -- The filter /must be/ installed before the monitor is switched to -- listening mode. -- filterAddMatchSubsystemDevtype :: Monitor -> ByteString -> Maybe ByteString -> IO () filterAddMatchSubsystemDevtype monitor subsystem mbDevtype = throwErrnoIfMinus1_ "filterAddMatchSubsystemDevtype" $ useAsCString subsystem $ \ c_subsystem -> case mbDevtype of Just devtype -> useAsCString devtype $ \ c_devtype -> c_filterAddMatchSubsystemDevtype monitor c_subsystem c_devtype Nothing -> c_filterAddMatchSubsystemDevtype monitor c_subsystem nullPtr foreign import ccall unsafe "udev_monitor_filter_add_match_tag" c_filterAddMatchTag :: Monitor -> CString -> IO CInt -- | The filter must be installed before the monitor is switched to -- listening mode. -- filterAddMatchTag :: Monitor -> ByteString -> IO () filterAddMatchTag monitor tag = throwErrnoIfMinus1_ "filterAddMatchTag" $ useAsCString tag $ \ c_tag -> c_filterAddMatchTag monitor c_tag foreign import ccall unsafe "udev_monitor_filter_update" c_filterUpdate :: Monitor -> IO CInt -- | Update the installed socket filter. This is only needed, if the -- filter was removed or changed. -- filterUpdate :: Monitor -> IO () filterUpdate monitor = throwErrnoIfMinus1_ "filterUpdate" $ c_filterUpdate monitor foreign import ccall unsafe "udev_monitor_filter_remove" c_filterRemove :: Monitor -> IO CInt -- | Remove all filters from monitor. filterRemove :: Monitor -> IO () filterRemove monitor = throwErrnoIfMinus1_ "filterRemove" $ c_filterRemove monitor