diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -13,7 +13,7 @@ ### Build Status [![Build Status][status-img]][status-link] -### Maintainer +### Maintainer Feel free to report bugs and suggestions via github [issue tracker][issues] or the mail. @@ -23,6 +23,6 @@ [tutor]: http://www.signal11.us/oss/udev [hackage-docs]: http://hackage.haskell.org/package/udev [github-docs]: http://pxqr.github.io/udev/ -[status-img]: https://travis-ci.org/pxqr/udev.png -[status-link]: https://travis-ci.org/pxqr/udev -[issues]: https://github.com/pxqr/udev/issues +[status-img]: https://github.com/leifw/udev/workflows/Haskell%20CI/badge.svg +[status-link]: https://github.com/LeifW/udev/actions?query=workflow%3A%22Haskell+CI%22 +[issues]: https://github.com/LeifW/udev/issues diff --git a/examples/hidraw.hs b/examples/hidraw.hs --- a/examples/hidraw.hs +++ b/examples/hidraw.hs @@ -16,7 +16,7 @@ e <- newEnumerate udev addMatchSubsystem e "hidraw" scanDevices e - ls <- getListEntry e + Just ls <- getListEntry e path <- getName ls print path dev <- newFromSysPath udev path diff --git a/examples/monitor.hs b/examples/monitor.hs --- a/examples/monitor.hs +++ b/examples/monitor.hs @@ -1,18 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} module Main (main) where -import Prelude as P - -import Control.Monad -import Data.ByteString.Char8 as BC +import Control.Monad (forever) +import Control.Concurrent (threadWaitRead) import System.UDev.Context import System.UDev.Device import System.UDev.Monitor -import System.Posix.IO.Select -import System.Posix.IO.Select.Types - dumpDeviceInfo :: Device -> IO () dumpDeviceInfo dev = do print $ getSubsystem dev @@ -22,21 +17,16 @@ print $ getSysnum dev print $ getDevnode dev print $ getAction dev - P.putStrLn $ "device number: " ++ show (getDevnum dev) + putStrLn $ "device number: " ++ show (getDevnum dev) main :: IO () -main = do - withUDev $ \ udev -> do - setLogPriority udev LogDebug - setLogger udev defaultLogger - monitor <- newFromNetlink udev UDevId - enableReceiving monitor - fd <- getFd monitor - forever $ do - res <- select' [fd] [] [] Never - case res of - Just ([_], [], []) -> do - dev <- receiveDevice monitor - dumpDeviceInfo dev - Nothing -> return () - return () +main = withUDev $ \ udev -> do + setLogPriority udev LogDebug + setLogger udev defaultLogger + monitor <- newFromNetlink udev UDevId + enableReceiving monitor + fd <- getFd monitor + forever $ do + threadWaitRead fd + dev <- receiveDevice monitor + dumpDeviceInfo dev diff --git a/src/System/UDev.hs b/src/System/UDev.hs --- a/src/System/UDev.hs +++ b/src/System/UDev.hs @@ -16,8 +16,6 @@ , module System.UDev.Util ) where -import Data.Monoid - import System.UDev.Context import System.UDev.Device import System.UDev.Enumerate @@ -26,14 +24,3 @@ import System.UDev.Monitor import System.UDev.Queue import System.UDev.Util - - -type Devtype = () -type Tag = () - -data Filter = Filter (Maybe (Subsystem, Devtype)) (Maybe Tag) - -instance Monoid Filter where - mempty = Filter Nothing Nothing - Filter sda ta `mappend` Filter sdb tb - = Filter (sda `mappend` sdb) (ta `mappend` tb) diff --git a/src/System/UDev/Context.hs b/src/System/UDev/Context.hs --- a/src/System/UDev/Context.hs +++ b/src/System/UDev/Context.hs @@ -15,6 +15,7 @@ UDev , UDevChild (..) , newUDev + , freeUDev , withUDev -- * Logging @@ -31,10 +32,11 @@ ) where import Control.Applicative +import Control.Monad (void) import Control.Exception import Data.ByteString as BS import Data.ByteString.Char8 as BC -import Foreign +import Foreign (Ptr, FunPtr) import Foreign.C.String import Foreign.C.Types import Unsafe.Coerce @@ -51,9 +53,12 @@ newUDev :: IO UDev newUDev = c_new +freeUDev :: UDev -> IO () +freeUDev = void . unref + -- | Like 'newUDev' but context will be released at exit. withUDev :: (UDev -> IO a) -> IO a -withUDev = bracket c_new unref +withUDev = bracket newUDev freeUDev {----------------------------------------------------------------------- -- Logging @@ -130,7 +135,7 @@ -- | Default logger will just print @%PRIO %FILE:%LINE:\n%FN: %FORMAT@ -- to stdout. defaultLogger :: Logger -defaultLogger _ priority file line fn format = do +defaultLogger _ priority file line fn format = BC.putStrLn $ BS.concat [ BC.pack (show priority), " " , file, ":", BC.pack (show line), ":\n" diff --git a/src/System/UDev/Device.hs b/src/System/UDev/Device.hs --- a/src/System/UDev/Device.hs +++ b/src/System/UDev/Device.hs @@ -15,6 +15,7 @@ module System.UDev.Device ( Device , Devnum + , Action (..) -- * Create , newFromSysPath @@ -76,9 +77,9 @@ -- path to the device, including the sys mount point. -- newFromSysPath :: UDev -> RawFilePath -> IO Device -newFromSysPath udev sysPath = do - Device <$> (throwErrnoIfNull "newFromSysPath" $ do - useAsCString sysPath $ \ c_sysPath -> do +newFromSysPath udev sysPath = + Device <$> throwErrnoIfNull "newFromSysPath" + (useAsCString sysPath $ \ c_sysPath -> getDevice <$> c_newFromSysPath udev c_sysPath) type Dev_t = CULong @@ -122,7 +123,7 @@ -- device, like \"mem\" \/ \"zero\", or \"block\" \/ \"sda\". -- newFromSubsystemSysname :: UDev -> ByteString -> ByteString -> IO Device -newFromSubsystemSysname udev subsystem sysname = do +newFromSubsystemSysname udev subsystem sysname = useAsCString subsystem $ \ c_subsystem -> useAsCString sysname $ \ c_sysname -> c_newFromSubsystemSysname udev c_subsystem c_sysname @@ -141,7 +142,7 @@ -- * +sound:card29 - kernel driver core subsystem:device name -- newFromDeviceId :: UDev -> ByteString -> IO Device -newFromDeviceId udev devId = do +newFromDeviceId udev devId = useAsCString devId $ \ c_devId -> c_newFromDeviceId udev c_devId @@ -197,7 +198,7 @@ -- does not contain the sys mount point, and starts with a \'/\'. -- getDevpath :: Device -> RawFilePath -getDevpath dev = unsafePerformIO $ do +getDevpath dev = unsafePerformIO $ packCString =<< c_getDevpath dev foreign import ccall unsafe "udev_device_get_subsystem" @@ -323,7 +324,7 @@ -- | Get the kernel driver name. getDriver :: Device -> ByteString -getDriver dev = unsafePerformIO $ do +getDriver dev = unsafePerformIO $ packCString =<< c_getDriver dev foreign import ccall unsafe "udev_device_get_devnum" @@ -359,7 +360,7 @@ getAction :: Device -> Maybe Action getAction dev | c_action == nullPtr = Nothing - | otherwise = Just $ unsafePerformIO $ do + | otherwise = Just $ unsafePerformIO $ marshalAction <$> packCString c_action where c_action = c_getAction dev @@ -375,7 +376,7 @@ -- return the same value and not open the attribute again. -- getSysattrValue :: Device -> ByteString -> IO ByteString -getSysattrValue dev sysattr = do +getSysattrValue dev sysattr = packCString =<< useAsCString sysattr (return . c_getSysattrValue dev) foreign import ccall unsafe "udev_device_set_sysattr_value" @@ -388,8 +389,8 @@ -> ByteString -- ^ attribute name -> ByteString -- ^ new value to be set -> IO () -setSysattrValue dev sysattr value = do - throwErrnoIf_ (0 <) "setSysattrValue" $ do +setSysattrValue dev sysattr value = + throwErrnoIf_ (0 <) "setSysattrValue" $ useAsCString sysattr $ \ c_sysattr -> useAsCString value $ \ c_value -> c_setSysattrValue dev c_sysattr c_value @@ -438,7 +439,7 @@ -- | Check if a given device has a certain tag associated. hasTag :: Device -> ByteString -> IO Bool -hasTag dev tag = do - (1 ==) <$> do - useAsCString tag $ \ c_tag -> - c_hasTag dev c_tag +hasTag dev tag = + (1 ==) <$> + useAsCString tag (\ c_tag -> + c_hasTag dev c_tag) diff --git a/src/System/UDev/Enumerate.hs b/src/System/UDev/Enumerate.hs --- a/src/System/UDev/Enumerate.hs +++ b/src/System/UDev/Enumerate.hs @@ -75,8 +75,8 @@ -> Subsystem -- ^ filter for a subsystem of the -- device to include in the list -> IO () -- ^ can throw exception -addMatchSubsystem enumerate subsystem = do - throwErrnoIfMinus1_ "addMatchSubsystem" $ do +addMatchSubsystem enumerate subsystem = + throwErrnoIfMinus1_ "addMatchSubsystem" $ useAsCString subsystem $ c_addMatchSubsystem enumerate @@ -88,8 +88,8 @@ -> Subsystem -- ^ filter for a subsystem of the -- device to exclude from the list -> IO () -- ^ can throw exception -addNoMatchSubsystem enumerate subsystem = do - throwErrnoIfMinus1_ "addNoMatchSubsystem" $ do +addNoMatchSubsystem enumerate subsystem = + throwErrnoIfMinus1_ "addNoMatchSubsystem" $ useAsCString subsystem $ c_addNoMatchSubsystem enumerate @@ -109,13 +109,13 @@ -- the device to include in the list -> Maybe SysValue -- ^ optional value of the sys attribute -> IO () -- ^ can throw exception -addMatchSysattr enumerate sysattr mvalue = do - throwErrnoIf_ (< 0) "addMatchSysattr" $ do - useAsCString sysattr $ \ c_sysattr -> do +addMatchSysattr enumerate sysattr mvalue = + throwErrnoIf_ (< 0) "addMatchSysattr" $ + useAsCString sysattr $ \ c_sysattr -> case mvalue of Nothing -> c_addMatchSysattr enumerate c_sysattr nullPtr - Just value -> do - useAsCString value $ \ c_value -> do + Just value -> + useAsCString value $ \ c_value -> c_addMatchSysattr enumerate c_sysattr c_value foreign import ccall unsafe "udev_enumerate_add_nomatch_sysattr" @@ -128,13 +128,13 @@ -> Maybe ByteString -- ^ optional value of the sys -- attribute -> IO () -addNoMatchSysattr enumerate sysattr mvalue = do - throwErrnoIf_ (< 0) "addNoMatchSysattr" $ do - useAsCString sysattr $ \ c_sysattr -> do +addNoMatchSysattr enumerate sysattr mvalue = + throwErrnoIf_ (< 0) "addNoMatchSysattr" $ + useAsCString sysattr $ \ c_sysattr -> case mvalue of Nothing -> c_addNoMatchSysattr enumerate c_sysattr nullPtr - Just value -> do - useAsCString value $ \ c_value -> do + Just value -> + useAsCString value $ \ c_value -> c_addNoMatchSysattr enumerate c_sysattr c_value foreign import ccall unsafe "udev_enumerate_add_match_property" @@ -146,10 +146,10 @@ -- device to include in the list -> ByteString -- ^ value of the property -> IO () -addMatchProperty enumerate prop value = do - throwErrnoIf_ (< 0) "addMatchProperty" $ do - useAsCString prop $ \ c_prop -> do - useAsCString value $ \ c_value -> do +addMatchProperty enumerate prop value = + throwErrnoIf_ (< 0) "addMatchProperty" $ + useAsCString prop $ \ c_prop -> + useAsCString value $ \ c_value -> c_addMatchProperty enumerate c_prop c_value foreign import ccall unsafe "udev_enumerate_add_match_tag" @@ -161,9 +161,9 @@ -> ByteString -- ^ filter for a tag of the device to -- include in the list -> IO () -addMatchTag enumerate tag = do - throwErrnoIf_ (< 0) "addMatchTag" $ do - useAsCString tag $ \ c_tag -> do +addMatchTag enumerate tag = + throwErrnoIf_ (< 0) "addMatchTag" $ + useAsCString tag $ \ c_tag -> c_addMatchTag enumerate c_tag foreign import ccall unsafe "udev_enumerate_add_match_parent" @@ -178,8 +178,8 @@ addMatchParent :: Enumerate -- ^ context -> Device -- ^ parent device where to start searching -> IO () -- ^ can throw exception -addMatchParent enumerate dev = do - throwErrnoIf_ (< 0) "addMatchParent" $ do +addMatchParent enumerate dev = + throwErrnoIf_ (< 0) "addMatchParent" $ c_addMatchParent enumerate dev foreign import ccall unsafe "udev_enumerate_add_match_is_initialized" @@ -187,8 +187,8 @@ -- | Match only devices which udev has set up already. addMatchIsInitialized :: Enumerate -> IO () -addMatchIsInitialized enumerate = do - throwErrnoIfMinus1_ "addMatchIsInitialized" $ do +addMatchIsInitialized enumerate = + throwErrnoIfMinus1_ "addMatchIsInitialized" $ c_addMatchIsInitialized enumerate foreign import ccall unsafe "udev_enumerate_add_match_sysname" @@ -199,8 +199,8 @@ -> ByteString -- ^ filter for the name of the device -- to include in the list -> IO () -- ^ can throw exception -addMatchSysname enumerate sysName = do - throwErrnoIfMinus1_ "addMatchSysname" $ do +addMatchSysname enumerate sysName = + throwErrnoIfMinus1_ "addMatchSysname" $ useAsCString sysName $ c_addMatchSysname enumerate @@ -213,9 +213,9 @@ addSyspath :: Enumerate -- ^ context -> RawFilePath -- ^ path of a device -> IO () -- ^ can throw exception -addSyspath enumerate syspath = do - throwErrnoIf_ (< 0) "addSyspath" $ do - useAsCString syspath $ \ c_syspath -> do +addSyspath enumerate syspath = + throwErrnoIf_ (< 0) "addSyspath" $ + useAsCString syspath $ \ c_syspath -> c_addSyspath enumerate c_syspath {----------------------------------------------------------------------- @@ -244,6 +244,8 @@ c_getListEntry :: Enumerate -> IO List -- | Get the first entry of the sorted list of device paths. -getListEntry :: Enumerate -> IO List -getListEntry = c_getListEntry +getListEntry :: Enumerate -> IO (Maybe List) +getListEntry enumerate = do + xs <- c_getListEntry enumerate + return $ if xs == nil then Nothing else Just xs {-# INLINE getListEntry #-} diff --git a/src/System/UDev/List.hs b/src/System/UDev/List.hs --- a/src/System/UDev/List.hs +++ b/src/System/UDev/List.hs @@ -20,10 +20,8 @@ import Control.Monad import Data.ByteString import Foreign.C.String -import Foreign.C.Types import System.UDev.Types - foreign import ccall unsafe "udev_list_entry_get_next" c_getNext :: List -> IO List diff --git a/src/System/UDev/Monitor.hs b/src/System/UDev/Monitor.hs --- a/src/System/UDev/Monitor.hs +++ b/src/System/UDev/Monitor.hs @@ -96,8 +96,8 @@ newFromNetlink :: UDev -> SourceId -> IO Monitor newFromNetlink udev sid = Monitor <$> do - throwErrnoIfNull "newFromNetlink" $ do - useAsCString (unmarshalSourceId sid) $ \ c_name -> do + throwErrnoIfNull "newFromNetlink" $ + useAsCString (unmarshalSourceId sid) $ \ c_name -> getMonitor <$> c_newFromNetlink udev c_name @@ -106,8 +106,8 @@ -- | Binds the 'Monitor' socket to the event source. enableReceiving :: Monitor -> IO () -enableReceiving monitor = do - throwErrnoIfMinus1_ "enableReceiving" $ do +enableReceiving monitor = + throwErrnoIfMinus1_ "enableReceiving" $ c_enableReceiving monitor foreign import ccall unsafe "udev_monitor_set_receive_buffer_size" @@ -115,8 +115,8 @@ -- | Set the size of the kernel socket buffer. setReceiveBufferSize :: Monitor -> Int -> IO () -setReceiveBufferSize monitor size = do - throwErrnoIfMinus1_ "setReceiveBufferSize" $ do +setReceiveBufferSize monitor size = + throwErrnoIfMinus1_ "setReceiveBufferSize" $ c_setReceiveBufferSize monitor (fromIntegral size) foreign import ccall unsafe "udev_monitor_get_fd" @@ -138,10 +138,10 @@ -- device, fill in the received data, and return the device. -- receiveDevice :: Monitor -> IO Device -receiveDevice monitor = do - Device <$> do - throwErrnoIfNull "receiveDevice" $ do - getDevice <$> c_receiveDevice monitor +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 @@ -151,12 +151,16 @@ -- The filter /must be/ installed before the monitor is switched to -- listening mode. -- -filterAddMatchSubsystemDevtype :: Monitor -> ByteString -> ByteString -> IO () -filterAddMatchSubsystemDevtype monitor subsystem devtype = do +filterAddMatchSubsystemDevtype :: Monitor -> ByteString -> Maybe ByteString -> IO () +filterAddMatchSubsystemDevtype monitor subsystem mbDevtype = throwErrnoIfMinus1_ "filterAddMatchSubsystemDevtype" $ useAsCString subsystem $ \ c_subsystem -> - useAsCString devtype $ \ c_devtype -> - c_filterAddMatchSubsystemDevtype monitor c_subsystem c_devtype + 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 @@ -165,9 +169,9 @@ -- listening mode. -- filterAddMatchTag :: Monitor -> ByteString -> IO () -filterAddMatchTag monitor tag = do - throwErrnoIfMinus1_ "filterAddMatchTag" $ do - useAsCString tag $ \ c_tag -> do +filterAddMatchTag monitor tag = + throwErrnoIfMinus1_ "filterAddMatchTag" $ + useAsCString tag $ \ c_tag -> c_filterAddMatchTag monitor c_tag foreign import ccall unsafe "udev_monitor_filter_update" @@ -177,8 +181,8 @@ -- filter was removed or changed. -- filterUpdate :: Monitor -> IO () -filterUpdate monitor = do - throwErrnoIfMinus1_ "filterUpdate" $ do +filterUpdate monitor = + throwErrnoIfMinus1_ "filterUpdate" $ c_filterUpdate monitor @@ -187,6 +191,6 @@ -- | Remove all filters from monitor. filterRemove :: Monitor -> IO () -filterRemove monitor = do - throwErrnoIfMinus1_ "filterRemove" $ do +filterRemove monitor = + throwErrnoIfMinus1_ "filterRemove" $ c_filterRemove monitor diff --git a/src/System/UDev/Queue.hs b/src/System/UDev/Queue.hs --- a/src/System/UDev/Queue.hs +++ b/src/System/UDev/Queue.hs @@ -82,7 +82,7 @@ -> Seqnum -- ^ last event sequence number -> IO Bool -- ^ if any of the sequence numbers in -- the given range is currently active -sequenceIsFinished queue start end = do +sequenceIsFinished queue start end = (> 0) <$> c_sequenceIsFinished queue (fromIntegral start) (fromIntegral end) {-# INLINE sequenceIsFinished #-} diff --git a/udev.cabal b/udev.cabal --- a/udev.cabal +++ b/udev.cabal @@ -1,17 +1,17 @@ name: udev -version: 0.1.0.0 +version: 0.1.1.0 license: BSD3 license-file: LICENSE author: Sam Truzjan -maintainer: pxqr.sta@gmail.com +maintainer: abimelech@gmail.com copyright: (c) 2013, Sam Truzjan category: System stability: Experimental build-type: Simple cabal-version: >= 1.10 tested-with: GHC == 7.6.3 -homepage: https://github.com/pxqr/udev -bug-reports: https://github.com/pxqr/udev/issues +homepage: https://github.com/LeifW/udev +bug-reports: https://github.com/LeifW/udev/issues synopsis: libudev bindings description: libudev bindings @@ -20,14 +20,14 @@ source-repository head type: git - location: git://github.com/pxqr/udev.git + location: git://github.com/LeifW/udev.git branch: master source-repository this type: git - location: git://github.com/pxqr/udev.git + location: git://github.com/LeifW/udev.git branch: master - tag: v0.1.0.0 + tag: v0.1.1.0 flag examples description: whether to build examples @@ -67,6 +67,6 @@ default-language: Haskell2010 hs-source-dirs: examples main-is: monitor.hs - build-depends: base, bytestring, udev, select + build-depends: base, bytestring, udev if !flag(examples) buildable: False