Etherbunny-0.2: etherbunny.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Etherbunny.Ethernet
-- Copyright   :  (c) Nicholas Burlett 2007
-- License     :  GPL (see the file LICENSE)
--
-- Maintainer  :  nickburlett@mac.com
-- Stability   :  experimental
-- Portability :  ghc
--
-- Example program for using etherbunny.
-- 
-----------------------------------------------------------------------------


{-# OPTIONS_GHC -fglasgow-exts -funbox-strict-fields #-}

module Main where

import Network.Etherbunny.Ethernet
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
import System.IO.Unsafe
import Monad
import System.Console.GetOpt
import Data.Maybe ( fromMaybe )
import System.Environment(getArgs)
import List 
import IO 

version = "0.2"

main = do
    argv <- getArgs
    (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'
    return ()
        
packets p = do
    (ph, bytep) <- next p
    if bytep == nullPtr
        then 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))

data Flag 
    = Version | InputFile String | InputDevice String 
      deriving Show

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"

isInputFile (InputFile _) = True
isInputFile _ = False

isInputDevice (InputDevice _) = True
isInputDevice _ = False

infile :: Maybe String -> Flag
infile  = InputFile . fromMaybe "-"

indev :: Maybe String -> Flag
indev = InputDevice . fromMaybe ""

options :: [OptDescr Flag]
options =
    [ Option ['V','?'] ["version"] (NoArg Version)            "show version number"
    , 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 = 
   case getOpt Permute options argv 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 = 
    let hasFile = any isInputFile opts
        hasDevice = any isInputDevice opts
    in case (hasDevice, hasFile) of 
        (True, True) -> ["Must specify only one Interface or File"]
        (False, False) -> ["Must specify an Interface or File"]
        otherwise -> []