adding API

4 files changed, 116 insertions, 15 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 (..)