Commit 5698952aa07e83659df7456635c302efe7cfd600

Peter Simons (Committer)
Fri Feb 26 00:00:02 CET 2010
Григорий Холомьёв <omever @gm…l.com> (Author)
Fri Nov 13 19:57:17 CET 2009

Tree SHA1: b8f6909
Parent SHA1: cab7015 (Bumped to version 1.4.)
raw diff | raw patch

Added support for resolving SRV records.

Diff rendering mode:
inline
side by side


17	17	module ADNS
18	18	( HostName, HostAddress
19	19	, Resolver, initResolver, InitFlag(..)
20		, queryA, queryPTR, queryMX
	20	, queryA, queryPTR, queryMX, querySRV
21	21	, dummyDNS
22	22	)
23	23	where
24	24
25		import Network ( HostName )
	25	import Network ( HostName, PortID )
26	26	import Network.Socket ( HostAddress )
27	27	import ADNS.Base
28	28	import ADNS.Resolver
29	29
30	30	queryA :: Resolver -> HostName -> IO (Maybe [HostAddress])
31	31	queryA = query resolveA
	32
	33	-- \| For quering SRV records. Result is the list of tuples (host, port)
	34	querySRV :: Resolver -> HostName -> IO (Maybe [(HostName, PortID)])
	35	querySRV = query resolveSRV
32	36
33	37	queryPTR :: Resolver -> HostAddress -> IO (Maybe [HostName])
34	38	queryPTR = query resolvePTR


112	112
113	113	data RRType = A \| CNAME \| MX \| NS \| PTR
114	114	\| NSEC
	115	\| SRV
115	116	\| RRType Int
116	117	deriving (Read)
117	118
…	…
127	127	NS -> showString "NS"
128	128	PTR -> showString "PTR"
129	129	NSEC -> showString "NSEC"
	130	SRV -> showString "SRV"
130	131	(RRType i) -> showString "TYPE" . shows i
131	132
132	133	instance Enum RRType where
…	…
136	136	toEnum #{const adns_r_mx} = MX
137	137	toEnum #{const adns_r_ns} = NS
138	138	toEnum #{const adns_r_ptr} = PTR
	139	toEnum #{const adns_r_srv} = SRV
139	140	toEnum x = case x .&. #{const adns_rrt_typemask} of
140	141	47 -> NSEC
141	142	i -> RRType i
…	…
146	146	fromEnum MX = #{const adns_r_mx}
147	147	fromEnum NS = #{const adns_r_ns}
148	148	fromEnum PTR = #{const adns_r_ptr}
	149	fromEnum SRV = #{const adns_r_srv}
149	150	fromEnum x = #{const adns_r_unknown} .\|. case x of
150	151	NSEC -> 47
151	152	(RRType i) -> i
…	…
313	313	p <- #{peek adns_rr_byteblock, data} ptr
314	314	return (RRByteblock (fromEnum l) p)
315	315
	316	-- \|Original definition:
	317	--
	318	-- > typedef struct {
	319	-- > int priority, weight, port;
	320	-- > char *host;
	321	-- > } adns_rr_srvraw;
	322
	323	data RRSrvRaw = RRSrvRaw Int Int Int (Ptr CChar)
	324
	325	instance Storable RRSrvRaw where
	326	sizeOf _ = #{size adns_rr_srvraw}
	327	alignment _ = alignment (undefined :: CInt)
	328	poke _ _ = fail "poke is undefined for Network.DNS.ADNS.RRSrvRaw"
	329	peek ptr = do
	330	pr <- #{peek adns_rr_srvraw, priority} ptr :: IO CInt
	331	w <- #{peek adns_rr_srvraw, weight} ptr :: IO CInt
	332	po <- #{peek adns_rr_srvraw, port} ptr :: IO CInt
	333	h <- #{peek adns_rr_srvraw, host} ptr
	334	return (RRSrvRaw (fromEnum pr) (fromEnum w) (fromEnum po) h)
	335
