diff --git a/ADNS/Base.hsc b/ADNS/Base.hsc --- a/ADNS/Base.hsc +++ b/ADNS/Base.hsc @@ -21,10 +21,9 @@ import Control.Exception ( assert, bracket ) import Network ( HostName ) -import Network.Socket ( HostAddress ) +import Network.Socket ( HostAddress, hostAddressToTuple ) import Foreign import Foreign.C -import ADNS.Endian #include #include @@ -138,8 +137,8 @@ toEnum #{const adns_r_ptr} = PTR toEnum #{const adns_r_srv} = SRV toEnum x = case x .&. #{const adns_rrt_typemask} of - 47 -> NSEC - i -> RRType i + 47 -> NSEC + i -> RRType i fromEnum A = #{const adns_r_a} fromEnum CNAME = #{const adns_r_cname} @@ -148,9 +147,9 @@ fromEnum PTR = #{const adns_r_ptr} fromEnum SRV = #{const adns_r_srv} fromEnum x = #{const adns_r_unknown} .|. case x of - NSEC -> 47 - (RRType i) -> i - _ -> error "Missing case in fromEnum ADNS.Base.RRType" + NSEC -> 47 + (RRType i) -> i + _ -> error "Missing case in fromEnum ADNS.Base.RRType" instance Storable RRType where sizeOf _ = #{size adns_rrtype} @@ -226,7 +225,7 @@ shows b3 . ('.':) . shows b4 $ "" where - (b1,b2,b3,b4) = readWord32 ha + (b1,b2,b3,b4) = hostAddressToTuple ha instance Storable RRAddr where sizeOf _ = #{size adns_rr_addr} @@ -405,7 +404,7 @@ parseByType CNAME = peek (castPtr ptr) >>= peekCString >>= return . RRCNAME parseByType NSEC = do RRByteblock len rptr <- peek (castPtr ptr) (name, _) <- peekFQDNAndAdvance rptr len - return $ RRNSEC name + return $ RRNSEC name parseByType (RRType _) = do RRByteblock len rptr <- peek (castPtr ptr) str <- peekCStringLen (rptr, len) return $ RRUNKNOWN str @@ -421,8 +420,8 @@ 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) + (zone, ptr2) <- peekFQDNAndAdvance (ptr1 `plusPtr` c) 0 + return (name ++ "." ++ zone, ptr2) | otherwise -> error "Compressed FQDN must not occur here." @@ -632,10 +631,3 @@ 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 deleted file mode 100644 --- a/ADNS/Endian.hs +++ /dev/null @@ -1,70 +0,0 @@ -{- | - 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 -import System.IO.Unsafe - --- |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 = - System.IO.Unsafe.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 --- a/ADNS/Resolver.hs +++ b/ADNS/Resolver.hs @@ -29,9 +29,8 @@ import Data.Map ( Map ) import qualified Data.Map as Map import Network -import Network.Socket ( HostAddress ) +import Network.Socket ( HostAddress, hostAddressToTuple ) 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 @@ -141,7 +140,7 @@ shows b2 . ('.':) . shows b1 $ ".in-addr.arpa." where - (b1,b2,b3,b4) = readWord32 ha + (b1,b2,b3,b4) = hostAddressToTuple ha -- * Implementation diff --git a/example/adns-srv-test.hs b/example/adns-srv-test.hs --- a/example/adns-srv-test.hs +++ b/example/adns-srv-test.hs @@ -18,8 +18,8 @@ initResolver [Debug] $ \resolver -> do a <- querySRV resolver (head names) case a of - Just addr -> putStrLn $ "RESULT:\n" ++ concatMap (\b -> fst b ++ ":" ++ showPortID (snd b)) addr - _ -> fail $ "Error in SRV " ++ show (head names) + Just addr -> putStrLn $ "RESULT:\n" ++ concatMap (\b -> fst b ++ ":" ++ showPortID (snd b)) addr + _ -> fail $ "Error in SRV " ++ show (head names) showPortID :: PortID -> String showPortID (PortNumber p) = show p diff --git a/example/adns-test-and-traverse.hs b/example/adns-test-and-traverse.hs --- a/example/adns-test-and-traverse.hs +++ b/example/adns-test-and-traverse.hs @@ -9,7 +9,7 @@ main = initResolver [NoErrPrint, NoServerWarn] $ \resolver -> do args <- getArgs case args of - [name] -> traverse resolver name + [name] -> traverseDNSSEC resolver name [t,name] -> work resolver (read t) name _ -> putStrLn "Usage: t [typeid] fqdn" @@ -33,12 +33,13 @@ -- 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 + +traverseDNSSEC :: Resolver -> String -> IO () +traverseDNSSEC 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 + [RRNSEC y] | not (x `endsWith` ('.':y)) -> traverseDNSSEC resolver y _ -> return () endsWith :: String -> String -> Bool diff --git a/hsdns.cabal b/hsdns.cabal --- a/hsdns.cabal +++ b/hsdns.cabal @@ -1,5 +1,5 @@ Name: hsdns -Version: 1.6.1 +Version: 1.7 Copyright: Peter Simons License: LGPL-3 License-File: COPYING.LESSER @@ -30,25 +30,54 @@ > OK: localhost <-> 127.0.0.1 > FAIL: cryp.to -> 217.19.183.102 -> ["zuse.cryp.to"] > OK: www.example.com <-> 192.0.32.10 -Cabal-Version: >= 1.6 +Cabal-Version: >= 1.8 Build-Type: Simple -Tested-With: GHC >= 6.10.4 && <= 7.6.3 - -Extra-Source-Files: example/adns-reverse-lookup.hs - example/adns-srv-test.hs - example/adns-test-and-traverse.hs +Tested-With: GHC > 7 && < 8.1 Source-Repository head Type: git Location: git://github.com/peti/hsdns.git +Flag install-examples + Description: Build and install example programs. + Default: False + Library - Build-Depends: base >= 3 && < 5, network, containers + Build-Depends: base >= 3 && < 5, network >= 2.6.3.0, containers Extensions: ForeignFunctionInterface, EmptyDataDecls Extra-Libraries: adns Includes: "adns.h" "errno.h" Exposed-Modules: ADNS, ADNS.Base, - ADNS.Endian, ADNS.Resolver Ghc-Options: -Wall + +executable adns-reverse-lookup + main-is: adns-reverse-lookup.hs + hs-source-dirs: example + ghc-options: -Wall -threaded + build-depends: base, network, hsdns + if flag(install-examples) + buildable: True + else + buildable: False + +executable adns-srv-test + main-is: adns-srv-test.hs + hs-source-dirs: example + ghc-options: -Wall -threaded + build-depends: base, network, hsdns + if flag(install-examples) + buildable: True + else + buildable: False + +executable adns-test-and-traverse + main-is: adns-test-and-traverse.hs + hs-source-dirs: example + ghc-options: -Wall -threaded + build-depends: base, hsdns + if flag(install-examples) + buildable: True + else + buildable: False