diff options
author | Kazu Yamamoto <kazu@iij.ad.jp> | 2011-09-05 16:06:17 +0900 |
---|---|---|
committer | Kazu Yamamoto <kazu@iij.ad.jp> | 2011-09-05 16:06:17 +0900 |
commit | 8e28329b12d1cabd0038e5d86c8c8edd9dfe0e5e (patch) | |
tree | 5f87044ccdbb90ecee1f48bc78da450cfb59bfd2 | |
parent | e368c41a0a1819178429dac733c5bd76d1b67805 (diff) |
Supporting PTR.
-rw-r--r-- | Network/DNS/Internal.hs | 6 | ||||
-rw-r--r-- | Network/DNS/Lookup.hs | 13 | ||||
-rw-r--r-- | Network/DNS/Response.hs | 1 | ||||
-rw-r--r-- | Test.hs | 12 |
4 files changed, 30 insertions, 2 deletions
diff --git a/Network/DNS/Internal.hs b/Network/DNS/Internal.hs index 28063fc..f2dff00 100644 --- a/Network/DNS/Internal.hs +++ b/Network/DNS/Internal.hs @@ -18,7 +18,7 @@ type Domain = ByteString {-| Types for resource records. -} -data TYPE = A | AAAA | NS | TXT | MX | CNAME | SOA +data TYPE = A | AAAA | NS | TXT | MX | CNAME | SOA | PTR | UNKNOWN Int deriving (Eq, Show, Read) rrDB :: [(TYPE, Int)] @@ -27,6 +27,7 @@ rrDB = [ , (NS, 2) , (CNAME, 5) , (SOA, 6) + , (PTR, 12) , (MX, 15) , (TXT, 16) , (AAAA, 28) @@ -125,7 +126,7 @@ data ResourceRecord = ResourceRecord { {-| Raw data format for each type. -} -data RDATA = RD_NS Domain | RD_CNAME Domain | RD_MX Int Domain +data RDATA = RD_NS Domain | RD_CNAME Domain | RD_MX Int Domain | RD_PTR Domain | RD_SOA Domain Domain Int Int Int Int Int | RD_A IPv4 | RD_AAAA IPv6 | RD_TXT ByteString | RD_OTH [Int] deriving (Eq) @@ -138,6 +139,7 @@ instance Show RDATA where show (RD_AAAA aaaa) = show aaaa show (RD_TXT txt) = BS.unpack txt show (RD_SOA mn _ _ _ _ _ mi) = BS.unpack mn ++ " " ++ show mi + show (RD_PTR dom) = BS.unpack dom show (RD_OTH is) = show is ---------------------------------------------------------------- diff --git a/Network/DNS/Lookup.hs b/Network/DNS/Lookup.hs index 79af339..728b0c6 100644 --- a/Network/DNS/Lookup.hs +++ b/Network/DNS/Lookup.hs @@ -6,6 +6,7 @@ module Network.DNS.Lookup ( lookupA, lookupAAAA , lookupMX, lookupAviaMX, lookupAAAAviaMX , lookupTXT + , lookupPTR ) where import Control.Applicative @@ -82,3 +83,15 @@ lookupTXT rlv dom = toTXT <$> DNS.lookup rlv dom TXT toTXT = maybe Nothing (Just . map unTag) unTag (RD_TXT x) = x unTag _ = error "lookupTXT" + +---------------------------------------------------------------- + +{-| + Resolving 'Domain' and its preference by 'PTR'. +-} +lookupPTR :: Resolver -> Domain -> IO (Maybe [Domain]) +lookupPTR rlv dom = toPTR <$> DNS.lookup rlv dom PTR + where + toPTR = maybe Nothing (Just . map unTag) + unTag (RD_PTR dm) = dm + unTag _ = error "lookupPTR" diff --git a/Network/DNS/Response.hs b/Network/DNS/Response.hs index d746fc2..fdce3e3 100644 --- a/Network/DNS/Response.hs +++ b/Network/DNS/Response.hs @@ -126,6 +126,7 @@ decodeRData SOA _ = RD_SOA <$> decodeDomain decodeRetry = getInt32 decodeExpire = getInt32 decodeMinumun = getInt32 +decodeRData PTR _ = RD_PTR <$> decodeDomain decodeRData _ len = RD_OTH <$> getNBytes len @@ -7,6 +7,7 @@ import Network.DNS as DNS import Test.Framework (defaultMain, testGroup, Test) import Test.Framework.Providers.HUnit import Test.HUnit hiding (Test) +import qualified Data.ByteString.Char8 as BS tests :: [Test] tests = [ @@ -16,6 +17,7 @@ tests = [ , testCase "lookupTXT" test_lookupTXT , testCase "lookupAviaMX" test_lookupAviaMX , testCase "lookupAviaCNAME" test_lookupAviaCNAME + , testCase "lookupPTR" test_lookupPTR ] ] @@ -60,5 +62,15 @@ test_lookupAviaCNAME = do withResolver rs $ \resolver -> DNS.lookupA resolver "ghs.google.com" ??= ["72.14.203.121"] +test_lookupPTR :: IO () +test_lookupPTR = do + rs <- makeResolvSeed defaultResolvConf + withResolver rs $ \resolver -> + DNS.lookupPTR resolver rev ?= Just ["www-v4.iij.ad.jp."] + where + target = "210.130.137.80" + rev = BS.intercalate "." (reverse (BS.split '.' target)) + `BS.append` ".in-addr.arpa" + main :: IO () main = defaultMain tests |