socket 0.5.0.0 → 0.5.1.0
raw patch · 8 files changed
+72/−138 lines, 8 filesdep ~base
Dependency ranges changed: base
Files
- CHANGELOG.md +5/−0
- platform/linux/src/System/Socket/Internal/Platform.hsc +14/−4
- platform/win32/src/System/Socket/Internal/Platform.hsc +4/−4
- socket.cabal +6/−44
- src/System/Socket.hsc +4/−4
- src/System/Socket/Family/Inet6.hsc +3/−2
- src/System/Socket/Internal/Socket.hsc +16/−71
- src/System/Socket/Unsafe.hsc +20/−9
CHANGELOG.md view
@@ -1,3 +1,8 @@+0.5.1.0 Lars Petersen <info@lars-petersen.net> 2015-06-22++ * Exposed `unsafeGetSocketOption` and `unsafeSetSocketOption`.+ * Exposed `socketWaitRead` and `socketWaitWrite` through `System.Socket.Unsafe`.+ 0.5.0.0 Lars Petersen <info@lars-petersen.net> 2015-06-19 * Introduced newtypes `Port`, `FlowInfo` and `ScopeId` in Inet6 family.
platform/linux/src/System/Socket/Internal/Platform.hsc view
@@ -11,12 +11,22 @@ import System.Socket.Internal.Message import System.Socket.Internal.Exception -socketWaitWrite' :: Fd -> Int -> IO (IO ())-socketWaitWrite' fd _ = do+unsafeSocketWaitWrite :: Fd -> Int -> IO (IO ())+unsafeSocketWaitWrite fd _ = do threadWaitWriteSTM fd >>= return . atomically . fst -socketWaitRead' :: Fd -> Int -> IO (IO ())-socketWaitRead' fd _ = do+-- | Blocks until a socket should be tried for reading.+--+-- > safeSocketWaitRead = do+-- > wait <- withMVar msock $ \sock-> do+-- > -- Register while holding a lock on the socket descriptor.+-- > unsafeSocketWaitRead sock 0 +-- > -- Do the waiting without keeping the socket descriptor locked.+-- > wait+unsafeSocketWaitRead :: Fd -- ^ Socket descriptor+ -> Int -- ^ How many times has it been tried unsuccessfully so far? (currently only relevant on Windows)+ -> IO (IO ()) -- ^ The outer action registers the waiting, the inner does the actual wait.+unsafeSocketWaitRead fd _ = do threadWaitReadSTM fd >>= return . atomically . fst type CSSize
platform/win32/src/System/Socket/Internal/Platform.hsc view
@@ -13,12 +13,12 @@ import System.Socket.Internal.Message import System.Socket.Internal.Exception -socketWaitWrite' :: Fd -> Int -> IO (IO ())-socketWaitWrite' _ iteration = do+unsafeSocketWaitWrite :: Fd -> Int -> IO (IO ())+unsafeSocketWaitWrite _ iteration = do return (threadDelay $ 1 `shiftL` min iteration 20) -socketWaitRead' :: Fd -> Int -> IO (IO ())-socketWaitRead' _ iteration = do+unsafeSocketWaitRead :: Fd -> Int -> IO (IO ())+unsafeSocketWaitRead _ iteration = do return (threadDelay $ 1 `shiftL` min iteration 20) type CSSize
socket.cabal view
@@ -1,53 +1,15 @@ name: socket-version: 0.5.0.0+version: 0.5.1.0 synopsis: A portable and extensible sockets library. description:- /Motivation/- .- This library aims to expose a minimal and platform-independant interface for- POSIX compliant networking code.- .- /Implementation Philosophy/- .- - Every operation and every flag exposed should be supported with same- semantics on every platform. If this cannot be guaranteed it should- be supplied by another (extension) package.- Examples for things that have been ripped out of this library are:- Unix sockets, SCTP, vectored IO (for now).- .- - Absolutely no conditional exports.- .- - No `#ifdef` madness in the Haskell sources. The Haskell binding code- uses the FFI to reference the platform's native networking functions.- If they are not Posix compliant (i.e. on Windows) an level of- indirection is introduced to create an Posix compliant equivalent in C- using whatever the plaform specific building blocks are.- .- /Platform Support/- .- /Linux/: Working.- .- /BSD/: Unknown. Should work. Please report if not.- .- /OS X/: Unknown. Please report if you have a Mac.+ This library is a minimal and platform-independant interface for+ BSD style networking. .- /Windows/: Fully supported on Windows7 (maybe Vista) or higher :-)+ The following is a list of known extension packages: .- GHCs runtime system on Windows does not offer an event notification mechanism for sockets.- The original [network](https://hackage.haskell.org/package/network) library- suffers from this, too. For example, connection attempts are uninterruptible etc.- The approach taken to circumvent this in this library is to poll the- non-blocking sockets with increasing delay. This guarantees interruptability- and fairness between different threads. It allows for decent throughput- while also keeping CPU consumption on a moderate level if a socket has not seen- events for a longer period of time (maximum of 1 second delay after 20- polling iterations). The only drawback is potentially reduced response time- of your application. The good part: Heavy load (e.g. connection requests or- incoming traffic) will reduce this problem. Eventually your accepting thread- won't wait at all if there are several connection requests queued.+ - https://hackage.haskell.org/package/socket-sctp .- This workaround may be removed if someone is willing to sacrifice to improve- the IO manager on Windows.+ Also see README.md for details. license: MIT license-file: LICENSE
src/System/Socket.hsc view
@@ -287,7 +287,7 @@ -- The manpage says that in this case the connection -- shall be established asynchronously and one is -- supposed to wait.- wait <- socketWaitWrite' fd 0+ wait <- unsafeSocketWaitWrite fd 0 return (Just wait) else do throwIO e@@ -315,7 +315,7 @@ return Nothing else if e == eAlready then do -- The previous connection attempt is still pending.- Just <$> socketWaitWrite' fd iteration+ Just <$> unsafeSocketWaitWrite fd iteration else do -- The previous connection failed (results in EINPROGRESS or -- EWOULBLOCK here) or something else is wrong.@@ -325,7 +325,7 @@ else do -- This means the last connection attempt succeeded immediately. -- Linux does this when connecting to the same address when the- -- socketWaitWrite' call signals writeability.+ -- unsafeSocketWaitWrite call signals writeability. return Nothing case mwait' of Nothing -> do@@ -406,7 +406,7 @@ e <- c_get_last_socket_error if e == eWouldBlock || e == eAgain then do- socketWaitRead' fd iteration >>= return . Left+ unsafeSocketWaitRead fd iteration >>= return . Left else if e == eInterrupted -- On EINTR it is good practice to just retry. then retry
src/System/Socket/Family/Inet6.hsc view
@@ -26,6 +26,7 @@ import Control.Applicative import Foreign.Ptr+import Foreign.C.Types import Foreign.Storable import Foreign.Marshal.Utils @@ -182,8 +183,8 @@ instance GetSocketOption V6Only where getSocketOption s =- V6Only <$> getSocketOptionBool s (#const IPPROTO_IPV6) (#const IPV6_V6ONLY)+ V6Only . ((/=0) :: CInt -> Bool) <$> unsafeGetSocketOption s (#const IPPROTO_IPV6) (#const IPV6_V6ONLY) instance SetSocketOption V6Only where setSocketOption s (V6Only o) =- setSocketOptionBool s (#const IPPROTO_IPV6) (#const IPV6_V6ONLY) o+ unsafeSetSocketOption s (#const IPPROTO_IPV6) (#const IPV6_V6ONLY) (if o then 1 else 0 :: CInt)
src/System/Socket/Internal/Socket.hsc view
@@ -1,13 +1,9 @@ module System.Socket.Internal.Socket ( Socket (..) , GetSocketOption (..)- , getSocketOptionBool- , getSocketOptionInt- , getSocketOptionCInt+ , unsafeGetSocketOption , SetSocketOption (..)- , setSocketOptionBool- , setSocketOptionInt- , setSocketOptionCInt+ , unsafeSetSocketOption , Error (..) , ReuseAddress (..) ) where@@ -66,7 +62,7 @@ instance GetSocketOption Error where getSocketOption s =- Error . SocketException <$> getSocketOptionCInt s (#const SOL_SOCKET) (#const SO_ERROR)+ Error . SocketException <$> unsafeGetSocketOption s (#const SOL_SOCKET) (#const SO_ERROR) -- | @SO_REUSEADDR@ data ReuseAddress@@ -75,88 +71,37 @@ instance GetSocketOption ReuseAddress where getSocketOption s =- ReuseAddress <$> getSocketOptionBool s (#const SOL_SOCKET) (#const SO_REUSEADDR)+ ReuseAddress . ((/=0) :: CInt -> Bool) <$> unsafeGetSocketOption s (#const SOL_SOCKET) (#const SO_REUSEADDR) instance SetSocketOption ReuseAddress where setSocketOption s (ReuseAddress o) =- setSocketOptionBool s (#const SOL_SOCKET) (#const SO_REUSEADDR) o+ unsafeSetSocketOption s (#const SOL_SOCKET) (#const SO_REUSEADDR) (if o then 1 else 0 :: CInt) ------------------------------------------------------------------------------- -- Unsafe helpers ------------------------------------------------------------------------------- -setSocketOptionBool :: Socket f t p -> CInt -> CInt -> Bool -> IO ()-setSocketOptionBool (Socket mfd) level name value = do- withMVar mfd $ \fd->- alloca $ \vPtr-> do- if value- then poke vPtr 1- else poke vPtr 0- i <- c_setsockopt fd level name - (vPtr :: Ptr CInt)- (fromIntegral $ sizeOf (undefined :: CInt))- when (i < 0) $ do- c_get_last_socket_error >>= throwIO--getSocketOptionBool :: Socket f t p -> CInt -> CInt -> IO Bool-getSocketOptionBool (Socket mfd) level name = do- withMVar mfd $ \fd->- alloca $ \vPtr-> do- alloca $ \lPtr-> do- i <- c_getsockopt fd level name - (vPtr :: Ptr CInt)- (lPtr :: Ptr CInt)- if i < 0 then do- c_get_last_socket_error >>= throwIO- else do- v <- peek vPtr- return (v == 1)--setSocketOptionInt :: Socket f t p -> CInt -> CInt -> Int -> IO ()-setSocketOptionInt (Socket mfd) level name value = do- withMVar mfd $ \fd->- alloca $ \vPtr-> do- poke vPtr (fromIntegral value :: CInt)- i <- c_setsockopt fd level name - (vPtr :: Ptr CInt)- (fromIntegral $ sizeOf (undefined :: CInt))- when (i < 0) $ do- c_get_last_socket_error >>= throwIO--getSocketOptionInt :: Socket f t p -> CInt -> CInt -> IO Int-getSocketOptionInt (Socket mfd) level name = do- withMVar mfd $ \fd->- alloca $ \vPtr-> do- alloca $ \lPtr-> do- i <- c_getsockopt fd level name- (vPtr :: Ptr CInt)- (lPtr :: Ptr CInt)- if i < 0 then do- c_get_last_socket_error >>= throwIO- else do- v <- peek vPtr- return (fromIntegral v)--setSocketOptionCInt :: Socket f t p -> CInt -> CInt -> CInt -> IO ()-setSocketOptionCInt (Socket mfd) level name value = do+unsafeSetSocketOption :: Storable a => Socket f t p -> CInt -> CInt -> a -> IO ()+unsafeSetSocketOption (Socket mfd) level name value = do withMVar mfd $ \fd-> alloca $ \vPtr-> do poke vPtr value i <- c_setsockopt fd level name - (vPtr :: Ptr CInt)- (fromIntegral $ sizeOf (undefined :: CInt))+ vPtr+ (fromIntegral $ sizeOf value) when (i < 0) $ do c_get_last_socket_error >>= throwIO -getSocketOptionCInt :: Socket f t p -> CInt -> CInt -> IO CInt-getSocketOptionCInt (Socket mfd) level name = do+unsafeGetSocketOption :: Storable a => Socket f t p -> CInt -> CInt -> IO a+unsafeGetSocketOption (Socket mfd) level name = do+ u <- return undefined withMVar mfd $ \fd-> alloca $ \vPtr-> do alloca $ \lPtr-> do- i <- c_getsockopt fd level name- (vPtr :: Ptr CInt)- (lPtr :: Ptr CInt)+ poke lPtr (fromIntegral $ sizeOf u)+ i <- c_getsockopt fd level name vPtr (lPtr :: Ptr CInt) if i < 0 then do c_get_last_socket_error >>= throwIO else do- peek vPtr+ x <- peek vPtr+ return (x `asTypeOf` u)
src/System/Socket/Unsafe.hsc view
@@ -1,14 +1,25 @@ module System.Socket.Unsafe (- -- * tryWaitAndRetry- tryWaitAndRetry -- * unsafeSend- , unsafeSend+ unsafeSend -- * unsafeSendTo , unsafeSendTo -- * unsafeReceive , unsafeReceive -- * unsafeReceiveFrom , unsafeReceiveFrom+ -- * Socket Options+ -- ** unsafeGetSocketOption+ , unsafeGetSocketOption+ -- ** unsafeSetSocketOption+ , unsafeSetSocketOption+ -- * Waiting For Events+ -- ** unsafeSocketWaitRead+ , unsafeSocketWaitRead+ -- ** unsafeSocketWaitWrite+ , unsafeSocketWaitWrite+ -- * Other Helpers+ -- ** tryWaitRetryLoop+ , tryWaitRetryLoop ) where import Data.Function@@ -33,22 +44,22 @@ unsafeSend :: Socket a t p -> Ptr a -> CSize -> MessageFlags -> IO CInt unsafeSend s bufPtr bufSize flags = do- tryWaitAndRetry s socketWaitWrite' (\fd-> c_send fd bufPtr bufSize (flags `mappend` msgNoSignal) )+ tryWaitRetryLoop s unsafeSocketWaitWrite (\fd-> c_send fd bufPtr bufSize (flags `mappend` msgNoSignal) ) unsafeSendTo :: Socket f t p -> Ptr b -> CSize -> MessageFlags -> Ptr (SocketAddress f) -> CInt -> IO CInt unsafeSendTo s bufPtr bufSize flags addrPtr addrSize = do- tryWaitAndRetry s socketWaitWrite' (\fd-> c_sendto fd bufPtr (fromIntegral bufSize) (flags `mappend` msgNoSignal) addrPtr addrSize)+ tryWaitRetryLoop s unsafeSocketWaitWrite (\fd-> c_sendto fd bufPtr (fromIntegral bufSize) (flags `mappend` msgNoSignal) addrPtr addrSize) unsafeReceive :: Socket a t p -> Ptr b -> CSize -> MessageFlags -> IO CInt unsafeReceive s bufPtr bufSize flags =- tryWaitAndRetry s socketWaitRead' (\fd-> c_recv fd bufPtr bufSize flags)+ tryWaitRetryLoop s unsafeSocketWaitRead (\fd-> c_recv fd bufPtr bufSize flags) unsafeReceiveFrom :: Socket f t p -> Ptr b -> CSize -> MessageFlags -> Ptr (SocketAddress f) -> Ptr CInt -> IO CInt unsafeReceiveFrom s bufPtr bufSize flags addrPtr addrSizePtr = do- tryWaitAndRetry s socketWaitRead' (\fd-> c_recvfrom fd bufPtr bufSize flags addrPtr addrSizePtr)+ tryWaitRetryLoop s unsafeSocketWaitRead (\fd-> c_recvfrom fd bufPtr bufSize flags addrPtr addrSizePtr) -tryWaitAndRetry :: Socket f t p -> (Fd -> Int-> IO (IO ())) -> (Fd -> IO CInt) -> IO CInt-tryWaitAndRetry (Socket mfd) getWaitAction action = loop 0+tryWaitRetryLoop :: Socket f t p -> (Fd -> Int-> IO (IO ())) -> (Fd -> IO CInt) -> IO CInt+tryWaitRetryLoop (Socket mfd) getWaitAction action = loop 0 where loop iteration = do ewr <- withMVar mfd $ \fd-> do