From 825e27472ab361f9fdb46146c44cd56a571ed947 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Wed, 17 Mar 2010 22:25:49 +0900 Subject: adding API --- Network/DNS.hs | 85 +++++++++++++++++++++++++++++++++++++++++++++++-- Network/DNS/Internal.hs | 30 +++++++++++------ Network/DNS/Response.hs | 14 ++++++-- Network/DNS/Types.hs | 2 +- dns.cabal | 10 +++--- 5 files changed, 122 insertions(+), 19 deletions(-) diff --git a/Network/DNS.hs b/Network/DNS.hs index 0f6de02..b633c33 100644 --- a/Network/DNS.hs +++ b/Network/DNS.hs @@ -1,9 +1,90 @@ module Network.DNS ( module Network.DNS.Types - , module Network.DNS.Query - , module Network.DNS.Response + , lookup, lookupRaw, Resolver + , makeResolver, makeDefaultResolver ) where +import Control.Applicative +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) + +---------------------------------------------------------------- + +data Resolver = Resolver { + genId :: IO Int + , dnsSock :: Socket +} + +---------------------------------------------------------------- + +resolvConf :: String +resolvConf = "/etc/resolv.conf" + +dnsBufferSize :: Int64 +dnsBufferSize = 512 + +---------------------------------------------------------------- + +makeResolver :: String -> IO Resolver +makeResolver addr = do + sock <- openSocket addr + return $ Resolver { genId = getRandom, dnsSock = sock } + +makeDefaultResolver :: IO Resolver +makeDefaultResolver = do + cs <- readFile resolvConf + let l:_ = filter ("nameserver" `isPrefixOf`) $ lines cs + makeResolver $ drop 11 l + +---------------------------------------------------------------- + +getRandom :: IO Int +getRandom = getStdRandom (randomR (0,65535)) + +openSocket :: String -> IO Socket +openSocket 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") + sock <- socket (addrFamily a) (addrSocketType a) (addrProtocol a) + connect sock (addrAddress a) + return sock + +---------------------------------------------------------------- + +lookupRaw :: String -> TYPE -> Resolver -> IO DNSFormat +lookupRaw dom typ rlv = genId rlv >>= lookupRaw' dom typ rlv + +lookupRaw' :: String -> TYPE -> Resolver -> Int -> IO DNSFormat +lookupRaw' dom typ rlv idnt = do + let sock = dnsSock rlv + q = makeQuestion dom typ + sendAll sock (composeQuery idnt [q]) + parseResponse <$> recv sock dnsBufferSize + +lookup :: String -> TYPE -> Resolver -> IO (Maybe RDATA) +lookup dom typ rlv = do + idnt <- genId rlv + res <- lookupRaw' dom typ rlv idnt + let hdr = header res + if identifier hdr == idnt && anCount hdr /= 0 + then return $ find dom typ (answer res) + else return Nothing + +find :: Domain -> TYPE -> [ResourceRecord] -> Maybe RDATA +find _ _ [] = Nothing +find dom typ (r:rs) + | rrname r == dom && rrtype r == typ = return $ rdata r + | otherwise = find dom typ rs diff --git a/Network/DNS/Internal.hs b/Network/DNS/Internal.hs index ac6b8ba..f29ed3e 100644 --- a/Network/DNS/Internal.hs +++ b/Network/DNS/Internal.hs @@ -1,20 +1,23 @@ module Network.DNS.Internal where -import Data.Maybe +import Data.Char import Data.IP +import Data.Maybe ---------------------------------------------------------------- -data TYPE = A | AAAA | NS | TXT | MX | CNAME | UNKNOWN deriving (Eq, Show, Read) +data TYPE = A | AAAA | NS | TXT | MX | CNAME | SOA + | UNKNOWN Int deriving (Eq, Show, Read) rrDB :: [(TYPE, Int)] rrDB = [ - (A, 1) - , (NS, 2) - , (CNAME, 5) - , (MX, 15) - , (TXT, 16) - , (AAAA, 28) + (A, 1) + , (NS, 2) + , (CNAME, 5) + , (SOA, 6) + , (MX, 15) + , (TXT, 16) + , (AAAA, 28) ] rookup :: (Eq b) => b -> [(a,b)] -> Maybe a @@ -24,10 +27,14 @@ rookup key ((x,y):xys) | otherwise = rookup key xys intToType :: Int -> TYPE -intToType n = maybe UNKNOWN id $ rookup n rrDB +intToType n = maybe (UNKNOWN n) id $ rookup n rrDB typeToInt :: TYPE -> Int +typeToInt (UNKNOWN x) = x typeToInt t = maybe 0 id $ lookup t rrDB +toType :: String -> TYPE +toType = read . map toUpper + ---------------------------------------------------------------- data QorR = QR_Query | QR_Response deriving (Eq, Show) @@ -60,15 +67,18 @@ data ResourceRecord = ResourceRecord { , rdata :: RDATA } deriving (Eq, Show) -data RDATA = RD_NS Domain | RD_CNAME Domain +data RDATA = RD_NS Domain | RD_CNAME Domain | RD_MX Int Domain + | RD_SOA Domain Domain Int Int Int Int Int | RD_A IPv4 | RD_AAAA IPv6 | RD_OTH [Int] deriving (Eq) instance Show RDATA where show (RD_NS dom) = dom + show (RD_MX prf dom) = dom ++ " " ++ show prf show (RD_CNAME dom) = dom show (RD_A a) = show a show (RD_AAAA aaaa) = show aaaa + show (RD_SOA mn _ _ _ _ _ mi) = mn ++ " " ++ show mi show (RD_OTH is) = show is ---------------------------------------------------------------- diff --git a/Network/DNS/Response.hs b/Network/DNS/Response.hs index 1ef8973..fa4cdf4 100644 --- a/Network/DNS/Response.hs +++ b/Network/DNS/Response.hs @@ -92,14 +92,24 @@ decodeRR = do decodeRLen = getInt16 decodeRData :: TYPE -> Int -> SGet RDATA -decodeRData NS _ = RD_NS <$> decodeDomain +decodeRData NS _ = RD_NS <$> decodeDomain +decodeRData MX _ = RD_MX <$> decodePreference <*> decodeDomain + where + decodePreference = getInt16 +decodeRData CNAME _ = RD_CNAME <$> decodeDomain decodeRData A len = (RD_A . toIPv4) <$> getNBytes len decodeRData AAAA len = (RD_AAAA . toIPv6 . combine) <$> getNBytes len where combine [] = [] combine [_] = error "combine" combine (a:b:cs) = a * 256 + b : combine cs -decodeRData CNAME _ = RD_CNAME <$> decodeDomain +decodeRData SOA _ = RD_SOA <$> decodeDomain + <*> decodeDomain + <*> getInt32 + <*> getInt32 + <*> getInt32 + <*> getInt32 + <*> getInt32 decodeRData _ len = RD_OTH <$> getNBytes len ---------------------------------------------------------------- diff --git a/Network/DNS/Types.hs b/Network/DNS/Types.hs index fe1f1be..906fc08 100644 --- a/Network/DNS/Types.hs +++ b/Network/DNS/Types.hs @@ -1,5 +1,5 @@ module Network.DNS.Types ( - TYPE (..), intToType, typeToInt + TYPE (..), intToType, typeToInt, toType , QorR (..) , OPCODE (..) , RCODE (..) diff --git a/dns.cabal b/dns.cabal index 0d607fe..f6fa99b 100644 --- a/dns.cabal +++ b/dns.cabal @@ -16,9 +16,11 @@ library GHC-Options: -Wall Exposed-Modules: Network.DNS Network.DNS.Types - Network.DNS.Query - Network.DNS.Response Other-Modules: Network.DNS.Internal Network.DNS.StateBinary - Build-Depends: base >= 4.0 && < 10, binary, iproute, bytestring, - containers, mtl + Network.DNS.Query + Network.DNS.Response + Build-Depends: base >= 4.0 && < 10, haskell98, + binary, iproute, + containers, mtl, bytestring, + network, network-bytestring -- cgit v1.2.3