module Network.Pcap
(
PcapHandle
, DumpHandle
, BpfProgram
, Callback
, CallbackBS
, Direction(..)
, Link(..)
, Interface(..)
, PcapAddr(..)
, SockAddr(..)
, Network(..)
, PktHdr(..)
, Statistics(..)
, openOffline
, openLive
, openDead
, openDump
, setFilter
, compileFilter
, lookupDev
, findAllDevs
, lookupNet
, setNonBlock
, getNonBlock
, setDirection
, datalink
, setDatalink
, listDatalinks
, dispatch
, loop
, next
, dump
, dispatchBS
, loopBS
, nextBS
, dumpBS
, sendPacket
, sendPacketBS
, toBS
, hdrTime
, hdrDiffTime
, statistics
, version
, isSwapped
, snapshotLen
) where
#ifdef BYTESTRING_IN_BASE
import qualified Data.ByteString.Base as B
import qualified Data.ByteString.Base as BU
#else
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Unsafe as BU
#endif
import Data.Int (Int64)
import Data.Time.Clock (DiffTime, picosecondsToDiffTime)
import Data.Word (Word8, Word32)
import Foreign.Ptr (Ptr, castPtr)
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import qualified Network.Pcap.Base as P
import Network.Pcap.Base (BpfProgram, Callback, Interface(..), Link(..),
Network(..), Direction(..),
PcapAddr(..), PktHdr(..), SockAddr(..), Statistics,
compileFilter, findAllDevs, lookupDev, lookupNet)
newtype PcapHandle = PcapHandle (ForeignPtr P.PcapTag)
newtype DumpHandle = DumpHandle (ForeignPtr P.PcapDumpTag)
type CallbackBS = PktHdr -> B.ByteString -> IO ()
openOffline :: FilePath
-> IO PcapHandle
openOffline :: FilePath -> IO PcapHandle
openOffline = (ForeignPtr PcapTag -> PcapHandle)
-> IO (ForeignPtr PcapTag) -> IO PcapHandle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ForeignPtr PcapTag -> PcapHandle
PcapHandle (IO (ForeignPtr PcapTag) -> IO PcapHandle)
-> (FilePath -> IO (ForeignPtr PcapTag))
-> FilePath
-> IO PcapHandle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (ForeignPtr PcapTag)
P.openOffline
openLive :: String
-> Int
-> Bool
-> Int64
-> IO PcapHandle
openLive :: FilePath -> Int -> Bool -> Int64 -> IO PcapHandle
openLive FilePath
name Int
snaplen Bool
promisc Int64
timeout =
let timeout' :: Int
timeout' | Int64
timeout Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0 = Int
0
| Bool
otherwise = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
timeout Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
1000)
in ForeignPtr PcapTag -> PcapHandle
PcapHandle (ForeignPtr PcapTag -> PcapHandle)
-> IO (ForeignPtr PcapTag) -> IO PcapHandle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` FilePath -> Int -> Bool -> Int -> IO (ForeignPtr PcapTag)
P.openLive FilePath
name Int
snaplen Bool
promisc Int
timeout'
openDead :: Link
-> Int
-> IO PcapHandle
openDead :: Link -> Int -> IO PcapHandle
openDead Link
link Int
snaplen = ForeignPtr PcapTag -> PcapHandle
PcapHandle (ForeignPtr PcapTag -> PcapHandle)
-> IO (ForeignPtr PcapTag) -> IO PcapHandle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Link -> Int -> IO (ForeignPtr PcapTag)
P.openDead Link
link Int
snaplen
{-# INLINE withPcap #-}
withPcap :: PcapHandle -> (Ptr P.PcapTag -> IO a) -> IO a
withPcap :: PcapHandle -> (Ptr PcapTag -> IO a) -> IO a
withPcap (PcapHandle ForeignPtr PcapTag
hdl) = ForeignPtr PcapTag -> (Ptr PcapTag -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PcapTag
hdl
{-# INLINE withDump #-}
withDump :: DumpHandle -> (Ptr P.PcapDumpTag -> IO a) -> IO a
withDump :: DumpHandle -> (Ptr PcapDumpTag -> IO a) -> IO a
withDump (DumpHandle ForeignPtr PcapDumpTag
hdl) = ForeignPtr PcapDumpTag -> (Ptr PcapDumpTag -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PcapDumpTag
hdl
openDump :: PcapHandle
-> FilePath
-> IO DumpHandle
openDump :: PcapHandle -> FilePath -> IO DumpHandle
openDump PcapHandle
pch FilePath
name = PcapHandle -> (Ptr PcapTag -> IO DumpHandle) -> IO DumpHandle
forall a. PcapHandle -> (Ptr PcapTag -> IO a) -> IO a
withPcap PcapHandle
pch ((Ptr PcapTag -> IO DumpHandle) -> IO DumpHandle)
-> (Ptr PcapTag -> IO DumpHandle) -> IO DumpHandle
forall a b. (a -> b) -> a -> b
$ \Ptr PcapTag
hdl ->
ForeignPtr PcapDumpTag -> DumpHandle
DumpHandle (ForeignPtr PcapDumpTag -> DumpHandle)
-> IO (ForeignPtr PcapDumpTag) -> IO DumpHandle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr PcapTag -> FilePath -> IO (ForeignPtr PcapDumpTag)
P.openDump Ptr PcapTag
hdl FilePath
name
setFilter :: PcapHandle
-> String
-> Bool
-> Word32
-> IO ()
setFilter :: PcapHandle -> FilePath -> Bool -> Word32 -> IO ()
setFilter PcapHandle
pch FilePath
filt Bool
opt Word32
mask = PcapHandle -> (Ptr PcapTag -> IO ()) -> IO ()
forall a. PcapHandle -> (Ptr PcapTag -> IO a) -> IO a
withPcap PcapHandle
pch ((Ptr PcapTag -> IO ()) -> IO ())
-> (Ptr PcapTag -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PcapTag
hdl ->
Ptr PcapTag -> FilePath -> Bool -> Word32 -> IO ()
P.setFilter Ptr PcapTag
hdl FilePath
filt Bool
opt Word32
mask
setNonBlock :: PcapHandle
-> Bool
-> IO ()
setNonBlock :: PcapHandle -> Bool -> IO ()
setNonBlock PcapHandle
pch Bool
block = PcapHandle -> (Ptr PcapTag -> IO ()) -> IO ()
forall a. PcapHandle -> (Ptr PcapTag -> IO a) -> IO a
withPcap PcapHandle
pch ((Ptr PcapTag -> IO ()) -> IO ())
-> (Ptr PcapTag -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PcapTag
hdl -> Ptr PcapTag -> Bool -> IO ()
P.setNonBlock Ptr PcapTag
hdl Bool
block
getNonBlock :: PcapHandle -> IO Bool
getNonBlock :: PcapHandle -> IO Bool
getNonBlock PcapHandle
pch = PcapHandle -> (Ptr PcapTag -> IO Bool) -> IO Bool
forall a. PcapHandle -> (Ptr PcapTag -> IO a) -> IO a
withPcap PcapHandle
pch Ptr PcapTag -> IO Bool
P.getNonBlock
setDirection :: PcapHandle -> Direction -> IO ()
setDirection :: PcapHandle -> Direction -> IO ()
setDirection PcapHandle
pch Direction
dir = PcapHandle -> (Ptr PcapTag -> IO ()) -> IO ()
forall a. PcapHandle -> (Ptr PcapTag -> IO a) -> IO a
withPcap PcapHandle
pch ((Ptr PcapTag -> IO ()) -> IO ())
-> (Ptr PcapTag -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PcapTag
hdl -> Ptr PcapTag -> Direction -> IO ()
P.setDirection Ptr PcapTag
hdl Direction
dir
{-# INLINE hdrTime #-}
hdrTime :: PktHdr -> Int64
hdrTime :: PktHdr -> Int64
hdrTime PktHdr
pkt = Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PktHdr -> Word32
hdrSeconds PktHdr
pkt) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1000000 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+
Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PktHdr -> Word32
hdrUseconds PktHdr
pkt)
hdrDiffTime :: PktHdr -> DiffTime
hdrDiffTime :: PktHdr -> DiffTime
hdrDiffTime PktHdr
pkt = Integer -> DiffTime
picosecondsToDiffTime (Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PktHdr -> Int64
hdrTime PktHdr
pkt) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000000)
wrapBS :: CallbackBS -> Callback
wrapBS :: CallbackBS -> Callback
wrapBS CallbackBS
f PktHdr
hdr Ptr Word8
ptr = do
let len :: Word32
len = PktHdr -> Word32
hdrCaptureLength PktHdr
hdr
ByteString
bs <- Int -> (Ptr Word8 -> IO ()) -> IO ByteString
B.create (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len) ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
B.memcpy Ptr Word8
p Ptr Word8
ptr (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len)
CallbackBS
f PktHdr
hdr ByteString
bs
dispatch :: PcapHandle
-> Int
-> Callback
-> IO Int
dispatch :: PcapHandle -> Int -> Callback -> IO Int
dispatch PcapHandle
pch Int
count Callback
f = PcapHandle -> (Ptr PcapTag -> IO Int) -> IO Int
forall a. PcapHandle -> (Ptr PcapTag -> IO a) -> IO a
withPcap PcapHandle
pch ((Ptr PcapTag -> IO Int) -> IO Int)
-> (Ptr PcapTag -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr PcapTag
hdl -> Ptr PcapTag -> Int -> Callback -> IO Int
P.dispatch Ptr PcapTag
hdl Int
count Callback
f
dispatchBS :: PcapHandle
-> Int
-> CallbackBS
-> IO Int
dispatchBS :: PcapHandle -> Int -> CallbackBS -> IO Int
dispatchBS PcapHandle
pch Int
count CallbackBS
f = PcapHandle -> (Ptr PcapTag -> IO Int) -> IO Int
forall a. PcapHandle -> (Ptr PcapTag -> IO a) -> IO a
withPcap PcapHandle
pch ((Ptr PcapTag -> IO Int) -> IO Int)
-> (Ptr PcapTag -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr PcapTag
hdl -> Ptr PcapTag -> Int -> Callback -> IO Int
P.dispatch Ptr PcapTag
hdl Int
count (CallbackBS -> Callback
wrapBS CallbackBS
f)
loop :: PcapHandle
-> Int
-> Callback
-> IO Int
loop :: PcapHandle -> Int -> Callback -> IO Int
loop PcapHandle
pch Int
count Callback
f = PcapHandle -> (Ptr PcapTag -> IO Int) -> IO Int
forall a. PcapHandle -> (Ptr PcapTag -> IO a) -> IO a
withPcap PcapHandle
pch ((Ptr PcapTag -> IO Int) -> IO Int)
-> (Ptr PcapTag -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr PcapTag
hdl -> Ptr PcapTag -> Int -> Callback -> IO Int
P.loop Ptr PcapTag
hdl Int
count Callback
f
loopBS :: PcapHandle
-> Int
-> CallbackBS
-> IO Int
loopBS :: PcapHandle -> Int -> CallbackBS -> IO Int
loopBS PcapHandle
pch Int
count CallbackBS
f = PcapHandle -> (Ptr PcapTag -> IO Int) -> IO Int
forall a. PcapHandle -> (Ptr PcapTag -> IO a) -> IO a
withPcap PcapHandle
pch ((Ptr PcapTag -> IO Int) -> IO Int)
-> (Ptr PcapTag -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr PcapTag
hdl -> Ptr PcapTag -> Int -> Callback -> IO Int
P.loop Ptr PcapTag
hdl Int
count (CallbackBS -> Callback
wrapBS CallbackBS
f)
sendPacket :: PcapHandle
-> Ptr Word8
-> Int
-> IO ()
sendPacket :: PcapHandle -> Ptr Word8 -> Int -> IO ()
sendPacket PcapHandle
pch Ptr Word8
buf Int
size = PcapHandle -> (Ptr PcapTag -> IO ()) -> IO ()
forall a. PcapHandle -> (Ptr PcapTag -> IO a) -> IO a
withPcap PcapHandle
pch ((Ptr PcapTag -> IO ()) -> IO ())
-> (Ptr PcapTag -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PcapTag
hdl -> Ptr PcapTag -> Ptr Word8 -> Int -> IO ()
P.sendPacket Ptr PcapTag
hdl Ptr Word8
buf Int
size
sendPacketBS :: PcapHandle
-> B.ByteString
-> IO ()
sendPacketBS :: PcapHandle -> ByteString -> IO ()
sendPacketBS PcapHandle
pch ByteString
s = ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
s ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
buf, Int
len) ->
PcapHandle -> Ptr Word8 -> Int -> IO ()
sendPacket PcapHandle
pch (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
buf) Int
len
toBS :: (PktHdr, Ptr Word8) -> IO (PktHdr, B.ByteString)
toBS :: (PktHdr, Ptr Word8) -> IO (PktHdr, ByteString)
toBS (PktHdr
hdr, Ptr Word8
ptr) = do
let len :: Word32
len = PktHdr -> Word32
hdrCaptureLength PktHdr
hdr
ByteString
s <- Int -> (Ptr Word8 -> IO ()) -> IO ByteString
B.create (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len) ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
B.memcpy Ptr Word8
p Ptr Word8
ptr (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len)
(PktHdr, ByteString) -> IO (PktHdr, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (PktHdr
hdr, ByteString
s)
next :: PcapHandle -> IO (PktHdr, Ptr Word8)
next :: PcapHandle -> IO (PktHdr, Ptr Word8)
next PcapHandle
pch = PcapHandle
-> (Ptr PcapTag -> IO (PktHdr, Ptr Word8))
-> IO (PktHdr, Ptr Word8)
forall a. PcapHandle -> (Ptr PcapTag -> IO a) -> IO a
withPcap PcapHandle
pch Ptr PcapTag -> IO (PktHdr, Ptr Word8)
P.next
nextBS :: PcapHandle -> IO (PktHdr, B.ByteString)
nextBS :: PcapHandle -> IO (PktHdr, ByteString)
nextBS PcapHandle
pch = PcapHandle
-> (Ptr PcapTag -> IO (PktHdr, Ptr Word8))
-> IO (PktHdr, Ptr Word8)
forall a. PcapHandle -> (Ptr PcapTag -> IO a) -> IO a
withPcap PcapHandle
pch Ptr PcapTag -> IO (PktHdr, Ptr Word8)
P.next IO (PktHdr, Ptr Word8)
-> ((PktHdr, Ptr Word8) -> IO (PktHdr, ByteString))
-> IO (PktHdr, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (PktHdr, Ptr Word8) -> IO (PktHdr, ByteString)
toBS
dump :: DumpHandle
-> Ptr PktHdr
-> Ptr Word8
-> IO ()
dump :: DumpHandle -> Ptr PktHdr -> Ptr Word8 -> IO ()
dump DumpHandle
dh Ptr PktHdr
hdr Ptr Word8
pkt = DumpHandle -> (Ptr PcapDumpTag -> IO ()) -> IO ()
forall a. DumpHandle -> (Ptr PcapDumpTag -> IO a) -> IO a
withDump DumpHandle
dh ((Ptr PcapDumpTag -> IO ()) -> IO ())
-> (Ptr PcapDumpTag -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PcapDumpTag
hdl -> Ptr PcapDumpTag -> Ptr PktHdr -> Ptr Word8 -> IO ()
P.dump Ptr PcapDumpTag
hdl Ptr PktHdr
hdr Ptr Word8
pkt
dumpBS :: DumpHandle
-> Ptr PktHdr
-> B.ByteString
-> IO ()
dumpBS :: DumpHandle -> Ptr PktHdr -> ByteString -> IO ()
dumpBS DumpHandle
dh Ptr PktHdr
hdr ByteString
s =
DumpHandle -> (Ptr PcapDumpTag -> IO ()) -> IO ()
forall a. DumpHandle -> (Ptr PcapDumpTag -> IO a) -> IO a
withDump DumpHandle
dh ((Ptr PcapDumpTag -> IO ()) -> IO ())
-> (Ptr PcapDumpTag -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PcapDumpTag
hdl ->
ByteString -> (Ptr CChar -> IO ()) -> IO ()
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BU.unsafeUseAsCString ByteString
s ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PcapDumpTag -> Ptr PktHdr -> Ptr Word8 -> IO ()
P.dump Ptr PcapDumpTag
hdl Ptr PktHdr
hdr (Ptr Word8 -> IO ())
-> (Ptr CChar -> Ptr Word8) -> Ptr CChar -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr
datalink :: PcapHandle -> IO Link
datalink :: PcapHandle -> IO Link
datalink PcapHandle
pch = PcapHandle -> (Ptr PcapTag -> IO Link) -> IO Link
forall a. PcapHandle -> (Ptr PcapTag -> IO a) -> IO a
withPcap PcapHandle
pch Ptr PcapTag -> IO Link
P.datalink
setDatalink :: PcapHandle -> Link -> IO ()
setDatalink :: PcapHandle -> Link -> IO ()
setDatalink PcapHandle
pch Link
link = PcapHandle -> (Ptr PcapTag -> IO ()) -> IO ()
forall a. PcapHandle -> (Ptr PcapTag -> IO a) -> IO a
withPcap PcapHandle
pch ((Ptr PcapTag -> IO ()) -> IO ())
-> (Ptr PcapTag -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PcapTag
hdl -> Ptr PcapTag -> Link -> IO ()
P.setDatalink Ptr PcapTag
hdl Link
link
listDatalinks :: PcapHandle -> IO [Link]
listDatalinks :: PcapHandle -> IO [Link]
listDatalinks PcapHandle
pch = PcapHandle -> (Ptr PcapTag -> IO [Link]) -> IO [Link]
forall a. PcapHandle -> (Ptr PcapTag -> IO a) -> IO a
withPcap PcapHandle
pch Ptr PcapTag -> IO [Link]
P.listDatalinks
statistics :: PcapHandle -> IO Statistics
statistics :: PcapHandle -> IO Statistics
statistics PcapHandle
pch = PcapHandle -> (Ptr PcapTag -> IO Statistics) -> IO Statistics
forall a. PcapHandle -> (Ptr PcapTag -> IO a) -> IO a
withPcap PcapHandle
pch Ptr PcapTag -> IO Statistics
P.statistics
version :: PcapHandle -> IO (Int, Int)
version :: PcapHandle -> IO (Int, Int)
version PcapHandle
pch = PcapHandle -> (Ptr PcapTag -> IO (Int, Int)) -> IO (Int, Int)
forall a. PcapHandle -> (Ptr PcapTag -> IO a) -> IO a
withPcap PcapHandle
pch Ptr PcapTag -> IO (Int, Int)
P.version
isSwapped :: PcapHandle -> IO Bool
isSwapped :: PcapHandle -> IO Bool
isSwapped PcapHandle
pch = PcapHandle -> (Ptr PcapTag -> IO Bool) -> IO Bool
forall a. PcapHandle -> (Ptr PcapTag -> IO a) -> IO a
withPcap PcapHandle
pch Ptr PcapTag -> IO Bool
P.isSwapped
snapshotLen :: PcapHandle -> IO Int
snapshotLen :: PcapHandle -> IO Int
snapshotLen PcapHandle
pch = PcapHandle -> (Ptr PcapTag -> IO Int) -> IO Int
forall a. PcapHandle -> (Ptr PcapTag -> IO a) -> IO a
withPcap PcapHandle
pch Ptr PcapTag -> IO Int
P.snapshotLen