summaryrefslogtreecommitdiffhomepage
path: root/Network
diff options
context:
space:
mode:
authorGravatar Kazu Yamamoto <kazu@iij.ad.jp>2011-09-05 16:06:17 +0900
committerGravatar Kazu Yamamoto <kazu@iij.ad.jp>2011-09-05 16:06:17 +0900
commit8e28329b12d1cabd0038e5d86c8c8edd9dfe0e5e (patch)
tree5f87044ccdbb90ecee1f48bc78da450cfb59bfd2 /Network
parente368c41a0a1819178429dac733c5bd76d1b67805 (diff)
Supporting PTR.
Diffstat (limited to 'Network')
-rw-r--r--Network/DNS/Internal.hs6
-rw-r--r--Network/DNS/Lookup.hs13
-rw-r--r--Network/DNS/Response.hs1
3 files changed, 18 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