hsdns 1.4 → 1.4.1

raw patch · 7 files changed

+55/−117 lines, 7 filesdep ~basedep ~containersdep ~networkPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, containers, network

API changes (from Hackage documentation)

Files

• ADNS.hs +6/−2
• ADNS/Base.hsc +28/−0
• ADNS/Resolver.hs +16/−2
• README +2/−2
• example/adns-reverse-lookup.hs +0/−60
• example/adns-test-and-traverse.hs +0/−49
• hsdns.cabal +3/−2

@@ -17,18 +17,22 @@ module ADNS   ( HostName, HostAddress   , Resolver, initResolver, InitFlag(..)-  , queryA, queryPTR, queryMX+  , queryA, queryPTR, queryMX, querySRV   , dummyDNS   )   where -import Network           ( HostName )+import Network           ( HostName, PortID ) import Network.Socket    ( HostAddress ) import ADNS.Base import ADNS.Resolver  queryA :: Resolver -> HostName -> IO (Maybe [HostAddress]) queryA = query resolveA++-- | For quering SRV records. Result is the list of tuples (host, port)+querySRV :: Resolver -> HostName -> IO (Maybe [(HostName, PortID)])+querySRV = query resolveSRV  queryPTR :: Resolver -> HostAddress -> IO (Maybe [HostName]) queryPTR = query resolvePTR

@@ -112,6 +112,7 @@  data RRType = A | CNAME | MX | NS | PTR             | NSEC+            | SRV             | RRType Int   deriving (Read) @@ -126,6 +127,7 @@                    NS         -> showString "NS"                    PTR        -> showString "PTR"                    NSEC       -> showString "NSEC"+                   SRV        -> showString "SRV"                    (RRType i) -> showString "TYPE" . shows i  instance Enum RRType where@@ -134,6 +136,7 @@   toEnum #{const adns_r_mx}  = MX   toEnum #{const adns_r_ns}  = NS   toEnum #{const adns_r_ptr} = PTR+  toEnum #{const adns_r_srv} = SRV   toEnum x = case x .&. #{const adns_rrt_typemask} of       	 47 -> NSEC 	 i  -> RRType i@@ -143,6 +146,7 @@   fromEnum MX  = #{const adns_r_mx}   fromEnum NS  = #{const adns_r_ns}   fromEnum PTR = #{const adns_r_ptr}+  fromEnum SRV = #{const adns_r_srv}   fromEnum x = #{const adns_r_unknown} .|. case x of    	   NSEC       -> 47   	   (RRType i) -> i@@ -309,6 +313,26 @@       p <- #{peek adns_rr_byteblock, data} ptr       return (RRByteblock (fromEnum l) p) +-- |Original definition:+--+-- >    typedef struct {+-- >      int priority, weight, port;+-- >      char *host;+-- >    } adns_rr_srvraw;++data RRSrvRaw = RRSrvRaw Int Int Int (Ptr CChar)++instance Storable RRSrvRaw where+    sizeOf _     = #{size adns_rr_srvraw}+    alignment _  = alignment (undefined :: CInt)+    poke _ _     = fail "poke is undefined for Network.DNS.ADNS.RRSrvRaw"+    peek ptr     = do+      pr <- #{peek adns_rr_srvraw, priority} ptr :: IO CInt+      w <- #{peek adns_rr_srvraw, weight} ptr :: IO CInt+      po <- #{peek adns_rr_srvraw, port} ptr :: IO CInt+      h <- #{peek adns_rr_srvraw, host} ptr+      return (RRSrvRaw (fromEnum pr) (fromEnum w) (fromEnum po) h)+ data Answer = Answer   { status  :: Status       -- ^ Status code for this query.@@ -331,6 +355,7 @@   | RRPTR String   | RRNSEC String   | RRUNKNOWN String+  | RRSRV Int Int Int String   deriving (Show)  instance Storable Answer where@@ -372,6 +397,9 @@   parseByType A   = peek (castPtr ptr) >>= return . RRA . RRAddr   parseByType NS  = peek (castPtr ptr) >>= return . RRNS   parseByType PTR = peek (castPtr ptr) >>= peekCString >>= return . RRPTR+  parseByType SRV = do (RRSrvRaw prio weight port host) <- peek (castPtr ptr)+                       host' <- peekCString host+                       return (RRSRV prio weight port host')   parseByType MX  = do (RRIntHostAddr i addr) <- peek (castPtr ptr)                        return (RRMX i addr)   parseByType CNAME = peek (castPtr ptr) >>= peekCString >>= return . RRCNAME

