diff --git a/Etherbunny.cabal b/Etherbunny.cabal --- a/Etherbunny.cabal +++ b/Etherbunny.cabal @@ -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 diff --git a/Network/Etherbunny/Ethernet.hs b/Network/Etherbunny/Ethernet.hs --- a/Network/Etherbunny/Ethernet.hs +++ b/Network/Etherbunny/Ethernet.hs @@ -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) diff --git a/Network/Etherbunny/Ip.hs b/Network/Etherbunny/Ip.hs --- a/Network/Etherbunny/Ip.hs +++ b/Network/Etherbunny/Ip.hs @@ -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 diff --git a/Network/Etherbunny/Tcp.hs b/Network/Etherbunny/Tcp.hs --- a/Network/Etherbunny/Tcp.hs +++ b/Network/Etherbunny/Tcp.hs @@ -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) - diff --git a/etherbunny.hs b/etherbunny.hs --- a/etherbunny.hs +++ b/etherbunny.hs @@ -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 -> [] - + _ -> [] diff --git a/tests/packet.hs b/tests/packet.hs new file mode 100644 --- /dev/null +++ b/tests/packet.hs @@ -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) + ]