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