path: root/dht/readpackets.hs

{-# 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 ++ "."