diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # Revision history for net-spider-rpl-cli +## 0.1.3.0 -- 2020-04-18 + +* Add Analyze module. + ## 0.1.2.2 -- 2019-12-29 * Confirm `ip-1.7.0`. diff --git a/net-spider-rpl-cli.cabal b/net-spider-rpl-cli.cabal --- a/net-spider-rpl-cli.cabal +++ b/net-spider-rpl-cli.cabal @@ -1,5 +1,5 @@ name: net-spider-rpl-cli -version: 0.1.2.2 +version: 0.1.3.0 author: Toshio Ito maintainer: Toshio Ito license: BSD3 @@ -24,10 +24,11 @@ ghc-options: -Wall -fno-warn-unused-imports default-extensions: StrictData other-extensions: OverloadedStrings, RankNTypes - exposed-modules: NetSpider.RPL.CLI + exposed-modules: NetSpider.RPL.CLI, + NetSpider.RPL.CLI.Analyze -- other-modules: build-depends: base >=4.11.1.0 && <4.13, - net-spider >=0.4.0.0 && <0.5, + net-spider >=0.4.3.0 && <0.5, net-spider-rpl >=0.4.0.0 && <0.5, net-spider-cli >=0.2.0.0 && <0.3, text >=1.2.2.2 && <1.3, @@ -35,7 +36,9 @@ greskell >=1.0.0.0 && <1.1, optparse-applicative >=0.14.3.0 && <0.16, monad-logger >=0.3.28.1 && <0.4, - time >=1.8.0.2 && <1.10 + time >=1.8.0.2 && <1.10, + fgl >=5.6.0.0 && <5.8, + transformers >=0.5.5.0 && <0.6 flag static description: Static link @@ -61,10 +64,15 @@ main-is: Spec.hs -- default-extensions: -- other-extensions: - other-modules: NetSpider.RPL.CLISpec + other-modules: NetSpider.RPL.CLISpec, + NetSpider.RPL.CLI.AnalyzeSpec build-depends: base, net-spider-rpl-cli, net-spider, net-spider-rpl, optparse-applicative, net-spider-cli, + text, monad-logger, hspec >=2.5.5, - ip >=1.3.0 && <1.8 + ip >=1.3.0 && <1.8, + hashable >=1.2.6.1 && <1.4, + bytestring >=0.10.8.2 && <0.11, + fast-logger >=2.4.11 && <3.1 source-repository head type: git diff --git a/src/NetSpider/RPL/CLI/Analyze.hs b/src/NetSpider/RPL/CLI/Analyze.hs new file mode 100644 --- /dev/null +++ b/src/NetSpider/RPL/CLI/Analyze.hs @@ -0,0 +1,152 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module: NetSpider.RPL.CLI.Analyze +-- Description: Analyze graph attributes +-- Maintainer: Toshio Ito +-- +-- @since 0.1.3.0 +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) + + +-- | Attributes of a DODAG. +data DODAGAttributes = + DODAGAttributes + { node_num :: Int, + edge_num :: Int, + depth :: Int, + root :: IPv6ID, + time :: Timestamp + } + deriving (Show,Eq,Ord) + +-- | Get analysis on a DIO graph. +analyzeDIO :: SnapshotGraphDIO -> WriterLoggingM (Maybe DODAGAttributes) +analyzeDIO = analyzeGeneric RootDest FindingDIO + +-- | Get analysis on a DAO graph. +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 -- ^ Node with no incoming edges. + | RootDest -- ^ Node with no outgoing edges. + +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 -- ^ the root node + -> RootType -- ^ type of the root + -> 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 + diff --git a/test/NetSpider/RPL/CLI/AnalyzeSpec.hs b/test/NetSpider/RPL/CLI/AnalyzeSpec.hs new file mode 100644 --- /dev/null +++ b/test/NetSpider/RPL/CLI/AnalyzeSpec.hs @@ -0,0 +1,300 @@ +{-# LANGUAGE OverloadedStrings #-} +module NetSpider.RPL.CLI.AnalyzeSpec (main,spec) where + +import Control.Monad.Logger (LogLevel(..)) +import System.Log.FastLogger (fromLogStr) +import qualified Data.ByteString as BS +import Data.Foldable (foldl') +import Data.Hashable (Hashable) +import Data.Int (Int64) +import Data.Maybe (fromJust) +import Data.Text (Text, unpack) +import Data.Text.Encoding (encodeUtf8) +import NetSpider.Found (FoundNode(..), FoundLink(..), LinkState(..)) +import NetSpider.Log (runWriterLoggingM, LogLine) +import NetSpider.Query (foundNodePolicy, unifyLinkSamples, Query) +import NetSpider.RPL.FindingID (FindingID, idFromText, ipv6FromText, IPv6ID) +import NetSpider.RPL.DAO + ( DAONode(..), DAOLink(..), daoDefQuery, FoundNodeDAO, + SnapshotGraphDAO + ) +import NetSpider.RPL.DIO + ( DIONode(..), DIOLink(..), MergedDIOLink(..), NeighborType(..), + FoundNodeDIO, SnapshotGraphDIO, dioDefQuery + ) +import NetSpider.Snapshot (SnapshotGraph) +import NetSpider.Timestamp (fromEpochMillisecond) +import NetSpider.Weaver (Weaver, newWeaver, getSnapshot, addFoundNode) +import Test.Hspec + +import NetSpider.RPL.CLI.Analyze + ( analyzeDAO, analyzeDIO, + DODAGAttributes(DODAGAttributes) + ) +import qualified NetSpider.RPL.CLI.Analyze as A + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + spec_DIO + spec_DAO + +makeSnapshotFromQuery :: (Ord n, Hashable n, Show n) => Query n na fla sla -> [FoundNode n na fla] -> SnapshotGraph n na sla +makeSnapshotFromQuery query fns = getS $ foldl' (\w fn -> addFoundNode fn w) newW fns + where + newW = newWeaver $ foundNodePolicy $ query + getS = getSnapshot $ unifyLinkSamples $ query + +makeSnapshotDAO :: [FoundNodeDAO] -> SnapshotGraphDAO +makeSnapshotDAO = makeSnapshotFromQuery $ daoDefQuery [] + +makeSnapshotDIO :: [FoundNodeDIO] -> SnapshotGraphDIO +makeSnapshotDIO = makeSnapshotFromQuery $ dioDefQuery [] + +idFromText' :: Text -> FindingID +idFromText' = fromJust . idFromText + +ipFromText' :: Text -> IPv6ID +ipFromText' = fromJust . ipv6FromText + +defPathLifeTime :: Word +defPathLifeTime = 3600 + +daoNode :: Int64 -- ^ timestamp + -> Maybe Word -- ^ route num + -> Text -- ^ subject + -> [Text] -- ^ targets + -> FoundNodeDAO +daoNode ts mroutes sub targets = + FoundNode + { subjectNode = idFromText' sub, + foundAt = fromEpochMillisecond ts, + nodeAttributes = DAONode $ mroutes, + neighborLinks = map toFL targets + } + where + toFL t = FoundLink + { targetNode = idFromText' t, + linkState = LinkToTarget, + linkAttributes = DAOLink $ defPathLifeTime + } + +dioNode :: Int64 + -> Text -- ^ subject + -> [Text] -- ^ targets + -> FoundNodeDIO +dioNode ts sub targets = + FoundNode + { subjectNode = idFromText' sub, + foundAt = fromEpochMillisecond ts, + nodeAttributes = DIONode defRank defDioInterval, + neighborLinks = map toFL targets + } + where + defRank = 256 + defDioInterval = 10 + toFL t = + FoundLink + { targetNode = idFromText' t, + linkState = LinkToTarget, + linkAttributes = DIOLink PreferredParent defNRank Nothing + } + defNRank = 512 + +expectNoErrorLog :: [LogLine] -> IO () +expectNoErrorLog got_logs = + if (length $ filter matchLog got_logs) == 0 + then return () + else expectationFailure ("Expected no error/warn log, but found. " <> show got_logs) + where + matchLog (_, _, LevelError, _) = True + matchLog (_, _, LevelWarn, _) = True + matchLog (_, _, _, _) = False + +expectErrorLog :: [LogLine] -> Text -> IO () +expectErrorLog got_logs exp_err_msg = + if (length $ filter matchLog got_logs) == 0 + then expectationFailure ("Expected an error log matching " <> unpack exp_err_msg <> ", but not found.") + else return () + where + matchLog (_, _, LevelError, logstr) = matchLogMsg logstr + matchLog (_, _, _, _) = False + matchLogMsg logstr = encodeUtf8 exp_err_msg `BS.isInfixOf` fromLogStr logstr + +spec_DIO :: Spec +spec_DIO = describe "analyzeDIO" $ do + specify "root only" $ do + let fns = [ dioNode 100 "dio://[fd00::1]" [] + ] + (got, logs) = runWriterLoggingM $ analyzeDIO $ makeSnapshotDIO fns + got `shouldBe` + ( Just $ DODAGAttributes + { A.node_num = 1, + A.edge_num = 0, + A.depth = 0, + A.root = ipFromText' "fd00::1", + A.time = fromEpochMillisecond 100 + } + ) + expectNoErrorLog logs + specify "depth 1" $ do + let fns = [ dioNode 100 "dio://[fd00::1]" [], + dioNode 120 "dio://[fd00::2]" ["dio://[fd00::1]"], + dioNode 140 "dio://[fd00::3]" ["dio://[fd00::1]"], + dioNode 110 "dio://[fd00::4]" ["dio://[fd00::1]"] + ] + (got, logs) = runWriterLoggingM $ analyzeDIO $ makeSnapshotDIO fns + got `shouldBe` + ( Just $ DODAGAttributes + { A.node_num = 4, + A.edge_num = 3, + A.depth = 1, + A.root = ipFromText' "fd00::1", + A.time = fromEpochMillisecond 140 + } + ) + expectNoErrorLog logs + specify "depth 4" $ do + let fns = [ dioNode 150 "dio://[fd00::1]" [], + dioNode 110 "dio://[fd00::4]" ["dio://[fd00::3]"], + dioNode 120 "dio://[fd00::2]" ["dio://[fd00::1]"], + dioNode 200 "dio://[fd00::3]" ["dio://[fd00::2]"], + dioNode 170 "dio://[fd00::5]" ["dio://[fd00::4]"], + dioNode 189 "dio://[fd00::6]" ["dio://[fd00::2]"] + ] + (got, logs) = runWriterLoggingM $ analyzeDIO $ makeSnapshotDIO fns + got `shouldBe` + ( Just $ DODAGAttributes + { A.node_num = 6, + A.edge_num = 5, + A.depth = 4, + A.root = ipFromText' "fd00::1", + A.time = fromEpochMillisecond 200 + } + ) + expectNoErrorLog logs + specify "multiple orphan nodes with one root" $ do + let fns = [ dioNode 110 "dio://[fd00::1]" [], + dioNode 120 "dio://[fd00::2]" [], + dioNode 130 "dio://[fd00::3]" [], + dioNode 100 "dio://[fd00::4]" ["dio://[fd00::2]"] + ] + (got, logs) = runWriterLoggingM $ analyzeDIO $ makeSnapshotDIO fns + got `shouldBe` + ( Just $ DODAGAttributes + { A.node_num = 4, + A.edge_num = 1, + A.depth = 1, + A.root = ipFromText' "fd00::2", + A.time = fromEpochMillisecond 130 + } + ) + expectNoErrorLog logs + specify "multiple roots" $ do + let fns = [ dioNode 100 "dio://[fd00::1]" [], + dioNode 200 "dio://[fd00::2]" ["dio://[fd00::1]"], + dioNode 150 "dio://[fd00::3]" [], + dioNode 130 "dio://[fd00::4]" ["dio://[fd00::3]"] + ] + (got, logs) = runWriterLoggingM $ analyzeDIO $ makeSnapshotDIO fns + got `shouldBe` Nothing + expectErrorLog logs "multiple root" + specify "all orphan nodes" $ do + let fns = [ dioNode 120 "dio://[fd00::1]" [], + dioNode 170 "dio://[fd00::2]" [], + dioNode 110 "dio://[fd00::5]" [], + dioNode 100 "dio://[fd00::3]" [], + dioNode 180 "dio://[fd00::4]" [] + ] + (got, logs) = runWriterLoggingM $ analyzeDIO $ makeSnapshotDIO fns + got `shouldBe` Nothing + expectErrorLog logs "orphan nodes only" + + +spec_DAO :: Spec +spec_DAO = describe "analyzeDAO" $ do + specify "root only" $ do + let fns = [ daoNode 100 (Just 0) "dao://[fd00::1]" [] + ] + (got, logs) = runWriterLoggingM $ analyzeDAO $ makeSnapshotDAO fns + got `shouldBe` + ( Just $ DODAGAttributes + { A.node_num = 1, + A.edge_num = 0, + A.depth = 0, + A.root = ipFromText' "fd00::1", + A.time = fromEpochMillisecond 100 + } + ) + expectNoErrorLog logs + specify "depth 1" $ do + let fns = [ daoNode 100 (Just 3) "dao://[fd00::1]" + [ "dao://[fd00::2]", + "dao://[fd00::3]", + "dao://[fd00::4]" + ], + daoNode 100 Nothing "dao://[fd00::2]" [], + daoNode 100 Nothing "dao://[fd00::3]" [], + daoNode 100 Nothing "dao://[fd00::4]" [] + ] + (got, logs) = runWriterLoggingM $ analyzeDAO $ makeSnapshotDAO fns + got `shouldBe` + ( Just $ DODAGAttributes + { A.node_num = 4, + A.edge_num = 3, + A.depth = 1, + A.root = ipFromText' "fd00::1", + A.time = fromEpochMillisecond 100 + } + ) + expectNoErrorLog logs + specify "depth 4" $ do + let fns = [ daoNode 100 Nothing "dao://[fd00::3]" ["dao://[fd00::4]"], + daoNode 100 (Just 4) "dao://[fd00::1]" ["dao://[fd00::2]"], + daoNode 100 Nothing "dao://[fd00::5]" [], + daoNode 100 Nothing "dao://[fd00::2]" ["dao://[fd00::3]"], + daoNode 100 Nothing "dao://[fd00::4]" ["dao://[fd00::5]"] + ] + (got, logs) = runWriterLoggingM $ analyzeDAO $ makeSnapshotDAO fns + got `shouldBe` + ( Just $ DODAGAttributes + { A.node_num = 5, + A.edge_num = 4, + A.depth = 4, + A.root = ipFromText' "fd00::1", + A.time = fromEpochMillisecond 100 + } + ) + expectNoErrorLog logs + specify "multiple timestamps" $ do + let fns = [ daoNode 100 (Just 4) "dao://[fd00::1]" ["dao://[fd00::2]", "dao://[fd00::3]"], + daoNode 100 Nothing "dao://[fd00::2]" ["dao://[fd00::4]", "dao://[fd00::5]"], + daoNode 100 Nothing "dao://[fd00::3]" [], + daoNode 100 Nothing "dao://[fd00::4]" [], + daoNode 100 Nothing "dao://[fd00::5]" [], + + daoNode 200 Nothing "dao://[fd00::3]" ["dao://[fd00::6]"], + daoNode 200 Nothing "dao://[fd00::6]" [] + + -- daoNode 200 (Just 4) "dao://[fd00::1]" ["dao://[fd00::2]", "dao://[fd00::3]", "dao://[fd00::4]"], + -- daoNode 200 Nothing "dao://[fd00::2]" ["dao://[fd00::5]"], + -- daoNode 200 Nothing "dao://[fd00::4]" [], + -- daoNode 200 Nothing "dao://[fd00::5]" [], + ] + (got, logs) = runWriterLoggingM $ analyzeDAO $ makeSnapshotDAO fns + got `shouldBe` + ( Just $ DODAGAttributes + { A.node_num = 6, + A.edge_num = 5, + A.depth = 2, + A.root = ipFromText' "fd00::1", + A.time = fromEpochMillisecond 200 + } + ) + expectNoErrorLog logs + + + +