hsdns 1.1 → 1.3
raw patch · 21 files changed
+1295/−2173 lines, 21 filesdep +containersdep ~basesetup-changed
Dependencies added: containers
Dependency ranges changed: base
Files
- ADNS.hs +43/−0
- ADNS/Base.hsc +613/−0
- ADNS/Endian.hs +69/−0
- ADNS/Resolver.hs +178/−0
- COPYING +165/−0
- Data/Endian.hs +0/−41
- LICENSE +0/−340
- Network/DNS.hs +0/−78
- Network/DNS/ADNS.hs +0/−687
- Network/DNS/ADNS.hsc +0/−577
- Network/DNS/PollResolver.hs +0/−226
- Network/IP/Address.hs +0/−48
- README +61/−0
- Setup.hs +0/−5
- Setup.lhs +8/−0
- System/Posix/GetTimeOfDay.hsc +0/−54
- System/Posix/Poll.hsc +0/−91
- example/adns-reverse-lookup.hs +60/−0
- example/adns-test-and-traverse.hs +49/−0
- hsdns.cabal +45/−26
- prologue.txt +4/−0
+ ADNS.hs view
@@ -0,0 +1,43 @@+{- |+ Module : ADNS+ Copyright : (c) 2008 Peter Simons+ License : LGPL++ Maintainer : simons@cryp.to+ Stability : provisional+ Portability : portable++ An asynchronous DNS resolver based on GNU ADNS+ <http://www.gnu.org/software/adns/>. You should link your+ program with the /threaded/ runtime-system when using this+ module. In GHC, this is accomplished by specifying @-threaded@+ on the command-line.+-}++module ADNS+ ( HostName, HostAddress+ , Resolver, initResolver, InitFlag(..)+ , queryA, queryPTR, queryMX+ , dummyDNS+ )+ where++import Network ( HostName )+import Network.Socket ( HostAddress )+import ADNS.Base+import ADNS.Resolver++queryA :: Resolver -> HostName -> IO (Maybe [HostAddress])+queryA = query resolveA++queryPTR :: Resolver -> HostAddress -> IO (Maybe [HostName])+queryPTR = query resolvePTR++queryMX :: Resolver -> HostName -> IO (Maybe [(HostName, HostAddress)])+queryMX = query resolveMX++-- ----- Configure Emacs -----+--+-- Local Variables: ***+-- haskell-program-name: "ghci -ladns" ***+-- End: ***
+ ADNS/Base.hsc view
@@ -0,0 +1,613 @@+{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}+{- |+ Module : ADNS.Base+ Copyright : (c) 2008 by Peter Simons+ License : LGPL++ Maintainer : simons@cryp.to+ Stability : provisional+ Portability : ForeignFunctionInterface++ This module provides bindings to GNU ADNS, a domain name+ resolver library written in C. ADNS is available from+ <http://www.gnu.org/software/adns/>.++ You will most likely not need this module directly: "ADNS"+ provides a simpler API for the Haskell world; this module+ contains mostly marshaling code.+ -}++module ADNS.Base where++import Control.Exception ( assert, bracket )+import Network ( HostName )+import Network.Socket ( HostAddress )+import Foreign+import Foreign.C+import ADNS.Endian++#include <adns.h>+#include <errno.h>++-- * Marshaled ADNS Data Types++data OpaqueState+type AdnsState = Ptr OpaqueState++data OpaqueQuery+type Query = Ptr OpaqueQuery++data InitFlag+ = NoEnv -- ^ do not look at environment+ | NoErrPrint -- ^ never print output to stderr ('Debug' overrides)+ | NoServerWarn -- ^ do not warn to stderr about duff nameservers etc+ | Debug -- ^ enable all output to stderr plus 'Debug' msgs+ | LogPid -- ^ include process id in diagnostic output+ | NoAutoSys -- ^ do not make syscalls at every opportunity+ | Eintr -- ^ allow 'adnsSynch' to return 'eINTR'+ | NoSigPipe -- ^ application has SIGPIPE set to SIG_IGN, do not protect+ | CheckC_EntEx -- ^ do consistency checks on entry\/exit to adns functions+ | CheckC_Freq -- ^ do consistency checks very frequently (slow!)+ deriving (Eq, Bounded, Show)++instance Enum InitFlag where+ toEnum #{const adns_if_noenv} = NoEnv+ toEnum #{const adns_if_noerrprint} = NoErrPrint+ toEnum #{const adns_if_noserverwarn} = NoServerWarn+ toEnum #{const adns_if_debug} = Debug+ toEnum #{const adns_if_logpid} = LogPid+ toEnum #{const adns_if_noautosys} = NoAutoSys+ toEnum #{const adns_if_eintr} = Eintr+ toEnum #{const adns_if_nosigpipe} = NoSigPipe+ toEnum #{const adns_if_checkc_entex} = CheckC_EntEx+ toEnum #{const adns_if_checkc_freq} = CheckC_Freq+ toEnum i = error ("Network.DNS.ADNS.InitFlag cannot be mapped to value " ++ show i)++ fromEnum NoEnv = #{const adns_if_noenv}+ fromEnum NoErrPrint = #{const adns_if_noerrprint}+ fromEnum NoServerWarn = #{const adns_if_noserverwarn}+ fromEnum Debug = #{const adns_if_debug}+ fromEnum LogPid = #{const adns_if_logpid}+ fromEnum NoAutoSys = #{const adns_if_noautosys}+ fromEnum Eintr = #{const adns_if_eintr}+ fromEnum NoSigPipe = #{const adns_if_nosigpipe}+ fromEnum CheckC_EntEx = #{const adns_if_checkc_entex}+ fromEnum CheckC_Freq = #{const adns_if_checkc_freq}++data QueryFlag+ = Search -- ^ use the searchlist+ | UseVC -- ^ use a virtual circuit (TCP connection)+ | Owner -- ^ fill in the owner field in the answer+ | QuoteOk_Query -- ^ allow special chars in query domain+ | QuoteOk_CName -- ^ allow special chars in CNAME we go via (default)+ | QuoteOk_AnsHost -- ^ allow special chars in things supposed to be hostnames+ | QuoteFail_CName -- ^ refuse if quote-req chars in CNAME we go via+ | CName_Loose -- ^ allow refs to CNAMEs - without, get _s_cname+ | CName_Forbid -- ^ don't follow CNAMEs, instead give _s_cname+ deriving (Eq, Bounded, Show)++instance Enum QueryFlag where+ toEnum #{const adns_qf_search} = Search+ toEnum #{const adns_qf_usevc} = UseVC+ toEnum #{const adns_qf_owner} = Owner+ toEnum #{const adns_qf_quoteok_query} = QuoteOk_Query+ toEnum #{const adns_qf_quoteok_cname} = QuoteOk_CName+ toEnum #{const adns_qf_quoteok_anshost} = QuoteOk_AnsHost+ toEnum #{const adns_qf_quotefail_cname} = QuoteFail_CName+ toEnum #{const adns_qf_cname_loose} = CName_Loose+ toEnum #{const adns_qf_cname_forbid} = CName_Forbid+ toEnum i = error ("Network.DNS.ADNS.QueryFlag cannot be mapped to value " ++ show i)++ fromEnum Search = #{const adns_qf_search}+ fromEnum UseVC = #{const adns_qf_usevc}+ fromEnum Owner = #{const adns_qf_owner}+ fromEnum QuoteOk_Query = #{const adns_qf_quoteok_query}+ fromEnum QuoteOk_CName = #{const adns_qf_quoteok_cname}+ fromEnum QuoteOk_AnsHost = #{const adns_qf_quoteok_anshost}+ fromEnum QuoteFail_CName = #{const adns_qf_quotefail_cname}+ fromEnum CName_Loose = #{const adns_qf_cname_loose}+ fromEnum CName_Forbid = #{const adns_qf_cname_forbid}++-- |The record types we support.++data RRType = A | CNAME | MX | NS | PTR+ | NSEC+ | RRType Int+ deriving (Read)++instance Eq RRType where+ a == b = fromEnum a == fromEnum b++instance Show RRType where+ showsPrec _ x = case toEnum $ fromEnum x of -- canonify+ A -> showString "A"+ CNAME -> showString "CNAME"+ MX -> showString "MX"+ NS -> showString "NS"+ PTR -> showString "PTR"+ NSEC -> showString "NSEC"+ (RRType i) -> showString "TYPE" . shows i++instance Enum RRType where+ toEnum #{const adns_r_a} = A+ toEnum #{const adns_r_cname} = CNAME+ toEnum #{const adns_r_mx} = MX+ toEnum #{const adns_r_ns} = NS+ toEnum #{const adns_r_ptr} = PTR+ toEnum x = case x .&. #{const adns_rrt_typemask} of+ 47 -> NSEC+ i -> RRType i++ fromEnum A = #{const adns_r_a}+ fromEnum CNAME = #{const adns_r_cname}+ fromEnum MX = #{const adns_r_mx}+ fromEnum NS = #{const adns_r_ns}+ fromEnum PTR = #{const adns_r_ptr}+ fromEnum x = #{const adns_r_unknown} .|. case x of+ NSEC -> 47+ (RRType i) -> i+ _ -> error "Missing case in fromEnum ADNS.Base.RRType"++instance Storable RRType where+ sizeOf _ = #{size adns_rrtype}+ alignment _ = alignment (undefined :: #{type adns_rrtype})+ poke ptr t = let p = castPtr ptr :: Ptr #{type adns_rrtype}+ in poke p ((toEnum . fromEnum) t)+ peek ptr = let p = castPtr ptr :: Ptr #{type adns_rrtype}+ in peek p >>= return . toEnum . fromEnum++-- |The status codes recognized by ADNS vary in different+-- versions of the library. So instead of providing an+-- 'Enum', the 'Status' type contains the numeric value as+-- returned by ADNS itself. For common status codes, helper+-- functions like 'sOK' or 'sNXDOMAIN' are provided. The+-- functions 'adnsErrTypeAbbrev', 'adnsErrAbbrev', and+-- 'adnsStrerror' can also be used to map these codes into+-- human readable strings.++newtype Status = StatusCode Int+ deriving (Eq, Show)++#enum Status, StatusCode \+ , sOK = adns_s_ok \+ , sNOMEMORY = adns_s_nomemory \+ , sUNKNOWNRRTYPE = adns_s_unknownrrtype \+ , sSYSTEMFAIL = adns_s_systemfail \+ , sMAX_LOCALFAIL = adns_s_max_localfail \+ , sTIMEOUT = adns_s_timeout \+ , sALLSERVFAIL = adns_s_allservfail \+ , sNORECURSE = adns_s_norecurse \+ , sINVALIDRESPONSE = adns_s_invalidresponse \+ , sUNKNOWNFORMAT = adns_s_unknownformat \+ , sMAX_REMOTEFAIL = adns_s_max_remotefail \+ , sRCODESERVFAIL = adns_s_rcodeservfail \+ , sRCODEFORMATERROR = adns_s_rcodeformaterror \+ , sRCODENOTIMPLEMENTED = adns_s_rcodenotimplemented \+ , sRCODEREFUSED = adns_s_rcoderefused \+ , sRCODEUNKNOWN = adns_s_rcodeunknown \+ , sMAX_TEMPFAIL = adns_s_max_tempfail \+ , sINCONSISTENT = adns_s_inconsistent \+ , sPROHIBITEDCNAME = adns_s_prohibitedcname \+ , sANSWERDOMAININVALID = adns_s_answerdomaininvalid \+ , sANSWERDOMAINTOOLONG = adns_s_answerdomaintoolong \+ , sINVALIDDATA = adns_s_invaliddata \+ , sMAX_MISCONFIG = adns_s_max_misconfig \+ , sQUERYDOMAINWRONG = adns_s_querydomainwrong \+ , sQUERYDOMAININVALID = adns_s_querydomaininvalid \+ , sQUERYDOMAINTOOLONG = adns_s_querydomaintoolong \+ , sMAX_MISQUERY = adns_s_max_misquery \+ , sNXDOMAIN = adns_s_nxdomain \+ , sNODATA = adns_s_nodata \+ , sMAX_PERMFAIL = adns_s_max_permfail++-- |Original definition:+--+-- > typedef struct {+-- > int len;+-- > union {+-- > struct sockaddr sa;+-- > struct sockaddr_in inet;+-- > } addr;+-- > } adns_rr_addr;+--+-- /Note/: Anything but @sockaddr_in@ will cause 'peek' to call 'fail',+-- when marshaling this structure. 'poke' is not defined.++newtype RRAddr = RRAddr HostAddress+ deriving (Eq)++instance Show RRAddr where+ show (RRAddr ha) = shows b1 . ('.':) .+ shows b2 . ('.':) .+ shows b3 . ('.':) .+ shows b4 $ ""+ where+ (b1,b2,b3,b4) = readWord32 ha++instance Storable RRAddr where+ sizeOf _ = #{size adns_rr_addr}+ alignment _ = alignment (undefined :: CInt)+ poke _ _ = fail "poke is undefined for Network.DNS.ADNS.RRAddr"+ peek ptr' = do+ let ptr = #{ptr adns_rr_addr, addr} ptr'+ t <- #{peek struct sockaddr_in, sin_family} ptr :: IO #{type sa_family_t}+ if (t /= #{const AF_INET})+ then fail ("peek Network.DNS.ADNS.RRAddr: unsupported 'sockaddr' type " ++ show t)+ else #{peek struct sockaddr_in, sin_addr} ptr >>= return . RRAddr++-- |Original definition:+--+-- > typedef struct {+-- > char *host;+-- > adns_status astatus;+-- > int naddrs; /* temp fail => -1, perm fail => 0, s_ok => >0+-- > adns_rr_addr *addrs;+-- > } adns_rr_hostaddr;+--+-- The @naddrs@ field is not available in @RRHostAddr@+-- because I couldn't see how that information wouldn't be+-- available in the @astatus@ field too. If I missed+-- anything, please let me know.+--+-- /Note/: The data type should probably contain+-- 'HostAddress' rather than 'RRAddr'. I'm using the former+-- only because it has nicer output with 'show'. 'poke' is+-- not defined.++data RRHostAddr = RRHostAddr HostName Status [RRAddr]+ deriving (Show)++instance Storable RRHostAddr where+ sizeOf _ = #{size adns_rr_hostaddr}+ alignment _ = alignment (undefined :: CString)+ poke _ _ = fail "poke is undefined for Network.DNS.ADNS.RRHostAddr"+ peek ptr = do+ h <- #{peek adns_rr_hostaddr, host} ptr+ hstr <- assert (h /= nullPtr) (peekCString h)+ st <- #{peek adns_rr_hostaddr, astatus} ptr+ nadr <- #{peek adns_rr_hostaddr, naddrs} ptr :: IO #{type adns_status}+ aptr <- #{peek adns_rr_hostaddr, addrs} ptr+ adrs <- if (nadr > 0)+ then peekArray (fromEnum nadr) aptr+ else return []+ return (RRHostAddr hstr (StatusCode st) adrs)++-- |Original definition:+--+-- > typedef struct {+-- > int i;+-- > adns_rr_hostaddr ha;+-- > } adns_rr_inthostaddr;++data RRIntHostAddr = RRIntHostAddr Int RRHostAddr+ deriving (Show)++instance Storable RRIntHostAddr where+ sizeOf _ = #{size adns_rr_inthostaddr}+ alignment _ = alignment (undefined :: CInt)+ poke _ _ = fail "poke is undefined for Network.DNS.ADNS.RRIntHostAddr"+ peek ptr = do+ i <- #{peek adns_rr_inthostaddr, i} ptr :: IO CInt+ a <- #{peek adns_rr_inthostaddr, ha} ptr+ return (RRIntHostAddr (fromEnum i) a)++-- |Original definition:+--+-- > typedef struct {+-- > int len;+-- > unsigned char *data;+-- > } adns_rr_byteblock;++data RRByteblock = RRByteblock Int (Ptr CChar)++instance Storable RRByteblock where+ sizeOf _ = #{size adns_rr_byteblock}+ alignment _ = alignment (undefined :: CInt)+ poke _ _ = fail "poke is undefined for Network.DNS.ADNS.RRByteblock"+ peek ptr = do+ l <- #{peek adns_rr_byteblock, len } ptr :: IO CInt+ p <- #{peek adns_rr_byteblock, data} ptr+ return (RRByteblock (fromEnum l) p)++data Answer = Answer+ { status :: Status+ -- ^ Status code for this query.+ , cname :: Maybe String+ -- ^ Always 'Nothing' for @CNAME@ queries+ , owner :: Maybe String+ -- ^ Only set if 'Owner' was requested for query.+ , expires :: CTime+ -- ^ Only defined if status is 'sOK', 'sNXDOMAIN', or 'sNODATA'.+ , rrs :: [Response]+ -- ^ The list will be empty if an error occured.+ }+ deriving (Show)++data Response+ = RRA RRAddr+ | RRCNAME String+ | RRMX Int RRHostAddr+ | RRNS RRHostAddr+ | RRPTR String+ | RRNSEC String+ | RRUNKNOWN String+ deriving (Show)++instance Storable Answer where+ sizeOf _ = #{size adns_answer}+ alignment _ = alignment (undefined :: CInt)+ poke _ _ = fail "poke is not defined for Network.DNS.ADNS.Answer"+ peek ptr = do+ sc <- #{peek adns_answer, status} ptr+ cn <- #{peek adns_answer, cname} ptr >>= maybePeek peekCString+ ow <- #{peek adns_answer, owner} ptr >>= maybePeek peekCString+ et <- #{peek adns_answer, expires} ptr+ rt <- #{peek adns_answer, type} ptr+ rs <- #{peek adns_answer, nrrs} ptr :: IO CInt+ sz <- (#{peek adns_answer, rrsz} ptr) :: IO CInt+ rrsp <- #{peek adns_answer, rrs} ptr+ r <- peekResp rt rrsp (fromEnum sz) (fromEnum rs)+ return Answer+ { status = StatusCode sc+ , cname = cn+ , owner = ow+ , expires = et+ , rrs = r+ }++-- |This function parses the 'Response' union found in+-- 'Answer'. It cannot be defined via 'Storable' because it+-- needs to know the type of the record to expect. This is,+-- by the way, the function to look at, if you want to add+-- support for additional 'RRType' records.++peekResp :: RRType -> Ptr b -> Int -> Int -> IO [Response]+peekResp _ _ _ 0 = return []+peekResp rt ptr off n = do+ r <- parseByType (toEnum $ fromEnum rt)+ rs <- peekResp rt (ptr `plusPtr` off) off (n-1)+ return (r:rs)++ where+ parseByType A = peek (castPtr ptr) >>= return . RRA . RRAddr+ parseByType NS = peek (castPtr ptr) >>= return . RRNS+ parseByType PTR = peek (castPtr ptr) >>= peekCString >>= return . RRPTR+ parseByType MX = do (RRIntHostAddr i addr) <- peek (castPtr ptr)+ return (RRMX i addr)+ parseByType CNAME = peek (castPtr ptr) >>= peekCString >>= return . RRCNAME+ parseByType NSEC = do RRByteblock len rptr <- peek (castPtr ptr)+ (name, _) <- peekFQDNAndAdvance rptr len+ return $ RRNSEC name+ parseByType (RRType _) = do RRByteblock len rptr <- peek (castPtr ptr)+ str <- peekCStringLen (rptr, len)+ return $ RRUNKNOWN str+++-- |This function parses a FQDN in uncompressed wire format and advances+-- the pointer to the next byte after the parsed name.++peekFQDNAndAdvance :: Ptr a -> Int -> IO (String, Ptr a)+peekFQDNAndAdvance ptr _ = do+ cc <- peek (castPtr ptr :: Ptr CChar)+ let ptr1 = ptr `plusPtr` 1+ case fromEnum cc of+ c | c == 0 -> return ("", ptr1)+ | c < 64 -> do name <- peekCStringLen (castPtr ptr1, c)+ (zone, ptr2) <- peekFQDNAndAdvance (ptr1 `plusPtr` c) 0+ return (name ++ "." ++ zone, ptr2)+ | otherwise -> error "Compressed FQDN must not occur here."++++-- * ADNS Library Functions++-- |Run the given 'IO' computation with an initialized+-- resolver. As of now, the diagnose stream is always set to+-- 'System.IO.stderr'. Initialize the library with 'NoErrPrint' if you+-- don't wont to see any error output. All resources are+-- freed when @adnsInit@ returns.++adnsInit :: [InitFlag] -> (AdnsState -> IO a) -> IO a+adnsInit flags =+ bracket+ (wrapAdns (\p -> adns_init p (mkFlags flags) nullPtr) peek)+ adns_finish++-- |Similar to 'adnsInit', but reads the resolver+-- configuration from a string rather than from+-- @\/etc\/resolv.conf@. Supported are the usual commands:+-- @nameserver@, @search@, @domain@, @sortlist@, and+-- @options@.+--+-- Additionally, these non-standard commands may be used:+--+-- * @clearnameservers@: Clears the list of nameservers.+--+-- * @include filename@: The specified file will be read.++adnsInitCfg :: [InitFlag] -> String -> (AdnsState -> IO a) -> IO a+adnsInitCfg flags cfg = bracket mkState adns_finish+ where+ mkState = withCString cfg $ \cstr ->+ wrapAdns+ (\p -> adns_init_strcfg p (mkFlags flags) nullPtr cstr)+ peek++-- |Perform a synchronous query for a record. In case of an+-- I\/O error, an 'System.IO.Error.IOException' is thrown.+-- If the query fails for other reasons, the 'Status' code+-- in the 'Answer' will signify that.++adnsSynch :: AdnsState -> String -> RRType -> [QueryFlag] -> IO Answer+adnsSynch st own rrt flags =+ withCString own $ \o -> do+ let rrt' = (toEnum . fromEnum) rrt+ wrapAdns+ (adns_synchronous st o rrt' (mkFlags flags))+ (\p -> peek p >>= peek)++-- |Submit an asynchronous query. The returned 'Query' can+-- be tested for completion with 'adnsCheck'.++adnsSubmit :: AdnsState -> String -> RRType -> [QueryFlag] -> IO Query+adnsSubmit st own rrt flags =+ withCString own $ \o -> do+ let rrt' = (toEnum . fromEnum) rrt+ wrapAdns+ (adns_submit st o rrt' (mkFlags flags) nullPtr)+ (peek)++-- |Check the status of an asynchronous query. If the query+-- is complete, the 'Answer' will be returned. The 'Query'+-- becomes invalid after that.++adnsCheck :: AdnsState -> Query -> IO (Maybe Answer)+adnsCheck st q =+ alloca $ \qPtr ->+ alloca $ \aPtr -> do+ poke qPtr q+ poke aPtr nullPtr+ rc <- adns_check st qPtr aPtr nullPtr+ case rc of+ 0 -> peek aPtr >>= peek >>= return . Just+ #{const EAGAIN} -> return Nothing+ _ -> do p <- adns_strerror rc+ s <- peekCString p+ fail ("adnsCheck: " ++ s)++-- |Wait for a response to arrive. The returned 'Query' is+-- invalid and must not be passed to ADNS again. If 'Nothing' is+-- returned, the resolver is empty.++adnsWait :: AdnsState -> IO (Maybe (Query,Answer))+adnsWait st =+ alloca $ \qPtr ->+ alloca $ \aPtr -> do+ poke qPtr nullPtr+ poke aPtr nullPtr+ rc <- adns_wait st qPtr aPtr nullPtr+ case rc of+ 0 -> do q <- peek qPtr+ a' <- peek aPtr+ a <- peek a'+ free a'+ return (Just (q,a))+ #{const ESRCH} -> return Nothing+ _ -> do p <- adns_strerror rc+ s <- peekCString p+ fail ("adnsWait: " ++ s)++-- |Cancel an open 'Query'.++foreign import ccall unsafe "adns_cancel" adnsCancel :: Query -> IO ()++-- |Wait for the next 'Query' to become available.++foreign import ccall safe adns_wait ::+ AdnsState -> Ptr Query -> Ptr (Ptr Answer) -> Ptr (Ptr a) -> IO CInt++-- |Return the list of all currently open queries.++adnsQueries :: AdnsState -> IO [Query]+adnsQueries st = adns_forallqueries_begin st >> walk+ where walk = do q <- adns_forallqueries_next st nullPtr+ if (q /= nullPtr)+ then walk >>= return . ((:) q)+ else return []+++-- |Map a 'Status' code to a human-readable error+-- description. For example:+--+-- > *ADNS> adnsStrerror sNXDOMAIN >>= print+-- > "No such domain"+--+-- Use this function with great care: It will crash the+-- process when called with a status code that ADNS doesn't+-- know about. So use it only to print values you got from+-- the resolver!++adnsStrerror :: Status -> IO String+adnsStrerror (StatusCode x) = do+ cstr <- (adns_strerror . toEnum . fromEnum) x+ assert (cstr /= nullPtr) (peekCString cstr)++-- |Map a 'Status' code to a short error name. Don't use+-- this function to print a status code unless you've+-- obtained it from the resolver!++adnsErrAbbrev :: Status -> IO String+adnsErrAbbrev (StatusCode x) = do+ cstr <- (adns_errabbrev . toEnum . fromEnum) x+ assert (cstr /= nullPtr) (peekCString cstr)++-- |Map a 'Status' code to a short description of the type+-- of error. Don't use this function to print a status code+-- unless you've obtained it from the resolver!++adnsErrTypeAbbrev :: Status -> IO String+adnsErrTypeAbbrev (StatusCode x) = do+ cstr <- (adns_errtypeabbrev . toEnum . fromEnum) x+ assert (cstr /= nullPtr) (peekCString cstr)++-- * Unmarshaled Low-Level C Functions++foreign import ccall unsafe adns_init ::+ Ptr AdnsState -> CInt -> Ptr CFile -> IO CInt++foreign import ccall unsafe adns_init_strcfg ::+ Ptr AdnsState -> CInt -> Ptr CFile -> CString-> IO CInt++foreign import ccall unsafe adns_finish ::+ AdnsState -> IO ()++foreign import ccall unsafe adns_submit ::+ AdnsState -> CString -> CInt -> CInt -> Ptr a -> Ptr Query+ -> IO CInt++foreign import ccall unsafe adns_check ::+ AdnsState -> Ptr Query -> Ptr (Ptr Answer) -> Ptr (Ptr a)+ -> IO CInt++foreign import ccall unsafe adns_synchronous ::+ AdnsState -> CString -> CInt -> CInt -> Ptr (Ptr Answer)+ -> IO CInt++foreign import ccall unsafe adns_forallqueries_begin ::+ AdnsState -> IO ()++foreign import ccall unsafe adns_forallqueries_next ::+ AdnsState -> Ptr (Ptr a) -> IO Query++foreign import ccall unsafe adns_strerror :: CInt -> IO CString+foreign import ccall unsafe adns_errabbrev :: CInt -> IO CString+foreign import ccall unsafe adns_errtypeabbrev :: CInt -> IO CString++-- * Helper Functions++-- |Internel helper function to handle result passing from+-- ADNS via @Ptr (Ptr a)@, and to generate human-readable IO+-- exceptions in case of an error.++wrapAdns :: (Ptr (Ptr b) -> IO CInt) -> (Ptr (Ptr b) -> IO a) -> IO a+wrapAdns m acc = alloca $ \resP -> do+ poke resP nullPtr+ rc <- m resP+ if (rc == 0)+ then acc resP+ else do p <- adns_strerror rc+ s <- peekCString p+ fail ("ADNS: " ++ s)++-- |Map a list of flags ('Enum' types) into a 'CInt'+-- suitable for adns calls.++mkFlags :: Enum a => [a] -> CInt+mkFlags = toEnum . sum . map fromEnum+++-- ----- Configure Emacs -----+--+-- Local Variables: ***+-- haskell-program-name: "ghci -ladns" ***+-- End: ***
+ ADNS/Endian.hs view
@@ -0,0 +1,69 @@+{- |+ Module : ADNS.Endian+ Copyright : (c) 2008 Peter Simons+ License : LGPL++ Maintainer : simons@cryp.to+ Stability : provisional+ Portability : portable++ Determine the machine's endian.+-}++module ADNS.Endian ( Endian(..), endian, readWord32, readWord16 ) where++import Foreign++-- |Signify the system's native byte order according to+-- significance of bytes from low addresses to high addresses.++data Endian+ = LittleEndian -- ^ byte order: @1234@+ | BigEndian -- ^ byte order: @4321@+ | PDPEndian -- ^ byte order: @3412@+ deriving (Show, Eq)++-- |The endian of this machine, determined at run-time.++{-# NOINLINE endian #-}+endian :: Endian+endian =+ unsafePerformIO $+ allocaArray (sizeOf (undefined :: Word32)) $ \p -> do+ let val = 0x01020304 :: Word32+ poke p val+ let p' = castPtr p :: Ptr Word8+ val' <- peekArray 4 p'+ case val' of+ (0x01:0x02:0x03:0x04:[]) -> return BigEndian+ (0x04:0x03:0x02:0x01:[]) -> return LittleEndian+ (0x03:0x04:0x01:0x02:[]) -> return PDPEndian+ _ -> error "unknown endian"++-- |Parse a host-ordered 32-bit word into a network-ordered tuple+-- of 8-bit words.++readWord32 :: Word32 -> (Word8, Word8, Word8, Word)+readWord32 n =+ let (b1,n1) = (n .&. 255, n `shiftR` 8)+ (b2,n2) = (n1 .&. 255, n1 `shiftR` 8)+ (b3,n3) = (n2 .&. 255, n2 `shiftR` 8)+ b4 = n3 .&. 255+ in+ case endian of+ BigEndian -> (fromIntegral b4, fromIntegral b3, fromIntegral b2, fromIntegral b1)+ LittleEndian -> (fromIntegral b1, fromIntegral b2, fromIntegral b3, fromIntegral b4)+ PDPEndian -> (fromIntegral b2, fromIntegral b1, fromIntegral b4, fromIntegral b3)++-- |Parse a host-ordered 16-bit word into a network-ordered tuple of+-- 8-bit words.++readWord16 :: Word16 -> (Word8, Word8)+readWord16 n =+ let (b1,n1) = (n .&. 255, n `shiftR` 8)+ b2 = n1 .&. 255+ in+ case endian of+ BigEndian -> (fromIntegral b2, fromIntegral b1)+ LittleEndian -> (fromIntegral b1, fromIntegral b2)+ PDPEndian -> (fromIntegral b2, fromIntegral b1)
+ ADNS/Resolver.hs view
@@ -0,0 +1,178 @@+{- |+ Module : ADNS.Resolver+ Copyright : (c) 2008 Peter Simons+ License : LGPL++ Maintainer : simons@cryp.to+ Stability : provisional+ Portability : portable++ This module implements a Haskell DNS Resolver on top of the+ ADNS library. GHC users should compile their code using the+ @-threaded@ runtime system.+ -}++module ADNS.Resolver+ ( Resolver+ , initResolver+ , toPTR+ , resolveA, resolvePTR, resolveMX+ , query+ , dummyDNS+ )+ where++import Control.Concurrent ( forkIO )+import Control.Concurrent.MVar+import Control.Monad ( when )+import Data.List ( sortBy )+import Data.Map ( Map )+import qualified Data.Map as Map+import Network ( HostName )+import Network.Socket ( HostAddress )+import ADNS.Base+import ADNS.Endian++-- |A 'Resolver' is an 'IO' computation which -- given the name+-- and type of the record to query -- returns an 'MVar' that will+-- eventually contain the 'Answer' from the Domain Name System.++type Resolver = String -> RRType -> [QueryFlag] -> IO (MVar Answer)++-- |Run the given 'IO' computation with an Initialized+-- 'Resolver'. Note that resolver functions can be shared,+-- and /should/ be shared between any number of 'IO'+-- threads. You may use multiple resolvers, of course, but+-- doing so defeats the purpose of an asynchronous resolver.++initResolver :: [InitFlag] -> (Resolver -> IO a) -> IO a+initResolver flags f =+ adnsInit flags $ \dns ->+ newMVar (RState dns Map.empty) >>= f . resolve++-- |Resolve a hostname's 'A' records.++resolveA :: Resolver -> HostName -> IO (Either Status [HostAddress])+resolveA resolver x = do+ Answer rc _ _ _ rs <- resolver x A [] >>= takeMVar+ if rc /= sOK+ then return (Left rc)+ else return (Right [ addr | RRA (RRAddr addr) <- rs ])++-- |Get the 'PTR' records assigned to a host address. Note+-- that although the API allows for a record to have more+-- than one 'PTR' entry, this will actually not happen+-- because the GNU adns library can't handle this case and+-- will return 'sINCONSISTENT'.++resolvePTR :: Resolver -> HostAddress -> IO (Either Status [HostName])+resolvePTR resolver x = do+ Answer rc _ _ _ rs <- resolver (toPTR x) PTR [] >>= takeMVar+ if rc /= sOK+ then return (Left rc)+ else return (Right [ addr | RRPTR addr <- rs ])++-- |Resolve the mail exchangers for a hostname. The returned+-- list may contain more than one entry per hostname, in+-- case the host has several 'A' records. The records are+-- returned in the order you should try to contact them as+-- determined by the priority in the 'RRMX' response.++resolveMX :: Resolver -> HostName -> IO (Either Status [(HostName, HostAddress)])+resolveMX resolver x = do+ Answer rc _ _ _ rs <- resolver x MX [] >>= takeMVar+ if rc /= sOK+ then return (Left rc)+ else do+ let cmp (RRMX p1 _) (RRMX p2 _) = compare p1 p2+ cmp _ _= error $ showString "unexpected record in MX lookup: " (show rs)+ rs' = sortBy cmp rs+ as = [ (hn,a) | RRMX _ (RRHostAddr hn stat has) <- rs'+ , stat == sOK && not (null has)+ , RRAddr a <- has ]+ return (Right as)++-- |Convenience wrapper that will modify any of the+-- @revolveXXX@ functions above to return 'Maybe' rather+-- than 'Either'. The idea is that @Nothing@ signifies any+-- sort of failure: @Just []@ signifies 'sNXDOMAIN' or+-- 'sNODATA', and everything else signifies 'sOK'.+--+-- So if you aren't interested in getting accurate 'Status'+-- codes in case of failures. Wrap your DNS queries as+-- follows:+--+-- > queryA :: Resolver -> HostName -> IO (Maybe [HostAddress])+-- > queryA = query resolveA++query :: (Resolver -> a -> IO (Either Status [b]))+ -> (Resolver -> a -> IO (Maybe [b]))+query f dns x = fmap toMaybe (f dns x)+ where+ toMaybe (Left rc)+ | rc == sNXDOMAIN = Just []+ | rc == sNODATA = Just []+ | otherwise = Nothing+ toMaybe (Right r) = Just r++-- |Use this function to disable DNS resolving. It will+-- always return @('Answer' 'sSYSTEMFAIL' Nothing (Just+-- host) (-1) [])@.++dummyDNS :: Resolver+dummyDNS host _ _ = newMVar+ (Answer sSYSTEMFAIL Nothing (Just host) (-1) [])++-- |Print an IP host address as a string suitable for 'PTR' lookups.++toPTR :: HostAddress -> String+toPTR ha = shows b4 . ('.':) .+ shows b3 . ('.':) .+ shows b2 . ('.':) .+ shows b1 $ ".in-addr.arpa."+ where+ (b1,b2,b3,b4) = readWord32 ha++-- * Implementation++-- |The internal state of the resolver is stored in an+-- 'MVar' so that it is shared (and synchronized) between+-- any number of concurrent 'IO' threads.++data ResolverState = RState+ { adns :: AdnsState -- ^ opaque ADNS state+ , queries :: Map Query (MVar Answer) -- ^ currently open queries+ }++-- |Submit a DNS query to the resolver and check whether we+-- have a running 'resolveLoop' thread already. If we don't,+-- start one with 'forkIO'. Make sure you link the threaded+-- RTS so that the main loop will not block other threads.++resolve :: MVar ResolverState -> Resolver+resolve mst r rt qfs = modifyMVar mst $ \st -> do+ res <- newEmptyMVar+ q <- adnsSubmit (adns st) r rt qfs+ when (Map.null (queries st))+ (forkIO (resolveLoop mst) >> return ())+ let st' = st { queries = Map.insert q res (queries st) }+ return (st', res)++-- |Loop until all open queries have been resolved.++resolveLoop :: MVar ResolverState -> IO ()+resolveLoop mst = do+ more <- modifyMVar mst $ \(RState dns qs) -> do+ r <- adnsWait dns+ case r of+ Nothing -> return (RState dns qs, False)+ Just (q,a) -> do mv <- Map.lookup q qs+ putMVar mv a+ return (RState dns (Map.delete q qs), True)+ when more (resolveLoop mst)++-- ----- Configure Emacs -----+--+-- Local Variables: ***+-- haskell-program-name: "ghci -ladns" ***+-- End: ***
+ COPYING view
@@ -0,0 +1,165 @@+ GNU LESSER GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.+++ This version of the GNU Lesser General Public License incorporates+the terms and conditions of version 3 of the GNU General Public+License, supplemented by the additional permissions listed below.++ 0. Additional Definitions. ++ As used herein, "this License" refers to version 3 of the GNU Lesser+General Public License, and the "GNU GPL" refers to version 3 of the GNU+General Public License.++ "The Library" refers to a covered work governed by this License,+other than an Application or a Combined Work as defined below.++ An "Application" is any work that makes use of an interface provided+by the Library, but which is not otherwise based on the Library.+Defining a subclass of a class defined by the Library is deemed a mode+of using an interface provided by the Library.++ A "Combined Work" is a work produced by combining or linking an+Application with the Library. The particular version of the Library+with which the Combined Work was made is also called the "Linked+Version".++ The "Minimal Corresponding Source" for a Combined Work means the+Corresponding Source for the Combined Work, excluding any source code+for portions of the Combined Work that, considered in isolation, are+based on the Application, and not on the Linked Version.++ The "Corresponding Application Code" for a Combined Work means the+object code and/or source code for the Application, including any data+and utility programs needed for reproducing the Combined Work from the+Application, but excluding the System Libraries of the Combined Work.++ 1. Exception to Section 3 of the GNU GPL.++ You may convey a covered work under sections 3 and 4 of this License+without being bound by section 3 of the GNU GPL.++ 2. Conveying Modified Versions.++ If you modify a copy of the Library, and, in your modifications, a+facility refers to a function or data to be supplied by an Application+that uses the facility (other than as an argument passed when the+facility is invoked), then you may convey a copy of the modified+version:++ a) under this License, provided that you make a good faith effort to+ ensure that, in the event an Application does not supply the+ function or data, the facility still operates, and performs+ whatever part of its purpose remains meaningful, or++ b) under the GNU GPL, with none of the additional permissions of+ this License applicable to that copy.++ 3. Object Code Incorporating Material from Library Header Files.++ The object code form of an Application may incorporate material from+a header file that is part of the Library. You may convey such object+code under terms of your choice, provided that, if the incorporated+material is not limited to numerical parameters, data structure+layouts and accessors, or small macros, inline functions and templates+(ten or fewer lines in length), you do both of the following:++ a) Give prominent notice with each copy of the object code that the+ Library is used in it and that the Library and its use are+ covered by this License.++ b) Accompany the object code with a copy of the GNU GPL and this license+ document.++ 4. Combined Works.++ You may convey a Combined Work under terms of your choice that,+taken together, effectively do not restrict modification of the+portions of the Library contained in the Combined Work and reverse+engineering for debugging such modifications, if you also do each of+the following:++ a) Give prominent notice with each copy of the Combined Work that+ the Library is used in it and that the Library and its use are+ covered by this License.++ b) Accompany the Combined Work with a copy of the GNU GPL and this license+ document.++ c) For a Combined Work that displays copyright notices during+ execution, include the copyright notice for the Library among+ these notices, as well as a reference directing the user to the+ copies of the GNU GPL and this license document.++ d) Do one of the following:++ 0) Convey the Minimal Corresponding Source under the terms of this+ License, and the Corresponding Application Code in a form+ suitable for, and under terms that permit, the user to+ recombine or relink the Application with a modified version of+ the Linked Version to produce a modified Combined Work, in the+ manner specified by section 6 of the GNU GPL for conveying+ Corresponding Source.++ 1) Use a suitable shared library mechanism for linking with the+ Library. A suitable mechanism is one that (a) uses at run time+ a copy of the Library already present on the user's computer+ system, and (b) will operate properly with a modified version+ of the Library that is interface-compatible with the Linked+ Version. ++ e) Provide Installation Information, but only if you would otherwise+ be required to provide such information under section 6 of the+ GNU GPL, and only to the extent that such information is+ necessary to install and execute a modified version of the+ Combined Work produced by recombining or relinking the+ Application with a modified version of the Linked Version. (If+ you use option 4d0, the Installation Information must accompany+ the Minimal Corresponding Source and Corresponding Application+ Code. If you use option 4d1, you must provide the Installation+ Information in the manner specified by section 6 of the GNU GPL+ for conveying Corresponding Source.)++ 5. Combined Libraries.++ You may place library facilities that are a work based on the+Library side by side in a single library together with other library+facilities that are not Applications and are not covered by this+License, and convey such a combined library under terms of your+choice, if you do both of the following:++ a) Accompany the combined library with a copy of the same work based+ on the Library, uncombined with any other library facilities,+ conveyed under the terms of this License.++ b) Give prominent notice with the combined library that part of it+ is a work based on the Library, and explaining where to find the+ accompanying uncombined form of the same work.++ 6. Revised Versions of the GNU Lesser General Public License.++ The Free Software Foundation may publish revised and/or new versions+of the GNU Lesser General Public License from time to time. Such new+versions will be similar in spirit to the present version, but may+differ in detail to address new problems or concerns.++ Each version is given a distinguishing version number. If the+Library as you received it specifies that a certain numbered version+of the GNU Lesser General Public License "or any later version"+applies to it, you have the option of following the terms and+conditions either of that published version or of any later version+published by the Free Software Foundation. If the Library as you+received it does not specify a version number of the GNU Lesser+General Public License, you may choose any version of the GNU Lesser+General Public License ever published by the Free Software Foundation.++ If the Library as you received it specifies that a proxy can decide+whether future versions of the GNU Lesser General Public License shall+apply, that proxy's public statement of acceptance of any version is+permanent authorization for you to choose that version for the+Library.
− Data/Endian.hs
@@ -1,41 +0,0 @@-{- |- Module : Data.Endian- Copyright : (c) 2006-04-08 by Peter Simons- License : GPL2-- Maintainer : simons@cryp.to- Stability : stable- Portability : portable-- Find out the machine's endian at runtime.--}--module Data.Endian ( Endian(..), ourEndian ) where--import Foreign---- |Definitions for byte order according to significance of--- bytes from low addresses to high addresses.--data Endian- = LittleEndian -- ^ byte order: @1234@- | BigEndian -- ^ byte order: @4321@- | PDPEndian -- ^ byte order: @3412@- deriving (Show, Eq)---- |The endian of this machine, determined at run-time.--{-# NOINLINE ourEndian #-}-ourEndian :: Endian-ourEndian =- unsafePerformIO $- allocaArray (sizeOf (undefined :: Word32)) $ \p -> do- let val = 0x01020304 :: Word32- poke p val- let p' = castPtr p :: Ptr Word8- val' <- peekArray 4 p'- case val' of- (0x01:0x02:0x03:0x04:[]) -> return BigEndian- (0x04:0x03:0x02:0x01:[]) -> return LittleEndian- (0x03:0x04:0x01:0x02:[]) -> return PDPEndian- _ -> error "unknown endian"
− LICENSE
@@ -1,340 +0,0 @@- GNU GENERAL PUBLIC LICENSE- Version 2, June 1991-- Copyright (C) 1989, 1991 Free Software Foundation, Inc.- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA- Everyone is permitted to copy and distribute verbatim copies- of this license document, but changing it is not allowed.-- Preamble-- The licenses for most software are designed to take away your-freedom to share and change it. By contrast, the GNU General Public-License is intended to guarantee your freedom to share and change free-software--to make sure the software is free for all its users. This-General Public License applies to most of the Free Software-Foundation's software and to any other program whose authors commit to-using it. (Some other Free Software Foundation software is covered by-the GNU Library General Public License instead.) You can apply it to-your programs, too.-- When we speak of free software, we are referring to freedom, not-price. Our General Public Licenses are designed to make sure that you-have the freedom to distribute copies of free software (and charge for-this service if you wish), that you receive source code or can get it-if you want it, that you can change the software or use pieces of it-in new free programs; and that you know you can do these things.-- To protect your rights, we need to make restrictions that forbid-anyone to deny you these rights or to ask you to surrender the rights.-These restrictions translate to certain responsibilities for you if you-distribute copies of the software, or if you modify it.-- For example, if you distribute copies of such a program, whether-gratis or for a fee, you must give the recipients all the rights that-you have. You must make sure that they, too, receive or can get the-source code. And you must show them these terms so they know their-rights.-- We protect your rights with two steps: (1) copyright the software, and-(2) offer you this license which gives you legal permission to copy,-distribute and/or modify the software.-- Also, for each author's protection and ours, we want to make certain-that everyone understands that there is no warranty for this free-software. If the software is modified by someone else and passed on, we-want its recipients to know that what they have is not the original, so-that any problems introduced by others will not reflect on the original-authors' reputations.-- Finally, any free program is threatened constantly by software-patents. We wish to avoid the danger that redistributors of a free-program will individually obtain patent licenses, in effect making the-program proprietary. To prevent this, we have made it clear that any-patent must be licensed for everyone's free use or not licensed at all.-- The precise terms and conditions for copying, distribution and-modification follow.-- GNU GENERAL PUBLIC LICENSE- TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION-- 0. This License applies to any program or other work which contains-a notice placed by the copyright holder saying it may be distributed-under the terms of this General Public License. The "Program", below,-refers to any such program or work, and a "work based on the Program"-means either the Program or any derivative work under copyright law:-that is to say, a work containing the Program or a portion of it,-either verbatim or with modifications and/or translated into another-language. (Hereinafter, translation is included without limitation in-the term "modification".) Each licensee is addressed as "you".--Activities other than copying, distribution and modification are not-covered by this License; they are outside its scope. The act of-running the Program is not restricted, and the output from the Program-is covered only if its contents constitute a work based on the-Program (independent of having been made by running the Program).-Whether that is true depends on what the Program does.-- 1. You may copy and distribute verbatim copies of the Program's-source code as you receive it, in any medium, provided that you-conspicuously and appropriately publish on each copy an appropriate-copyright notice and disclaimer of warranty; keep intact all the-notices that refer to this License and to the absence of any warranty;-and give any other recipients of the Program a copy of this License-along with the Program.--You may charge a fee for the physical act of transferring a copy, and-you may at your option offer warranty protection in exchange for a fee.-- 2. You may modify your copy or copies of the Program or any portion-of it, thus forming a work based on the Program, and copy and-distribute such modifications or work under the terms of Section 1-above, provided that you also meet all of these conditions:-- a) You must cause the modified files to carry prominent notices- stating that you changed the files and the date of any change.-- b) You must cause any work that you distribute or publish, that in- whole or in part contains or is derived from the Program or any- part thereof, to be licensed as a whole at no charge to all third- parties under the terms of this License.-- c) If the modified program normally reads commands interactively- when run, you must cause it, when started running for such- interactive use in the most ordinary way, to print or display an- announcement including an appropriate copyright notice and a- notice that there is no warranty (or else, saying that you provide- a warranty) and that users may redistribute the program under- these conditions, and telling the user how to view a copy of this- License. (Exception: if the Program itself is interactive but- does not normally print such an announcement, your work based on- the Program is not required to print an announcement.)--These requirements apply to the modified work as a whole. If-identifiable sections of that work are not derived from the Program,-and can be reasonably considered independent and separate works in-themselves, then this License, and its terms, do not apply to those-sections when you distribute them as separate works. But when you-distribute the same sections as part of a whole which is a work based-on the Program, the distribution of the whole must be on the terms of-this License, whose permissions for other licensees extend to the-entire whole, and thus to each and every part regardless of who wrote it.--Thus, it is not the intent of this section to claim rights or contest-your rights to work written entirely by you; rather, the intent is to-exercise the right to control the distribution of derivative or-collective works based on the Program.--In addition, mere aggregation of another work not based on the Program-with the Program (or with a work based on the Program) on a volume of-a storage or distribution medium does not bring the other work under-the scope of this License.-- 3. You may copy and distribute the Program (or a work based on it,-under Section 2) in object code or executable form under the terms of-Sections 1 and 2 above provided that you also do one of the following:-- a) Accompany it with the complete corresponding machine-readable- source code, which must be distributed under the terms of Sections- 1 and 2 above on a medium customarily used for software interchange; or,-- b) Accompany it with a written offer, valid for at least three- years, to give any third party, for a charge no more than your- cost of physically performing source distribution, a complete- machine-readable copy of the corresponding source code, to be- distributed under the terms of Sections 1 and 2 above on a medium- customarily used for software interchange; or,-- c) Accompany it with the information you received as to the offer- to distribute corresponding source code. (This alternative is- allowed only for noncommercial distribution and only if you- received the program in object code or executable form with such- an offer, in accord with Subsection b above.)--The source code for a work means the preferred form of the work for-making modifications to it. For an executable work, complete source-code means all the source code for all modules it contains, plus any-associated interface definition files, plus the scripts used to-control compilation and installation of the executable. However, as a-special exception, the source code distributed need not include-anything that is normally distributed (in either source or binary-form) with the major components (compiler, kernel, and so on) of the-operating system on which the executable runs, unless that component-itself accompanies the executable.--If distribution of executable or object code is made by offering-access to copy from a designated place, then offering equivalent-access to copy the source code from the same place counts as-distribution of the source code, even though third parties are not-compelled to copy the source along with the object code.-- 4. You may not copy, modify, sublicense, or distribute the Program-except as expressly provided under this License. Any attempt-otherwise to copy, modify, sublicense or distribute the Program is-void, and will automatically terminate your rights under this License.-However, parties who have received copies, or rights, from you under-this License will not have their licenses terminated so long as such-parties remain in full compliance.-- 5. You are not required to accept this License, since you have not-signed it. However, nothing else grants you permission to modify or-distribute the Program or its derivative works. These actions are-prohibited by law if you do not accept this License. Therefore, by-modifying or distributing the Program (or any work based on the-Program), you indicate your acceptance of this License to do so, and-all its terms and conditions for copying, distributing or modifying-the Program or works based on it.-- 6. Each time you redistribute the Program (or any work based on the-Program), the recipient automatically receives a license from the-original licensor to copy, distribute or modify the Program subject to-these terms and conditions. You may not impose any further-restrictions on the recipients' exercise of the rights granted herein.-You are not responsible for enforcing compliance by third parties to-this License.-- 7. If, as a consequence of a court judgment or allegation of patent-infringement or for any other reason (not limited to patent issues),-conditions are imposed on you (whether by court order, agreement or-otherwise) that contradict the conditions of this License, they do not-excuse you from the conditions of this License. If you cannot-distribute so as to satisfy simultaneously your obligations under this-License and any other pertinent obligations, then as a consequence you-may not distribute the Program at all. For example, if a patent-license would not permit royalty-free redistribution of the Program by-all those who receive copies directly or indirectly through you, then-the only way you could satisfy both it and this License would be to-refrain entirely from distribution of the Program.--If any portion of this section is held invalid or unenforceable under-any particular circumstance, the balance of the section is intended to-apply and the section as a whole is intended to apply in other-circumstances.--It is not the purpose of this section to induce you to infringe any-patents or other property right claims or to contest validity of any-such claims; this section has the sole purpose of protecting the-integrity of the free software distribution system, which is-implemented by public license practices. Many people have made-generous contributions to the wide range of software distributed-through that system in reliance on consistent application of that-system; it is up to the author/donor to decide if he or she is willing-to distribute software through any other system and a licensee cannot-impose that choice.--This section is intended to make thoroughly clear what is believed to-be a consequence of the rest of this License.-- 8. If the distribution and/or use of the Program is restricted in-certain countries either by patents or by copyrighted interfaces, the-original copyright holder who places the Program under this License-may add an explicit geographical distribution limitation excluding-those countries, so that distribution is permitted only in or among-countries not thus excluded. In such case, this License incorporates-the limitation as if written in the body of this License.-- 9. The Free Software Foundation may publish revised and/or new versions-of the General Public License from time to time. Such new versions will-be similar in spirit to the present version, but may differ in detail to-address new problems or concerns.--Each version is given a distinguishing version number. If the Program-specifies a version number of this License which applies to it and "any-later version", you have the option of following the terms and conditions-either of that version or of any later version published by the Free-Software Foundation. If the Program does not specify a version number of-this License, you may choose any version ever published by the Free Software-Foundation.-- 10. If you wish to incorporate parts of the Program into other free-programs whose distribution conditions are different, write to the author-to ask for permission. For software which is copyrighted by the Free-Software Foundation, write to the Free Software Foundation; we sometimes-make exceptions for this. Our decision will be guided by the two goals-of preserving the free status of all derivatives of our free software and-of promoting the sharing and reuse of software generally.-- NO WARRANTY-- 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY-FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN-OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES-PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED-OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS-TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE-PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,-REPAIR OR CORRECTION.-- 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR-REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,-INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING-OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED-TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY-YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER-PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE-POSSIBILITY OF SUCH DAMAGES.-- END OF TERMS AND CONDITIONS-- How to Apply These Terms to Your New Programs-- If you develop a new program, and you want it to be of the greatest-possible use to the public, the best way to achieve this is to make it-free software which everyone can redistribute and change under these terms.-- To do so, attach the following notices to the program. It is safest-to attach them to the start of each source file to most effectively-convey the exclusion of warranty; and each file should have at least-the "copyright" line and a pointer to where the full notice is found.-- <one line to give the program's name and a brief idea of what it does.>- Copyright (C) <year> <name of author>-- This program is free software; you can redistribute it and/or modify- it under the terms of the GNU General Public License as published by- the Free Software Foundation; either version 2 of the License, or- (at your option) any later version.-- This program is distributed in the hope that it will be useful,- but WITHOUT ANY WARRANTY; without even the implied warranty of- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the- GNU General Public License for more details.-- You should have received a copy of the GNU General Public License- along with this program; if not, write to the Free Software- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA---Also add information on how to contact you by electronic and paper mail.--If the program is interactive, make it output a short notice like this-when it starts in an interactive mode:-- Gnomovision version 69, Copyright (C) year name of author- Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.- This is free software, and you are welcome to redistribute it- under certain conditions; type `show c' for details.--The hypothetical commands `show w' and `show c' should show the appropriate-parts of the General Public License. Of course, the commands you use may-be called something other than `show w' and `show c'; they could even be-mouse-clicks or menu items--whatever suits your program.--You should also get your employer (if you work as a programmer) or your-school, if any, to sign a "copyright disclaimer" for the program, if-necessary. Here is a sample; alter the names:-- Yoyodyne, Inc., hereby disclaims all copyright interest in the program- `Gnomovision' (which makes passes at compilers) written by James Hacker.-- <signature of Ty Coon>, 1 April 1989- Ty Coon, President of Vice--This General Public License does not permit incorporating your program into-proprietary programs. If your program is a subroutine library, you may-consider it more useful to permit linking proprietary applications with the-library. If this is what you want to do, use the GNU Library General-Public License instead of this License.
− Network/DNS.hs
@@ -1,78 +0,0 @@-{- |- Module : Network.DNS- Copyright : (c) 2006-04-08 by Peter Simons- License : GPL2-- Maintainer : simons@cryp.to- Stability : provisional- Portability : Haskell 2-pre-- An asynchronous DNS resolver. Link your program with the- /threaded/ runtime-system when you use this module. In- GHC, this is accomplished by specifying @-threaded@ on- the command-line.--}--module Network.DNS- ( -- PollResolver- Resolver- , initResolver- , resolveA- , resolvePTR- , resolveMX- , query- -- Network- , HostName- -- Network.Socket- , HostAddress- -- ADNS- , InitFlag(..)- , QueryFlag(..)- , RRType(..)- , Status(..)- , RRAddr(..)- , RRHostAddr(..)- , RRIntHostAddr(..)- , Answer(..)- , Response(..)- , sOK- , sNOMEMORY- , sUNKNOWNRRTYPE- , sSYSTEMFAIL- , sMAX_LOCALFAIL- , sTIMEOUT- , sALLSERVFAIL- , sNORECURSE- , sINVALIDRESPONSE- , sUNKNOWNFORMAT- , sMAX_REMOTEFAIL- , sRCODESERVFAIL- , sRCODEFORMATERROR- , sRCODENOTIMPLEMENTED- , sRCODEREFUSED- , sRCODEUNKNOWN- , sMAX_TEMPFAIL- , sINCONSISTENT- , sPROHIBITEDCNAME- , sANSWERDOMAININVALID- , sANSWERDOMAINTOOLONG- , sINVALIDDATA- , sMAX_MISCONFIG- , sQUERYDOMAINWRONG- , sQUERYDOMAININVALID- , sQUERYDOMAINTOOLONG- , sMAX_MISQUERY- , sNXDOMAIN- , sNODATA- , sMAX_PERMFAIL- , adnsStrerror- , adnsErrAbbrev- , adnsErrTypeAbbrev- , dummyDNS- )- where--import Network ( HostName )-import Network.DNS.ADNS-import Network.DNS.PollResolver-import Network.IP.Address
− Network/DNS/ADNS.hs
@@ -1,687 +0,0 @@-{-# INCLUDE <adns.h> #-}-{-# INCLUDE <errno.h> #-}-{-# LINE 1 "ADNS.hsc" #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LINE 2 "ADNS.hsc" #-}-{- |- Module : Network.DNS.ADNS- Copyright : (c) 2006-04-08 by Peter Simons- License : GPL2-- Maintainer : simons@cryp.to- Stability : provisional- Portability : Haskell 2-pre-- This module provides bindings to GNU ADNS, a domain name- resolver library written in C. Its source code, among- other things, is available at- <http://www.gnu.org/software/adns/>.-- You will most likely not need this module directly;- "Network.DNS" provides a much nicer interface from the- Haskell world; this module contains mostly marshaling- code.--}--module Network.DNS.ADNS where--import Control.Exception ( assert, bracket )-import Foreign-import Foreign.C-import Network ( HostName )-import Network.IP.Address-import System.Posix.Poll-import System.Posix.GetTimeOfDay---{-# LINE 33 "ADNS.hsc" #-}--{-# LINE 34 "ADNS.hsc" #-}---- * Marshaled ADNS Data Types--data OpaqueState-type AdnsState = Ptr OpaqueState--data OpaqueQuery-type Query = Ptr OpaqueQuery--data InitFlag- = NoEnv -- ^ do not look at environment- | NoErrPrint -- ^ never print output to stderr ('Debug' overrides)- | NoServerWarn -- ^ do not warn to stderr about duff nameservers etc- | Debug -- ^ enable all output to stderr plus 'Debug' msgs- | LogPid -- ^ include process id in diagnostic output- | NoAutoSys -- ^ do not make syscalls at every opportunity- | Eintr -- ^ allow 'adnsSynch' to return 'eINTR'- | NoSigPipe -- ^ application has SIGPIPE set to SIG_IGN, do not protect- | CheckC_EntEx -- ^ do consistency checks on entry\/exit to adns functions- | CheckC_Freq -- ^ do consistency checks very frequently (slow!)- deriving (Eq, Bounded, Show)--instance Enum InitFlag where- toEnum 1 = NoEnv-{-# LINE 58 "ADNS.hsc" #-}- toEnum 2 = NoErrPrint-{-# LINE 59 "ADNS.hsc" #-}- toEnum 4 = NoServerWarn-{-# LINE 60 "ADNS.hsc" #-}- toEnum 8 = Debug-{-# LINE 61 "ADNS.hsc" #-}- toEnum 128 = LogPid-{-# LINE 62 "ADNS.hsc" #-}- toEnum 16 = NoAutoSys-{-# LINE 63 "ADNS.hsc" #-}- toEnum 32 = Eintr-{-# LINE 64 "ADNS.hsc" #-}- toEnum 64 = NoSigPipe-{-# LINE 65 "ADNS.hsc" #-}- toEnum 256 = CheckC_EntEx-{-# LINE 66 "ADNS.hsc" #-}- toEnum 768 = CheckC_Freq-{-# LINE 67 "ADNS.hsc" #-}- toEnum i = error ("Network.DNS.ADNS.InitFlag cannot be mapped to value " ++ show i)-- fromEnum NoEnv = 1-{-# LINE 70 "ADNS.hsc" #-}- fromEnum NoErrPrint = 2-{-# LINE 71 "ADNS.hsc" #-}- fromEnum NoServerWarn = 4-{-# LINE 72 "ADNS.hsc" #-}- fromEnum Debug = 8-{-# LINE 73 "ADNS.hsc" #-}- fromEnum LogPid = 128-{-# LINE 74 "ADNS.hsc" #-}- fromEnum NoAutoSys = 16-{-# LINE 75 "ADNS.hsc" #-}- fromEnum Eintr = 32-{-# LINE 76 "ADNS.hsc" #-}- fromEnum NoSigPipe = 64-{-# LINE 77 "ADNS.hsc" #-}- fromEnum CheckC_EntEx = 256-{-# LINE 78 "ADNS.hsc" #-}- fromEnum CheckC_Freq = 768-{-# LINE 79 "ADNS.hsc" #-}--data QueryFlag- = Search -- ^ use the searchlist- | UseVC -- ^ use a virtual circuit (TCP connection)- | Owner -- ^ fill in the owner field in the answer- | QuoteOk_Query -- ^ allow special chars in query domain- | QuoteOk_CName -- ^ allow special chars in CNAME we go via (default)- | QuoteOk_AnsHost -- ^ allow special chars in things supposed to be hostnames- | QuoteFail_CName -- ^ refuse if quote-req chars in CNAME we go via- | CName_Loose -- ^ allow refs to CNAMEs - without, get _s_cname- | CName_Forbid -- ^ don't follow CNAMEs, instead give _s_cname- deriving (Eq, Bounded, Show)--instance Enum QueryFlag where- toEnum 1 = Search-{-# LINE 94 "ADNS.hsc" #-}- toEnum 2 = UseVC-{-# LINE 95 "ADNS.hsc" #-}- toEnum 4 = Owner-{-# LINE 96 "ADNS.hsc" #-}- toEnum 16 = QuoteOk_Query-{-# LINE 97 "ADNS.hsc" #-}- toEnum 0 = QuoteOk_CName-{-# LINE 98 "ADNS.hsc" #-}- toEnum 64 = QuoteOk_AnsHost-{-# LINE 99 "ADNS.hsc" #-}- toEnum 128 = QuoteFail_CName-{-# LINE 100 "ADNS.hsc" #-}- toEnum 256 = CName_Loose-{-# LINE 101 "ADNS.hsc" #-}- toEnum 512 = CName_Forbid-{-# LINE 102 "ADNS.hsc" #-}- toEnum i = error ("Network.DNS.ADNS.QueryFlag cannot be mapped to value " ++ show i)-- fromEnum Search = 1-{-# LINE 105 "ADNS.hsc" #-}- fromEnum UseVC = 2-{-# LINE 106 "ADNS.hsc" #-}- fromEnum Owner = 4-{-# LINE 107 "ADNS.hsc" #-}- fromEnum QuoteOk_Query = 16-{-# LINE 108 "ADNS.hsc" #-}- fromEnum QuoteOk_CName = 0-{-# LINE 109 "ADNS.hsc" #-}- fromEnum QuoteOk_AnsHost = 64-{-# LINE 110 "ADNS.hsc" #-}- fromEnum QuoteFail_CName = 128-{-# LINE 111 "ADNS.hsc" #-}- fromEnum CName_Loose = 256-{-# LINE 112 "ADNS.hsc" #-}- fromEnum CName_Forbid = 512-{-# LINE 113 "ADNS.hsc" #-}---- |The record types we support.--data RRType = A | MX | NS | PTR- deriving (Eq, Bounded, Show)--instance Enum RRType where- toEnum 1 = A-{-# LINE 121 "ADNS.hsc" #-}- toEnum 65551 = MX-{-# LINE 122 "ADNS.hsc" #-}- toEnum 65538 = NS-{-# LINE 123 "ADNS.hsc" #-}- toEnum 65548 = PTR-{-# LINE 124 "ADNS.hsc" #-}- toEnum i = error ("Network.DNS.ADNS.RRType cannot be mapped to value " ++ show i)-- fromEnum A = 1-{-# LINE 127 "ADNS.hsc" #-}- fromEnum MX = 65551-{-# LINE 128 "ADNS.hsc" #-}- fromEnum NS = 65538-{-# LINE 129 "ADNS.hsc" #-}- fromEnum PTR = 65548-{-# LINE 130 "ADNS.hsc" #-}--instance Storable RRType where- sizeOf _ = (4)-{-# LINE 133 "ADNS.hsc" #-}- alignment _ = alignment (undefined :: Word32)-{-# LINE 134 "ADNS.hsc" #-}- poke ptr t = let p = castPtr ptr :: Ptr Word32-{-# LINE 135 "ADNS.hsc" #-}- in poke p ((toEnum . fromEnum) t)- peek ptr = let p = castPtr ptr :: Ptr Word32-{-# LINE 137 "ADNS.hsc" #-}- in peek p >>= return . toEnum . fromEnum---- |The status codes recognized by ADNS vary in different--- versions of the library. So instead of providing an--- 'Enum', the 'Status' type contains the numeric value as--- returned by ADNS itself. For common status codes, helper--- functions like 'sOK' or 'sNXDOMAIN' are provided. The--- functions 'adnsErrTypeAbbrev', 'adnsErrAbbrev', and--- 'adnsStrerror' can also be used to map these codes into--- human readable strings.--newtype Status = StatusCode Int- deriving (Eq, Show)--sOK :: Status-sOK = StatusCode 0-sNOMEMORY :: Status-sNOMEMORY = StatusCode 1-sUNKNOWNRRTYPE :: Status-sUNKNOWNRRTYPE = StatusCode 2-sSYSTEMFAIL :: Status-sSYSTEMFAIL = StatusCode 3-sMAX_LOCALFAIL :: Status-sMAX_LOCALFAIL = StatusCode 29-sTIMEOUT :: Status-sTIMEOUT = StatusCode 30-sALLSERVFAIL :: Status-sALLSERVFAIL = StatusCode 31-sNORECURSE :: Status-sNORECURSE = StatusCode 32-sINVALIDRESPONSE :: Status-sINVALIDRESPONSE = StatusCode 33-sUNKNOWNFORMAT :: Status-sUNKNOWNFORMAT = StatusCode 34-sMAX_REMOTEFAIL :: Status-sMAX_REMOTEFAIL = StatusCode 59-sRCODESERVFAIL :: Status-sRCODESERVFAIL = StatusCode 60-sRCODEFORMATERROR :: Status-sRCODEFORMATERROR = StatusCode 61-sRCODENOTIMPLEMENTED :: Status-sRCODENOTIMPLEMENTED = StatusCode 62-sRCODEREFUSED :: Status-sRCODEREFUSED = StatusCode 63-sRCODEUNKNOWN :: Status-sRCODEUNKNOWN = StatusCode 64-sMAX_TEMPFAIL :: Status-sMAX_TEMPFAIL = StatusCode 99-sINCONSISTENT :: Status-sINCONSISTENT = StatusCode 100-sPROHIBITEDCNAME :: Status-sPROHIBITEDCNAME = StatusCode 101-sANSWERDOMAININVALID :: Status-sANSWERDOMAININVALID = StatusCode 102-sANSWERDOMAINTOOLONG :: Status-sANSWERDOMAINTOOLONG = StatusCode 103-sINVALIDDATA :: Status-sINVALIDDATA = StatusCode 104-sMAX_MISCONFIG :: Status-sMAX_MISCONFIG = StatusCode 199-sQUERYDOMAINWRONG :: Status-sQUERYDOMAINWRONG = StatusCode 200-sQUERYDOMAININVALID :: Status-sQUERYDOMAININVALID = StatusCode 201-sQUERYDOMAINTOOLONG :: Status-sQUERYDOMAINTOOLONG = StatusCode 202-sMAX_MISQUERY :: Status-sMAX_MISQUERY = StatusCode 299-sNXDOMAIN :: Status-sNXDOMAIN = StatusCode 300-sNODATA :: Status-sNODATA = StatusCode 301-sMAX_PERMFAIL :: Status-sMAX_PERMFAIL = StatusCode 499--{-# LINE 182 "ADNS.hsc" #-}---- |Original definition:------ > typedef struct {--- > int len;--- > union {--- > struct sockaddr sa;--- > struct sockaddr_in inet;--- > } addr;--- > } adns_rr_addr;------ /Note/: Anything but @sockaddr_in@ will cause 'peek' to call 'fail',--- when marshaling this structure. 'poke' is not defined.--newtype RRAddr = RRAddr HostAddress- deriving (Eq)--instance Show RRAddr where- show (RRAddr ha) = shows b1 . ('.':) .- shows b2 . ('.':) .- shows b3 . ('.':) .- shows b4 $ ""- where- (b1,b2,b3,b4) = ha2tpl ha--instance Storable RRAddr where- sizeOf _ = (20)-{-# LINE 209 "ADNS.hsc" #-}- alignment _ = alignment (undefined :: CInt)- poke _ _ = fail "poke is undefined for Network.DNS.ADNS.RRAddr"- peek ptr' = do- let ptr = (\hsc_ptr -> hsc_ptr `plusPtr` 4) ptr'-{-# LINE 213 "ADNS.hsc" #-}- (t :: Word16) <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr-{-# LINE 214 "ADNS.hsc" #-}- if (t /= 2)-{-# LINE 215 "ADNS.hsc" #-}- then fail ("peek Network.DNS.ADNS.RRAddr: unsupported 'sockaddr' type " ++ show t)- else (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr >>= return . RRAddr-{-# LINE 217 "ADNS.hsc" #-}---- | Original definition:------ > typedef struct {--- > char *host;--- > adns_status astatus;--- > int naddrs; /* temp fail => -1, perm fail => 0, s_ok => >0--- > adns_rr_addr *addrs;--- > } adns_rr_hostaddr;------ The @naddrs@ field is not available in @RRHostAddr@--- because I couldn't see how that information wouldn't be--- available in the @astatus@ field too. If I missed--- anything, please let me know.------ /Note/: The data type should probably contain--- 'HostAddress' rather than 'RRAddr'. I'm using the former--- only because it has nicer output with 'show'. 'poke' is--- not defined.--data RRHostAddr = RRHostAddr HostName Status [RRAddr]- deriving (Show)--instance Storable RRHostAddr where- sizeOf _ = (24)-{-# LINE 242 "ADNS.hsc" #-}- alignment _ = alignment (undefined :: CString)- poke _ _ = fail "poke is undefined for Network.DNS.ADNS.RRHostAddr"- peek ptr = do- h <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr-{-# LINE 246 "ADNS.hsc" #-}- hstr <- assert (h /= nullPtr) (peekCString h)- st <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr-{-# LINE 248 "ADNS.hsc" #-}- (nadr :: Word32) <- (\hsc_ptr -> peekByteOff hsc_ptr 12) ptr-{-# LINE 249 "ADNS.hsc" #-}- aptr <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr-{-# LINE 250 "ADNS.hsc" #-}- adrs <- if (nadr > 0)- then peekArray (fromEnum nadr) aptr- else return []- return (RRHostAddr hstr (StatusCode st) adrs)---- |Original definition:------ > typedef struct {--- > int i;--- > adns_rr_hostaddr ha;--- > } adns_rr_inthostaddr;--data RRIntHostAddr = RRIntHostAddr Int RRHostAddr- deriving (Show)--instance Storable RRIntHostAddr where- sizeOf _ = (32)-{-# LINE 267 "ADNS.hsc" #-}- alignment _ = alignment (undefined :: CInt)- poke _ _ = fail "poke is undefined for Network.DNS.ADNS.RRIntHostAddr"- peek ptr = do- (i::CInt) <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr-{-# LINE 271 "ADNS.hsc" #-}- a <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr-{-# LINE 272 "ADNS.hsc" #-}- return (RRIntHostAddr (fromEnum i) a)--data Answer = Answer- { status :: Status- -- ^ Status code for this query.- , cname :: Maybe String- -- ^ Always 'Nothing' for @CNAME@ queries (which are not supported yet anyway).- , owner :: Maybe String- -- ^ Only set if 'Owner' was requested for query.- , expires :: CTime- -- ^ Only defined if status is 'sOK', 'sNXDOMAIN', or 'sNODATA'.- , rrs :: [Response]- -- ^ The list will be empty if an error occured.- }- deriving (Show)--data Response- = RRA RRAddr- | RRMX Int RRHostAddr- | RRNS RRHostAddr- | RRPTR String- deriving (Show)--instance Storable Answer where- sizeOf _ = (56)-{-# LINE 297 "ADNS.hsc" #-}- alignment _ = alignment (undefined :: CInt)- poke _ _ = fail "poke is not defined for Network.DNS.ADNS.Answer"- peek ptr = do- sc <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr-{-# LINE 301 "ADNS.hsc" #-}- cn <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr >>= maybePeek peekCString-{-# LINE 302 "ADNS.hsc" #-}- ow <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr >>= maybePeek peekCString-{-# LINE 303 "ADNS.hsc" #-}- et <- (\hsc_ptr -> peekByteOff hsc_ptr 32) ptr-{-# LINE 304 "ADNS.hsc" #-}- rt <- (\hsc_ptr -> peekByteOff hsc_ptr 24) ptr-{-# LINE 305 "ADNS.hsc" #-}- (rs :: CInt) <- (\hsc_ptr -> peekByteOff hsc_ptr 40) ptr-{-# LINE 306 "ADNS.hsc" #-}- (sz :: CInt) <- (\hsc_ptr -> peekByteOff hsc_ptr 44) ptr-{-# LINE 307 "ADNS.hsc" #-}- rrsp <- (\hsc_ptr -> peekByteOff hsc_ptr 48) ptr-{-# LINE 308 "ADNS.hsc" #-}- r <- peekResp rt rrsp (fromEnum sz) (fromEnum rs)- return Answer- { status = StatusCode sc- , cname = cn- , owner = ow- , expires = et- , rrs = r- }---- |This function parses the 'Response' union found in--- 'Answer'. It cannot be defined via 'Storable' because it--- needs to know the type of the record to expect. This is,--- by the way, the function to look at, if you want to add--- support for additional 'RRType' records.--peekResp :: RRType -> Ptr b -> Int -> Int -> IO [Response]-peekResp _ _ _ 0 = return []-peekResp rt ptr off n = do- r <- parseByType rt- rs <- peekResp rt (ptr `plusPtr` off) off (n-1)- return (r:rs)-- where- parseByType A = peek (castPtr ptr) >>= return . RRA . RRAddr- parseByType NS = peek (castPtr ptr) >>= return . RRNS- parseByType PTR = peek (castPtr ptr) >>= peekCString >>= return . RRPTR- parseByType MX = do (RRIntHostAddr i addr) <- peek (castPtr ptr)- return (RRMX i addr)---- * ADNS Library Functions---- |Run the given 'IO' computation with an initialized--- resolver. As of now, the diagnose stream is always set to--- 'System.IO.stderr'. Initialize the library with 'NoErrPrint' if you--- don't wont to see any error output. All resources are--- freed when @adnsInit@ returns.--adnsInit :: [InitFlag] -> (AdnsState -> IO a) -> IO a-adnsInit flags =- bracket- (wrapAdns (\p -> adns_init p (mkFlags flags) nullPtr) peek)- adns_finish---- |Similar to 'adnsInit', but reads the resolver--- configuration from a string rather than from--- @\/etc\/resolv.conf@. Supported are the usual commands:--- @nameserver@, @search@, @domain@, @sortlist@, and--- @options@.------ Additionally, these non-standard commands may be used:------ * @clearnameservers@: Clears the list of nameservers.------ * @include filename@: The specified file will be read.--adnsInitCfg :: [InitFlag] -> String -> (AdnsState -> IO a) -> IO a-adnsInitCfg flags cfg = bracket mkState adns_finish- where- mkState = withCString cfg $ \cstr ->- wrapAdns- (\p -> adns_init_strcfg p (mkFlags flags) nullPtr cstr)- peek---- |Perform a synchronous query for a record. In case of an--- I\/O error, an 'System.IO.Error.IOException' is thrown.--- If the query fails for other reasons, the 'Status' code--- in the 'Answer' will signify that.--adnsSynch :: AdnsState -> String -> RRType -> [QueryFlag] -> IO Answer-adnsSynch st own rrt flags =- withCString own $ \o -> do- let rrt' = (toEnum . fromEnum) rrt- wrapAdns- (adns_synchronous st o rrt' (mkFlags flags))- (\p -> peek p >>= peek)---- |Submit an asynchronous query. The returned 'Query' can--- be tested for completion with 'adnsCheck'.--adnsSubmit :: AdnsState -> String -> RRType -> [QueryFlag] -> IO Query-adnsSubmit st own rrt flags =- withCString own $ \o -> do- let rrt' = (toEnum . fromEnum) rrt- wrapAdns- (adns_submit st o rrt' (mkFlags flags) nullPtr)- (peek)---- |Check the status of an asynchronous query. If the query--- is complete, the 'Answer' will be returned. The 'Query'--- becomes invalid after that.--adnsCheck :: AdnsState -> Query -> IO (Maybe Answer)-adnsCheck st q =- alloca $ \qPtr ->- alloca $ \aPtr -> do- poke qPtr q- poke aPtr nullPtr- rc <- adns_check st qPtr aPtr nullPtr- case rc of- 0 -> peek aPtr >>= peek >>= return . Just- 11 -> return Nothing-{-# LINE 409 "ADNS.hsc" #-}- _ -> do p <- adns_strerror rc- s <- peekCString p- fail ("adnsCheck: " ++ s)---- |Cancel an open 'Query'.--foreign import ccall unsafe "adns_cancel" adnsCancel :: Query -> IO ()---- |Return the list of all currently open queries.--adnsQueries :: AdnsState -> IO [Query]-adnsQueries st = adns_forallqueries_begin st >> walk- where walk = do q <- adns_forallqueries_next st nullPtr- if (q /= nullPtr)- then walk >>= return . ((:) q)- else return []---- |Find out which file descriptors ADNS is interested in--- and when it would like to be able to time things out.--- This is in a form suitable for use with 'poll'.------ On entry, @fds@ should point to at least @*nfds_io@--- structs. ADNS will fill up to that many structs with--- information for @poll@, and record in @*nfds_io@ how many--- entries it actually used. If the array is too small,--- @*nfds_io@ will be set to the number required and--- 'adnsBeforePoll' will return 'eRANGE'.------ You may call 'adnsBeforePoll' with @fds=='nullPtr'@ and--- @*nfds_io==0@, in which case ADNS will fill in the number--- of fds that it might be interested in into @*nfds_io@ and--- return either 0 (if it is not interested in any fds) or--- 'eRANGE' (if it is).------ Note that (unless @now@ is 0) ADNS may acquire additional--- fds from one call to the next, so you must put--- adns_beforepoll in a loop, rather than assuming that the--- second call (with the buffer size requested by the first)--- will not return 'eRANGE'.------ ADNS only ever sets 'PollIn', 'PollOut' and 'PollPri' in--- its 'Pollfd' structs, and only ever looks at those bits.--- 'PollPri' is required to detect TCP Urgent Data (which--- should not be used by a DNS server) so that ADNS can know--- that the TCP stream is now useless.------ In any case, @*timeout_io@ should be a timeout value as--- for 'poll', which ADNS will modify downwards as required.--- If the caller does not plan to block, then @*timeout_io@--- should be 0 on entry. Alternatively, @timeout_io@ may be--- 0.------ 'adnsBeforePoll' will return 0 on success, and will not--- fail for any reason other than the fds buffer being too--- small (ERANGE).------ This call will never actually do any I\/O. If you supply--- the current time it will not change the fds that ADNS is--- using or the timeouts it wants.------ In any case this call won't block.--foreign import ccall unsafe "adns_beforepoll" adnsBeforePoll ::- AdnsState -> Ptr Pollfd -> Ptr CInt -> Ptr CInt -> Ptr Timeval- -> IO CInt---- |Gives ADNS flow-of-control for a bit; intended for use--- after 'poll'. @fds@ and @nfds@ should be the results from--- 'poll'. 'Pollfd' structs mentioning fds not belonging to--- adns will be ignored.--foreign import ccall unsafe "adns_afterpoll" adnsAfterPoll ::- AdnsState -> Ptr Pollfd -> CInt -> Ptr Timeval -> IO ()---- |Map a 'Status' code to a human-readable error--- description. For example:------ > *ADNS> adnsStrerror sNXDOMAIN >>= print--- > "No such domain"------ Use this function with great care: It will crash the--- process when called with a status code that ADNS doesn't--- know about. So use it only to print values you got from--- the resolver!--adnsStrerror :: Status -> IO String-adnsStrerror (StatusCode x) = do- cstr <- (adns_strerror . toEnum . fromEnum) x- assert (cstr /= nullPtr) (peekCString cstr)---- |Map a 'Status' code to a short error name. Don't use--- this function to print a status code unless you've--- obtained it from the resolver!--adnsErrAbbrev :: Status -> IO String-adnsErrAbbrev (StatusCode x) = do- cstr <- (adns_errabbrev . toEnum . fromEnum) x- assert (cstr /= nullPtr) (peekCString cstr)---- |Map a 'Status' code to a short description of the type--- of error. Don't use this function to print a status code--- unless you've obtained it from the resolver!--adnsErrTypeAbbrev :: Status -> IO String-adnsErrTypeAbbrev (StatusCode x) = do- cstr <- (adns_errtypeabbrev . toEnum . fromEnum) x- assert (cstr /= nullPtr) (peekCString cstr)---- * Unmarshaled Low-Level C Functions--foreign import ccall unsafe adns_init ::- Ptr AdnsState -> CInt -> Ptr CFile -> IO CInt--foreign import ccall unsafe adns_init_strcfg ::- Ptr AdnsState -> CInt -> Ptr CFile -> CString-> IO CInt--foreign import ccall unsafe adns_finish ::- AdnsState -> IO ()--foreign import ccall unsafe adns_submit ::- AdnsState -> CString -> CInt -> CInt -> Ptr a -> Ptr Query- -> IO CInt--foreign import ccall unsafe adns_check ::- AdnsState -> Ptr Query -> Ptr (Ptr Answer) -> Ptr (Ptr a)- -> IO CInt--foreign import ccall unsafe adns_synchronous ::- AdnsState -> CString -> CInt -> CInt -> Ptr (Ptr Answer)- -> IO CInt--foreign import ccall unsafe adns_forallqueries_begin ::- AdnsState -> IO ()--foreign import ccall unsafe adns_forallqueries_next ::- AdnsState -> Ptr (Ptr a) -> IO Query--foreign import ccall unsafe adns_strerror :: CInt -> IO CString-foreign import ccall unsafe adns_errabbrev :: CInt -> IO CString-foreign import ccall unsafe adns_errtypeabbrev :: CInt -> IO CString---- * Helper Functions---- |Internel helper function to handle result passing from--- ADNS via @Ptr (Ptr a)@, and to generate human-readable IO--- exceptions in case of an error.--wrapAdns :: (Ptr (Ptr b) -> IO CInt) -> (Ptr (Ptr b) -> IO a) -> IO a-wrapAdns m acc = alloca $ \resP -> do- poke resP nullPtr- rc <- m resP- if (rc == 0)- then acc resP- else do p <- adns_strerror rc- s <- peekCString p- fail ("ADNS: " ++ s)---- |Map a list of flags ('Enum' types) into a 'CInt'--- suitable for adns calls.--mkFlags :: Enum a => [a] -> CInt-mkFlags = toEnum . sum . map fromEnum----- ----- Configure Emacs ----------- Local Variables: ***--- haskell-program-name: "ghci -ladns -lcrypto" ***--- End: ***
− Network/DNS/ADNS.hsc
@@ -1,577 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface, PatternSignatures, EmptyDataDecls #-}-{- |- Module : Network.DNS.ADNS- Copyright : (c) 2006-04-08 by Peter Simons- License : GPL2-- Maintainer : simons@cryp.to- Stability : provisional- Portability : Haskell 2-pre-- This module provides bindings to GNU ADNS, a domain name- resolver library written in C. Its source code, among- other things, is available at- <http://www.gnu.org/software/adns/>.-- You will most likely not need this module directly;- "Network.DNS" provides a much nicer interface from the- Haskell world; this module contains mostly marshaling- code.--}--module Network.DNS.ADNS where--import Control.Exception ( assert, bracket )-import Foreign-import Foreign.C-import Network ( HostName )-import Network.IP.Address-import System.Posix.Poll-import System.Posix.GetTimeOfDay--#include <adns.h>-#include <errno.h>---- * Marshaled ADNS Data Types--data OpaqueState-type AdnsState = Ptr OpaqueState--data OpaqueQuery-type Query = Ptr OpaqueQuery--data InitFlag- = NoEnv -- ^ do not look at environment- | NoErrPrint -- ^ never print output to stderr ('Debug' overrides)- | NoServerWarn -- ^ do not warn to stderr about duff nameservers etc- | Debug -- ^ enable all output to stderr plus 'Debug' msgs- | LogPid -- ^ include process id in diagnostic output- | NoAutoSys -- ^ do not make syscalls at every opportunity- | Eintr -- ^ allow 'adnsSynch' to return 'eINTR'- | NoSigPipe -- ^ application has SIGPIPE set to SIG_IGN, do not protect- | CheckC_EntEx -- ^ do consistency checks on entry\/exit to adns functions- | CheckC_Freq -- ^ do consistency checks very frequently (slow!)- deriving (Eq, Bounded, Show)--instance Enum InitFlag where- toEnum #{const adns_if_noenv} = NoEnv- toEnum #{const adns_if_noerrprint} = NoErrPrint- toEnum #{const adns_if_noserverwarn} = NoServerWarn- toEnum #{const adns_if_debug} = Debug- toEnum #{const adns_if_logpid} = LogPid- toEnum #{const adns_if_noautosys} = NoAutoSys- toEnum #{const adns_if_eintr} = Eintr- toEnum #{const adns_if_nosigpipe} = NoSigPipe- toEnum #{const adns_if_checkc_entex} = CheckC_EntEx- toEnum #{const adns_if_checkc_freq} = CheckC_Freq- toEnum i = error ("Network.DNS.ADNS.InitFlag cannot be mapped to value " ++ show i)-- fromEnum NoEnv = #{const adns_if_noenv}- fromEnum NoErrPrint = #{const adns_if_noerrprint}- fromEnum NoServerWarn = #{const adns_if_noserverwarn}- fromEnum Debug = #{const adns_if_debug}- fromEnum LogPid = #{const adns_if_logpid}- fromEnum NoAutoSys = #{const adns_if_noautosys}- fromEnum Eintr = #{const adns_if_eintr}- fromEnum NoSigPipe = #{const adns_if_nosigpipe}- fromEnum CheckC_EntEx = #{const adns_if_checkc_entex}- fromEnum CheckC_Freq = #{const adns_if_checkc_freq}--data QueryFlag- = Search -- ^ use the searchlist- | UseVC -- ^ use a virtual circuit (TCP connection)- | Owner -- ^ fill in the owner field in the answer- | QuoteOk_Query -- ^ allow special chars in query domain- | QuoteOk_CName -- ^ allow special chars in CNAME we go via (default)- | QuoteOk_AnsHost -- ^ allow special chars in things supposed to be hostnames- | QuoteFail_CName -- ^ refuse if quote-req chars in CNAME we go via- | CName_Loose -- ^ allow refs to CNAMEs - without, get _s_cname- | CName_Forbid -- ^ don't follow CNAMEs, instead give _s_cname- deriving (Eq, Bounded, Show)--instance Enum QueryFlag where- toEnum #{const adns_qf_search} = Search- toEnum #{const adns_qf_usevc} = UseVC- toEnum #{const adns_qf_owner} = Owner- toEnum #{const adns_qf_quoteok_query} = QuoteOk_Query- toEnum #{const adns_qf_quoteok_cname} = QuoteOk_CName- toEnum #{const adns_qf_quoteok_anshost} = QuoteOk_AnsHost- toEnum #{const adns_qf_quotefail_cname} = QuoteFail_CName- toEnum #{const adns_qf_cname_loose} = CName_Loose- toEnum #{const adns_qf_cname_forbid} = CName_Forbid- toEnum i = error ("Network.DNS.ADNS.QueryFlag cannot be mapped to value " ++ show i)-- fromEnum Search = #{const adns_qf_search}- fromEnum UseVC = #{const adns_qf_usevc}- fromEnum Owner = #{const adns_qf_owner}- fromEnum QuoteOk_Query = #{const adns_qf_quoteok_query}- fromEnum QuoteOk_CName = #{const adns_qf_quoteok_cname}- fromEnum QuoteOk_AnsHost = #{const adns_qf_quoteok_anshost}- fromEnum QuoteFail_CName = #{const adns_qf_quotefail_cname}- fromEnum CName_Loose = #{const adns_qf_cname_loose}- fromEnum CName_Forbid = #{const adns_qf_cname_forbid}---- |The record types we support.--data RRType = A | MX | NS | PTR- deriving (Eq, Bounded, Show)--instance Enum RRType where- toEnum #{const adns_r_a} = A- toEnum #{const adns_r_mx} = MX- toEnum #{const adns_r_ns} = NS- toEnum #{const adns_r_ptr} = PTR- toEnum i = error ("Network.DNS.ADNS.RRType cannot be mapped to value " ++ show i)-- fromEnum A = #{const adns_r_a}- fromEnum MX = #{const adns_r_mx}- fromEnum NS = #{const adns_r_ns}- fromEnum PTR = #{const adns_r_ptr}--instance Storable RRType where- sizeOf _ = #{size adns_rrtype}- alignment _ = alignment (undefined :: #{type adns_rrtype})- poke ptr t = let p = castPtr ptr :: Ptr #{type adns_rrtype}- in poke p ((toEnum . fromEnum) t)- peek ptr = let p = castPtr ptr :: Ptr #{type adns_rrtype}- in peek p >>= return . toEnum . fromEnum---- |The status codes recognized by ADNS vary in different--- versions of the library. So instead of providing an--- 'Enum', the 'Status' type contains the numeric value as--- returned by ADNS itself. For common status codes, helper--- functions like 'sOK' or 'sNXDOMAIN' are provided. The--- functions 'adnsErrTypeAbbrev', 'adnsErrAbbrev', and--- 'adnsStrerror' can also be used to map these codes into--- human readable strings.--newtype Status = StatusCode Int- deriving (Eq, Show)--#enum Status, StatusCode \- , sOK = adns_s_ok \- , sNOMEMORY = adns_s_nomemory \- , sUNKNOWNRRTYPE = adns_s_unknownrrtype \- , sSYSTEMFAIL = adns_s_systemfail \- , sMAX_LOCALFAIL = adns_s_max_localfail \- , sTIMEOUT = adns_s_timeout \- , sALLSERVFAIL = adns_s_allservfail \- , sNORECURSE = adns_s_norecurse \- , sINVALIDRESPONSE = adns_s_invalidresponse \- , sUNKNOWNFORMAT = adns_s_unknownformat \- , sMAX_REMOTEFAIL = adns_s_max_remotefail \- , sRCODESERVFAIL = adns_s_rcodeservfail \- , sRCODEFORMATERROR = adns_s_rcodeformaterror \- , sRCODENOTIMPLEMENTED = adns_s_rcodenotimplemented \- , sRCODEREFUSED = adns_s_rcoderefused \- , sRCODEUNKNOWN = adns_s_rcodeunknown \- , sMAX_TEMPFAIL = adns_s_max_tempfail \- , sINCONSISTENT = adns_s_inconsistent \- , sPROHIBITEDCNAME = adns_s_prohibitedcname \- , sANSWERDOMAININVALID = adns_s_answerdomaininvalid \- , sANSWERDOMAINTOOLONG = adns_s_answerdomaintoolong \- , sINVALIDDATA = adns_s_invaliddata \- , sMAX_MISCONFIG = adns_s_max_misconfig \- , sQUERYDOMAINWRONG = adns_s_querydomainwrong \- , sQUERYDOMAININVALID = adns_s_querydomaininvalid \- , sQUERYDOMAINTOOLONG = adns_s_querydomaintoolong \- , sMAX_MISQUERY = adns_s_max_misquery \- , sNXDOMAIN = adns_s_nxdomain \- , sNODATA = adns_s_nodata \- , sMAX_PERMFAIL = adns_s_max_permfail---- |Original definition:------ > typedef struct {--- > int len;--- > union {--- > struct sockaddr sa;--- > struct sockaddr_in inet;--- > } addr;--- > } adns_rr_addr;------ /Note/: Anything but @sockaddr_in@ will cause 'peek' to call 'fail',--- when marshaling this structure. 'poke' is not defined.--newtype RRAddr = RRAddr HostAddress- deriving (Eq)--instance Show RRAddr where- show (RRAddr ha) = shows b1 . ('.':) .- shows b2 . ('.':) .- shows b3 . ('.':) .- shows b4 $ ""- where- (b1,b2,b3,b4) = ha2tpl ha--instance Storable RRAddr where- sizeOf _ = #{size adns_rr_addr}- alignment _ = alignment (undefined :: CInt)- poke _ _ = fail "poke is undefined for Network.DNS.ADNS.RRAddr"- peek ptr' = do- let ptr = #{ptr adns_rr_addr, addr} ptr'- (t :: #{type sa_family_t}) <- #{peek struct sockaddr_in, sin_family} ptr- if (t /= #{const AF_INET})- then fail ("peek Network.DNS.ADNS.RRAddr: unsupported 'sockaddr' type " ++ show t)- else #{peek struct sockaddr_in, sin_addr} ptr >>= return . RRAddr---- |Original definition:------ > typedef struct {--- > char *host;--- > adns_status astatus;--- > int naddrs; /* temp fail => -1, perm fail => 0, s_ok => >0--- > adns_rr_addr *addrs;--- > } adns_rr_hostaddr;------ The @naddrs@ field is not available in @RRHostAddr@--- because I couldn't see how that information wouldn't be--- available in the @astatus@ field too. If I missed--- anything, please let me know.------ /Note/: The data type should probably contain--- 'HostAddress' rather than 'RRAddr'. I'm using the former--- only because it has nicer output with 'show'. 'poke' is--- not defined.--data RRHostAddr = RRHostAddr HostName Status [RRAddr]- deriving (Show)--instance Storable RRHostAddr where- sizeOf _ = #{size adns_rr_hostaddr}- alignment _ = alignment (undefined :: CString)- poke _ _ = fail "poke is undefined for Network.DNS.ADNS.RRHostAddr"- peek ptr = do- h <- #{peek adns_rr_hostaddr, host} ptr- hstr <- assert (h /= nullPtr) (peekCString h)- st <- #{peek adns_rr_hostaddr, astatus} ptr- (nadr :: #{type adns_status}) <- #{peek adns_rr_hostaddr, naddrs} ptr- aptr <- #{peek adns_rr_hostaddr, addrs} ptr- adrs <- if (nadr > 0)- then peekArray (fromEnum nadr) aptr- else return []- return (RRHostAddr hstr (StatusCode st) adrs)---- |Original definition:------ > typedef struct {--- > int i;--- > adns_rr_hostaddr ha;--- > } adns_rr_inthostaddr;--data RRIntHostAddr = RRIntHostAddr Int RRHostAddr- deriving (Show)--instance Storable RRIntHostAddr where- sizeOf _ = #{size adns_rr_inthostaddr}- alignment _ = alignment (undefined :: CInt)- poke _ _ = fail "poke is undefined for Network.DNS.ADNS.RRIntHostAddr"- peek ptr = do- (i::CInt) <- #{peek adns_rr_inthostaddr, i} ptr- a <- #{peek adns_rr_inthostaddr, ha} ptr- return (RRIntHostAddr (fromEnum i) a)--data Answer = Answer- { status :: Status- -- ^ Status code for this query.- , cname :: Maybe String- -- ^ Always 'Nothing' for @CNAME@ queries (which are not supported yet anyway).- , owner :: Maybe String- -- ^ Only set if 'Owner' was requested for query.- , expires :: CTime- -- ^ Only defined if status is 'sOK', 'sNXDOMAIN', or 'sNODATA'.- , rrs :: [Response]- -- ^ The list will be empty if an error occured.- }- deriving (Show)--data Response- = RRA RRAddr- | RRMX Int RRHostAddr- | RRNS RRHostAddr- | RRPTR String- deriving (Show)--instance Storable Answer where- sizeOf _ = #{size adns_answer}- alignment _ = alignment (undefined :: CInt)- poke _ _ = fail "poke is not defined for Network.DNS.ADNS.Answer"- peek ptr = do- sc <- #{peek adns_answer, status} ptr- cn <- #{peek adns_answer, cname} ptr >>= maybePeek peekCString- ow <- #{peek adns_answer, owner} ptr >>= maybePeek peekCString- et <- #{peek adns_answer, expires} ptr- rt <- #{peek adns_answer, type} ptr- (rs :: CInt) <- #{peek adns_answer, nrrs} ptr- (sz :: CInt) <- #{peek adns_answer, rrsz} ptr- rrsp <- #{peek adns_answer, rrs} ptr- r <- peekResp rt rrsp (fromEnum sz) (fromEnum rs)- return Answer- { status = StatusCode sc- , cname = cn- , owner = ow- , expires = et- , rrs = r- }---- |This function parses the 'Response' union found in--- 'Answer'. It cannot be defined via 'Storable' because it--- needs to know the type of the record to expect. This is,--- by the way, the function to look at, if you want to add--- support for additional 'RRType' records.--peekResp :: RRType -> Ptr b -> Int -> Int -> IO [Response]-peekResp _ _ _ 0 = return []-peekResp rt ptr off n = do- r <- parseByType rt- rs <- peekResp rt (ptr `plusPtr` off) off (n-1)- return (r:rs)-- where- parseByType A = peek (castPtr ptr) >>= return . RRA . RRAddr- parseByType NS = peek (castPtr ptr) >>= return . RRNS- parseByType PTR = peek (castPtr ptr) >>= peekCString >>= return . RRPTR- parseByType MX = do (RRIntHostAddr i addr) <- peek (castPtr ptr)- return (RRMX i addr)---- * ADNS Library Functions---- |Run the given 'IO' computation with an initialized--- resolver. As of now, the diagnose stream is always set to--- 'System.IO.stderr'. Initialize the library with 'NoErrPrint' if you--- don't wont to see any error output. All resources are--- freed when @adnsInit@ returns.--adnsInit :: [InitFlag] -> (AdnsState -> IO a) -> IO a-adnsInit flags =- bracket- (wrapAdns (\p -> adns_init p (mkFlags flags) nullPtr) peek)- adns_finish---- |Similar to 'adnsInit', but reads the resolver--- configuration from a string rather than from--- @\/etc\/resolv.conf@. Supported are the usual commands:--- @nameserver@, @search@, @domain@, @sortlist@, and--- @options@.------ Additionally, these non-standard commands may be used:------ * @clearnameservers@: Clears the list of nameservers.------ * @include filename@: The specified file will be read.--adnsInitCfg :: [InitFlag] -> String -> (AdnsState -> IO a) -> IO a-adnsInitCfg flags cfg = bracket mkState adns_finish- where- mkState = withCString cfg $ \cstr ->- wrapAdns- (\p -> adns_init_strcfg p (mkFlags flags) nullPtr cstr)- peek---- | Perform a synchronous query for a record. In case of an--- I\/O error, an 'System.IO.Error.IOException' is thrown.--- If the query fails for other reasons, the 'Status' code--- in the 'Answer' will signify that.--adnsSynch :: AdnsState -> String -> RRType -> [QueryFlag] -> IO Answer-adnsSynch st own rrt flags =- withCString own $ \o -> do- let rrt' = (toEnum . fromEnum) rrt- wrapAdns- (adns_synchronous st o rrt' (mkFlags flags))- (\p -> peek p >>= peek)---- | Submit an asynchronous query. The returned 'Query' can--- be tested for completion with 'adnsCheck'.--adnsSubmit :: AdnsState -> String -> RRType -> [QueryFlag] -> IO Query-adnsSubmit st own rrt flags =- withCString own $ \o -> do- let rrt' = (toEnum . fromEnum) rrt- wrapAdns- (adns_submit st o rrt' (mkFlags flags) nullPtr)- (peek)---- | Check the status of an asynchronous query. If the query--- is complete, the 'Answer' will be returned. The 'Query'--- becomes invalid after that.--adnsCheck :: AdnsState -> Query -> IO (Maybe Answer)-adnsCheck st q =- alloca $ \qPtr ->- alloca $ \aPtr -> do- poke qPtr q- poke aPtr nullPtr- rc <- adns_check st qPtr aPtr nullPtr- case rc of- 0 -> peek aPtr >>= peek >>= return . Just- #{const EAGAIN} -> return Nothing- _ -> do p <- adns_strerror rc- s <- peekCString p- fail ("adnsCheck: " ++ s)---- |Cancel an open 'Query'.--foreign import ccall unsafe "adns_cancel" adnsCancel :: Query -> IO ()---- |Return the list of all currently open queries.--adnsQueries :: AdnsState -> IO [Query]-adnsQueries st = adns_forallqueries_begin st >> walk- where walk = do q <- adns_forallqueries_next st nullPtr- if (q /= nullPtr)- then walk >>= return . ((:) q)- else return []---- | Find out which file descriptors ADNS is interested in--- and when it would like to be able to time things out.--- This is in a form suitable for use with 'poll'.------ On entry, @fds@ should point to at least @*nfds_io@--- structs. ADNS will fill up to that many structs with--- information for @poll@, and record in @*nfds_io@ how many--- entries it actually used. If the array is too small,--- @*nfds_io@ will be set to the number required and--- 'adnsBeforePoll' will return 'eRANGE'.------ You may call 'adnsBeforePoll' with @fds=='nullPtr'@ and--- @*nfds_io==0@, in which case ADNS will fill in the number--- of fds that it might be interested in into @*nfds_io@ and--- return either 0 (if it is not interested in any fds) or--- 'eRANGE' (if it is).------ Note that (unless @now@ is 0) ADNS may acquire additional--- fds from one call to the next, so you must put--- adns_beforepoll in a loop, rather than assuming that the--- second call (with the buffer size requested by the first)--- will not return 'eRANGE'.------ ADNS only ever sets 'PollIn', 'PollOut' and 'PollPri' in--- its 'Pollfd' structs, and only ever looks at those bits.--- 'PollPri' is required to detect TCP Urgent Data (which--- should not be used by a DNS server) so that ADNS can know--- that the TCP stream is now useless.------ In any case, @*timeout_io@ should be a timeout value as--- for 'poll', which ADNS will modify downwards as required.--- If the caller does not plan to block, then @*timeout_io@--- should be 0 on entry. Alternatively, @timeout_io@ may be--- 0.------ 'adnsBeforePoll' will return 0 on success, and will not--- fail for any reason other than the fds buffer being too--- small (ERANGE).------ This call will never actually do any I\/O. If you supply--- the current time it will not change the fds that ADNS is--- using or the timeouts it wants.------ In any case this call won't block.--foreign import ccall unsafe "adns_beforepoll" adnsBeforePoll ::- AdnsState -> Ptr Pollfd -> Ptr CInt -> Ptr CInt -> Ptr Timeval- -> IO CInt---- |Gives ADNS flow-of-control for a bit; intended for use--- after 'poll'. @fds@ and @nfds@ should be the results from--- 'poll'. 'Pollfd' structs mentioning fds not belonging to--- adns will be ignored.--foreign import ccall unsafe "adns_afterpoll" adnsAfterPoll ::- AdnsState -> Ptr Pollfd -> CInt -> Ptr Timeval -> IO ()---- | Map a 'Status' code to a human-readable error--- description. For example:------ > *ADNS> adnsStrerror sNXDOMAIN >>= print--- > "No such domain"------ Use this function with great care: It will crash the--- process when called with a status code that ADNS doesn't--- know about. So use it only to print values you got from--- the resolver!--adnsStrerror :: Status -> IO String-adnsStrerror (StatusCode x) = do- cstr <- (adns_strerror . toEnum . fromEnum) x- assert (cstr /= nullPtr) (peekCString cstr)---- | Map a 'Status' code to a short error name. Don't use--- this function to print a status code unless you've--- obtained it from the resolver!--adnsErrAbbrev :: Status -> IO String-adnsErrAbbrev (StatusCode x) = do- cstr <- (adns_errabbrev . toEnum . fromEnum) x- assert (cstr /= nullPtr) (peekCString cstr)---- |Map a 'Status' code to a short description of the type--- of error. Don't use this function to print a status code--- unless you've obtained it from the resolver!--adnsErrTypeAbbrev :: Status -> IO String-adnsErrTypeAbbrev (StatusCode x) = do- cstr <- (adns_errtypeabbrev . toEnum . fromEnum) x- assert (cstr /= nullPtr) (peekCString cstr)---- * Unmarshaled Low-Level C Functions--foreign import ccall unsafe adns_init ::- Ptr AdnsState -> CInt -> Ptr CFile -> IO CInt--foreign import ccall unsafe adns_init_strcfg ::- Ptr AdnsState -> CInt -> Ptr CFile -> CString-> IO CInt--foreign import ccall unsafe adns_finish ::- AdnsState -> IO ()--foreign import ccall unsafe adns_submit ::- AdnsState -> CString -> CInt -> CInt -> Ptr a -> Ptr Query- -> IO CInt--foreign import ccall unsafe adns_check ::- AdnsState -> Ptr Query -> Ptr (Ptr Answer) -> Ptr (Ptr a)- -> IO CInt--foreign import ccall unsafe adns_synchronous ::- AdnsState -> CString -> CInt -> CInt -> Ptr (Ptr Answer)- -> IO CInt--foreign import ccall unsafe adns_forallqueries_begin ::- AdnsState -> IO ()--foreign import ccall unsafe adns_forallqueries_next ::- AdnsState -> Ptr (Ptr a) -> IO Query--foreign import ccall unsafe adns_strerror :: CInt -> IO CString-foreign import ccall unsafe adns_errabbrev :: CInt -> IO CString-foreign import ccall unsafe adns_errtypeabbrev :: CInt -> IO CString---- * Helper Functions---- |Internel helper function to handle result passing from--- ADNS via @Ptr (Ptr a)@, and to generate human-readable IO--- exceptions in case of an error.--wrapAdns :: (Ptr (Ptr b) -> IO CInt) -> (Ptr (Ptr b) -> IO a) -> IO a-wrapAdns m acc = alloca $ \resP -> do- poke resP nullPtr- rc <- m resP- if (rc == 0)- then acc resP- else do p <- adns_strerror rc- s <- peekCString p- fail ("ADNS: " ++ s)---- |Map a list of flags ('Enum' types) into a 'CInt'--- suitable for adns calls.--mkFlags :: Enum a => [a] -> CInt-mkFlags = toEnum . sum . map fromEnum----- ----- Configure Emacs ----------- Local Variables: ***--- haskell-program-name: "ghci -ladns -lcrypto" ***--- End: ***
− Network/DNS/PollResolver.hs
@@ -1,226 +0,0 @@-{- |- Module : Network.DNS.PollResolver- Copyright : (c) 2006-04-08 by Peter Simons- License : GPL2-- Maintainer : simons@cryp.to- Stability : provisional- Portability : Haskell 2-pre-- This module provides a 'poll'-based I\/O scheduler for- "Network.DNS.ADNS". See the @test.hs@ program included in- the distribution for an example of how to use this- resolver. Link your program with the /threaded/- runtime-system when you use this module. In GHC, this is- accomplished by specifying @-threaded@ on the- command-line.- -}--module Network.DNS.PollResolver where--import Control.Concurrent ( forkIO )-import Control.Concurrent.MVar-import Control.Monad ( when )-import Data.List ( sortBy )-import Foreign-import Foreign.C-import Network ( HostName )-import Network.IP.Address-import Network.DNS.ADNS-import System.Posix.Poll-import System.Posix.GetTimeOfDay---- * Resolver API---- |A 'Resolver' is an 'IO' computation which -- given the--- name and type of the record to query -- returns an 'MVar'--- that will eventually contain the 'Answer' from the Domain--- Name System.--type Resolver = String -> RRType -> [QueryFlag] -> IO (MVar Answer)---- |Run the given 'IO' computation with an Initialized--- 'Resolver'. Note that resolver functions can be shared,--- and /should/ be shared between any number of 'IO'--- threads. You may use multiple resolvers, of course, but--- doing so defeats the purpose of an asynchronous resolver.--initResolver :: [InitFlag] -> (Resolver -> IO a) -> IO a-initResolver flags f = do- adnsInit flags $ \dns -> do- fds <- mallocForeignPtrArray initSize- mst <- newMVar (RState dns fds initSize [])- f (resolve mst)- where- initSize = 32---- |Resolve a hostname's 'A' records.--resolveA :: Resolver -> HostName -> IO (Either Status [HostAddress])-resolveA resolver x = do- Answer rc _ _ _ rs <- resolver x A [] >>= takeMVar- if rc /= sOK- then return (Left rc)- else return (Right [ addr | RRA (RRAddr addr) <- rs ])---- |Get the 'PTR' records assigned to a host address. Note--- that although the API allows for a record to have more--- than one 'PTR' entry, this will actually not happen--- because the GNU adns library can't handle this case and--- will return 'sINCONSISTENT'.--resolvePTR :: Resolver -> HostAddress -> IO (Either Status [HostName])-resolvePTR resolver x = do- Answer rc _ _ _ rs <- resolver (ha2ptr x) PTR [] >>= takeMVar- if rc /= sOK- then return (Left rc)- else return (Right [ addr | RRPTR addr <- rs ])---- |Resolve the mail exchangers for a hostname. The returned--- list may contain more than one entry per hostname, in--- case the host has several 'A' records. The records are--- returned in the order you should try to contact them as--- determined by the priority in the 'RRMX' response.--resolveMX :: Resolver -> HostName -> IO (Either Status [(HostName, HostAddress)])-resolveMX resolver x = do- Answer rc _ _ _ rs <- resolver x MX [] >>= takeMVar- if rc /= sOK- then return (Left rc)- else do- let cmp (RRMX p1 _) (RRMX p2 _) = compare p1 p2- cmp _ _= error $ showString "unexpected record in MX lookup: " (show rs)- rs' = sortBy cmp rs- as = [ (hn,a) | RRMX _ (RRHostAddr hn stat has) <- rs'- , stat == sOK && not (null has)- , RRAddr a <- has ]- return (Right as)---- |Convenience wrapper that will modify any of the--- @revolveXXX@ functions above to return 'Maybe' rather--- than 'Either'. The idea is that @Nothing@ signifies any--- sort of failure; @Just []@ signifies 'sNXDOMAIN'; and--- everything else signifies 'sOK'.------ So if you aren't interested in getting accurate 'Status'--- codes in case of failures. Wrap your DNS queries as--- follows:------ > queryA :: Resolver -> HostName -> IO (Maybe [HostAddress])--- > queryA = query resolveA--query :: (Resolver -> a -> IO (Either Status [b]))- -> (Resolver -> a -> IO (Maybe [b]))-query f dns x = fmap toMaybe (f dns x)- where- toMaybe (Left rc)- | rc == sNXDOMAIN = Just []- | otherwise = Nothing- toMaybe (Right r) = Just r---- |Use this function to disable DNS resolving. It will--- always return @('Answer' 'sSYSTEMFAIL' Nothing (Just--- host) (-1) [])@.--dummyDNS :: Resolver-dummyDNS host _ _ = newMVar- (Answer sSYSTEMFAIL Nothing (Just host) (-1) [])---- * Implementation---- |The internal state of the resolver is stored in an--- 'MVar' so that it is shared (and synchronized) between--- any number of concurrent 'IO' threads.--data ResolverState = RState- { adns :: AdnsState -- ^opaque ADNS state- , pollfds :: ForeignPtr Pollfd -- ^array for poll(2)- , capacity :: Int -- ^size of the array- , queries :: [(Query, MVar Answer)] -- ^currently open queries- }---- |Submit a DNS query to the resolver and check whether we--- have a running 'resolveLoop' thread already. If we don't,--- start one with 'forkIO'. Make sure you link the threaded--- RTS so that the main loop will not block other threads.--resolve :: MVar ResolverState -> Resolver-resolve mst r rt qfs = modifyMVar mst $ \st -> do- res <- newEmptyMVar- q <- adnsSubmit (adns st) r rt qfs- when (null (queries st))- (forkIO (resolveLoop mst) >> return ())- let st' = st { queries = (q,res):(queries st) }- return (st', res)---- |Loop until all open queries have been resolved. Uses--- 'poll' internally to avoid busy-polling the ADNS sockets.--resolveLoop :: MVar ResolverState -> IO ()-resolveLoop mst = do- empty <- modifyMVar mst $ \(RState dns fds cap qs) -> do- res' <- mapM (checkQuery dns) qs- case [ x | Just x <- res' ] of- [] -> do adnsQueries dns >>= mapM_ adnsCancel- return ((RState dns fds cap []), True)- res -> return ((RState dns fds cap res), False)- when (not empty) (waitForIO >> resolveLoop mst)-- where- checkQuery dns (q, mv) = do- res <- adnsCheck dns q- case res of- Just a -> putMVar mv a >> return Nothing- Nothing -> return (Just (q, mv))-- waitForIO = do- (nfds,to) <- beforePoll- when (nfds > 0) (doPoll nfds to >> afterPoll nfds)-- beforePoll = do- b4 <- modifyMVar mst $ \st ->- withForeignPtr (pollfds st) $ \fds ->- alloca $ \nfds ->- alloca $ \to ->- alloca $ \now -> do- poke nfds (toEnum (capacity st))- poke to (-1)- getTimeOfDay now- rc <- adnsBeforePoll (adns st) fds nfds to now- n <- peek nfds- tv <- peek to- if rc == 0 then return (st, (Right (n,tv))) else- if (Errno rc) == eRANGE then return (st, (Left n)) else- fail ("adnsBeforePoll returned unknown value " ++ show rc)- case b4 of- Left n -> allocFds (fromEnum n) >> beforePoll- Right x -> return x-- doPoll nfds to = do- fds' <- withMVar mst (return . pollfds)- rc <- withForeignPtr fds' $ \fds ->- poll fds (toEnum (fromEnum nfds)) to- when (rc < 0) (throwErrno "PollResolver.doPoll failed")-- afterPoll nfds =- withMVar mst $ \st ->- alloca $ \now ->- withForeignPtr (pollfds st) $ \fds -> do- getTimeOfDay now- adnsAfterPoll (adns st) fds nfds now-- allocFds n = modifyMVar_ mst $ \st ->- if n <= capacity st then return st else do- let sizes = iterate (*2) (capacity st)- (n':_) = dropWhile (<n) sizes- fds <- mallocForeignPtrArray n'- return st { pollfds = fds- , capacity = n'- }----- ----- Configure Emacs ----------- Local Variables: ***--- haskell-program-name: "ghci -ladns -lcrypto" ***--- End: ***
− Network/IP/Address.hs
@@ -1,48 +0,0 @@-{- |- Module : Network.IP.Address- Copyright : (c) 2006-04-08 by Peter Simons- License : GPL2-- Maintainer : simons@cryp.to- Stability : provisional- Portability : Haskell 2-pre-- Tools for manipulating IP addresses.--}--module Network.IP.Address- ( module Network.IP.Address- , HostAddress- , inet_addr- , inet_ntoa- )- where--import Data.Endian-import Data.Bits-import Network.Socket---- |Split up an IP address in network byte-order.--ha2tpl :: HostAddress -> (Int, Int, Int, Int)-ha2tpl n =- let (b1,n1) = (n .&. 255, n `shiftR` 8)- (b2,n2) = (n1 .&. 255, n1 `shiftR` 8)- (b3,n3) = (n2 .&. 255, n2 `shiftR` 8)- b4 = n3 .&. 255- in- case ourEndian of- BigEndian -> (fromEnum b4, fromEnum b3, fromEnum b2, fromEnum b1)- LittleEndian -> (fromEnum b1, fromEnum b2, fromEnum b3, fromEnum b4)- PDPEndian -> (fromEnum b4, fromEnum b3, fromEnum b1, fromEnum b2)---- |Turn a 32-bit IP address into a string suitable for--- 'Network.DNS.PTR' lookups in the Domain Name System.--ha2ptr :: HostAddress -> String-ha2ptr n = shows b4 . ('.':) .- shows b3 . ('.':) .- shows b2 . ('.':) .- shows b1 $ ".in-addr.arpa."- where- (b1,b2,b3,b4) = ha2tpl n
+ README view
@@ -0,0 +1,61 @@+An asynchronous DNS resolver for Haskell_+=========================================++:Latest Release: hsdns-1.3.tar.gz_+:Darcs: darcs_ get http://cryp.to/hsdns/++Synopsis+--------++ This library provides an asynchronous DNS resolver on top of+ the `GNU ADNS library`_. Not all options are supported, but A,+ MX, and PTR lookups work nicely. Courtesy of Lutz Donnerhacke+ <lutz@iks-jena.de>, there is also support for retrieving+ generic RR types, CNAMEs, and for NSEC zone walking. The+ library can be expected to work with fine ADNS 1.4 or later. It+ might also work with version ADNS 1.3, but that hasn't been+ tested.++ The example program adns-reverse-lookup.hs_ demonstrates how+ the resolver is used. Given a list of host names on the command+ line, it performs an A/PTR double-lookup and checks whether the+ records are consistent. The output is printed in the order in+ which the DNS responses arrive::++ $ ./adns-reverse-lookup xyz.example.org ecrc.de www.example.com www.cryp.to+ OK: www.example.com <-> 208.77.188.166+ ERR: xyz.example.org: cannot resolve A+ FAIL: www.cryp.to -> 195.234.152.69 -> ["research.cryp.to"]+ FAIL: ecrc.de -> 127.0.0.1 -> ["localhost"]++Documentation+-------------++ `Reference Documentation`_+ Haddock-generated reference of all exported functions.++Copyleft+--------++ Copyright (c) 2008 Peter Simons <simons@cryp.to>. All rights+ reserved. This software is released under the terms of the `GNU+ Lesser General Public License+ <http://www.gnu.org/licenses/lgpl.html>`_.++-----------------------------------------------------------------++`[Homepage] <http://cryp.to/>`_++.. _Haskell: http://haskell.org/++.. _Cabal: http://haskell.org/cabal/++.. _darcs: http://abridgegame.org/darcs/++.. _GNU ADNS library: http://www.chiark.greenend.org.uk/~ian/adns/++.. _Reference Documentation: docs/index.html++.. _hsdns-1.3.tar.gz: http://cryp.to/hsdns/hsdns-1.3.tar.gz++.. _adns-reverse-lookup.hs: example/adns-reverse-lookup.hs
− Setup.hs
@@ -1,5 +0,0 @@-#!/usr/bin/runhaskell--import Distribution.Simple--main = defaultMainWithHooks defaultUserHooks
+ Setup.lhs view
@@ -0,0 +1,8 @@+#!/usr/bin/env runhaskell++> module Main (main) where+>+> import Distribution.Simple+>+> main :: IO ()+> main = defaultMain
− System/Posix/GetTimeOfDay.hsc
@@ -1,54 +0,0 @@-{-# OPTIONS -fffi -fglasgow-exts #-}-{- |- Module : System.Posix.GetTimeOfDay- Copyright : (c) 2006-04-08 by Peter Simons- License : GPL2-- Maintainer : simons@cryp.to- Stability : provisional- Portability : Haskell 2-pre-- A foreign function interface to @gettimeofday(2)@.--}--module System.Posix.GetTimeOfDay where--import Foreign-import Foreign.C--#include <sys/time.h>---- |Marshaling for C's @struct timeval@.--data Timeval = Timeval CTime #{type suseconds_t}---- |Not really implemented by anyone; so we provide just a--- place-holder. Pass 'nullPtr' to 'gettimeofday'.--data Timezone--instance Storable Timeval where- sizeOf _ = #{size struct timeval}- alignment _ = alignment (undefined :: CTime)- poke ptr (Timeval t us)- = do #{poke struct timeval, tv_sec} ptr t- #{poke struct timeval, tv_usec} ptr us- peek ptr = do t <- #{peek struct timeval, tv_sec} ptr- us <- #{peek struct timeval, tv_usec} ptr- return (Timeval t us)---- |Write the current time as a 'Timeval'. The time is--- returned in local time, no time zone correction takes--- place. Signals errors with 'throwErrno'.--getTimeOfDay :: Ptr Timeval -> IO ()-getTimeOfDay p = do- rc <- gettimeofday p nullPtr- case rc of- 0 -> return ()- _ -> throwErrno "GetTimeOfDay"---- |The @gettimeofday(2)@ system call.--foreign import ccall unsafe gettimeofday- :: Ptr Timeval -> Ptr Timezone -> IO CInt
− System/Posix/Poll.hsc
@@ -1,91 +0,0 @@-{-# OPTIONS -fffi -fglasgow-exts #-}-{- |- Module : System.Posix.Poll- Copyright : (c) 2006-04-08 by Peter Simons- License : GPL2-- Maintainer : simons@cryp.to- Stability : provisional- Portability : Haskell 2-pre-- A foreign function interface to the POSIX system call- @poll(2)@. Your program should link the threaded- runtime-system when using this module in blocking- fashion.- -}--module System.Posix.Poll where--import Foreign-import Foreign.C-import System.Posix.Types--#include <sys/poll.h>---- |The marshaled version of:------ > struct pollfd--- > {--- > int fd; /* file descriptor */--- > short events; /* requested events */--- > short revents; /* returned events */--- > };--data Pollfd = Pollfd Fd CShort CShort- deriving (Show)--instance Storable Pollfd where- sizeOf _ = #{size struct pollfd}- alignment _ = alignment (undefined :: CInt)-- peek p = do- fd <- #{peek struct pollfd, fd} p- e <- #{peek struct pollfd, events} p- re <- #{peek struct pollfd, revents} p- return $ Pollfd fd e re-- poke p (Pollfd fd e re) = do- #{poke struct pollfd, fd} p fd- #{poke struct pollfd, events} p e- #{poke struct pollfd, revents} p re---- |Marshaled 'Enum' representing the various @poll(2)@--- flags.--data PollFlag- = PollIn -- ^ there is data to read- | PollPri -- ^ there is urgent data to read- | PollOut -- ^ writing now will not block- | PollErr -- ^ error condition- | PollHup -- ^ hung up- | PollNVal -- ^ invalid request: fd not open- deriving (Eq, Bounded, Show)--instance Enum PollFlag where- toEnum #{const POLLIN} = PollIn- toEnum #{const POLLPRI} = PollPri- toEnum #{const POLLOUT} = PollOut- toEnum #{const POLLERR} = PollErr- toEnum #{const POLLHUP} = PollHup- toEnum #{const POLLNVAL} = PollNVal- toEnum i = error ("PollFlag cannot be mapped to value " ++ show i)-- fromEnum PollIn = #{const POLLIN}- fromEnum PollPri = #{const POLLPRI}- fromEnum PollOut = #{const POLLOUT}- fromEnum PollErr = #{const POLLERR}- fromEnum PollHup = #{const POLLHUP}- fromEnum PollNVal = #{const POLLNVAL}---- |The system routine @poll(2)@ may block, obviously; so it--- is declared as a \"safe\" FFI call. In the /threaded/--- runtime-system, this means that a blocking invocation of--- 'poll' will not block any other execution threads. Thus,--- you should link your programs with @-threaded@ when you--- use this module. Further details can be found at--- <http://www.haskell.org//pipermail/glasgow-haskell-users/2005-February/007762.html>.------ In the non-threaded runtime-system, using 'poll' in--- blocking fashion /will/ block all other threads too.--foreign import ccall safe poll :: Ptr Pollfd -> CUInt -> CInt -> IO CInt
+ example/adns-reverse-lookup.hs view
@@ -0,0 +1,60 @@+{-+ 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: ***
+ example/adns-test-and-traverse.hs view
@@ -0,0 +1,49 @@+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
hsdns.cabal view
@@ -1,27 +1,46 @@-Name: hsdns-Version: 1.1-Author: Peter Simons <simons@cryp.to>-License: GPL-License-File: LICENSE-Maintainer: simons@cryp.to-Homepage: http://cryp.to/hsdns/-Category: Network-Description: Asynchronous DNS Resolver; requires the GNU ADNS library to be installed.--Build-Depends: base, network-Extra-Libraries: adns-Includes: "<adns.h>", "<sys/poll.h>", "<sys/time.h>",- "<errno.h>"-Exposed-Modules:- Data.Endian,- Network.DNS,- Network.DNS.ADNS,- Network.DNS.PollResolver,- Network.IP.Address,- System.Posix.GetTimeOfDay,- System.Posix.Poll+Name: hsdns+Version: 1.3+Author: Peter Simons <simons@cryp.to>,+ Lutz Donnerhacke <lutz@iks-jena.de>+Maintainer: Peter Simons <simons@cryp.to>+License: LGPL+License-File: COPYING+Homepage: http://cryp.to/hsdns/+Synopsis: Asynchronous DNS Resolver+Description: Asynchronous DNS Resolver; requires GNU ADNS to be installed.+Category: Foreign, Network+Build-Depends: base, network, containers+Extensions: ForeignFunctionInterface, EmptyDataDecls+Extra-Libraries: adns+Includes: "adns.h", "errno.h"+Exposed-Modules: ADNS,+ ADNS.Base,+ ADNS.Endian,+ ADNS.Resolver+GHC-Options: -Wall+Data-Files: README, prologue.txt+Build-Type: Simple -Extensions: ForeignFunctionInterface, PatternSignatures, EmptyDataDecls-Build-Type: Simple-Tested-With: GHC==6.8.2-ghc-options: -Wall -O2+-- Building these executables doesn't work anymore with the latest+-- cabal version. The problem is that the file ADNS/Base.hs is no+-- longer generated into the source tree, but into the dist/+-- directory, where the example programs won't find it during+-- compilation.+--+-- To remedy the situation, we need either a really wild search+-- path so that ADNS/Base.hs is found in the build dir, or we need+-- separate cabal files for building the library and the example+-- programs (which would suck) or some other magic way I am+-- currently unaware of but that probably exists. Whatever.+--+-- Executable: adns-reverse-lookup+-- Hs-Source-Dirs: example, .+-- Main-Is: adns-reverse-lookup.hs+-- Extra-Libraries: adns+-- GHC-Options: -O -Wall -threaded+--+-- Executable: adns-test-and-traverse+-- Hs-Source-Dirs: example, .+-- Main-Is: adns-test-and-traverse.hs+-- Extra-Libraries: adns+-- GHC-Options: -O -Wall -threaded
+ prologue.txt view
@@ -0,0 +1,4 @@+This package provides FFI bindings to the GNU ADNS library+<http://www.gnu.org/software/adns/> as well as an appropriate+high-level interface from the Haskell world. The code has been+been tested with ADNS version 1.4.