packages feed

hsdns 1.0 → 1.1

raw patch · 19 files changed

+2173/−989 lines, 19 filessetup-changednew-uploader

Files

− ADNS.hs
@@ -1,43 +0,0 @@-{- |-   Module      :  ADNS-   Copyright   :  (c) 2007 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
@@ -1,545 +0,0 @@-{-# OPTIONS -fffi #-}-{- |-   Module      :  ADNS.Base-   Copyright   :  (c) 2007 by Peter Simons-   License     :  GPL2--   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 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 = OpaqueState-type AdnsState = Ptr OpaqueState--data OpaqueQuery = 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) = 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)--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 <- #{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 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)---- |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
@@ -1,69 +0,0 @@-{- |-   Module      :  ADNS.Endian-   Copyright   :  (c) 2007 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
@@ -1,178 +0,0 @@-{- |-   Module      :  ADNS.Resolver-   Copyright   :  (c) 2007 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: ***
+ Data/Endian.hs view
@@ -0,0 +1,41 @@+{- |+   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 view
@@ -0,0 +1,340 @@+		    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 view
@@ -0,0 +1,78 @@+{- |+   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 view
@@ -0,0 +1,687 @@+{-# 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 view
@@ -0,0 +1,577 @@+{-# 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 view
@@ -0,0 +1,226 @@+{- |+   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 view
@@ -0,0 +1,48 @@+{- |+   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
@@ -1,57 +0,0 @@-An asynchronous DNS resolver for Haskell_-=========================================--:Latest Release: hsdns-1.0.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 fine. The code has been been tested-  with ADNS versions 1.0 to 1.4.--  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) 2007 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.0.tar.gz: http://cryp.to/hsdns/hsdns-1.0.tar.gz--.. _adns-reverse-lookup.hs: example/adns-reverse-lookup.hs
+ Setup.hs view
@@ -0,0 +1,5 @@+#!/usr/bin/runhaskell++import Distribution.Simple++main = defaultMainWithHooks defaultUserHooks
− Setup.lhs
@@ -1,8 +0,0 @@-#!/usr/bin/env runhaskell--> module Main (main) where->-> import Distribution.Simple->-> main :: IO ()-> main = defaultMain
+ System/Posix/GetTimeOfDay.hsc view
@@ -0,0 +1,54 @@+{-# 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 view
@@ -0,0 +1,91 @@+{-# 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
@@ -1,60 +0,0 @@-{--    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: ***
hsdns.cabal view
@@ -1,25 +1,27 @@-Name:			hsdns-Version:		1.0-Author:			Peter Simons <simons@cryp.to>-Maintainer:		simons@cryp.to-License:		LGPL-Homepage:		http://cryp.to/hsdns/-Synopsis:		Asynchronous DNS Resolver-Description:		An asynchronous DNS resolver based on GNU ADNS.-Category:		Foreign, Network-Build-Depends:		base, network-Extensions:		ForeignFunctionInterface-Extra-Libraries:	adns-Includes:		"adns.h", "errno.h"-Exposed-Modules:	ADNS,-			ADNS.Base,-			ADNS.Endian,-			ADNS.Resolver-GHC-Options:		-O -Wall-Data-Files:		README, prologue.txt+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. -Executable:		adns-reverse-lookup-Hs-Source-Dirs:		example, .-Main-Is:		adns-reverse-lookup.hs-Extra-Libraries:	adns-GHC-Options:		-O -Wall -threaded+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++Extensions:      ForeignFunctionInterface, PatternSignatures, EmptyDataDecls+Build-Type:      Simple+Tested-With:     GHC==6.8.2+ghc-options:     -Wall -O2
− prologue.txt
@@ -1,5 +0,0 @@-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. Not all options are-supported, but A, MX, and PTR lookups work fine. The code has-been been tested with ADNS versions 1.0 to 1.4.