packages feed

network-data (empty) → 0.0.1

raw patch · 9 files changed

+515/−0 lines, 9 filesdep +basedep +binarydep +bytestringsetup-changed

Dependencies added: base, binary, bytestring, parsec, pretty, prettyclass

Files

+ Data/CSum.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving #-}+module Data.CSum+	( csum16+	, CSum+	, zeroCSum+	) where++import qualified Data.ByteString.Lazy as B+import Data.List (foldl')+import Control.Monad (sequence)+import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import Data.Bits++newtype CSum = CSum Word16 deriving (Eq, Ord, Show, Bounded, Num)++csum16 :: B.ByteString -> CSum+csum16 b = CSum $ foldl' ( (+) . complement) 0 words+  where+  words :: [Word16]+  words = runGet (sequence $ replicate (fromIntegral $ B.length b `div` 4) getWord16be) b+{-# INLINE csum16 #-}++instance Binary CSum where+	put (CSum w) = putWord16be w+	get = getWord16be >>= return . CSum++zeroCSum = CSum 0
+ Data/Header.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}+module Data.Header+	( L3Header (..)+	, L3Address (..)+	) where++import Data.Binary (encode, Binary)+import qualified Data.ByteString.Lazy as B+import Data.CSum as C++-- |A class of network headers that assumes a checksum is present.+class (Binary h) => L3Header h a c | h -> a, a -> h, h -> c where+	-- |Returns the checksum from the header+	getChecksum :: h -> c++	-- |Sets the checksum in the header+	setChecksum :: h -> c -> h++	-- |Returns a 'source' for the header.+	src :: h -> a++	-- |Returns a 'destination' for the header.+	dst :: h -> a++	-- |Returns a header with all the same fields except the checksum is zeroed+	zeroChecksum :: h -> h+	zeroChecksum h = setChecksum h 0++	-- |Computes the checksum+	computeChecksum :: h -> c+	computeChecksum h = C.csum16 (encode (zeroChecksum h))++	-- |Computes the checksum, returns a header with the proper checksum+	fillChecksum :: h -> h+	fillChecksum h = setChecksum h (computeChecksum h)++	-- |Used by various layer 4 protocols (UDP, TCP),+	-- a pseudo header is needed to compute the checksum+	pseudoHeader :: h -> B.ByteString++	-- |Returns True iff the checksum is valid+	valid :: h -> Bool+	valid h = zeroCSum == getChecksum h || computeChecksum h == getChecksum h++-- |A class of network addresses that assumes there is a 'broadcast' concept.+class (Binary a) => L3Address a h | a -> h, h -> a where+	localBroadcast :: a -> a+	globalBroadcast :: a++class (Binary a) => L4Header h p where+	fixChecksum :: L3Header => h -> l3 -> h+	srcPort	:: h -> p+	dstPort :: h -> p
+ Data/IP.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE DisambiguateRecordFields, FlexibleInstances, MultiParamTypeClasses #-}+{- |The Data.IP library exports IPv4 and IPv6 address and header structures.++   Patches to add more parsing and pretty printing are welcome.++   FIXME:+   There is currently no support for options fields of the IP header.+ -}+module Data.IP+	( IPv4 (..)+	, IPv4Header (..)+	, IPv4Flag (..)+	, dummyIPv4Header+	, module Data.IPv6+	, ipv4+	) where++import Control.Monad (sequence)+import qualified Data.ByteString.Lazy as B+import Data.Binary+import Data.Binary.Put+import Data.Binary.Get+import Data.CSum+import Data.List+import Data.IPv6+import Data.Header+import Data.Bits+import Text.PrettyPrint+import Text.PrettyPrint.HughesPJClass+import qualified Text.ParserCombinators.Parsec as P+import Text.ParserCombinators.Parsec.Prim++-- |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)++instance Binary IPv4 where+	put (IPv4 b) = putLazyByteString b+	get = getLazyByteString 4 >>= return . IPv4++-- |Don't fragment, more fragment and reserved flags+data IPv4Flag = DF | MF | Res deriving (Eq, Ord, Show, Read)++instance Enum [IPv4Flag] where+	fromEnum xs = foldl' (.|.) 0 $ map fromEnum1 xs+	toEnum f = map snd $ filter fst [(testBit f 0, Res), (testBit f 1, MF), (testBit f 2, DF)]++fromEnum1 DF   = 4+fromEnum1 MF   = 2+fromEnum1 Res  = 1++-- |This IPv4 header structure lacks support for options.  Ints are used+-- for most integral data types and the binary instance hands the bit packing.+--+-- No warning is provided if a field is overflowed!+data IPv4Header =+	IPv4Hdr { hdrLength		:: Int+		, version		:: Int+		, tos			:: Int+		, payloadLength		:: Int+		, ipID			:: Int+		, flags			:: [IPv4Flag]+		, fragmentOffset	:: Int+		, ttl			:: Int+		, protocol		:: Int+		, checksum		:: CSum+		, source		:: IPv4+		, destination		:: IPv4+	} deriving (Eq, Ord, Show)++-- |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])++instance Binary IPv4Header where+  put (IPv4Hdr ihl ver tos len id flags off ttl prot csum src dst) = do+	pW8 $ (ihl .&. 0xF) .|. (ver `shiftL` 4 .&. 0xF0)+	pW8 tos+	pW16 len+	pW16 id+	let offFlags = (off .&. 0x1FFF) .|. fromIntegral (fromEnum flags `shiftL` 13)+	pW16 offFlags+	pW8 ttl+	pW8 prot+	put csum+	put src+	put dst++  get = do+	ihlVer <- gW8+	let ihl = (ihlVer .&. 0xF)+	    ver = (ihlVer `shiftR` 4) .&. 0xF+	tos <- gW8+	len <- gW16+	id  <- gW16+	offFlags <- gW16+	let off = offFlags .&. 0x1FFF+	    flags = toEnum $ offFlags `shiftR` 13+	ttl <- gW8+	prot <- gW8+	csum <- get+	src <- get+	dst <- get+	return $ IPv4Hdr ihl ver tos len id flags off ttl prot csum src dst++gW8 = getWord8 >>= return . fromIntegral+gW16 = getWord16be >>= return . fromIntegral+pW8 = putWord8 . fromIntegral+pW16 = putWord16be . fromIntegral+pW32 = putWord32be . fromIntegral++-- L3Header and L3Address instances (see Data.Header)+instance L3Header IPv4Header IPv4 CSum where+	getChecksum = checksum+	setChecksum h c = h { checksum = c }+	src = source+	dst = destination+	pseudoHeader h = runPut (do+		put (src h)+		put (dst h)+		putWord8 0+		pw8 (protocol h)+		pw16 (payloadLength 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++-- Pretty Printing and parsing instances+instance Pretty IPv4 where+	pPrint (IPv4 i) = cat . intersperse (char '.') . map (int . fromIntegral) $ (B.unpack i)++ipv4 = do+	a <- octet+	P.char '.'+	b <- octet+	P.char '.'+	c <- octet+	P.char '.'+	d <- octet+	return $ IPv4 $ B.pack [a, b, c, d]+	<?>+	"Expected IPv4 Address"++octet = do+	d <- P.many1 P.digit+	let s = toEnum $ read d+	return s
+ Data/IPv6.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE DisambiguateRecordFields #-}++module Data.IPv6+	( IPv6 (..)+	) where++import Control.Monad (sequence)+import qualified Data.ByteString.Lazy as B+import Data.Binary+import Data.Binary.Put+import Data.Binary.Get+import Data.Bits+import Numeric (showHex)+import Text.PrettyPrint+import Text.PrettyPrint.HughesPJClass+import Text.ParserCombinators.Parsec as P+import Data.Maybe (maybeToList)++gW8 = getWord8 >>= return . fromIntegral+gW16 = getWord16be >>= return . fromIntegral+gW32 = getWord32be >>= return . fromIntegral+pW8 = putWord8 . fromIntegral+pW16 = putWord16be . fromIntegral+pW32 = putWord32be . fromIntegral++data IPv6 = IPv6 B.ByteString deriving (Eq, Ord, Show, Read)++instance Binary IPv6 where+	put (IPv6 b) = putLazyByteString b+	get = getLazyByteString 16 >>= return . IPv6++data IPv6Header =+	IPv6Hdr { version		:: Int+		, trafficClass		:: Int+		, flowLabel		:: Int+		, payloadLength		:: Int+		, nextHeader		:: IPv6Ext+		, hopLimit		:: Int+		, source		:: IPv6+		, destination		:: IPv6+	} deriving (Eq, Ord, Show)++instance Binary IPv6Header where+  put (IPv6Hdr ver tc fl len nh hop src dst) = do+	let verTCFlow = (ver .&. 0xF `shiftL` 28) .|. (tc .&. 0xFF `shiftL` 20) .|. (fl .&. 0xFFFFF)+	pW32 verTCFlow+	pW16 len+	put nh+	pW8 hop+	put src+	put dst++  get = do+	verTCFlow <- gW32+	let ver = (verTCFlow `shiftR` 28) .&. 0xF+	    tc  = (verTCFlow `shiftR` 20) .&. 0xFF+	    fl  = verTCFlow .&. 0xFFFFF+	len <- gW16+	nh  <- get+	hop <- gW8+	src <- get+	dst <- get+	return $ IPv6Hdr ver tc fl len nh hop src dst++data IPv6Ext = E deriving (Eq, Ord, Show)++instance Binary IPv6Ext where+	get = return E+	put _ = return ()++-- TODO: Header and Address instanes++instance Pretty IPv6 where+	pPrint (IPv6 i) = cat . alternate colon . map (pHex 2) $ (B.unpack i)++-- Until 'hex' is part of the pretty printer+pHex nr n = text $ pad nr $ showHex n ""+  where+  pad n s = let l = length s in if l < n then replicate (n - l) '0' ++ s else drop (l - n) s++alternate :: a -> [a] -> [a]+alternate f xs = go xs+  where+  go (a:b:c:xs) = a : b : f : go (c:xs)+  go x = x++second :: GenParser Char st [String]+second = do+		P.char ':'+		x <- many1 hexDigit+		xs <- second+		return (x : xs)+	 <|>+		return []++first :: GenParser Char st [String]+first = do+	x <- many1 hexDigit+	(do	P.char ':'+		xs <- first+		return (x:xs)+	 <|> return [x])+	<|> return []++ipv6 :: GenParser Char st IPv6+ipv6 = do error "blah"+  where+  replace :: (Eq a) => a -> [a] -> [a] -> [a]+  replace _ _ [] = []+  replace n r (x:xs) = if n == x then r ++ xs else x : replace n r xs
+ Data/TCP.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances #-}+module Data.TCP+	( TCPPort+	, TCPHeader (..)+	) where++import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import Data.CSum+import Data.Bits+import Data.List++newtype TCPPort = TCPPort Word16 deriving (Eq, Ord, Show, Read, Num, Bounded)++instance Binary TCPPort where+	put (TCPPort p) = putWord16be p+	get = getWord16be >>= return . TCPPort++newtype SeqNumber = SN Word32 deriving (Eq, Ord, Show, Read, Num, Bounded)+newtype AckNumber = AN Word32 deriving (Eq, Ord, Show, Read, Num, Bounded)++instance Binary SeqNumber where+	put (SN n) = putWord32be n+	get = getWord32be >>= return . SN++instance Binary AckNumber where+	put (AN n) = putWord32be n+	get = getWord32be >>= return . AN++data TCPFlag = FIN | SYN | RST | PSH | ACK | URG | ECE | CWR deriving (Eq, Ord, Show, Enum)++instance Enum [TCPFlag] where+	fromEnum fs = foldl' (+) 0 $ map (bit . fromEnum) fs+	toEnum i = map (toEnum . snd) . filter fst . flip zip [0..7] . map (testBit i) $ [0..7]++data TCPHeader =+	TCPHdr  { srcPort	:: TCPPort+		, dstPort	:: TCPPort+		, seqNumber	:: SeqNumber+		, ackNumber	:: AckNumber+		, dataOffset	:: Int+		, res		:: Int+		, flags		:: [TCPFlag]+		, windowSize	:: Int+		, checksum	:: CSum+		, urgentPtr	:: Int+	} deriving (Eq, Ord, Show)++instance Binary TCPHeader where+	put (TCPHdr s d seq ack dat res fs w c u) = do+		put s+		put d+		put seq+		put ack+		let datRes = ((dat .&. 0xF) `shiftL` 4) .|. (res .&. 0xF)+		put datRes+		put (fromEnum fs)+		putWord16be (fromIntegral w .&. 0xFFFF)+		put c+		putWord16be (fromIntegral u .&. 0xFFFF)+	get = do+		s <- get+		d <- get+		seq <- get+		ack <- get+		datRes <- get+		let dat = (datRes `shiftR` 4) .&. 0xF+		    res = datRes .&. 0xF+		fs <- get >>= return . toEnum+		w <- getWord16be >>= return . fromIntegral+		c <- get+		u <- getWord16be >>= return . fromIntegral+		return $ TCPHdr s d seq ack dat res fs w c u++-- FIXME need parser for TCPPort, L4Header instance
+ Data/UDP.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}+module Data.UDP+	( UDPPort+	, UDPHeader (..)+	) where++import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import Data.CSum+import Data.Header++newtype UDPPort = UDPPort Word16 deriving (Eq, Ord, Show, Read, Num, Bounded)++instance Binary UDPPort where+	put (UDPPort p) = putWord16be p+	get = getWord16be >>= return . UDPPort++data UDPHeader =+	UDPHdr  { srcPort	:: UDPPort+		, dstPort	:: UDPPort+		, payloadLength :: Int+		, checksum	:: CSum+	} deriving (Eq, Ord, Show)++instance Binary UDPHeader where+	put (UDPHdr s d l c) = do+		put s+		put d+		putWord16be $ fromIntegral l+		put c+	get = do+		s <- get+		d <- get+		l <- getWord16be >>= return . fromIntegral+		c <- get+		return $ UDPHdr s d l c
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) Thomas DuBuisson++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ network-data.cabal view
@@ -0,0 +1,29 @@+name:		network-data+version:	0.0.1+license:	BSD3+license-file:	LICENSE+author:		Thomas DuBuisson <thomas.dubuisson@gmail.com>+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.+		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.+category:	Data, Networking+stability:	stable+build-type:	Simple+cabal-version:	>= 1.2+tested-with:	GHC == 6.10.1+extra-source-files:++Flag small_base+  Description: Choose the split-up base package.++Library+  if flag(small_base)+    Build-Depends: base >= 3, bytestring >= 0.9 && < 1.0, binary >= 0.4.0 && < 0.5.0, prettyclass, pretty, parsec+  else+    Build-Depends: base >= 3, bytestring >= 0.9 && < 1.0, binary >= 0.4.0 && <0.5.0, prettyclass, pretty, parsec+  hs-source-dirs:+  exposed-modules: Data.IP, Data.IPv6, Data.Header, Data.TCP, Data.UDP, Data.CSum+  ghc-options: