{-# INCLUDE #-} {-# INCLUDE #-} {-# 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 . 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: ***