network-udp (empty) → 0.0.0
raw patch · 5 files changed
+384/−0 lines, 5 filesdep +basedep +bytestringdep +containers
Dependencies added: base, bytestring, containers, iproute, network
Files
- LICENSE +29/−0
- Network/UDP.hs +263/−0
- Network/UDP/Recv.hs +44/−0
- Network/UDP/Types.hs +14/−0
- network-udp.cabal +34/−0
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2022, Internet Initiative Japan Inc.+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 the copyright holders nor the names of its+ 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.
+ Network/UDP.hs view
@@ -0,0 +1,263 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Best current practice library for UDP clients and servers.+--+-- * Efficient receiving function without memory copy+-- * Proper buffer size+-- * Type-safe APIs+-- * TCP-like APIs (creating a UDP connection from a listing socket) in the server side+-- * Auto migration (network interface selection) in the client side+--+-- The 'Network.Socket.ByteString.recv' family in+-- "Network.Socket.ByteString" uses 'createAndTrim'+-- internaly. So, one buffer is allocated before corresponding+-- system calls are called. Then another buffer is allocated+-- according to the input size and the input is copied.+-- Receiving functions provided by this library uses 'createUptoN'+-- to avoid the memory copy.+--+-- Recent application protocols are designed to avoid IP+-- fragmentation. So, the UDP payload size is never over 1,500.+-- This library uses 2,048 for the buffer size. This size ensures+-- no global locking when allocating 'ByteString' (i.e. a buffer).+--+-- To know the background of TCP-like API in the server side, see:+--+-- * https://kazu-yamamoto.hatenablog.jp/entry/2022/02/25/153122+--+-- To know the background of auto migration in the client side, see:+--+-- * https://kazu-yamamoto.hatenablog.jp/entry/2021/06/29/134930+-- * https://www.iij.ad.jp/en/dev/iir/pdf/iir_vol52_focus2_EN.pdf (Sec 3.9)+module Network.UDP (+ -- * Sockets used by clients and servers after accept+ UDPSocket(..)+ , clientSocket+ , recv+ , recvBuf+ , send+ , sendBuf+ -- * Server's wildcard socket+ , ListenSocket(..)+ , serverSocket+ , ClientSockAddr(..)+ , recvFrom+ , sendTo+ -- * Server's connected socket+ , accept+ -- * Closing+ , stop+ , close+ -- * Misc+ , natRebinding+ ) where++import Control.Concurrent+import qualified Control.Exception as E+import Control.Monad+import Data.ByteString (ByteString)+import Data.IP hiding (addr)+import Data.Maybe (fromJust)+import Data.Word (Word8)+import Foreign.Ptr (Ptr)+import qualified GHC.IO.Exception as E+import qualified Network.Socket as NS+import Network.Socket hiding (accept, close, sendBuf, recvBuf)+import qualified Network.Socket.ByteString as NSB+import qualified System.IO.Error as E++import Network.UDP.Types+import qualified Network.UDP.Recv as R++----------------------------------------------------------------++anySockAddr :: SockAddr -> SockAddr+anySockAddr (SockAddrInet p _) = SockAddrInet p 0+anySockAddr (SockAddrInet6 p f _ s) = SockAddrInet6 p f (0,0,0,0) s+anySockAddr _ = error "anySockAddr"++isAnySockAddr :: SockAddr -> Bool+isAnySockAddr (SockAddrInet _ 0) = True+isAnySockAddr (SockAddrInet6 _ _ (0,0,0,0) _) = True+isAnySockAddr _ = False++----------------------------------------------------------------++-- | A listening socket for UDP which can be used+-- for 'recvFrom' and 'sendTo'.+-- Optionally, a connected UDP socket can be created+-- with 'accept' as an emulation of TCP.+data ListenSocket = ListenSocket {+ listenSocket :: Socket+ , mySockAddr :: SockAddr+ , wildcard :: Bool -- ^ 'True' for wildcard. 'False' for interface-specific.+ } deriving (Eq, Show)++-- | A UDP socket which are used with 'recv' and 'send'.+data UDPSocket = UDPSocket {+ udpSocket :: Socket+ , peerSockAddr :: SockAddr -- ^ Used for a unconnected socket naturally. Used for a connected sockdet for checking+ , connected :: Bool+ } deriving (Eq, Show)++-- | A client socket address from the server point of view.+data ClientSockAddr = ClientSockAddr SockAddr [Cmsg] deriving (Eq, Show)++----------------------------------------------------------------++-- | Creating a listening UDP socket.+serverSocket :: (IP, PortNumber) -> IO ListenSocket+serverSocket ip = E.bracketOnError open NS.close $ \s -> do+ setSocketOption s ReuseAddr 1+ withFdSocket s setCloseOnExecIfNeeded+#if !defined(openbsd_HOST_OS)+ when (family == AF_INET6) $ setSocketOption s IPv6Only 1+#endif+ bind s sa+ let wild = isAnySockAddr sa+ when wild $ do+ let opt = decideOption sa+ setSocketOption s opt 1+ return $ ListenSocket s sa wild+ where+ sa = toSockAddr ip+ family = sockAddrFamily sa+ open = socket family Datagram defaultProtocol++----------------------------------------------------------------++-- | Receiving data with a listening UDP socket.+-- For a wildcard socket, recvmsg() is called.+-- For an interface specific socket, recvfrom() is called.+recvFrom :: ListenSocket -> IO (ByteString, ClientSockAddr)+recvFrom ListenSocket{..}+ | wildcard = do+ (bs,sa,cmsg,_) <- R.recvMsg listenSocket properUDPSize properCMSGSize 0+ return (bs, ClientSockAddr sa cmsg)+ | otherwise = do+ (bs,sa) <- R.recvFrom listenSocket properUDPSize+ return (bs, ClientSockAddr sa [])++-- | Sending data with a listening UDP socket.+-- For a wildcard socket, sendmsg() is called.+-- For an interface specific socket, sento() is called.+sendTo :: ListenSocket -> ByteString -> ClientSockAddr -> IO ()+sendTo ListenSocket{..} bs (ClientSockAddr sa cmsgs)+ | wildcard = void $ NSB.sendMsg listenSocket sa [bs] cmsgs 0+ | otherwise = void $ NSB.sendTo listenSocket bs sa++----------------------------------------------------------------++-- | Creating a connected UDP socket like TCP's accept().+accept :: ListenSocket -> ClientSockAddr -> IO UDPSocket+accept ListenSocket{..} (ClientSockAddr peersa cmsgs) = E.bracketOnError open NS.close $ \s -> do+ setSocketOption s ReuseAddr 1+ withFdSocket s setCloseOnExecIfNeeded+ let mysa' | wildcard = getMySockAddr mySockAddr cmsgs+ | otherwise = anySockAddr mySockAddr+ -- wildcard: (UDP, *.443, *:*) -> (UDP, 127.0.0.1:443, *:*)+ -- otherwise: (UDP, 127.0.0.1:443, *:*) -> (UDP, *:443, *:*)+ bind s mysa'+ -- bind and connect is not atomic+ -- So, bind may results in EADDRINUSE+ `E.catch` postphone (bind s mysa')+ connect s peersa -- (UDP, 127.0.0.1:443, pa:pp)+ return $ UDPSocket s peersa True+ where+ postphone action e+ | E.ioeGetErrorType e == E.ResourceBusy = threadDelay 10000 >> action+ | otherwise = E.throwIO e+ family = sockAddrFamily mySockAddr+ open = socket family Datagram defaultProtocol++----------------------------------------------------------------++-- | Creating a unconnected UDP socket.+clientSocket :: HostName -> ServiceName -> Bool -> IO UDPSocket+clientSocket host port conn = do+ addr <- head <$> NS.getAddrInfo (Just hints) (Just host) (Just port)+ E.bracketOnError (NS.openSocket addr) NS.close $ \s -> do+ let sa = addrAddress addr+ when conn $ NS.connect s sa+ return $ UDPSocket s sa conn+ where+ hints = NS.defaultHints { addrSocketType = Datagram }++-- | Sending data with a UDP socket.+-- If the socket is connected, send() is called.+-- Otherwise, sento() is called.+send :: UDPSocket -> (ByteString -> IO ())+send UDPSocket{..}+ | connected = \bs -> void $ NSB.send udpSocket bs+ | otherwise = \bs -> void $ NSB.sendTo udpSocket bs peerSockAddr++-- | Receiving data with a UDP socket.+-- If the socket is connected, recv() is called.+-- Otherwise, recvfrom() is called.+recv :: UDPSocket -> IO ByteString+recv UDPSocket{..}+ | connected = R.recv udpSocket properUDPSize+ | otherwise = go+ where+ go = do+ (bs, sa) <- R.recvFrom udpSocket properUDPSize+ if sa == peerSockAddr then return bs else go++-- | Sending data in a buffer with a UDP socket.+-- If the socket is connected, send() is called.+-- Otherwise, sento() is called.+sendBuf :: UDPSocket -> (Ptr Word8 -> Int -> IO ())+sendBuf UDPSocket{..} ptr siz+ | connected = void $ NS.sendBuf udpSocket ptr siz+ | otherwise = void $ NS.sendBufTo udpSocket ptr siz peerSockAddr++-- | Receiving data in a buffer with a UDP socket.+-- If the socket is connected, recv() is called.+-- Otherwise, recvfrom() is called.+recvBuf :: UDPSocket -> (Ptr Word8 -> Int -> IO Int)+recvBuf UDPSocket{..} ptr siz+ | connected = NS.recvBuf udpSocket ptr siz+ | otherwise = go+ where+ go = do+ (len,sa) <- NS.recvBufFrom udpSocket ptr siz+ if sa == peerSockAddr then return len else go++-- | Closing a socket.+stop :: ListenSocket -> IO ()+stop (ListenSocket s _ _) = NS.close s++-- | Closing a socket.+close :: UDPSocket -> IO ()+close (UDPSocket s _ _) = NS.close s++-- | Emulation of NAT rebiding in the client side.+-- This is mainly used for test purposes.+natRebinding :: UDPSocket -> IO UDPSocket+natRebinding (UDPSocket _ sa conn) = E.bracketOnError open NS.close $ \s -> do+ when conn $ NS.connect s sa+ return $ UDPSocket s sa conn+ where+ family = sockAddrFamily sa+ open = NS.socket family Datagram NS.defaultProtocol++----------------------------------------------------------------++decideOption :: SockAddr -> SocketOption+decideOption SockAddrInet{} = RecvIPv4PktInfo+decideOption SockAddrInet6{} = RecvIPv6PktInfo+decideOption _ = error "decideOption"++-- | Obtaining my sockaddr for a wildcard socket from cmsgs.+getMySockAddr :: SockAddr -> [Cmsg] -> SockAddr+getMySockAddr (SockAddrInet p _) cmsgs = SockAddrInet p addr+ where+ pktinfo = fromJust $ lookupCmsg CmsgIdIPv4PktInfo cmsgs+ IPv4PktInfo _ _ addr = fromJust $ decodeCmsg pktinfo+getMySockAddr (SockAddrInet6 p f _ sc) cmsgs = SockAddrInet6 p f addr sc+ where+ pktinfo = fromJust $ lookupCmsg CmsgIdIPv6PktInfo cmsgs+ IPv6PktInfo _ addr = fromJust $ decodeCmsg pktinfo+getMySockAddr _ _ = error "getMySockAddr"
+ Network/UDP/Recv.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.UDP.Recv (+ recv+ , recvFrom+ , recvMsg+ ) where++import Data.ByteString (ByteString)+import Data.ByteString.Internal (create, ByteString(..), createUptoN)+import Foreign.ForeignPtr (withForeignPtr)+import Network.Socket (Socket, SockAddr, Cmsg, MsgFlag, recvBuf, recvBufFrom, recvBufMsg)+import Network.Socket.Internal (zeroMemory)+import System.IO.Error (ioeSetErrorString, mkIOError)+import GHC.IO.Exception (IOErrorType(..))++mkInvalidRecvArgError :: String -> IOError+mkInvalidRecvArgError loc = ioeSetErrorString err "non-positive length"+ where+ err = mkIOError InvalidArgument loc Nothing Nothing++recv :: Socket -> Int -> IO ByteString+recv s siz+ | siz < 0 = ioError (mkInvalidRecvArgError "Network.UDP.Recv.recv")+ | otherwise = createUptoN siz $ \ptr -> recvBuf s ptr siz++recvFrom :: Socket -> Int -> IO (ByteString, SockAddr)+recvFrom s siz = do+ bs@(PS fptr _ _) <- create siz $ \ptr -> zeroMemory ptr (fromIntegral siz)+ withForeignPtr fptr $ \ptr -> do+ (len, sa) <- recvBufFrom s ptr siz+ let bs' | len < siz = PS fptr 0 len+ | otherwise = bs+ return (bs', sa)++recvMsg :: Socket -> Int -> Int -> MsgFlag+ -> IO (ByteString, SockAddr, [Cmsg], MsgFlag)+recvMsg s siz clen flags = do+ bs@(PS fptr _ _) <- create siz $ \ptr -> zeroMemory ptr (fromIntegral siz)+ withForeignPtr fptr $ \ptr -> do+ (addr,len,cmsgs,flags') <- recvBufMsg s [(ptr,siz)] clen flags+ let bs' | len < siz = PS fptr 0 len+ | otherwise = bs+ return (bs', addr, cmsgs, flags')
+ Network/UDP/Types.hs view
@@ -0,0 +1,14 @@+module Network.UDP.Types where++import Network.Socket++properUDPSize :: Int+properUDPSize = 2048++properCMSGSize :: Int+properCMSGSize = 64++sockAddrFamily :: SockAddr -> Family+sockAddrFamily SockAddrInet{} = AF_INET+sockAddrFamily SockAddrInet6{} = AF_INET6+sockAddrFamily _ = error "sockAddrFamily"
+ network-udp.cabal view
@@ -0,0 +1,34 @@+name: network-udp+version: 0.0.0+synopsis: UDP library+description: Best current practice library for UDP clients and servers.+license: BSD3+license-file: LICENSE+author: Kazu Yamamoto+maintainer: kazu@iij.ad.jp+-- copyright:+category: Network+build-type: Simple+cabal-version: >= 1.10++----------------------------------------------------------------++Source-Repository head+ Type: git+ Location: https://github.com/kazu-yamamoto/network-udp++----------------------------------------------------------------++library+ exposed-modules: Network.UDP+ other-modules: Network.UDP.Recv+ Network.UDP.Types+ build-depends: base >= 4.9 && < 5+ , bytestring+ , containers+ , iproute+ , network+ -- hs-source-dirs:+ default-language: Haskell2010+ ghc-options: -Wall+ default-extensions: Strict StrictData