module Network.Etherbunny.Ip (
IPPkt,
IPVerIHL,
getIPPacket,
) where
import Network.Etherbunny.Tcp
import Data.Word
import Numeric
import Bits
import Network.Socket (HostAddress)
import Data.Binary.Get
import qualified Data.ByteString as B
newtype IPVerIHL = IPVerIHL Word8
deriving (Eq, Ord, Bits, Num, Integral, Enum, Real, Show)
ipVersion :: IPVerIHL -> Word8
ipVersion (IPVerIHL v) = v `shiftR` 4
ipHeaderLength :: IPVerIHL -> Word8
ipHeaderLength (IPVerIHL v) = v .&. 0x0f
newtype IPFlagsFragment = IPFlagsFragment Word16
deriving (Eq, Ord, Bits, Num, Integral, Enum, Real, Show)
newtype IPProtocol = IPProtocol Word8
deriving (Eq, Ord, Bits, Num, Integral, Enum, Real, Show)
newtype IPTOS = IPTOS Word8
deriving (Eq, Ord, Bits, Num, Integral, Enum, Real, Show)
data IPPkt = IPPkt {
ipVerIHL :: !IPVerIHL,
ipTOS :: !IPTOS,
ipTotalLength :: !Word16,
ipIdentification :: !Word16,
ipFlagsFragment :: !IPFlagsFragment,
ipTTL :: !Word8,
ipProtocol :: !IPProtocol,
ipHeaderChecksum :: !Word16,
ipSource :: !HostAddress,
ipDestination :: !HostAddress,
ipOptions :: ![Word8],
ipPayload :: !(Maybe TCPPkt)
}
showsIP :: (Bits a) => a -> String -> String
showsIP m =
foldr (\i a -> shows (getWord m i) . showString "." . a) (shows (getWord m 0) ) $ [3,2,1]
where
getWord x i = (x `shiftR` (i*8)) .&. 0xff
instance Show IPPkt where
showsPrec p pkt =
showString "\n IP: Ip Version " . showsPrec p (ipVersion $ ipVerIHL pkt)
. showString "\n Header length " . showsPrec p (ipHeaderLength $ ipVerIHL pkt)
. showString "\n TOS: " . showsPrec p (ipTOS pkt)
. showString "\n totalLength: " . showsPrec p (ipTotalLength pkt)
. showString "\n Frag Ident: " . showsPrec p (ipIdentification pkt)
. showString "\n flags/fragment offset: " . showsPrec p (ipFlagsFragment pkt)
. showString "\n TTL: " . showsPrec p (ipTTL pkt)
. showString "\n Protocol: " . showsPrec p (ipProtocol pkt)
. showString "\n Header Checksum: " . showHex (ipHeaderChecksum pkt)
. showString "\n Source: " . showsIP (ipSource pkt)
. showString "\n Destination: " . showsIP (ipDestination pkt)
. showString "\n Options: " . showsPrec p (ipOptions pkt)
. showString "\n Payload: " . showsPrec p (ipPayload pkt)
. showString "\n"
getIPPacket :: Get IPPkt
getIPPacket = do
verihl <- getWord8
iptos <- getWord8
tlength <- getWord16be
ident <- getWord16be
flgfrag <- getWord16be
ttl <- getWord8
ipprot <- getWord8
hdrcksm <- getWord16be
srcip <- getWord32be
dstip <- getWord32be
let hl = ipHeaderLength $ IPVerIHL verihl
options <- getByteString $ fromIntegral $ hl 5
payload <- case ipprot of
6 -> do
let tcplen = fromIntegral $ tlength (fromIntegral (hl*4))
tcp <- getTCPPacket tcplen srcip dstip
return $ Just tcp
_ -> do
skip $ (fromIntegral $ tlength (fromIntegral hl)*4)
return Nothing
return $ IPPkt
(IPVerIHL verihl)
(IPTOS iptos)
tlength
ident
(IPFlagsFragment flgfrag)
ttl
(IPProtocol ipprot)
hdrcksm
srcip
dstip
(B.unpack options)
payload