From 2afb9d8072fdf52e9ed100027cf97aad8b9abd8d Mon Sep 17 00:00:00 2001 From: PHO Date: Sat, 23 May 2009 10:30:27 +0900 Subject: [PATCH] More record types... --- Network/DNS/Message.hs | 237 +++++++++++++++++++++++++++++++---------- 1 file changed, 182 insertions(+), 55 deletions(-) diff --git a/Network/DNS/Message.hs b/Network/DNS/Message.hs index 5c53795..ab1a154 100644 --- a/Network/DNS/Message.hs +++ b/Network/DNS/Message.hs @@ -13,14 +13,27 @@ module Network.DNS.Message , RecordType , RecordClass(..) + , SOAFields(..) + , SomeQT , SomeRR , SomeRT , A(..) , NS(..) + , MD(..) + , MF(..) , CNAME(..) + , SOA(..) + , MB(..) + , MG(..) + , MR(..) + , NULL(..) + , PTR(..) , HINFO(..) + , MINFO(..) + , MX(..) + , TXT(..) , mkDomainName , wrapQueryType @@ -295,33 +308,49 @@ class (Show rt, Show dt, Eq rt, Eq dt, Typeable rt, Typeable dt) => RecordType r putRecordType :: rt -> Packer s () putRecordType = P.putWord16be . fromIntegral . rtToInt - putResourceRecord :: ResourceRecord rt dt -> Packer CompTable () - putResourceRecord rr - = do putDomainName $ rrName rr - putRecordType $ rrType rr - putBinary $ rrClass rr - P.putWord32be $ rrTTL rr - - -- First, write a dummy data length. + putRecordDataWithLength :: rt -> dt -> Packer CompTable () + putRecordDataWithLength rt dt + = do -- First, write a dummy data length. offset <- bytesWrote P.putWord16be 0 -- Second, write data. - putRecordData (rrType rr) (rrData rr) + putRecordData rt dt -- Third, rewrite the dummy length to an actual value. offset' <- bytesWrote withOffset offset $ P.putWord16be (fromIntegral (offset' - offset - 2)) + putResourceRecord :: ResourceRecord rt dt -> Packer CompTable () + putResourceRecord rr + = do putDomainName $ rrName rr + putRecordType $ rrType rr + putBinary $ rrClass rr + P.putWord32be $ rrTTL rr + putRecordDataWithLength (rrType rr) (rrData rr) + + getRecordDataWithLength :: rt -> Unpacker DecompTable dt + getRecordDataWithLength rt + = do len <- U.getWord16be + offset <- U.bytesRead + dat <- getRecordData rt + offset' <- U.bytesRead + + let consumed = offset' - offset + when (consumed /= len) + $ fail ("getRecordData " ++ show rt ++ " consumed " ++ show consumed ++ + " bytes but it had to consume " ++ show len ++ " bytes") + + return dat + getResourceRecord :: rt -> Unpacker DecompTable (ResourceRecord rt dt) getResourceRecord rt = do name <- getDomainName U.skip 2 -- record type cl <- getBinary ttl <- U.getWord32be - U.skip 2 -- data length - dat <- getRecordData rt + dat <- getRecordDataWithLength rt return $ ResourceRecord { rrName = name , rrType = rt @@ -349,6 +378,18 @@ getSomeRT = do n <- liftM fromIntegral U.getWord16be Just srt -> return srt +data SOAFields + = SOAFields { + soaMasterNameServer :: !DomainName + , soaResponsibleMailbox :: !DomainName + , soaSerialNumber :: !Word32 + , soaRefreshInterval :: !Word32 + , soaRetryInterval :: !Word32 + , soaExpirationLimit :: !Word32 + , soaMinimumTTL :: !Word32 + } + deriving (Show, Eq, Typeable) + data A = A deriving (Show, Eq, Typeable) instance RecordType A HostAddress where rtToInt _ = 1 @@ -361,21 +402,129 @@ instance RecordType NS DomainName where putRecordData _ = putDomainName getRecordData _ = getDomainName +data MD = MD deriving (Show, Eq, Typeable) +instance RecordType MD DomainName where + rtToInt _ = 3 + putRecordData _ = putDomainName + getRecordData _ = getDomainName + +data MF = MF deriving (Show, Eq, Typeable) +instance RecordType MF DomainName where + rtToInt _ = 4 + putRecordData _ = putDomainName + getRecordData _ = getDomainName + data CNAME = CNAME deriving (Show, Eq, Typeable) instance RecordType CNAME DomainName where rtToInt _ = 5 putRecordData _ = putDomainName getRecordData _ = getDomainName +data SOA = SOA deriving (Show, Eq, Typeable) +instance RecordType SOA SOAFields where + rtToInt _ = 6 + putRecordData _ = \ soa -> + do putDomainName $ soaMasterNameServer soa + putDomainName $ soaResponsibleMailbox soa + P.putWord32be $ soaSerialNumber soa + P.putWord32be $ soaRefreshInterval soa + P.putWord32be $ soaRetryInterval soa + P.putWord32be $ soaExpirationLimit soa + P.putWord32be $ soaMinimumTTL soa + getRecordData _ = do master <- getDomainName + mail <- getDomainName + serial <- U.getWord32be + refresh <- U.getWord32be + retry <- U.getWord32be + expire <- U.getWord32be + ttl <- U.getWord32be + return SOAFields { + soaMasterNameServer = master + , soaResponsibleMailbox = mail + , soaSerialNumber = serial + , soaRefreshInterval = refresh + , soaRetryInterval = retry + , soaExpirationLimit = expire + , soaMinimumTTL = ttl + } + +data MB = MB deriving (Show, Eq, Typeable) +instance RecordType MB DomainName where + rtToInt _ = 7 + putRecordData _ = putDomainName + getRecordData _ = getDomainName + +data MG = MG deriving (Show, Eq, Typeable) +instance RecordType MG DomainName where + rtToInt _ = 8 + putRecordData _ = putDomainName + getRecordData _ = getDomainName + +data MR = MR deriving (Show, Eq, Typeable) +instance RecordType MR DomainName where + rtToInt _ = 9 + putRecordData _ = putDomainName + getRecordData _ = getDomainName + +data NULL = NULL deriving (Show, Eq, Typeable) +instance RecordType NULL BS.ByteString where + rtToInt _ = 10 + putRecordData _ _ = fail "putRecordData NULL can't be defined" + getRecordData _ = fail "getRecordData NULL can't be defined" + putRecordDataWithLength _ = \ dat -> + do P.putWord16be $ fromIntegral $ BS.length dat + P.putByteString dat + getRecordDataWithLength _ = do len <- U.getWord16be + U.getByteString $ fromIntegral len + +data PTR = PTR deriving (Show, Eq, Typeable) +instance RecordType PTR DomainName where + rtToInt _ = 12 + putRecordData _ = putDomainName + getRecordData _ = getDomainName + data HINFO = HINFO deriving (Show, Eq, Typeable) instance RecordType HINFO (BS.ByteString, BS.ByteString) where - rtToInt _ = 13 - putRecordData _ (cpu, os) = do putCharString cpu - putCharString os - getRecordData _ = do cpu <- getCharString - os <- getCharString - return (cpu, os) - + rtToInt _ = 13 + putRecordData _ = \ (cpu, os) -> + do putCharString cpu + putCharString os + getRecordData _ = do cpu <- getCharString + os <- getCharString + return (cpu, os) + +data MINFO = MINFO deriving (Show, Eq, Typeable) +instance RecordType MINFO (DomainName, DomainName) where + rtToInt _ = 14 + putRecordData _ = \ (r, e) -> + do putDomainName r + putDomainName e + getRecordData _ = do r <- getDomainName + e <- getDomainName + return (r, e) + +data MX = MX deriving (Show, Eq, Typeable) +instance RecordType MX (Word16, DomainName) where + rtToInt _ = 15 + putRecordData _ = \ (pref, exch) -> + do P.putWord16be pref + putDomainName exch + getRecordData _ = do pref <- U.getWord16be + exch <- getDomainName + return (pref, exch) + +data TXT = TXT deriving (Show, Eq, Typeable) +instance RecordType TXT [BS.ByteString] where + rtToInt _ = 16 + putRecordData _ = mapM_ putCharString + getRecordData _ = fail "getRecordData TXT can't be defined" + + getRecordDataWithLength _ = U.getWord16be >>= worker [] . fromIntegral + where + worker :: [BS.ByteString] -> Int -> Unpacker s [BS.ByteString] + worker soFar 0 = return (reverse soFar) + worker soFar n = do str <- getCharString + worker (str : soFar) (0 `max` n - 1 - BS.length str) {- data RecordType @@ -508,48 +657,26 @@ instance Enum ResponseCode where {- instance Enum RecordType where - fromEnum A = 1 - fromEnum NS = 2 - fromEnum MD = 3 - fromEnum MF = 4 - fromEnum CNAME = 5 - fromEnum SOA = 6 - fromEnum MB = 7 - fromEnum MG = 8 - fromEnum MR = 9 - fromEnum NULL = 10 + fromEnum A = 1 / + fromEnum NS = 2 / + fromEnum MD = 3 / + fromEnum MF = 4 / + fromEnum CNAME = 5 / + fromEnum SOA = 6 / + fromEnum MB = 7 / + fromEnum MG = 8 / + fromEnum MR = 9 / + fromEnum NULL = 10 / fromEnum WKS = 11 - fromEnum PTR = 12 - fromEnum HINFO = 13 - fromEnum MINFO = 14 - fromEnum MX = 15 - fromEnum TXT = 16 + fromEnum PTR = 12 / + fromEnum HINFO = 13 / + fromEnum MINFO = 14 / + fromEnum MX = 15 / + fromEnum TXT = 16 / fromEnum AXFR = 252 fromEnum MAILB = 253 fromEnum MAILA = 254 fromEnum AnyType = 255 - - toEnum 1 = A - toEnum 2 = NS - toEnum 3 = MD - toEnum 4 = MF - toEnum 5 = CNAME - toEnum 6 = SOA - toEnum 7 = MB - toEnum 8 = MG - toEnum 9 = MR - toEnum 10 = NULL - toEnum 11 = WKS - toEnum 12 = PTR - toEnum 13 = HINFO - toEnum 14 = MINFO - toEnum 15 = MX - toEnum 16 = TXT - toEnum 252 = AXFR - toEnum 253 = MAILB - toEnum 254 = MAILA - toEnum 255 = AnyType - toEnum _ = undefined -} instance Enum RecordClass where -- 2.40.0