316	336	data Answer = Answer
317	337	{ status :: Status
318	338	-- ^ Status code for this query.
…	…
355	355	\| RRPTR String
356	356	\| RRNSEC String
357	357	\| RRUNKNOWN String
	358	\| RRSRV Int Int Int String
358	359	deriving (Show)
359	360
360	361	instance Storable Answer where
…	…
397	397	parseByType A = peek (castPtr ptr) >>= return . RRA . RRAddr
398	398	parseByType NS = peek (castPtr ptr) >>= return . RRNS
399	399	parseByType PTR = peek (castPtr ptr) >>= peekCString >>= return . RRPTR
	400	parseByType SRV = do (RRSrvRaw prio weight port host) <- peek (castPtr ptr)
	401	host' <- peekCString host
	402	return (RRSRV prio weight port host')
400	403	parseByType MX = do (RRIntHostAddr i addr) <- peek (castPtr ptr)
401	404	return (RRMX i addr)
402	405	parseByType CNAME = peek (castPtr ptr) >>= peekCString >>= return . RRCNAME


16	16	( Resolver
17	17	, initResolver
18	18	, toPTR
19		, resolveA, resolvePTR, resolveMX
	19	, resolveA, resolvePTR, resolveMX, resolveSRV
20	20	, query
21	21	, dummyDNS
22	22	)
…	…
28	28	import Data.List ( sortBy )
29	29	import Data.Map ( Map )
30	30	import qualified Data.Map as Map
31		import Network ( HostName )
	31	import Network
32	32	import Network.Socket ( HostAddress )
33	33	import ADNS.Base
34	34	import ADNS.Endian
…	…
58	58	if rc /= sOK
59	59	then return (Left rc)
60	60	else return (Right [ addr \| RRA (RRAddr addr) <- rs ])
	61
	62	-- \|Resolve a hostname's 'SRV' records.
	63
	64	resolveSRV :: Resolver -> HostName -> IO (Either Status [(HostName, PortID)])
	65	resolveSRV resolver x = do
	66	Answer rc _ _ _ rs <- resolver x SRV [] >>= takeMVar
	67	if rc /= sOK
	68	then return (Left rc)
	69	else do
	70	let cmp (RRSRV p1 _ _ _) (RRSRV p2 _ _ _) = compare p1 p2
	71	cmp _ _ = error $ showString "unexpected record in SRV lookup: " (show rs)
	72	rs' = sortBy cmp rs
	73	as = [ (host, PortNumber $ toEnum port) \| (RRSRV _ _ port host) <- rs' ]
	74	return (Right as)
61	75
62	76	-- \|Get the 'PTR' records assigned to a host address. Note
63	77	-- that although the API allows for a record to have more


1	1	An asynchronous DNS resolver for Haskell_
2	2	=========================================
3	3
4		:Latest Release: hsdns-1.4.tar.gz_
	4	:Latest Release: hsdns-1.4.1.tar.gz_
5	5	:Darcs: darcs_ get http://cryp.to/hsdns/
6	6
7	7	Synopsis
…	…
56	56
57	57	.. _Reference Documentation: docs/index.html
58	58
59		.. _hsdns-1.4.tar.gz: http://cryp.to/hsdns/hsdns-1.4.tar.gz
	59	.. _hsdns-1.4.1.tar.gz: http://cryp.to/hsdns/hsdns-1.4.1.tar.gz
60	60
61	61	.. _adns-reverse-lookup.hs: example/adns-reverse-lookup.hs


		1	{-
		2	Resolve a hostnames' SRV records, then show it
		3	-}
		4
		5	module Main ( main ) where
		6
		7	import Control.Monad ( when )
		8	import System.Environment ( getArgs )
		9	import Network.Socket ( inet_ntoa )
		10	import Data.List ( elem )
		11	import ADNS
		12
		13	main :: IO ()
		14	main = do
		15	names <- getArgs
		16	when (null names) (putStrLn "Usage: hostname [hostname ...]")
		17	initResolver [Debug] $ \resolver -> do
		18	a <- querySRV resolver $ head names
		19	case a of
		20	Just addr -> do
		21	putStrLn $ "RESULT:\n" ++ (concat $ map (\b -> (fst b) ++ (show $ snd b) ++ "\n") addr)
		22	_ -> putStrLn $ "Error in SRV " ++ (show a)
		23
		24	-- ----- Configure Emacs -----
		25	--
		26	-- Local Variables: ***
		27	-- haskell-program-name: "ghci -ladns" ***
		28	-- End: ***


1	1	Name: hsdns
2		Version: 1.4
	2	Version: 1.4.1
3	3	Author: Peter Simons <simons@cryp.to>,
4	4	Lutz Donnerhacke <lutz@iks-jena.de>
5	5	Maintainer: Peter Simons <simons@cryp.to>

Commit 5698952aa07e83659df7456635c302efe7cfd600

Gitorious