posix-socket 0.1 → 0.2
raw patch · 2 files changed
+154/−84 lines, 2 files
Files
- posix-socket.cabal +1/−1
- src/System/Posix/Socket.hsc +153/−83
posix-socket.cabal view
@@ -1,5 +1,5 @@ Name: posix-socket-Version: 0.1+Version: 0.2 Category: System Stability: experimental Synopsis: Bindings to the POSIX socket API
src/System/Posix/Socket.hsc view
@@ -10,35 +10,38 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE PatternSynonyms #-} -- | POSIX sockets. module System.Posix.Socket- ( Socket+ (+ -- * Socket types+ Socket , withSocketFd , unsafeSocketFd , unsafeSocketFromFd , SockFamily(..) , SockAddr(..) , SockType(..)- , streamSockType- , datagramSockType- , rawSockType- , seqPacketSockType+ , pattern SOCK_STREAM+ , pattern SOCK_DGRAM+ , pattern SOCK_RAW+ , pattern SOCK_RDM+ , pattern SOCK_SEQPACKET , SockProto(..) , defaultSockProto , SockOpt(..) , SO_ERROR(..) , SO_KEEPALIVE(..) , SO_REUSEADDR(..)- , SockOps- , sendSockOp- , recvSockOp- , MsgFlags- , peekMsgFlag- , truncMsgFlag- , oobMsgFlag- , dontRouteMsgFlag-+ , SockOps(..)+ , MsgFlags(..)+ , pattern MSG_PEEK+ , pattern MSG_TRUNC+ , pattern MSG_OOB+ , pattern MSG_DONTROUTE+ -- * Socket operations+ -- ** Creating and connecting , socket , getSockOpt , setSockOpt@@ -47,8 +50,10 @@ , tryConnect , listen , accept+ , tryAccept , getLocalAddr , getRemoteAddr+ -- ** Receiving messages , hasOobData , recvBufs , recvBuf@@ -58,6 +63,7 @@ , recvBufFrom , recvFrom' , recvFrom+ -- ** Sending messages , sendBufs , sendMany' , sendMany@@ -70,6 +76,7 @@ , sendBufTo , sendTo' , sendTo+ -- ** Closing , shutdown , close ) where@@ -83,8 +90,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Internal as BS import qualified Data.ByteString.Unsafe as BS-import Data.Flags (Flags(..), (.>=.))-import Data.Flags.TH (bitmaskWrapper)+import Data.Flags (Flags(..), BoundedFlags(..), (.>=.)) import Data.Foldable (forM_) import Control.Applicative ((<$>)) import Control.Monad (void, when, foldM)@@ -141,10 +147,12 @@ -- | Get the underlying file descriptor. unsafeSocketFd ∷ MonadBase IO μ ⇒ Socket f → μ Fd unsafeSocketFd (Socket v) = liftBase $ readMVar v+{-# INLINE unsafeSocketFd #-} -- | Use file descriptor as a socket. unsafeSocketFromFd ∷ MonadBase IO μ ⇒ Fd → μ (Socket f) unsafeSocketFromFd = liftBase . fmap Socket . newMVar+{-# INLINE unsafeSocketFromFd #-} -- | Socket address. class SockAddr a where@@ -170,22 +178,26 @@ -- | Socket type. newtype SockType = SockType CInt deriving (Typeable, Eq, Ord, Show, Storable) --- | See /SOCK_STREAM/.-streamSockType ∷ SockType-streamSockType = SockType #const SOCK_STREAM+-- | See /socket(2)/.+pattern SOCK_STREAM ∷ SockType+pattern SOCK_STREAM = SockType #const SOCK_STREAM --- | See /SOCK_DGRAM/.-datagramSockType ∷ SockType-datagramSockType = SockType #const SOCK_DGRAM+-- | See /socket(2)/.+pattern SOCK_DGRAM ∷ SockType+pattern SOCK_DGRAM = SockType #const SOCK_DGRAM --- | See /SOCK_RAW/.-rawSockType ∷ SockType-rawSockType = SockType #const SOCK_RAW+-- | See /socket(2)/.+pattern SOCK_RAW ∷ SockType+pattern SOCK_RAW = SockType #const SOCK_RAW --- | See /SOCK_SEQPACKET/.-seqPacketSockType ∷ SockType-seqPacketSockType = SockType #const SOCK_SEQPACKET+-- | See /socket(2)/.+pattern SOCK_RDM ∷ SockType+pattern SOCK_RDM = SockType #const SOCK_RDM +-- | See /socket(2)/.+pattern SOCK_SEQPACKET ∷ SockType+pattern SOCK_SEQPACKET = SockType #const SOCK_SEQPACKET+ -- | Socket protocol. newtype SockProto = SockProto CInt deriving (Typeable, Eq, Ord, Show, Storable) @@ -253,29 +265,49 @@ sockOptLevel _ = #const SOL_SOCKET sockOptCode _ = #const SO_REUSEADDR --- | Socket operations. Used by 'shutdown'.-$(bitmaskWrapper "SockOps" ''Int []- [("sendSockOp", 1),- ("recvSockOp", 2)])+-- | Socket operations.+data SockOps = NoSockOps+ | RecvSockOps+ | SendSockOps+ | AllSockOps+ deriving (Typeable, Show, Read, Eq) +instance Flags SockOps where+ noFlags = NoSockOps+ andFlags NoSockOps ops = ops+ andFlags ops NoSockOps = ops+ andFlags ops1 ops2 | ops1 == ops2 = ops1+ andFlags _ _ = AllSockOps+ butFlags _ AllSockOps = NoSockOps+ butFlags ops1 ops2 | ops1 == ops2 = NoSockOps+ butFlags ops _ = ops+ commonFlags AllSockOps ops = ops+ commonFlags ops AllSockOps = ops+ commonFlags ops1 ops2 | ops1 == ops2 = ops1+ commonFlags _ _ = NoSockOps++instance BoundedFlags SockOps where+ allFlags = AllSockOps+ enumFlags f = filter (f .>=.) [RecvSockOps, SendSockOps]+ -- | Message flags. newtype MsgFlags = MsgFlags CInt deriving (Typeable, Eq, Show, Storable, Flags) --- | See /MSG_PEEK/.-peekMsgFlag ∷ MsgFlags-peekMsgFlag = MsgFlags #const MSG_PEEK+-- | See /recvmsg(2)/ and /sendmsg(2)/.+pattern MSG_PEEK ∷ MsgFlags+pattern MSG_PEEK = MsgFlags #const MSG_PEEK --- | See /MSG_TRUNC/.-truncMsgFlag ∷ MsgFlags-truncMsgFlag = MsgFlags #const MSG_TRUNC+-- | See /recvmsg(2)/ and /sendmsg(2)/.+pattern MSG_TRUNC ∷ MsgFlags+pattern MSG_TRUNC = MsgFlags #const MSG_TRUNC --- | See /MSG_OOB/.-oobMsgFlag ∷ MsgFlags-oobMsgFlag = MsgFlags #const MSG_OOB+-- | See /recvmsg(2)/ and /sendmsg(2)/.+pattern MSG_OOB ∷ MsgFlags+pattern MSG_OOB = MsgFlags #const MSG_OOB --- | See /MSG_DONTROUTE/.-dontRouteMsgFlag ∷ MsgFlags-dontRouteMsgFlag = MsgFlags #const MSG_DONTROUTE+-- | See /recvmsg(2)/ and /sendmsg(2)/.+pattern MSG_DONTROUTE ∷ MsgFlags+pattern MSG_DONTROUTE = MsgFlags #const MSG_DONTROUTE allocaMaxAddr ∷ SockAddr a ⇒ Proxy a → (Ptr a → #{itype socklen_t} → IO α) → IO α allocaMaxAddr addrProxy f =@@ -312,8 +344,8 @@ where famCode ∷ #{itype sa_family_t} famCode = fromIntegral $ sockFamilyCode fam --- | Create a socket. See /socket(3)/.--- The underlying file descriptor is non-blocking.+-- | Create a socket. The underlying file descriptor is non-blocking. All+-- blocking operations are done via the GHC event manager. See /socket(2)/. socket ∷ (SockFamily f, MonadBase IO μ) ⇒ f → SockType → SockProto → μ (Socket f) socket f (SockType t) p = liftBase $ do@@ -336,12 +368,12 @@ c_getsockopt fd (sockOptLevel o) (sockOptCode o) p pSize sockOptValue o <$> peek p --- | Get socket option value. See /getsockopt(3)/.+-- | Get socket option value. See /getsockopt(2)/. getSockOpt ∷ (SockOpt o, SockOptReadable o ~ 'True, MonadBase IO μ) ⇒ Socket f → o → μ (SockOptValue o) getSockOpt s o = withSocketFd s $ \fd → getFdOpt fd o --- | Set socket option value. See /setsockopt(3)/.+-- | Set socket option value. See /setsockopt(2)/. setSockOpt ∷ (SockOpt o, SockOptWritable o ~ 'True, MonadBase IO μ) ⇒ Socket f → o → SockOptValue o → μ () setSockOpt s o v = withSocketFd s $ \fd →@@ -351,15 +383,15 @@ fromIntegral (sizeOf raw) where raw = sockOptRaw o v --- | Bind socket to the specified address. See /bind(3)/.+-- | Bind socket to the specified address. See /bind(2)/. bind ∷ ∀ f μ . (SockFamily f, MonadBase IO μ) ⇒ Socket f → SockFamilyAddr f → μ () bind s addr = withSocketFd s $ \fd → withAddr (undefined ∷ f) addr $ \p size → throwErrnoIfMinus1_ "bind" $ c_bind fd p $ fromIntegral size --- | Connect socket to the specified address. This function blocks.--- See /connect(3)/.+-- | Connect socket to the specified address. This operation blocks.+-- See /connect(2)/. connect ∷ ∀ f μ . (SockFamily f, MonadBase IO μ) ⇒ Socket f → SockFamilyAddr f → μ () connect s addr = withSocketFd s $ \fd →@@ -381,7 +413,7 @@ -- | Try to connect socket without blocking. On success 'True' is returned. -- If the connection did not succeed immediately, 'False' is returned.--- See /connect(3)/.+-- See /connect(2)/. tryConnect ∷ ∀ f μ . (SockFamily f, MonadBase IO μ) ⇒ Socket f → SockFamilyAddr f → μ Bool tryConnect s addr = withSocketFd s $ \fd →@@ -401,7 +433,7 @@ listen s backlog = withSocketFd s $ \fd → throwErrnoIfMinus1_ "listen" $ c_listen fd $ fromIntegral backlog --- | Accept a connection on the given socket. This function blocks.+-- | Accept a connection on the given socket. This operation blocks. -- See /accept(2)/. accept ∷ ∀ f μ . (SockFamily f, MonadBase IO μ) ⇒ Socket f → μ (Socket f, SockFamilyAddr f)@@ -422,12 +454,38 @@ _ → throwErrno "accept" else do addr ← peekAddrOfSize (undefined ∷ f) p pSize+ let accFd = Fd cfd #ifndef HAVE_ACCEPT_WITH_FLAGS- setNonBlockingFD cfd True+ onException (setNonBlockingFD accFd True) (closeFd accFd) #endif- (, addr) <$> unsafeSocketFromFd (Fd cfd)+ (, addr) <$> unsafeSocketFromFd accFd --- | Get the local address. See /getsockname(3)/.+-- | Try to accept a connection on the given socket without blocking.+-- On success the accepted socket and the peer address are returned.+-- See /accept(2)/.+tryAccept ∷ ∀ f μ . (SockFamily f, MonadBase IO μ)+ ⇒ Socket f → μ (Maybe (Socket f, SockFamilyAddr f))+tryAccept s = withSocketFd s $ \fd →+ allocaMaxAddr (Proxy ∷ Proxy (SockFamilyAddr f)) $ \p size →+ with size $ \pSize → do+ cfd ← c_accept fd p pSize+#ifdef HAVE_ACCEPT_WITH_FLAGS+ #{const SOCK_NONBLOCK}+#endif+ if cfd == -1 then do+ errno ← getErrno+ case errno of+ e | e == eAGAIN || e == eWOULDBLOCK → return Nothing+ _ → throwErrno "accept"+ else do+ addr ← peekAddrOfSize (undefined ∷ f) p pSize+ let accFd = Fd cfd+#ifndef HAVE_ACCEPT_WITH_FLAGS+ onException (setNonBlockingFD accFd True) (closeFd accFd)+#endif+ Just . (, addr) <$> unsafeSocketFromFd accFd++-- | Get the local address. See /getsockname(2)/. getLocalAddr ∷ ∀ f μ . (SockFamily f, MonadBase IO μ) ⇒ Socket f → μ (SockFamilyAddr f) getLocalAddr s = withSocketFd s $ \fd →@@ -436,7 +494,7 @@ throwErrnoIfMinus1_ "getLocalAddr" $ c_getsockname fd p pSize peekAddrOfSize (undefined ∷ f) p pSize --- | Get the remote address. See /getpeername(3)/.+-- | Get the remote address. See /getpeername(2)/. getRemoteAddr ∷ ∀ f μ . (SockFamily f, MonadBase IO μ) ⇒ Socket f → μ (SockFamilyAddr f) getRemoteAddr s = withSocketFd s $ \fd →@@ -510,7 +568,7 @@ recvBufsFromFd (undefined ∷ f) fd bufs flags -- | Receive a message from a connected socket, possibly utilizing multiple--- memory buffers. See /recvmsg(3)/.+-- memory buffers. See /recvmsg(2)/. recvBufs ∷ (SockFamily f, MonadBase IO μ) ⇒ Socket f -- ^ The socket → [(Ptr Word8, Int)] -- ^ Memory buffers@@ -520,7 +578,8 @@ (_, r, flags') ← recvBufsFrom' s bufs flags return (r, flags') --- | Receive a message from a connected socket. See /recvmsg(3)/.+-- | Receive a message from a connected socket. This operation blocks.+-- See /recvmsg(2)/. recvBuf ∷ (SockFamily f, MonadBase IO μ) ⇒ Socket f -- ^ The socket → Ptr α -- ^ Buffer pointer@@ -529,7 +588,8 @@ → μ (Int, MsgFlags) -- ^ Received message length and flags recvBuf s p len flags = recvBufs s [(castPtr p, len)] flags --- | Receive a message from a connected socket. See /recvmsg(3)/.+-- | Receive a message from a connected socket. This operation blocks.+-- See /recvmsg(2)/. recv' ∷ (SockFamily f, MonadBase IO μ) ⇒ Socket f -- ^ The socket → Int -- ^ Maximum message length@@ -540,7 +600,8 @@ (r, flags') ← recvBuf s p len flags return (0, r, flags') --- | Receive a message from a connected socket. See /recvmsg(3)/.+-- | Receive a message from a connected socket. This operation blocks.+-- See /recvmsg(2)/. recv ∷ (SockFamily f, MonadBase IO μ) ⇒ Socket f -- ^ The socket → Int -- ^ Maximum message length@@ -548,7 +609,7 @@ recv s len = fst <$> recv' s len noFlags -- | Receive a message from an unconnected socket, possibly utilizing multiple--- memory buffers. See /recvmsg(3)/.+-- memory buffers. This operation blocks. See /recvmsg(2)/. recvBufsFrom ∷ ∀ f μ . (SockFamily f, MonadBase IO μ) ⇒ Socket f -- ^ The socket → [(Ptr Word8, Int)] -- ^ Memory buffers@@ -564,7 +625,8 @@ peekAddrOfSize (undefined ∷ f) p pSize (, n, flags') <$> maybe getpeername return mAddr --- | Receive a message from an unconnected socket. See /recvmsg(3)/.+-- | Receive a message from an unconnected socket. This operation blocks.+-- See /recvmsg(2)/. recvBufFrom ∷ (SockFamily f, MonadBase IO μ) ⇒ Socket f -- ^ The socket → Ptr α -- ^ Buffer pointer@@ -574,7 +636,8 @@ -- ^ Received message source address, length, and flags recvBufFrom s p len flags = recvBufsFrom s [(castPtr p, len)] flags --- | Receive a message from an unconnected socket. See /recvmsg(3)/.+-- | Receive a message from an unconnected socket. This operation blocks.+-- See /recvmsg(2)/. recvFrom' ∷ (SockFamily f, MonadBase IO μ) ⇒ Socket f -- ^ The socket → Int -- ^ Maximum message length@@ -587,7 +650,8 @@ return (0, len', (addr, flags')) return (addr, bs, flags') --- | Receive a message from an unconnected socket. See /recvmsg(3)/.+-- | Receive a message from an unconnected socket. This operation blocks.+-- See /recvmsg(2)/. recvFrom ∷ (SockFamily f, MonadBase IO μ) ⇒ Socket f -- ^ The socket → Int -- ^ Maximum message length@@ -643,12 +707,12 @@ cont -- | Send a message split into several memory buffers on a connected socket.--- See /sendmsg(3)/.+-- This operation blocks. See /sendmsg(2)/. sendBufs ∷ (SockFamily f, MonadBase IO μ) ⇒ Socket f -- ^ The socket → [(Ptr Word8, Int)] -- ^ Memory buffers → MsgFlags -- ^ Message flags- → μ Int -- ^ The number of bytes sent + → μ Int -- ^ The number of bytes sent sendBufs s bufs flags = _sendBufs s bufs flags Nothing withBufs ∷ [ByteString] → ([(Ptr Word8, Int)] → IO α) → IO α@@ -658,7 +722,7 @@ go bss' ((castPtr p, len) : rbufs) -- | Send a message split into several 'ByteString's on a connected socket.--- See /sendmsg(3)/.+-- This operation blocks. See /sendmsg(2)/. sendMany' ∷ (SockFamily f, MonadBase IO μ) ⇒ Socket f -- ^ The socket → [ByteString] -- ^ Message contents@@ -668,14 +732,15 @@ liftBase $ withBufs bss $ \bufs → sendBufs s bufs flags -- | Send a message split into several 'ByteString's on a connected socket.--- See /sendmsg(3)/.+-- This operation blocks. See /sendmsg(2)/. sendMany ∷ (SockFamily f, MonadBase IO μ) ⇒ Socket f -- ^ The socket → [ByteString] -- ^ Message contents → μ Int -- ^ The number of bytes sent sendMany s bss = sendMany' s bss noFlags --- | Send a message on a connected socket. See /sendmsg(3)/.+-- | Send a message on a connected socket. This operation blocks.+-- See /sendmsg(2)/. sendBuf ∷ (SockFamily f, MonadBase IO μ) ⇒ Socket f -- ^ The socket → Ptr α -- ^ Buffer pointer@@ -684,7 +749,8 @@ → μ Int -- ^ The number of bytes sent sendBuf s p len flags = sendBufs s [(castPtr p, len)] flags --- | Send a message on a connected socket. See /sendmsg(3)/.+-- | Send a message on a connected socket. This operation blocks.+-- See /sendmsg(2)/. send' ∷ (SockFamily f, MonadBase IO μ) ⇒ Socket f -- ^ The socket → ByteString -- ^ Message contents@@ -693,7 +759,8 @@ send' s bs flags = liftBase $ BS.unsafeUseAsCStringLen bs $ \(p, len) → sendBuf s p len flags --- | Send a message on a connected socket. See /sendmsg(3)/.+-- | Send a message on a connected socket. This operation blocks.+-- See /sendmsg(2)/. send ∷ (SockFamily f, MonadBase IO μ) ⇒ Socket f -- ^ The socket → ByteString -- ^ Message contents@@ -701,7 +768,7 @@ send s bs = send' s bs noFlags -- | Send a message split into several memory buffers on an unconnected--- socket. See /sendmsg(3)/.+-- socket. This operation blocks. See /sendmsg(2)/. sendBufsTo ∷ (SockFamily f, MonadBase IO μ) ⇒ Socket f -- ^ The socket → [(Ptr Word8, Int)] -- ^ Memory buffers@@ -711,7 +778,7 @@ sendBufsTo s bufs flags addr = _sendBufs s bufs flags (Just addr) -- | Send a message split into several 'ByteString's on an unconnected socket.--- See /sendmsg(3)/.+-- This operation blocks. See /sendmsg(2)/. sendManyTo' ∷ (SockFamily f, MonadBase IO μ) ⇒ Socket f -- ^ The socket → [ByteString] -- ^ Message contents@@ -722,7 +789,7 @@ sendBufsTo s bufs flags addr -- | Send a message split into several 'ByteString's on an unconnected socket.--- See /sendmsg(3)/.+-- This operation blocks. See /sendmsg(2)/. sendManyTo ∷ (SockFamily f, MonadBase IO μ) ⇒ Socket f -- ^ The socket → [ByteString] -- ^ Message contents@@ -730,7 +797,8 @@ → μ Int -- ^ The number of bytes sent sendManyTo s bss addr = sendManyTo' s bss noFlags addr --- | Send a message on an unconnected socket. See /sendmsg(3)/.+-- | Send a message on an unconnected socket. This operation blocks.+-- See /sendmsg(2)/. sendBufTo ∷ (SockFamily f, MonadBase IO μ) ⇒ Socket f -- ^ The socket → Ptr α -- ^ Buffer pointer@@ -740,7 +808,8 @@ → μ Int -- ^ The number of bytes sent sendBufTo s p len flags addr = sendBufsTo s [(castPtr p, len)] flags addr --- | Send a message on an unconnected socket. See /sendmsg(3)/.+-- | Send a message on an unconnected socket. This operation blocks.+-- See /sendmsg(2)/. sendTo' ∷ (SockFamily f, MonadBase IO μ) ⇒ Socket f -- ^ The socket → ByteString -- ^ Message contents@@ -751,7 +820,8 @@ liftBase $ BS.unsafeUseAsCStringLen bs $ \(p, len) → sendBufTo s p len flags addr --- | Send a message on an unconnected socket. See /sendmsg(3)/.+-- | Send a message on an unconnected socket. This operation blocks.+-- See /sendmsg(2)/. sendTo ∷ (SockFamily f, MonadBase IO μ) ⇒ Socket f -- ^ The socket → ByteString -- ^ Message contents@@ -759,22 +829,22 @@ → μ Int -- ^ The number of bytes sent sendTo s bs addr = sendTo' s bs noFlags addr --- | Shut down a part of a full-duplex connection. See /shutdown(3)/.+-- | Shut down a part of a full-duplex connection. See /shutdown(2)/. shutdown ∷ MonadBase IO μ ⇒ Socket f → SockOps → μ () shutdown s dirs = withSocketFd s $ \fd → forM_ how $ throwErrnoIfMinus1_ "shutdown" . c_shutdown fd- where how = if dirs .>=. sendSockOp then- if dirs .>=. recvSockOp then+ where how = if dirs .>=. SendSockOps then+ if dirs .>=. RecvSockOps then Just #{const SHUT_RDWR} else Just #{const SHUT_WR} else- if dirs .>=. recvSockOp then+ if dirs .>=. RecvSockOps then Just #{const SHUT_RD} else Nothing --- | Close the socket. See /close(3)/.+-- | Close the socket. See /close(2)/. close ∷ MonadBase IO μ ⇒ Socket f → μ () close (Socket v) = liftBase $ modifyMVar_ v $ \fd → do when (fd >= 0) $ closeFdWith closeFd fd