{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE PatternSynonyms #-} module WifiHeader where import Data.Bits import Data.Word import Net.Ethernet as Mac (Addr(..)) import Net.Packet import Net.PacketParsing import LLCSNAP -- 802.11 Mac header -- -- 23 bytes -- Wikipedia: -- -- Frames are divided into very specific and standardized sections. Each frame -- consists of a MAC header, payload, and frame check sequence (FCS). -- -- Data frames carry packets from web pages, files, etc. within the body.[51] -- The body begins with an IEEE 802.2 header, with the Destination Service -- Access Point (DSAP) specifying the protocol; however, if the DSAP is hex AA, -- the 802.2 header is followed by a Subnetwork Access Protocol (SNAP) header, -- with the Organizationally Unique Identifier (OUI) and protocol ID (PID) -- fields specifying the protocol. If the OUI is all zeroes, the protocol ID -- field is an EtherType value.[52] Almost all 802.11 data frames use 802.2 and -- SNAP headers, and most use an OUI of 00:00:00 and an EtherType value. -- -- [51] http://www.wi-fiplanet.com/tutorials/article.php/1447501 -- The first two bytes of the MAC header form a frame control field... -- -- The next two bytes are reserved for the Duration ID field -- -- An 802.11 frame can have up to four address fields. Each field can carry a -- MAC address. The first 4 bits are used for the fragmentation number, and -- the last 12 bits are the sequence number. -- -- The Sequence Control field is a two-byte section used for identifying -- message order as well as eliminating duplicate frames. -- -- An optional two-byte Quality of Service control field that was added with -- 802.11e. -- -- The payload or frame body field is variable in size, from 0 to 2304 bytes -- plus any overhead from security encapsulation, and contains information from -- higher layers -- -- The Frame Check Sequence (FCS) is the last four bytes in the standard 802.11 -- frame. Often referred to as the Cyclic Redundancy Check (CRC), it allows for -- integrity check of retrieved frames. -- 2 bits data Type = Management | Control | Data | Reserved deriving (Eq,Ord,Enum,Read,Show) -- 4 bits data SubType = AssociationRequest | SubType1 | SubType2 | SubType3 | ProbeRequest | SubType5 | SubType6 | SubType7 -- Any of the following used with type 'Data' means the optional -- QoS field is present. | Beacon | SubType9 | Disassociation | SubTypeB | SubTypeC | SubTypeD | SubTypeE | SubTypeF deriving (Eq,Ord,Enum,Read,Show) -- Byte 0 (Frame Control Field 1) wifiTypeBits :: Word8 -> Maybe (Type,SubType) wifiTypeBits b | version/=0 = Nothing | otherwise = Just (typ,subtyp) where version = b .&. 0x03 typ = toEnum $ fromIntegral $ 0x03 .&. shiftR b 2 subtyp = toEnum $ fromIntegral $ 0x0F .&. shiftR b 4 -- Byte 1 (Frame Control Field 2) newtype Flags = Flags Word8 deriving (Eq,Ord,Bits,Read,Show) pattern ToDS = Flags 0x01 pattern FromDS = Flags 0x02 pattern MoreFragments = Flags 0x04 pattern Retry = Flags 0x08 pattern PowerManagement = Flags 0x10 pattern MoreData = Flags 0x20 pattern Protected = Flags 0x40 pattern Order = Flags 0x80 flagNames :: [(Flags, String)] flagNames = [( ToDS, "ToDS" ) ,( FromDS, "FromDS" ) ,( MoreFragments, "MoreFragments" ) ,( Retry, "Retry" ) ,( PowerManagement, "PowerManagement" ) ,( MoreData, "MoreData" ) ,( Protected, "Protected" ) ,( Order, "Order" )] -- Bytes 2,3 -- Duration/ID field -- -- This field is of size 16 bits. It carries following fields. -- -- • In control type frames of subtype Power Save (PS)-Poll, the Duration/ID -- field carries the association identity (AID) of the station that transmitted -- the frame in the 14 least significant bits (LSB), with the 2 most -- significant bits (MSB) both set to 1. AID value varies between values from 1 -- to 2007. -- -- • In all the other frames, this field contains duration value as specified -- for each of the frame. For all the frames transmitted during the CFP -- (contention free time period) this field is set to 32,768. If the content of -- this field is less than 32768, it is used to update NAV (Network Allocation -- Vector). newtype DurationID = DurationID Word16 deriving (Eq,Ord,Read,Show) instance Parse DurationID where parse = DurationID <$> parse -- (big endian) -- Bytes 4-(21/27) (+18 or +24 bytes long) -- -- Wikipedia claimed: Address 1 is the receiver, Address 2 is the transmitter, -- Address 3 is used for filtering purposes by the receiver.[dubious – discuss] -- -- But http://www.rfwireless-world.com/Articles/WLAN-MAC-layer-protocol.html -- says: -- -- ToDS FromDS addr1 addr2 addr3 addr4 -- ---- ------ ----- ----- ----- ----- -- 0 0 DA SA BSSID - -- 0 1 DA BSSID SA - -- 1 0 BSSID SA DA - -- 1 1 RA TA DA SA -- -- DataFrames: -- -- http://www.rfwireless-world.com/images/WLAN-MAC-Data-Frame.jpg -- -- Note 1: The address-1 always holds the RA(Receiver Address) of the intended -- receiver or receivers(e.g. in multicast operation). Note 2 : The address-2 -- always holds the address of STA which is transmitting the MAC frame. data Addresses = Addresses { bssid :: Maybe Mac.Addr -- BSSID , srcAddr :: Mac.Addr -- SA , dstAddr :: Mac.Addr -- DA , txAddr :: Maybe Mac.Addr -- TA , rxAddr :: Maybe Mac.Addr -- RA } deriving (Eq,Ord,Show) parseAddresses :: Flags -> PacketParser Addresses parseAddresses fc = case fc .&. (ToDS .|. FromDS) of Flags 0 -> do -- 0 0 DA SA BSSID - _da <- parse _sa <- parse _bssid <- parse return Addresses { bssid = Just _bssid , srcAddr = _sa , dstAddr = _da , txAddr = Nothing , rxAddr = Nothing } FromDS -> do -- 0 1 DA BSSID SA - _da <- parse _bssid <- parse _sa <- parse return Addresses { bssid = Just _bssid , srcAddr = _sa , dstAddr = _da , txAddr = Nothing , rxAddr = Nothing } ToDS -> do -- 1 0 BSSID SA DA - _bssid <- parse _sa <- parse _da <- parse return Addresses { bssid = Just _bssid , srcAddr = _sa , dstAddr = _da , txAddr = Nothing , rxAddr = Nothing } Flags 0x03 -> do -- 1 1 RA TA DA SA _ra <- parse _ta <- parse _da <- parse -- http://www.rfwireless-world.com/Articles/WLAN-MAC-layer-protocol-p2.html -- indicates that there is a SequenceControl field here. _sa <- parse return Addresses { bssid = Nothing , srcAddr = _sa , dstAddr = _da , txAddr = Just _ta , rxAddr = Just _ra } -- Bytes 22/28-23/29 (2 bytes) -- -- The Sequence Control field. -- -- A two-byte section used for identifying message order as well as eliminating -- duplicate frames. The first 4 bits are used for the fragmentation number, -- and the last 12 bits are the sequence number. newtype SequenceControl = SequenceControl Word16 deriving (Eq,Ord,Read,Show) instance Parse SequenceControl where parse = SequenceControl <$> parse -- (big endian) -- Optional: Bytes 24/30 - 25/31 -- -- An optional two-byte Quality of Service control field that was added with 802.11e. newtype QoS = QoS Word16 deriving (Eq,Ord,Read,Show) -- Bytes 24/30 (802.11e maybe 26/32) - ? variable length -- -- Frame Body -- Last 4 bytes. -- -- FCS -- -- Wikipedia cites https://wayback.archive.org/web/20090124151617/http://wifi.cs.st-andrews.ac.uk/wififrame.html -- -- From http://www.rfwireless-world.com/Articles/WLAN-MAC-layer-protocol.html -- -- The WLAN FCS field is a 32-bit field containing a 32-bit CRC. The FCS is -- calculated over all the fields of the MAC header and the Frame Body field. -- These are referred to as the calculation fields. -- -- The FCS is calculated using the following standard generator polynomial of -- degree 32: G(x) = x³² + x²⁶ + x²³ + x²² + x¹⁶ + x¹² + x¹¹ + x¹⁰ + x⁸ + x⁷ + -- x⁵ + x⁴ + x² + x + 1 -- -- The FCS is the 1's complement of the sum (modulo 2) of the following: -- -- • The remainder of xk * (x³¹+x³⁰+x²⁹+...+x² + x + 1) divided (modulo 2) by -- G(x), where k is the number of bits in the calculation fields. -- -- • The remainder after multiplication of the contents (treated as a -- polynomial) of the calculation fields by x³² and then division by G(x) newtype FCS = FCS Word32 deriving (Eq,Ord,Read,Show) data Packet a = Packet { wifiType :: Type , subtype :: SubType , flags :: Flags , duration :: DurationID , addresses :: Addresses , sequenceControl :: SequenceControl , qos :: Maybe QoS , llcsnap :: Maybe LLCSNAP , content :: a , fcs :: Maybe FCS } deriving (Eq,Ord,Show) -- Hardcoded flag to disable parsing FCS checksum. hasFCS :: Bool hasFCS = False -- DLT_IEEE802_11 has no trailing 4-byte FCS checksum -- -- Other link types might include this: -- See: DLT_IEEE802_11_RADIO -- or DLT_IEEE802_11_RADIO_AVS instance Parse (Packet InPacket) where parse = do Just (typ,subtyp) <- wifiTypeBits <$> word8 flgs <- Flags <$> word8 durid <- DurationID <$> word16 addrs <- parseAddresses flgs sc <- SequenceControl <$> word16 -- TODO: Sometimes this precedes the 4th address. qos <- if typ == Data && subtyp > SubType7 then Just . QoS <$> parse else return Nothing llcsnap <- case typ of Data -> Just <$> parse _ -> return Nothing rst <- therest let (payload,fcs) = if hasFCS then let payload = takeInPack (len rst - 4) rst fcshi = rst `wordAt` (len rst - 4) fcslo = rst `wordAt` (len rst - 2) fcs = FCS $ fromIntegral fcshi * 65536 + fromIntegral fcslo in (payload,Just fcs) else (rst,Nothing) return Packet { wifiType = typ , subtype = subtyp , flags = flgs , duration = durid , addresses = addrs , sequenceControl = sc , qos = qos , llcsnap = llcsnap , content = payload , fcs = fcs }