{-# LANGUAGE OverloadedStrings #-}
module NetSpider.RPL.CLI.Analyze
( DODAGAttributes(..),
analyzeDIO,
analyzeDAO
) where
import Control.Applicative (empty)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Maybe (MaybeT(..))
import Data.Graph.Inductive (LNode, LEdge, Gr)
import qualified Data.Graph.Inductive as FGL
import Data.List (sortOn, reverse)
import Data.Maybe (listToMaybe)
import Data.Monoid ((<>))
import Data.Text (Text)
import NetSpider.Log (WriterLoggingM, logErrorW, spack, logDebugW)
import NetSpider.SeqID
(SeqIDMaker, newSeqIDMaker, convertGraph, originalIDFor)
import NetSpider.Snapshot
( SnapshotNode, SnapshotLink, SnapshotGraph,
nodeId, nodeAttributes, sourceNode, destinationNode, linkAttributes,
graphTimestamp
)
import NetSpider.Timestamp (Timestamp, showTimestamp)
import NetSpider.RPL.DIO (SnapshotGraphDIO)
import NetSpider.RPL.DAO (SnapshotGraphDAO)
import NetSpider.RPL.FindingID
( IPv6ID, FindingID, FindingType(..), ipv6Only, ipv6ToText)
data DODAGAttributes =
DODAGAttributes
{ node_num :: Int,
edge_num :: Int,
depth :: Int,
root :: IPv6ID,
time :: Timestamp
}
deriving (Show,Eq,Ord)
analyzeDIO :: SnapshotGraphDIO -> WriterLoggingM (Maybe DODAGAttributes)
analyzeDIO = analyzeGeneric RootDest FindingDIO
analyzeDAO :: SnapshotGraphDAO -> WriterLoggingM (Maybe DODAGAttributes)
analyzeDAO = analyzeGeneric RootSource FindingDAO
analyzeGeneric :: RootType -> FindingType -> SnapshotGraph FindingID na la -> WriterLoggingM (Maybe DODAGAttributes)
analyzeGeneric rtype ftype graph = runMaybeT $ go
where
maybeLog m err_log =
case m of
Nothing -> do
lift $ logErrorW err_log
empty
Just v -> return v
eitherLog e =
case e of
Left err_log -> maybeLog Nothing err_log
Right v -> return v
(seqid, gr) = toGr graph
ft_str =
case ftype of
FindingDIO -> "DIO"
FindingDAO -> "DAO"
logRootIP root_ip = do
lift $ logDebugW ("Root of the " <> ft_str <> " graph: " <> ipv6ToText root_ip)
logTS ts = do
lift $ logDebugW ("Timestamp of the " <> ft_str <> " graph: " <> showTimestamp ts)
go = do
root_node <- fmap fst $ eitherLog $ getRoot rtype gr
root_ip <- fmap ipv6Only $ maybeLog
(originalIDFor seqid root_node)
("Cannot find the FindingID for root node " <> (spack root_node) <> ".")
logRootIP root_ip
graph_ts <- maybeLog (graphTimestamp graph) ("The graph has no timestamp.")
logTS graph_ts
return DODAGAttributes { node_num = nodeNum gr,
edge_num = edgeNum gr,
depth = getDepth root_node rtype gr,
root = root_ip,
time = graph_ts
}
toLNode :: SnapshotNode Int na -> LNode (Maybe na)
toLNode n = (nodeId n, nodeAttributes n)
toLEdge :: SnapshotLink Int la -> LEdge la
toLEdge l = (sourceNode l, destinationNode l, linkAttributes l)
toGr :: SnapshotGraph FindingID na la -> (SeqIDMaker FindingID FGL.Node, Gr (Maybe na) la)
toGr graph = (got_maker, FGL.mkGraph lnodes ledges)
where
(got_maker, (new_nodes, new_links)) = convertGraph (newSeqIDMaker 0) graph
lnodes = map toLNode new_nodes
ledges = map toLEdge new_links
nodeNum :: Gr na la -> Int
nodeNum = FGL.order
edgeNum :: Gr na la -> Int
edgeNum = FGL.size
data RootType = RootSource
| RootDest
getRoot :: RootType -> Gr na la -> Either Text (LNode na)
getRoot rt gr = toEither
$ reverse
$ sortOn childNum
$ filter (\n -> parentNum n == 0)
$ FGL.labNodes gr
where
(parentNum, childNum) =
case rt of
RootSource -> ((FGL.indeg gr . fst), (FGL.outdeg gr . fst))
RootDest -> ((FGL.outdeg gr . fst), (FGL.indeg gr . fst))
toEither [] = Left ("The graph has no node that has no parent.")
toEither [n] = Right n
toEither (rnode : others) =
if childNum rnode > 0 && (all (\n -> childNum n == 0) others)
then Right rnode
else if childNum rnode == 0
then Left ("The graph contains orphan nodes only.")
else Left ("The graph contains multiple root candidates.")
getDepth :: FGL.Node
-> RootType
-> Gr na la
-> Int
getDepth root_node rtype gr = maximum' $ map toPathLen $ FGL.spTree root_node $ convertGr gr
where
convertGr = FGL.gmap setEdgeDir . FGL.emap setEdgeLabel
where
setEdgeLabel _ = (1 :: Int)
setEdgeDir orig@(inedges, n, nlabel, outedges) =
case rtype of
RootSource -> orig
RootDest -> (outedges, n, nlabel, inedges)
toPathLen (FGL.LP nodes) = length nodes - 1
maximum' [] = 0
maximum' l = maximum l