pcap (empty) → 0.2
raw patch · 4 files changed
+1128/−0 lines, 4 filesdep +basedep +haskell98dep +networkbuild-type:Customsetup-changed
Dependencies added: base, haskell98, network
Files
- LICENSE +11/−0
- Network/Pcap.hsc +1100/−0
- Setup.hs +2/−0
- pcap.cabal +15/−0
+ LICENSE view
@@ -0,0 +1,11 @@++Copyright (c) 2007, Nicholas Burlett+Copyright (c) 2004, Antiope Associates LLC+All rights reserved.++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:++Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.+Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.+Neither the name of the Antiope Associates LLC or Nicholas Burlett nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Network/Pcap.hsc view
@@ -0,0 +1,1100 @@+------------------------------------------------------------------------------+-- |+-- Module : Network.Pcap+-- Copyright : (c) Antiope Associates LLC 2004+-- License : BSD-style (see the file libraries/network/license)+--+-- Maintainer : nickburlett@mac.com, dominic.steinitz@blueyonder.co.uk +-- Stability : experimental+-- Portability : non-portable+--+-- The "Pcap" modules is a binding to all of the functions in+-- libpcap (See <http://www.tcpdump.org> for more information.)+--+-- Only a minimum of mashalling is done; for light duty applications,+-- the user can extract the length of the captured buffer+-- from the packet header record and use 'peekArray' to convert the+-- captured data to a list. For illustration:+--+-- > import Pcap+-- > import Foreign+-- >+-- > main = do+-- > let+-- > printIt :: PktHdr -> Ptr Word8 -> IO ()+-- > printIt ph bytep = do+-- > a <- peekArray (fromIntegral (caplen ph)) bytep +-- > print a+-- >+-- > p <- openLive "em0" 100 True 10000+-- > s <- withForeignPtr p $ \ptr -> do+-- > dispatch ptr (-1) printIt+-- > return ()+-- >+--+-- Users requiring higher perfomance (such as O(1) access to any byte+-- in a packet) should roll their own marshalling functions.+--+-- Note that the SockAddr exported here is not the SockAddr from+-- Network.Socket. The SockAddr from Network.Socket corresponds to+-- @struct sockaddr_in@ in BSD terminology. The SockAddr record here+-- is BDS's @struct sockaddr@. See W.R.Stevens, TCP Illustrated, volume 2,+-- for further eluciadation.+--+-- This binding should be portable for systems that can use the libpcap+-- from tcpdump.org. It will not work with Winpcap, a similar library+-- for Windows, although adapting it should not prove difficult.+--+------------------------------------------------------------------------------+++module Network.Pcap (++ -- * Types+ Pcap,+ Pdump,+ BpfProgram,+ Callback,+ Link(..),+ Interface(..),+ PcapAddr(..),+ SockAddr(..),+ Network(..),+ PktHdr(..),+ Statistics(..),++ -- * Device opening+ openOffline, -- :: String -> IO Pcap+ openLive, -- :: String -> Int -> Bool -> Int -> IO Pcap+ openDead, -- :: Int -> Int -> IO Pcap+ openDump, -- :: Ptr PcapTag -> String -> IO Pdump++ -- * Filter handling+ setFilter, -- :: Ptr PcapTag -> String -> Bool -> Word32 -> IO ()+ compileFilter, -- :: Int -> Int -> String -> Bool -> Word32 -> IO BpfProgram++ -- * Device utilities+ lookupDev, -- :: IO String+ findAllDevs, -- :: IO [Interface]+ lookupNet, -- :: String -> IO Network++ -- * Interface control+ -- ** Blocking mode+ setNonBlock, -- :: Ptr PcapTag -> Bool -> IO ()+ getNonBlock, -- :: Ptr PcapTag -> IO Bool++ -- ** Link layer utilities+ datalink, -- :: Ptr PcapTag -> IO Link+ setDatalink, -- :: Ptr PcapTag -> Link -> IO ()+ listDatalinks, -- :: Ptr PcapTag -> IO [Link]++ -- * Packet processing+ dispatch, -- :: Ptr PcapTag -> Int -> Callback -> IO Int+ loop, -- :: Ptr PcapTag -> Int -> Callback -> IO Int+ next, -- :: Ptr PcapTag -> IO (PktHdr, Ptr Word8)+ dump, -- :: Ptr PcapDumpTag -> Ptr PktHdr -> Ptr Word8 -> IO ()++ -- * Miscellaneous+ statistics, -- :: Ptr PcapTag -> IO Statistics+ majorVersion, -- :: Ptr PcapTag -> IO Int+ minorVersion, -- :: Ptr PcapTag -> IO Int+ isSwapped, -- :: Ptr PcapTag -> IO Bool+ snapshotLen, -- :: Ptr PcapTag -> IO Int+) where++import Maybe (isNothing, fromJust )+import Data.Word ( Word8, Word32 )+import Foreign.Ptr ( Ptr, plusPtr, nullPtr, FunPtr, freeHaskellFunPtr )+import Foreign.C.String ( peekCString, withCString )+import Foreign.C.Types ( CInt, CUInt, CChar, CUChar, CLong )+import Foreign.ForeignPtr ( ForeignPtr, FinalizerPtr, newForeignPtr )+import Foreign.Marshal.Alloc ( alloca, allocaBytes, free )+import Foreign.Marshal.Array ( allocaArray, peekArray )+import Foreign.Marshal.Utils ( fromBool, toBool )+import Foreign.Storable ( Storable(..) )+import Network.Socket ( Family(..), unpackFamily)+import System.IO.Error ( userError )++#include <pcap.h>+#include <pcap-bpf.h>+#include <netinet/in.h>+#include <sys/socket.h>++#include "config.h"+++data BpfProgramTag+-- | Compiled Berkeley Packet Filter program+type BpfProgram = ForeignPtr BpfProgramTag++data PcapTag+-- | packet capture descriptor+type Pcap = ForeignPtr PcapTag++data PcapDumpTag+-- | savefile descriptor+type Pdump = ForeignPtr PcapDumpTag++data PktHdr = PktHdr { sec :: Word32, -- ^ timestamp (seconds)+ usec :: Word32, -- ^ timestamp (microseconds)+ caplen :: Word32, -- ^ number of bytes present in capture+ len :: Word32 -- ^ number of bytes on the wire+ }+ deriving (Show)++data Statistics = Statistics { recv :: Word32, -- ^ packets received+ drop :: Word32, -- ^ packets dropped by libpcap+ ifdrop :: Word32 -- ^ packets dropped by the interface+ }+ deriving (Show)+++--+-- Data types for interface list+--++-- | The interface structure+data Interface = Interface { ifName :: String, -- ^ the interface name+ ifDescription :: String, -- ^ interface description string (if any)+ ifAddresses :: [PcapAddr], -- ^ address families supported by this interface+ ifFlags :: Word32+ }+ deriving (Read, Show)++-- | The address structure+data PcapAddr = PcapAddr { ifAddr :: SockAddr, -- ^ interface address+ ifMask :: Maybe SockAddr, -- ^ network mask+ ifBcast :: Maybe SockAddr, -- ^ broadcast address+ ifPeer :: Maybe SockAddr -- ^ address of peer, of a point-to-point link+ }+ deriving (Read, Show)++-- |+-- The socket address record. Note that this is not the same as+-- SockAddr from Network.Sockets. (That is a Haskell version of+-- struct sockaddr_in. This is the real struct sockaddr from the BSD+-- network stack.)+--+data SockAddr = SockAddr { sockAddrFamily :: Family, -- ^ an address family exported by Network.Socket+ sockAddrAddr :: [Word8]+ }+ deriving (Read, Show)++-- | The network address record. Both the address and mask are in+-- network byte order.+data Network = Network { netAddr :: Word32, -- ^ IPv4 network address+ netMask :: Word32 -- ^ IPv4 netmask+ }+ deriving (Read, Show)+++--+-- Open a device+--++-- |+-- openOffline opens a \"savefile\" for reading. The file foramt is the+-- as used for tcpdump. The string \"-\" is a synonym for stdin.+--+openOffline+ :: String -- ^ filename+ -> IO Pcap+openOffline name =+ withCString name $ \namePtr ->+ allocaArray (#const PCAP_ERRBUF_SIZE) $ \errPtr -> do+ ptr <- pcap_open_offline namePtr errPtr+ if ptr == nullPtr+ then peekCString errPtr >>= ioError . userError+ else do+ final <- h2c pcap_close+ newForeignPtr final ptr++-- |+-- openLive is used to get a packet descriptor that can be used to+-- look at packates on the network. The arguments are the device name,+-- the snapshot legnth (in bytes), the promiscuity of the interface+-- (True == promiscuous) and a timeout in milliseconds.+--+-- Using \"any\" as the device name will capture packets from all interfaces.+-- On some systems, reading from the \"any\" device is incompatible with+-- setting the interfaces into promiscuous mode. In that case, only packets+-- whose link layer addresses match those of the interfaces are captured.+--+openLive+ :: String -- ^ device name+ -> Int -- ^ snapshot length+ -> Bool -- ^ set to promiscuous mode?+ -> Int -- ^ timeout in milliseconds+ -> IO Pcap+openLive name snaplen promisc timeout =+ withCString name $ \namePtr ->+ allocaArray (#const PCAP_ERRBUF_SIZE) $ \errPtr -> do+ ptr <- pcap_open_live namePtr+ (fromIntegral snaplen)+ (fromBool promisc)+ (fromIntegral timeout)+ errPtr+ if ptr == nullPtr+ then peekCString errPtr >>= ioError . userError+ else do+ final <- h2c pcap_close+ newForeignPtr final ptr++-- |+-- openDead is used to get a packet capture descriptor without opening+-- a file or device. It is typically used to test packet filter compilation+-- by setFilter. The arguments are the linktype and the snapshot length.+--+openDead+ :: Link -- ^ datalink type+ -> Int -- ^ snapshot length+ -> IO Pcap -- ^ packet capture descriptor+openDead link snaplen = + do+ ptr <- pcap_open_dead (packLink link)+ (fromIntegral snaplen)+ if ptr == nullPtr+ then ioError $ userError "Can't open dead pcap device"+ else do+ final <- h2c pcap_close+ newForeignPtr final ptr+++foreign import ccall unsafe pcap_open_offline :: Ptr CChar -> Ptr CChar -> IO (Ptr PcapTag)+foreign import ccall unsafe pcap_close :: Ptr PcapTag -> IO ()+foreign import ccall unsafe pcap_open_live :: Ptr CChar -> CInt -> CInt -> CInt -> Ptr CChar -> IO (Ptr PcapTag)+foreign import ccall unsafe pcap_open_dead :: CInt -> CInt -> IO (Ptr PcapTag)++foreign import ccall "wrapper" h2c :: (Ptr PcapTag -> IO()) -> IO (FinalizerPtr a)++++--+-- Open a dump device+--++-- |+-- openDump opens a \"savefile\" for writing. This savefile is written to+-- by the dump function. The arguments are a raw packet capture descriptor+-- and the filename, with \"-\" as a synonym for stdout.+--+openDump+ :: Ptr PcapTag -- ^ packet capture descriptor+ -> String -- ^ savefile name+ -> IO Pdump -- ^ davefile descriptor+openDump hdl name =+ withCString name $ \namePtr -> do+ ptr <- pcap_dump_open hdl namePtr+ if (ptr == nullPtr) then+ throwPcapError hdl+ else do+ final <- h2c' pcap_dump_close+ newForeignPtr final ptr++foreign import ccall unsafe pcap_dump_open :: Ptr PcapTag -> Ptr CChar -> IO (Ptr PcapDumpTag)+foreign import ccall unsafe pcap_dump_close :: Ptr PcapDumpTag -> IO ()++foreign import ccall "wrapper" h2c' :: (Ptr PcapDumpTag -> IO()) -> IO (FinalizerPtr a)+++--+-- Set the filter+--++-- |+-- Set a filter on the specified packet capture descriptor. Valid filter+-- strings are those accepted by tcpdump.+--+setFilter+ :: Ptr PcapTag -- ^ packet capture descriptor+ -> String -- ^ filter string+ -> Bool -- ^ optimize?+ -> Word32 -- ^ IPv4 network mask+ -> IO ()+setFilter hdl filt opt mask =+ withCString filt $ \filter -> do+ allocaBytes (#size struct bpf_program) $ \bpfp -> do+ ret <- pcap_compile hdl+ bpfp+ filter+ (fromBool opt)+ (fromIntegral mask)+ if ret == (-1) then+ throwPcapError hdl+ else do+ ret <- pcap_setfilter hdl bpfp+ if ret == (-1) then+ throwPcapError hdl+ else+ pcap_freecode bpfp++-- |+-- Compile a filter for use by another program using the Berkeley Packet+-- Filter library.+--+compileFilter+ :: Int -- ^ snapshot length+ -> Link -- ^ datalink type+ -> String -- ^ filter string+ -> Bool -- ^ optimize?+ -> Word32 -- ^ IPv4 network mask+ -> IO BpfProgram+compileFilter snaplen link filt opt mask =+ withCString filt $ \filter ->+ allocaBytes (#size struct bpf_program) $ \bpfp -> do+ ret <- pcap_compile_nopcap (fromIntegral snaplen)+ (packLink link)+ bpfp+ filter+ (fromBool opt)+ (fromIntegral mask)+ if ret == (-1) then+ ioError $ userError "Pcap.compileFilter error"+ else do+ final <- h2c'' pcap_freecode+ newForeignPtr final bpfp+ ++foreign import ccall pcap_compile+ :: Ptr PcapTag -> Ptr BpfProgramTag -> Ptr CChar -> CInt -> CInt -> IO CInt+foreign import ccall pcap_compile_nopcap+ :: CInt -> CInt -> Ptr BpfProgramTag -> Ptr CChar -> CInt -> CInt -> IO CInt+foreign import ccall pcap_setfilter+ :: Ptr PcapTag -> Ptr BpfProgramTag -> IO CInt+foreign import ccall pcap_freecode+ :: Ptr BpfProgramTag -> IO ()++foreign import ccall "wrapper" h2c''+ :: (Ptr BpfProgramTag -> IO ()) -> IO (FinalizerPtr a)++++--+-- Find devices+--++data DevBuf+data DevAddr+++-- |+-- lookupDev returns the name of a device suitable for use with+-- openLive and lookupNet. If you only have one interface, it is the+-- function of choice. If not, see findAllDevs.+--+lookupDev :: IO String+lookupDev =+ allocaArray (#const PCAP_ERRBUF_SIZE) $ \errPtr -> do+ ptr <- pcap_lookupdev errPtr+ if ptr == nullPtr+ then peekCString errPtr >>= ioError . userError+ else peekCString ptr+++-- |+-- findAllDevs returns a list of all the network devices that can+-- be opened by openLive. It returns only those devices that the+-- calling process has sufficient privileges to open, so it may not+-- find every device on the system.+--+findAllDevs :: IO [Interface]+findAllDevs = + alloca $ \dptr -> do+ allocaArray (#const PCAP_ERRBUF_SIZE) $ \errPtr -> do+ ret <- pcap_findalldevs dptr errPtr+ if (ret == -1) then+ peekCString errPtr >>= ioError . userError+ else do+ dbuf <- peek dptr+ dl <- devs2list dbuf+ pcap_freealldevs dbuf+ return dl+++devs2list :: Ptr DevBuf -> IO [Interface]+devs2list dbuf+ | dbuf == nullPtr = do return []+ | otherwise = do+ nextdev <- (#peek struct pcap_if, next) dbuf+ ds <- devs2list nextdev+ d <- oneDev dbuf+ return (d : ds)+++oneDev :: Ptr DevBuf -> IO Interface+oneDev dbuf =+ do+ name <- (#peek struct pcap_if, name) dbuf+ desc <- (#peek struct pcap_if, description) dbuf+ addrs <- (#peek struct pcap_if, addresses) dbuf+ flags <- (#peek struct pcap_if, flags) dbuf++ name' <- peekCString name+ desc' <- if desc /= nullPtr then+ peekCString desc+ else+ return ""++ addrs' <- addrs2list addrs++ return (Interface name' desc' addrs' (fromIntegral (flags :: CUInt)))+++addrs2list :: Ptr DevAddr -> IO [PcapAddr]+addrs2list abuf+ | abuf == nullPtr = do return []+ | otherwise = do+ nextaddr <- (#peek struct pcap_addr, next) abuf+ as <- addrs2list nextaddr+ a <- oneAddr abuf+ return (a : as)+++oneAddr :: Ptr DevAddr -> IO PcapAddr+oneAddr abuf =+ let+ socka :: Ptr a -> IO (Maybe SockAddr)+ socka sa =+ if sa /= nullPtr then+ do+#if defined(SA_LEN)+ l <- ((#peek struct sockaddr, sa_len) sa) :: IO CUChar+#else+ l <- return (#size struct sockaddr) :: IO CUChar+#endif+ f <- ((#peek struct sockaddr, sa_family) sa) :: IO CUChar+ + addr <- peekArray ((fromIntegral l) - (#offset struct sockaddr, sa_data))+ ((plusPtr sa (#offset struct sockaddr, sa_data)) :: Ptr Word8)++ return (Just (SockAddr (unpackFamily (fromIntegral f)) addr))+ else+ return Nothing+ in + do+ addr <- (#peek struct pcap_addr, addr) abuf >>= socka+ mask <- (#peek struct pcap_addr, netmask) abuf >>= socka+ bcast <- (#peek struct pcap_addr, broadaddr) abuf >>= socka+ peer <- (#peek struct pcap_addr, dstaddr) abuf >>= socka++ if isNothing addr then+ ioError $ userError "Pcap.oneAddr: null address"+ else+ return (PcapAddr (fromJust addr) mask bcast peer)+++-- | Return the network address and mask for the specified interface+-- name. Only valid for IPv4. For other protocols,+-- use findAllDevs and search the Address list for the associated+-- network mask.+--+lookupNet+ :: String -- ^ device name+ -> IO Network+lookupNet dev =+ withCString dev $ \name ->+ alloca $ \netp ->+ alloca $ \maskp -> do+ allocaArray (#const PCAP_ERRBUF_SIZE) $ \errPtr -> do+ ret <- pcap_lookupnet name netp maskp errPtr+ if ret == (-1) then+ peekCString errPtr >>= ioError . userError+ else do+ net <- peek netp+ mask <- peek maskp++ return (Network (fromIntegral net)+ (fromIntegral mask) )+++foreign import ccall unsafe pcap_lookupdev :: Ptr CChar -> IO (Ptr CChar)+foreign import ccall unsafe pcap_findalldevs :: Ptr (Ptr DevBuf) -> Ptr CChar -> IO CInt+foreign import ccall unsafe pcap_freealldevs :: Ptr DevBuf -> IO ()+foreign import ccall unsafe pcap_lookupnet :: Ptr CChar -> Ptr CUInt -> Ptr CUInt -> Ptr CChar -> IO CInt++++--+-- Set or read the device mode (blocking/nonblocking)+--++-- | Set a packet capture descriptor into non-blocking mode, if the+-- second argument is True, otherwise put it in blocking mode. Note+-- that the packet capture descripto must have been obtaine from openLive.+--+setNonBlock :: Ptr PcapTag -> Bool -> IO ()+setNonBlock ptr block = + allocaArray (#const PCAP_ERRBUF_SIZE) $ \errPtr -> do+ ret <- pcap_setnonblock ptr (fromBool block) errPtr+ if ret == (-1)+ then peekCString errPtr >>= ioError . userError+ else return ()++--+-- | Return the blocking status of the packet capture descriptor. Ture+-- indicates that the descriptor is non-blocking. Descriptors referring+-- savefiles opened by openDump always reutre False.+--+getNonBlock :: Ptr PcapTag -> IO Bool+getNonBlock ptr = + allocaArray (#const PCAP_ERRBUF_SIZE) $ \errPtr -> do+ ret <- pcap_getnonblock ptr errPtr+ if ret == (-1)+ then peekCString errPtr >>= ioError . userError+ else return (toBool ret)+++foreign import ccall unsafe pcap_setnonblock :: Ptr PcapTag -> CInt -> Ptr CChar -> IO CInt+foreign import ccall unsafe pcap_getnonblock :: Ptr PcapTag -> Ptr CChar -> IO CInt++++--+-- Error handling+--++throwPcapError :: Ptr PcapTag -> IO a+throwPcapError hdl = do+ msg <- pcap_geterr hdl >>= peekCString+ ioError (userError msg)+++foreign import ccall unsafe pcap_geterr :: Ptr PcapTag -> IO (Ptr CChar)++++--+-- Reading packets+--++-- | the type of the callback function passed to dispatch or loop.+type Callback = PktHdr -> Ptr Word8 -> IO ()+type CCallback = Ptr Word8 -> Ptr PktHdr -> Ptr Word8 -> IO ()+++exportCallback :: Callback -> IO (FunPtr CCallback)+exportCallback f = exportCCallback $ \_user hdr ptr -> do+ let ts = (#ptr struct pcap_pkthdr, ts) hdr++ s <- (#peek struct timeval, tv_sec) ts+ us <- (#peek struct timeval, tv_usec) ts+ caplen <- (#peek struct pcap_pkthdr, caplen) hdr+ len <- (#peek struct pcap_pkthdr, len) hdr++ f+ (PktHdr+ (fromIntegral (s :: CLong))+ (fromIntegral (us :: CLong))+ (fromIntegral (caplen :: CUInt))+ (fromIntegral (len :: CUInt)))+ ptr+++-- |+-- Collect and process packets. The arguments are the packet capture+-- descriptor, the count and a callback function.+--+-- The count is the maximum number of packets to process before returning.+-- A count of -1 means process all of the packets received in one buffer+-- (if a live capture) or all of the packets in a savefile (if offline).+--+-- The callback function is passed two arguments, a packet header+-- record and a pointer to the packet data (Ptr Word8). THe header+-- record contains the number of bytes captured, whcih can be used+-- to marshal the data into a list or array.+--+dispatch+ :: Ptr PcapTag -- ^ packet capture descriptor+ -> Int -- ^ number of packets to process+ -> Callback -- ^ packet processing function+ -> IO Int -- ^ number of packets read+dispatch hdl count f = do+ handler <- exportCallback f+ result <- pcap_dispatch hdl (fromIntegral count) handler nullPtr++ freeHaskellFunPtr handler++ if (result == -1) then+ throwPcapError hdl+ else+ return (fromIntegral result)+++-- |+-- Similar to dispatch, but loop until the number of packets specified+-- by the second argument are read. A negative value loops forever.+--+-- It does not return when a live read tiemout occurs. Use dispatch instead+-- if you wnat to specify a timeout.+--+loop+ :: Ptr PcapTag -- ^ packet cpature descriptor+ -> Int -- ^ number of packet to read+ -> Callback -- ^ packet processing function+ -> IO Int -- ^ number of packets read+loop hdl count f = do+ handler <- exportCallback f+ result <- pcap_loop hdl (fromIntegral count) handler nullPtr++ freeHaskellFunPtr handler++ if (result == -1) then+ throwPcapError hdl+ else+ return (fromIntegral result)+++-- | +-- Read the next packet (by calling dispatch with a count of 1).+--+next+ :: Ptr PcapTag -- ^ packet capture descriptor+ -> IO (PktHdr, Ptr Word8) -- ^ packet header and data of the next packet+next hdl =+ allocaBytes (#size struct pcap_pkthdr) $ \hdr -> do+ ptr <- pcap_next hdl hdr+ if (ptr == nullPtr) then+ return (PktHdr 0 0 0 0, ptr)+ else do+ let ts = (#ptr struct pcap_pkthdr, ts) hdr++ s <- (#peek struct timeval, tv_sec) ts+ us <- (#peek struct timeval, tv_usec) ts+ caplen <- (#peek struct pcap_pkthdr, caplen) hdr+ len <- (#peek struct pcap_pkthdr, len) hdr++ return (PktHdr+ (fromIntegral (s :: CLong))+ (fromIntegral (us :: CLong))+ (fromIntegral (caplen :: CUInt))+ (fromIntegral (len :: CUInt)),+ ptr)+ ++-- |+-- Write the packet data given by the second and third arguments+-- to a savefile opened by openDead. dump is designed so it can be+-- easily used as a default callback function by dispatch or loop.+--+dump+ :: Ptr PcapDumpTag -- ^ savefile descriptor+ -> Ptr PktHdr -- ^ packet header record+ -> Ptr Word8 -- ^ packet data+ -> IO ()+dump hdl hdr pkt = pcap_dump hdl hdr pkt++++foreign import ccall "wrapper" exportCCallback+ :: CCallback -> IO (FunPtr CCallback)++foreign import ccall pcap_dispatch+ :: Ptr PcapTag -> CInt -> FunPtr CCallback -> Ptr Word8 -> IO CInt+foreign import ccall pcap_loop+ :: Ptr PcapTag -> CInt -> FunPtr CCallback -> Ptr Word8 -> IO CInt+foreign import ccall pcap_next+ :: Ptr PcapTag -> Ptr PktHdr -> IO (Ptr Word8)+foreign import ccall pcap_dump+ :: Ptr PcapDumpTag -> Ptr PktHdr -> Ptr Word8 -> IO ()+++--+-- Datalink manipulation+--++-- |+-- Returns the datalink type associated with the given pcap descriptor.+--+datalink :: Ptr PcapTag -> IO Link+datalink hdl = do+ ret <- pcap_datalink hdl+ return (unpackLink ret)+++-- |+-- Sets the datalink type for a given pcap descriptor.+--+setDatalink :: Ptr PcapTag -> Link -> IO ()+setDatalink hdl link = do+ ret <- pcap_set_datalink hdl (packLink link)+ if (ret == -1) then+ throwPcapError hdl+ else+ return ()+++-- |+-- List all the datalink types supported by a pcap descriptor. Entries+-- from the resulting list are valid arguments to setDatalink.+--+listDatalinks :: Ptr PcapTag -> IO [Link]+listDatalinks hdl =+ alloca $ \lptr -> do+ ret <- pcap_list_datalinks hdl lptr+ if (ret == -1) then+ throwPcapError hdl+ else do+ dlbuf <- peek lptr+ dls <- peekArray (fromIntegral (ret :: CInt)) dlbuf+ free dlbuf+ return (map unpackLink dls)+ + +foreign import ccall unsafe pcap_datalink :: Ptr PcapTag -> IO CInt+foreign import ccall unsafe pcap_set_datalink :: Ptr PcapTag -> CInt -> IO CInt+foreign import ccall unsafe pcap_list_datalinks :: Ptr PcapTag -> Ptr (Ptr CInt) -> IO CInt+++--+-- Statistics+--++data PcapStats = PcapStats++-- |+-- Returns the number of packets received, the number of packets+-- dropped by the packet filter and the number of packets dropped+-- by the interface (before processing by the packet filter).+--+statistics :: Ptr PcapTag -> IO Statistics+statistics hdl =+ allocaBytes (#size struct pcap_stat) $ \stats -> do+ ret <- pcap_stats hdl stats+ if (ret == -1) then+ throwPcapError hdl+ else do+ recv <- (#peek struct pcap_stat, ps_recv) stats+ drop <- (#peek struct pcap_stat, ps_drop) stats+ ifdrop <- (#peek struct pcap_stat, ps_ifdrop) stats++ return (Statistics+ (fromIntegral (recv :: CUInt))+ (fromIntegral (drop :: CUInt))+ (fromIntegral (ifdrop :: CUInt)))++foreign import ccall unsafe pcap_stats :: Ptr PcapTag -> Ptr PcapStats -> IO Int++++--+-- Version information+--++-- |+-- Major version number of the library.+--+majorVersion :: Ptr PcapTag -> IO Int+majorVersion ptr = do+ v <- pcap_major_version ptr+ return (fromIntegral (v :: CInt))+++-- |+-- Minor version number of the library.+--+minorVersion :: Ptr PcapTag -> IO Int+minorVersion ptr = do+ v <- pcap_major_version ptr+ return (fromIntegral (v :: CInt))+++-- |+-- isSwapped is True if the current savefile uses a different+-- byte order than the one native to the system.+--+isSwapped :: Ptr PcapTag -> IO Bool+isSwapped ptr = do+ sw <- pcap_is_swapped ptr+ return (toBool sw)+++-- |+-- The snapshot length that was used in the call to openLive.+-- +snapshotLen :: Ptr PcapTag -> IO Int+snapshotLen ptr = do+ l <- pcap_snapshot ptr+ return (fromIntegral (l :: CInt))+++foreign import ccall pcap_major_version :: Ptr PcapTag -> IO CInt+foreign import ccall pcap_minor_version :: Ptr PcapTag -> IO CInt+foreign import ccall pcap_is_swapped :: Ptr PcapTag -> IO CInt+foreign import ccall pcap_snapshot :: Ptr PcapTag -> IO CInt+++--+-- Utility functions for data link types+--++-- | Datalink types.+--+-- This covers all of the datalink types defined in bpf.h.+-- Types defined on your system may vary.+--+data Link + = DLT_NULL -- ^ no link layer encapsulation+#ifdef DLT_EN10MB+ | DLT_EN10MB -- ^ 10 Mbit per second (or faster) ethernet+#endif+#ifdef DLT_EN3MB+ | DLT_EN3MB -- ^ original 3 Mbit per second ethernet+#endif+#ifdef DLT_AX25+ | DLT_AX25 -- ^ amateur radio AX.25+#endif+#ifdef DLT_PRONET+ | DLT_PRONET -- ^ Proteon ProNET Token Ring+#endif+#ifdef DLT_CHAOS+ | DLT_CHAOS -- ^ Chaos+#endif+#ifdef DLT_IEEE802+ | DLT_IEEE802 -- ^ IEEE 802 networks+#endif+#ifdef DLT_ARCNET+ | DLT_ARCNET -- ^ ARCNET+#endif+#ifdef DLT_SLIP+ | DLT_SLIP -- ^ Serial line IP+#endif+#ifdef DLT_PPP+ | DLT_PPP -- ^ Point-to-point protocol+#endif+#ifdef DLT_FDDI+ | DLT_FDDI -- ^ FDDI+#endif+#ifdef DLT_ATM_RFC1483+ | DLT_ATM_RFC1483 -- ^ LLC SNAP encapsulated ATM+#endif+#ifdef DLT_RAW+ | DLT_RAW -- ^ raw IP+#endif+#ifdef DLT_SLIP_BSDOS+ | DLT_SLIP_BSDOS -- ^ BSD OS serial line IP+#endif+#ifdef DLT_PPP_BSDOS+ | DLT_PPP_BSDOS -- ^ BSD OS point-to-point protocol+#endif+#ifdef DLT_ATM_CLIP+ | DLT_ATM_CLIP -- ^ Linux classical IP over ATM+#endif+#ifdef DLT_PPP_SERIAL+ | DLT_PPP_SERIAL -- ^ PPP over serial with HDLC encapsulation+#endif+#ifdef DLT_PPP_ETHER+ | DLT_PPP_ETHER -- ^ PPP over ethernet+#endif+#ifdef DLT_C_HDLC + | DLT_C_HDLC -- ^ Cisco HDLC+#endif+#ifdef DLT_IEEE802_11+ | DLT_IEEE802_11 -- ^ IEEE 802.11 wireless+#endif+#ifdef DLT_LOOP+ | DLT_LOOP -- ^ OpenBSD loopback device+#endif+#ifdef DLT_LINUX_SLL+ | DLT_LINUX_SLL -- ^ Linux cooked sockets+#endif+#ifdef DLT_LTALK+ | DLT_LTALK -- ^ Apple LocalTalk+#endif+#ifdef DLT_ECONET+ | DLT_ECONET -- ^ Acorn Econet+#endif+#ifdef DLT_IPFILTER+ | DLT_IPFILTER -- ^ OpenBSD's old ipfilter+#endif+#ifdef DLT_PFLOG+ | DLT_PFLOG -- ^ OpenBSD's pflog+#endif+#ifdef DLT_CISCO_IOS+ | DLT_CISCO_IOS -- ^ Cisco IOS+#endif+#ifdef DLT_PRISM_HEADER+ | DLT_PRISM_HEADER -- ^ Intersil Prism II wireless chips+#endif+#ifdef DLT_AIRONET_HEADER+ | DLT_AIRONET_HEADER -- ^ Aironet (Cisco) 802.11 wireless+#endif+ deriving (Eq, Ord, Read, Show)+++packLink :: Link -> CInt+packLink l = case l of+ DLT_NULL -> #const DLT_NULL+#ifdef DLT_EN10MB+ DLT_EN10MB -> #const DLT_EN10MB+#endif+#ifdef DLT_EN3MB+ DLT_EN3MB -> #const DLT_EN3MB+#endif+#ifdef DLT_AX25+ DLT_AX25 -> #const DLT_AX25+#endif+#ifdef DLT_PRONET+ DLT_PRONET -> #const DLT_PRONET+#endif+#ifdef DLT_CHAOS+ DLT_CHAOS -> #const DLT_CHAOS+#endif+#ifdef DLT_IEEE802+ DLT_IEEE802 -> #const DLT_IEEE802+#endif+#ifdef DLT_ARCNET+ DLT_ARCNET -> #const DLT_ARCNET+#endif+#ifdef DLT_SLIP+ DLT_SLIP -> #const DLT_SLIP+#endif+#ifdef DLT_PPP+ DLT_PPP -> #const DLT_PPP+#endif+#ifdef DLT_FDDI+ DLT_FDDI -> #const DLT_FDDI+#endif+#ifdef DLT_ATM_RFC1483+ DLT_ATM_RFC1483 -> #const DLT_ATM_RFC1483+#endif+#ifdef DLT_RAW+ DLT_RAW -> #const DLT_RAW+#endif+#ifdef DLT_SLIP_BSDOS+ DLT_SLIP_BSDOS -> #const DLT_SLIP_BSDOS+#endif+#ifdef DLT_PPP_BSDOS+ DLT_PPP_BSDOS -> #const DLT_PPP_BSDOS+#endif+#ifdef DLT_ATM_CLIP+ DLT_ATM_CLIP -> #const DLT_ATM_CLIP+#endif+#ifdef DLT_PPP_SERIAL+ DLT_PPP_SERIAL -> #const DLT_PPP_SERIAL+#endif+#ifdef DLT_PPP_ETHER+ DLT_PPP_ETHER -> #const DLT_PPP_ETHER+#endif+#ifdef DLT_C_HDLC + DLT_C_HDLC -> #const DLT_C_HDLC+#endif+#ifdef DLT_IEEE802_11+ DLT_IEEE802_11 -> #const DLT_IEEE802_11+#endif+#ifdef DLT_LOOP+ DLT_LOOP -> #const DLT_LOOP+#endif+#ifdef DLT_LINUX_SLL+ DLT_LINUX_SLL -> #const DLT_LINUX_SLL+#endif+#ifdef DLT_LTALK+ DLT_LTALK -> #const DLT_LTALK+#endif+#ifdef DLT_ECONET+ DLT_ECONET -> #const DLT_ECONET+#endif+#ifdef DLT_IPFILTER+ DLT_IPFILTER -> #const DLT_IPFILTER+#endif+#ifdef DLT_PFLOG+ DLT_PFLOG -> #const DLT_PFLOG+#endif+#ifdef DLT_CISCO_IOS+ DLT_CISCO_IOS -> #const DLT_CISCO_IOS+#endif+#ifdef DLT_PRISM_HEADER+ DLT_PRISM_HEADER -> #const DLT_PRISM_HEADER+#endif+#ifdef DLT_AIRONET_HEADER+ DLT_AIRONET_HEADER -> #const DLT_AIRONET_HEADER+#endif++++unpackLink :: CInt -> Link+unpackLink l = case l of+ (#const DLT_NULL) -> DLT_NULL+#ifdef DLT_EN10MB+ (#const DLT_EN10MB) -> DLT_EN10MB+#endif+#ifdef DLT_EN3MB+ (#const DLT_EN3MB) -> DLT_EN3MB+#endif+#ifdef DLT_AX25+ (#const DLT_AX25) -> DLT_AX25+#endif+#ifdef DLT_PRONET+ (#const DLT_PRONET) -> DLT_PRONET+#endif+#ifdef DLT_CHAOS+ (#const DLT_CHAOS) -> DLT_CHAOS+#endif+#ifdef DLT_IEEE802+ (#const DLT_IEEE802) -> DLT_IEEE802+#endif+#ifdef DLT_ARCNET+ (#const DLT_ARCNET) -> DLT_ARCNET+#endif+#ifdef DLT_SLIP+ (#const DLT_SLIP) -> DLT_SLIP+#endif+#ifdef DLT_PPP+ (#const DLT_PPP) -> DLT_PPP+#endif+#ifdef DLT_FDDI+ (#const DLT_FDDI) -> DLT_FDDI+#endif+#ifdef DLT_ATM_RFC1483+ (#const DLT_ATM_RFC1483) -> DLT_ATM_RFC1483+#endif+#ifdef DLT_RAW+ (#const DLT_RAW) -> DLT_RAW+#endif+#ifdef DLT_SLIP_BSDOS+ (#const DLT_SLIP_BSDOS) -> DLT_SLIP_BSDOS+#endif+#ifdef DLT_PPP_BSDOS+ (#const DLT_PPP_BSDOS) -> DLT_PPP_BSDOS+#endif+#ifdef DLT_ATM_CLIP+ (#const DLT_ATM_CLIP) -> DLT_ATM_CLIP+#endif+#ifdef DLT_PPP_SERIAL+ (#const DLT_PPP_SERIAL) -> DLT_PPP_SERIAL+#endif+#ifdef DLT_PPP_ETHER+ (#const DLT_PPP_ETHER) -> DLT_PPP_ETHER+#endif+#ifdef DLT_C_HDLC + (#const DLT_C_HDLC) -> DLT_C_HDLC+#endif+#ifdef DLT_IEEE802_11+ (#const DLT_IEEE802_11) -> DLT_IEEE802_11+#endif+#ifdef DLT_LOOP+ (#const DLT_LOOP) -> DLT_LOOP+#endif+#ifdef DLT_LINUX_SLL+ (#const DLT_LINUX_SLL) -> DLT_LINUX_SLL+#endif+#ifdef DLT_LTALK+ (#const DLT_LTALK) -> DLT_LTALK+#endif+#ifdef DLT_ECONET+ (#const DLT_ECONET) -> DLT_ECONET+#endif+#ifdef DLT_IPFILTER+ (#const DLT_IPFILTER) -> DLT_IPFILTER+#endif+#ifdef DLT_PFLOG+ (#const DLT_PFLOG) -> DLT_PFLOG+#endif+#ifdef DLT_CISCO_IOS+ (#const DLT_CISCO_IOS) -> DLT_CISCO_IOS+#endif+#ifdef DLT_PRISM_HEADER+ (#const DLT_PRISM_HEADER) -> DLT_PRISM_HEADER+#endif+#ifdef DLT_AIRONET_HEADER+ (#const DLT_AIRONET_HEADER) -> DLT_AIRONET_HEADER+#endif
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ pcap.cabal view
@@ -0,0 +1,15 @@+name: pcap+version: 0.2+license: BSD4+license-file: LICENSE+synopsis: pcap interface+Description: FFI Wrapper around libpcap+Maintainer: nickburlett@mac.com, dominic.steinitz@blueyonder.co.uk+Category: Network+exposed-modules:+ Network.Pcap+Build-Depends: + base, network, haskell98+extensions: ForeignFunctionInterface+ghc-options: -fglasgow-exts+