summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--LLCSNAP.hs49
-rw-r--r--WifiHeader.hs335
-rw-r--r--readpackets.hs286
-rw-r--r--src/Hans/Checksum.hs136
4 files changed, 769 insertions, 37 deletions
diff --git a/LLCSNAP.hs b/LLCSNAP.hs
new file mode 100644
index 00000000..417c36ba
--- /dev/null
+++ b/LLCSNAP.hs
@@ -0,0 +1,49 @@
1module LLCSNAP where
2
3import Data.Bits
4import Data.Word
5
6import Net.PacketParsing
7
8
9-- 802.2 LLC Header : SNAP extension
10-- --------------------------------------------------------------------------
11-- DSAP : SSAP : Control : OUI : Protocol ID
12-- 1 octet : 1 octet : 1 or 2 octets : 3 octets : 2 octets
13
14data LLCSNAP = LLCSNAP
15 { dsap :: Word8
16 , ssap :: Word8
17 , control :: Word16 -- 1 or 2 bytes
18 , oui :: Word32 -- 3 bytes
19 , protoid :: Word16
20 }
21 deriving (Eq,Ord,Read,Show)
22
23instance Parse LLCSNAP where
24 parse = do
25 -- LLC
26 dsap <- word8
27 ssap <- word8
28 control <- fromIntegral <$> word8
29 -- Based on "Understanding Logical Link Control" at
30 -- https://www.cisco.com/c/en/us/support/docs/ibm-technologies/logical-link-control-llc/12247-45.html
31 --
32 -- Unless the low two bits are set, there's
33 -- another byte of the control field.
34 nr <- if 0x0003 == control .&. 0x0003
35 then return 0
36 else fromIntegral <$> word8
37 -- SNAP
38 ouilo <- fromIntegral <$> word16
39 ouihi <- fromIntegral <$> word8
40 protoid <- word16
41 return LLCSNAP
42 { dsap = dsap
43 , ssap = ssap
44 , control = control + 256 * nr
45 , oui = ouilo + 65536 * ouihi
46 , protoid = protoid
47 }
48
49
diff --git a/WifiHeader.hs b/WifiHeader.hs
new file mode 100644
index 00000000..90e77003
--- /dev/null
+++ b/WifiHeader.hs
@@ -0,0 +1,335 @@
1{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3{-# LANGUAGE PatternSynonyms #-}
4module WifiHeader where
5
6import Data.Bits
7import Data.Word
8
9import Net.Ethernet as Mac (Addr(..))
10import Net.Packet
11import Net.PacketParsing
12
13import LLCSNAP
14
15-- 802.11 Mac header
16--
17-- 23 bytes
18
19-- Wikipedia:
20--
21-- Frames are divided into very specific and standardized sections. Each frame
22-- consists of a MAC header, payload, and frame check sequence (FCS).
23--
24-- Data frames carry packets from web pages, files, etc. within the body.[51]
25-- The body begins with an IEEE 802.2 header, with the Destination Service
26-- Access Point (DSAP) specifying the protocol; however, if the DSAP is hex AA,
27-- the 802.2 header is followed by a Subnetwork Access Protocol (SNAP) header,
28-- with the Organizationally Unique Identifier (OUI) and protocol ID (PID)
29-- fields specifying the protocol. If the OUI is all zeroes, the protocol ID
30-- field is an EtherType value.[52] Almost all 802.11 data frames use 802.2 and
31-- SNAP headers, and most use an OUI of 00:00:00 and an EtherType value.
32--
33-- [51] http://www.wi-fiplanet.com/tutorials/article.php/1447501
34
35-- The first two bytes of the MAC header form a frame control field...
36--
37-- The next two bytes are reserved for the Duration ID field
38--
39-- An 802.11 frame can have up to four address fields. Each field can carry a
40-- MAC address. The first 4 bits are used for the fragmentation number, and
41-- the last 12 bits are the sequence number.
42--
43-- The Sequence Control field is a two-byte section used for identifying
44-- message order as well as eliminating duplicate frames.
45--
46-- An optional two-byte Quality of Service control field that was added with
47-- 802.11e.
48--
49-- The payload or frame body field is variable in size, from 0 to 2304 bytes
50-- plus any overhead from security encapsulation, and contains information from
51-- higher layers
52--
53-- The Frame Check Sequence (FCS) is the last four bytes in the standard 802.11
54-- frame. Often referred to as the Cyclic Redundancy Check (CRC), it allows for
55-- integrity check of retrieved frames.
56
57-- 2 bits
58data Type = Management
59 | Control
60 | Data
61 | Reserved
62 deriving (Eq,Ord,Enum,Read,Show)
63
64-- 4 bits
65data SubType = AssociationRequest
66 | SubType1
67 | SubType2
68 | SubType3
69 | ProbeRequest
70 | SubType5
71 | SubType6
72 | SubType7
73
74 -- Any of the following used with type 'Data' means the optional
75 -- QoS field is present.
76 | Beacon
77 | SubType9
78 | Disassociation
79 | SubTypeB
80 | SubTypeC
81 | SubTypeD
82 | SubTypeE
83 | SubTypeF
84 deriving (Eq,Ord,Enum,Read,Show)
85
86-- Byte 0 (Frame Control Field 1)
87wifiTypeBits :: Word8 -> Maybe (Type,SubType)
88wifiTypeBits b
89 | version/=0 = Nothing
90 | otherwise = Just (typ,subtyp)
91 where
92 version = b .&. 0x03
93 typ = toEnum $ fromIntegral $ 0x03 .&. shiftR b 2
94 subtyp = toEnum $ fromIntegral $ 0x0F .&. shiftR b 4
95
96
97
98-- Byte 1 (Frame Control Field 2)
99newtype Flags = Flags Word8
100 deriving (Eq,Ord,Bits,Read,Show)
101
102pattern ToDS = Flags 0x01
103pattern FromDS = Flags 0x02
104pattern MoreFragments = Flags 0x04
105pattern Retry = Flags 0x08
106pattern PowerManagement = Flags 0x10
107pattern MoreData = Flags 0x20
108pattern Protected = Flags 0x40
109pattern Order = Flags 0x80
110
111flagNames :: [(Flags, String)]
112flagNames =
113 [( ToDS, "ToDS" )
114 ,( FromDS, "FromDS" )
115 ,( MoreFragments, "MoreFragments" )
116 ,( Retry, "Retry" )
117 ,( PowerManagement, "PowerManagement" )
118 ,( MoreData, "MoreData" )
119 ,( Protected, "Protected" )
120 ,( Order, "Order" )]
121
122-- Bytes 2,3
123-- Duration/ID field
124--
125-- This field is of size 16 bits. It carries following fields.
126--
127-- • In control type frames of subtype Power Save (PS)-Poll, the Duration/ID
128-- field carries the association identity (AID) of the station that transmitted
129-- the frame in the 14 least significant bits (LSB), with the 2 most
130-- significant bits (MSB) both set to 1. AID value varies between values from 1
131-- to 2007.
132--
133-- • In all the other frames, this field contains duration value as specified
134-- for each of the frame. For all the frames transmitted during the CFP
135-- (contention free time period) this field is set to 32,768. If the content of
136-- this field is less than 32768, it is used to update NAV (Network Allocation
137-- Vector).
138newtype DurationID = DurationID Word16
139 deriving (Eq,Ord,Read,Show)
140
141instance Parse DurationID where parse = DurationID <$> parse -- (big endian)
142
143
144
145-- Bytes 4-(21/27) (+18 or +24 bytes long)
146--
147-- Wikipedia claimed: Address 1 is the receiver, Address 2 is the transmitter,
148-- Address 3 is used for filtering purposes by the receiver.[dubious – discuss]
149--
150-- But http://www.rfwireless-world.com/Articles/WLAN-MAC-layer-protocol.html
151-- says:
152--
153-- ToDS FromDS addr1 addr2 addr3 addr4
154-- ---- ------ ----- ----- ----- -----
155-- 0 0 DA SA BSSID -
156-- 0 1 DA BSSID SA -
157-- 1 0 BSSID SA DA -
158-- 1 1 RA TA DA SA
159--
160-- DataFrames:
161--
162-- http://www.rfwireless-world.com/images/WLAN-MAC-Data-Frame.jpg
163--
164-- Note 1: The address-1 always holds the RA(Receiver Address) of the intended
165-- receiver or receivers(e.g. in multicast operation). Note 2 : The address-2
166-- always holds the address of STA which is transmitting the MAC frame.
167
168data Addresses = Addresses
169 { bssid :: Maybe Mac.Addr -- BSSID
170 , srcAddr :: Mac.Addr -- SA
171 , dstAddr :: Mac.Addr -- DA
172 , txAddr :: Maybe Mac.Addr -- TA
173 , rxAddr :: Maybe Mac.Addr -- RA
174 }
175 deriving (Eq,Ord,Show)
176
177parseAddresses :: Flags -> PacketParser Addresses
178parseAddresses fc = case fc .&. (ToDS .|. FromDS) of
179 Flags 0 -> do
180 -- 0 0 DA SA BSSID -
181 _da <- parse
182 _sa <- parse
183 _bssid <- parse
184 return Addresses
185 { bssid = Just _bssid
186 , srcAddr = _sa
187 , dstAddr = _da
188 , txAddr = Nothing
189 , rxAddr = Nothing
190 }
191 FromDS -> do
192 -- 0 1 DA BSSID SA -
193 _da <- parse
194 _bssid <- parse
195 _sa <- parse
196 return Addresses
197 { bssid = Just _bssid
198 , srcAddr = _sa
199 , dstAddr = _da
200 , txAddr = Nothing
201 , rxAddr = Nothing
202 }
203 ToDS -> do
204 -- 1 0 BSSID SA DA -
205 _bssid <- parse
206 _sa <- parse
207 _da <- parse
208 return Addresses
209 { bssid = Just _bssid
210 , srcAddr = _sa
211 , dstAddr = _da
212 , txAddr = Nothing
213 , rxAddr = Nothing
214 }
215 Flags 0x03 -> do
216 -- 1 1 RA TA DA SA
217 _ra <- parse
218 _ta <- parse
219 _da <- parse
220 -- http://www.rfwireless-world.com/Articles/WLAN-MAC-layer-protocol-p2.html
221 -- indicates that there is a SequenceControl field here.
222 _sa <- parse
223 return Addresses
224 { bssid = Nothing
225 , srcAddr = _sa
226 , dstAddr = _da
227 , txAddr = Just _ta
228 , rxAddr = Just _ra
229 }
230
231-- Bytes 22/28-23/29 (2 bytes)
232--
233-- The Sequence Control field.
234--
235-- A two-byte section used for identifying message order as well as eliminating
236-- duplicate frames. The first 4 bits are used for the fragmentation number,
237-- and the last 12 bits are the sequence number.
238newtype SequenceControl = SequenceControl Word16
239 deriving (Eq,Ord,Read,Show)
240
241instance Parse SequenceControl where parse = SequenceControl <$> parse -- (big endian)
242
243-- Optional: Bytes 24/30 - 25/31
244--
245-- An optional two-byte Quality of Service control field that was added with 802.11e.
246newtype QoS = QoS Word16
247 deriving (Eq,Ord,Read,Show)
248
249-- Bytes 24/30 (802.11e maybe 26/32) - ? variable length
250--
251-- Frame Body
252
253-- Last 4 bytes.
254--
255-- FCS
256--
257-- Wikipedia cites https://wayback.archive.org/web/20090124151617/http://wifi.cs.st-andrews.ac.uk/wififrame.html
258--
259-- From http://www.rfwireless-world.com/Articles/WLAN-MAC-layer-protocol.html
260--
261-- The WLAN FCS field is a 32-bit field containing a 32-bit CRC. The FCS is
262-- calculated over all the fields of the MAC header and the Frame Body field.
263-- These are referred to as the calculation fields.
264--
265-- The FCS is calculated using the following standard generator polynomial of
266-- degree 32: G(x) = x³² + x²⁶ + x²³ + x²² + x¹⁶ + x¹² + x¹¹ + x¹⁰ + x⁸ + x⁷ +
267-- x⁵ + x⁴ + x² + x + 1
268--
269-- The FCS is the 1's complement of the sum (modulo 2) of the following:
270--
271-- • The remainder of xk * (x³¹+x³⁰+x²⁹+...+x² + x + 1) divided (modulo 2) by
272-- G(x), where k is the number of bits in the calculation fields.
273--
274-- • The remainder after multiplication of the contents (treated as a
275-- polynomial) of the calculation fields by x³² and then division by G(x)
276newtype FCS = FCS Word32
277 deriving (Eq,Ord,Read,Show)
278
279data Packet a = Packet
280 { wifiType :: Type
281 , subtype :: SubType
282 , flags :: Flags
283 , duration :: DurationID
284 , addresses :: Addresses
285 , sequenceControl :: SequenceControl
286 , qos :: Maybe QoS
287 , llcsnap :: Maybe LLCSNAP
288 , content :: a
289 , fcs :: Maybe FCS
290 }
291 deriving (Eq,Ord,Show)
292
293-- Hardcoded flag to disable parsing FCS checksum.
294hasFCS :: Bool
295hasFCS = False -- DLT_IEEE802_11 has no trailing 4-byte FCS checksum
296 --
297 -- Other link types might include this:
298 -- See: DLT_IEEE802_11_RADIO
299 -- or DLT_IEEE802_11_RADIO_AVS
300
301instance Parse (Packet InPacket) where
302 parse = do
303 Just (typ,subtyp) <- wifiTypeBits <$> word8
304 flgs <- Flags <$> word8
305 durid <- DurationID <$> word16
306 addrs <- parseAddresses flgs
307 sc <- SequenceControl <$> word16 -- TODO: Sometimes this precedes the 4th address.
308 qos <- if typ == Data && subtyp > SubType7
309 then Just . QoS <$> parse
310 else return Nothing
311 llcsnap <- case typ of
312 Data -> Just <$> parse
313 _ -> return Nothing
314 rst <- therest
315 let (payload,fcs) = if hasFCS
316 then
317 let payload = takeInPack (len rst - 4) rst
318 fcshi = rst `wordAt` (len rst - 4)
319 fcslo = rst `wordAt` (len rst - 2)
320 fcs = FCS $ fromIntegral fcshi * 65536
321 + fromIntegral fcslo
322 in (payload,Just fcs)
323 else (rst,Nothing)
324 return Packet
325 { wifiType = typ
326 , subtype = subtyp
327 , flags = flgs
328 , duration = durid
329 , addresses = addrs
330 , sequenceControl = sc
331 , qos = qos
332 , llcsnap = llcsnap
333 , content = payload
334 , fcs = fcs
335 }
diff --git a/readpackets.hs b/readpackets.hs
index f02df538..690aa91e 100644
--- a/readpackets.hs
+++ b/readpackets.hs
@@ -1,6 +1,9 @@
1{-# LANGUAGE PackageImports #-} 1{-# LANGUAGE PackageImports #-}
2{-# LANGUAGE StandaloneDeriving #-}
2module Main where 3module Main where
3 4
5import Control.Arrow
6import Data.Maybe
4import Data.Binary.Get (runGet) 7import Data.Binary.Get (runGet)
5import qualified Data.ByteString as BS 8import qualified Data.ByteString as BS
6import qualified Data.ByteString as B 9import qualified Data.ByteString as B
@@ -8,30 +11,63 @@ import qualified Data.ByteString.Lazy as LZ
8import qualified Data.ByteString.Lazy.Char8 as L8 11import qualified Data.ByteString.Lazy.Char8 as L8
9import Data.IORef 12import Data.IORef
10import Data.List 13import Data.List
14import Data.Word
11import Debug.Trace 15import Debug.Trace
12import Text.Printf 16import Text.Printf
13import Text.Show.Pretty as PP 17import Text.Show.Pretty as PP
14import "network-house" Net.Packet 18import "network-house" Net.Packet as House
15import qualified "network-house" Net.IPv4 as IP4 19import qualified "network-house" Net.IPv4 as IP4
16import qualified "network-house" Net.IPv6 as IP6 20import qualified "network-house" Net.IPv6 as IP6
17import "network-house" Net.PacketParsing 21import "network-house" Net.PacketParsing as House
22import "network-house" Net.PortNumber as TCP
23import "network-house" Net.ICMP as ICMP
24import "network-house" Net.TCP as TCP
18import "network-house" Net.UDP as UDP 25import "network-house" Net.UDP as UDP
19import "pcap" Network.Pcap 26import "pcap" Network.Pcap
20import qualified Data.Serialize as S 27import qualified Data.Serialize as S
21import qualified Network.Socket as HS 28import qualified Network.Socket as HS
22import Control.Applicative 29import Control.Applicative
30import Control.Monad
31import System.Environment
32import Control.Exception
33
34import Hans.Checksum
35import WifiHeader as Wifi
23 36
24import Crypto.Tox 37import Crypto.Tox
25import Network.Tox.DHT.Transport as Tox 38import Network.Tox.DHT.Transport as Tox
26import Data.BEncode as BE 39import Data.BEncode as BE
27import Data.BEncode.Pretty 40import Data.BEncode.Pretty
28-- import Data.IKE.Message 41-- import Data.IKE.Message
42import Text.XXD
29 43
30-- traceM string = trace string $ return () 44-- traceM string = trace string $ return ()
31 45
46
47-- IPv4 : rfc 791
48-- IPv6 : rfc 2460 (8200)
49-- TCP : rfc 793
50-- UDP : rfc 768
51-- ICMP : rfc 792
52-- ICMPv6 : rfc 4443
53-- ARP : rfc 826
54-- SNAP : rfc 1042
55
56deriving instance Show IP6.Word4
57deriving instance Show IP6.Word20
58deriving instance Show IP6.Addr
59deriving instance Show a => Show (IP6.Packet a)
60
32bs2chunk :: BS.ByteString -> UArray Int Word8 61bs2chunk :: BS.ByteString -> UArray Int Word8
33bs2chunk bs = listArray (0,subtract 33 $ BS.length bs) $ drop 32 $ BS.unpack bs 62bs2chunk bs = listArray (0,subtract 33 $ BS.length bs) $ drop 32 $ BS.unpack bs
63-- 23 + 9 = 32
64
65mkchunk :: Int -> BS.ByteString -> Maybe (UArray Int Word8)
66mkchunk n bs
67 | (BS.length bs < n) = Nothing
68 | otherwise = Just $ listArray (0,subtract (n+1) $ BS.length bs) $ drop n $ BS.unpack bs
34 69
70{-
35hex :: BS.ByteString -> String 71hex :: BS.ByteString -> String
36hex = concatMap (printf "%02x") . B.unpack 72hex = concatMap (printf "%02x") . B.unpack
37 73
@@ -40,43 +76,219 @@ hexlines bs = ss
40 where xs = zip [0..] $ hex bs 76 where xs = zip [0..] $ hex bs
41 ls = groupBy (\(n,_) (m,_)-> n `div` 32 == m `div` 32) xs 77 ls = groupBy (\(n,_) (m,_)-> n `div` 32 == m `div` 32) xs
42 ss = map (map snd) ls 78 ss = map (map snd) ls
79-}
80
81udpPacket :: PktHdr -> BS.ByteString -> Maybe (IO ())
82udpPacket hdr buf = do
83 chunk <- mkchunk 32 buf
84 udp <- House.doParse $ House.toInPack chunk
85 -- traceM $ "got udp: " ++ show udp
86 -- traceM $ "got udp content: " ++ show (content udp)
87 let plen = House.len $ UDP.content udp
88 bs <- fmap BS.pack . parseInPacket (bytes plen) $ UDP.content udp
89 -- traceM $ "Got bs " ++ show bs
90 (checksum,blob) <- Just $ BS.splitAt 2 bs -- extra 2 bytes in pcap capture, i'm assuming its a checksum
91 -- (first4,truncated) = BS.splitAt 4 blob
92 -- -- First 4 bytes being zero is how we distinguish between
93 -- -- ESP and IKEv2 packets on port 4500.
94 -- dta = if destPort udp /= Port 500 && first4==BS.pack [0,0,0,0]
95 -- then truncated
96 -- else blob
97 Just $ do
98 putStrLn $ "UDP." ++ show udp
99 mapM_ putStrLn $ xxd2 0 blob
100
101parseIP4 :: InPacket -> Maybe (IP4.Packet InPacket)
102parseIP4 inpkt = do
103 ip <- House.doParse inpkt
104 4 <- Just $ IP4.version ip
105 return ip
106
107ipPacket4 :: PktHdr -> BS.ByteString -> Maybe (IO ())
108ipPacket4 hdr buf = do
109 chunk <- mkchunk 23 buf
110 ip <- parseIP4 $ House.toInPack chunk
111 Just $ do
112 putStrLn $ "-- ipPacket4 --"
113 putStrLn $ "IP4." ++ show ip
114
115parseIP6 :: InPacket -> Maybe (IP6.Packet InPacket)
116parseIP6 inpkt = do
117 ip <- House.doParse inpkt
118 IP6.Word4 6 <- Just $ IP6.version ip
119 return ip
120
121ipPacket6 :: PktHdr -> BS.ByteString -> Maybe (IO ())
122ipPacket6 hdr buf = do
123 chunk <- mkchunk 23 buf
124 ip <- parseIP6 $ House.toInPack chunk
125 Just $ do
126 putStrLn $ "-- ipPacket6 --"
127 putStrLn $ "IP6." ++ show ip
128
129showTruncated hdr s
130 | hdrCaptureLength hdr == hdrWireLength hdr
131 = s
132 | otherwise = unwords
133 [ s
134 , "(truncated"
135 , show $ hdrCaptureLength hdr
136 , "of"
137 , show (hdrWireLength hdr) ++ ")"
138 ]
139
140wifiPacket hdr buf = do
141 (Data,_) <- wifiTypeBits $ BS.index buf 0 -- Filter all but data packets.
142 guard (BS.length buf >= 28)
143 chunk <- mkchunk 0 buf
144 wifi <- House.doParse $ House.toInPack chunk
145 Just $ do
146 -- putStrLn $ "-- wifiPacket --"
147 -- putStrLn $ "Wifi." ++ show wifi
148 let parseip = do
149 Wifi.Data <- Just $ wifiType wifi
150 c <- Just $ Wifi.content wifi
151 (Left <$> parseIP4 c) <|> (Right <$> parseIP6 c)
152 let mdta = parseip >>= ipPacket
153 forM_ mdta $ \dta -> do
154 let src = saddr (left fst $ right fst $ ipAddrs dta)
155 (fromMaybe 0 $ fst <$> ipPorts dta)
156 dst = saddr (left snd $ right snd $ ipAddrs dta)
157 (fromMaybe 0 $ snd <$> ipPorts dta)
158 srcmac = Wifi.srcAddr (Wifi.addresses wifi)
159 dstmac = Wifi.dstAddr (Wifi.addresses wifi)
160 r = [ maybe "" (("bssid "++) . show) $ Wifi.bssid (Wifi.addresses wifi)
161 , "<-- " ++ show src ++ " (" ++ show srcmac ++ ")"
162 , "--> " ++ show dst ++ " (" ++ show dstmac ++ ")"
163 , showTruncated hdr (ipProtocol dta)
164 ]
165 case ipPayload dta of
166 Nothing -> mapM_ putStrLn r
167 Just bs -> mapM_ putStrLn $ sideBySide (xxd2 0 bs) r
168 putStrLn ""
169
170sideBySide (x:xs) (y:ys) = (take 72 (x ++ repeat ' ') ++ y) : sideBySide xs ys
171sideBySide [] (y:ys) = (replicate 72 ' ' ++ y) : sideBySide [] ys
172sideBySide xs [] = xs
173
174saddr (Left ip4) port = HS.SockAddrInet (fromIntegral port) addr
175 where IP4.Addr a b c d = ip4
176 addr = fromIntegral a
177 + fromIntegral b * 256
178 + fromIntegral c * 65536
179 + fromIntegral d * 16777216
180saddr (Right ip6) port = HS.SockAddrInet6 (fromIntegral port) 0 addr 0
181 where IP6.Addr ah al bh bl ch cl dh dl = ip6
182 addr = ( fromIntegral ah * 65536 + fromIntegral al
183 , fromIntegral bh * 65536 + fromIntegral bl
184 , fromIntegral ch * 65536 + fromIntegral cl
185 , fromIntegral dh * 65536 + fromIntegral dl
186 )
187
188data IPData = IPData
189 { ipPayload :: Maybe BS.ByteString
190 , ipProtocol :: String
191 , ipPorts :: Maybe (Word16,Word16)
192 , ipAddrs :: Either (IP4.Addr,IP4.Addr)
193 (IP6.Addr,IP6.Addr)
194 }
195
196ip4addrs pkt = (IP4.source pkt, IP4.dest pkt)
197
198ip6addrs pkt = (IP6.source pkt, IP6.dest pkt)
199
200ipPacket ip = do
201 let udp = do
202 IP4.UDP <- Just $ either IP4.protocol IP6.next_header ip
203 pkt <- House.doParse $ either IP4.content IP6.content ip
204 let ulen = House.len $ UDP.content pkt
205 mbs = fmap BS.pack . parseInPacket (bytes ulen) $ UDP.content pkt
206 let UDP.Port sport = UDP.sourcePort pkt
207 UDP.Port dport = UDP.destPort pkt
208 return IPData
209 { ipPayload = mbs
210 , ipProtocol = "UDP"
211 , ipPorts = Just (sport,dport)
212 , ipAddrs = either (Left . ip4addrs) (Right . ip6addrs) ip
213 }
214 tcp = do
215 IP4.TCP <- Just $ either IP4.protocol IP6.next_header ip
216 pkt <- House.doParse $ either IP4.content IP6.content ip
217 let ulen = House.len $ TCP.content pkt
218 mbs = fmap BS.pack . parseInPacket (bytes ulen) $ TCP.content pkt
219 let TCP.Port sport = TCP.sourcePort pkt
220 TCP.Port dport = TCP.destPort pkt
221 return IPData
222 { ipPayload = mbs
223 , ipProtocol = "TCP"
224 , ipPorts = Just (sport,dport)
225 , ipAddrs = either (Left . ip4addrs) (Right . ip6addrs) ip
226 }
227 icmp = do
228 IP4.ICMP <- Just $ either IP4.protocol IP6.next_header ip
229 pkt <- House.doParse $ either IP4.content IP6.content ip
230 let ping = do
231 EchoRequest msg <- Just pkt
232 return ("Ping", echoData msg)
233 pong = do
234 EchoReply msg <- Just pkt
235 return ("Pong", echoData msg)
236 other = do
237 Other { type_ = typ, content = chunk } <- Just pkt
238 return (show typ, chunk)
239 (typ,chunk) <- ping <|> pong <|> other
240 let p = House.toInPack chunk
241 ulen = House.len p
242 mbs = fmap BS.pack . parseInPacket (bytes ulen) $ p
243 return IPData
244 { ipPayload = mbs
245 , ipProtocol = "ICMP "++typ
246 , ipPorts = Nothing
247 , ipAddrs = either (Left . ip4addrs) (Right . ip6addrs) ip
248 }
249 unknown = do
250 IP4.Unknown proto <- Just $ either IP4.protocol IP6.next_header ip
251 pkt <- Just $ either IP4.content IP6.content ip
252 let ulen = House.len pkt
253 mbs = fmap BS.pack . parseInPacket (bytes ulen) $ pkt
254 return IPData
255 { ipPayload = mbs
256 , ipProtocol = "proto "++show proto
257 , ipPorts = Nothing
258 , ipAddrs = either (Left . ip4addrs) (Right . ip6addrs) ip
259 }
260 udp <|> icmp <|> tcp <|> unknown
261
43 262
44parsePacket :: IORef Int -> PktHdr -> BS.ByteString -> IO () 263parsePacket :: IORef Int -> PktHdr -> BS.ByteString -> IO ()
45parsePacket cnt hdr buf = do 264parsePacket cnt hdr buf = do
46 print hdr 265 sequence_ $ wifiPacket hdr buf
47 let -- mb :: Maybe (BS.ByteString, Message Encrypted)
48 mb = do
49 udp <- doParse $ toInPack $ bs2chunk buf
50 -- traceM $ "got udp: " ++ show udp
51 -- traceM $ "got udp content: " ++ show (content udp)
52 let plen = Net.Packet.len $ content udp
53 bs <- fmap BS.pack . parseInPacket (bytes plen) $ content udp
54 -- traceM $ "Got bs " ++ show bs
55 let (checksum,blob) = BS.splitAt 2 bs -- extra 2 bytes in pcap capture, i'm assuming its a checksum
56-- (first4,truncated) = BS.splitAt 4 blob
57-- -- First 4 bytes being zero is how we distinguish between
58-- -- ESP and IKEv2 packets on port 4500.
59-- dta = if destPort udp /= Port 500 && first4==BS.pack [0,0,0,0]
60-- then truncated
61-- else blob
62 dta = blob
63 let d = BE.decode {- runGet getMessage $ LZ.fromStrict -} dta
64 saddr = HS.SockAddrInet 0 0 -- TODO
65 -- e = S.decode dta :: Either String (DHTMessage Encrypted8)
66 e = case Tox.parseDHTAddr (dta,saddr) :: Either (DHTMessage Encrypted8,NodeInfo) (BS.ByteString,HS.SockAddr) of
67 Left toxpkt -> Right toxpkt
68 Right _ -> Left "tox parse fail"
69 return $ (udp, bs, fmap Left d <|> fmap Right e)
70 flip (maybe $ return ()) mb $ \(udp, bs,m) -> do
71 putStrLn $ show udp
72 mapM_ putStrLn $ hexlines bs
73 -- putStrLn $ PP.ppShow m
74 either putStrLn (L8.putStrLn . either showBEncode (L8.pack . show)) m
75 modifyIORef' cnt (+1) 266 modifyIORef' cnt (+1)
76 267
268sampleHdr :: PktHdr
269sampleHdr = PktHdr {hdrSeconds = 1511875620, hdrUseconds = 464364, hdrCaptureLength = 347, hdrWireLength = 347}
270
271sampleBytes :: BS.ByteString
272sampleBytes = "\136\n0\NULT\242\SOH\243\ENQ\153\NUL\rg\144\162\a\244>\157\ETXV\213\240 \ETX\NUL\170\170\ETX\NUL\NUL\NUL\b\NULE\NUL\SOH9\191\170@\NUL@\ACK\174\176\192,D\ENQ\n\235\188G\NULP\202\220R\199)\154R\199+\247\128\DC1\b\NUL\204\196\NUL\NUL\SOH\SOH\b\n\NUL\243\150\&6\NUL\243\150\&1HTTP/1.1 302 Found \r\nLocation: https://wifilogin.xfinity.com/start.php?h=kozHorIQv1nb851zZcMfnWdD4wtjyIymVSIwanl8KXaQLMHBm0oJhcubjREusjojI%2B8f0UNFoG1p2lD33OXGlpw3uvJ5SeKeX37jANRRu%2FPZOwWw%2F70foAx70wBVohtmhWksbshKhR4lAWuv2FAB0%2BPVkpfSjNIE0HwQO%2BnRZR8%3D\r\n\r\n"
273
274sampleHdr2 = PktHdr {hdrSeconds = 1511841845, hdrUseconds = 681965, hdrCaptureLength = 10, hdrWireLength = 10}
275sampleBytes2 =
276 [ 0xc4, 0x00, 0x8a, 0x00
277 , 0x8c, 0xf5, 0xa3, 0x12, 0xdf, 0x80 ]
278
77main = do 279main = do
78 cnt <- newIORef 0 280 args <- getArgs
79 pcap <- openOffline "packets.pcap" 281 forM_ args $ \fname -> do
80 loopResult <- loopBS pcap (-1) $ parsePacket cnt 282 cnt <- newIORef 0
81 pktcnt <- readIORef cnt 283 parsePacket cnt sampleHdr sampleBytes
82 putStrLn $ "read "++show pktcnt ++" packets." 284 pcap <- openOffline fname -- "packets.pcap"
285 linktype <- datalink pcap
286 putStrLn $ unwords ["Opened:",fname,"Link:",show linktype]
287 -- Opened: opnwep.dat-08.cap Link: DLT_IEEE802_11
288 -- Opened: packets.pcap Link: DLT_EN10MB
289 -- DLT_IEEE802_11
290 -- DLT_IEEE802_11_RADIO
291 -- DLT_IEEE802_11_RADIO_AVS
292 loopResult <- loopBS pcap (-1) $ parsePacket cnt
293 pktcnt <- readIORef cnt
294 putStrLn $ "read "++show pktcnt ++" packets from " ++ fname ++ "."
diff --git a/src/Hans/Checksum.hs b/src/Hans/Checksum.hs
new file mode 100644
index 00000000..7afc93c7
--- /dev/null
+++ b/src/Hans/Checksum.hs
@@ -0,0 +1,136 @@
1{-# LANGUAGE RecordWildCards #-}
2{-# LANGUAGE BangPatterns #-}
3
4-- BANNERSTART
5-- - Copyright 2006-2008, Galois, Inc.
6-- - This software is distributed under a standard, three-clause BSD license.
7-- - Please see the file LICENSE, distributed with this software, for specific
8-- - terms and conditions.
9-- Author: Adam Wick <awick@galois.com>
10-- BANNEREND
11-- |A module providing checksum computations to other parts of Hans. The
12-- checksum here is the standard Internet 16-bit checksum (the one's
13-- complement of the one's complement sum of the data).
14
15module Hans.Checksum(
16 -- * Checksums
17 computeChecksum,
18 Checksum(..),
19 PartialChecksum(),
20 emptyPartialChecksum,
21 finalizeChecksum,
22 stepChecksum,
23
24 Pair8(..),
25 ) where
26
27import Data.Bits (Bits(shiftL,shiftR,complement,clearBit,(.&.)))
28import Data.List (foldl')
29import Data.Word (Word8,Word16,Word32)
30import qualified Data.ByteString as S
31import qualified Data.ByteString.Lazy as L
32import qualified Data.ByteString.Short as Sh
33import qualified Data.ByteString.Unsafe as S
34
35
36data PartialChecksum = PartialChecksum { pcAccum :: {-# UNPACK #-} !Word32
37 , pcCarry :: !(Maybe Word8)
38 } deriving (Eq,Show)
39
40emptyPartialChecksum :: PartialChecksum
41emptyPartialChecksum = PartialChecksum
42 { pcAccum = 0
43 , pcCarry = Nothing
44 }
45
46finalizeChecksum :: PartialChecksum -> Word16
47finalizeChecksum pc = complement (fromIntegral (fold32 (fold32 result)))
48 where
49 fold32 :: Word32 -> Word32
50 fold32 x = (x .&. 0xFFFF) + (x `shiftR` 16)
51
52 result = case pcCarry pc of
53 Nothing -> pcAccum pc
54 Just prev -> stepChecksum (pcAccum pc) prev 0
55{-# INLINE finalizeChecksum #-}
56
57
58computeChecksum :: Checksum a => a -> Word16
59computeChecksum a = finalizeChecksum (extendChecksum a emptyPartialChecksum)
60{-# INLINE computeChecksum #-}
61
62-- | Incremental checksum computation interface.
63class Checksum a where
64 extendChecksum :: a -> PartialChecksum -> PartialChecksum
65
66
67data Pair8 = Pair8 !Word8 !Word8
68
69instance Checksum Pair8 where
70 extendChecksum (Pair8 hi lo) = \ PartialChecksum { .. } ->
71 case pcCarry of
72 Nothing -> PartialChecksum { pcAccum = stepChecksum pcAccum hi lo
73 , pcCarry = Nothing }
74 Just c -> PartialChecksum { pcAccum = stepChecksum pcAccum c hi
75 , pcCarry = Just lo }
76 {-# INLINE extendChecksum #-}
77
78instance Checksum Word16 where
79 extendChecksum w = \pc -> extendChecksum (Pair8 hi lo) pc
80 where
81 lo = fromIntegral w
82 hi = fromIntegral (w `shiftR` 8)
83 {-# INLINE extendChecksum #-}
84
85instance Checksum Word32 where
86 extendChecksum w = \pc ->
87 extendChecksum (fromIntegral w :: Word16) $
88 extendChecksum (fromIntegral (w `shiftR` 16) :: Word16) pc
89 {-# INLINE extendChecksum #-}
90
91instance Checksum a => Checksum [a] where
92 extendChecksum as = \pc -> foldl' (flip extendChecksum) pc as
93 {-# INLINE extendChecksum #-}
94
95instance Checksum L.ByteString where
96 extendChecksum lbs = \pc -> extendChecksum (L.toChunks lbs) pc
97 {-# INLINE extendChecksum #-}
98
99-- XXX this could be faster if we could mirror the structure of the instance for
100-- S.ByteString
101instance Checksum Sh.ShortByteString where
102 extendChecksum shb = \ pc -> extendChecksum (Sh.fromShort shb) pc
103
104
105instance Checksum S.ByteString where
106 extendChecksum b pc
107 | S.null b = pc
108 | otherwise = case pcCarry pc of
109 Nothing -> result
110 Just prev -> extendChecksum (S.tail b) PartialChecksum
111 { pcCarry = Nothing
112 , pcAccum = stepChecksum (pcAccum pc) prev (S.unsafeIndex b 0)
113 }
114 where
115
116 n' = S.length b
117 n = clearBit n' 0 -- aligned to two
118
119 result = PartialChecksum
120 { pcAccum = loop (pcAccum pc) 0
121 , pcCarry = carry
122 }
123
124 carry
125 | odd n' = Just $! S.unsafeIndex b n
126 | otherwise = Nothing
127
128 loop !acc off
129 | off < n = loop (stepChecksum acc hi lo) (off + 2)
130 | otherwise = acc
131 where hi = S.unsafeIndex b off
132 lo = S.unsafeIndex b (off+1)
133
134stepChecksum :: Word32 -> Word8 -> Word8 -> Word32
135stepChecksum acc hi lo = acc + fromIntegral hi `shiftL` 8 + fromIntegral lo
136{-# INLINE stepChecksum #-}
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-22 13:37:43 +0000