@@ -16,7 +16,7 @@   ( Resolver   , initResolver   , toPTR-  , resolveA, resolvePTR, resolveMX+  , resolveA, resolvePTR, resolveMX, resolveSRV   , query   , dummyDNS   )@@ -28,7 +28,7 @@ import Data.List          ( sortBy ) import Data.Map           ( Map ) import qualified Data.Map as Map-import Network            ( HostName )+import Network            import Network.Socket     ( HostAddress ) import ADNS.Base import ADNS.Endian@@ -58,6 +58,20 @@   if rc /= sOK      then return (Left rc)      else return (Right [ addr | RRA (RRAddr addr) <- rs  ])++-- |Resolve a hostname's 'SRV' records.++resolveSRV :: Resolver -> HostName -> IO (Either Status [(HostName, PortID)])+resolveSRV resolver x = do+  Answer rc _ _ _ rs  <- resolver x SRV [] >>= takeMVar+  if rc /= sOK+     then return (Left rc)+     else do+       let cmp (RRSRV p1 _ _ _) (RRSRV p2 _ _ _) = compare p1 p2+           cmp _ _ = error $ showString "unexpected record in SRV lookup: " (show rs)+           rs' = sortBy cmp rs+           as = [ (host, PortNumber $ toEnum port) | (RRSRV _ _ port host) <- rs' ]+       return (Right as)  -- |Get the 'PTR' records assigned to a host address. Note -- that although the API allows for a record to have more

@@ -1,7 +1,7 @@ An asynchronous DNS resolver for Haskell_ ========================================= -:Latest Release: hsdns-1.4.tar.gz_+:Latest Release: hsdns-1.4.1.tar.gz_ :Darcs:          darcs_ get http://cryp.to/hsdns/  Synopsis@@ -56,6 +56,6 @@  .. _Reference Documentation: docs/index.html -.. _hsdns-1.4.tar.gz: http://cryp.to/hsdns/hsdns-1.4.tar.gz+.. _hsdns-1.4.1.tar.gz: http://cryp.to/hsdns/hsdns-1.4.1.tar.gz  .. _adns-reverse-lookup.hs: example/adns-reverse-lookup.hs

@@ -1,60 +0,0 @@-{--    Resolve a bunch of hostnames' A records, then resolve those-    A-record's PTR records and check whether they match. Do it-    all asynchronously. The results are printed in the order the-    answers come in.--    TODO: handle hosts that have more than one A record--}--module Main ( main ) where--import Control.Monad            ( when, replicateM_ )-import Control.Concurrent       ( forkIO )-import Control.Concurrent.Chan  ( Chan, newChan, writeChan, readChan )-import System.Environment       ( getArgs )-import Network.Socket           ( inet_ntoa )-import Data.List                ( elem )-import ADNS--data CheckResult-  = OK HostName HostAddress-  | NotOK HostName HostAddress [HostName]-  | DNSError String--printResult :: CheckResult -> IO ()-printResult (OK h a)       = do addr <- inet_ntoa a-                                putStrLn $ "OK: "   ++ h ++ " <-> " ++ addr-printResult (NotOK h a h') = do addr <- inet_ntoa a-                                putStrLn $ "FAIL: " ++ h ++ " -> "  ++ addr ++ " -> " ++ show h'-printResult (DNSError msg) = putStrLn $ "ERR: " ++ msg--main :: IO ()-main = do-  names <- getArgs-  when (null names) (putStrLn "Usage: hostname [hostname ...]")-  initResolver [NoErrPrint, NoServerWarn] $ \resolver -> do-    rrChannel <- newChan :: IO (Chan CheckResult)-    mapM_ (\h -> forkIO (ptrCheck resolver rrChannel h)) names-    replicateM_ (length names) (readChan rrChannel >>= printResult)--ptrCheck :: Resolver -> Chan CheckResult -> HostName -> IO ()-ptrCheck resolver chan host = do-  let returnError t = writeChan chan (DNSError (host ++ ": cannot resolve " ++ t))-  a <- queryA resolver host-  case a of-    Just [addr] -> do-      ptr <- queryPTR resolver addr-      case ptr of-        Just names | host `elem` names -> writeChan chan (OK host addr)-                   | otherwise         -> writeChan chan (NotOK host addr names)-        _                              -> returnError "PTR"-    _           -> returnError "A"------ ----- Configure Emacs ----------- Local Variables: ***--- haskell-program-name: "ghci -ladns" ***--- End: ***

@@ -1,49 +0,0 @@-module Main where--import ADNS-import ADNS.Base-import Control.Concurrent.MVar-import System.Environment--main :: IO ()-main = initResolver [NoErrPrint, NoServerWarn] $ \resolver -> do-  args <- getArgs-  case args of-    [name]   -> traverse resolver name-    [t,name] -> work resolver (read t) name-    _ -> putStrLn "Usage: t [typeid] fqdn"---- | Test function to see the raw results of a given query type-work :: Resolver -> RRType -> String -> IO ()-work resolver t n = do-  putStrLn $ showString "Querying " . shows t $ showString " for " n-  print =<< takeMVar =<< resolver n t [QuoteOk_Query]---- | Example implementation to traverse a DNSSEC signed zone.------ This implementation is clearly wrong, because any real zone traversal--- is done using the NSEC records in the authority section of a NXDOMAIN--- response.------ Unfortunly the adns library does not provide access to other sections--- than the answer section, so this walk is done by querying NSEC directly.------ If there are signed subzones, the traversal switches to the subzone--- and stops if this subzone is traversed. You may continue the traversal--- by providing the next entry after the subzone.------ You may try this mechanism on "dnssec.iks-jena.de"-traverse :: Resolver -> String -> IO ()-traverse resolver x = do-  putStrLn x-  answer <- takeMVar =<< resolver x NSEC [QuoteOk_Query]-  case rrs answer of-     [RRNSEC y] | not (x `endsWith` ('.':y)) -> traverse resolver y-     _  -> return ()--endsWith :: String -> String -> Bool-endsWith x y = startsWith (reverse x) (reverse y)--startsWith :: String -> String -> Bool-startsWith (x:xs) (y:ys) = x == y && startsWith xs ys-startsWith _      ys     = null ys

@@ -1,7 +1,8 @@ Name:                   hsdns-Version:                1.4+Version:                1.4.1 Author:                 Peter Simons <simons@cryp.to>,                         Lutz Donnerhacke <lutz@iks-jena.de>+			Григорий Холомьёв <omever@gmail.com> Maintainer:             Peter Simons <simons@cryp.to> License:                LGPL License-File:           COPYING@@ -9,7 +10,7 @@ Synopsis:               Asynchronous DNS Resolver Description:            Asynchronous DNS Resolver; requires GNU ADNS to be installed. Category:               Foreign, Network-Build-Depends:          base, network, containers+Build-Depends:          base >=3.0.0.0 && <4.2.0.0, network, containers Extensions:             ForeignFunctionInterface, EmptyDataDecls Extra-Libraries:        adns Includes:               "adns.h", "errno.h"