summaryrefslogtreecommitdiff
path: root/server/src/Network/Bind.hs
blob: d2442c8276b97e66c01439b40bb9f8e130b6c74c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
module Network.Bind where

import Data.ByteString (ByteString)
import Network.Socket
import System.IO.Error

import Network.Address (getBindAddress)
import qualified Network.QueryResponse as QR
         ;import Network.QueryResponse hiding (udpTransport, udpTransport')

-- | Try (in order) a list of port numbers to bind a socket on and return a
-- 'Transport' on the first success.
--
-- Port numbers may be specified symbolically (for example, "domain" for port
-- 53) and additionally, for testing convenience, the port "fake" will pretend
-- to bind a port but instead return a null transport.
--
-- The Bool argument should be 'True' if you want a dual-socket that supports
-- both IPv4 and IPv6.  Otherwise, IPv4 only will be assumed.
udpTransport' :: Show err => Bool -> [String] -> IO (Maybe (Transport err SockAddr ByteString, Socket))
udpTransport' want6 ports = do
    let tryBind "fake" _ = do
            dummysock <- socket (if want6 then AF_INET6 else AF_INET) Datagram defaultProtocol
            return $ Just (QR.nullTransport, dummysock)
        tryBind port next = do
            addr <- getBindAddress port want6
            (udp,sock) <- QR.udpTransport' addr
            return $ Just (udp,sock)
          `catchIOError` \e -> do
            -- warn $ "bind-error: " <> bshow addr <> " " <> bshow e
            next
    foldr tryBind (return Nothing) ports

-- | Like "udpTransport\'" except that it does not return the bound 'Socket'.
udpTransport :: Show err => Bool -> [String] -> IO (Maybe (Transport err SockAddr ByteString))
udpTransport want6 ports = fmap fst <$> udpTransport' want6 ports