dns-2.0.8/0000755000000000000000000000000013002260502010461 5ustar0000000000000000dns-2.0.8/Changelog0000644000000000000000000000225413002260502012276 0ustar00000000000000002.0.8 - Better handling of encoding and decoding the "root" domain ".". [#45](https://github.com/kazu-yamamoto/dns/pull/45) 2.0.7 - Add length checks for A and AAAA records. [#43](https://github.com/kazu-yamamoto/dns/pull/43) 2.0.6 - Adding Ord instance. [#41](https://github.com/kazu-yamamoto/dns/pull/41) - Adding DNSSEC-related RRTYPEs [#40](https://github.com/kazu-yamamoto/dns/pull/40) 2.0.5 - Supporting DNS-SEC AD (authenticated data). [#38](https://github.com/kazu-yamamoto/dns/pull/38) - Removing the dependency to blaze-builder. 2.0.4 - Renaming a variable to fix preprocessor conflicts [#37](https://github.com/kazu-yamamoto/dns/pull/37) 2.0.3 - Handle invalid opcodes gracefully. [#36](https://github.com/kazu-yamamoto/dns/pull/36) 2.0.2 - Providing a new API: decodeMany. 2.0.1 - Updating document. 2.0.0 - DNSMessage is now monomorphic - RDATA is now monomorphic - Removed traversal instance for DNSMessage - EDNS0 encoding/decoding is now supported - Removed dnsMapWithType and dnsTraverseWithType functions - responseA and responseAAAA now take lists of IP addresses as their arguments - DNSHeader type no longer has qdCount, anCount, nsCount, and arCount fields dns-2.0.8/dns.cabal0000644000000000000000000000712613002260502012237 0ustar0000000000000000Name: dns Version: 2.0.8 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 License-File: LICENSE Synopsis: DNS library in Haskell Description: A thread-safe DNS library for both clients and servers written in pure Haskell. Category: Network Cabal-Version: >= 1.10 Build-Type: Simple Extra-Source-Files: Changelog Library Default-Language: Haskell2010 GHC-Options: -Wall Exposed-Modules: Network.DNS Network.DNS.Lookup Network.DNS.Resolver Network.DNS.Utils Network.DNS.Types Network.DNS.Encode Network.DNS.Decode Other-Modules: Network.DNS.Internal Network.DNS.StateBinary if impl(ghc >= 7) Build-Depends: base >= 4 && < 5 , attoparsec , binary , bytestring , bytestring-builder , conduit >= 1.1 , conduit-extra >= 1.1 , containers , iproute >= 1.3.2 , mtl , network >= 2.3 , random , resourcet , safe == 0.3.* else Build-Depends: base >= 4 && < 5 , attoparsec , binary , bytestring , bytestring-builder , conduit >= 1.1 , conduit-extra >= 1.1 , containers , iproute >= 1.2.4 , mtl , network , network-bytestring , random , resourcet , safe == 0.3.* Test-Suite network Type: exitcode-stdio-1.0 Default-Language: Haskell2010 Hs-Source-Dirs: test2 Ghc-Options: -Wall Main-Is: Spec.hs Other-Modules: LookupSpec Build-Depends: dns , base , bytestring , bytestring-builder , hspec Test-Suite spec Type: exitcode-stdio-1.0 Default-Language: Haskell2010 Hs-Source-Dirs: test, . Ghc-Options: -Wall Main-Is: Spec.hs Other-Modules: EncodeSpec DecodeSpec Build-Depends: base , attoparsec , binary , bytestring , bytestring-builder , conduit >= 1.1 , conduit-extra >= 1.1 , containers , dns , hspec , iproute >= 1.2.4 , mtl , network >= 2.3 , random , resourcet , safe == 0.3.* , word8 Test-Suite doctest Type: exitcode-stdio-1.0 Default-Language: Haskell2010 Hs-Source-Dirs: test2 Ghc-Options: -Wall Main-Is: doctests.hs Build-Depends: base , doctest Source-Repository head Type: git Location: git://github.com/kazu-yamamoto/dns.git dns-2.0.8/LICENSE0000644000000000000000000000276513002260502011500 0ustar0000000000000000Copyright (c) 2009, IIJ Innovation Institute Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. dns-2.0.8/Setup.hs0000644000000000000000000000005613002260502012116 0ustar0000000000000000import Distribution.Simple main = defaultMain dns-2.0.8/Network/0000755000000000000000000000000013002260502012112 5ustar0000000000000000dns-2.0.8/Network/DNS.hs0000644000000000000000000000266313002260502013101 0ustar0000000000000000-- | A thread-safe DNS library for both clients and servers written -- in pure Haskell. -- The Network.DNS module re-exports all other exposed modules for -- convenience. -- Applications will most likely use the high-level interface, while -- library/daemon authors may need to use the lower-level one. -- EDNS0 and TCP fallback are not supported yet. -- module Network.DNS ( -- * High level module Network.DNS.Lookup -- | The "Network.DNS.Lookup" module contains simple functions to -- perform various DNS lookups. If you simply want to resolve a -- hostname ('lookupA'), or find a domain's MX record -- ('lookupMX'), this is the easiest way to do it. , module Network.DNS.Resolver -- | The "Network.DNS.Resolver" module is slightly more low-level -- than "Network.DNS.Lookup". If you need to do something unusual, -- you may need to use the 'lookup', 'lookupAuth', or 'lookupRaw' -- functions. , module Network.DNS.Utils -- | The "Network.DNS.Utils" module contains utility functions used -- for processing DNS data. , module Network.DNS.Types -- | All of the types that the other modules use. -- * Low level , module Network.DNS.Decode -- | Decoding a response. , module Network.DNS.Encode -- | Encoding a query. ) where import Network.DNS.Lookup import Network.DNS.Resolver import Network.DNS.Utils import Network.DNS.Types import Network.DNS.Decode import Network.DNS.Encode dns-2.0.8/Network/DNS/0000755000000000000000000000000013002260502012536 5ustar0000000000000000dns-2.0.8/Network/DNS/Decode.hs0000644000000000000000000002315113002260502014257 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, CPP #-} module Network.DNS.Decode ( decode , decodeMany , receive ) where import Control.Applicative (many) import Control.Monad (replicateM) import Control.Monad.Trans.Resource (ResourceT, runResourceT) import qualified Control.Exception as ControlException import Data.Bits ((.&.), shiftR, testBit) import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy as BL import Data.Conduit (($$), Source) import Data.Conduit.Network (sourceSocket) import Data.IP (IP(..), toIPv4, toIPv6b) import Data.Typeable (Typeable) import Data.Word (Word16) import Network (Socket) import Network.DNS.Internal import Network.DNS.StateBinary import qualified Safe #if __GLASGOW_HASKELL__ < 709 import Control.Applicative #endif ---------------------------------------------------------------- data RDATAParseError = RDATAParseError String deriving (Show, Typeable) instance ControlException.Exception RDATAParseError -- | Receiving DNS data from 'Socket' and parse it. receive :: Socket -> IO DNSMessage receive = receiveDNSFormat . sourceSocket ---------------------------------------------------------------- -- | Parsing DNS data. decode :: BL.ByteString -> Either String DNSMessage decode bs = fst <$> runSGet decodeResponse bs -- | Parse many length-encoded DNS records, for example, from TCP traffic. decodeMany :: BL.ByteString -> Either String ([DNSMessage], BL.ByteString) decodeMany bs = do ((bss, _), leftovers) <- runSGetWithLeftovers lengthEncoded bs msgs <- mapM decode bss return (msgs, leftovers) where -- Read a list of length-encoded lazy bytestrings lengthEncoded :: SGet [BL.ByteString] lengthEncoded = many $ do len <- getInt16 fmap BL.fromStrict (getNByteString len) ---------------------------------------------------------------- receiveDNSFormat :: Source (ResourceT IO) ByteString -> IO DNSMessage receiveDNSFormat src = fst <$> runResourceT (src $$ sink) where sink = sinkSGet decodeResponse ---------------------------------------------------------------- decodeResponse :: SGet DNSMessage decodeResponse = do (hd,qdCount,anCount,nsCount,arCount) <- decodeHeader DNSMessage hd <$> decodeQueries qdCount <*> decodeRRs anCount <*> decodeRRs nsCount <*> decodeRRs arCount ---------------------------------------------------------------- decodeFlags :: SGet DNSFlags decodeFlags = do word <- get16 maybe (fail "Unsupported flags") pure (toFlags word) where toFlags :: Word16 -> Maybe DNSFlags toFlags flgs = do opcode_ <- getOpcode flgs rcode_ <- getRcode flgs return $ DNSFlags (getQorR flgs) opcode_ (getAuthAnswer flgs) (getTrunCation flgs) (getRecDesired flgs) (getRecAvailable flgs) rcode_ (getAuthenData flgs) getQorR w = if testBit w 15 then QR_Response else QR_Query getOpcode w = Safe.toEnumMay (fromIntegral (shiftR w 11 .&. 0x0f)) getAuthAnswer w = testBit w 10 getTrunCation w = testBit w 9 getRecDesired w = testBit w 8 getRecAvailable w = testBit w 7 getRcode w = Safe.toEnumMay (fromIntegral (w .&. 0x0f)) getAuthenData w = testBit w 5 ---------------------------------------------------------------- decodeHeader :: SGet (DNSHeader,Int,Int,Int,Int) decodeHeader = do hd <- DNSHeader <$> decodeIdentifier <*> decodeFlags qdCount <- decodeQdCount anCount <- decodeAnCount nsCount <- decodeNsCount arCount <- decodeArCount pure (hd ,qdCount ,anCount ,nsCount ,arCount ) where decodeIdentifier = getInt16 decodeQdCount = getInt16 decodeAnCount = getInt16 decodeNsCount = getInt16 decodeArCount = getInt16 ---------------------------------------------------------------- decodeQueries :: Int -> SGet [Question] decodeQueries n = replicateM n decodeQuery decodeType :: SGet TYPE decodeType = intToType <$> getInt16 decodeOptType :: SGet OPTTYPE decodeOptType = intToOptType <$> getInt16 decodeQuery :: SGet Question decodeQuery = Question <$> decodeDomain <*> decodeType <* ignoreClass decodeRRs :: Int -> SGet [ResourceRecord] decodeRRs n = replicateM n decodeRR decodeRR :: SGet ResourceRecord decodeRR = do dom <- decodeDomain typ <- decodeType decodeRR' dom typ where decodeRR' _ OPT = do udps <- decodeUDPSize _ <- decodeERCode ver <- decodeOPTVer dok <- decodeDNSOK len <- decodeRLen dat <- decodeRData OPT len return OptRecord { orudpsize = udps , ordnssecok = dok , orversion = ver , rdata = dat } decodeRR' dom t = do ignoreClass ttl <- decodeTTL len <- decodeRLen dat <- decodeRData t len return ResourceRecord { rrname = dom , rrtype = t , rrttl = ttl , rdata = dat } decodeUDPSize = fromIntegral <$> getInt16 decodeERCode = getInt8 decodeOPTVer = fromIntegral <$> getInt8 decodeDNSOK = flip testBit 15 <$> getInt16 decodeTTL = fromIntegral <$> get32 decodeRLen = getInt16 decodeRData :: TYPE -> Int -> SGet RData decodeRData NS _ = RD_NS <$> decodeDomain decodeRData MX _ = RD_MX <$> decodePreference <*> decodeDomain where decodePreference = getInt16 decodeRData CNAME _ = RD_CNAME <$> decodeDomain decodeRData DNAME _ = RD_DNAME <$> decodeDomain decodeRData TXT len = (RD_TXT . ignoreLength) <$> getNByteString len where ignoreLength = BS.tail decodeRData A len | len == 4 = (RD_A . toIPv4) <$> getNBytes len | otherwise = fail "IPv4 addresses must be 4 bytes long" decodeRData AAAA len | len == 16 = (RD_AAAA . toIPv6b) <$> getNBytes len | otherwise = fail "IPv6 addresses must be 16 bytes long" decodeRData SOA _ = RD_SOA <$> decodeDomain <*> decodeDomain <*> decodeSerial <*> decodeRefesh <*> decodeRetry <*> decodeExpire <*> decodeMinumun where decodeSerial = getInt32 decodeRefesh = getInt32 decodeRetry = getInt32 decodeExpire = getInt32 decodeMinumun = getInt32 decodeRData PTR _ = RD_PTR <$> decodeDomain decodeRData SRV _ = RD_SRV <$> decodePriority <*> decodeWeight <*> decodePort <*> decodeDomain where decodePriority = getInt16 decodeWeight = getInt16 decodePort = getInt16 decodeRData OPT ol = RD_OPT <$> decode' ol where decode' :: Int -> SGet [OData] decode' l | l < 0 = fail "decodeOPTData: length inconsistency" | l == 0 = pure [] | otherwise = do optCode <- decodeOptType optLen <- getInt16 dat <- decodeOData optCode optLen (dat:) <$> decode' (l - optLen - 4) -- decodeRData TLSA len = RD_TLSA <$> decodeUsage <*> decodeSelector <*> decodeMType <*> decodeADF where decodeUsage = getInt8 decodeSelector = getInt8 decodeMType = getInt8 decodeADF = getNByteString (len - 3) decodeRData _ len = RD_OTH <$> getNByteString len decodeOData :: OPTTYPE -> Int -> SGet OData decodeOData ClientSubnet len = do fam <- getInt16 srcMask <- getInt8 scpMask <- getInt8 rawip <- fmap fromIntegral . B.unpack <$> getNByteString (len - 4) -- 4 = 2 + 1 + 1 ip <- case fam of 1 -> pure . IPv4 . toIPv4 $ take 4 (rawip ++ repeat 0) 2 -> pure . IPv6 . toIPv6b $ take 16 (rawip ++ repeat 0) _ -> fail "Unsupported address family" pure $ OD_ClientSubnet srcMask scpMask ip decodeOData (OUNKNOWN i) len = OD_Unknown i <$> getNByteString len ---------------------------------------------------------------- decodeDomain :: SGet Domain decodeDomain = do pos <- getPosition c <- getInt8 let n = getValue c -- Syntax hack to avoid using MultiWayIf case () of _ | c == 0 -> return "." -- Perhaps the root domain? _ | isPointer c -> do d <- getInt8 let offset = n * 256 + d mo <- pop offset case mo of Nothing -> fail $ "decodeDomain: " ++ show offset -- A pointer may refer to another pointer. -- So, register this position for the domain. Just o -> push pos o >> return o -- As for now, extended labels have no use. -- This may change some time in the future. _ | isExtLabel c -> return "" _ | otherwise -> do hs <- getNByteString n ds <- decodeDomain let dom = case ds of -- avoid trailing ".." "." -> hs `BS.append` "." _ -> hs `BS.append` "." `BS.append` ds push pos dom return dom where getValue c = c .&. 0x3f isPointer c = testBit c 7 && testBit c 6 isExtLabel c = (not $ testBit c 7) && testBit c 6 ignoreClass :: SGet () ignoreClass = () <$ get16 dns-2.0.8/Network/DNS/Encode.hs0000644000000000000000000001751513002260502014300 0ustar0000000000000000{-# LANGUAGE RecordWildCards, CPP #-} module Network.DNS.Encode ( encode , composeQuery , composeQueryAD ) where import Control.Monad (when) import Control.Monad.State (State, modify, execState, gets) import Data.Binary (Word16) import Data.Bits ((.|.), bit, shiftL, setBit) import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy as BL import Data.ByteString.Lazy.Char8 (ByteString) import Data.IP (IP(..),fromIPv4, fromIPv6b) import Data.List (dropWhileEnd) import Data.Monoid ((<>)) import Network.DNS.Internal import Network.DNS.StateBinary #if __GLASGOW_HASKELL__ < 709 import Data.Monoid (mconcat) #endif ---------------------------------------------------------------- -- | Composing query. First argument is a number to identify response. composeQuery :: Int -> [Question] -> ByteString composeQuery idt qs = encode qry where hdr = header defaultQuery qry = defaultQuery { header = hdr { identifier = idt } , question = qs } composeQueryAD :: Int -> [Question] -> ByteString composeQueryAD idt qs = encode qry where hdr = header defaultQuery flg = flags hdr qry = defaultQuery { header = hdr { identifier = idt, flags = flg { authenData = True } } , question = qs } ---------------------------------------------------------------- -- | Composing DNS data. encode :: DNSMessage -> ByteString encode msg = runSPut (encodeDNSMessage msg) ---------------------------------------------------------------- encodeDNSMessage :: DNSMessage -> SPut encodeDNSMessage msg = encodeHeader hdr <> encodeNums <> mconcat (map encodeQuestion qs) <> mconcat (map encodeRR an) <> mconcat (map encodeRR au) <> mconcat (map encodeRR ad) where encodeNums = mconcat $ fmap putInt16 [length qs ,length an ,length au ,length ad ] hdr = header msg qs = question msg an = answer msg au = authority msg ad = additional msg encodeHeader :: DNSHeader -> SPut encodeHeader hdr = encodeIdentifier (identifier hdr) <> encodeFlags (flags hdr) where encodeIdentifier = putInt16 encodeFlags :: DNSFlags -> SPut encodeFlags DNSFlags{..} = put16 word where 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 authenData $ set (bit 5) , 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 putRData :: RData -> SPut putRData rd = do addPositionW 2 -- "simulate" putInt16 rDataBuilder <- encodeRDATA rd -- fixmed: SPut must hold length let rdataLength = fromIntegral . BL.length . BB.toLazyByteString $ rDataBuilder let rlenBuilder = BB.int16BE rdataLength return rlenBuilder <> return rDataBuilder encodeRR :: ResourceRecord -> SPut encodeRR ResourceRecord{..} = mconcat [ encodeDomain rrname , putInt16 (typeToInt rrtype) , put16 1 , putInt32 rrttl , putRData rdata ] encodeRR OptRecord{..} = mconcat [ encodeDomain BS.empty , putInt16 (typeToInt OPT) , putInt16 orudpsize , putInt32 $ if ordnssecok then setBit 0 15 else 0 , putRData rdata ] encodeRDATA :: RData -> SPut encodeRDATA rd = case rd of (RD_A ip) -> mconcat $ map putInt8 (fromIPv4 ip) (RD_AAAA ip) -> mconcat $ map putInt8 (fromIPv6b ip) (RD_NS dom) -> encodeDomain dom (RD_CNAME dom) -> encodeDomain dom (RD_DNAME dom) -> encodeDomain dom (RD_PTR dom) -> encodeDomain dom (RD_MX prf dom) -> mconcat [putInt16 prf, encodeDomain dom] (RD_TXT txt) -> putByteStringWithLength txt (RD_OTH bytes) -> putByteString bytes (RD_OPT opts) -> mconcat $ fmap encodeOData opts (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 ] (RD_TLSA u s m d) -> mconcat [ putInt8 u , putInt8 s , putInt8 m , putByteString d ] encodeOData :: OData -> SPut encodeOData (OD_ClientSubnet srcNet scpNet ip) = let dropZeroes = dropWhileEnd (==0) (fam,raw) = case ip of IPv4 ip4 -> (1,dropZeroes $ fromIPv4 ip4) IPv6 ip6 -> (2,dropZeroes $ fromIPv6b ip6) dataLen = 2 + 2 + length raw in mconcat [putInt16 (optTypeToInt ClientSubnet) ,putInt16 dataLen ,putInt16 fam ,putInt8 srcNet ,putInt8 scpNet ,mconcat $ fmap putInt8 raw ] encodeOData (OD_Unknown code bs) = mconcat [putInt16 code ,putInt16 $ BS.length bs ,putByteString bs ] -- In the case of the TXT record, we need to put the string length putByteStringWithLength :: BS.ByteString -> SPut putByteStringWithLength bs = putInt8 (fromIntegral $ BS.length bs) -- put the length of the given string <> putByteString bs ---------------------------------------------------------------- rootDomain :: Domain rootDomain = BS.pack "." encodeDomain :: Domain -> SPut encodeDomain dom | (BS.null dom || dom == rootDomain) = put8 0 | otherwise = do mpos <- wsPop dom cur <- gets wsPosition case mpos of Just pos -> encodePointer pos Nothing -> wsPush dom cur >> mconcat [ encodePartialDomain hd , encodeDomain tl ] where (hd, tl') = BS.break (=='.') dom tl = if BS.null tl' then tl' else BS.drop 1 tl' encodePointer :: Int -> SPut encodePointer pos = putInt16 (pos .|. 0xc000) encodePartialDomain :: Domain -> SPut encodePartialDomain = putByteStringWithLength dns-2.0.8/Network/DNS/Internal.hs0000644000000000000000000002104413002260502014647 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Network.DNS.Internal where import Control.Exception (Exception) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Builder as L import qualified Data.ByteString.Lazy as L import Data.IP (IP, IPv4, IPv6) import Data.Maybe (fromMaybe) import Data.Typeable (Typeable) ---------------------------------------------------------------- -- | Type for domain. type Domain = ByteString ---------------------------------------------------------------- -- | Types for resource records. data TYPE = A | AAAA | NS | TXT | MX | CNAME | SOA | PTR | SRV | DNAME | OPT | DS | RRSIG | NSEC | DNSKEY | NSEC3 | NSEC3PARAM | TLSA | CDS | CDNSKEY | CSYNC | UNKNOWN Int deriving (Eq, Show, Read) -- https://www.iana.org/assignments/dns-parameters/dns-parameters.xhtml#dns-parameters-4 -- rrDB :: [(TYPE, Int)] rrDB = [ (A, 1) , (NS, 2) , (CNAME, 5) , (SOA, 6) , (PTR, 12) , (MX, 15) , (TXT, 16) , (AAAA, 28) , (SRV, 33) , (DNAME, 39) -- RFC 6672 , (OPT, 41) -- RFC 6891 , (DS, 43) -- RFC 4034 , (RRSIG, 46) -- RFC 4034 , (NSEC, 47) -- RFC 4034 , (DNSKEY, 48) -- RFC 4034 , (NSEC3, 40) -- RFC 5155 , (NSEC3PARAM, 51) -- RFC 5155 , (TLSA, 52) -- RFC 6698 , (CDS, 59) -- RFC 7344 , (CDNSKEY, 60) -- RFC 7344 , (CSYNC, 62) -- RFC 7477 ] data OPTTYPE = ClientSubnet | OUNKNOWN Int deriving (Eq) orDB :: [(OPTTYPE, Int)] orDB = [ (ClientSubnet, 8) ] rookup :: (Eq b) => b -> [(a,b)] -> Maybe a rookup _ [] = Nothing rookup key ((x,y):xys) | key == y = Just x | otherwise = rookup key xys intToType :: Int -> TYPE intToType n = fromMaybe (UNKNOWN n) $ rookup n rrDB typeToInt :: TYPE -> Int typeToInt (UNKNOWN x) = x typeToInt t = fromMaybe (error "typeToInt") $ lookup t rrDB intToOptType :: Int -> OPTTYPE intToOptType n = fromMaybe (OUNKNOWN n) $ rookup n orDB optTypeToInt :: OPTTYPE -> Int optTypeToInt (OUNKNOWN x) = x optTypeToInt t = fromMaybe (error "optTypeToInt") $ lookup t orDB ---------------------------------------------------------------- -- | An enumeration of all possible DNS errors that can occur. data DNSError = -- | The sequence number of the answer doesn't match our query. This -- could indicate foul play. SequenceNumberMismatch -- | The request simply timed out. | TimeoutExpired -- | The answer has the correct sequence number, but returned an -- unexpected RDATA format. | UnexpectedRDATA -- | The domain for query is illegal. | IllegalDomain -- | The name server was unable to interpret the query. | FormatError -- | The name server was unable to process this query due to a -- problem with the name server. | ServerFailure -- | Meaningful only for responses from an authoritative name -- server, this code signifies that the -- domain name referenced in the query does not exist. | NameError -- | The name server does not support the requested kind of query. | NotImplemented -- | The name server refuses to perform the specified operation for -- policy reasons. For example, a name -- server may not wish to provide the -- information to the particular requester, -- or a name server may not wish to perform -- a particular operation (e.g., zone transfer) for particular data. | OperationRefused -- | The server detected a malformed OPT RR. | BadOptRecord deriving (Eq, Show, Typeable) instance Exception DNSError -- | Raw data format for DNS Query and Response. data DNSMessage = DNSMessage { header :: DNSHeader , question :: [Question] , answer :: [ResourceRecord] , authority :: [ResourceRecord] , additional :: [ResourceRecord] } deriving (Eq, Show) -- | For backward compatibility. type DNSFormat = DNSMessage -- | Raw data format for the header of DNS Query and Response. data DNSHeader = DNSHeader { identifier :: Int , flags :: DNSFlags } deriving (Eq, Show) -- | Raw data format for the flags of DNS Query and Response. data DNSFlags = DNSFlags { qOrR :: QorR , opcode :: OPCODE , authAnswer :: Bool , trunCation :: Bool , recDesired :: Bool , recAvailable :: Bool , rcode :: RCODE , authenData :: Bool } deriving (Eq, Show) ---------------------------------------------------------------- data QorR = QR_Query | QR_Response deriving (Eq, Show) data OPCODE = OP_STD | OP_INV | OP_SSR deriving (Eq, Show, Enum, Bounded) data RCODE = NoErr | FormatErr | ServFail | NameErr | NotImpl | Refused | BadOpt deriving (Eq, Ord, Show, Enum, Bounded) ---------------------------------------------------------------- -- | Raw data format for DNS questions. data Question = Question { qname :: Domain , qtype :: TYPE } deriving (Eq, Show) -- | Making "Question". makeQuestion :: Domain -> TYPE -> Question makeQuestion = Question ---------------------------------------------------------------- -- | Raw data format for resource records. data ResourceRecord = ResourceRecord { rrname :: Domain , rrtype :: TYPE , rrttl :: Int , rdata :: RData } | OptRecord { orudpsize :: Int , ordnssecok :: Bool , orversion :: Int , rdata :: RData } deriving (Eq,Show) -- | Raw data format for each type. data RData = RD_NS Domain | RD_CNAME Domain | RD_DNAME 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_SRV Int Int Int Domain | RD_OPT [OData] | RD_OTH ByteString | RD_TLSA Int Int Int ByteString deriving (Eq, Ord) instance Show RData where show (RD_NS dom) = BS.unpack dom show (RD_MX prf dom) = show prf ++ " " ++ BS.unpack dom show (RD_CNAME dom) = BS.unpack dom show (RD_DNAME dom) = BS.unpack dom show (RD_A a) = show a 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_SRV pri wei prt dom) = show pri ++ " " ++ show wei ++ " " ++ show prt ++ BS.unpack dom show (RD_OPT od) = show od show (RD_OTH is) = show is show (RD_TLSA use sel mtype dgst) = show use ++ " " ++ show sel ++ " " ++ show mtype ++ " " ++ (BS.unpack $ L.toStrict . L.toLazyByteString . L.byteStringHex $ dgst) data OData = OD_ClientSubnet Int Int IP | OD_Unknown Int ByteString deriving (Eq,Show,Ord) ---------------------------------------------------------------- defaultQuery :: DNSMessage defaultQuery = DNSMessage { header = DNSHeader { identifier = 0 , flags = DNSFlags { qOrR = QR_Query , opcode = OP_STD , authAnswer = False , trunCation = False , recDesired = True , recAvailable = False , rcode = NoErr , authenData = False } } , question = [] , answer = [] , authority = [] , additional = [] } defaultResponse :: DNSMessage defaultResponse = let hd = header defaultQuery flg = flags hd in defaultQuery { header = hd { flags = flg { qOrR = QR_Response , authAnswer = True , recAvailable = True , authenData = False } } } responseA :: Int -> Question -> [IPv4] -> DNSMessage responseA ident q ips = let hd = header defaultResponse dom = qname q an = fmap (ResourceRecord dom A 300 . RD_A) ips in defaultResponse { header = hd { identifier=ident } , question = [q] , answer = an } responseAAAA :: Int -> Question -> [IPv6] -> DNSMessage responseAAAA ident q ips = let hd = header defaultResponse dom = qname q an = fmap (ResourceRecord dom AAAA 300 . RD_AAAA) ips in defaultResponse { header = hd { identifier=ident } , question = [q] , answer = an } dns-2.0.8/Network/DNS/Lookup.hs0000644000000000000000000003530513002260502014351 0ustar0000000000000000-- | Simple, high-level DNS lookup functions. -- -- All of the lookup functions necessary run in IO, since they -- interact with the network. The return types are similar, but -- differ in what can be returned from a successful lookup. -- -- We can think of the return type as \"either what I asked for, or -- an error\". For example, the 'lookupA' function, if successful, -- will return a list of 'IPv4'. The 'lookupMX' function will -- instead return a list of @('Domain',Int)@ pairs, where each pair -- represents a hostname and its associated priority. -- -- The order of multiple results may not be consistent between -- lookups. If you require consistent results, apply -- 'Data.List.sort' to the returned list. -- -- The errors that can occur are the same for all lookups. Namely: -- -- * Timeout -- -- * Wrong sequence number (foul play?) -- -- * Unexpected data in the response -- -- If an error occurs, you should be able to pattern match on the -- 'DNSError' constructor to determine which of these is the case. -- -- /Note/: A result of \"no records\" is not considered an -- error. If you perform, say, an \'AAAA\' lookup for a domain with -- no such records, the \"success\" result would be @Right []@. -- -- We perform a successful lookup of \"www.example.com\": -- -- >>> let hostname = Data.ByteString.Char8.pack "www.example.com" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> withResolver rs $ \resolver -> lookupA resolver hostname -- Right [93.184.216.34] -- -- The only error that we can easily cause is a timeout. We do this -- by creating and utilizing a 'ResolvConf' which has a timeout of -- one millisecond: -- -- >>> let hostname = Data.ByteString.Char8.pack "www.example.com" -- >>> let badrc = defaultResolvConf { resolvTimeout = 1 } -- >>> -- >>> rs <- makeResolvSeed badrc -- >>> withResolver rs $ \resolver -> lookupA resolver hostname -- Left TimeoutExpired -- -- As is the convention, successful results will always be wrapped -- in a 'Right', while errors will be wrapped in a 'Left'. -- -- For convenience, you may wish to enable GHC's OverloadedStrings -- extension. This will allow you to avoid calling -- 'Data.ByteString.Char8.pack' on each domain name. See -- -- for more information. -- module Network.DNS.Lookup ( lookupA, lookupAAAA , lookupMX, lookupAviaMX, lookupAAAAviaMX , lookupNS , lookupNSAuth , lookupTXT , lookupPTR , lookupRDNS , lookupSRV ) where import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS import Data.IP (IPv4, IPv6) import Network.DNS.Resolver as DNS import Network.DNS.Types ---------------------------------------------------------------- -- | Look up all \'A\' records for the given hostname. -- -- A straightforward example: -- -- >>> let hostname = Data.ByteString.Char8.pack "www.mew.org" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> withResolver rs $ \resolver -> lookupA resolver hostname -- Right [210.130.207.72] -- -- This function will also follow a CNAME and resolve its target if -- one exists for the queries hostname: -- -- >>> let hostname = Data.ByteString.Char8.pack "www.kame.net" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> withResolver rs $ \resolver -> lookupA resolver hostname -- Right [203.178.141.194] -- lookupA :: Resolver -> Domain -> IO (Either DNSError [IPv4]) lookupA rlv dom = do erds <- DNS.lookup rlv dom A case erds of -- See lookupXviaMX for an explanation of this construct. Left err -> return (Left err) Right rds -> return $ mapM unTag rds where unTag :: RData -> Either DNSError IPv4 unTag (RD_A x) = Right x unTag _ = Left UnexpectedRDATA -- | Look up all (IPv6) \'AAAA\' records for the given hostname. -- -- Examples: -- -- >>> let hostname = Data.ByteString.Char8.pack "www.wide.ad.jp" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> withResolver rs $ \resolver -> lookupAAAA resolver hostname -- Right [2001:200:dff:fff1:216:3eff:fe4b:651c] -- lookupAAAA :: Resolver -> Domain -> IO (Either DNSError [IPv6]) lookupAAAA rlv dom = do erds <- DNS.lookup rlv dom AAAA case erds of -- See lookupXviaMX for an explanation of this construct. Left err -> return (Left err) Right rds -> return $ mapM unTag rds where unTag :: RData -> Either DNSError IPv6 unTag (RD_AAAA x) = Right x unTag _ = Left UnexpectedRDATA ---------------------------------------------------------------- -- | Look up all \'MX\' records for the given hostname. Two parts -- constitute an MX record: a hostname , and an integer priority. We -- therefore return each record as a @('Domain', Int)@. -- -- In this first example, we look up the MX for the domain -- \"example.com\". It has no MX (to prevent a deluge of spam from -- examples posted on the internet). But remember, \"no results\" is -- still a successful result. -- -- >>> let hostname = Data.ByteString.Char8.pack "example.com" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> withResolver rs $ \resolver -> lookupMX resolver hostname -- Right [] -- -- The domain \"mew.org\" does however have a single MX: -- -- >>> let hostname = Data.ByteString.Char8.pack "mew.org" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> withResolver rs $ \resolver -> lookupMX resolver hostname -- Right [("mail.mew.org.",10)] -- -- Also note that all hostnames are returned with a trailing dot to -- indicate the DNS root. -- lookupMX :: Resolver -> Domain -> IO (Either DNSError [(Domain,Int)]) lookupMX rlv dom = do erds <- DNS.lookup rlv dom MX case erds of -- See lookupXviaMX for an explanation of this construct. Left err -> return (Left err) Right rds -> return $ mapM unTag rds where unTag :: RData -> Either DNSError (Domain,Int) unTag (RD_MX pr dm) = Right (dm,pr) unTag _ = Left UnexpectedRDATA -- | Look up all \'MX\' records for the given hostname, and then -- resolve their hostnames to IPv4 addresses by calling -- 'lookupA'. The priorities are not retained. -- -- Examples: -- -- >>> import Data.List (sort) -- >>> let hostname = Data.ByteString.Char8.pack "wide.ad.jp" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> ips <- withResolver rs $ \resolver -> lookupAviaMX resolver hostname -- >>> fmap sort ips -- Right [133.138.10.34,203.178.136.49] -- -- Since there is more than one result, it is necessary to sort the -- list in order to check for equality. -- lookupAviaMX :: Resolver -> Domain -> IO (Either DNSError [IPv4]) lookupAviaMX rlv dom = lookupXviaMX rlv dom (lookupA rlv) -- | Look up all \'MX\' records for the given hostname, and then -- resolve their hostnames to IPv6 addresses by calling -- 'lookupAAAA'. The priorities are not retained. -- lookupAAAAviaMX :: Resolver -> Domain -> IO (Either DNSError [IPv6]) lookupAAAAviaMX rlv dom = lookupXviaMX rlv dom (lookupAAAA rlv) lookupXviaMX :: Resolver -> Domain -> (Domain -> IO (Either DNSError [a])) -> IO (Either DNSError [a]) lookupXviaMX rlv dom func = do edps <- lookupMX rlv dom case edps of -- We have to deconstruct and reconstruct the error so that the -- typechecker does not conclude that a ~ (Domain, Int). Left err -> return (Left err) Right dps -> do -- We'll get back a [Either DNSError a] here. responses <- mapM (func . fst) dps -- We can use 'sequence' to join all of the Eithers -- together. If any of them are (Left _), we'll get a Left -- overall. Otherwise, we'll get Right [a]. let overall = sequence responses -- Finally, we use (fmap concat) to concatenate the responses -- if there were no errors. return $ fmap concat overall ---------------------------------------------------------------- -- | This function performs the real work for both 'lookupNS' and -- 'lookupNSAuth'. The only difference between those two is which -- function, 'lookup' or 'lookupAuth', is used to perform the -- lookup. We take either of those as our first parameter. lookupNSImpl :: (Resolver -> Domain -> TYPE -> IO (Either DNSError [RData])) -> Resolver -> Domain -> IO (Either DNSError [Domain]) lookupNSImpl lookup_function rlv dom = do erds <- lookup_function rlv dom NS case erds of -- See lookupXviaMX for an explanation of this construct. Left err -> return (Left err) Right rds -> return $ mapM unTag rds where unTag :: RData -> Either DNSError Domain unTag (RD_NS dm) = Right dm unTag _ = Left UnexpectedRDATA -- | Look up all \'NS\' records for the given hostname. The results -- are taken from the ANSWER section of the response (as opposed to -- AUTHORITY). For details, see e.g. -- . -- -- There will typically be more than one name server for a -- domain. It is therefore extra important to sort the results if -- you prefer them to be at all deterministic. -- -- Examples: -- -- >>> import Data.List (sort) -- >>> let hostname = Data.ByteString.Char8.pack "mew.org" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> ns <- withResolver rs $ \resolver -> lookupNS resolver hostname -- >>> fmap sort ns -- Right ["ns1.mew.org.","ns2.mew.org."] -- lookupNS :: Resolver -> Domain -> IO (Either DNSError [Domain]) lookupNS = lookupNSImpl DNS.lookup -- | Look up all \'NS\' records for the given hostname. The results -- are taken from the AUTHORITY section of the response and not the -- usual ANSWER (use 'lookupNS' for that). For details, see e.g. -- . -- -- There will typically be more than one name server for a -- domain. It is therefore extra important to sort the results if -- you prefer them to be at all deterministic. -- -- For an example, we can look up the nameservers for -- \"example.com\" from one of the root servers, a.gtld-servers.net, -- the IP address of which was found beforehand: -- -- >>> import Data.List (sort) -- >>> let hostname = Data.ByteString.Char8.pack "example.com" -- >>> -- >>> let ri = RCHostName "192.5.6.30" -- a.gtld-servers.net -- >>> let rc = defaultResolvConf { resolvInfo = ri } -- >>> rs <- makeResolvSeed rc -- >>> ns <- withResolver rs $ \resolver -> lookupNSAuth resolver hostname -- >>> fmap sort ns -- Right ["a.iana-servers.net.","b.iana-servers.net."] -- lookupNSAuth :: Resolver -> Domain -> IO (Either DNSError [Domain]) lookupNSAuth = lookupNSImpl DNS.lookupAuth ---------------------------------------------------------------- -- | Look up all \'TXT\' records for the given hostname. The results -- are free-form 'ByteString's. -- -- Two common uses for \'TXT\' records are -- and -- . As an -- example, we find the SPF record for \"mew.org\": -- -- >>> let hostname = Data.ByteString.Char8.pack "mew.org" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> withResolver rs $ \resolver -> lookupTXT resolver hostname -- Right ["v=spf1 +mx -all"] -- lookupTXT :: Resolver -> Domain -> IO (Either DNSError [ByteString]) lookupTXT rlv dom = do erds <- DNS.lookup rlv dom TXT case erds of -- See lookupXviaMX for an explanation of this construct. Left err -> return (Left err) Right rds -> return $ mapM unTag rds where unTag :: RData -> Either DNSError ByteString unTag (RD_TXT x) = Right x unTag _ = Left UnexpectedRDATA ---------------------------------------------------------------- -- | Look up all \'PTR\' records for the given hostname. To perform a -- reverse lookup on an IP address, you must first reverse its -- octets and then append the suffix \".in-addr.arpa.\" -- -- We look up the PTR associated with the IP address -- 210.130.137.80, i.e., 80.137.130.210.in-addr.arpa: -- -- >>> let hostname = Data.ByteString.Char8.pack "164.2.232.202.in-addr.arpa" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> withResolver rs $ \resolver -> lookupPTR resolver hostname -- Right ["www.iij.ad.jp."] -- -- The 'lookupRDNS' function is more suited to this particular task. -- lookupPTR :: Resolver -> Domain -> IO (Either DNSError [Domain]) lookupPTR rlv dom = do erds <- DNS.lookup rlv dom PTR case erds of -- See lookupXviaMX for an explanation of this construct. Left err -> return (Left err) Right rds -> return $ mapM unTag rds where unTag :: RData -> Either DNSError Domain unTag (RD_PTR dm) = Right dm unTag _ = Left UnexpectedRDATA -- | Convenient wrapper around 'lookupPTR' to perform a reverse lookup -- on a single IP address. -- -- We repeat the example from 'lookupPTR', except now we pass the IP -- address directly: -- -- >>> let hostname = Data.ByteString.Char8.pack "202.232.2.164" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> withResolver rs $ \resolver -> lookupRDNS resolver hostname -- Right ["www.iij.ad.jp."] -- lookupRDNS :: Resolver -> Domain -> IO (Either DNSError [Domain]) lookupRDNS rlv ip = lookupPTR rlv dom where -- ByteString constants. dot = BS.pack "." suffix = BS.pack ".in-addr.arpa" octets = BS.split '.' ip reverse_ip = BS.intercalate dot (reverse octets) dom = reverse_ip `BS.append` suffix ---------------------------------------------------------------- -- | Look up all \'SRV\' records for the given hostname. A SRV record -- comprises four fields, -- -- * Priority (lower is more-preferred) -- -- * Weight (relative frequency with which to use this record -- amongst all results with the same priority) -- -- * Port (the port on which the service is offered) -- -- * Target (the hostname on which the service is offered) -- -- The first three are integral, and the target is another DNS -- hostname. We therefore return a four-tuple -- @(Int,Int,Int,'Domain')@. -- -- Examples: -- -- >>> let hostname = Data.ByteString.Char8.pack "_sip._tcp.cisco.com" -- >>> -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> withResolver rs $ \resolver -> lookupSRV resolver hostname -- Right [(1,0,5060,"vcsgw.cisco.com.")] -- lookupSRV :: Resolver -> Domain -> IO (Either DNSError [(Int,Int,Int,Domain)]) lookupSRV rlv dom = do erds <- DNS.lookup rlv dom SRV case erds of -- See lookupXviaMX for an explanation of this construct. Left err -> return (Left err) Right rds -> return $ mapM unTag rds where unTag :: RData -> Either DNSError (Int,Int,Int,Domain) unTag (RD_SRV pri wei prt dm) = Right (pri,wei,prt,dm) unTag _ = Left UnexpectedRDATA dns-2.0.8/Network/DNS/Resolver.hs0000644000000000000000000003122713002260502014700 0ustar0000000000000000{-# LANGUAGE CPP, OverloadedStrings #-} -- | DNS Resolver and generic (lower-level) lookup functions. module Network.DNS.Resolver ( -- * Documentation -- ** Configuration for resolver FileOrNumericHost(..), ResolvConf(..), defaultResolvConf -- ** Intermediate data type for resolver , ResolvSeed, makeResolvSeed -- ** Type and function for resolver , Resolver(..), withResolver, withResolvers -- ** Looking up functions , lookup , lookupAuth -- ** Raw looking up function , lookupRaw , lookupRawAD , fromDNSMessage , fromDNSFormat ) where import Control.Exception (bracket) import Data.Char (isSpace) import Data.List (isPrefixOf) import Data.Maybe (fromMaybe) import Network.BSD (getProtocolNumber) import Network.DNS.Decode import Network.DNS.Encode import Network.DNS.Internal import qualified Data.ByteString.Char8 as BS import Network.Socket (HostName, Socket, SocketType(Datagram), close, socket, connect) import Network.Socket (AddrInfoFlag(..), AddrInfo(..), SockAddr(..), PortNumber(..), defaultHints, getAddrInfo) import Prelude hiding (lookup) import System.Random (getStdRandom, randomR) import System.Timeout (timeout) #if __GLASGOW_HASKELL__ < 709 import Control.Applicative ((<$>), (<*>), pure) #endif #if mingw32_HOST_OS == 1 import Network.Socket (send) import qualified Data.ByteString.Lazy.Char8 as LB import Control.Monad (when) #else import Network.Socket.ByteString.Lazy (sendAll) #endif ---------------------------------------------------------------- -- | Union type for 'FilePath' and 'HostName'. Specify 'FilePath' to -- \"resolv.conf\" or numeric IP address in 'String' form. -- -- /Warning/: Only numeric IP addresses are valid @RCHostName@s. -- -- Example (using Google's public DNS cache): -- -- >>> let cache = RCHostName "8.8.8.8" -- data FileOrNumericHost = RCFilePath FilePath -- ^ A path for \"resolv.conf\" | RCHostName HostName -- ^ A numeric IP address | RCHostPort HostName PortNumber -- ^ A numeric IP address and port number -- | Type for resolver configuration. The easiest way to construct a -- @ResolvConf@ object is to modify the 'defaultResolvConf'. data ResolvConf = ResolvConf { resolvInfo :: FileOrNumericHost -- | Timeout in micro seconds. , resolvTimeout :: Int -- | The number of retries including the first try. , resolvRetry :: Int -- | This field was obsoleted. , resolvBufsize :: Integer } -- | Return a default 'ResolvConf': -- -- * 'resolvInfo' is 'RCFilePath' \"\/etc\/resolv.conf\". -- -- * 'resolvTimeout' is 3,000,000 micro seconds. -- -- * 'resolvRetry' is 3. -- -- * 'resolvBufsize' is 512. (obsoleted) -- -- Example (use Google's public DNS cache instead of resolv.conf): -- -- >>> let cache = RCHostName "8.8.8.8" -- >>> let rc = defaultResolvConf { resolvInfo = cache } -- defaultResolvConf :: ResolvConf defaultResolvConf = ResolvConf { resolvInfo = RCFilePath "/etc/resolv.conf" , resolvTimeout = 3 * 1000 * 1000 , resolvRetry = 3 , resolvBufsize = 512 } ---------------------------------------------------------------- -- | Abstract data type of DNS Resolver seed. -- When implementing a DNS cache, this should be re-used. data ResolvSeed = ResolvSeed { addrInfo :: AddrInfo , rsTimeout :: Int , rsRetry :: Int , rsBufsize :: Integer } -- | Abstract data type of DNS Resolver -- When implementing a DNS cache, this MUST NOT be re-used. data Resolver = Resolver { genId :: IO Int , dnsSock :: Socket , dnsTimeout :: Int , dnsRetry :: Int , dnsBufsize :: Integer } ---------------------------------------------------------------- -- | Make a 'ResolvSeed' from a 'ResolvConf'. -- -- Examples: -- -- >>> rs <- makeResolvSeed defaultResolvConf -- makeResolvSeed :: ResolvConf -> IO ResolvSeed makeResolvSeed conf = ResolvSeed <$> addr <*> pure (resolvTimeout conf) <*> pure (resolvRetry conf) <*> pure (resolvBufsize conf) where addr = case resolvInfo conf of RCHostName numhost -> makeAddrInfo numhost Nothing RCHostPort numhost mport -> makeAddrInfo numhost $ Just mport RCFilePath file -> toAddr <$> readFile file >>= \i -> makeAddrInfo i Nothing toAddr cs = let l:_ = filter ("nameserver" `isPrefixOf`) $ lines cs in extract l extract = reverse . dropWhile isSpace . reverse . dropWhile isSpace . drop 11 makeAddrInfo :: HostName -> Maybe PortNumber -> IO AddrInfo makeAddrInfo addr mport = do proto <- getProtocolNumber "udp" let hints = defaultHints { addrFlags = [AI_ADDRCONFIG, AI_NUMERICHOST, AI_PASSIVE] , addrSocketType = Datagram , addrProtocol = proto } a:_ <- getAddrInfo (Just hints) (Just addr) (Just "domain") let connectPort = case addrAddress a of SockAddrInet pn ha -> SockAddrInet (fromMaybe pn mport) ha SockAddrInet6 pn fi ha sid -> SockAddrInet6 (fromMaybe pn mport) fi ha sid unixAddr -> unixAddr return $ a { addrAddress = connectPort } ---------------------------------------------------------------- -- | Giving a thread-safe 'Resolver' to the function of the second -- argument. A socket for UDP is opened inside and is surely closed. -- Multiple 'withResolver's can be used concurrently. -- Multiple lookups must be done sequentially with a given -- 'Resolver'. If multiple 'Resolver's are necessary for -- concurrent purpose, use 'withResolvers'. withResolver :: ResolvSeed -> (Resolver -> IO a) -> IO a withResolver seed func = bracket (openSocket seed) close $ \sock -> do connectSocket sock seed func $ makeResolver seed sock -- | Giving thread-safe 'Resolver's to the function of the second -- argument. Sockets for UDP are opened inside and are surely closed. -- For each 'Resolver', multiple lookups must be done sequentially. -- 'Resolver's can be used concurrently. withResolvers :: [ResolvSeed] -> ([Resolver] -> IO a) -> IO a withResolvers seeds func = bracket openSockets closeSockets $ \socks -> do mapM_ (uncurry connectSocket) $ zip socks seeds let resolvs = zipWith makeResolver seeds socks func resolvs where openSockets = mapM openSocket seeds closeSockets = mapM close openSocket :: ResolvSeed -> IO Socket openSocket seed = socket (addrFamily ai) (addrSocketType ai) (addrProtocol ai) where ai = addrInfo seed connectSocket :: Socket -> ResolvSeed -> IO () connectSocket sock seed = connect sock (addrAddress ai) where ai = addrInfo seed makeResolver :: ResolvSeed -> Socket -> Resolver makeResolver seed sock = Resolver { genId = getRandom , dnsSock = sock , dnsTimeout = rsTimeout seed , dnsRetry = rsRetry seed , dnsBufsize = rsBufsize seed } getRandom :: IO Int getRandom = getStdRandom (randomR (0,65535)) ---------------------------------------------------------------- -- | Looking up resource records of a domain. The first parameter is one of -- the field accessors of the 'DNSMessage' type -- this allows you to -- choose which section (answer, authority, or additional) you would like -- to inspect for the result. lookupSection :: (DNSMessage -> [ResourceRecord]) -> Resolver -> Domain -> TYPE -> IO (Either DNSError [RData]) lookupSection section rlv dom typ = do eans <- lookupRaw rlv dom typ case eans of Left err -> return $ Left err Right ans -> return $ fromDNSMessage ans toRData where {- CNAME hack dom' = if "." `isSuffixOf` dom then dom else dom ++ "." correct r = rrname r == dom' && rrtype r == typ -} correct r = rrtype r == typ toRData = map rdata . filter correct . section -- | Extract necessary information from 'DNSMessage' fromDNSMessage :: DNSMessage -> (DNSMessage -> a) -> Either DNSError a fromDNSMessage ans conv = case errcode ans of NoErr -> Right $ conv ans FormatErr -> Left FormatError ServFail -> Left ServerFailure NameErr -> Left NameError NotImpl -> Left NotImplemented Refused -> Left OperationRefused BadOpt -> Left BadOptRecord where errcode = rcode . flags . header -- | For backward compatibility. fromDNSFormat :: DNSMessage -> (DNSMessage -> a) -> Either DNSError a fromDNSFormat = fromDNSMessage -- | Look up resource records for a domain, collecting the results -- from the ANSWER section of the response. -- -- We repeat an example from "Network.DNS.Lookup": -- -- >>> let hostname = Data.ByteString.Char8.pack "www.example.com" -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> withResolver rs $ \resolver -> lookup resolver hostname A -- Right [93.184.216.34] -- lookup :: Resolver -> Domain -> TYPE -> IO (Either DNSError [RData]) lookup = lookupSection answer -- | Look up resource records for a domain, collecting the results -- from the AUTHORITY section of the response. lookupAuth :: Resolver -> Domain -> TYPE -> IO (Either DNSError [RData]) lookupAuth = lookupSection authority -- | Look up a name and return the entire DNS Response. Sample output -- is included below, however it is /not/ tested -- the sequence -- number is unpredictable (it has to be!). -- -- The example code: -- -- @ -- let hostname = Data.ByteString.Char8.pack \"www.example.com\" -- rs <- makeResolvSeed defaultResolvConf -- withResolver rs $ \resolver -> lookupRaw resolver hostname A -- @ -- -- And the (formatted) expected output: -- -- @ -- Right (DNSMessage -- { header = DNSHeader -- { identifier = 1, -- flags = DNSFlags -- { qOrR = QR_Response, -- opcode = OP_STD, -- authAnswer = False, -- trunCation = False, -- recDesired = True, -- recAvailable = True, -- rcode = NoErr, -- authenData = False -- }, -- }, -- question = [Question { qname = \"www.example.com.\", -- qtype = A}], -- answer = [ResourceRecord {rrname = \"www.example.com.\", -- rrtype = A, -- rrttl = 800, -- rdlen = 4, -- rdata = 93.184.216.119}], -- authority = [], -- additional = []}) -- @ -- lookupRaw :: Resolver -> Domain -> TYPE -> IO (Either DNSError DNSMessage) lookupRaw = lookupRawInternal receive False lookupRawAD :: Resolver -> Domain -> TYPE -> IO (Either DNSError DNSMessage) lookupRawAD = lookupRawInternal receive True lookupRawInternal :: (Socket -> IO DNSMessage) -> Bool -> Resolver -> Domain -> TYPE -> IO (Either DNSError DNSMessage) lookupRawInternal _ _ _ dom _ | isIllegal dom = return $ Left IllegalDomain lookupRawInternal rcv ad rlv dom typ = do seqno <- genId rlv let query = (if ad then composeQueryAD else composeQuery) seqno [q] checkSeqno = check seqno loop query checkSeqno 0 False where loop query checkSeqno cnt mismatch | cnt == retry = do let ret | mismatch = SequenceNumberMismatch | otherwise = TimeoutExpired return $ Left ret | otherwise = do sendAll sock query response <- timeout tm (rcv sock) case response of Nothing -> loop query checkSeqno (cnt + 1) False Just res -> do let valid = checkSeqno res if valid then return $ Right res else loop query checkSeqno (cnt + 1) False sock = dnsSock rlv tm = dnsTimeout rlv retry = dnsRetry rlv q = makeQuestion dom typ check seqno res = identifier (header res) == seqno #if mingw32_HOST_OS == 1 -- Windows does not support sendAll in Network.ByteString.Lazy. -- This implements sendAll with Haskell Strings. sendAll sock bs = do sent <- send sock (LB.unpack bs) when (sent < fromIntegral (LB.length bs)) $ sendAll sock (LB.drop (fromIntegral sent) bs) #endif isIllegal :: Domain -> Bool isIllegal "" = True isIllegal dom | '.' `BS.notElem` dom = True | ':' `BS.elem` dom = True | '/' `BS.elem` dom = True | BS.length dom > 253 = True | any (\x -> BS.length x > 63) (BS.split '.' dom) = True isIllegal _ = False dns-2.0.8/Network/DNS/StateBinary.hs0000644000000000000000000001154713002260502015327 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, CPP #-} module Network.DNS.StateBinary where import Control.Monad.State (State, StateT) import qualified Control.Monad.State as ST import Control.Monad.Trans.Resource (ResourceT) import qualified Data.Attoparsec.ByteString as A import qualified Data.Attoparsec.ByteString.Lazy as AL import qualified Data.Attoparsec.Types as T import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.ByteString.Builder (Builder) import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Lazy as BL import Data.Conduit (Sink) import Data.Conduit.Attoparsec (sinkParser) import Data.IntMap (IntMap) import qualified Data.IntMap as IM import Data.Map (Map) import qualified Data.Map as M import Data.Word (Word8, Word16, Word32) import Network.DNS.Types #if __GLASGOW_HASKELL__ < 709 import Control.Applicative ((<$>), (<*)) import Data.Monoid (Monoid, mconcat, mappend, mempty) #endif ---------------------------------------------------------------- type SPut = State WState Builder data WState = WState { wsDomain :: Map Domain Int , wsPosition :: Int } initialWState :: WState initialWState = WState M.empty 0 instance Monoid SPut where mempty = return mempty mappend a b = mconcat <$> sequence [a, b] put8 :: Word8 -> SPut put8 = fixedSized 1 BB.word8 put16 :: Word16 -> SPut put16 = fixedSized 2 BB.word16BE put32 :: Word32 -> SPut put32 = fixedSized 4 BB.word32BE putInt8 :: Int -> SPut putInt8 = fixedSized 1 (BB.int8 . fromIntegral) putInt16 :: Int -> SPut putInt16 = fixedSized 2 (BB.int16BE . fromIntegral) putInt32 :: Int -> SPut putInt32 = fixedSized 4 (BB.int32BE . fromIntegral) putByteString :: ByteString -> SPut putByteString = writeSized BS.length BB.byteString addPositionW :: Int -> State WState () addPositionW n = do (WState m cur) <- ST.get ST.put $ WState m (cur+n) fixedSized :: Int -> (a -> Builder) -> a -> SPut fixedSized n f a = do addPositionW n return (f a) writeSized :: (a -> Int) -> (a -> Builder) -> a -> SPut writeSized n f a = do addPositionW (n a) return (f a) wsPop :: Domain -> State WState (Maybe Int) wsPop dom = do doms <- ST.gets wsDomain return $ M.lookup dom doms wsPush :: Domain -> Int -> State WState () wsPush dom pos = do (WState m cur) <- ST.get ST.put $ WState (M.insert dom pos m) cur ---------------------------------------------------------------- type SGet = StateT PState (T.Parser ByteString) data PState = PState { psDomain :: IntMap Domain , psPosition :: Int } ---------------------------------------------------------------- getPosition :: SGet Int getPosition = psPosition <$> ST.get addPosition :: Int -> SGet () addPosition n = do PState dom pos <- ST.get ST.put $ PState dom (pos + n) push :: Int -> Domain -> SGet () push n d = do PState dom pos <- ST.get ST.put $ PState (IM.insert n d dom) pos pop :: Int -> SGet (Maybe Domain) pop n = IM.lookup n . psDomain <$> ST.get ---------------------------------------------------------------- get8 :: SGet Word8 get8 = ST.lift A.anyWord8 <* addPosition 1 get16 :: SGet Word16 get16 = ST.lift getWord16be <* addPosition 2 where word8' = fromIntegral <$> A.anyWord8 getWord16be = do a <- word8' b <- word8' return $ a * 256 + b get32 :: SGet Word32 get32 = ST.lift getWord32be <* addPosition 4 where word8' = fromIntegral <$> A.anyWord8 getWord32be = do a <- word8' b <- word8' c <- word8' d <- word8' return $ a * 1677721 + b * 65536 + c * 256 + d getInt8 :: SGet Int getInt8 = fromIntegral <$> get8 getInt16 :: SGet Int getInt16 = fromIntegral <$> get16 getInt32 :: SGet Int getInt32 = fromIntegral <$> get32 ---------------------------------------------------------------- getNBytes :: Int -> SGet [Int] getNBytes len = toInts <$> getNByteString len where toInts = map fromIntegral . BS.unpack getNByteString :: Int -> SGet ByteString getNByteString n = ST.lift (A.take n) <* addPosition n ---------------------------------------------------------------- initialState :: PState initialState = PState IM.empty 0 sinkSGet :: SGet a -> Sink ByteString (ResourceT IO) (a, PState) sinkSGet parser = sinkParser (ST.runStateT parser initialState) runSGet :: SGet a -> BL.ByteString -> Either String (a, PState) runSGet parser bs = AL.eitherResult $ AL.parse (ST.runStateT parser initialState) bs runSGetWithLeftovers :: SGet a -> BL.ByteString -> Either String ((a, PState), BL.ByteString) runSGetWithLeftovers parser bs = toResult $ AL.parse (ST.runStateT parser initialState) bs where toResult :: AL.Result r -> Either String (r, BL.ByteString) toResult (AL.Done i r) = Right (r, i) toResult (AL.Fail _ _ err) = Left err runSPut :: SPut -> BL.ByteString runSPut = BB.toLazyByteString . flip ST.evalState initialWState dns-2.0.8/Network/DNS/Types.hs0000644000000000000000000000121613002260502014176 0ustar0000000000000000-- | Data types for DNS Query and Response. -- For more information, see . module Network.DNS.Types ( -- * Domain Domain -- * Resource Records , ResourceRecord (..) , RData (..), OData (..) -- ** Resource Record Type , TYPE (..), intToType, typeToInt , OPTTYPE (..), intToOptType, optTypeToInt -- * DNS Error , DNSError (..) -- * DNS Message , DNSMessage (..) , DNSFormat -- * DNS Header , DNSHeader (..) -- * DNS Flags , DNSFlags (..) -- * DNS Body , QorR (..) , OPCODE (..) , RCODE (..) , Question (..) , responseA, responseAAAA ) where import Network.DNS.Internal dns-2.0.8/Network/DNS/Utils.hs0000644000000000000000000001014313002260502014171 0ustar0000000000000000-- | Miscellaneous utility functions for processing DNS data. -- module Network.DNS.Utils ( normalize , normalizeCase , normalizeRoot ) where import qualified Data.ByteString.Char8 as BS ( append , last , map , null , pack ) import Data.Char ( toLower ) import Network.DNS.Types ( Domain ) -- | Perform both 'normalizeCase' and 'normalizeRoot' on the given -- 'Domain'. When comparing DNS names taken from user input, this is -- often necessary to avoid unexpected results. -- -- /Examples/: -- -- >>> let domain1 = BS.pack "ExAmPlE.COM" -- >>> let domain2 = BS.pack "example.com." -- >>> domain1 == domain2 -- False -- >>> normalize domain1 == normalize domain2 -- True -- -- The 'normalize' function should be idempotent: -- -- >>> normalize (normalize domain1) == normalize domain1 -- True -- -- Ensure that we don't crash on the empty 'Domain': -- -- >>> import qualified Data.ByteString.Char8 as BS ( empty ) -- >>> normalize BS.empty -- "." -- normalize :: Domain -> Domain normalize = normalizeCase . normalizeRoot -- | Normalize the case of the given DNS name for comparisons. -- -- According to RFC #1035, \"For all parts of the DNS that are part -- of the official protocol, all comparisons between character -- strings (e.g., labels, domain names, etc.) are done in a -- case-insensitive manner.\" This function chooses to lowercase -- its argument, but that should be treated as an implementation -- detail if at all possible. -- -- /Examples/: -- -- >>> let domain1 = BS.pack "ExAmPlE.COM" -- >>> let domain2 = BS.pack "exAMPle.com" -- >>> domain1 == domain2 -- False -- >>> normalizeCase domain1 == normalizeCase domain2 -- True -- -- The 'normalizeCase' function should be idempotent: -- -- >>> normalizeCase (normalizeCase domain2) == normalizeCase domain2 -- True -- -- Ensure that we don't crash on the empty 'Domain': -- -- >>> import qualified Data.ByteString.Char8 as BS ( empty ) -- >>> normalizeCase BS.empty -- "" -- normalizeCase :: Domain -> Domain normalizeCase = BS.map toLower -- | Normalize the given name by appending a trailing dot (the DNS -- root) if one does not already exist. -- -- Warning: this does not produce an equivalent DNS name! However, -- users are often unaware of the effect that the absence of the -- root will have. In user interface design, it may therefore be -- wise to act as if the user supplied the trailing dot during -- comparisons. -- -- Per RFC #1034, -- -- \"Since a complete domain name ends with the root label, this leads -- to a printed form which ends in a dot. We use this property to -- distinguish between: -- -- * a character string which represents a complete domain name -- (often called \'absolute\'). For example, \'poneria.ISI.EDU.\' -- -- * a character string that represents the starting labels of a -- domain name which is incomplete, and should be completed by -- local software using knowledge of the local domain (often -- called \'relative\'). For example, \'poneria\' used in the -- ISI.EDU domain. -- -- Relative names are either taken relative to a well known origin, -- or to a list of domains used as a search list. Relative names -- appear mostly at the user interface, where their interpretation -- varies from implementation to implementation, and in master -- files, where they are relative to a single origin domain name.\" -- -- /Examples/: -- -- >>> let domain1 = BS.pack "example.com" -- >>> let domain2 = BS.pack "example.com." -- >>> domain1 == domain2 -- False -- >>> normalizeRoot domain1 == normalizeRoot domain2 -- True -- -- The 'normalizeRoot' function should be idempotent: -- -- >>> normalizeRoot (normalizeRoot domain1) == normalizeRoot domain1 -- True -- -- Ensure that we don't crash on the empty 'Domain': -- -- >>> import qualified Data.ByteString.Char8 as BS ( empty ) -- >>> normalizeRoot BS.empty -- "." -- normalizeRoot :: Domain -> Domain normalizeRoot d | BS.null d = trailing_dot | BS.last d == '.' = d | otherwise = d `BS.append` trailing_dot where trailing_dot = BS.pack "." dns-2.0.8/test/0000755000000000000000000000000013002260502011440 5ustar0000000000000000dns-2.0.8/test/DecodeSpec.hs0000644000000000000000000000666313002260502014005 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, CPP #-} module DecodeSpec where import Data.ByteString.Internal (ByteString(..), unsafeCreate) #if !MIN_VERSION_bytestring(0,10,0) import qualified Data.ByteString as BS #endif import qualified Data.ByteString.Lazy as BL import Data.Word8 import Foreign.ForeignPtr (withForeignPtr) import Foreign.Ptr (plusPtr) import Foreign.Storable (peek, poke, peekByteOff) import Network.DNS.Decode import Network.DNS.Encode import Test.Hspec ---------------------------------------------------------------- test_doublePointer :: BL.ByteString test_doublePointer = "f7eb8500000100010007000404736563330561706e696303636f6d0000010001c00c0001000100001c200004ca0c1c8cc0110002000100001c20000f036e73310561706e6963036e657400c0300002000100001c200006036e7333c040c0300002000100001c200006036e7334c040c0300002000100001c20001004736563310561706e696303636f6d00c0300002000100001c20001704736563310761757468646e730472697065036e657400c0300002000100001c20001004736563320561706e696303636f6d00c0300002000100001c2000070473656333c0bfc07b0001000100001c200004ca0c1d3bc07b001c000100001c20001020010dc02001000a4608000000000059c0ba0001000100001c200004ca0c1d3cc0d6001c000100001c20001020010dc0000100004777000000000140" test_txt :: BL.ByteString test_txt = "463181800001000100000000076e69636f6c6173046b766462076e647072696d6102696f0000100001c00c0010000100000e10000c6e69636f6c61732e6b766462" test_dname :: BL.ByteString test_dname = "b3c0818000010005000200010377777706376b616e616c02636f02696c0000010001c0100027000100000003000c0769737261656c3702727500c00c0005000100000003000603777777c02ec046000500010000255b0002c02ec02e000100010000003d000451daf938c02e000100010000003d0004c33ce84ac02e000200010005412b000c036e7332026137036f726700c02e000200010005412b0006036e7331c08a0000291000000000000000" ---------------------------------------------------------------- spec :: Spec spec = do describe "decode" $ do it "decodes double pointers correctly" $ do let Right x1 = decode $ fromHexString test_doublePointer Right x2 = decode (encode x1) Right x3 = decode (encode x2) x3 `shouldBe` x2 it "decodes dname" $ do let Right x1 = decode $ fromHexString test_dname Right x2 = decode (encode x1) Right x3 = decode (encode x2) print x1 x3 `shouldBe` x2 it "decodes txt" $ do let Right x1 = decode $ fromHexString test_txt Right x2 = decode (encode x1) Right x3 = decode (encode x2) print x1 x3 `shouldBe` x2 ---------------------------------------------------------------- fromHexString :: BL.ByteString -> BL.ByteString #if MIN_VERSION_bytestring(0,10,0) fromHexString = BL.fromStrict . fromHexString' . BL.toStrict #else fromHexString = BL.pack . BS.unpack . fromHexString' . BS.pack . BL.unpack #endif fromHexString' :: ByteString -> ByteString fromHexString' (PS fptr off len) = unsafeCreate size $ \dst -> withForeignPtr fptr $ \src -> go (src `plusPtr` off) dst 0 where size = len `div` 2 go from to bytes | bytes == size = return () | otherwise = do w1 <- peek from w2 <- peekByteOff from 1 let w = hex2w (w1,w2) poke to w go (from `plusPtr` 2) (to `plusPtr` 1) (bytes + 1) hex2w :: (Word8, Word8) -> Word8 hex2w (w1,w2) = h2w w1 * 16 + h2w w2 h2w :: Word8 -> Word8 h2w w | isDigit w = w - _0 | otherwise = w - _a + 10 dns-2.0.8/test/EncodeSpec.hs0000644000000000000000000001637513002260502014020 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module EncodeSpec where import Data.IP import Network.DNS import Network.DNS.Internal (defaultQuery, makeQuestion) import Test.Hspec spec :: Spec spec = do describe "encode" $ do it "encodes DNSMessage correctly" $ do check1 testQueryA check1 testQueryAAAA check1 testResponseA check1 testResponseTXT describe "decode" $ do it "decodes DNSMessage correctly" $ do check2 testQueryA check2 testQueryAAAA check2 testResponseA check2 testResponseTXT check1 :: DNSMessage -> Expectation check1 inp = out `shouldBe` Right inp where bs = encode inp out = decode bs check2 :: DNSMessage -> Expectation check2 inp = bs' `shouldBe` bs where bs = encode inp Right out = decode bs bs' = encode out defaultHeader :: DNSHeader defaultHeader = header defaultQuery testQueryA :: DNSMessage testQueryA = defaultQuery { header = defaultHeader { identifier = 1000 } , question = [makeQuestion "www.mew.org." A] } testQueryAAAA :: DNSMessage testQueryAAAA = defaultQuery { header = defaultHeader { identifier = 1000 } , question = [makeQuestion "www.mew.org." AAAA] } testResponseA :: DNSMessage testResponseA = DNSMessage { header = DNSHeader { identifier = 61046 , flags = DNSFlags { qOrR = QR_Response , opcode = OP_STD , authAnswer = False , trunCation = False , recDesired = True , recAvailable = True , rcode = NoErr , authenData = False } } , question = [Question { qname = "492056364.qzone.qq.com." , qtype = A } ] , answer = [ResourceRecord { rrname = "492056364.qzone.qq.com." , rrtype = A , rrttl = 568 , rdata = RD_A $ toIPv4 [119, 147, 15, 122] } , ResourceRecord { rrname = "492056364.qzone.qq.com." , rrtype = A , rrttl = 568 , rdata = RD_A $ toIPv4 [119, 147, 79, 106] } , ResourceRecord { rrname = "492056364.qzone.qq.com." , rrtype = A , rrttl = 568 , rdata = RD_A $ toIPv4 [183, 60, 55, 43] } , ResourceRecord { rrname = "492056364.qzone.qq.com." , rrtype = A , rrttl = 568 , rdata = RD_A $ toIPv4 [183, 60, 55, 107] } , ResourceRecord { rrname = "492056364.qzone.qq.com." , rrtype = A , rrttl = 568 , rdata = RD_A $ toIPv4 [113, 108, 7, 172] } , ResourceRecord { rrname = "492056364.qzone.qq.com." , rrtype = A , rrttl = 568 , rdata = RD_A $ toIPv4 [113, 108, 7, 174] } , ResourceRecord { rrname = "492056364.qzone.qq.com." , rrtype = A , rrttl = 568 , rdata = RD_A $ toIPv4 [113, 108, 7, 175] } , ResourceRecord { rrname = "492056364.qzone.qq.com." , rrtype = A , rrttl = 568 , rdata = RD_A $ toIPv4 [119, 147, 15, 100] } ] , authority = [ ResourceRecord { rrname = "qzone.qq.com." , rrtype = NS , rrttl = 45919 , rdata = RD_NS "ns-tel2.qq.com." } , ResourceRecord { rrname = "qzone.qq.com." , rrtype = NS , rrttl = 45919 , rdata = RD_NS "ns-tel1.qq.com." } ] , additional = [ ResourceRecord { rrname = "ns-tel1.qq.com." , rrtype = A , rrttl = 46520 , rdata = RD_A $ toIPv4 [121, 14, 73, 115] } , ResourceRecord { rrname = "ns-tel2.qq.com." , rrtype = A , rrttl = 2890 , rdata = RD_A $ toIPv4 [222, 73, 76, 226] } , ResourceRecord { rrname = "ns-tel2.qq.com." , rrtype = A , rrttl = 2890 , rdata = RD_A $ toIPv4 [183, 60, 3, 202] } , ResourceRecord { rrname = "ns-tel2.qq.com." , rrtype = A , rrttl = 2890 , rdata = RD_A $ toIPv4 [218, 30, 72, 180] } ] } testResponseTXT :: DNSMessage testResponseTXT = DNSMessage { header = DNSHeader { identifier = 48724 , flags = DNSFlags { qOrR = QR_Response , opcode = OP_STD , authAnswer = False , trunCation = False , recDesired = True , recAvailable = True , rcode = NoErr , authenData = False } } , question = [Question { qname = "492056364.qzone.qq.com." , qtype = TXT } ] , answer = [ResourceRecord { rrname = "492056364.qzone.qq.com." , rrtype = TXT , rrttl = 0 , rdata = RD_TXT "simple txt line" } ] , authority = [ ResourceRecord { rrname = "qzone.qq.com." , rrtype = NS , rrttl = 45919 , rdata = RD_NS "ns-tel2.qq.com." } , ResourceRecord { rrname = "qzone.qq.com." , rrtype = NS , rrttl = 45919 , rdata = RD_NS "ns-tel1.qq.com." } ] , additional = [ ResourceRecord { rrname = "ns-tel1.qq.com." , rrtype = A , rrttl = 46520 , rdata = RD_A $ toIPv4 [121, 14, 73, 115] } , ResourceRecord { rrname = "ns-tel2.qq.com." , rrtype = A , rrttl = 2890 , rdata = RD_A $ toIPv4 [222, 73, 76, 226] } , ResourceRecord { rrname = "ns-tel2.qq.com." , rrtype = A , rrttl = 2890 , rdata = RD_A $ toIPv4 [183, 60, 3, 202] } , ResourceRecord { rrname = "ns-tel2.qq.com." , rrtype = A , rrttl = 2890 , rdata = RD_A $ toIPv4 [218, 30, 72, 180] } ] } dns-2.0.8/test/Spec.hs0000644000000000000000000000005413002260502012665 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} dns-2.0.8/test2/0000755000000000000000000000000013002260502011522 5ustar0000000000000000dns-2.0.8/test2/doctests.hs0000644000000000000000000000063013002260502013705 0ustar0000000000000000module Main where import Test.DocTest main :: IO () main = doctest [ "-XOverloadedStrings" {- Both 'iproute' and 'network-data' provide ‘Data.IP’ package: Ambiguous interface for ‘Data.IP’: it was found in multiple packages: network-data-0.5.3 iproute-1.7.0 We ignore network-data to make tests pass. -} , "-ignore-package=network-data" , "Network/DNS.hs" ] dns-2.0.8/test2/LookupSpec.hs0000644000000000000000000000063313002260502014144 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module LookupSpec where import Network.DNS as DNS import Test.Hspec spec :: Spec spec = do describe "lookupAAAA" $ do it "gets IPv6 addresses" $ do rs <- makeResolvSeed defaultResolvConf withResolver rs $ \resolver -> do DNS.lookupAAAA resolver "mew.org" `shouldReturn` Right [] dns-2.0.8/test2/Spec.hs0000644000000000000000000000005413002260502012747 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-}