diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2013, Sam Truzjan + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Sam Truzjan nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,22 @@ +This package provides Haskell bindings to [libudev][libudev], that +allows access to device information. `libudev` is part of [udev][udev] +device manager for linux kernel. + +To build library you need to install `libudev-dev` (Debian, Ubuntu) first. + +To build [examples](examples) you need to configure package with +`examples` flag. The examples are ported from this [tutorial][tutor]. + +### Build Status [![Build Status][status-img]][status-link] + +### Maintainer + +Feel free to report bugs and suggestions via github +[issue tracker][issues] or the mail. + +[udev]: http://cgit.freedesktop.org/systemd/systemd/tree/src/udev +[libudev]: http://www.freedesktop.org/software/systemd/libudev/ +[tutor]: http://www.signal11.us/oss/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 diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/changelog b/changelog new file mode 100644 --- /dev/null +++ b/changelog @@ -0,0 +1,1 @@ +* 0.0.0.0: Initial version. diff --git a/examples/hidraw.hs b/examples/hidraw.hs new file mode 100644 --- /dev/null +++ b/examples/hidraw.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Data.ByteString as BS +import Data.ByteString.Char8 as BC + +import System.UDev.Context +import System.UDev.Device +import System.UDev.Enumerate +import System.UDev.List + + +main :: IO () +main = do + withUDev $ \ udev -> do + e <- newEnumerate udev + addMatchSubsystem e "hidraw" + scanDevices e + ls <- getListEntry e + path <- getName ls + print path + dev <- newFromSysPath udev path + print $ getDevnode dev + mdev <- getParentWithSubsystemDevtype dev "usb" "usb_device" + case mdev of + Nothing -> BC.putStrLn "unable to find parent usb device" + Just pdev -> do + BC.putStrLn $ BS.concat + [ "VID/PID: ", getSysattrValue pdev "idVendor" , " " + , getSysattrValue pdev "idProduct", "\n" + , getSysattrValue pdev "manufacturer", "\n" + , getSysattrValue pdev "product" , "\n" +-- , "serial: ", getSysattrValue pdev "serial" + ] + return () diff --git a/examples/monitor.hs b/examples/monitor.hs new file mode 100644 --- /dev/null +++ b/examples/monitor.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Control.Monad +import Data.ByteString.Char8 as BC + +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 + print $ getDevtype dev + print $ getSyspath dev + print $ getSysname dev + print $ getSysnum dev + print $ getDevnode dev + print $ getAction 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 () diff --git a/src/System/UDev.hs b/src/System/UDev.hs new file mode 100644 --- /dev/null +++ b/src/System/UDev.hs @@ -0,0 +1,39 @@ +-- | +-- Copyright : (c) Sam Truzjan 2013 +-- License : BSD3 +-- Maintainer : pxqr.sta@gmail.com +-- Stability : experimental +-- Portability : portable +-- +module System.UDev + ( module System.UDev.Context + , module System.UDev.Device + , module System.UDev.Enumerate + , module System.UDev.HWDB + , module System.UDev.List + , module System.UDev.Monitor + , module System.UDev.Queue + , module System.UDev.Util + ) where + +import Data.Monoid + +import System.UDev.Context +import System.UDev.Device +import System.UDev.Enumerate +import System.UDev.HWDB +import System.UDev.List +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 new file mode 100644 --- /dev/null +++ b/src/System/UDev/Context.hs @@ -0,0 +1,158 @@ +-- | +-- Copyright : (c) Sam Truzjan 2013 +-- License : BSD3 +-- Maintainer : pxqr.sta@gmail.com +-- Stability : stable +-- Portability : portable +-- +-- The context contains the default values read from the udev config +-- file, and is passed to all library operations. +-- +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE OverloadedStrings #-} +module System.UDev.Context + ( -- * Context + UDev + , UDevChild (..) + , newUDev + , withUDev + + -- * Logging + , Priority (..) + , Logger + , getLogPriority + , setLogPriority + , setLogger + , defaultLogger + + -- * User data + , getUserdata + , setUserdata + ) where + +import Control.Applicative +import Control.Exception +import Data.ByteString as BS +import Data.ByteString.Char8 as BC +import Foreign +import Foreign.C.String +import Foreign.C.Types +import Unsafe.Coerce + +import System.UDev.Types + + +foreign import ccall unsafe "udev_new" + c_new :: IO UDev + +-- | Create udev library context. This reads the udev configuration +-- file, and fills in the default values. +-- +newUDev :: IO UDev +newUDev = c_new + +-- | Like 'newUDev' but context will be released at exit. +withUDev :: (UDev -> IO a) -> IO a +withUDev = bracket c_new unref + +{----------------------------------------------------------------------- +-- Logging +-----------------------------------------------------------------------} + +-- | Log message priority. +data Priority = LogError -- ^ error conditions + | LogInfo -- ^ informational + | LogDebug -- ^ debug-level messages + deriving (Show, Read, Eq, Ord, Enum, Bounded) + +-- | Convert priority to priority code. +prioToNr :: Priority -> CInt +prioToNr LogError = 3 +prioToNr LogInfo = 6 +prioToNr LogDebug = 7 + +-- | Convert priority code to priority. +nrToPrio :: CInt -> IO Priority +nrToPrio 3 = pure LogError +nrToPrio 6 = pure LogInfo +nrToPrio 7 = pure LogDebug +nrToPrio n = throwIO $ PatternMatchFail msg + where + msg = "unknown priority number: " ++ show n + +foreign import ccall unsafe "udev_get_log_priority" + c_getLogPriority :: UDev -> IO CInt + +-- | The initial logging priority is read from the udev config file at +-- startup. +getLogPriority :: UDev -> IO Priority +getLogPriority udev = nrToPrio =<< c_getLogPriority udev + +foreign import ccall unsafe "udev_set_log_priority" + c_setLogPriority :: UDev -> CInt -> IO () + +-- | Set the current logging priority. The value controls which +-- messages are logged. +setLogPriority :: UDev -> Priority -> IO () +setLogPriority udev prio = c_setLogPriority udev (prioToNr prio) + +type CLogger = UDev -> CInt -> CString -> CInt -> CString -> CString -> IO () + +-- | Logger function will called by udev on events. +type Logger = UDev + -> Priority -- ^ message priority; + -> ByteString -- ^ position: file + -> Int -- ^ position: line + -> ByteString -- ^ position: function + -> ByteString -- ^ message body + -> IO () + +marshLogger :: Logger -> CLogger +marshLogger logger udev c_priority c_file c_line c_fn c_format = do + file <- packCString c_file + fn <- packCString c_fn + format <- packCString c_format + prio <- nrToPrio c_priority + logger udev prio file (fromIntegral c_line) fn format + +foreign import ccall "wrapper" + mkLogger :: CLogger -> IO (FunPtr CLogger) + +foreign import ccall "udev_set_log_fn" + c_setLogger :: UDev -> FunPtr CLogger -> IO () + +-- | The built-in logging writes to stderr. It can be overridden by a +-- custom function, to plug log messages into the users' logging +-- functionality. +setLogger :: UDev -> Logger -> IO () +setLogger udev logger = c_setLogger udev =<< mkLogger (marshLogger logger) + +-- | Default logger will just print @%PRIO %FILE:%LINE:\n%FN: %FORMAT@ +-- to stdout. +defaultLogger :: Logger +defaultLogger _ priority file line fn format = do + BC.putStrLn $ BS.concat + [ BC.pack (show priority), " " + , file, ":", BC.pack (show line), ":\n" + , " ", fn, ": ", format + ] + +{----------------------------------------------------------------------- +-- Userdata +-----------------------------------------------------------------------} + +foreign import ccall unsafe "udev_get_userdata" + c_getUserdata :: UDev -> IO (Ptr ()) + +-- | Retrieve stored data pointer from library context. This might be +-- useful to access from callbacks like a custom logging function. +-- +getUserdata :: UDev -> IO a +getUserdata udev = unsafeCoerce <$> c_getUserdata udev + +foreign import ccall unsafe "udev_set_userdata" + c_setUserdata :: UDev -> Ptr () -> IO () + +-- | Store custom userdata in the library context. +setUserdata :: UDev -> a -> IO () +setUserdata udev ud = c_setUserdata udev (unsafeCoerce ud) diff --git a/src/System/UDev/Device.hs b/src/System/UDev/Device.hs new file mode 100644 --- /dev/null +++ b/src/System/UDev/Device.hs @@ -0,0 +1,409 @@ +-- | +-- Copyright : (c) Sam Truzjan 2013 +-- License : BSD3 +-- Maintainer : pxqr.sta@gmail.com +-- Stability : stable +-- Portability : portable +-- +-- Representation of kernel sys devices. Devices are uniquely +-- identified by their syspath, every device has exactly one path in +-- the kernel sys filesystem. Devices usually belong to a kernel +-- subsystem, and have a unique name inside that subsystem. +-- +module System.UDev.Device + ( Device + , Devnum + + -- * Create + , newFromSysPath + , newFromDevnum + , newFromSubsystemSysname + , newFromDeviceId + , newFromEnvironment + + , getParent + , getParentWithSubsystemDevtype + + -- * Query + , getDevpath + , getSubsystem + , getDevtype + , getSyspath + , getSysname + , getSysnum + , getDevnode + , isInitialized + , getDevlinksListEntry + , getPropertiesListEntry + , getTagsListEntry + , getPropertyValue + , getDriver + , getDevnum + , getAction + + -- * Sysattrs + , getSysattrValue + , setSysattrValue + , getSysattrListEntry + + -- * Misc + , getSeqnum + , getUsecSinceInitialized + , hasTag + ) where + +import Control.Applicative +import Data.ByteString as BS +import Foreign hiding (unsafePerformIO) +import Foreign.C +import System.IO.Unsafe + +import System.UDev.Context +import System.UDev.List +import System.UDev.Types + + +foreign import ccall unsafe "udev_device_new_from_syspath" + c_newFromSysPath :: UDev -> CString -> IO Device + +-- TODO type SysPath = FilePath +type SysPath = ByteString + +-- | Create new udev device, and fill in information from the sys +-- device and the udev database entry. The syspath is the absolute +-- path to the device, including the sys mount point. +-- +newFromSysPath :: UDev -> SysPath -> IO Device +newFromSysPath udev sysPath = do + Device <$> (throwErrnoIfNull "newFromSysPath" $ do + useAsCString sysPath $ \ c_sysPath -> do + getDevice <$> c_newFromSysPath udev c_sysPath) + +type Dev_t = CULong + +foreign import ccall unsafe "udev_device_new_from_devnum" + c_newFromDevnum :: UDev -> CChar -> Dev_t -> IO Device + +-- | Device number. +type Devnum = Int + +-- | Create new udev device, and fill in information from the sys +-- device and the udev database entry. The device is looked-up by its +-- major/minor number and type. Character and block device numbers are +-- not unique across the two types. +-- +newFromDevnum :: UDev -> Char -> Devnum -> IO Device +newFromDevnum udev char devnum + = c_newFromDevnum udev (toEnum (fromEnum char)) (fromIntegral devnum) +{-# INLINE newFromDevnum #-} + +foreign import ccall unsafe "udev_device_new_from_subsystem_sysname" + c_newFromSubsystemSysname :: UDev -> CString -> CString -> IO Device + +-- | The device is looked up by the subsystem and name string of the +-- device, like \"mem\" \/ \"zero\", or \"block\" \/ \"sda\". +-- +newFromSubsystemSysname :: UDev -> ByteString -> ByteString -> IO Device +newFromSubsystemSysname udev subsystem sysname = do + useAsCString subsystem $ \ c_subsystem -> + useAsCString sysname $ \ c_sysname -> + c_newFromSubsystemSysname udev c_subsystem c_sysname + +foreign import ccall unsafe "udev_device_new_from_device_id" + c_newFromDeviceId :: UDev -> CString -> IO Device + +-- | The device is looked-up by a special string: +-- +-- * b8:2 - block device major:minor +-- +-- * c128:1 - char device major:minor +-- +-- * n3 - network device ifindex +-- +-- * +sound:card29 - kernel driver core subsystem:device name +-- +newFromDeviceId :: UDev -> ByteString -> IO Device +newFromDeviceId udev devId = do + useAsCString devId $ \ c_devId -> + c_newFromDeviceId udev c_devId + +foreign import ccall unsafe "udev_device_new_from_environment" + c_newFromEnvironment :: UDev -> IO Device + +-- | Create new udev device, and fill in information from the current +-- process environment. This only works reliable if the process is +-- called from a udev rule. It is usually used for tools executed from +-- @IMPORT=@ rules. +-- +newFromEnvironment :: UDev -> IO Device +newFromEnvironment = c_newFromEnvironment + +foreign import ccall unsafe "udev_device_get_parent" + c_getParent :: Device -> IO Device + +-- TODO: [MEM]: The returned the device is not referenced. It is +-- attached to the child device, and will be cleaned up when the child +-- device is cleaned up. + +-- | Find the next parent device, and fill in information from the sys +-- device and the udev database entry. +getParent :: Device -> IO Device +getParent = c_getParent + +foreign import ccall unsafe "udev_device_get_parent_with_subsystem_devtype" + c_getParentWithSubsystemDevtype :: Device -> CString -> CString + -> IO Device + +-- | Find the next parent device, with a matching subsystem and devtype +-- value, and fill in information from the sys device and the udev +-- database entry. +-- +getParentWithSubsystemDevtype :: Device -> ByteString -> ByteString + -> IO (Maybe Device) +getParentWithSubsystemDevtype udev subsystem devtype = do + mdev <- useAsCString subsystem $ \ c_subsystem -> + useAsCString devtype $ \ c_devtype -> + c_getParentWithSubsystemDevtype udev c_subsystem c_devtype + return $ if getDevice mdev == nullPtr then Nothing else Just mdev + +foreign import ccall unsafe "udev_device_get_devpath" + c_getDevpath :: Device -> IO CString + +-- TODO use RawFilePath + +{----------------------------------------------------------------------- +-- Query +-----------------------------------------------------------------------} + +-- | Retrieve the kernel devpath value of the udev device. The path +-- does not contain the sys mount point, and starts with a \'/\'. +-- +getDevpath :: Device -> IO ByteString +getDevpath dev = packCString =<< c_getDevpath dev + +foreign import ccall unsafe "udev_device_get_subsystem" + c_getSubsystem :: Device -> IO CString + +packCStringMaybe :: CString -> IO (Maybe ByteString) +packCStringMaybe cstring = + if cstring == nullPtr + then return Nothing + else Just <$> packCString cstring + +-- | Retrieve the subsystem string of the udev device. The string does +-- not contain any \"/\". +-- +getSubsystem :: Device -> Maybe ByteString +getSubsystem dev = unsafePerformIO $ packCStringMaybe =<< c_getSubsystem dev + +foreign import ccall unsafe "udev_device_get_devtype" + c_getDevtype :: Device -> IO CString + +-- | Retrieve the devtype string of the udev device. +getDevtype :: Device -> Maybe ByteString +getDevtype dev = unsafePerformIO $ packCStringMaybe =<< c_getDevtype dev + +foreign import ccall unsafe "udev_device_get_syspath" + c_getSyspath :: Device -> IO CString + +-- | Retrieve the sys path of the udev device. The path is an absolute +-- path and starts with the sys mount point. +-- +getSyspath :: Device -> ByteString +getSyspath dev = unsafePerformIO $ packCString =<< c_getSyspath dev + +foreign import ccall unsafe "udev_device_get_sysname" + c_getSysname :: Device -> IO CString + +-- | Get the kernel device name in /sys. +getSysname :: Device -> ByteString +getSysname dev = unsafePerformIO $ packCString =<< c_getSysname dev + +foreign import ccall unsafe "udev_device_get_sysnum" + c_getSysnum :: Device -> IO CString + +-- TODO :: Device -> Maybe Int ? + +-- | Get the instance number of the device. +getSysnum :: Device -> Maybe ByteString +getSysnum dev = unsafePerformIO $ packCStringMaybe =<< c_getSysnum dev + +foreign import ccall unsafe "udev_device_get_devnode" + c_getDevnode :: Device -> IO CString + +-- | Retrieve the device node file name belonging to the udev +-- device. The path is an absolute path, and starts with the device +-- directory. +-- +getDevnode :: Device -> Maybe ByteString +getDevnode udev = unsafePerformIO $ packCStringMaybe =<< c_getDevnode udev + +foreign import ccall unsafe "udev_device_get_is_initialized" + c_isInitialized :: Device -> IO CInt + +-- | Check if udev has already handled the device and has set up +-- device node permissions and context, or has renamed a network +-- device. +-- +-- This is only implemented for devices with a device node or network +-- interfaces. All other devices return 1 here. +-- +isInitialized :: Device -> IO Bool +isInitialized dev = (< 0) <$> c_isInitialized dev + +foreign import ccall unsafe "udev_device_get_devlinks_list_entry" + c_getDevlinksListEntry :: Device -> IO List + +-- | Retrieve the list of device links pointing to the device file of +-- the udev device. The next list entry can be retrieved with +-- 'getNext', which returns 'Nothing' if no more entries exist. The +-- devlink path can be retrieved from the list entry by 'getName'. The +-- path is an absolute path, and starts with the device directory. +-- +getDevlinksListEntry :: Device -> IO List +getDevlinksListEntry = c_getDevlinksListEntry +{-# INLINE getDevlinksListEntry #-} + +foreign import ccall unsafe "udev_device_get_properties_list_entry" + c_getPropertiesListEntry :: Device -> IO List + +-- | Retrieve the list of key/value device properties of the udev +-- device. The next list entry can be retrieved with 'getNext', which +-- returns 'Nothing' if no more entries exist. The property name can +-- be retrieved from the list entry by 'getName', the property value +-- by 'getValue'. +-- +getPropertiesListEntry :: Device -> IO List +getPropertiesListEntry = c_getPropertiesListEntry +{-# INLINE getPropertiesListEntry #-} + +foreign import ccall unsafe "udev_device_get_tags_list_entry" + c_getTagsListEntry :: Device -> IO List + +-- | Retrieve the list of tags attached to the udev device. The next +-- list entry can be retrieved with 'getNext', which returns 'Nothing' +-- if no more entries exist. The tag string can be retrieved from the +-- list entry by 'getName'. +-- +getTagsListEntry :: Device -> IO List +getTagsListEntry = c_getTagsListEntry +{-# INLINE getTagsListEntry #-} + +foreign import ccall unsafe "udev_device_get_property_value" + c_getPropertyValue :: Device -> CString -> IO CString + +-- | Get the value of a given property. +getPropertyValue :: Device -> ByteString -> IO (Maybe ByteString) +getPropertyValue dev prop = do + res <- useAsCString prop $ \ c_prop -> + c_getPropertyValue dev c_prop + if res == nullPtr then return Nothing else Just <$> packCString res + +foreign import ccall unsafe "udev_device_get_driver" + c_getDriver :: Device -> IO CString + +-- TODO ByteString -> Text ? + +-- | Get the kernel driver name. +getDriver :: Device -> IO ByteString +getDriver dev = packCString =<< c_getDriver dev + +foreign import ccall unsafe "udev_device_get_devnum" + c_getDevnum :: Device -> IO Devnum + +-- | Get the device major/minor number. +getDevnum :: Device -> IO Devnum +getDevnum = c_getDevnum +{-# INLINE getDevnum #-} + +foreign import ccall unsafe "udev_device_get_action" + c_getAction :: Device -> CString + +-- TODO data Action + +-- | This is only valid if the device was received through a +-- monitor. Devices read from sys do not have an action string. +-- +getAction :: Device -> Maybe ByteString +getAction dev + | c_action == nullPtr = Nothing + | otherwise = Just $ unsafePerformIO $ packCString c_action + where + c_action = c_getAction dev + + +foreign import ccall unsafe "udev_device_get_sysattr_value" + c_getSysattrValue :: Device -> CString -> CString + +-- | The retrieved value is cached in the device. Repeated calls will +-- return the same value and not open the attribute again. +-- +getSysattrValue :: Device -> ByteString -> ByteString +getSysattrValue dev sysattr = do + unsafePerformIO $ do + packCString =<< useAsCString sysattr (return . c_getSysattrValue dev) + +foreign import ccall unsafe "udev_device_set_sysattr_value" + c_setSysattrValue :: Device -> CString -> CString -> IO CInt + +-- | Update the contents of the sys attribute and the cached value of +-- the device. +-- +setSysattrValue :: Device + -> ByteString -- ^ attribute name + -> ByteString -- ^ new value to be set + -> IO () +setSysattrValue dev sysattr value = do + throwErrnoIf_ (0 <) "setSysattrValue" $ do + useAsCString sysattr $ \ c_sysattr -> + useAsCString value $ \ c_value -> + c_setSysattrValue dev c_sysattr c_value + +foreign import ccall unsafe "udev_device_get_sysattr_list_entry" + c_getSysAttrListEntry :: Device -> IO List + +-- | Retrieve the list of available sysattrs, with value being empty; +-- This just return all available sysfs attributes for a particular +-- device without reading their values. +-- +getSysattrListEntry :: Device -> IO List +getSysattrListEntry = c_getSysAttrListEntry +{-# INLINE getSysattrListEntry #-} + +toMaybe :: CULLong -> Maybe Int +toMaybe 0 = Nothing +toMaybe n = Just (fromIntegral n) +{-# INLINE toMaybe #-} + +foreign import ccall unsafe "udev_device_get_seqnum" + c_getSeqnum :: Device -> IO CULLong + +-- | This is only valid if the device was received through a +-- monitor. Devices read from sys do not have a sequence number. +-- +getSeqnum :: Device -> IO (Maybe Int) +getSeqnum dev = toMaybe <$> c_getSeqnum dev +{-# INLINE getSeqnum #-} + +foreign import ccall unsafe "udev_device_get_usec_since_initialized" + c_getUsecSinceInitialized :: Device -> IO CULLong + +-- | Return the number of microseconds passed since udev set up the +-- device for the first time. +-- +-- This is only implemented for devices with need to store +-- properties in the udev database. All other devices return +-- 'Nothing' here. +-- +getUsecSinceInitialized :: Device -> IO (Maybe Int) +getUsecSinceInitialized dev = toMaybe <$> c_getUsecSinceInitialized dev + +foreign import ccall unsafe "udev_device_has_tag" + c_hasTag :: Device -> CString -> IO CInt + +-- | 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 diff --git a/src/System/UDev/Enumerate.hs b/src/System/UDev/Enumerate.hs new file mode 100644 --- /dev/null +++ b/src/System/UDev/Enumerate.hs @@ -0,0 +1,248 @@ +-- | +-- Copyright : (c) Sam Truzjan 2013 +-- License : BSD3 +-- Maintainer : pxqr.sta@gmail.com +-- Stability : stable +-- Portability : portable +-- +-- Lookup devices in the sys filesystem, filter devices by +-- properties, and return a sorted list of devices. +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module System.UDev.Enumerate + ( Enumerate + + , newEnumerate + + -- * Match + , Subsystem + , addMatchSubsystem + , addNoMatchSubsystem + + , SysAttr + , SysValue + , addMatchSysattr + , addNoMatchSysattr + + , addMatchProperty + , addMatchTag + , addMatchParent + , addMatchIsInitialized + , addMatchSysname + , addSyspath + + -- * Scan + , scanDevices + , scanSubsystems + + -- * Query + , getListEntry + ) where + +import Data.ByteString as BS +import Foreign +import Foreign.C.Error +import Foreign.C.String +import Foreign.C.Types + +import System.UDev.Context +import System.UDev.Device +import System.UDev.List +import System.UDev.Types + + +foreign import ccall unsafe "udev_enumerate_new" + c_new :: UDev -> IO Enumerate + +-- | Create an enumeration context to scan /sys. +newEnumerate :: UDev -> IO Enumerate +newEnumerate = c_new +{-# INLINE newEnumerate #-} + +{----------------------------------------------------------------------- +-- Match +-----------------------------------------------------------------------} + +foreign import ccall unsafe "udev_enumerate_add_match_subsystem" + c_addMatchSubsystem :: Enumerate -> CString -> IO CInt + +-- | Kernel subsystem string. +type Subsystem = ByteString + +-- | Match only devices belonging to a certain kernel subsystem. +addMatchSubsystem :: Enumerate -- ^ context + -> Subsystem -- ^ filter for a subsystem of the + -- device to include in the list + -> IO () -- ^ can throw exception +addMatchSubsystem enumerate subsystem = do + throwErrnoIfMinus1_ "addMatchSubsystem" $ do + useAsCString subsystem $ + c_addMatchSubsystem enumerate + +foreign import ccall unsafe "udev_enumerate_add_nomatch_subsystem" + c_addNoMatchSubsystem :: Enumerate -> CString -> IO CInt + +-- | Match only devices not belonging to a certain kernel subsystem. +addNoMatchSubsystem :: Enumerate -- ^ context + -> Subsystem -- ^ filter for a subsystem of the + -- device to exclude from the list + -> IO () -- ^ can throw exception +addNoMatchSubsystem enumerate subsystem = do + throwErrnoIfMinus1_ "addNoMatchSubsystem" $ do + useAsCString subsystem $ + c_addNoMatchSubsystem enumerate + +-- | \/sys attribute string. +type SysAttr = ByteString + +-- | Attribute specific \/sys value string. Can be an int or +-- identifier depending on attribute. +type SysValue = ByteString + +foreign import ccall unsafe "udev_enumerate_add_match_sysattr" + c_addMatchSysattr :: Enumerate -> CString -> CString -> IO CInt + +-- | Match only devices with a certain \/sys device attribute. +addMatchSysattr :: Enumerate -- ^ context + -> SysAttr -- ^ filter for a sys attribute at + -- 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 + case mvalue of + Nothing -> c_addMatchSysattr enumerate c_sysattr nullPtr + Just value -> do + useAsCString value $ \ c_value -> do + c_addMatchSysattr enumerate c_sysattr c_value + +foreign import ccall unsafe "udev_enumerate_add_nomatch_sysattr" + c_addNoMatchSysattr :: Enumerate -> CString -> CString -> IO CInt + +-- | Match only devices not having a certain /sys device attribute. +addNoMatchSysattr :: Enumerate -- ^ context + -> ByteString -- ^ filter for a sys attribute at the + -- device to exclude from the list + -> Maybe ByteString -- ^ optional value of the sys + -- attribute + -> IO () +addNoMatchSysattr enumerate sysattr mvalue = do + throwErrnoIf_ (< 0) "addNoMatchSysattr" $ do + useAsCString sysattr $ \ c_sysattr -> do + case mvalue of + Nothing -> c_addNoMatchSysattr enumerate c_sysattr nullPtr + Just value -> do + useAsCString value $ \ c_value -> do + c_addNoMatchSysattr enumerate c_sysattr c_value + +foreign import ccall unsafe "udev_enumerate_add_match_property" + c_addMatchProperty :: Enumerate -> CString -> CString -> IO CInt + +-- | Match only devices with a certain property. +addMatchProperty :: Enumerate -- ^ context + -> ByteString -- ^ filter for a property of the + -- 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 + c_addMatchProperty enumerate c_prop c_value + +foreign import ccall unsafe "udev_enumerate_add_match_tag" + c_addMatchTag :: Enumerate -> CString -> IO CInt + + +-- | Match only devices with a certain tag. +addMatchTag :: Enumerate -- ^ context + -> 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 + c_addMatchTag enumerate c_tag + +foreign import ccall unsafe "udev_enumerate_add_match_parent" + c_addMatchParent :: Enumerate -> Device -> IO CInt + +-- | Return the devices on the subtree of one given device. The parent +-- itself is included in the list. +-- +-- A reference for the device is held until the udev_enumerate context +-- is cleaned up. +-- +addMatchParent :: Enumerate -- ^ context + -> Device -- ^ parent device where to start searching + -> IO () -- ^ can throw exception +addMatchParent enumerate dev = do + throwErrnoIf_ (< 0) "addMatchParent" $ do + c_addMatchParent enumerate dev + +foreign import ccall unsafe "udev_enumerate_add_match_is_initialized" + c_addMatchIsInitialized :: Enumerate -> IO CInt + +-- | Match only devices which udev has set up already. +addMatchIsInitialized :: Enumerate -> IO () +addMatchIsInitialized enumerate = do + throwErrnoIfMinus1_ "addMatchIsInitialized" $ do + c_addMatchIsInitialized enumerate + +foreign import ccall unsafe "udev_enumerate_add_match_sysname" + c_addMatchSysname :: Enumerate -> CString -> IO CInt + +-- | Match only devices with a given \/sys device name. +addMatchSysname :: Enumerate -- ^ context + -> ByteString -- ^ filter for the name of the device + -- to include in the list + -> IO () -- ^ can throw exception +addMatchSysname enumerate sysName = do + throwErrnoIfMinus1_ "addMatchSysname" $ do + useAsCString sysName $ + c_addMatchSysname enumerate + +foreign import ccall unsafe "udev_enumerate_add_syspath" + c_addSyspath :: Enumerate -> CString -> IO CInt + +-- | Add a device to the list of devices, to retrieve it back sorted +-- in dependency order. +-- +addSyspath :: Enumerate -- ^ context + -> ByteString -- ^ path of a device + -> IO () -- ^ can throw exception +addSyspath enumerate syspath = do + throwErrnoIf_ (< 0) "addSyspath" $ do + useAsCString syspath $ \ c_syspath -> do + c_addSyspath enumerate c_syspath + +{----------------------------------------------------------------------- +-- Scan +-----------------------------------------------------------------------} + +foreign import ccall unsafe "udev_enumerate_scan_devices" + c_scanDevices :: Enumerate -> IO CInt + +-- | Scan \/sys for all devices which match the given filters. +scanDevices :: Enumerate -> IO () +scanDevices = throwErrnoIfMinus1_ "scanDevices" . c_scanDevices + +foreign import ccall unsafe "udev_enumerate_scan_subsystems" + c_scanSubsystems :: Enumerate -> IO CInt + +-- | Scan \/sys for all devices which match the given filters. +scanSubsystems :: Enumerate -> IO () +scanSubsystems = throwErrnoIfMinus1_ "scanSubsystems" . c_scanSubsystems + +{----------------------------------------------------------------------- +-- Query +-----------------------------------------------------------------------} + +foreign import ccall unsafe "udev_enumerate_get_list_entry" + c_getListEntry :: Enumerate -> IO List + +-- | Get the first entry of the sorted list of device paths. +getListEntry :: Enumerate -> IO List +getListEntry = c_getListEntry +{-# INLINE getListEntry #-} diff --git a/src/System/UDev/HWDB.hs b/src/System/UDev/HWDB.hs new file mode 100644 --- /dev/null +++ b/src/System/UDev/HWDB.hs @@ -0,0 +1,44 @@ +-- | +-- Copyright : (c) Sam Truzjan 2013 +-- License : BSD3 +-- Maintainer : pxqr.sta@gmail.com +-- Stability : stable +-- Portability : portable +-- +-- Retrieve properties from the hardware database. +-- +module System.UDev.HWDB + ( HWDB + , newHWDB + , getPropertiesList + ) where + +import Data.ByteString as BS +import Foreign.C + +import System.UDev.Context +import System.UDev.List +import System.UDev.Types + + +foreign import ccall unsafe "udev_hwdb_new" + c_new :: UDev -> IO HWDB + +-- | Create a hardware database context to query properties for +-- devices. +newHWDB :: UDev -> IO HWDB +newHWDB = c_new + +foreign import ccall unsafe "udev_hwdb_get_properties_list_entry" + c_getPropertiesList :: HWDB -> CString -> CUInt -> IO List + +-- | Lookup a matching device in the hardware database. The lookup key +-- is a modalias string, whose formats are defined for the Linux +-- kernel modules. Examples are: pci:v00008086d00001C2D*, +-- usb:v04F2pB221*. The first entry of a list of retrieved properties +-- is returned. +-- +getPropertiesList :: HWDB -> ByteString -> IO List +getPropertiesList hwdb modalias = + useAsCString modalias $ \ c_modalias -> + c_getPropertiesList hwdb c_modalias 0 diff --git a/src/System/UDev/List.hs b/src/System/UDev/List.hs new file mode 100644 --- /dev/null +++ b/src/System/UDev/List.hs @@ -0,0 +1,59 @@ +-- | +-- Copyright : (c) Sam Truzjan 2013 +-- License : BSD3 +-- Maintainer : pxqr.sta@gmail.com +-- Stability : experimental +-- Portability : portable +-- +-- Libudev list operations. +-- +module System.UDev.List + ( List + + , getNext + , getByName + + , getName + , getValue + ) where + +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 + +foreign import ccall unsafe "udev_list_entry_get_by_name" + c_getByName :: List -> IO List + +foreign import ccall unsafe "udev_list_entry_get_name" + c_getName :: List -> IO CString + +foreign import ccall unsafe "udev_list_entry_get_value" + c_getValue :: List -> IO CString + +-- | Get the next entry from the list. +getNext :: List -> IO (Maybe List) +getNext xxs = do + xs <- c_getNext xxs + return $ if xs == nil then Nothing else Just xs + +-- | Lookup an entry in the list with a certain name. +getByName :: List -> IO (Maybe List) +getByName xs = do + ys <- c_getByName xs + return $ if ys == nil then Nothing else Just ys + +-- TODO avoid copying? +-- | Get the name of a list entry. +getName :: List -> IO ByteString +getName = c_getName >=> packCString + +-- | Get the value of list entry. +getValue :: List -> IO ByteString +getValue = c_getValue >=> packCString diff --git a/src/System/UDev/Monitor.hs b/src/System/UDev/Monitor.hs new file mode 100644 --- /dev/null +++ b/src/System/UDev/Monitor.hs @@ -0,0 +1,187 @@ +-- | +-- 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 + , udevId + , kernelId + , 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. +newtype SourceId = SourceId ByteString + +-- | 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 +-- 'kernelId' instead. +-- +kernelId :: SourceId +kernelId = SourceId "kernel" + +-- | Events are sent out after udev has finished its event processing, +-- all rules have been processed, and needed device nodes are created. +udevId :: SourceId +udevId = SourceId "udev" + + +-- | Create new udev monitor and connect to a specified event source. +newFromNetlink :: UDev -> SourceId -> IO Monitor +newFromNetlink udev (SourceId name) = + Monitor <$> do + throwErrnoIfNull "newFromNetlink" $ do + useAsCString name $ \ c_name -> do + getMonitor <$> c_newFromNetlink udev c_name + + +foreign import ccall unsafe "udev_monitor_enable_receiving" + c_enableReceiving :: Monitor -> IO CInt + +-- | Binds the udev_monitor socket to the event source. +enableReceiving :: Monitor -> IO () +enableReceiving monitor = do + throwErrnoIfMinus1_ "enableReceiving" $ do + 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 = do + throwErrnoIfMinus1_ "setReceiveBufferSize" $ do + 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 + +-- | Retrieve 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 = do + Device <$> do + throwErrnoIfNull "receiveDevice" $ do + 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 -> ByteString -> IO () +filterAddMatchSubsystemDevtype monitor subsystem devtype = do + throwErrnoIfMinus1_ "filterAddMatchSubsystemDevtype" $ + useAsCString subsystem $ \ c_subsystem -> + useAsCString devtype $ \ c_devtype -> + c_filterAddMatchSubsystemDevtype monitor c_subsystem c_devtype + +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 = do + throwErrnoIfMinus1_ "filterAddMatchTag" $ do + useAsCString tag $ \ c_tag -> do + 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 = do + throwErrnoIfMinus1_ "filterUpdate" $ do + 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 = do + throwErrnoIfMinus1_ "filterRemove" $ do + c_filterRemove monitor diff --git a/src/System/UDev/Queue.hs b/src/System/UDev/Queue.hs new file mode 100644 --- /dev/null +++ b/src/System/UDev/Queue.hs @@ -0,0 +1,112 @@ +-- | +-- Copyright : (c) Sam Truzjan 2013 +-- License : BSD3 +-- Maintainer : pxqr.sta@gmail.com +-- Stability : experimental +-- Portability : portable +-- +-- The udev daemon processes events asynchronously. All events which +-- do not have interdependencies run in parallel. This exports the +-- current state of the event processing queue, and the current +-- event sequence numbers from the kernel and the udev daemon. +-- +module System.UDev.Queue + ( Queue + , Seqnum + + , newQueue + , isActive + , isEmpty + , isFinished + + , getPending + , sequenceIsFinished + , getKernelSeqnum + , getUDevSeqnum + ) where + +import Control.Applicative +import Foreign.C + +import System.UDev.Context +import System.UDev.List +import System.UDev.Types + + +foreign import ccall unsafe "udev_queue_new" + c_newQueue :: UDev -> IO Queue + +-- | Create a new queue. +newQueue :: UDev -> IO Queue +newQueue = c_newQueue +{-# INLINE newQueue #-} + +foreign import ccall unsafe "udev_queue_get_udev_is_active" + c_isActive :: Queue -> IO CInt + +-- | Check if udev is active on the system. +isActive :: Queue -> IO Bool +isActive queue = (0 <) <$> c_isActive queue +{-# INLINE isActive #-} + +foreign import ccall unsafe "udev_queue_get_queue_is_empty" + c_isEmpty :: Queue -> IO CInt + +-- | Check if udev is currently processing any events. +isEmpty :: Queue -> IO Bool +isEmpty queue = (0 <) <$> c_isEmpty queue +{-# INLINE isEmpty #-} + +foreign import ccall unsafe "udev_queue_get_seqnum_is_finished" + c_isFinished :: Queue -> CULLong -> IO CInt + +-- | Sequence number of event. +type Seqnum = Int + +-- | Check if udev is currently processing a given sequence number. +isFinished :: Queue -- ^ udev queue context + -> Seqnum -- ^ sequence number + -> IO Bool -- ^ if the given sequence number is currently + -- active. +isFinished queue seqnr = (0 <) <$> c_isFinished queue (fromIntegral seqnr) +{-# INLINE isFinished #-} + +foreign import ccall unsafe "udev_queue_get_seqnum_sequence_is_finished" + c_sequenceIsFinished :: Queue -> CULLong -> CULLong -> IO CInt + +-- | Check if udev is currently processing any events in a given +-- sequence number range. +-- +sequenceIsFinished :: Queue -- ^ udev queue context + -> Seqnum -- ^ first event sequence number + -> 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 + (> 0) <$> c_sequenceIsFinished queue (fromIntegral start) + (fromIntegral end) +{-# INLINE sequenceIsFinished #-} + +foreign import ccall unsafe "udev_queue_get_queued_list_entry" + c_getPending :: Queue -> IO List + +-- | Get the first entry of the list of queued events. +getPending :: Queue -> IO List +getPending = c_getPending +{-# INLINE getPending #-} + +foreign import ccall unsafe "udev_queue_get_kernel_seqnum" + c_getKernelSeqnum :: Queue -> IO CULLong + +-- | Get the current kernel event sequence number. +getKernelSeqnum :: Queue -> IO Seqnum +getKernelSeqnum queue = fromIntegral <$> c_getKernelSeqnum queue +{-# INLINE getKernelSeqnum #-} + +foreign import ccall unsafe "udev_queue_get_udev_seqnum" + c_getUDevSeqnum :: Queue -> IO CULLong + +-- | Get the last known udev event sequence number. +getUDevSeqnum :: Queue -> IO Seqnum +getUDevSeqnum queue = fromIntegral <$> c_getUDevSeqnum queue +{-# INLINE getUDevSeqnum #-} diff --git a/src/System/UDev/Types.hs b/src/System/UDev/Types.hs new file mode 100644 --- /dev/null +++ b/src/System/UDev/Types.hs @@ -0,0 +1,152 @@ +-- | +-- Copyright : (c) Sam Truzjan 2013 +-- License : BSD3 +-- Maintainer : pxqr.sta@gmail.com +-- Stability : experimental +-- Portability : portable +-- +-- Internal definitions; do not export this module. +-- +module System.UDev.Types + ( Ref (..) + , UDevChild (..) + + , UDev (..) + , Device (..) + , Enumerate (..) + , HWDB (..) + , List (..), nil + , Queue (..) + ) where + +import Foreign + +{----------------------------------------------------------------------- +-- Classes +-----------------------------------------------------------------------} + +class Ref a where + ref :: a -> IO a + unref :: a -> IO a + +-- | Family of udev resources. +class UDevChild a where + -- | Get the context a resource belong to. + getUDev :: a -> UDev + +{----------------------------------------------------------------------- +-- UDev +-----------------------------------------------------------------------} + +-- | Opaque object representing the library context. +newtype UDev = UDev (Ptr UDev) + + +instance UDevChild UDev where + getUDev = id + +foreign import ccall unsafe "udev_ref" + c_ref :: UDev -> IO UDev + +foreign import ccall unsafe "udev_unref" + c_unref :: UDev -> IO UDev + +instance Ref UDev where + ref = c_ref + unref = c_unref + +{----------------------------------------------------------------------- +-- Device +-----------------------------------------------------------------------} + +-- | Opaque object representing one kernel sys device. +newtype Device = Device { getDevice :: Ptr Device } + +foreign import ccall unsafe "udev_device_ref" + c_deviceRef :: Device -> IO Device + +foreign import ccall unsafe "udev_device_unref" + c_deviceUnref :: Device -> IO Device + +instance Ref Device where + ref = c_deviceRef + unref = c_deviceUnref + +foreign import ccall unsafe "udev_device_get_udev" + c_getUDev :: Device -> UDev + +instance UDevChild Device where + getUDev = c_getUDev + +{----------------------------------------------------------------------- +-- Enumerate +-----------------------------------------------------------------------} + +-- | Opaque object representing one device lookup/sort context. +newtype Enumerate = Enumerate (Ptr Enumerate) + +foreign import ccall unsafe "udev_enumerate_ref" + c_EnumerateRef :: Enumerate -> IO Enumerate + +foreign import ccall unsafe "udev_enumerate_unref" + c_EnumerateUnref :: Enumerate -> IO Enumerate + +instance Ref Enumerate where + ref = c_EnumerateRef + unref = c_EnumerateUnref + +foreign import ccall unsafe "udev_enumerate_get_udev" + c_EnumerateGetUDev :: Enumerate -> UDev + +instance UDevChild Enumerate where + getUDev = c_EnumerateGetUDev + +{----------------------------------------------------------------------- +-- HWDB +-----------------------------------------------------------------------} + +-- | Opaque object representing the hardware database. +newtype HWDB = HWDB (Ptr HWDB) + +foreign import ccall unsafe "udev_hwdb_ref" + c_HWDBRef :: HWDB -> IO HWDB + +foreign import ccall unsafe "udev_hwdb_unref" + c_HWDBUnref :: HWDB -> IO HWDB + +instance Ref HWDB where + ref = c_HWDBRef + unref = c_HWDBUnref + +{----------------------------------------------------------------------- +-- List +-----------------------------------------------------------------------} + +-- TODO newtype List name value + +-- | Opaque object representing one entry in a list. An entry contains +-- contains a name, and optionally a value. +-- +newtype List = List (Ptr List) + deriving Eq + +nil :: List +nil = List nullPtr + +{----------------------------------------------------------------------- +-- Queue +-----------------------------------------------------------------------} + +-- | Opaque object representing the current event queue in the udev +-- daemon. +newtype Queue = Queue { getQueue :: Ptr Queue } + +foreign import ccall unsafe "udev_queue_ref" + c_queueRef :: Queue -> IO Queue + +foreign import ccall unsafe "udev_queue_unref" + c_queueUnref :: Queue -> IO Queue + +instance Ref Queue where + ref = c_queueRef + unref = c_queueUnref diff --git a/src/System/UDev/Util.hs b/src/System/UDev/Util.hs new file mode 100644 --- /dev/null +++ b/src/System/UDev/Util.hs @@ -0,0 +1,24 @@ +-- | +-- Copyright : (c) Sam Truzjan 2013 +-- License : BSD3 +-- Maintainer : pxqr.sta@gmail.com +-- Stability : experimental +-- Portability : portable +-- +-- Utilities useful when dealing with devices and device node names. +-- +module System.UDev.Util + ( encodeString + ) where + +import Foreign.C + + +foreign import ccall unsafe "udev_util_encode_string" + c_encodeString :: CString -> CString -> CSize -> IO () + +-- | Encode all potentially unsafe characters of a string to the +-- corresponding 2 char hex value prefixed by '\x'. +-- +encodeString :: CString -> CString -> CSize -> IO () +encodeString = c_encodeString diff --git a/udev.cabal b/udev.cabal new file mode 100644 --- /dev/null +++ b/udev.cabal @@ -0,0 +1,71 @@ +name: udev +version: 0.0.0.0 +license: BSD3 +license-file: LICENSE +author: Sam Truzjan +maintainer: pxqr.sta@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 +synopsis: libudev bindings +description: libudev bindings + +extra-source-files: README.md + , changelog + +source-repository head + type: git + location: git://github.com/pxqr/udev.git + branch: master + +source-repository this + type: git + location: git://github.com/pxqr/udev.git + branch: master + tag: v0.0.0.0 + +flag examples + description: whether to build examples + default: False + +library + default-language: Haskell2010 + default-extensions: + hs-source-dirs: src + exposed-modules: System.UDev + , System.UDev.Context + , System.UDev.Device + , System.UDev.Enumerate + , System.UDev.HWDB + , System.UDev.List + , System.UDev.Monitor + , System.UDev.Queue + , System.UDev.Util + other-modules: System.UDev.Types + pkgconfig-depends: libudev + build-depends: base == 4.* + , bytestring + , unix + build-tools: hsc2hs + ghc-options: -Wall + +executable hidraw + default-language: Haskell2010 + hs-source-dirs: examples + main-is: hidraw.hs + build-depends: base, bytestring, udev + if !flag(examples) + buildable: False + +executable monitor + default-language: Haskell2010 + hs-source-dirs: examples + main-is: monitor.hs + build-depends: base, bytestring, udev, select + if !flag(examples) + buildable: False