1 {-# LANGUAGE ForeignFunctionInterface, GeneralizedNewtypeDeriving,
5 -- | A binding to the epoll I/O event notification facility
7 -- epoll is a variant of poll that can be used either as an edge-triggered or
8 -- a level-triggered interface and scales well to large numbers of watched file
11 -- epoll decouples monitor an fd from the process of registering it.
13 module System.Event.EPoll
19 import qualified System.Event.Internal as E
21 #include "EventConfig.h"
22 #if !defined(HAVE_EPOLL)
26 new = error "EPoll back end not implemented for this platform"
30 {-# INLINE available #-}
33 #include <sys/epoll.h>
35 import Control.Monad (when)
36 import Data.Bits (Bits, (.|.), (.&.))
37 import Data.Monoid (Monoid(..))
38 import Data.Word (Word32)
39 import Foreign.C.Error (throwErrnoIfMinus1, throwErrnoIfMinus1_)
40 import Foreign.C.Types (CInt)
41 import Foreign.Marshal.Utils (with)
42 import Foreign.Ptr (Ptr)
43 import Foreign.Storable (Storable(..))
45 import GHC.Err (undefined)
46 import GHC.Num (Num(..))
47 import GHC.Real (ceiling, fromIntegral)
48 import GHC.Show (Show)
49 import System.Posix.Internals (c_close)
50 #if !defined(HAVE_EPOLL_CREATE1)
51 import System.Posix.Internals (setCloseOnExec)
53 import System.Posix.Types (Fd(..))
55 import qualified System.Event.Array as A
56 import System.Event.Internal (Timeout(..))
60 {-# INLINE available #-}
63 epollFd :: {-# UNPACK #-} !EPollFd
64 , epollEvents :: {-# UNPACK #-} !(A.Array Event)
67 -- | Create a new epoll backend.
72 let !be = E.backend poll modifyFd delete (EPoll epfd evts)
75 delete :: EPoll -> IO ()
77 _ <- c_close . fromEPollFd . epollFd $ be
80 -- | Change the set of events we are interested in for a given file
82 modifyFd :: EPoll -> Fd -> E.Event -> E.Event -> IO ()
83 modifyFd ep fd oevt nevt = with (Event (fromEvent nevt) fd) $
84 epollControl (epollFd ep) op fd
85 where op | oevt == mempty = controlOpAdd
86 | nevt == mempty = controlOpDelete
87 | otherwise = controlOpModify
89 -- | Select a set of file descriptors which are ready for I/O
90 -- operations and call @f@ for all ready file descriptors, passing the
91 -- events that are ready.
92 poll :: EPoll -- ^ state
93 -> Timeout -- ^ timeout in milliseconds
94 -> (Fd -> E.Event -> IO ()) -- ^ I/O callback
96 poll ep timeout f = do
97 let events = epollEvents ep
99 -- Will return zero if the system call was interupted, in which case
100 -- we just return (and try again later.)
101 n <- A.unsafeLoad events $ \es cap ->
102 epollWait (epollFd ep) es cap $ fromTimeout timeout
105 A.forM_ events $ \e -> f (eventFd e) (toEvent (eventTypes e))
106 cap <- A.capacity events
107 when (cap == n) $ A.ensureCapacity events (2 * cap)
109 newtype EPollFd = EPollFd {
111 } deriving (Eq, Show)
114 eventTypes :: EventType
118 instance Storable Event where
119 sizeOf _ = #size struct epoll_event
120 alignment _ = alignment (undefined :: CInt)
123 ets <- #{peek struct epoll_event, events} ptr
124 ed <- #{peek struct epoll_event, data.fd} ptr
125 let !ev = Event (EventType ets) ed
129 #{poke struct epoll_event, events} ptr (unEventType $ eventTypes e)
130 #{poke struct epoll_event, data.fd} ptr (eventFd e)
132 newtype ControlOp = ControlOp CInt
134 #{enum ControlOp, ControlOp
135 , controlOpAdd = EPOLL_CTL_ADD
136 , controlOpModify = EPOLL_CTL_MOD
137 , controlOpDelete = EPOLL_CTL_DEL
140 newtype EventType = EventType {
141 unEventType :: Word32
142 } deriving (Show, Eq, Num, Bits)
144 #{enum EventType, EventType
146 , epollOut = EPOLLOUT
147 , epollErr = EPOLLERR
148 , epollHup = EPOLLHUP
151 -- | Create a new epoll context, returning a file descriptor associated with the context.
152 -- The fd may be used for subsequent calls to this epoll context.
154 -- The size parameter to epoll_create is a hint about the expected number of handles.
156 -- The file descriptor returned from epoll_create() should be destroyed via
157 -- a call to close() after polling is finished
159 epollCreate :: IO EPollFd
161 fd <- throwErrnoIfMinus1 "epollCreate" $
162 #if defined(HAVE_EPOLL_CREATE1)
163 c_epoll_create1 (#const EPOLL_CLOEXEC)
165 c_epoll_create 256 -- argument is ignored
168 let !epollFd' = EPollFd fd
171 epollControl :: EPollFd -> ControlOp -> Fd -> Ptr Event -> IO ()
172 epollControl (EPollFd epfd) (ControlOp op) (Fd fd) event =
173 throwErrnoIfMinus1_ "epollControl" $ c_epoll_ctl epfd op fd event
175 epollWait :: EPollFd -> Ptr Event -> Int -> Int -> IO Int
176 epollWait (EPollFd epfd) events numEvents timeout =
178 E.throwErrnoIfMinus1NoRetry "epollWait" $
179 c_epoll_wait epfd events (fromIntegral numEvents) (fromIntegral timeout)
181 fromEvent :: E.Event -> EventType
182 fromEvent e = remap E.evtRead epollIn .|.
183 remap E.evtWrite epollOut
185 | e `E.eventIs` evt = to
188 toEvent :: EventType -> E.Event
189 toEvent e = remap (epollIn .|. epollErr .|. epollHup) E.evtRead `mappend`
190 remap (epollOut .|. epollErr .|. epollHup) E.evtWrite
192 | e .&. evt /= 0 = to
195 fromTimeout :: Timeout -> Int
196 fromTimeout Forever = -1
197 fromTimeout (Timeout s) = ceiling $ 1000 * s
199 #if defined(HAVE_EPOLL_CREATE1)
200 foreign import ccall unsafe "sys/epoll.h epoll_create1"
201 c_epoll_create1 :: CInt -> IO CInt
203 foreign import ccall unsafe "sys/epoll.h epoll_create"
204 c_epoll_create :: CInt -> IO CInt
207 foreign import ccall unsafe "sys/epoll.h epoll_ctl"
208 c_epoll_ctl :: CInt -> CInt -> CInt -> Ptr Event -> IO CInt
210 foreign import ccall safe "sys/epoll.h epoll_wait"
211 c_epoll_wait :: CInt -> Ptr Event -> CInt -> CInt -> IO CInt
213 #endif /* defined(HAVE_EPOLL) */