module Network.Etherbunny.Tcp (
TCPPkt,
getTCPPacket,
) where
import Data.Word
import Numeric
import Bits
import Data.Binary.Get
import qualified Data.ByteString as B
newtype TCPDOECNCB = TCPDOECNCB Word16
deriving (Eq, Ord, Bits, Num, Integral, Enum, Real, Show)
tcpDataOffset :: TCPDOECNCB -> Word16
tcpDataOffset (TCPDOECNCB v) = v `shiftR` 12
tcpECN :: TCPDOECNCB -> Word16
tcpECN (TCPDOECNCB v) = (v `shiftR` 6) .&. 0x0f
tcpControlBits :: TCPDOECNCB -> Word16
tcpControlBits (TCPDOECNCB v) = v .&. 0x2f
checksum :: Word16 -> B.ByteString -> Word16
checksum c b = fromIntegral $ (cb .&. 0xFFFF) + (cb `shiftR` 16) where
cb = checksum' (fromIntegral c) 0 b
checksum' :: Word32 -> Int -> B.ByteString -> Word32
checksum' d r e = if r >= B.length b
then fromIntegral d
else
if r == (B.length e) 1
then d + (fromIntegral (B.index e r) `shiftL` 8)
else let h = (fromIntegral $ B.index e r) :: Word32
l = (fromIntegral $ B.index e $ r+1) :: Word32
s = (h `shiftL` 8 .|. l) + d
in checksum' s (r+2) b
type TCPPayload = Int
data TCPPkt = TCPPkt {
tcpSourcePort :: !Word16,
tcpDestinationPort :: !Word16,
tcpSequenceNumber :: !Word32,
tcpAcknowledgement :: !Word32,
tcpDOECNCB :: !TCPDOECNCB,
tcpWindow :: !Word16,
tcpChecksum :: !Word16,
tcpChecksumCorrect :: !Bool,
tcpUrgentPointer :: !Word16,
tcpOptions :: ![Word8],
tcpPayload :: !(Maybe TCPPayload)
}
instance Show TCPPkt where
showsPrec p pkt =
showString "\n TCP: Source Port " . showsPrec p (tcpSourcePort pkt)
. showString "\n Destination Port " . showsPrec p (tcpDestinationPort pkt)
. showString "\n Sequence Number: " . showsPrec p (tcpSequenceNumber pkt)
. showString "\n Ack Number: " . showsPrec p (tcpAcknowledgement pkt)
. showString "\n Data Offset: " . showsPrec p (tcpDataOffset $ tcpDOECNCB pkt)
. showString "\n ECN: " . showsPrec p (tcpECN $ tcpDOECNCB pkt)
. showString "\n Control Bits: " . showsPrec p (tcpControlBits $ tcpDOECNCB pkt)
. showString "\n Window: " . showsPrec p (tcpWindow pkt)
. showString "\n Checksum: " . showHex (tcpChecksum pkt)
. showString " correct? " . showsPrec p (tcpChecksumCorrect pkt)
. showString "\n Urgent Pointer: " . showsPrec p (tcpUrgentPointer pkt)
. showString "\n Options: " . showsPrec p (tcpOptions pkt)
. showString "\n Payload: " . showsPrec p (tcpPayload pkt)
getTCPPacket :: Int -> Word32 -> Word32 -> Get TCPPkt
getTCPPacket len srcip dstip = do
r <- remaining
fullBytes <- lookAhead $ getByteString $ fromIntegral r
let headersum = srcip + dstip + (fromIntegral len) + 6
let headersum16 = (headersum .&. 0xFFFF) + (headersum `shiftR` 16)
let headersum16' = fromIntegral $ (headersum16 .&. 0xFFFF) + (headersum16 `shiftR` 16)
let computedChecksum = checksum headersum16' fullBytes
sp <- getWord16be
dp <- getWord16be
seqnum <- getWord32be
ack <- getWord32be
doecncb <- getWord16be
window <- getWord16be
cksum <- getWord16be
urg <- getWord16be
let doffset = fromIntegral $ tcpDataOffset $ TCPDOECNCB doecncb
let optlength = (doffset*4) 20
opt <- getByteString optlength
skip $ len (doffset*4)
return $ TCPPkt
sp
dp
seqnum
ack
(TCPDOECNCB doecncb)
window
cksum
(computedChecksum == 0xffff)
urg
(B.unpack opt)
(Nothing)