diff options
Diffstat (limited to 'Network/DNS/Query.hs')
| -rw-r--r-- | Network/DNS/Query.hs | 96 |
1 files changed, 82 insertions, 14 deletions
diff --git a/Network/DNS/Query.hs b/Network/DNS/Query.hs index 30c7e24..0d164b4 100644 --- a/Network/DNS/Query.hs +++ b/Network/DNS/Query.hs @@ -1,19 +1,28 @@ -module Network.DNS.Query (composeQuery) where +{-# LANGUAGE RecordWildCards #-} +module Network.DNS.Query (composeQuery, composeDNSFormat) where import qualified Data.ByteString.Lazy.Char8 as BL (ByteString) import qualified Data.ByteString as BS (unpack) import qualified Data.ByteString.Char8 as BS (length, split, null) +import Blaze.ByteString.Builder.ByteString (writeByteString) import Network.DNS.StateBinary import Network.DNS.Internal import Data.Monoid +import Control.Monad.State +import Data.Bits +import Data.Word +import Data.IP (+++) :: Monoid a => a -> a -> a (+++) = mappend ---------------------------------------------------------------- +composeDNSFormat :: DNSFormat -> BL.ByteString +composeDNSFormat fmt = runSPut (encodeDNSFormat fmt) + composeQuery :: Int -> [Question] -> BL.ByteString -composeQuery idt qs = runSPut (encodeQuery qry) +composeQuery idt qs = composeDNSFormat qry where hdr = header defaultQuery qry = defaultQuery { @@ -26,12 +35,18 @@ composeQuery idt qs = runSPut (encodeQuery qry) ---------------------------------------------------------------- -encodeQuery :: DNSFormat -> SPut -encodeQuery fmt = encodeHeader hdr - +++ encodeQuestion qs +encodeDNSFormat :: DNSFormat -> SPut +encodeDNSFormat fmt = encodeHeader hdr + +++ mconcat (map encodeQuestion qs) + +++ mconcat (map encodeRR an) + +++ mconcat (map encodeRR au) + +++ mconcat (map encodeRR ad) where hdr = header fmt qs = question fmt + an = answer fmt + au = authority fmt + ad = additional fmt encodeHeader :: DNSHeader -> SPut encodeHeader hdr = encodeIdentifier (identifier hdr) @@ -48,16 +63,69 @@ encodeHeader hdr = encodeIdentifier (identifier hdr) decodeArCount = putInt16 encodeFlags :: DNSFlags -> SPut -encodeFlags _ = put16 0x0100 -- xxx - -encodeQuestion :: [Question] -> SPut -encodeQuestion qs = encodeDomain dom - +++ putInt16 (typeToInt typ) - +++ put16 1 +encodeFlags DNSFlags{..} = put16 word where - q = head qs - dom = qname q - typ = qtype q + word16 :: Enum a => a -> Word16 + word16 = toEnum . fromEnum + + set :: Word16 -> State Word16 () + set byte = modify (.|. byte) + + st :: State Word16 () + st = sequence_ + [ set (word16 rcode) + , when recAvailable $ set (bit 7) + , when recDesired $ set (bit 8) + , when trunCation $ set (bit 9) + , when authAnswer $ set (bit 10) + , set (word16 opcode `shiftL` 11) + , when (qOrR==QR_Response) $ set (bit 15) + ] + + word = execState st 0 + +encodeQuestion :: Question -> SPut +encodeQuestion Question{..} = + encodeDomain qname + +++ putInt16 (typeToInt qtype) + +++ put16 1 + +encodeRR :: ResourceRecord -> SPut +encodeRR ResourceRecord{..} = + mconcat + [ encodeDomain rrname + , putInt16 (typeToInt rrtype) + , put16 1 + , putInt32 rrttl + , putInt16 rdlen + , encodeRDATA rdata + ] + +encodeRDATA :: RDATA -> SPut +encodeRDATA rd = case rd of + (RD_A ip) -> mconcat $ map putInt8 (fromIPv4 ip) + (RD_AAAA ip) -> mconcat $ map putInt16 (fromIPv6 ip) + (RD_NS dom) -> encodeDomain dom + (RD_CNAME dom) -> encodeDomain dom + (RD_PTR dom) -> encodeDomain dom + (RD_MX prf dom) -> mconcat [putInt16 prf, encodeDomain dom] + (RD_TXT txt) -> writeByteString txt + (RD_OTH bytes) -> mconcat $ map putInt8 bytes + (RD_SOA d1 d2 serial refresh retry expire min') -> mconcat $ + [ encodeDomain d1 + , encodeDomain d2 + , putInt32 serial + , putInt32 refresh + , putInt32 retry + , putInt32 expire + , putInt32 min' + ] + (RD_SRV prio weight port dom) -> mconcat $ + [ putInt16 prio + , putInt16 weight + , putInt16 port + , encodeDomain dom + ] ---------------------------------------------------------------- |