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
|
module Main (main) where
import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.Maybe
import Network.DNS.Decode
import Network.DNS.Encode
import Network.DNS.Types
import Network.Socket.ByteString (recvFrom,sendAllTo)
import Network.Socket hiding (recvFrom)
import System.Environment
import qualified Data.ByteString.Lazy as LBS
import Database (Database)
import qualified Config
import qualified Database
main :: IO ()
main = do
[confPath,dbPath] <- getArgs
c <- Config.readFile "test.conf"
db <- Database.readFile "test.db"
addrinfos <-
getAddrInfo
(Just (defaultHints { addrFlags = [AI_PASSIVE] }))
Nothing
(Just (Config.port c))
addrinfo <- maybe (fail "no addr info") return (listToMaybe addrinfos)
bracket
(socket (addrFamily addrinfo) Datagram defaultProtocol)
(close)
$ \sock -> do
bind sock (addrAddress addrinfo)
forever $ do
(s, addr) <- recvFrom sock (Config.bufSize c)
forkIO $ do
either
(putStrLn . ("decode error: " ++))
(\req -> do
let res = handleRequest db req
sendAllTo sock (LBS.toStrict (encode res)) addr)
(decode (LBS.fromStrict s))
handleRequest :: Database -> DNSMessage -> DNSMessage
handleRequest db DNSMessage{question=qs,header=DNSHeader{identifier=i}} =
DNSMessage
{ header = DNSHeader
{ identifier = i
, flags = DNSFlags
{ qOrR = QR_Response
, opcode = OP_STD
, authAnswer = True
, trunCation = False
, recDesired = True
, recAvailable = False
, rcode = if length as == 0 then NameErr else NoErr
, authenData = False
}
}
, question = qs
, answer = as
, authority = []
, additional = []
}
where
as = concatMap (flip Database.lookup db) qs
|
