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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
-- | Resolver related data types.
module Network.DNS.Resolver (
-- * Configuration for resolver
ResolvConf
, defaultResolvConf
-- ** Accessors
, resolvInfo
, resolvTimeout
, resolvRetry
, resolvConcurrent
, resolvCache
, resolvQueryControls
-- ** Specifying DNS servers
, FileOrNumericHost(..)
-- ** Configuring cache
, CacheConf
, defaultCacheConf
, maximumTTL
, pruningDelay
-- * Intermediate data type for resolver
, ResolvSeed
, makeResolvSeed
-- * Type and function for resolver
, Resolver
, withResolver
, withResolvers
) where
import Control.Exception as E
import qualified Crypto.Random as C
import qualified Data.ByteString as BS
import Data.IORef (IORef)
import qualified Data.IORef as I
import qualified Data.List.NonEmpty as NE
import Network.Socket (AddrInfoFlag(..), AddrInfo(..), PortNumber, HostName, SocketType(Datagram), getAddrInfo, defaultHints)
import Prelude
import Network.DNS.Imports
import Network.DNS.Memo
import Network.DNS.Resolver.Internal
import Network.DNS.Transport
import Network.DNS.Types.Internal
import Network.DNS.Types.Resolver
----------------------------------------------------------------
-- | Make a 'ResolvSeed' from a 'ResolvConf'.
--
-- Examples:
--
-- >>> rs <- makeResolvSeed defaultResolvConf
--
makeResolvSeed :: ResolvConf -> IO ResolvSeed
makeResolvSeed conf = ResolvSeed conf <$> findAddresses
where
findAddresses :: IO (NonEmpty AddrInfo)
findAddresses = case resolvInfo conf of
RCHostName numhost -> (:| []) <$> makeAddrInfo numhost Nothing
RCHostPort numhost mport -> (:| []) <$> makeAddrInfo numhost (Just mport)
RCHostNames nss -> mkAddrs nss
RCFilePath file -> getDefaultDnsServers file >>= mkAddrs
mkAddrs [] = E.throwIO BadConfiguration
mkAddrs (l:ls) = (:|) <$> makeAddrInfo l Nothing <*> forM ls (`makeAddrInfo` Nothing)
makeAddrInfo :: HostName -> Maybe PortNumber -> IO AddrInfo
makeAddrInfo addr mport = do
let hints = defaultHints {
addrFlags = [AI_ADDRCONFIG, AI_NUMERICHOST, AI_NUMERICSERV, AI_PASSIVE]
, addrSocketType = Datagram
}
-- 53 is the standard port number for domain name servers as assigned by IANA
serv = maybe "53" show mport
head <$> getAddrInfo (Just hints) (Just addr) (Just serv)
----------------------------------------------------------------
-- | Giving a thread-safe 'Resolver' to the function of the second
-- argument.
withResolver :: ResolvSeed -> (Resolver -> IO a) -> IO a
withResolver seed f = makeResolver seed >>= f
{-# DEPRECATED withResolvers "Use withResolver with resolvConcurrent set to True" #-}
-- | Giving thread-safe 'Resolver's to the function of the second
-- argument. For each 'Resolver', multiple lookups must be done
-- sequentially. 'Resolver's can be used concurrently.
withResolvers :: [ResolvSeed] -> ([Resolver] -> IO a) -> IO a
withResolvers seeds f = mapM makeResolver seeds >>= f
makeResolver :: ResolvSeed -> IO Resolver
makeResolver seed = do
let n = NE.length $ nameservers seed
refs <- replicateM n (C.drgNew >>= I.newIORef)
let gens = NE.fromList $ map getRandom refs
case resolvCache $ resolvconf seed of
Just cacheconf -> do
c <- newCache $ pruningDelay cacheconf
return $ Resolver seed gens $ Just c
Nothing -> return $ Resolver seed gens Nothing
getRandom :: IORef C.ChaChaDRG -> IO Word16
getRandom ref = I.atomicModifyIORef' ref $ \gen ->
let (bs, gen') = C.randomBytesGenerate 2 gen
[u,l] = map fromIntegral $ BS.unpack bs
!seqno = u * 256 + l
in (gen', seqno)
|
