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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
{-|
DNS Resolver and lookup functions.
-}
module Network.DNS.Resolver (
ResolvSeed, makeResolvSeed, makeDefaultResolvSeed
, Resolver, withResolver
, lookup, lookupRaw
) where
import Control.Applicative
import Control.Exception
import Data.List hiding (find, lookup)
import Data.Int
import Network.DNS.Types
import Network.DNS.Query
import Network.DNS.Response
import Random
import Network.BSD
import Network.Socket hiding (send, sendTo, recv, recvFrom)
import Network.Socket.ByteString.Lazy
import Prelude hiding (lookup)
----------------------------------------------------------------
{-|
Abstract data type of DNS Resolver seed
-}
data ResolvSeed = ResolvSeed {
addrInfo :: AddrInfo
}
data Resolver = Resolver {
genId :: IO Int
, dnsSock :: Socket
}
----------------------------------------------------------------
resolvConf :: String
resolvConf = "/etc/resolv.conf"
dnsBufferSize :: Int64
dnsBufferSize = 512
----------------------------------------------------------------
{-|
Making 'ResolvSeed' from an IP address of a DNS cache server.
-}
makeResolvSeed :: HostName -> IO ResolvSeed
makeResolvSeed addr = ResolvSeed <$> makeAddrInfo addr
{-|
Making 'ResolvSeed' from \"/etc/resolv.conf\".
-}
makeDefaultResolvSeed :: IO ResolvSeed
makeDefaultResolvSeed = toAddr <$> readFile resolvConf >>= makeResolvSeed
where
toAddr cs = let l:_ = filter ("nameserver" `isPrefixOf`) $ lines cs
in drop 11 l
----------------------------------------------------------------
getRandom :: IO Int
getRandom = getStdRandom (randomR (0,65535))
makeAddrInfo :: HostName -> IO AddrInfo
makeAddrInfo addr = do
proto <- getProtocolNumber "udp"
let hints = defaultHints {
addrFlags = [AI_ADDRCONFIG, AI_NUMERICHOST, AI_PASSIVE]
, addrSocketType = Datagram
, addrProtocol = proto
}
a:_ <- getAddrInfo (Just hints) (Just addr) (Just "domain")
return a
----------------------------------------------------------------
withResolver :: ResolvSeed -> (Resolver -> IO ()) -> IO ()
withResolver seed func = do
let ai = addrInfo seed
sock <- socket (addrFamily ai) (addrSocketType ai) (addrProtocol ai)
connect sock (addrAddress ai)
let resolv = Resolver getRandom sock
func resolv `finally` sClose sock
----------------------------------------------------------------
{-|
Looking up resource records of a domain.
-}
lookup :: Resolver -> Domain -> TYPE -> IO (Maybe [RDATA])
lookup rlv dom typ = do
let sock = dnsSock rlv
seqno <- genId rlv
res <- lookupRaw' sock seqno dom typ
let hdr = header res
if identifier hdr == seqno && anCount hdr /= 0
then return . listToMaybe . map rdata . filter correct $ answer res
else return Nothing
where
{- CNAME hack
dom' = if "." `isSuffixOf` dom
then dom
else dom ++ "."
correct r = rrname r == dom' && rrtype r == typ
-}
correct r = rrtype r == typ
listToMaybe [] = Nothing
listToMaybe xs = Just xs
{-|
Looking up a domain and returning an entire DNS Response.
-}
lookupRaw :: Resolver -> Domain -> TYPE -> IO DNSFormat
lookupRaw rlv dom typ = do
let sock = dnsSock rlv
seqno <- genId rlv
lookupRaw' sock seqno dom typ
lookupRaw' :: Socket -> Int -> Domain -> TYPE -> IO DNSFormat
lookupRaw' sock seqno dom typ = do
let q = makeQuestion dom typ
sendAll sock (composeQuery seqno [q])
parseResponse <$> recv sock dnsBufferSize
|
