Commit 9b18586538ec6fcc682a7fb7737b03d6baec2831

Peter Simons (Committer)
Fri Feb 26 00:00:00 CET 2010
Lutz Donnerhacke <lutz @iks-…na.de> (Author)
Fri Jan 11 10:55:02 CET 2008

Tree SHA1: 03907a0
Parent SHA1: 66031a8 (fix include file names)
raw diff | raw patch

Allow retrieving generic RRTypes.
Add support for CNAME queries.
Canonify RRType before parsing responses.
Added NSEC processing and zone walking example.

Diff rendering mode:
inline
side by side


22	22	import Control.Exception ( assert, bracket )
23	23	import Network ( HostName )
24	24	import Network.Socket ( HostAddress )
	25	import Data.Bits ()
25	26	import Foreign
26	27	import Foreign.C
27	28	import ADNS.Endian
…	…
111	111
112	112	-- \|The record types we support.
113	113
114		data RRType = A \| MX \| NS \| PTR
115		deriving (Eq, Bounded, Show)
	114	data RRType = A \| CNAME \| MX \| NS \| PTR
	115	\| NSEC
	116	\| RRType Int
	117	deriving (Read)
116	118
	119	instance Eq RRType where
	120	a == b = fromEnum a == fromEnum b
	121
	122	instance Show RRType where
	123	showsPrec _ x = case toEnum $ fromEnum x of -- canonify
	124	A -> showString "A"
	125	CNAME -> showString "CNAME"
	126	MX -> showString "MX"
	127	NS -> showString "NS"
	128	PTR -> showString "PTR"
	129	NSEC -> showString "NSEC"
	130	(RRType i) -> showString "TYPE" . shows i
	131
117	132	instance Enum RRType where
118	133	toEnum #{const adns_r_a} = A
	134	toEnum #{const adns_r_cname} = CNAME
119	135	toEnum #{const adns_r_mx} = MX
120	136	toEnum #{const adns_r_ns} = NS
121	137	toEnum #{const adns_r_ptr} = PTR
122		toEnum i = error ("Network.DNS.ADNS.RRType cannot be mapped to value " ++ show i)
	138	toEnum x = case x .&. #{const adns_rrt_typemask} of
	139	47 -> NSEC
	140	i -> RRType i
123	141
124	142	fromEnum A = #{const adns_r_a}
	143	fromEnum CNAME = #{const adns_r_cname}
125	144	fromEnum MX = #{const adns_r_mx}
126	145	fromEnum NS = #{const adns_r_ns}
127	146	fromEnum PTR = #{const adns_r_ptr}
	147	fromEnum x = #{const adns_r_unknown} .\|. case x of
	148	NSEC -> 47
	149	(RRType i) -> i
	150	_ -> error "Missing case in fromEnum ADNS.Base.RRType"
128	151
129	152	instance Storable RRType where
130	153	sizeOf _ = #{size adns_rrtype}
…	…
292	292	a <- #{peek adns_rr_inthostaddr, ha} ptr
293	293	return (RRIntHostAddr (fromEnum i) a)
294	294
	295	-- \|Original definition:
	296	--
	297	-- > typedef struct {
	298	-- > int len;
	299	-- > unsigned char *data;
	300	-- > } adns_rr_byteblock;
	301
	302	data RRByteblock = RRByteblock Int (Ptr CChar)
	303
	304	instance Storable RRByteblock where
	305	sizeOf _ = #{size adns_rr_byteblock}
	306	alignment _ = alignment (undefined :: CInt)
	307	poke _ _ = fail "poke is undefined for Network.DNS.ADNS.RRByteblock"
	308	peek ptr = do
	309	l <- #{peek adns_rr_byteblock, len } ptr :: IO CInt
	310	p <- #{peek adns_rr_byteblock, data} ptr
	311	return (RRByteblock (fromEnum l) p)
	312
