From f9744f1e92e1b29490a6890e82679e91de06a472 Mon Sep 17 00:00:00 2001 From: Denis Tereshkin Date: Thu, 19 Oct 2023 21:23:44 +0700 Subject: [PATCH] Icmp echo serialize --- src/Packets/L2.hs | 11 ++++-- src/Packets/L3.hs | 80 +++++++++++++++++++++++++++++++++++++++++ test/Test.hs | 5 ++- test/Test/Packets/L3.hs | 45 +++++++++++++++++++++++ theta.cabal | 7 ++-- 5 files changed, 143 insertions(+), 5 deletions(-) create mode 100644 src/Packets/L3.hs create mode 100644 test/Test/Packets/L3.hs diff --git a/src/Packets/L2.hs b/src/Packets/L2.hs index d77415d..6d3dd9f 100644 --- a/src/Packets/L2.hs +++ b/src/Packets/L2.hs @@ -3,8 +3,15 @@ module Packets.L2 ( ) where -import Packets.Packet (Serializable (..)) +import Packets.MacAddress (MacAddress (..)) +data L2Header = + L2Header + { + sourceMac :: MacAddress + , destMac :: MacAddress + , payload :: L2Payload + } -data L2Header +data L2Payload -- = Dot1Q Tpid Dot1QTag EtherType L2Payload | L2EtherType EtherType L3Payload diff --git a/src/Packets/L3.hs b/src/Packets/L3.hs new file mode 100644 index 0000000..564e813 --- /dev/null +++ b/src/Packets/L3.hs @@ -0,0 +1,80 @@ + +module Packets.L3 + ( + L3Payload(..) + , ipChecksum + , IcmpCode(..) + , IcmpType(..) + , IcmpId(..) + , IcmpSqnum(..) + , IcmpPacket(..) + ) where + +import Data.Binary (Binary (..), Put (..), putWord8) +import Data.Binary.Put (putByteString, putWord16be, runPut) +import Data.Bits (shiftR, (.&.)) +import qualified Data.ByteString as B +import Data.Word (Word16 (..), Word8 (..)) + +data L3Payload = IcmpPayload IcmpPacket + deriving (Show, Eq) + +data IcmpType = + IcmpTypeEchoRequest + | IcmpTypeEchoResponse + | IcmpTypeOther Word8 + deriving (Show, Eq) + +newtype IcmpCode = IcmpCode { unIcmpCode :: Int } + deriving (Show, Eq) + +newtype IcmpId = IcmpId { unIcmpId :: Word16 } + deriving (Show, Eq) + +newtype IcmpSqnum = IcmpSqnum { unIcmpSqnum :: Word16 } + deriving (Show, Eq) + +data IcmpPacket = + IcmpEchoRequest IcmpId IcmpSqnum B.ByteString + | IcmpEchoResponse IcmpId IcmpSqnum B.ByteString + | IcmpUnknown IcmpType IcmpCode B.ByteString + deriving (Show, Eq) + +ipChecksum :: B.ByteString -> Word16 +ipChecksum bs = 0xffff - (fromIntegral . adjustedSum . sum . words) bs + where + adjustedSum x = if x > 0xffff + then adjustedSum $ x .&. 0xffff + x `shiftR` 16 + else x + + words :: B.ByteString -> [Int] + words bs = + let (h, t) = B.splitAt 2 bs in + case (B.unpack . B.take 2) h of + [x1, x2] -> (fromIntegral x1 * 0x100 + fromIntegral x2) : words t + [x1] -> (fromIntegral x1 * 0x100) : words t + [] -> [] + +instance Binary IcmpType where + put IcmpTypeEchoRequest = putWord8 8 + put IcmpTypeEchoResponse = putWord8 0 + get = error "" + +fillIcmpChecksum :: B.ByteString -> B.ByteString +fillIcmpChecksum src = B.take 2 src <> rawChecksum <> B.drop 4 src + where + checksum = ipChecksum src + rawChecksum = B.pack (fromIntegral <$> [ checksum `shiftR` 8, checksum .&. 0xff ]) + +instance Binary IcmpPacket where + put (IcmpEchoRequest icmpId icmpSqnum payload) = putByteString $ fillIcmpChecksum . B.toStrict . runPut $ do + put IcmpTypeEchoRequest + putWord8 0 -- ICMP Code + putWord16be 0 -- Fill later + putWord16be . unIcmpId $ icmpId + putWord16be . unIcmpSqnum $ icmpSqnum + putByteString payload + + put _ = undefined + get = undefined + diff --git a/test/Test.hs b/test/Test.hs index ac4e498..8293396 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -4,11 +4,14 @@ module Main main ) where +import qualified Test.Packets.L3 import qualified Test.Packets.MacAddress import Test.Tasty main = defaultMain tests tests :: TestTree -tests = testGroup "Tests" [ Test.Packets.MacAddress.tests ] +tests = testGroup "Tests" [ + Test.Packets.MacAddress.tests + , Test.Packets.L3.tests ] diff --git a/test/Test/Packets/L3.hs b/test/Test/Packets/L3.hs new file mode 100644 index 0000000..a649da7 --- /dev/null +++ b/test/Test/Packets/L3.hs @@ -0,0 +1,45 @@ + +module Test.Packets.L3 + ( + tests + ) where + +import Data.Binary (encode) +import qualified Data.ByteString as B +import Data.Word (Word8 (..)) +import Hedgehog (MonadGen (..), forAll, property, (===)) +import Hedgehog.Gen +import qualified Hedgehog.Range as Range +import Packets.L3 +import Test.Tasty +import Test.Tasty.Hedgehog +import Test.Tasty.HUnit + +tests :: TestTree +tests = testGroup "L3" [ unitTests] + +unitTests :: TestTree +unitTests = testGroup "Unit tests" [ testIpChecksum + , testSerializeEchoRequest ] + +testIpChecksum :: TestTree +testIpChecksum = testCase "ipChecksum case 1" $ do + let testIcmp = B.pack [ + 0x08, 0x00, 0x00, 0x00, 0xfc, 0x6b, 0x59, 0xfb, + 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68] + let checksum = ipChecksum testIcmp + checksum @?= 0x1003 + +testSerializeEchoRequest :: TestTree +testSerializeEchoRequest = testCase "serialize IcmpEchoRequest" $ do + let payload = B.pack [ + 0x1c, 0x25, 0x31, 0x65, 0x00, 0x00, 0x00, 0x00, + 0x72, 0x51, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, + 0x18, 0x19, 0x1a, 0x1b, 0x1c, 0x1d, 0x1e, 0x1f, 0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27, + 0x28, 0x29, 0x2a, 0x2b, 0x2c, 0x2d, 0x2e, 0x2f, 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37 + ] + let testIcmp = B.pack [ 0x08, 0x00, 0xd8, 0x7c, 0x9d, 0xd2, 0x00, 0x02] <> payload + let icmp = IcmpEchoRequest (IcmpId 40402) (IcmpSqnum 2) payload + (B.toStrict . encode) icmp @=? testIcmp + + diff --git a/theta.cabal b/theta.cabal index 42c7d5e..c7b7833 100644 --- a/theta.cabal +++ b/theta.cabal @@ -16,12 +16,13 @@ extra-source-files: README.md library theta-lib hs-source-dirs: src - modules: Packets.Serializable - , Packets.L2 + exposed-modules: Packets.L2 + , Packets.L3 , Packets.MacAddress default-language: Haskell2010 build-depends: base >= 4.7 && < 5 , bytestring + , binary ghc-options: -Wall -Wcompat -Widentities @@ -37,6 +38,7 @@ Test-Suite test-theta hs-source-dirs: src test main-is: Test.hs other-modules: Test.Packets.MacAddress + , Test.Packets.L3 build-depends: base , theta-lib , tasty @@ -44,3 +46,4 @@ Test-Suite test-theta , tasty-hedgehog , hedgehog , bytestring + , binary