module Nettle.IPv4.IPPacket (
IPPacket(..)
, IPHeader(..)
, DifferentiatedServicesCodePoint
, FragOffset
, IPProtocol
, IPTypeOfService
, TransportPort
, ipTypeTcp
, ipTypeUdp
, ipTypeIcmp
, IPBody(..)
, getIPPacket
, getIPHeader
, ICMPHeader
, ICMPType
, ICMPCode
, getICMPHeader
, TCPHeader
, TCPPortNumber
, getTCPHeader
, UDPHeader
, UDPPortNumber
, getUDPHeader
, FramedMessage(..)
) where
import Nettle.IPv4.IPAddress
import Data.Bits
import Data.Word
import Data.Binary
import Data.Binary.Get
import qualified Data.ByteString.Lazy as B
data IPPacket = IPPacket IPHeader IPBody
deriving (Show,Eq)
data IPHeader = IPHeader { ipSrcAddress :: IPAddress
, ipDstAddress :: IPAddress
, ipProtocol :: IPProtocol
, headerLength :: Int
, totalLength :: Int
, dscp :: DifferentiatedServicesCodePoint
}
deriving (Read,Show,Eq)
type DifferentiatedServicesCodePoint = Word8
type FragOffset = Word16
type IPProtocol = Word8
type IPTypeOfService = Word8
type TransportPort = Word16
ipTypeTcp, ipTypeUdp, ipTypeIcmp :: IPProtocol
ipTypeTcp = 6
ipTypeUdp = 17
ipTypeIcmp = 1
data IPBody = TCPInIP TCPHeader
| UDPInIP UDPHeader
| ICMPInIP ICMPHeader
| UninterpretedIPBody B.ByteString
deriving (Show,Eq)
class FramedMessage m a b | m -> a, m -> b where
body :: m -> b
sourceAddress :: m -> a
destAddress :: m -> a
instance FramedMessage IPPacket IPAddress IPBody where
body (IPPacket _ b) = b
sourceAddress (IPPacket hdr _) = ipSrcAddress hdr
destAddress (IPPacket hdr _) = ipDstAddress hdr
getIPHeader :: Get IPHeader
getIPHeader = do
b1 <- getWord8
diffServ <- getWord8
totalLen <- getWord16be
ident <- getWord16be
flagsAndFragOffset <- getWord16be
ttl <- getWord8
nwproto <- getIPProtocol
hdrChecksum <- getWord16be
nwsrc <- getIPAddress
nwdst <- getIPAddress
return (IPHeader { ipSrcAddress = nwsrc
, ipDstAddress = nwdst
, ipProtocol = nwproto
, headerLength = fromIntegral (b1 .&. 0x0f)
, totalLength = fromIntegral totalLen
, dscp = shiftR diffServ 2
} )
getIPProtocol :: Get IPProtocol
getIPProtocol = getWord8
getFragOffset :: Get FragOffset
getFragOffset = getWord16be
getIPPacket :: Get IPPacket
getIPPacket = do
hdr <- getIPHeader
body <- getIPBody hdr
return (IPPacket hdr body)
where getIPBody (IPHeader {..})
| ipProtocol == ipTypeTcp = getTCPHeader >>= return . TCPInIP
| ipProtocol == ipTypeUdp = getUDPHeader >>= return . UDPInIP
| ipProtocol == ipTypeIcmp = getICMPHeader >>= return . ICMPInIP
| otherwise = getLazyByteString (fromIntegral (totalLength headerLength)) >>=
return . UninterpretedIPBody
type ICMPHeader = (ICMPType, ICMPCode)
type ICMPType = Word8
type ICMPCode = Word8
getICMPHeader :: Get ICMPHeader
getICMPHeader = do
icmp_type <- getWord8
icmp_code <- getWord8
skip 6
return (icmp_type, icmp_code)
type TCPHeader = (TCPPortNumber, TCPPortNumber)
type TCPPortNumber = Word16
getTCPHeader :: Get TCPHeader
getTCPHeader = do
srcp <- getWord16be
dstp <- getWord16be
return (srcp,dstp)
type UDPHeader = (UDPPortNumber, UDPPortNumber)
type UDPPortNumber = Word16
getUDPHeader :: Get UDPHeader
getUDPHeader = do
srcp <- getWord16be
dstp <- getWord16be
return (srcp,dstp)