hsdns-1.1Source codeContentsIndex
Network.DNS.ADNS
PortabilityHaskell 2-pre
Stabilityprovisional
Maintainersimons@cryp.to
Contents
Marshaled ADNS Data Types
ADNS Library Functions
Unmarshaled Low-Level C Functions
Helper Functions
Description

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.

Synopsis
data OpaqueState
type AdnsState = Ptr OpaqueState
data OpaqueQuery
type Query = Ptr OpaqueQuery
data InitFlag
= NoEnv
| NoErrPrint
| NoServerWarn
| Debug
| LogPid
| NoAutoSys
| Eintr
| NoSigPipe
| CheckC_EntEx
| CheckC_Freq
data QueryFlag
= Search
| UseVC
| Owner
| QuoteOk_Query
| QuoteOk_CName
| QuoteOk_AnsHost
| QuoteFail_CName
| CName_Loose
| CName_Forbid
data RRType
= A
| MX
| NS
| PTR
newtype Status = StatusCode Int
sOK :: Status
sNOMEMORY :: Status
sUNKNOWNRRTYPE :: Status
sSYSTEMFAIL :: Status
sMAX_LOCALFAIL :: Status
sTIMEOUT :: Status
sALLSERVFAIL :: Status
sNORECURSE :: Status
sINVALIDRESPONSE :: Status
sUNKNOWNFORMAT :: Status
sMAX_REMOTEFAIL :: Status
sRCODESERVFAIL :: Status
sRCODEFORMATERROR :: Status
sRCODENOTIMPLEMENTED :: Status
sRCODEREFUSED :: Status
sRCODEUNKNOWN :: Status
sMAX_TEMPFAIL :: Status
sINCONSISTENT :: Status
sPROHIBITEDCNAME :: Status
sANSWERDOMAININVALID :: Status
sANSWERDOMAINTOOLONG :: Status
sINVALIDDATA :: Status
sMAX_MISCONFIG :: Status
newtype RRAddr = RRAddr HostAddress
sQUERYDOMAINWRONG :: Status
sQUERYDOMAININVALID :: Status
sQUERYDOMAINTOOLONG :: Status
sMAX_MISQUERY :: Status
sNXDOMAIN :: Status
sNODATA :: Status
sMAX_PERMFAIL :: Status
data RRHostAddr = RRHostAddr HostName Status [RRAddr]
data RRIntHostAddr = RRIntHostAddr Int RRHostAddr
data Answer = Answer {
status :: Status
cname :: Maybe String
owner :: Maybe String
expires :: CTime
rrs :: [Response]
}
data Response
= RRA RRAddr
| RRMX Int RRHostAddr
| RRNS RRHostAddr
| RRPTR String
peekResp :: RRType -> Ptr b -> Int -> Int -> IO [Response]
adnsInit :: [InitFlag] -> (AdnsState -> IO a) -> IO a
adnsInitCfg :: [InitFlag] -> String -> (AdnsState -> IO a) -> IO a
adnsSynch :: AdnsState -> String -> RRType -> [QueryFlag] -> IO Answer
adnsSubmit :: AdnsState -> String -> RRType -> [QueryFlag] -> IO Query
adnsCheck :: AdnsState -> Query -> IO (Maybe Answer)
adnsCancel :: Query -> IO ()
adnsQueries :: AdnsState -> IO [Query]
adnsBeforePoll :: AdnsState -> Ptr Pollfd -> Ptr CInt -> Ptr CInt -> Ptr Timeval -> IO CInt
adnsAfterPoll :: AdnsState -> Ptr Pollfd -> CInt -> Ptr Timeval -> IO ()
adnsStrerror :: Status -> IO String
adnsErrAbbrev :: Status -> IO String
adnsErrTypeAbbrev :: Status -> IO String
adns_init :: Ptr AdnsState -> CInt -> Ptr CFile -> IO CInt
adns_init_strcfg :: Ptr AdnsState -> CInt -> Ptr CFile -> CString -> IO CInt
adns_finish :: AdnsState -> IO ()
adns_submit :: AdnsState -> CString -> CInt -> CInt -> Ptr a -> Ptr Query -> IO CInt
adns_check :: AdnsState -> Ptr Query -> Ptr (Ptr Answer) -> Ptr (Ptr a) -> IO CInt
adns_synchronous :: AdnsState -> CString -> CInt -> CInt -> Ptr (Ptr Answer) -> IO CInt
adns_forallqueries_begin :: AdnsState -> IO ()
adns_forallqueries_next :: AdnsState -> Ptr (Ptr a) -> IO Query
adns_strerror :: CInt -> IO CString
adns_errabbrev :: CInt -> IO CString
adns_errtypeabbrev :: CInt -> IO CString
wrapAdns :: (Ptr (Ptr b) -> IO CInt) -> (Ptr (Ptr b) -> IO a) -> IO a
mkFlags :: Enum a => [a] -> CInt
Marshaled ADNS Data Types
data OpaqueState Source
type AdnsState = Ptr OpaqueStateSource
data OpaqueQuery Source
type Query = Ptr OpaqueQuerySource
data InitFlag Source
Constructors
NoEnvdo not look at environment
NoErrPrintnever print output to stderr (Debug overrides)
NoServerWarndo not warn to stderr about duff nameservers etc
Debugenable all output to stderr plus Debug msgs
LogPidinclude process id in diagnostic output
NoAutoSysdo not make syscalls at every opportunity
Eintrallow adnsSynch to return eINTR
NoSigPipeapplication has SIGPIPE set to SIG_IGN, do not protect
CheckC_EntExdo consistency checks on entry/exit to adns functions
CheckC_Freqdo consistency checks very frequently (slow!)
show/hide Instances
data QueryFlag Source
Constructors
Searchuse the searchlist
UseVCuse a virtual circuit (TCP connection)
Ownerfill in the owner field in the answer
QuoteOk_Queryallow special chars in query domain
QuoteOk_CNameallow special chars in CNAME we go via (default)
QuoteOk_AnsHostallow special chars in things supposed to be hostnames
QuoteFail_CNamerefuse if quote-req chars in CNAME we go via
CName_Looseallow refs to CNAMEs - without, get _s_cname
CName_Forbiddon't follow CNAMEs, instead give _s_cname
show/hide Instances
data RRType Source
The record types we support.
Constructors
A
MX
NS
PTR
show/hide Instances
newtype Status Source
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.
Constructors
StatusCode Int
show/hide Instances
sOK :: StatusSource
sNOMEMORY :: StatusSource
sUNKNOWNRRTYPE :: StatusSource
sSYSTEMFAIL :: StatusSource
sMAX_LOCALFAIL :: StatusSource
sTIMEOUT :: StatusSource
sALLSERVFAIL :: StatusSource
sNORECURSE :: StatusSource
sINVALIDRESPONSE :: StatusSource
sUNKNOWNFORMAT :: StatusSource
sMAX_REMOTEFAIL :: StatusSource
sRCODESERVFAIL :: StatusSource
sRCODEFORMATERROR :: StatusSource
sRCODENOTIMPLEMENTED :: StatusSource
sRCODEREFUSED :: StatusSource
sRCODEUNKNOWN :: StatusSource
sMAX_TEMPFAIL :: StatusSource
sINCONSISTENT :: StatusSource

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.

sPROHIBITEDCNAME :: StatusSource
sANSWERDOMAININVALID :: StatusSource
sANSWERDOMAINTOOLONG :: StatusSource
sINVALIDDATA :: StatusSource
sMAX_MISCONFIG :: StatusSource
newtype RRAddr Source
Constructors
RRAddr HostAddress
show/hide Instances
sQUERYDOMAINWRONG :: StatusSource
sQUERYDOMAININVALID :: StatusSource
sQUERYDOMAINTOOLONG :: StatusSource
sMAX_MISQUERY :: StatusSource
sNXDOMAIN :: StatusSource
sNODATA :: StatusSource
sMAX_PERMFAIL :: StatusSource
data RRHostAddr Source

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.

Constructors
RRHostAddr HostName Status [RRAddr]
show/hide Instances
data RRIntHostAddr Source

Original definition:

    typedef struct {
      int i;
      adns_rr_hostaddr ha;
    } adns_rr_inthostaddr;
Constructors
RRIntHostAddr Int RRHostAddr
show/hide Instances
data Answer Source
Constructors
Answer
status :: StatusStatus code for this query.
cname :: Maybe StringAlways Nothing for CNAME queries (which are not supported yet anyway).
owner :: Maybe StringOnly set if Owner was requested for query.
expires :: CTimeOnly defined if status is sOK, sNXDOMAIN, or sNODATA.
rrs :: [Response]The list will be empty if an error occured.
show/hide Instances
data Response Source
Constructors
RRA RRAddr
RRMX Int RRHostAddr
RRNS RRHostAddr
RRPTR String
show/hide Instances
peekResp :: RRType -> Ptr b -> Int -> Int -> IO [Response]Source
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.
ADNS Library Functions
adnsInit :: [InitFlag] -> (AdnsState -> IO a) -> IO aSource
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.
adnsInitCfg :: [InitFlag] -> String -> (AdnsState -> IO a) -> IO aSource

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.
adnsSynch :: AdnsState -> String -> RRType -> [QueryFlag] -> IO AnswerSource
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.
adnsSubmit :: AdnsState -> String -> RRType -> [QueryFlag] -> IO QuerySource
Submit an asynchronous query. The returned Query can be tested for completion with adnsCheck.
adnsCheck :: AdnsState -> Query -> IO (Maybe Answer)Source
Check the status of an asynchronous query. If the query is complete, the Answer will be returned. The Query becomes invalid after that.
adnsCancel :: Query -> IO ()Source
Cancel an open Query.
adnsQueries :: AdnsState -> IO [Query]Source
Return the list of all currently open queries.
adnsBeforePoll :: AdnsState -> Ptr Pollfd -> Ptr CInt -> Ptr CInt -> Ptr Timeval -> IO CIntSource

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.

adnsAfterPoll :: AdnsState -> Ptr Pollfd -> CInt -> Ptr Timeval -> IO ()Source
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.
adnsStrerror :: Status -> IO StringSource

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!

adnsErrAbbrev :: Status -> IO StringSource
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!
adnsErrTypeAbbrev :: Status -> IO StringSource
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!
Unmarshaled Low-Level C Functions
adns_init :: Ptr AdnsState -> CInt -> Ptr CFile -> IO CIntSource
adns_init_strcfg :: Ptr AdnsState -> CInt -> Ptr CFile -> CString -> IO CIntSource
adns_finish :: AdnsState -> IO ()Source
adns_submit :: AdnsState -> CString -> CInt -> CInt -> Ptr a -> Ptr Query -> IO CIntSource
adns_check :: AdnsState -> Ptr Query -> Ptr (Ptr Answer) -> Ptr (Ptr a) -> IO CIntSource
adns_synchronous :: AdnsState -> CString -> CInt -> CInt -> Ptr (Ptr Answer) -> IO CIntSource
adns_forallqueries_begin :: AdnsState -> IO ()Source
adns_forallqueries_next :: AdnsState -> Ptr (Ptr a) -> IO QuerySource
adns_strerror :: CInt -> IO CStringSource
adns_errabbrev :: CInt -> IO CStringSource
adns_errtypeabbrev :: CInt -> IO CStringSource
Helper Functions
wrapAdns :: (Ptr (Ptr b) -> IO CInt) -> (Ptr (Ptr b) -> IO a) -> IO aSource
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.
mkFlags :: Enum a => [a] -> CIntSource
Map a list of flags (Enum types) into a CInt suitable for adns calls.
Produced by Haddock version 2.4.2