{-# LANGUAGE PackageImports #-} {-# LANGUAGE StandaloneDeriving #-} module Main where import Control.Arrow import Data.Maybe import Data.Binary.Get (runGet) import qualified Data.ByteString as BS import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LZ import qualified Data.ByteString.Lazy.Char8 as L8 import Data.IORef import Data.List import Data.Word import Debug.Trace import Text.Printf import Text.Show.Pretty as PP import "network-house" Net.Packet as House import qualified "network-house" Net.IPv4 as IP4 import qualified "network-house" Net.IPv6 as IP6 import "network-house" Net.PacketParsing as House import "network-house" Net.PortNumber as TCP import "network-house" Net.ICMP as ICMP import "network-house" Net.TCP as TCP import "network-house" Net.UDP as UDP import "pcap" Network.Pcap import qualified Data.Serialize as S import qualified Network.Socket as HS import Control.Applicative import Control.Monad import System.Environment import Control.Exception import Hans.Checksum import WifiHeader as Wifi import Crypto.Tox import Network.Tox.DHT.Transport as Tox import Data.BEncode as BE import Data.BEncode.Pretty -- import Data.IKE.Message import Text.XXD -- traceM string = trace string $ return () -- IPv4 : rfc 791 -- IPv6 : rfc 2460 (8200) -- TCP : rfc 793 -- UDP : rfc 768 -- ICMP : rfc 792 -- ICMPv6 : rfc 4443 -- ARP : rfc 826 -- SNAP : rfc 1042 deriving instance Show IP6.Word4 deriving instance Show IP6.Word20 deriving instance Show IP6.Addr deriving instance Show a => Show (IP6.Packet a) bs2chunk :: BS.ByteString -> UArray Int Word8 bs2chunk bs = listArray (0,subtract 33 $ BS.length bs) $ drop 32 $ BS.unpack bs -- 23 + 9 = 32 mkchunk :: Int -> BS.ByteString -> Maybe (UArray Int Word8) mkchunk n bs | (BS.length bs < n) = Nothing | otherwise = Just $ listArray (0,subtract (n+1) $ BS.length bs) $ drop n $ BS.unpack bs {- hex :: BS.ByteString -> String hex = concatMap (printf "%02x") . B.unpack hexlines :: BS.ByteString -> [String] hexlines bs = ss where xs = zip [0..] $ hex bs ls = groupBy (\(n,_) (m,_)-> n `div` 32 == m `div` 32) xs ss = map (map snd) ls -} udpPacket :: PktHdr -> BS.ByteString -> Maybe (IO ()) udpPacket hdr buf = do chunk <- mkchunk 32 buf udp <- House.doParse $ House.toInPack chunk -- traceM $ "got udp: " ++ show udp -- traceM $ "got udp content: " ++ show (content udp) let plen = House.len $ UDP.content udp bs <- fmap BS.pack . parseInPacket (bytes plen) $ UDP.content udp -- traceM $ "Got bs " ++ show bs (checksum,blob) <- Just $ BS.splitAt 2 bs -- extra 2 bytes in pcap capture, i'm assuming its a checksum -- (first4,truncated) = BS.splitAt 4 blob -- -- First 4 bytes being zero is how we distinguish between -- -- ESP and IKEv2 packets on port 4500. -- dta = if destPort udp /= Port 500 && first4==BS.pack [0,0,0,0] -- then truncated -- else blob Just $ do putStrLn $ "UDP." ++ show udp mapM_ putStrLn $ xxd2 0 blob parseIP4 :: InPacket -> Maybe (IP4.Packet InPacket) parseIP4 inpkt = do ip <- House.doParse inpkt 4 <- Just $ IP4.version ip return ip ipPacket4 :: PktHdr -> BS.ByteString -> Maybe (IO ()) ipPacket4 hdr buf = do chunk <- mkchunk 23 buf ip <- parseIP4 $ House.toInPack chunk Just $ do putStrLn $ "-- ipPacket4 --" putStrLn $ "IP4." ++ show ip parseIP6 :: InPacket -> Maybe (IP6.Packet InPacket) parseIP6 inpkt = do ip <- House.doParse inpkt IP6.Word4 6 <- Just $ IP6.version ip return ip ipPacket6 :: PktHdr -> BS.ByteString -> Maybe (IO ()) ipPacket6 hdr buf = do chunk <- mkchunk 23 buf ip <- parseIP6 $ House.toInPack chunk Just $ do putStrLn $ "-- ipPacket6 --" putStrLn $ "IP6." ++ show ip showTruncated hdr s | hdrCaptureLength hdr == hdrWireLength hdr = s | otherwise = unwords [ s , "(truncated" , show $ hdrCaptureLength hdr , "of" , show (hdrWireLength hdr) ++ ")" ] wifiPacket hdr buf = do (Data,_) <- wifiTypeBits $ BS.index buf 0 -- Filter all but data packets. guard (BS.length buf >= 28) chunk <- mkchunk 0 buf wifi <- House.doParse $ House.toInPack chunk Just $ do -- putStrLn $ "-- wifiPacket --" -- putStrLn $ "Wifi." ++ show wifi let parseip = do Wifi.Data <- Just $ wifiType wifi c <- Just $ Wifi.content wifi (Left <$> parseIP4 c) <|> (Right <$> parseIP6 c) let mdta = parseip >>= ipPacket forM_ mdta $ \dta -> do let src = saddr (left fst $ right fst $ ipAddrs dta) (fromMaybe 0 $ fst <$> ipPorts dta) dst = saddr (left snd $ right snd $ ipAddrs dta) (fromMaybe 0 $ snd <$> ipPorts dta) srcmac = Wifi.srcAddr (Wifi.addresses wifi) dstmac = Wifi.dstAddr (Wifi.addresses wifi) r = [ maybe "" (("bssid "++) . show) $ Wifi.bssid (Wifi.addresses wifi) , "<-- " ++ show src ++ " (" ++ show srcmac ++ ")" , "--> " ++ show dst ++ " (" ++ show dstmac ++ ")" , showTruncated hdr (ipProtocol dta) ] case ipPayload dta of Nothing -> mapM_ putStrLn r Just bs -> mapM_ putStrLn $ sideBySide (xxd2 0 bs) r putStrLn "" sideBySide (x:xs) (y:ys) = (take 72 (x ++ repeat ' ') ++ y) : sideBySide xs ys sideBySide [] (y:ys) = (replicate 72 ' ' ++ y) : sideBySide [] ys sideBySide xs [] = xs saddr (Left ip4) port = HS.SockAddrInet (fromIntegral port) addr where IP4.Addr a b c d = ip4 addr = fromIntegral a + fromIntegral b * 256 + fromIntegral c * 65536 + fromIntegral d * 16777216 saddr (Right ip6) port = HS.SockAddrInet6 (fromIntegral port) 0 addr 0 where IP6.Addr ah al bh bl ch cl dh dl = ip6 addr = ( fromIntegral ah * 65536 + fromIntegral al , fromIntegral bh * 65536 + fromIntegral bl , fromIntegral ch * 65536 + fromIntegral cl , fromIntegral dh * 65536 + fromIntegral dl ) data IPData = IPData { ipPayload :: Maybe BS.ByteString , ipProtocol :: String , ipPorts :: Maybe (Word16,Word16) , ipAddrs :: Either (IP4.Addr,IP4.Addr) (IP6.Addr,IP6.Addr) } ip4addrs pkt = (IP4.source pkt, IP4.dest pkt) ip6addrs pkt = (IP6.source pkt, IP6.dest pkt) ipPacket ip = do let udp = do IP4.UDP <- Just $ either IP4.protocol IP6.next_header ip pkt <- House.doParse $ either IP4.content IP6.content ip let ulen = House.len $ UDP.content pkt mbs = fmap BS.pack . parseInPacket (bytes ulen) $ UDP.content pkt let UDP.Port sport = UDP.sourcePort pkt UDP.Port dport = UDP.destPort pkt return IPData { ipPayload = mbs , ipProtocol = "UDP" , ipPorts = Just (sport,dport) , ipAddrs = either (Left . ip4addrs) (Right . ip6addrs) ip } tcp = do IP4.TCP <- Just $ either IP4.protocol IP6.next_header ip pkt <- House.doParse $ either IP4.content IP6.content ip let ulen = House.len $ TCP.content pkt mbs = fmap BS.pack . parseInPacket (bytes ulen) $ TCP.content pkt let TCP.Port sport = TCP.sourcePort pkt TCP.Port dport = TCP.destPort pkt return IPData { ipPayload = mbs , ipProtocol = "TCP" , ipPorts = Just (sport,dport) , ipAddrs = either (Left . ip4addrs) (Right . ip6addrs) ip } icmp = do IP4.ICMP <- Just $ either IP4.protocol IP6.next_header ip pkt <- House.doParse $ either IP4.content IP6.content ip let ping = do EchoRequest msg <- Just pkt return ("Ping", echoData msg) pong = do EchoReply msg <- Just pkt return ("Pong", echoData msg) other = do Other { type_ = typ, content = chunk } <- Just pkt return (show typ, chunk) (typ,chunk) <- ping <|> pong <|> other let p = House.toInPack chunk ulen = House.len p mbs = fmap BS.pack . parseInPacket (bytes ulen) $ p return IPData { ipPayload = mbs , ipProtocol = "ICMP "++typ , ipPorts = Nothing , ipAddrs = either (Left . ip4addrs) (Right . ip6addrs) ip } unknown = do IP4.Unknown proto <- Just $ either IP4.protocol IP6.next_header ip pkt <- Just $ either IP4.content IP6.content ip let ulen = House.len pkt mbs = fmap BS.pack . parseInPacket (bytes ulen) $ pkt return IPData { ipPayload = mbs , ipProtocol = "proto "++show proto , ipPorts = Nothing , ipAddrs = either (Left . ip4addrs) (Right . ip6addrs) ip } udp <|> icmp <|> tcp <|> unknown parsePacket :: IORef Int -> PktHdr -> BS.ByteString -> IO () parsePacket cnt hdr buf = do sequence_ $ wifiPacket hdr buf modifyIORef' cnt (+1) sampleHdr :: PktHdr sampleHdr = PktHdr {hdrSeconds = 1511875620, hdrUseconds = 464364, hdrCaptureLength = 347, hdrWireLength = 347} sampleBytes :: BS.ByteString sampleBytes = "\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" sampleHdr2 = PktHdr {hdrSeconds = 1511841845, hdrUseconds = 681965, hdrCaptureLength = 10, hdrWireLength = 10} sampleBytes2 = [ 0xc4, 0x00, 0x8a, 0x00 , 0x8c, 0xf5, 0xa3, 0x12, 0xdf, 0x80 ] main = do args <- getArgs forM_ args $ \fname -> do cnt <- newIORef 0 parsePacket cnt sampleHdr sampleBytes pcap <- openOffline fname -- "packets.pcap" linktype <- datalink pcap putStrLn $ unwords ["Opened:",fname,"Link:",show linktype] -- Opened: opnwep.dat-08.cap Link: DLT_IEEE802_11 -- Opened: packets.pcap Link: DLT_EN10MB -- DLT_IEEE802_11 -- DLT_IEEE802_11_RADIO -- DLT_IEEE802_11_RADIO_AVS loopResult <- loopBS pcap (-1) $ parsePacket cnt pktcnt <- readIORef cnt putStrLn $ "read "++show pktcnt ++" packets from " ++ fname ++ "."