mvclient-0.2: other/LogTranslate.hs

{-
    Takes saved hex dump files from Wireshark's "Follow UDP Stream", then
    attempts to guess where they break up into packets, and converts to a
    readable format with message names.

    This is the primary tool I've used to reverse engineer the protocol.
-}
module Main where

import Control.Monad

import Network.Metaverse.Circuit
import System.Environment
import Data.Word

import qualified Data.ByteString as B

dumpToBytes :: String -> (Bool, [Word8])
dumpToBytes str = (receiving,
                   map (read . ("0x" ++)) $ drop 1 $ words $ take 59 str1)
    where receiving   = (head str == ' ')
          str1        = if receiving then drop 4 str else str
          dropEnd n s = take (length s - n) s

-- Chunk lines to packets... There are hueristics used here to guess
-- packet boundaries, since Wireshark does not save them well.  They are:
--
-- (1) The transition between sending lines and receiving lines always
--     marks a packet boundary.
--
-- (2) If the length of this line is less than 7 bytes, it can NOT be a new
--     packet, *and* it must be the end of the old packet.
-- 
-- (3) If the line contains a first byte with zeros for its lower 4 bits,
--     the sequence number in bytes 1-5 is within 20 of the last seen sequence,
--     a there is a zero at position 6, then we decide this looks like a
--     packet header, and break it there.
--
-- (4) If the line is less than a full 16 bytes, we know it's the end of
--     a packet.

chunk :: Int -> Int -> [(Bool, [Word8])] -> [(Bool, [Word8])]
chunk inseq outseq []  = []
chunk inseq outseq lns = chunk' [] (fst (head lns)) lns
  where
    chunk' :: [Word8] -> Bool -> [(Bool, [Word8])] -> [(Bool, [Word8])]
    chunk' cur oldrecv ((recv, bytes) : tail)
        | recv /= oldrecv   = (oldrecv, cur) : chunk nin nout ((recv, bytes) : tail)
        | length bytes < 8  = (oldrecv, cur ++ bytes) : chunk nin nout tail
        | cur /= []
            && ((bytes !! 0) `mod` 16 == 0)
            && abs (seqdecode bytes 1 - lastseq) < 2
            && ((bytes !! 5) == 0)
                            = (oldrecv, cur) : chunk nin nout ((recv, bytes) : tail)
        | length bytes < 16 = (oldrecv, cur ++ bytes) : chunk nin nout tail
        | otherwise         = chunk' (cur ++ bytes) recv tail
        where nin       | oldrecv        = seqdecode seqsource 1
                        | otherwise      = inseq
              nout      | oldrecv        = outseq
                        | otherwise      = seqdecode seqsource 1
              seqsource | cur == [] = bytes
                        | otherwise = cur
              lastseq   | oldrecv   = inseq
                        | otherwise = outseq
    seqdecode bs i = fromIntegral (bs !! i) * 16777216
                   + fromIntegral (bs !! (i+1)) * 65536
                   + fromIntegral (bs !! (i+2)) * 256
                   + fromIntegral (bs !! (i+3))

main = do
    [ logfile ] <- getArgs
    txt         <- readFile logfile
    let lns = map dumpToBytes (filter (not . null) $ lines txt)
    mapM_ print (take 40 lns)
    let packets = map (\(r,p) -> (r, deserialize (B.pack p))) (chunk 1 1 lns)
    mapM_ print (take 20 packets)
    forM_ packets $ \(r,p) -> appendFile (logfile ++ ".out") $
        if r then "<<< " ++ show p ++ "\n" else ">>> " ++ show p ++ "\n"