SHARE
TWEET

Parsing pcap files

edv Dec 26th, 2011 138 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. {- Karol Samborski <edv.karol@gmail.com> -}
  2. module Main where
  3.  
  4. import System.Environment
  5. import System.Time
  6. import Control.Applicative
  7. import Network.Pcap
  8. import Data.List
  9. import qualified Data.ByteString.Char8 as BS
  10.  
  11. data Options = Options { filename :: FilePath, quoteOrder :: Bool }
  12. data AcceptTime = AcceptTime {
  13.       hh :: BS.ByteString
  14.     , mm :: BS.ByteString
  15.     , ss :: BS.ByteString
  16.     , uu :: BS.ByteString
  17.     }
  18.  
  19. instance Show AcceptTime where
  20.     show (AcceptTime h m s u) = (BS.unpack h) ++ ":"
  21.                                               ++ (BS.unpack m)
  22.                                               ++ ":"
  23.                                               ++ (BS.unpack s)
  24.                                               ++ "."
  25.                                               ++ (BS.unpack u)
  26.  
  27. instance Eq AcceptTime where
  28.     (==) a1 a2 = t1 == t2
  29.       where
  30.         t1 = BS.append (hh a1) $ BS.append (mm a1) $ BS.append (ss a1) (uu a1)
  31.         t2 = BS.append (hh a2) $ BS.append (mm a2) $ BS.append (ss a2) (uu a2)
  32.  
  33. instance Ord AcceptTime where
  34.     compare a1 a2 = if t1 > t2 then GT else if t1 < t2 then LT else EQ
  35.       where
  36.         t1 = BS.append (hh a1) $ BS.append (mm a1) $ BS.append (ss a1) (uu a1)
  37.         t2 = BS.append (hh a2) $ BS.append (mm a2) $ BS.append (ss a2) (uu a2)
  38.  
  39.  
  40. data MarketData = MarketData {
  41.       issueCode  :: BS.ByteString
  42.     , bids       :: [(BS.ByteString, BS.ByteString)]
  43.     , asks       :: [(BS.ByteString, BS.ByteString)]
  44.     , acceptTime :: AcceptTime
  45.     }
  46.  
  47. instance Show MarketData where
  48.     show (MarketData i b a t) = (show t)
  49.         ++ " " ++ (BS.unpack i)
  50.         ++ " " ++ (drop 1 $ foldr (\(ty, pr) ac ->
  51.             "@" ++ (BS.unpack ty) ++ "@" ++ (BS.unpack pr) ++ ac) [] b)
  52.         ++ " " ++ (drop 1 $ foldr (\(ty, pr) ac ->
  53.             "@" ++ (BS.unpack ty) ++ "@" ++ (BS.unpack pr) ++ ac) [] a)
  54.  
  55. parseData :: BS.ByteString
  56.           -> MarketData
  57. parseData line = MarketData (BS.take 12 l) _bids _asks (AcceptTime h m s u)
  58.   where
  59.     l = BS.drop 5 line
  60.     (_bids, r1) = takeBids $ BS.drop 24 l
  61.     (_asks, r2) = takeAsks $ BS.drop 7 r1
  62.     (h, r3) = BS.splitAt 2 (BS.take 8 $ BS.drop 50 r2)
  63.     (m, r4) = BS.splitAt 2 r3
  64.     (s, u) = BS.splitAt 2 r4
  65.  
  66. takeBids :: BS.ByteString
  67.          -> ([(BS.ByteString, BS.ByteString)], BS.ByteString)
  68. takeBids bs = takeBids' bs (5::Integer)
  69.   where
  70.     takeBids' b n
  71.         | n > 0     = let (_b, _r) = takeBids' (BS.drop 12 b) (n-1)
  72.                       in (_b ++ [(BS.splitAt 5 $ BS.take 12 b)], _r)
  73.         | otherwise = ([], b)
  74.  
  75. takeAsks :: BS.ByteString
  76.          -> ([(BS.ByteString, BS.ByteString)], BS.ByteString)
  77. takeAsks bs = takeAsks' bs (5::Integer)
  78.   where
  79.     takeAsks' b n
  80.         | n > 0     = let (_b, _r) = takeAsks' (BS.drop 12 b) (n-1)
  81.                       in ((BS.splitAt 5 $ BS.take 12 b):_b, _r)
  82.         | otherwise = ([], b)
  83.  
  84. prefix :: BS.ByteString
  85. prefix = (BS.pack "B6034")
  86.  
  87. showData :: PktHdr
  88.          -> BS.ByteString
  89.          -> IO ()
  90. showData hdr dat = do
  91.     let (_, _d) = BS.breakSubstring prefix dat
  92.         (sec, msec) = (hdrTime hdr) `divMod` 1000000
  93.     if (BS.length _d) > 0
  94.         then putStrLn $ (show $ TOD (toInteger sec) (toInteger (msec*1000000)))
  95.             ++ " " ++ (show $ parseData _d)
  96.         else return ()
  97.  
  98. getData :: PktHdr
  99.         -> BS.ByteString
  100.         -> (CalendarTime,MarketData)
  101. getData hdr dat = (toUTCTime $ TOD (toInteger sec) (toInteger (msec*1000000)), parseData dat)
  102.   where
  103.     (sec, msec) = (hdrTime hdr) `divMod` 1000000
  104.  
  105. nextBS' :: PcapHandle
  106.         -> IO (PktHdr,BS.ByteString)
  107. nextBS' h = do
  108.     (hdr, dat) <- nextBS h
  109.     let (_, _d) = BS.breakSubstring prefix dat
  110.     if (hdrCaptureLength hdr) == 0
  111.         then return (hdr, dat)
  112.         else if ((BS.length _d) > 0)
  113.             then return (hdr,_d)
  114.             else nextBS' h
  115.  
  116. compareData :: (CalendarTime,MarketData)
  117.             -> (CalendarTime,MarketData)
  118.             -> Ordering
  119. compareData (_,m1) (_,m2) = if (a1 > a2)
  120.     then GT
  121.     else if (a1 < a2)
  122.         then LT
  123.         else EQ
  124.   where
  125.     a1 = acceptTime m1
  126.     a2 = acceptTime m2
  127.  
  128. readSortQuote :: Int
  129.               -> [(CalendarTime,MarketData)]
  130.               -> PcapHandle
  131.               -> IO ()
  132. readSortQuote sec buf h = do
  133.     (hdr, dat) <- nextBS' h
  134.     let rec@(t,_dat) = getData hdr dat
  135.     if (hdrCaptureLength hdr) == 0
  136.         then mapM_ (\(_t, _m) ->
  137.             putStrLn $ (calendarTimeToString _t) ++ " " ++ show _m)
  138.                      $ sortBy compareData buf
  139.         else if (ctSec t) > (sec + 3)
  140.             then let (s,r) = break (\(time,_) -> (ctSec time) > sec)
  141.                              $ sortBy compareData buf
  142.                  in mapM_ (\(_t, _m) ->
  143.                     putStrLn $ (calendarTimeToString _t) ++ " " ++ show _m) s
  144.                     >> readSortQuote (ctSec $ fst $ head r) (r++[rec]) h
  145.             else readSortQuote sec (buf++[rec]) h
  146.  
  147. readQuote :: Bool
  148.           -> PcapHandle
  149.           -> IO ()
  150. readQuote False h = dispatchBS h (-1) showData >> return ()
  151. readQuote True h = do
  152.     (_hdr, _dat) <- nextBS' h
  153.     let first@(time,_) = getData _hdr _dat
  154.     readSortQuote (ctSec time) [first] h
  155.  
  156. main :: IO ()
  157. main = do
  158.     opt <- liftA parseOptions getArgs
  159.     hdl <- openOffline $ filename opt
  160.     readQuote (quoteOrder opt) hdl
  161.  
  162. parseOptions :: [String]
  163.              -> Options
  164. parseOptions [] = Options "" False
  165. parseOptions (x:xs)
  166.     | x == "-r" = Options (head xs) True
  167.     | otherwise = Options x False
RAW Paste Data
Top