{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PackageImports #-} module MptcpAnalyzer.Commands.ListMptcp ( piListMpTcpOpts , cmdListMptcpConnections , cmdListSubflows ) where import MptcpAnalyzer.Cache import MptcpAnalyzer.Commands.Definitions as CMD import MptcpAnalyzer.Commands.List as CMD import MptcpAnalyzer.Pcap import MptcpAnalyzer.Stream import MptcpAnalyzer.Types import Net.Mptcp -- import Net.Mptcp.Types (MptcpConnection(..), MptcpSubflow, showMptcpConnection) import qualified Control.Foldl as L import Control.Lens hiding (argument) import Data.Either (fromRight) import Data.Maybe (catMaybes, fromJust) import qualified Data.Set as Set import Data.Word (Word16, Word32, Word64, Word8) import Frames import "mptcp-pm" Net.Tcp.Constants (TcpFlag(..)) import Options.Applicative import qualified Pipes.Prelude as PP import Polysemy (Embed, Member, Members, Sem) import qualified Polysemy as P import Polysemy.State as P import Polysemy.Trace as P import Polysemy.Log (Log) import qualified Polysemy.Log as Log piListMpTcpOpts :: ParserInfo CommandArgs piListMpTcpOpts = info ( parserList <**> helper) ( progDesc "List MPTCP connections" ) where parserList = ArgsListMpTcpConnections <$> switch ( long "detailed" <> help "detail connections") piListMptcpSubflowOpts :: ParserInfo CommandArgs piListMptcpSubflowOpts = info ( parserList <**> helper) ( progDesc "List MPTCP connections" ) where parserList = ArgsListSubflows <$> switch ( long "detailed" <> help "detail connections") -- piListMptcpReinjectionsOpts :: ParserInfo CommandArgs -- piListMptcpReinjectionsOpts = info ( -- parserList <**> helper) -- ( progDesc "List MPTCP reinjections" -- ) -- where -- parserList = ArgsListSubflows <$> switch ( long "detailed" <> help "detail connections") type SomeFrame = Frame Packet -- TODO return mpconStreamId instead getMpTcpStreams :: SomeFrame -> [StreamIdMptcp] getMpTcpStreams ps = catMaybes $ L.fold L.nub (view mptcpStream <$> ps) filterMptcpConnection :: SomeFrame -> StreamId Mptcp -> SomeFrame filterMptcpConnection frame streamId = streamPackets where streamPackets = filterFrame (\x -> x ^. mptcpStream == Just streamId) frame -- buildMptcpConnectionFromRow :: Packet -> TcpConnection -- buildMptcpConnectionFromRow r = -- MptcpConnection { -- srcIp = r ^. ipSource -- , dstIp = r ^. ipDest -- , srcPort = r ^. tcpSrcPort -- , dstPort = r ^. tcpDestPort -- , priority = Nothing -- for now -- , localId = 0 -- , remoteId = 0 -- , subflowInterface = Nothing -- } cmdListSubflows :: (Members '[Log, P.State MyState, P.Trace, Cache, Embed IO] r) => Bool -- ^ Detailed -> Sem r RetCode cmdListSubflows detailed = do P.trace "not implemented yet" return CMD.Continue {- -} cmdListMptcpConnections :: (Members [Log, P.Trace, P.State MyState, Cache, P.Embed IO] r) => Bool -- ^ Detailed -> Sem r RetCode cmdListMptcpConnections _detailed = do -- TODO this part should be extracted so that state <- P.get let loadedPcap = view loadedFile state case loadedPcap of Nothing -> do P.trace "please load a pcap first" return CMD.Continue Just frame -> do -- log $ "Number of rows " ++ show (frameLength frame) P.trace $ "Number of MPTCP connections " ++ show (length mptcpStreams) P.trace $ show mptcpStreams P.trace $ concatMap showEitherCon mptcpConnections -- >> return CMD.Continue where mptcpConnections :: [Either String MptcpConnection] mptcpConnections = map (fmap ffCon . buildMptcpConnectionFromStreamId frame ) mptcpStreams showEitherCon :: Either String MptcpConnection -> String showEitherCon (Left msg) = msg ++ "\n" showEitherCon (Right mptcpCon) = showConnection mptcpCon ++ "\n" mptcpStreams = getMpTcpStreams frame