From 825e27472ab361f9fdb46146c44cd56a571ed947 Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Wed, 17 Mar 2010 22:25:49 +0900
Subject: adding API

---
 Network/DNS.hs | 85 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 83 insertions(+), 2 deletions(-)

(limited to 'Network/DNS.hs')

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
-- 
cgit v1.2.3