X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=haskell-dns.git;a=blobdiff_plain;f=Network%2FDNS%2FMessage.hs;h=6144d13766e037d551838526f18804bf0b896451;hp=3fc48a59f5470225648278fd5a8ad5aecaf21953;hb=d4d887202f59a0bb394d04e74c2f02eb91e26f5f;hpb=d94095b1b80d070f10fab2681bdebbdb8bed84b6 diff --git a/Network/DNS/Message.hs b/Network/DNS/Message.hs index 3fc48a5..6144d13 100644 --- a/Network/DNS/Message.hs +++ b/Network/DNS/Message.hs @@ -18,9 +18,13 @@ module Network.DNS.Message , CNAME(..) , HINFO(..) + + , mkQueryType + , mkDomainName ) where +import Control.Exception import Control.Monad import Data.Binary import Data.Binary.BitPut as BP @@ -28,6 +32,7 @@ import Data.Binary.Get as G import Data.Binary.Put as P import Data.Binary.Strict.BitGet as BG import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as C8 hiding (ByteString) import qualified Data.ByteString.Lazy as LBS import Data.Typeable import qualified Data.IntMap as IM @@ -52,6 +57,7 @@ data Message , msgAuthorities :: ![SomeRR] , msgAdditionals :: ![SomeRR] } + deriving (Show, Eq) data Header = Header { @@ -70,6 +76,7 @@ data Header -- + NSCOUNT -- + ARCOUNT } + deriving (Show, Eq) type MessageID = Word16 @@ -96,11 +103,16 @@ data ResponseCode data Question = Question { qName :: !DomainName - , qType :: !SomeRT + , qType :: !SomeQT , qClass :: !RecordClass } deriving (Show, Eq) +type SomeQT = SomeRT + +mkQueryType :: RecordType rt dt => rt -> SomeQT +mkQueryType = SomeRT + putQ :: Question -> Put putQ q = do putDomainName $ qName q @@ -128,6 +140,18 @@ nameToLabels (DN ls) = ls labelsToName :: [DomainLabel] -> DomainName labelsToName = DN +mkDomainName :: String -> DomainName +mkDomainName = labelsToName . mkLabels [] . notEmpty + where + notEmpty :: String -> String + notEmpty xs = assert (not $ null xs) xs + + mkLabels :: [DomainLabel] -> String -> [DomainLabel] + mkLabels soFar [] = reverse (C8.empty : soFar) + mkLabels soFar xs = case break (== '.') xs of + (l, ('.':rest)) + -> mkLabels (C8.pack l : soFar) rest + _ -> error ("Illegal domain name: " ++ xs) data RecordClass = IN