module Net.ICMP where
import Net.Bits
import Net.Utils
import Net.Packet
import Net.PacketParsing
data Packet = EchoRequest EchoMsg
| EchoReply EchoMsg
| Other { Packet -> MessageType
type_ :: !MessageType,
Packet -> Word8
code :: !Word8,
Packet -> Word16
chksum :: !Word16,
Packet -> UArray Int Word8
content :: UArray Int Word8
}
deriving Int -> Packet -> ShowS
[Packet] -> ShowS
Packet -> String
(Int -> Packet -> ShowS)
-> (Packet -> String) -> ([Packet] -> ShowS) -> Show Packet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Packet -> ShowS
showsPrec :: Int -> Packet -> ShowS
$cshow :: Packet -> String
show :: Packet -> String
$cshowList :: [Packet] -> ShowS
showList :: [Packet] -> ShowS
Show
data EchoMsg = Echo { EchoMsg -> Word16
ident :: !Word16
, EchoMsg -> Word16
seqNum :: !Word16
, EchoMsg -> UArray Int Word8
echoData :: UArray Int Word8
} deriving Int -> EchoMsg -> ShowS
[EchoMsg] -> ShowS
EchoMsg -> String
(Int -> EchoMsg -> ShowS)
-> (EchoMsg -> String) -> ([EchoMsg] -> ShowS) -> Show EchoMsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EchoMsg -> ShowS
showsPrec :: Int -> EchoMsg -> ShowS
$cshow :: EchoMsg -> String
show :: EchoMsg -> String
$cshowList :: [EchoMsg] -> ShowS
showList :: [EchoMsg] -> ShowS
Show
instance Parse Packet where
parse :: PacketParser Packet
parse = do (MessageType
t,Word8
c,Word16
s) <- PacketParser (MessageType, Word8, Word16)
forall a. Parse a => PacketParser a
parse
case MessageType
t of
MessageType
Echo_Request -> EchoMsg -> Packet
EchoRequest (EchoMsg -> Packet) -> PacketParser EchoMsg -> PacketParser Packet
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser EchoMsg
forall a. Parse a => PacketParser a
parse
MessageType
Echo_Reply -> EchoMsg -> Packet
EchoReply (EchoMsg -> Packet) -> PacketParser EchoMsg -> PacketParser Packet
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser EchoMsg
forall a. Parse a => PacketParser a
parse
MessageType
_ -> MessageType -> Word8 -> Word16 -> UArray Int Word8 -> Packet
Other MessageType
t Word8
c Word16
s (UArray Int Word8 -> Packet)
-> PacketParser (UArray Int Word8) -> PacketParser Packet
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser (UArray Int Word8)
forall a. Parse a => PacketParser a
parse
instance Parse EchoMsg where parse :: PacketParser EchoMsg
parse = Word16 -> Word16 -> UArray Int Word8 -> EchoMsg
Echo (Word16 -> Word16 -> UArray Int Word8 -> EchoMsg)
-> PacketParser Word16
-> PacketParser (Word16 -> UArray Int Word8 -> EchoMsg)
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser Word16
forall a. Parse a => PacketParser a
parse PacketParser (Word16 -> UArray Int Word8 -> EchoMsg)
-> PacketParser Word16
-> PacketParser (UArray Int Word8 -> EchoMsg)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Word16
forall a. Parse a => PacketParser a
parse PacketParser (UArray Int Word8 -> EchoMsg)
-> PacketParser (UArray Int Word8) -> PacketParser EchoMsg
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser (UArray Int Word8)
forall a. Parse a => PacketParser a
parse
instance Unparse Packet where unparse :: Packet -> UnparseS
unparse = OutPacket -> UnparseS
forall a. Unparse a => a -> UnparseS
unparse (OutPacket -> UnparseS)
-> (Packet -> OutPacket) -> Packet -> UnparseS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Packet -> OutPacket
icmpUnparse
icmpUnparse :: Packet -> OutPacket
icmpUnparse (EchoRequest EchoMsg
m) = Bool -> EchoMsg -> OutPacket
echoUnparse Bool
False EchoMsg
m
icmpUnparse (EchoReply EchoMsg
m) = Bool -> EchoMsg -> OutPacket
echoUnparse Bool
True EchoMsg
m
echoUnparse :: Bool -> EchoMsg -> OutPacket
echoUnparse :: Bool -> EchoMsg -> OutPacket
echoUnparse Bool
reply EchoMsg
m = UArray Int Word8 -> OutPacketS
addChunk ((Int, Int) -> [(Int, Word8)] -> UArray Int Word8
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
array (Int
0,Int
7) ([Int] -> [Word8] -> [(Int, Word8)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Word8
a1,Word8
a2,Word8
a3,Word8
a4,Word8
b1,Word8
b2,Word8
b3,Word8
b4]))
OutPacketS -> OutPacketS
forall a b. (a -> b) -> a -> b
$ UArray Int Word8 -> OutPacketS
addChunk (EchoMsg -> UArray Int Word8
echoData EchoMsg
m)
OutPacketS -> OutPacketS
forall a b. (a -> b) -> a -> b
$ OutPacket
emptyOutPack
where a1 :: Word8
a1 = if Bool
reply then Word8
0 else Word8
8
a2 :: Word8
a2 = Word8
0
(Word8
a3,Word8
a4) = (Word16
check Word16 -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
1, Word16
check Word16 -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
0)
(Word8
b1,Word8
b2) = (EchoMsg -> Word16
ident EchoMsg
m Word16 -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
1, EchoMsg -> Word16
ident EchoMsg
m Word16 -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
0)
(Word8
b3,Word8
b4) = (EchoMsg -> Word16
seqNum EchoMsg
m Word16 -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
1, EchoMsg -> Word16
seqNum EchoMsg
m Word16 -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
0)
check :: Word16
check = [Word16] -> Word16
checksum ([Word16] -> Word16) -> [Word16] -> Word16
forall a b. (a -> b) -> a -> b
$ [Word8] -> [Word16]
bytes_to_words_big ([Word8
a1,Word8
a2,Word8
0,Word8
0,Word8
b1,Word8
b2,Word8
b3,Word8
b4] [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ UArray Int Word8 -> [Word8]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems (EchoMsg -> UArray Int Word8
echoData EchoMsg
m))
data MessageType = Echo_Reply
| Unknown1
| Unknown2
| Destination_Unreachable
| Source_Quench
| Redirect
| Unknown6
| Unknown7
| Echo_Request
| Unknown9
| Unknown10
| Time_Exceeded
| Parameter_Problem
| Timestamp
| Timestamp_Reply
| Information_Request
| Information_Reply
| UnknownOther
deriving (MessageType -> MessageType -> Bool
(MessageType -> MessageType -> Bool)
-> (MessageType -> MessageType -> Bool) -> Eq MessageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageType -> MessageType -> Bool
== :: MessageType -> MessageType -> Bool
$c/= :: MessageType -> MessageType -> Bool
/= :: MessageType -> MessageType -> Bool
Eq,Int -> MessageType
MessageType -> Int
MessageType -> [MessageType]
MessageType -> MessageType
MessageType -> MessageType -> [MessageType]
MessageType -> MessageType -> MessageType -> [MessageType]
(MessageType -> MessageType)
-> (MessageType -> MessageType)
-> (Int -> MessageType)
-> (MessageType -> Int)
-> (MessageType -> [MessageType])
-> (MessageType -> MessageType -> [MessageType])
-> (MessageType -> MessageType -> [MessageType])
-> (MessageType -> MessageType -> MessageType -> [MessageType])
-> Enum MessageType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MessageType -> MessageType
succ :: MessageType -> MessageType
$cpred :: MessageType -> MessageType
pred :: MessageType -> MessageType
$ctoEnum :: Int -> MessageType
toEnum :: Int -> MessageType
$cfromEnum :: MessageType -> Int
fromEnum :: MessageType -> Int
$cenumFrom :: MessageType -> [MessageType]
enumFrom :: MessageType -> [MessageType]
$cenumFromThen :: MessageType -> MessageType -> [MessageType]
enumFromThen :: MessageType -> MessageType -> [MessageType]
$cenumFromTo :: MessageType -> MessageType -> [MessageType]
enumFromTo :: MessageType -> MessageType -> [MessageType]
$cenumFromThenTo :: MessageType -> MessageType -> MessageType -> [MessageType]
enumFromThenTo :: MessageType -> MessageType -> MessageType -> [MessageType]
Enum,MessageType
MessageType -> MessageType -> Bounded MessageType
forall a. a -> a -> Bounded a
$cminBound :: MessageType
minBound :: MessageType
$cmaxBound :: MessageType
maxBound :: MessageType
Bounded,Int -> MessageType -> ShowS
[MessageType] -> ShowS
MessageType -> String
(Int -> MessageType -> ShowS)
-> (MessageType -> String)
-> ([MessageType] -> ShowS)
-> Show MessageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageType -> ShowS
showsPrec :: Int -> MessageType -> ShowS
$cshow :: MessageType -> String
show :: MessageType -> String
$cshowList :: [MessageType] -> ShowS
showList :: [MessageType] -> ShowS
Show)
instance Parse MessageType where
parse :: PacketParser MessageType
parse = Word8 -> MessageType
forall {p}. Enum p => p -> MessageType
toEnum' (Word8 -> MessageType)
-> PacketParser Word8 -> PacketParser MessageType
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser Word8
word8
where toEnum' :: p -> MessageType
toEnum' p
w = if Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<MessageType -> Int
forall a. Enum a => a -> Int
fromEnum MessageType
lo Bool -> Bool -> Bool
|| Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>MessageType -> Int
forall a. Enum a => a -> Int
fromEnum MessageType
hi
then MessageType
UnknownOther
else Int -> MessageType
forall a. Enum a => Int -> a
toEnum (Int -> Int
forall a. Enum a => a -> Int
fromEnum Int
n)
where n :: Int
n=p -> Int
forall a. Enum a => a -> Int
fromEnum p
w
lo,hi::MessageType
lo :: MessageType
lo=MessageType
forall a. Bounded a => a
minBound
hi :: MessageType
hi=MessageType
forall a. Bounded a => a
maxBound