295	313	data Answer = Answer
296	314	{ status :: Status
297	315	-- ^ Status code for this query.
298	316	, cname :: Maybe String
299		-- ^ Always 'Nothing' for @CNAME@ queries (which are not supported yet anyway).
	317	-- ^ Always 'Nothing' for @CNAME@ queries
300	318	, owner :: Maybe String
301	319	-- ^ Only set if 'Owner' was requested for query.
302	320	, expires :: CTime
…	…
326	326
327	327	data Response
328	328	= RRA RRAddr
	329	\| RRCNAME String
329	330	\| RRMX Int RRHostAddr
330	331	\| RRNS RRHostAddr
331	332	\| RRPTR String
	333	\| RRNSEC String
	334	\| RRUNKNOWN String
332	335	deriving (Show)
333	336
334	337	instance Storable Answer where
…	…
365	365	peekResp :: RRType -> Ptr b -> Int -> Int -> IO [Response]
366	366	peekResp _ _ _ 0 = return []
367	367	peekResp rt ptr off n = do
368		r <- parseByType rt
	368	r <- parseByType (toEnum $ fromEnum rt)
369	369	rs <- peekResp rt (ptr `plusPtr` off) off (n-1)
370	370	return (r:rs)
371	371
…	…
375	375	parseByType PTR = peek (castPtr ptr) >>= peekCString >>= return . RRPTR
376	376	parseByType MX = do (RRIntHostAddr i addr) <- peek (castPtr ptr)
377	377	return (RRMX i addr)
	378	parseByType CNAME = peek (castPtr ptr) >>= peekCString >>= return . RRCNAME
	379	parseByType NSEC = do RRByteblock len rptr <- peek (castPtr ptr)
	380	(name, _) <- peekFQDNAndAdvance rptr len
	381	return $ RRNSEC name
	382	parseByType (RRType _) = do RRByteblock len rptr <- peek (castPtr ptr)
	383	str <- peekCStringLen (rptr, len)
	384	return $ RRUNKNOWN str
	385
	386
	387	-- \|This function parses a FQDN in uncompressed wire format and advances
	388	-- the pointer to the next byte after the parsed name.
	389
	390	peekFQDNAndAdvance :: Ptr a -> Int -> IO (String, Ptr a)
	391	peekFQDNAndAdvance ptr _ = do
	392	cc <- peek (castPtr ptr :: Ptr CChar)
	393	let ptr1 = ptr `plusPtr` 1
	394	case fromEnum cc of
	395	c \| c == 0 -> return ("", ptr1)
	396	\| c < 64 -> do name <- peekCStringLen (castPtr ptr1, c)
	397	(zone, ptr2) <- peekFQDNAndAdvance (ptr1 `plusPtr` c) 0
	398	return (name ++ "." ++ zone, ptr2)
	399	\| otherwise -> error "Compressed FQDN must not occur here."
	400
	401
378	402
379	403	-- * ADNS Library Functions
380	404


		1	module Main where
		2
		3	import ADNS
		4	import ADNS.Base
		5	import Control.Concurrent.MVar
		6	import System.Environment
		7
		8	main :: IO ()
		9	main = initResolver [NoErrPrint, NoServerWarn] $ \resolver -> do
		10	args <- getArgs
		11	case args of
		12	[name] -> traverse resolver name
		13	[t,name] -> work resolver (read t) name
		14	_ -> putStrLn "Usage: t [typeid] fqdn"
		15
		16	-- \| Test function to see the raw results of a given query type
		17	work :: Resolver -> RRType -> String -> IO ()
		18	work resolver t n = do
		19	putStrLn $ showString "Querying " . shows t $ showString " for " n
		20	print =<< takeMVar =<< resolver n t [QuoteOk_Query]
		21
		22	-- \| Example implementation to traverse a DNSSEC signed zone.
		23	--
		24	-- This implementation is clearly wrong, because any real zone traversal
		25	-- is done using the NSEC records in the authority section of a NXDOMAIN
		26	-- response.
		27	--
		28	-- Unfortunly the adns library does not provide access to other sections
		29	-- than the answer section, so this walk is done by querying NSEC directly.
		30	--
		31	-- If there are signed subzones, the traversal switches to the subzone
		32	-- and stops if this subzone is traversed. You may continue the traversal
		33	-- by providing the next entry after the subzone.
		34	--
		35	-- You may try this mechanism on "dnssec.iks-jena.de"
		36	traverse :: Resolver -> String -> IO ()
		37	traverse resolver x = do
		38	putStrLn x
		39	answer <- takeMVar =<< resolver x NSEC [QuoteOk_Query]
		40	case rrs answer of
		41	[RRNSEC y] \| not (x `endsWith` ('.':y)) -> traverse resolver y
		42	_ -> return ()
		43
		44	endsWith :: String -> String -> Bool
		45	endsWith x y = startsWith (reverse x) (reverse y)
		46
		47	startsWith :: String -> String -> Bool
		48	startsWith (x:xs) (y:ys) = x == y && startsWith xs ys
		49	startsWith _ ys = null ys


23	23	Main-Is: adns-reverse-lookup.hs
24	24	Extra-Libraries: adns
25	25	GHC-Options: -O -Wall -threaded
	26
	27	Executable: adns-test-and-traverse
	28	Hs-Source-Dirs: example, .
	29	Main-Is: adns-test-and-traverse.hs
	30	Extra-Libraries: adns
	31	GHC-Options: -O -Wall -threaded

Commit 9b18586538ec6fcc682a7fb7737b03d6baec2831

Gitorious