diff --git a/Data/Header.hs b/Data/Header.hs --- a/Data/Header.hs +++ b/Data/Header.hs @@ -8,7 +8,7 @@ import qualified Data.ByteString as B -- |A class of network headers that assumes a checksum is present. -class (Num c,Serialize h) => L3Header h a c | h -> a, a -> h, h -> c where +class (Eq c, Num c,Serialize h) => L3Header h a c | h -> a, a -> h, h -> c where -- |Returns the checksum from the header getChecksum :: h -> c diff --git a/Data/IP.hs b/Data/IP.hs --- a/Data/IP.hs +++ b/Data/IP.hs @@ -12,7 +12,6 @@ , IPHeader , dummyIPv4Header , module Data.IPv6 - , ipv4 ) where import Control.Monad (sequence, when, liftM) @@ -28,20 +27,18 @@ import Data.Bits import Text.PrettyPrint import Text.PrettyPrint.HughesPJClass -import qualified Text.ParserCombinators.Parsec as P -import Text.ParserCombinators.Parsec.Prim +import Data.Word type IP = Either IPv4 IPv6 type IPHeader = Either IPv4Header IPv6Header --- |For IPv4 addresses. The internal representation is a bytestring so --- use the pretty print 'ipv4' function as needed (instead of 'show'). -data IPv4 = IPv4 B.ByteString deriving (Eq, Ord, Show, Read, Data, Typeable) +-- |For IPv4 addresses. +data IPv4 = IPv4 Word32 deriving (Eq, Ord, Show, Read, Data, Typeable) instance Serialize IPv4 where - put (IPv4 b) = putByteString b - get = liftM IPv4 (getByteString 4) + put (IPv4 b) = putWord32be b + get = liftM IPv4 getWord32be -- |Don't fragment, more fragment and reserved flags data IPv4Flag = DF | MF | Res deriving (Eq, Ord, Show, Read, Data, Typeable) @@ -76,7 +73,7 @@ -- |A dummy header with zeroed fields except version, header length and TTL (255). dummyIPv4Header = IPv4Hdr 5 4 0 0 0 [] 0 255 0 0 ipv4zero ipv4zero -ipv4zero = IPv4 (B.pack [0,0,0,0]) +ipv4zero = IPv4 0 instance Serialize IPv4Header where put (IPv4Hdr ihl ver tos len id flags off ttl prot csum src dst) = do @@ -130,32 +127,9 @@ computeChecksum h = csum16 (encode (zeroChecksum h)) instance L3Address IPv4 IPv4Header where - localBroadcast (IPv4 a) = IPv4 $ B.concat [B.pack [0xFF], B.drop 1 a] - globalBroadcast = IPv4 $ B.replicate 4 0xFF + localBroadcast (IPv4 a) = IPv4 (0xFFFFFF00 .|. (0x000000FF .&. a)) + globalBroadcast = IPv4 0xFFFFFFFF -- Pretty Printing and parsing instances instance Pretty IPv4 where - pPrint (IPv4 i) = cat . intersperse (char '.') . map (int . fromIntegral) $ (B.unpack i) - --- |Parsec parser for IPv4 strings (ex: "33.44.255.17") -ipv4 :: GenParser Char st IPv4 -ipv4 = do - a <- octet - P.char '.' - b <- octet - P.char '.' - c <- octet - P.char '.' - d <- octet - return $ IPv4 $ B.pack [a, b, c, d] - - "IPv4 Address" - -octet = do - d <- P.many1 P.digit - let n = read d :: Int - when (n > 255) (fail "IPv4 octet invalid") - let s = toEnum n - return s - - "IPv4 digits for an octet" + pPrint (IPv4 i) = text . concat . intersperse "." . map show $ unfoldr (\(i,v) -> if i /= 0 then Just (v .&. 0xFF, (i-1, v `shiftR` 8)) else Nothing) (4,i) diff --git a/Data/IPv6.hs b/Data/IPv6.hs --- a/Data/IPv6.hs +++ b/Data/IPv6.hs @@ -3,7 +3,6 @@ module Data.IPv6 ( IPv6 (..) , IPv6Header - , ipv6 ) where import Control.Monad (sequence, when) @@ -17,7 +16,6 @@ import Numeric (showHex, readHex) import Text.PrettyPrint import Text.PrettyPrint.HughesPJClass -import Text.ParserCombinators.Parsec as P gW8 = getWord8 >>= return . fromIntegral gW16 = getWord16be >>= return . fromIntegral @@ -65,11 +63,11 @@ dst <- get return $ IPv6Hdr ver tc fl len nh hop src dst -data IPv6Ext = E deriving (Eq, Ord, Show, Read, Data, Typeable) +data IPv6Ext = IPv6Ext Int deriving (Eq, Ord, Show, Read, Data, Typeable) instance Serialize IPv6Ext where - get = return E - put _ = return () + get = fmap (IPv6Ext . fromIntegral) getWord8 + put (IPv6Ext x) = putWord8 (fromIntegral x) -- TODO: Header and Address instances @@ -86,26 +84,3 @@ where go (a:b:c:xs) = a : b : f : go (c:xs) go x = x - -ipv6 :: GenParser Char st IPv6 -ipv6 = do - blocks <- sepBy1 (many hexDigit) (P.char ':') - let blocks' = expand blocks - vals = map (fst . head . readHex) blocks' - -- bs = runPut (mapM_ putWord16be vals) - cblks = combine blocks - bs = runPut . mapM_ putWord16be . map (fst . head . readHex) . expand $ cblks - when (1 < length (filter (=="") cblks)) (fail "IPv6 Address with only one :: entry") - when (B.length bs /= 16) (fail "IPv6 Address of proper length") - return (IPv6 bs) - where - expand :: [String] -> [String] - expand as = replace (replicate (8 - length as + 1) "0") as - -replace :: (Eq a) => [[a]] -> [[a]] -> [[a]] -replace _ [] = [] -replace r ([]:xs) = r ++ xs -replace r (x:xs) = x : replace r xs - -combine :: (Eq a) => [[a]] -> [[a]] -combine = concat . map (\x -> if [] `elem` x then [[]] else x) . group diff --git a/network-data.cabal b/network-data.cabal --- a/network-data.cabal +++ b/network-data.cabal @@ -1,11 +1,11 @@ name: network-data -version: 0.2.0 +version: 0.2.1 license: BSD3 license-file: LICENSE author: Thomas DuBuisson maintainer: Thomas DuBuisson synopsis: Library for network data structures (ex: ip/udp/tcp headers and helper functions) -description: This library includes definiations for common headers such as IPv4, IPv6, UDP, TCP, etc. +description: This library includes definitions for common headers such as IPv4, IPv6, UDP, TCP, etc. Data type/functions for full packets, better typeclass setup, and a more agreeable interface with a berkeley sockets like API should be coming soon. Also, test cases - this code is untested as of yet. @@ -23,9 +23,8 @@ Build-Depends: base >= 3 && < 5, bytestring >= 0.9 && < 1.0, cereal >= 0.2 && < 0.4, - prettyclass >= 1.0.0.0 && < 1.1, - pretty >= 1.0.0 && < 1.1.0, - parsec >= 3 && < 4 + prettyclass >= 1.0 && < 1.1, + pretty >= 1.0 && < 1.2 hs-source-dirs: exposed-modules: Data.IP, Data.IPv6, Data.Header, Data.TCP, Data.UDP, Data.CSum ghc-options: