------------------------------------------------------------------------------
--- Knowledge-based Autonomic Heterogeneous Networks (KAHN)
--- @author  Rajesh Krishnan, Cosocket LLC
--- @version September 2014
------------------------------------------------------------------------------
{-
Copyright (c) 2014, Cosocket 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 Cosocket LLC 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 HOLDER 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.
-}
{-# LANGUAGE OverloadedStrings #-}
module KAHN.PKTPROC where
import qualified Data.ByteString.Char8 as B
import Control.Monad (mapM_,forever,when)
import Control.Concurrent.Chan
import System.ZMQ4.Monadic
import Control.Concurrent
import Network.Pcap
import KAHN.Config 
import KBITypes
import System.Info.MAC (refresh)
import System.IO (hPutStrLn,stderr)

import Data.Binary                                    (encode)
import qualified Data.ByteString.Char8 as B           (pack,unpack)
import qualified Data.ByteString.Lazy.Internal as BLI (unpackBytes)
import Data.Char (chr)
import GHC.Word (Word8)

pktproc :: Config -> ZMQ z ()
pktproc cfg = mapM_ (ifpktproc cfg) (words (cfgInterfaces cfg)) 

ifpktproc cfg ifc = do
  (ch,dev)  <- liftIO $ openChanDev ifc myfilt
  bbin      <- socket Pub
  bbout     <- socket Sub
  hdrbyt    <- liftIO $ (mymac ifc) >>= return . (\x -> broaddr ++ x ++ myproto)
  connect   bbin (cfgBBIN cfg)
  connect   bbout (cfgBBOUT cfg)
  subscribe bbout "OPKT"
  async     (inpkt  bbout dev hdrbyt)
  async     (outpkt bbin ifc dev ch hdrbyt)
  where broaddr = "\255\255\255\255\255\255"
        myproto = "\255\255"
        myfilt  = "ether proto 0xffff"

openChanDev ifc filter = do
  ch        <- newChan
  dev       <- openLive ifc 65535 False 0
  setFilter dev filter True 0
  forkIO $ (loopBS dev (-1) (\_ packet -> writeChan ch (B.unpack packet))) >> return ()
  return (ch,dev)   -- XXX: ought to test for successful initialization 

inpkt bbout dev hdrbyt = forever $ do
  addr <- receive bbout 
  more <- moreToReceive bbout
  when more $ do
    contents <- receive bbout 
    liftIO $ sendPacketBS dev $ B.pack (hdrbyt ++ (B.unpack contents))

outpkt bbin ifc dev ch hdrbyt = forever $ do
  pkt <- liftIO $ readChan ch >>= return . drop (length hdrbyt)
  send bbin [SendMore] "IPKT"
  send bbin []         $ B.pack (show (IPKT ifc pkt))

mymac ifc = do
  x <- refresh >>= 
         return . map (map (chr . fromEnum) . BLI.unpackBytes . encode . snd) 
                . filter (\x -> (fst x) == ifc) 
  z <- if (length x) == 1 then return (head x) 
         else (hPutStrLn stderr "error finding MAC" >> return "")
  return z
