------------------------------------------------------------------------------ -- | -- 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 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 #include #include #include #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