packages feed

Etherbunny 0.2 → 0.3

raw patch · 6 files changed

+208/−142 lines, 6 filesdep +bytestring

Dependencies added: bytestring

Files

Etherbunny.cabal view
@@ -1,18 +1,25 @@ Name:           Etherbunny-Version:        0.2+Version:        0.3 Author:         Nick Burlett Maintainer:     nickburlett@mac.com-Description:    A network analysis toolkit for haskell, based on the Network.Pcap library. Currently not very useful, but getting there.-Synopsis:       A network analysis toolkit for haskell+Synopsis:       A network analysis toolkit for Haskell+Description:    A network analysis toolkit for Haskell, based on the Network.Pcap library. Currently not very useful, but getting there.+Homepage:       http://etherbunny.anytini.com/ License:        GPL License-file:   LICENSE Category:       Network-Build-Depends:   -        base, network, haskell98, pcap, binary+Build-Depends:+                base, haskell98, network, pcap, binary, bytestring+Build-Type:     Simple+extra-source-files:+                tests/packet.hs Exposed-modules:-        Network.Etherbunny.Packet, Network.Etherbunny.Ethernet, Network.Etherbunny.Ip, Network.Etherbunny.Tcp+                Network.Etherbunny.Packet, Network.Etherbunny.Ethernet, Network.Etherbunny.Ip, Network.Etherbunny.Tcp+Extensions:     GeneralizedNewtypeDeriving  Executable:     etherbunny Main-Is:        etherbunny.hs-Extra-libraries: +Extra-libraries:                 pcap+ghc-options:    -funbox-strict-fields -O2 -Wall+Extensions:     GeneralizedNewtypeDeriving
Network/Etherbunny/Ethernet.hs view
@@ -9,24 +9,24 @@ -- Portability :  ghc -- -- Ethernet Packet access for Etherbunny.--- +-- ----------------------------------------------------------------------------- -{-# OPTIONS_GHC -fglasgow-exts -funbox-strict-fields #-}+{-# LANGUAGE GeneralizedNewtypeDeriving  #-}  module Network.Etherbunny.Ethernet (     -- * Types     MACAddr,     EthType,     EtherPkt,-    +     -- * Functions     getEtherPacket -- :: ByteString -> EthPkt ) where-    + import Network.Etherbunny.Ip import Network.Etherbunny.Packet-    + import Data.Word import qualified Data.ByteString as B import Data.Binary.Get@@ -41,14 +41,15 @@     deriving (Eq, Ord, Bits, Num, Integral, Enum, Real)  instance Show MACAddr where-    showsPrec _ (MACAddr m) = +    showsPrec _ (MACAddr m) =         foldr (\i a -> showsHexByte (getWord m i)  ":" . a) (showsHexByte (getWord m 0)  "") $ [5,4..1]         where             getWord x i = (x `shiftR` (i*8)) .&. 0xff-            showsHexByte x a = showString $ tail $ showHex (16^2+x) a+--            showsHexByte :: forall t. (Integral t) => t -> String -> String -> String+            showsHexByte x a = showString $ tail $ showHex (16^(2 :: Int)+x) a  macFromList :: [Word8] -> MACAddr-macFromList  = wordsToInt 6 +macFromList  = wordsToInt 6   -- |@@ -60,24 +61,25 @@  instance Show EthType where     showsPrec _ (EthType e) =-        showString $ tail $ showHex (16^4+ 0x0800) $ " " ++ etherTypeName e+        showString $ tail $ showHex ((16 :: Int)^(4 :: Int)+ 0x0800) $ " " ++ etherTypeName e -etherTypeName e +etherTypeName :: (Num a) => a -> [Char]+etherTypeName e     | e == 0x0800   = "IP"     | otherwise     = "Unknown" -ethTypeFromList :: [Word8] -> EthType-ethTypeFromList [f, f2] = EthType $ (fromIntegral f) `shiftL` 8 .|. (fromIntegral f2) +-- ethTypeFromList :: [Word8] -> EthType+-- ethTypeFromList [f, f2] = EthType $ (fromIntegral f) `shiftL` 8 .|. (fromIntegral f2)   data EtherPayload = IPPkt IPPkt     deriving (Show) --- | +-- | --   The EthPkt type defines an Ethernet II packet with another Packet payload -- -data EtherPkt = EtherPkt { +data EtherPkt = EtherPkt {                  ethDestination :: !MACAddr,    -- ^ destination MAC address                  ethSource      :: !MACAddr,    -- ^ source MAC address                  ethType        :: !EthType,    -- ^ payload type@@ -86,29 +88,29 @@                }  instance Show EtherPkt where-   showsPrec p pkt = +   showsPrec p pkt =        showString "Ethernet II dest: " . showsPrec p (ethDestination pkt)            . showString " src: " . showsPrec p (ethSource pkt)            . showString " type: " . showsPrec p (ethType pkt)            . showsPrec p (ethPayload pkt)            . showsPrec p (ethRemainder pkt) +getMacAddress :: Get MACAddr getMacAddress = do-    mac <- getByteString 6 -    return $ macFromList $ B.unpackList mac+    mac <- getByteString 6+    return $ macFromList $ B.unpack mac  getEtherPacket :: Get EtherPkt getEtherPacket = do     dst <- getMacAddress     src <- getMacAddress     typ <- getWord16be-    payload <- do +    payload <- do         case typ of-            0x0800    -> do +            0x0800    -> do                 payload <- getIPPacket                 return $ Just $ IPPkt payload-            otherwise -> undefined+            _ -> return Nothing     numRemain <- remaining-    remaining <- getByteString $ fromIntegral numRemain-    return $ EtherPkt dst src (EthType typ) payload (B.unpack remaining)-    +    remain <- getByteString $ fromIntegral numRemain+    return $ EtherPkt dst src (EthType typ) payload (B.unpack remain)
Network/Etherbunny/Ip.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-} ----------------------------------------------------------------------------- -- | -- Module      :  Etherbunny.Ip@@ -12,28 +13,26 @@ -- ----------------------------------------------------------------------------- -{-# OPTIONS_GHC -fglasgow-exts -funbox-strict-fields #-}- module Network.Etherbunny.Ip (     -- * Types     IPPkt,     IPVerIHL,-    +     -- * Functions     getIPPacket, ) where-    -import Network.Etherbunny.Packet++-- import Network.Etherbunny.Packet (wordsToWord16, wordsToWord32) import Network.Etherbunny.Tcp-    + import Data.Word import Numeric import Bits-import Network.Socket (HostAddress) +import Network.Socket (HostAddress) import Data.Binary.Get import qualified Data.ByteString as B -    + -- | --   Represents both the IP version and IP Header Length as a single Word8 --@@ -43,18 +42,18 @@  -- | --   Get the IP Version--- -+--+ipVersion :: IPVerIHL -> Word8 ipVersion (IPVerIHL v) = v `shiftR` 4  -- | --   Get the IP Header Length--- -+--+ipHeaderLength :: IPVerIHL -> Word8 ipHeaderLength (IPVerIHL v) = v .&. 0x0f-   -    ++ -- | --   Represents both the IP flags and IP fragment version a single Word8 --@@ -64,27 +63,29 @@  -- | --   Get the IP Version--- --ipFlags (IPFlagsFragment v) = v `shiftR` 13+--+-- ipFlags :: IPFlagsFragment -> Word16+-- ipFlags (IPFlagsFragment v) = v `shiftR` 13  -- | --   Get the IP Header Length--- +-- -ipFragmentOffset (IPFlagsFragment v) = v .&. 0x1fffffff   -    - +-- ipFragmentOffset :: IPFlagsFragment -> Word16+-- ipFragmentOffset (IPFlagsFragment v) = v .&. 0x1fffffff++ -- | --   The protocol for the data in an IP packet --  newtype IPProtocol = IPProtocol Word8     deriving (Eq, Ord, Bits, Num, Integral, Enum, Real, Show)-    -ipProtocolFromList = wordsToWord16- -    ++-- ipProtocolFromList :: [Word8] -> Word16+-- ipProtocolFromList = wordsToWord16++ -- | --   The Type of Service --@@ -92,28 +93,27 @@ newtype IPTOS = IPTOS Word8     deriving (Eq, Ord, Bits, Num, Integral, Enum, Real, Show) -ipTosFromList = wordsToWord32-    +-- ipTosFromList = wordsToWord32  -- |---  The IPPayload type is used to store each of the possible payload +--  The IPPayload type is used to store each of the possible payload --  that etherbunny knows about---    -    -data IPPayload = Foo-    +--++-- data IPPayload = Foo+ -- | --   The IPPkt type gives an interface to Internet Protocol packets -- -data IPPkt = IPPkt { +data IPPkt = IPPkt {          ipVerIHL           :: !IPVerIHL,   -- ^ version and header length          ipTOS              :: !IPTOS,      -- ^ type of service          ipTotalLength      :: !Word16,     -- ^ total length of the datagram          ipIdentification   :: !Word16,     -- ^ identification for all fragments of this datagram          ipFlagsFragment    :: !IPFlagsFragment, -- ^ both the flags and the fragment offset          ipTTL              :: !Word8,      -- ^ time to live-         ipProtocol         :: !IPProtocol, -- ^ protocol +         ipProtocol         :: !IPProtocol, -- ^ protocol          ipHeaderChecksum   :: !Word16,     -- ^ checksum of the header and options          ipSource           :: !HostAddress, -- ^ source address          ipDestination      :: !HostAddress, -- ^ destination address@@ -124,15 +124,15 @@ -- | --  Show ip addresses in a nicer format ---showsIP m = +showsIP :: (Bits a) => a -> String -> String+showsIP m =     foldr (\i a -> shows (getWord m i) . showString "." . a) (shows (getWord m 0) ) $ [3,2,1]     where         getWord x i = (x `shiftR` (i*8)) .&. 0xff-        showsHexByte x a = showString $ tail $ showHex (16^2+x) a -       + instance Show IPPkt where-  showsPrec p pkt = +  showsPrec p pkt =             showString "\n  IP: Ip Version " . showsPrec p (ipVersion $ ipVerIHL pkt)           . showString "\n      Header length " . showsPrec p (ipHeaderLength $ ipVerIHL pkt)           . showString "\n      TOS: " . showsPrec p (ipTOS pkt)@@ -147,8 +147,8 @@           . showString "\n      Options: " . showsPrec p (ipOptions pkt)           . showString "\n      Payload: " . showsPrec p (ipPayload pkt)           . showString "\n"-        + getIPPacket :: Get IPPkt getIPPacket = do     verihl  <- getWord8@@ -164,11 +164,11 @@     let hl = ipHeaderLength $ IPVerIHL verihl     options <- getByteString $ fromIntegral $ hl - 5     payload <- case ipprot of-        6 -> do +        6 -> do             let tcplen = fromIntegral $  tlength - (fromIntegral (hl*4))             tcp <- getTCPPacket tcplen srcip dstip             return $ Just tcp-        otherwise -> do +        _ -> do             skip $ (fromIntegral $ tlength - (fromIntegral hl)*4)             return Nothing     return $ IPPkt
Network/Etherbunny/Tcp.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-} ----------------------------------------------------------------------------- -- | -- Module      :  Etherbunny.Tcp@@ -12,26 +13,24 @@ -- ----------------------------------------------------------------------------- -{-# OPTIONS_GHC -fglasgow-exts -funbox-strict-fields #-}- module Network.Etherbunny.Tcp (     -- * Types     TCPPkt,-    +     -- * Functions     getTCPPacket, ) where-    -import Network.Etherbunny.Packet-    ++-- import Network.Etherbunny.Packet+ import Data.Word import Numeric import Bits-import Network (PortNumber) +-- import Network (PortNumber) import Data.Binary.Get import qualified Data.ByteString as B -    + -- | --   Represents the Data Offset, ECN, and Control Bits --@@ -41,66 +40,69 @@  -- | --   Get the Data Offset--- -+--+tcpDataOffset :: TCPDOECNCB -> Word16 tcpDataOffset (TCPDOECNCB v) = v `shiftR` 12  -- | --   Get the TCP ECN--- -+--+tcpECN :: TCPDOECNCB -> Word16 tcpECN (TCPDOECNCB v) = (v `shiftR` 6) .&. 0x0f-   -  ++ -- | --   Get the TCP Control Bits--- -+--+tcpControlBits :: TCPDOECNCB -> Word16 tcpControlBits (TCPDOECNCB v) = v .&. 0x2f- - ++ -- | --   Compute a TCP checksum, given a starting sum value --  checksum :: Word16 -> B.ByteString -> Word16 checksum c b = fromIntegral $ (cb .&. 0xFFFF) + (cb `shiftR` 16) where-    cb = checksum' (fromIntegral c) 0 b +    cb = checksum' (fromIntegral c) 0 b     checksum' :: Word32 -> Int -> B.ByteString -> Word32-    checksum' c r b = if r >= B.length b-        then fromIntegral c+    checksum' d r e = if r >= B.length b+        then fromIntegral d         else-            if r == (B.length b) -1-                then c + (fromIntegral (B.index b r) `shiftL` 8)-                else let h = (fromIntegral $ B.index b r) :: Word32-                         l = (fromIntegral $ B.index b $ r+1) :: Word32-                         s = (h `shiftL` 8 .|. l) + c+            if r == (B.length e) -1+                then d + (fromIntegral (B.index e r) `shiftL` 8)+                else let h = (fromIntegral $ B.index e r) :: Word32+                         l = (fromIntegral $ B.index e $ r+1) :: Word32+                         s = (h `shiftL` 8 .|. l) + d                      in checksum' s (r+2) b-  -data TCPPayload = Foo-    + -- |+--   Dummy TCPPayload type+--+type TCPPayload = Int++-- | --   The IPPkt type gives an interface to Internet Protocol packets -- -data TCPPkt = TCPPkt { +data TCPPkt = TCPPkt {          tcpSourcePort      :: !Word16, -- ^ version and header length          tcpDestinationPort :: !Word16, -- ^ type of service          tcpSequenceNumber  :: !Word32,     -- ^ total length of the datagram          tcpAcknowledgement :: !Word32,     -- ^ identification for all fragments of this datagram          tcpDOECNCB         :: !TCPDOECNCB, -- ^ Data Offset, ECN, Control Bits          tcpWindow          :: !Word16,     -- ^ time to live-         tcpChecksum        :: !Word16,     -- ^ checksum of the header and options +         tcpChecksum        :: !Word16,     -- ^ checksum of the header and options          tcpChecksumCorrect :: !Bool,       -- ^ true if the checksum is correct          tcpUrgentPointer   :: !Word16,     -- ^ pointer to the end seq of urgent data          tcpOptions         :: ![Word8],    -- ^ tcp options          tcpPayload         :: !(Maybe TCPPayload)      -- ^ payload        } -       + instance Show TCPPkt where-  showsPrec p pkt = +  showsPrec p pkt =             showString "\n  TCP: Source Port " . showsPrec p (tcpSourcePort pkt)           . showString "\n       Destination Port " . showsPrec p (tcpDestinationPort pkt)           . showString "\n       Sequence Number: " . showsPrec p (tcpSequenceNumber pkt)@@ -113,12 +115,12 @@                               . showString " correct? " . showsPrec p (tcpChecksumCorrect pkt)           . showString "\n       Urgent Pointer: " . showsPrec p (tcpUrgentPointer pkt)           . showString "\n       Options: " . showsPrec p (tcpOptions pkt)-          -- . showString "\n       Payload: " . showsPrec p (ipPayload pkt)-       +          . showString "\n       Payload: " . showsPrec p (tcpPayload pkt) + getTCPPacket :: Int -> Word32 -> Word32 -> Get TCPPkt getTCPPacket len srcip dstip = do-    r <- remaining +    r <- remaining     fullBytes <- lookAhead $ getByteString $ fromIntegral r     let headersum = srcip + dstip + (fromIntegral len) + 6     let headersum16 = (headersum .&. 0xFFFF) + (headersum `shiftR` 16)@@ -148,4 +150,3 @@         urg         (B.unpack opt)         (Nothing)-
etherbunny.hs view
@@ -9,21 +9,17 @@ -- Portability :  ghc -- -- Example program for using etherbunny.--- +-- --------------------------------------------------------------------------------{-# OPTIONS_GHC -fglasgow-exts -funbox-strict-fields #-}+{-# OPTIONS_GHC -funbox-strict-fields #-}  module Main where  import Network.Etherbunny.Ethernet-import Network.Etherbunny.Packet+-- import Network.Etherbunny.Packet  import Network.Pcap -import Foreign-import Data.Word import qualified Data.ByteString as B8 import qualified Data.ByteString.Lazy as B8L import Data.Binary.Get@@ -32,52 +28,62 @@ import System.Console.GetOpt import Data.Maybe ( fromMaybe ) import System.Environment(getArgs)-import List -import IO +import List+import IO +version :: String version = "0.2" +main :: IO () main = do     argv <- getArgs-    (o,_) <- etherbunnyOpts argv +    (o,_) <- etherbunnyOpts argv     print o     hSetBuffering stdout NoBuffering     p <- openFromOptions o-    withForeignPtr p $ \ptr -> do-        pkts <- packets ptr-        let pkts' = map process pkts-        mapM print pkts'+    loopBS p (-1) captcha+    -- pkts <- packets p+    -- pkts' <- mapM process pkts+    -- mapM print pkts'     return ()-        ++captcha :: PktHdr -> B8.ByteString -> IO ()+captcha _ bytes = print $ runGet getEtherPacket $ B8L.fromChunks [bytes]++packets :: PcapHandle -> IO [(PktHdr, B8.ByteString)] packets p = do-    (ph, bytep) <- next p-    if bytep == nullPtr-        then return []+    (ph, bytes) <- nextBS p+    if B8.length bytes == 0+        then print ph >> return []         else do rest <- (unsafeInterleaveIO $ packets p)-                return $ (ph, bytep) : rest-    -process (ph, bytep) = runGet getEtherPacket $ B8L.fromChunks [a]-    where a = B8.packCStringLen (castPtr bytep, fromIntegral (caplen ph))+                return $ (ph, bytes) : rest -data Flag -    = Version | InputFile String | InputDevice String +process :: (PktHdr, B8.ByteString) -> IO EtherPkt+process (_, bytes) = do+    return $ runGet getEtherPacket $ B8L.fromChunks [bytes]++data Flag+    = Version | InputFile String | InputDevice String       deriving Show +openFromOptions :: [Flag] -> IO PcapHandle openFromOptions o = do     let f = find isInputFile o `mplus` find isInputDevice o     case f of         Just (InputFile fname)   -> openOffline fname-        Just (InputDevice iname) -> openLive iname 1 False 10000-        otherwise -> ioError $ userError $ "unexpected argument error in otherwise case of openFromOptions"+        Just (InputDevice iname) -> openLive iname 10000 False 100000+        _ -> ioError $ userError $ "unexpected argument error in otherwise case of openFromOptions" +isInputFile :: Flag -> Bool isInputFile (InputFile _) = True isInputFile _ = False +isInputDevice :: Flag -> Bool isInputDevice (InputDevice _) = True isInputDevice _ = False  infile :: Maybe String -> Flag-infile  = InputFile . fromMaybe "-"+infile = InputFile . fromMaybe "-"  indev :: Maybe String -> Flag indev = InputDevice . fromMaybe ""@@ -88,23 +94,21 @@     , Option ['r']     ["file"]    (OptArg infile "FILE")     "read packets from FILE"     , Option ['i']     ["device"]  (OptArg indev "INTERFACE") "read packets from INTERFACE"     ]-      etherbunnyOpts :: [String] -> IO ([Flag], [String])-etherbunnyOpts argv = +etherbunnyOpts argv =    case getOpt Permute options argv of-      (o,n,[]  ) -> case checkOptions o of +      (o,n,[]  ) -> case checkOptions o of                         [] -> return (o,n)                         errs  -> ioError $ userError $ concat errs ++ usageInfo header options       (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))   where header = "Usage: etherbunny [OPTION...]"  checkOptions :: [Flag] -> [String]-checkOptions opts = +checkOptions opts =     let hasFile = any isInputFile opts         hasDevice = any isInputDevice opts-    in case (hasDevice, hasFile) of +    in case (hasDevice, hasFile) of         (True, True) -> ["Must specify only one Interface or File"]         (False, False) -> ["Must specify an Interface or File"]-        otherwise -> []-        +        _ -> []
+ tests/packet.hs view
@@ -0,0 +1,52 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Etherbunny.Packet+-- Copyright   :  (c) Nicholas Burlett 2007+-- License     :  GPL (see the file LICENSE)+--+-- Maintainer  :  nickburlett@mac.com+-- Stability   :  experimental+-- Portability :  ghc+--+-- Etherbunny tests.+--+-----------------------------------------------------------------------------++import Network.Etherbunny.Packet+import List+import Test.QuickCheck+import Text.Printf+import Bits+import Data.Word+import Monad++main :: IO ()+main  = mapM_ (\(s,a) -> printf "%-25s: " s >> a) tests++wordsFromInt :: (Num a, Bits t, Integral t) => t -> [a]+wordsFromInt w = reverse $ unfoldr buildwords (w, bitSize w `div` 8) where+    buildwords (_,0) = Nothing+    buildwords (x,c) = Just ( fromIntegral (x .&. 0xFF), (x `shiftR` 8, c -1))++-- | Test that the bytes from wordsToInt are the same as the input bytes+-- prop_wordsToIntBytes s = wordsToIntBytes (len s) s ==+prop_wordstofrom32 :: Word32 -> Bool+prop_wordstofrom32 x = (wordsToWord32 . wordsFromInt) x == x++prop_wordstofrom16 :: Word16 -> Bool+prop_wordstofrom16 x = (wordsToWord16 . wordsFromInt) x == x++instance Arbitrary Word32 where+    arbitrary = liftM fromIntegral (arbitrary :: Gen Int)+    coarbitrary n = variant 0 . coarbitrary (fromIntegral n ::Word32)++instance Arbitrary Word16 where+    arbitrary = liftM fromIntegral (arbitrary :: Gen Int)+    coarbitrary n = variant 0 . coarbitrary (fromIntegral n ::Word16)+++-- and add this to the tests list+tests :: [(String, IO ())]+tests  = [("wordsToWord32 . wordsFromInt", test prop_wordstofrom32)+         ,("wordsToWord16 . wordsFromInt", test prop_wordstofrom16)+         ]