[Haskell-cafe] Reading pcap file

mukesh tiwari mukeshtiwari.iiitm at gmail.com
Sun Oct 16 14:50:43 CEST 2011


Sorry everyone for cross posting. I was trying to send it on some
other forum  but some how i missed the email id.
Regards
Mukesh Tiwari

On Oct 16, 5:47 pm, mukesh tiwari <mukeshtiwari.ii... at gmail.com>
wrote:
> Hello everyone
> I am writing  application which reads pcap file like wireshark in pure
> haskell but there is some thing missing. I read this filehttp://www.viste.com/Linux/Server/WireShark/libpcapformat.pdf<http://www.google.com/url?sa=D&q=http://www.viste.com/Linux/Server/Wi...>
>
> and it say that first 24 bytes are global headers , after that every packet
>  contains pcap local header and data. What i am trying to do is ,
> first trying to get the bytes of data in  each packet by reading the third
> field incl_len in local header but my code is not behaving as it suppose . I
> am not getting the list of parsed packets . My test libcap file ishttp://wiki.wireshark.org/SampleCaptures?action=AttachFile&do=view&ta...<http://www.google.com/url?sa=D&q=http://wiki.wireshark.org/SampleCapt...>
>
> --http://www.viste.com/Linux/Server/WireShark/libpcapformat.pdf<http://www.google.com/url?sa=D&q=http://www.viste.com/Linux/Server/Wi...>
>
> --http://hackage.haskell.org/packages/archive/bytestring/0.9.0.4/doc/<http://www.google.com/url?sa=D&q=http://hackage.haskell.org/packages/...>
>
> html/Data-ByteString-Lazy.html
> import Data.List
> import qualified Data.ByteString.Lazy as BS
> import qualified Data.ByteString.Lazy.Char8 as B
> import Control.Monad
> import Text.Printf
> import Data.Word
> import Data.Char
> import System.Time
> import Numeric
> import System.Environment
>
> hexTodec :: BS.ByteString ->  Integer
> hexTodec lst = read $   "0x" ++  (  concatMap ( \x -> showHex x "" )
> $ BS.unpack lst  )
>
> parseFile :: BS.ByteString -> Bool -> IO [ BS.ByteString ]
> parseFile xs revflag
>   | BS.null xs = return []
>   | otherwise =   do
>         let ind =if revflag then   hexTodec . BS.reverse . BS.take 4 .
> BS.drop 8 $ xs
>                   else hexTodec  . BS.take 4 . BS.drop 8 $ xs
>         print ind
>         let ( x , ys ) = BS.splitAt  ( fromIntegral ind  )  xs
>         --BS.putStrLn $ x
>         tmp <- parseFile ys revflag
>         return $ x : tmp
>
> main = do
>         [ file ]  <- getArgs
>         contents  <- BS.readFile file
>         let ( a , rest ) =  BS.splitAt 24  contents  --strip global header
>
>         let revflag = case BS.unpack $ BS.take 4  a of
>                         [ 0xd4 , 0xc3 , 0xb2 , 0xa1 ] -> True
>                         _ -> False
>         p <-   parseFile  rest  revflag
>         print $ p !! 0
>         BS.putStr $  p !! 0
>
> Regards
> Mukesh Tiwari
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-C... at haskell.orghttp://www.haskell.org/mailman/listinfo/haskell-cafe



More information about the Haskell-Cafe mailing list