diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -20,3 +20,8 @@ * Add `newDevices` stream. * More robust error handling when reading from multiple devices. + +## 1.3.0.0 -- 2020-03-03 + +* Fix memory management issues and file descriptor leaks. +* Rename 'ReadFlags' to 'ReadFlag' as the type clearly represents just one flag. diff --git a/evdev.cabal b/evdev.cabal --- a/evdev.cabal +++ b/evdev.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: evdev -version: 1.2.0.1 +version: 1.3.0.0 author: George Thomas maintainer: George Thomas description: Provides access to the Linux event device interface, with an optional high-level Streamly-based API. @@ -44,6 +44,7 @@ default-extensions: FlexibleContexts GeneralizedNewtypeDeriving LambdaCase + NumericUnderscores OverloadedLists OverloadedStrings PatternSynonyms @@ -52,5 +53,5 @@ includes: libevdev-1.0/libevdev/libevdev.h linux/input.h errno.h - extra-libraries: evdev + c-sources: src-c/evdev-hs.c pkgconfig-depends: libevdev diff --git a/src-c/evdev-hs.c b/src-c/evdev-hs.c new file mode 100644 --- /dev/null +++ b/src-c/evdev-hs.c @@ -0,0 +1,9 @@ +#include +#include +#include + +void libevdev_hs_close(struct libevdev *dev) { + int fd = libevdev_get_fd(dev); + libevdev_free(dev); + close(fd); +} diff --git a/src/Evdev.hs b/src/Evdev.hs --- a/src/Evdev.hs +++ b/src/Evdev.hs @@ -27,26 +27,27 @@ EventCode(..), EventValue(..), KeyEventType(..), - ReadFlags (..), + ReadFlag(..), ) where import Control.Arrow (second) -import Control.Monad (filterM) +import Control.Monad (filterM,join) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as BS -import Data.Int (Int16,Int32) +import Data.Int (Int32) import Data.List.Extra (enumerate) import Data.Set (Set) -import Data.Time.Clock (DiffTime) +import Data.Time.Clock (DiffTime,picosecondsToDiffTime) +import Data.Word (Word16) import Foreign ((.|.)) -import Foreign.C (CUInt) +import Foreign.C (CInt(..),CUInt(..),CUShort(..)) import Foreign.C.Error (Errno(Errno),errnoToIOError) import Safe (initSafe,tailSafe) import System.Posix.ByteString (Fd,RawFilePath) import System.Posix.IO.ByteString (fdToHandle) import qualified Evdev.LowLevel as LL -import Evdev.LowLevel (ReadFlags(..)) +import Evdev.LowLevel (ReadFlag(..)) import Evdev.Codes -- stores path that was originally used, as it seems impossible to recover this later @@ -122,7 +123,7 @@ pattern ForceFeedbackStatusEvent :: EventCode -> EventValue -> Event pattern ForceFeedbackStatusEvent c v <- Event EvFfStatus c v _ -newtype EventCode = EventCode Int16 deriving (Enum, Eq, Ord, Read, Show) +newtype EventCode = EventCode Word16 deriving (Enum, Eq, Ord, Read, Show) newtype EventValue = EventValue Int32 deriving (Enum, Eq, Ord, Read, Show) data KeyEventType @@ -131,10 +132,10 @@ | Repeated deriving (Enum, Eq, Ord, Read, Show) -convertFlags :: Set ReadFlags -> CUInt +convertFlags :: Set ReadFlag -> CUInt convertFlags = fromIntegral . foldr ((.|.) . fromEnum) 0 -defaultReadFlags :: Set ReadFlags +defaultReadFlags :: Set ReadFlag defaultReadFlags = [Normal,Blocking] grabDevice :: Device -> IO () @@ -142,11 +143,12 @@ ungrabDevice :: Device -> IO () ungrabDevice = grabDevice' LL.LibevdevUngrab -nextEvent :: Device -> Set ReadFlags -> IO Event +nextEvent :: Device -> Set ReadFlag -> IO Event nextEvent dev flags = do - (t,c,v,time) <- LL.convertEvent =<< - throwCErrors "nextEvent" (Right dev) (LL.nextEvent (cDevice dev) (convertFlags flags)) - return $ Event (toEnum t) (EventCode c) (EventValue v) time + (CUShort t, CUShort c, CInt v, s, us) <- + throwCErrors "nextEvent" (Right dev) $ LL.nextEvent (cDevice dev) (convertFlags flags) + return $ Event (convertEnum t) (EventCode c) (EventValue v) $ + picosecondsToDiffTime $ 1_000_000_000_000 * fromIntegral s + 1_000_000 * fromIntegral us newDevice :: RawFilePath -> IO Device newDevice path = do @@ -157,7 +159,7 @@ evdevDir = "/dev/input" deviceName :: Device -> IO ByteString -deviceName = fmap BS.pack . LL.deviceName . cDevice +deviceName = join . LL.deviceName . cDevice deviceFd :: Device -> IO Fd deviceFd = LL.deviceFd . cDevice @@ -185,6 +187,14 @@ grabDevice' :: LL.GrabMode -> Device -> IO () grabDevice' mode dev = throwCErrors "grabDevice" (Right dev) $ LL.grabDevice (cDevice dev) mode +--TODO ensure all uses are safe + -- really, fromEnum should be :: e -> Integer + -- and toEnum :: Integral a => a -> Maybe e + -- the issues with Enum are great enough that it may be worth considering using something more bespoke than c2hs + -- or it could be worth a PR + -- auto-generate safe *toInt/*fromInt based on the current logic + -- then implement Enum instance in terms of those + -- note that we also use to/from-Enum in LowLevel -- obviously this isn't safe in general -- we use it only after matching on 'EventType', to get the corresponding 'EventCode' and 'EventValue' convertEnum :: (Enum a, Enum b) => a -> b diff --git a/src/Evdev/LowLevel.chs b/src/Evdev/LowLevel.chs --- a/src/Evdev/LowLevel.chs +++ b/src/Evdev/LowLevel.chs @@ -1,13 +1,10 @@ module Evdev.LowLevel where import Control.Monad.Loops (iterateWhile) -import Data.Int (Int16,Int32) -import Data.Time.Clock (DiffTime,picosecondsToDiffTime) -import Foreign (Ptr) -import Foreign.C (CInt,CUInt,CLong) +import Data.ByteString (ByteString,packCString) +import Foreign (Ptr,allocaBytes) +import Foreign.C (CInt(..),CUInt(..),CUShort(..),CLong) import Foreign.C.Error (Errno(Errno)) -import Foreign.ForeignPtr (mallocForeignPtrBytes,withForeignPtr) -import Foreign.Storable (peekByteOff) import System.Posix.ByteString (RawFilePath) import System.Posix.IO.ByteString (OpenMode(ReadOnly),defaultFileFlags,openFd) import System.Posix.Types (Fd(Fd)) @@ -18,7 +15,7 @@ #include #include -{#enum libevdev_read_flag as ReadFlags { +{#enum libevdev_read_flag as ReadFlag { LIBEVDEV_READ_FLAG_SYNC as Sync, LIBEVDEV_READ_FLAG_NORMAL as Normal, LIBEVDEV_READ_FLAG_FORCE_SYNC as ForceSync, @@ -27,61 +24,58 @@ {#enum libevdev_grab_mode as GrabMode { underscoreToCase } deriving (Show) #} -{#pointer *input_event as Event foreign newtype#} - -{#pointer *timeval as Time foreign newtype#} - -{#pointer *libevdev as Device newtype #} +{#pointer *libevdev as Device foreign finalizer libevdev_hs_close newtype #} +--TODO any reason c2hs doesn't allow a haskell function as the finalizer? + -- failing that, any reason not to have actual inline c? +--TODO expose this directly, seeing as the GC makes no guarantees of promptness +#c +void libevdev_hs_close(struct libevdev *dev); +#endc {- Conversions -} -convertEvent :: Event -> IO (Int,Int16,Int32,DiffTime) -convertEvent ev = (,,,) - <$> getIntField {#get input_event->type #} - <*> getIntField {#get input_event->code #} - <*> getIntField {#get input_event->value #} - <*> withEvent ev getTime - where - convertTime s us = picosecondsToDiffTime $ 1000000000000 * fromIntegral s + 1000000 * fromIntegral us - getIntField :: (Integral a,Integral b) => (Ptr Event -> IO a) -> IO b - getIntField f = withEvent ev (fmap fromIntegral . f) - getTime :: Ptr Event -> IO DiffTime - getTime ptr = - let sec, usec :: IO CLong - sec = peekByteOff ptr 0 - usec = peekByteOff ptr {#sizeof __kernel_time_t #} - in convertTime <$> sec <*> usec - -nextEvent :: Device -> CUInt -> IO (Errno, Event) -nextEvent dev flags = iterateWhile ((== Errno (-{#const EAGAIN #})) . fst) $ do - ptr <- mallocForeignPtrBytes {#sizeof input_event #} - err <- withForeignPtr ptr $ {#call libevdev_next_event #} dev flags - return (Errno err, Event ptr) +{#fun libevdev_next_event { `Device', `CUInt', `Ptr ()' } -> `Errno' Errno #} +nextEvent :: Device -> CUInt -> IO (Errno, (CUShort,CUShort,CInt,CLong,CLong)) --TODO not CLong on all platforms +nextEvent dev flags = allocaBytes {#sizeof input_event #} $ \evPtr -> + (,) <$> iterateWhile (== Errno (-{#const EAGAIN #})) (libevdev_next_event dev flags evPtr) + <*> ( + (,,,,) + <$> {#get input_event->type #} evPtr + <*> {#get input_event->code #} evPtr + <*> {#get input_event->value #} evPtr + <*> {#get input_event->time.tv_sec #} evPtr + <*> {#get input_event->time.tv_usec #} evPtr + ) -{#fun libevdev_grab { `Device', `GrabMode' } -> `CInt' #} +{#fun libevdev_grab { `Device', `GrabMode' } -> `Errno' Errno #} grabDevice :: Device -> GrabMode -> IO (Errno, ()) -grabDevice dev mode = do - err <- libevdev_grab dev mode - return (Errno err, ()) +grabDevice = fmap (,()) .: libevdev_grab +--TODO use 'libevdev_new_from_fd' when https://github.com/haskell/c2hs/issues/236 fixed +{#fun libevdev_new {} -> `Device' #} +{#fun libevdev_set_fd { `Device', unFd `Fd' } -> `Errno' Errno #} newDevice :: RawFilePath -> IO (Errno, Device) newDevice path = do - Fd n <- openFd path ReadOnly Nothing $ defaultFileFlags - dev <- {#call libevdev_new #} - err <- {#call libevdev_set_fd #} dev n - return (Errno err, dev) + fd <- openFd path ReadOnly Nothing defaultFileFlags + dev <- libevdev_new + err <- libevdev_set_fd dev fd + return (err, dev) {- Simpler functions -} {#fun libevdev_has_property as hasProperty { `Device', convertEnum `DeviceProperty' } -> `Bool' #} {#fun libevdev_get_fd as deviceFd { `Device' } -> `Fd' Fd #} -{#fun libevdev_get_name as deviceName { `Device' } -> `String' #} ---TODO should really be ByteString - +{#fun libevdev_get_name as deviceName { `Device' } -> `IO ByteString' packCString #} {- Util -} -convertEnum :: (Enum a, Integral b) => a -> b +convertEnum :: DeviceProperty -> CUInt convertEnum = fromIntegral . fromEnum + +(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d +(.:) = (.) . (.) + +unFd :: Fd -> CInt +unFd (Fd n) = n diff --git a/src/Evdev/Stream.hs b/src/Evdev/Stream.hs --- a/src/Evdev/Stream.hs +++ b/src/Evdev/Stream.hs @@ -52,6 +52,7 @@ -- | All events on all valid devices (in /\/dev\/input/). -- Prints any exceptions. +-- -- > allEvents == readEventsMany allDevices allEvents :: IsStream t => t IO (Device, Event) allEvents = readEventsMany allDevices