diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for net-spider-rpl + +## 0.1.0.0 -- 2019-05-03 + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2019, Toshio Ito + +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 Toshio Ito nor the names of other + 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 +OWNER 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,15 @@ +# net-spider-rpl + +NetSpider data model and utility for RPL ( [IPv6 Routing Protocol for Low-Power and Lossy Networks, RFC 6550](https://tools.ietf.org/html/rfc6550) ) networks. + +Features: + +- NetSpider data model for the DIO graph (i.e. upward graph) of RPL +- NetSpider data model for the DAO graph (i.e. downward graph) of RPL +- Utility function to read and parse log files generated by [Contiki-NG](http://contiki-ng.org/) applications. + +See the module document of [NetSpider.RPL](https://hackage.haskell.org/package/net-spider-rpl/docs/NetSpider-RPL.html) for detail. + +## Author + +Toshio Ito diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/net-spider-rpl.cabal b/net-spider-rpl.cabal new file mode 100644 --- /dev/null +++ b/net-spider-rpl.cabal @@ -0,0 +1,67 @@ +name: net-spider-rpl +version: 0.1.0.0 +author: Toshio Ito +maintainer: Toshio Ito +license: BSD3 +license-file: LICENSE +synopsis: NetSpider data model and utility for RPL networks +description: NetSpider data model and utility for RPL networks. See "NetSpider.RPL". +category: Database +cabal-version: >= 1.10 +build-type: Simple +extra-source-files: README.md, ChangeLog.md, + test/data/cooja.log, + test/data/syslog_root.log, + test/data/syslog_nonroot.log, + test/data/syslog_sr_tables.log +homepage: https://github.com/debug-ito/net-spider +bug-reports: https://github.com/debug-ito/net-spider/issues + +library + default-language: Haskell2010 + hs-source-dirs: src + ghc-options: -Wall -fno-warn-unused-imports + default-extensions: StrictData + other-extensions: OverloadedStrings, DeriveGeneric + exposed-modules: NetSpider.RPL, + NetSpider.RPL.FindingID, + NetSpider.RPL.DIO, + NetSpider.RPL.DAO, + NetSpider.RPL.Combined, + NetSpider.RPL.ContikiNG + other-modules: NetSpider.RPL.IPv6 + build-depends: base >=4.11.1.0 && <4.13, + aeson >=1.3.1.1 && <1.5, + greskell >=0.2.3.0 && <0.3, + net-spider >=0.3.0.0 && <0.4, + net-spider-pangraph >=0.1.0.0 && <0.2, + text >=1.2.3.1 && <1.3, + ip >=1.3.0 && <1.5, + hashable >=1.2.7.0 && <1.3, + time >=1.8.0.2 && <1.9 + +-- executable net-spider-rpl +-- default-language: Haskell2010 +-- hs-source-dirs: app +-- main-is: Main.hs +-- ghc-options: -Wall -fno-warn-unused-imports +-- -- other-modules: +-- -- default-extensions: +-- -- other-extensions: +-- build-depends: base + +test-suite spec + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + ghc-options: -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m" + main-is: Spec.hs + -- default-extensions: + other-extensions: OverloadedStrings + other-modules: NetSpider.RPL.ContikiNGSpec + build-depends: base, net-spider-rpl, net-spider, text, + hspec >=2.5.5 + +source-repository head + type: git + location: https://github.com/debug-ito/net-spider.git diff --git a/src/NetSpider/RPL.hs b/src/NetSpider/RPL.hs new file mode 100644 --- /dev/null +++ b/src/NetSpider/RPL.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module: NetSpider.RPL +-- Description: NetSpider data model and utility for RPL networks +-- Maintainer: Toshio Ito +-- +-- This module defines NetSpider data model and utility for RPL +-- networks. +-- +-- RPL ( [IPv6 Routing Protocol for Low-Power and Lossy Networks, RFC 6550](https://tools.ietf.org/html/rfc6550) ) +-- is a routing protocol for small wireless devices. Each node +-- independently exchanges routing information with its neighbors over +-- low-power wireless channels. Using those information, the nodes +-- form one or more network topologies called DODAG +-- (Destination-Oriented Directed Acyclic Graph) in a distributed +-- manner. +-- +-- The module "NetSpider.RPL.DIO" defines NetSpider data model about +-- DIO (DODAG Information Object). DIO is a control packet of RPL that +-- is necessary to form upward routes. 'FoundNodeDIO' type defines +-- DIO-specific information such as \"rank\". You can input +-- 'FoundNodeDIO's to NetSpider database to construct the upward +-- network. +-- +-- The "NetSpider.RPL.DAO" defines another data model +-- 'FoundNodeDAO'. DAO (Destination Advertisement Object) is a control +-- packet of RPL that is necessary to form downward +-- routes. 'FoundNodeDAO' type defines DAO-specific information. You +-- can input 'FoundNodeDAO' to NetSpider database to construct the +-- downward network. +-- +-- Because network topologies maintained in 'FoundNodeDIO' and +-- 'FoundNodeDAO' can be different, you have to use different node IDs +-- for them. The module "NetSpider.RPL.FindingID" exports 'FindingID' +-- that distingushes those two types of topologies. The DIO and DAO +-- topologies are obtained from the NetSpider database as different +-- Snapshot graphs. +-- +-- The two types of Snapshot graphs can be combined together by +-- upgrading their internal data. "NetSpider.RPL.Combined" module +-- provides functions to combine those graphs. +-- +-- The module "NetSpider.RPL.ContikiNG" (not re-exported by this +-- module) is a utility module to make 'FoundNodeDIO's and +-- 'FoundNodeDAO's. It defines utility functions to read and parse log +-- files generated by Contiki-NG applications. +-- [Contiki-NG](http://contiki-ng.org/) is a tiny operating system for +-- wireless devices that supports RPL. +module NetSpider.RPL + ( module NetSpider.RPL.FindingID, + module NetSpider.RPL.DIO, + module NetSpider.RPL.DAO, + module NetSpider.RPL.Combined + ) where + +import NetSpider.RPL.FindingID +import NetSpider.RPL.DIO +import NetSpider.RPL.DAO +import NetSpider.RPL.Combined diff --git a/src/NetSpider/RPL/Combined.hs b/src/NetSpider/RPL/Combined.hs new file mode 100644 --- /dev/null +++ b/src/NetSpider/RPL/Combined.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module: NetSpider.RPL.Combined +-- Description: Snapshot graph combining DIO and DAO graphs +-- Maintainer: Toshio Ito +-- +-- This module defines functions and data models that combine DIO +-- (defined in "NetSpider.RPL.DIO") and DAO (defined in +-- "NetSpider.RPL.DAO") graphs. +module NetSpider.RPL.Combined + ( -- * Functions + combineNodes, + combineLinks, + combineGraphs, + -- * Types + CombinedNode(..), + CombinedLink(..), + combinedLinkType + ) where + +import Data.Bifunctor (bimap, second) +import Data.Semigroup (Semigroup(..)) +import Data.Maybe (isJust) +import Data.Monoid (Monoid(..), First(..)) +import GHC.Exts (groupWith) +import qualified NetSpider.Pangraph as Pan +import NetSpider.Snapshot + ( SnapshotNode, SnapshotLink, + nodeId, nodeAttributes + ) + +import NetSpider.RPL.FindingID (FindingID(..), FindingType(..), IPv6ID, ipv6Only) +import NetSpider.RPL.DIO (DIONode, MergedDIOLink) +import NetSpider.RPL.DAO (DAONode, DAOLink) + +-- | Node attributes combining 'DIONode' and 'DAONode'. +data CombinedNode = + CombinedNode + { attrsDIO :: Maybe DIONode, + attrsDAO :: Maybe DAONode + } + deriving (Show,Eq,Ord) + +-- | Based on instance of 'First'. +instance Semigroup CombinedNode where + a <> b = CombinedNode dio dao + where + dio = getFirst $ (First $ attrsDIO a) <> (First $ attrsDIO b) + dao = getFirst $ (First $ attrsDAO a) <> (First $ attrsDAO b) + +-- | Based on instance of 'First'. +instance Monoid CombinedNode where + mappend a b = a <> b + mempty = CombinedNode Nothing Nothing + +instance Pan.ToAttributes CombinedNode where + toAttributes cn = (Pan.toAttributes $ attrsDIO cn) + ++ (Pan.toAttributes $ attrsDAO cn) + +-- | Link attribute combining 'MergedDIOLink' and 'DAOLink'. +data CombinedLink = CombinedDIOLink MergedDIOLink + | CombinedDAOLink DAOLink + deriving (Show,Eq,Ord) + +instance Pan.ToAttributes CombinedLink where + toAttributes (CombinedDIOLink ll) = + ("link_type", "dio") : Pan.toAttributes ll + toAttributes (CombinedDAOLink sl) = + ("link_type", "dao") : Pan.toAttributes sl + +combinedLinkType :: CombinedLink -> FindingType +combinedLinkType (CombinedDIOLink _) = FindingDIO +combinedLinkType (CombinedDAOLink _) = FindingDAO + +combineNodes :: [SnapshotNode FindingID DIONode] + -> [SnapshotNode FindingID DAONode] + -> [SnapshotNode IPv6ID CombinedNode] +combineNodes dio_ns dao_ns = concatNodes $ map fromDIO dio_ns ++ map fromDAO dao_ns + where + fromDIO = bimap ipv6Only (\ln -> CombinedNode (Just ln) Nothing) + fromDAO = bimap ipv6Only (\sn -> CombinedNode Nothing (Just sn)) + concatNodes nodes = map merge $ groupWith nodeId nodes + where + merge [] = error "Empty group should not happen." + merge group_nodes@(head_node : _) = + case mmerged_attr of + Nothing -> + -- No node has NodeAttribute. There is no need to merge. + head_node + Just merged_attr -> + case filter hasNodeAttr group_nodes of + [] -> error "At least one node must have NodeAttributes" + (representative_node : _) -> second (const merged_attr) representative_node + where + mmerged_attr = mconcat $ map nodeAttributes group_nodes + hasNodeAttr n = isJust $ nodeAttributes n + +combineLinks :: [SnapshotLink FindingID MergedDIOLink] + -> [SnapshotLink FindingID DAOLink] + -> [SnapshotLink IPv6ID CombinedLink] +combineLinks dio_ls dao_ls = map fromDIO dio_ls ++ map fromDAO dao_ls + where + fromDIO = bimap ipv6Only (\ll -> CombinedDIOLink ll) + fromDAO = bimap ipv6Only (\sl -> CombinedDAOLink sl) + +combineGraphs :: ([SnapshotNode FindingID DIONode], [SnapshotLink FindingID MergedDIOLink]) + -> ([SnapshotNode FindingID DAONode], [SnapshotLink FindingID DAOLink]) + -> ([SnapshotNode IPv6ID CombinedNode], [SnapshotLink IPv6ID CombinedLink]) +combineGraphs (dio_ns, dio_ls) (dao_ns, dao_ls) = + (combineNodes dio_ns dao_ns, combineLinks dio_ls dao_ls) diff --git a/src/NetSpider/RPL/ContikiNG.hs b/src/NetSpider/RPL/ContikiNG.hs new file mode 100644 --- /dev/null +++ b/src/NetSpider/RPL/ContikiNG.hs @@ -0,0 +1,412 @@ +-- | +-- Module: NetSpider.RPL.ContikiNG +-- Description: Parser for Contiki-NG logs about RPL +-- Maintainer: Toshio Ito +-- +-- This module exports utility functions to read and parse log files +-- from Contiki-NG applications. +-- +-- [Contiki-NG](http://contiki-ng.org/) is a tiny operation system for +-- wireless network devices. It supports RPL. +module NetSpider.RPL.ContikiNG + ( -- * Parser functions + parseFile, + -- * Parser components + Parser, + pCoojaLogHead, + pCoojaLogHead', + pSyslogHead + ) where + +import Control.Applicative ((<|>), (<$>), (<*>), (*>), (<*), many, optional) +import Control.Exception (Exception, throwIO) +import Control.Monad (void) +import Data.Bits (shift) +import Data.Char (isDigit, isHexDigit, isSpace) +import Data.Int (Int64) +import Data.List (sortOn, reverse) +import Data.Maybe (listToMaybe) +import Data.Monoid ((<>)) +import Data.Text (pack) +import qualified Data.Time as Time +import Data.Word (Word16) +import GHC.Exts (groupWith) +import Net.IPv6 (IPv6) +import qualified Net.IPv6 as IPv6 +import NetSpider.Found (FoundNode(..), FoundLink(..), LinkState(LinkToTarget)) +import NetSpider.Timestamp (Timestamp, fromEpochMillisecond, fromLocalTime, fromZonedTime) +import System.IO (withFile, IOMode(ReadMode), hGetLine, hIsEOF) +import qualified Text.ParserCombinators.ReadP as P +import Text.Read (readEither) + +import NetSpider.RPL.FindingID (FindingID(FindingID), FindingType(..)) +import NetSpider.RPL.IPv6 (isLinkLocal, setPrefix, getPrefix) +import qualified NetSpider.RPL.DIO as DIO +import NetSpider.RPL.DIO (FoundNodeDIO, dioLinkState) +import qualified NetSpider.RPL.DAO as DAO +import NetSpider.RPL.DAO (FoundNodeDAO) + +type Parser = P.ReadP + +data ParseError = ParseError String + deriving (Show,Eq,Ord) + +instance Exception ParseError + +runParser :: Parser a -> String -> Maybe a +runParser p input = extract $ sortPairs $ P.readP_to_S p input + where + sortPairs = sortOn $ \(_, rest) -> length rest + extract [] = Nothing + extract ((a,_) : _) = Just a + +-- | Read and parse a log file from a Contiki-NG application to make +-- 'FoundNodeDIO' and 'FoundNodeDAO'. +-- +-- It assumes that each line of log file has prefix, and that the +-- prefix contains timestamp information. You have to pass the parser +-- for the prefix to this function. For example, if you read a log +-- file generated by Cooja simulator, use 'pCoojaLogHead'' parser. +parseFile :: Parser Timestamp -- ^ Parser for log prefix + -> FilePath -- ^ File to read + -> IO ([FoundNodeDIO], [FoundNodeDAO]) +parseFile pTimestamp input_file = withFile input_file ReadMode $ onHandle + where + onHandle h = go ([], []) + where + go (acc_dio, acc_dao) = do + mentry <- parseOneEntry pTimestamp $ tryGetLine h + case mentry of + Nothing -> return (reverse acc_dio, reverse acc_dao) + Just (PEDIO fl) -> go (fl : acc_dio, acc_dao) + Just (PEDAO srs) -> go (acc_dio, srs ++ acc_dao) + Just PEMisc -> go (acc_dio, acc_dao) + tryGetLine h = do + eof <- hIsEOF h + if eof + then return Nothing + else Just <$> hGetLine h + +data ParseEntry = PEDIO FoundNodeDIO + | PEDAO [FoundNodeDAO] + | PEMisc + deriving (Show,Eq) + +-- | Return 'Nothing' when it finishes reading. +parseOneEntry :: Parser Timestamp -> IO (Maybe String) -> IO (Maybe ParseEntry) +parseOneEntry pTimestamp getL = impl + where + impl = do + mline <- getL + case mline of + Nothing -> return Nothing + Just line -> + case runParser ((,) <$> pTimestamp <*> (pLogHead *> pHeading)) line of + Nothing -> return $ Just PEMisc + Just (ts, HDIO addr node) -> proceedDIO ts addr node + Just (ts, HDAO route_num) -> proceedDAO ts route_num + withPrefix p = pTimestamp *> pLogHead *> p + proceedDIO ts addr node = do + mlinks <- readUntil getL (withPrefix pDIONeighbor) (withPrefix pDIONeighborEnd) + case mlinks of + Nothing -> return Nothing + Just links -> return $ Just $ PEDIO $ makeFoundNodeDIO ts addr node $ map (setAddressPrefix addr) links + proceedDAO ts route_num = do + mlinks <- readUntil getL (withPrefix pDAOLink) (withPrefix pDAOLinkEnd) + case mlinks of + Nothing -> return Nothing + Just links -> do + root_address <- maybe (throwIO $ ParseError "No root address found in SR log") return + $ getRootAddress links + return $ Just $ PEDAO $ map (makeDAONodeFromTuple root_address route_num ts) $ groupDAOLinks links + getRootAddress :: [(IPv6, Maybe (IPv6, Word))] -> Maybe IPv6 + getRootAddress links = fmap fst $ listToMaybe $ filter isRootEntry links + where + isRootEntry (_, Nothing) = True + isRootEntry (_, _) = False + groupDAOLinks :: [(IPv6, Maybe (IPv6, Word))] -> [(IPv6, [(IPv6, Word)])] + groupDAOLinks links = map toTuple $ groupWith byParentAddr $ (filterOutRoot =<< links) + where + filterOutRoot (_, Nothing) = [] + filterOutRoot (c, Just (p, lt)) = [(c, p, lt)] + byParentAddr (_, p, _) = p + toTuple [] = error "groupDAOLinks: this should not happen" + toTuple entries@((_, p, _) : _) = (p, map extractChildAndLifetime entries) + extractChildAndLifetime (c, _, lt) = (c, lt) + makeDAONodeFromTuple root_addr route_num ts (parent_addr, children) = + makeFoundNodeDAO + ts (if parent_addr == root_addr then Just route_num else Nothing) + parent_addr children + setAddressPrefix self_addr (neighbor_addr, ll) = (modified_addr, ll) + where + modified_addr = if isLinkLocal neighbor_addr + then setPrefix (getPrefix self_addr) neighbor_addr + else neighbor_addr + +readUntil :: IO (Maybe String) -> Parser a -> Parser end -> IO (Maybe [a]) +readUntil getL pBody pEnd = go [] + where + go acc = do + mline <- getL + case mline of + Nothing -> return Nothing + Just line -> + case runParser ((Left <$> pEnd) <|> (Right <$> pBody)) line of + Nothing -> return Nothing + Just (Left _) -> return $ Just $ reverse acc + Just (Right body) -> go (body : acc) + +makeFoundNodeDIO :: Timestamp -> IPv6 -> DIO.DIONode -> [(IPv6, DIO.DIOLink)] -> FoundNodeDIO +makeFoundNodeDIO ts self_addr node_attr neighbors = + FoundNode { subjectNode = FindingID FindingDIO self_addr, + foundAt = ts, + neighborLinks = map toFoundLink neighbors, + nodeAttributes = node_attr + } + where + toFoundLink (neighbor_addr, ll) = + FoundLink { targetNode = FindingID FindingDIO neighbor_addr, + linkState = dioLinkState ll, + linkAttributes = ll + } + +makeFoundNodeDAO :: Timestamp -> Maybe Word -> IPv6 -> [(IPv6, Word)] -> FoundNodeDAO +makeFoundNodeDAO ts mroute_num parent_addr children = + FoundNode { subjectNode = FindingID FindingDAO parent_addr, + foundAt = ts, + neighborLinks = map toFoundLink children, + nodeAttributes = DAO.DAONode mroute_num + } + where + toFoundLink (child_addr, lifetime) = + FoundLink { targetNode = FindingID FindingDAO child_addr, + linkState = LinkToTarget, + linkAttributes = DAO.DAOLink lifetime + } + + +data Heading = HDIO IPv6 DIO.DIONode + | HDAO Word + deriving (Show,Eq,Ord) + +pHeading :: Parser Heading +pHeading = (fmap (uncurry HDIO) $ pDIONode) + <|> (HDAO <$> pDAOLogHeader) + +isAddressChar :: Char -> Bool +isAddressChar c = isHexDigit c || c == ':' + +pAddress :: Parser IPv6 +pAddress = fromS =<< P.munch1 isAddressChar + where + fromS str = + case IPv6.decode $ pack str of + Nothing -> fail ("Invalid IPv6 address: " <> str) + Just addr -> return addr + +data CompactID = CNodeID Int + | CNodeAddress Word16 + deriving (Show,Eq,Ord) + +makeCompactAddress :: CompactID -> IPv6 +makeCompactAddress cid = + case cid of + CNodeID nid -> IPv6.fromWord32s 0 0 0 (fromIntegral nid) + CNodeAddress addr -> IPv6.fromWord16s 0 0 0 0 0 0 0 addr + +pHexWord16 :: String -> Parser Word16 +pHexWord16 input = go 0 input + where + go acc [] = return acc + go acc (c:rest) = do + c_num <- parseC + go ((acc `shift` 8) + c_num) rest + where + diffWord a b = fromIntegral (fromEnum a - fromEnum b) + parseC = if c >= '0' && c <= '9' + then return $ diffWord c '0' + else if c >= 'a' && c <= 'f' + then return $ diffWord c 'a' + else if c >= 'A' && c <= 'F' + then return $ diffWord c 'A' + else fail ("Invalid hex number: " <> input) + +pCompactID :: Parser CompactID +pCompactID = (fmap CNodeID $ pRead =<< P.count 3 (P.satisfy isDigit)) + <|> (fmap CNodeAddress $ pHexWord16 =<< P.count 4 (P.satisfy isHexDigit)) + +pCompactAddress :: Parser IPv6 +pCompactAddress = do + void $ P.string "6G-" -- expecting unicast global address + fmap makeCompactAddress $ pCompactID + +-- neighbor address can be logged in a "compact" form. +-- https://github.com/contiki-ng/contiki-ng/blob/develop/os/sys/log.c + +pMaybeCompactAddress :: Parser IPv6 +pMaybeCompactAddress = pCompactAddress <|> pAddress + +pRead :: Read a => String -> Parser a +pRead = either fail return . readEither + +pNum :: Read a => Parser a +pNum = pRead =<< P.munch1 isDigit + +pDIONode :: Parser (IPv6, DIO.DIONode) +pDIONode = do + void $ P.string "nbr: own state, addr " + addr <- pAddress + void $ P.string ", DAG state: " + void $ P.munch (\c -> c /= ',') + void $ P.string ", MOP " + void $ P.munch isDigit + void $ P.string " OCP " + void $ P.munch isDigit + void $ P.string " rank " + rank <- pNum + void $ P.string " max-rank " + void $ P.munch isDigit + void $ P.string ", dioint " + dio_int <- pNum + let node = DIO.DIONode { DIO.rank = rank, + DIO.dioInterval = dio_int + } + return (addr, node) + +pExpectChar :: Char -> Parser Bool +pExpectChar exp_c = fmap (== Just exp_c) $ optional P.get + +pDIONeighbor :: Parser (IPv6, DIO.DIOLink) +pDIONeighbor = do + void $ P.string "nbr: " + neighbor_addr <- pMaybeCompactAddress + P.skipSpaces + neighbor_rank <- pNum + void $ P.string ", " + P.skipSpaces + metric <- pNum + void $ P.string " => " + P.skipSpaces + void $ P.munch isDigit -- rank_via_neighbor + void $ P.string " -- " + P.skipSpaces + void $ P.munch isDigit -- freshness + void $ pExpectChar ' ' + void $ pExpectChar 'r' + void $ pExpectChar 'b' + acceptable <- pExpectChar 'a' + void $ pExpectChar 'f' + preferred <- pExpectChar 'p' + return ( neighbor_addr, + DIO.DIOLink + { DIO.neighborType = if preferred + then DIO.PreferredParent + else if acceptable + then DIO.ParentCandidate + else DIO.OtherNeighbor, + DIO.neighborRank = neighbor_rank, + DIO.metric = Just metric + } + ) + +pDIONeighborEnd :: Parser () +pDIONeighborEnd = void $ P.string "nbr: end of list" + +pLogHead :: Parser () +pLogHead = do + void $ P.char '[' + void $ P.munch (not . (== ']')) + void $ P.string "] " + +pDAOLogHeader :: Parser Word +pDAOLogHeader = do + void $ P.string "links: " + route_num <- pNum + void $ P.string " routing links in total " + return route_num + +pDAOLink :: Parser (IPv6, Maybe (IPv6, Word)) +pDAOLink = do + void $ P.string "links: " + child <- pMaybeCompactAddress + mparent <- optional pParentAndLifetime + return (child, mparent) + where + pParentAndLifetime = (,) + <$> (P.string " to " *> pMaybeCompactAddress) + <*> (P.string " (lifetime: " *> pNum <* P.string " seconds)") + + +pDAOLinkEnd :: Parser () +pDAOLinkEnd = void $ P.string "links: end of list" + +-- | Parse the head of Cooja log line, and return the timestamp and +-- node ID. +pCoojaLogHead :: Parser (Timestamp, Int) +pCoojaLogHead = do + ts_min <- pNum + void $ P.string ":" + ts_sec <- pNum + void $ P.string "." + ts_msec <- pNum + P.skipSpaces + void $ P.string "ID:" + node_id <- pNum + P.skipSpaces + return (makeTs ts_min ts_sec ts_msec, node_id) + where + makeTs :: Int64 -> Int64 -> Int64 -> Timestamp + makeTs ts_min ts_sec ts_msec = fromEpochMillisecond ((ts_min * 60 + ts_sec) * 1000 + ts_msec) + +-- | Same as 'pCoojaLogHead', but it returns the timestamp only. +pCoojaLogHead' :: Parser Timestamp +pCoojaLogHead' = fmap fst pCoojaLogHead + +-- | Parser for head of syslog line with its default format. +-- @\"Mmm dd hh:mm:ss HOSTNAME TAG: \"@. +-- +-- Because the format does not contain year, you have to pass it to +-- this function. +pSyslogHead :: Integer -- ^ year + -> Maybe Time.TimeZone -- ^ optional time zone. + -> Parser Timestamp +pSyslogHead year mtz = do + ts <- pSyslogTimestamp year mtz + P.skipSpaces + void $ P.munch (not . isSpace) -- hostname + P.skipSpaces + void $ P.munch (not . isSpace) -- tag + P.skipSpaces + return ts + +pSyslogTimestamp :: Integer -> Maybe Time.TimeZone -> Parser Timestamp +pSyslogTimestamp year mtz = do + month <- pMonth + P.skipSpaces + day <- pNum + P.skipSpaces + hour <- pNum <* P.string ":" + minute <- pNum <* P.string ":" + sec <- pNum + let lt = Time.LocalTime (Time.fromGregorian year month day) (Time.TimeOfDay hour minute sec) + case mtz of + Nothing -> return $ fromLocalTime lt + Just tz -> return $ fromZonedTime $ Time.ZonedTime lt tz + where + pMonth = do + mstr <- P.munch1 (not . isSpace) + case mstr of + "Jan" -> return 1 + "Feb" -> return 2 + "Mar" -> return 3 + "Apr" -> return 4 + "May" -> return 5 + "Jun" -> return 6 + "Jul" -> return 7 + "Aug" -> return 8 + "Sep" -> return 9 + "Oct" -> return 10 + "Nov" -> return 11 + "Dec" -> return 12 + _ -> fail ("Invalid for a month: " <> mstr) + diff --git a/src/NetSpider/RPL/DAO.hs b/src/NetSpider/RPL/DAO.hs new file mode 100644 --- /dev/null +++ b/src/NetSpider/RPL/DAO.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module: NetSpider.RPL.DAO +-- Description: Node and link information based on DAO (Destination Advertisement Object) +-- Maintainer: Toshio Ito +-- +-- +module NetSpider.RPL.DAO + ( -- * Types + FoundNodeDAO, + DAONode(..), + DAOLink(..), + -- * Unifier + daoUnifierConf + ) where + +import Data.Greskell + ( gIdentity + ) + +import Control.Applicative ((<$>), (<*>)) +import Data.Aeson (ToJSON(..)) +import Data.Greskell + ( parseOneValue + ) +import Data.Greskell.Extra (writePropertyKeyValues) +import NetSpider.Found (FoundNode) +import NetSpider.Graph (NodeAttributes(..), LinkAttributes(..)) +import qualified NetSpider.Pangraph as Pan +import NetSpider.Pangraph.Atom (toAtom, Atom) +import NetSpider.Unify (UnifyStdConfig, lsLinkAttributes, latestLinkSample) +import qualified NetSpider.Unify as Unify + +import NetSpider.RPL.FindingID (FindingID) + +-- | 'FoundNode' for a network described by DAOs. +type FoundNodeDAO = FoundNode FindingID DAONode DAOLink + +-- | Node attributes about DAO. +data DAONode = + DAONode + { daoRouteNum :: Maybe Word + -- ^ Number of DAO routes (downward routes) in the routing table + -- of the node. Exact meaning of the "number of routes" depends on + -- implementation. + -- + -- In Non-Storing mode, 'daoRouteNum' for non-root nodes are + -- supposed to be 'Nothing', because they don't have a downward + -- routing table. + } + deriving (Show,Eq,Ord) + +instance NodeAttributes DAONode where + writeNodeAttributes dn = writePropertyKeyValues pairs + where + pairs = [ ("dao_route_num", toJSON $ daoRouteNum dn) + ] + parseNodeAttributes ps = DAONode <$> parseOneValue "dao_route_num" ps + +instance Pan.ToAttributes DAONode where + toAttributes dn = + case daoRouteNum dn of + Nothing -> [] + Just p -> [("dao_route_num", toAtom $ p)] + +-- | Link attributes about DAO. +-- +-- In Storing mode of RPL, a 'DAOLink' represents a link between the +-- sender and the receiver of a DAO. In non-storing mode, it's a link +-- between the sender of the DAO and the node specified in the +-- \"parent address\" field of the Transit Information option +-- contained in the DAO. +data DAOLink = + DAOLink + { pathLifetimeSec :: Word + -- ^ Remaining lifetime of this link in seconds. + -- + -- Lifetime is advertised in Transit Information Option in DAO, + -- and managed in the routing table. + } + deriving (Show,Eq,Ord) + +instance LinkAttributes DAOLink where + writeLinkAttributes dl = writePropertyKeyValues pairs + where + pairs = [ ("path_lifetime_sec", toJSON $ pathLifetimeSec dl) + ] + parseLinkAttributes ps = DAOLink <$> parseOneValue "path_lifetime_sec" ps + +instance Pan.ToAttributes DAOLink where + toAttributes dl = [ ("path_lifetime_sec", toAtom $ pathLifetimeSec dl) ] + +-- | 'UnifyStdConfig' for RPL DAO data. +daoUnifierConf :: UnifyStdConfig FindingID DAONode DAOLink DAOLink () +daoUnifierConf = Unify.defUnifyStdConfig { Unify.negatesLinkSample = \_ _ -> False } diff --git a/src/NetSpider/RPL/DIO.hs b/src/NetSpider/RPL/DIO.hs new file mode 100644 --- /dev/null +++ b/src/NetSpider/RPL/DIO.hs @@ -0,0 +1,207 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module: NetSpider.RPL.DIO +-- Description: Node and link information based on DIO (DODAG Information Object) +-- Maintainer: Toshio Ito +-- +-- +module NetSpider.RPL.DIO + ( -- * Types + FoundNodeDIO, + DIONode(..), + DIOLink(..), + dioLinkState, + MergedDIOLink(..), + Rank, + NeighborType(..), + neighborTypeToText, + neighborTypeFromText, + -- * Unifier + dioUnifierConf + ) where + +import Control.Applicative ((<$>), (<*>)) +import Data.Aeson (ToJSON(..)) +import Data.Bifunctor (bimap) +import Data.Greskell + ( PropertyMap, Property, GValue, parseOneValue, + Binder, Walk, SideEffect, Element, Parser + ) +import Data.Greskell.Extra (writePropertyKeyValues) +import Data.Monoid ((<>)) +import Data.Text (Text, unpack) +import Data.Word (Word32) +import NetSpider.Found (FoundNode, LinkState(..)) +import NetSpider.Graph (NodeAttributes(..), LinkAttributes(..)) +import qualified NetSpider.Pangraph as Pan +import NetSpider.Pangraph.Atom (toAtom, Atom) +import NetSpider.Unify (UnifyStdConfig, lsLinkAttributes, latestLinkSample) +import qualified NetSpider.Unify as Unify + +import NetSpider.RPL.FindingID (FindingID) + +-- | 'FoundNode' for a network described by DIOs. +type FoundNodeDIO = FoundNode FindingID DIONode DIOLink + +-- | RPL rank +type Rank = Word + +-- | The interval of Trickle timer as decribed as number of doublings +-- of the minimum interval, i.e. log2(I / Imin). +type TrickleInterval = Word + +-- | Node attributes about DIO. +data DIONode = + DIONode + { rank :: Rank, + -- ^ RPL rank + dioInterval :: TrickleInterval + -- ^ Current interval of Trickle timer for DIO transmission. + } + deriving (Show,Eq,Ord) + +instance NodeAttributes DIONode where + writeNodeAttributes ln = writePropertyKeyValues pairs + where + pairs = [ ("rank", toJSON $ rank ln), + ("dio_interval", toJSON $ dioInterval ln) + ] + parseNodeAttributes ps = DIONode + <$> parseOneValue "rank" ps + <*> parseOneValue "dio_interval" ps + +instance Pan.ToAttributes DIONode where + toAttributes ln = [ ("rank", toAtom $ rank ln), + ("dio_interval", toAtom $ dioInterval ln) + ] + +-- | Classification of RPL neighbors. +data NeighborType = PreferredParent + -- ^ The neighbor is the preferred parent. + | ParentCandidate + -- ^ The neighbor is not the preferred parent, but + -- is in the parent set. + | OtherNeighbor + -- ^ The neighbor is not in the parent set. + deriving (Show,Eq,Ord,Enum,Bounded) + +neighborTypeToText :: NeighborType -> Text +neighborTypeToText nt = case nt of + PreferredParent -> "preferred_parent" + ParentCandidate -> "parent_candidate" + OtherNeighbor -> "other_neighbor" + +neighborTypeFromText :: Text -> Maybe NeighborType +neighborTypeFromText t = case t of + "preferred_parent" -> return PreferredParent + "parent_candidate" -> return ParentCandidate + "other_neighbor" -> return OtherNeighbor + _ -> Nothing + +-- | Unsafely convert walk's type signature +adaptWalk :: (Element e1, Element e2) => Walk SideEffect e1 e1 -> Walk SideEffect e2 e2 +adaptWalk = bimap undefined undefined + +instance LinkAttributes NeighborType where + writeLinkAttributes nt = writePropertyKeyValues [("neighbor_type", neighborTypeToText nt)] + parseLinkAttributes ps = fromT =<< parseOneValue "neighbor_type" ps + where + fromT t = maybe (fail ("Unknown neighbor type: " <> unpack t)) return $ neighborTypeFromText t + +-- | Link attributes about DIO. +-- +-- Basically this represents information of a neighbor learned from +-- the DIOs it has sent. +data DIOLink = + DIOLink + { neighborType :: NeighborType, + -- ^ Type of the neighbor at the other end of this link. + neighborRank :: Rank, + -- ^ Observed rank of the neighbor. + metric :: Maybe Rank + -- ^ Link metric of this link, calculated as step of Rank. Because + -- Rank computation is up to the Objective Function, this field is + -- optional. + } + deriving (Show,Eq,Ord) + +instance LinkAttributes DIOLink where + writeLinkAttributes ll = do + nt_steps <- writeLinkAttributes $ neighborType ll + other <- writePropertyKeyValues pairs + return (adaptWalk nt_steps <> other) + where + pairs = [ ("neighbor_rank", toJSON $ neighborRank ll), + ("metric", toJSON $ metric ll) + ] + parseLinkAttributes ps = + DIOLink + <$> parseLinkAttributes ps + <*> parseOneValue "neighbor_rank" ps + <*> parseOneValue "metric" ps + +-- | 'LinkState' that should be set for given 'DIOLink'. +dioLinkState :: DIOLink -> LinkState +dioLinkState l = + case neighborType l of + PreferredParent -> LinkToTarget + _ -> LinkUnused + +toAttributesPrefix :: Atom -> DIOLink -> [Pan.Attribute] +toAttributesPrefix prefix ll = + [ (prefix <> "neighbor_type", toAtom $ neighborTypeToText $ neighborType ll), + (prefix <> "neighbor_rank", toAtom $ neighborRank ll) + ] + ++ + ( case metric ll of + Nothing -> [] + Just metric_val -> [(prefix <> "metric", toAtom metric_val)] + ) + +instance Pan.ToAttributes DIOLink where + toAttributes = toAttributesPrefix "" + +-- | Link attributes merging two 'DIOLink's from the two end nodes +-- of the link. +data MergedDIOLink = + MergedDIOLink + { fromSource :: DIOLink, + fromDest :: Maybe DIOLink + } + deriving (Show,Eq,Ord) + +-- | 'UnifyStdConfig' for RPL DIO data +dioUnifierConf :: UnifyStdConfig FindingID DIONode DIOLink MergedDIOLink () +dioUnifierConf = Unify.UnifyStdConfig + { Unify.makeLinkSubId = const (), + Unify.mergeSamples = merger, + Unify.negatesLinkSample = \_ _ -> False + } + where + merger llinks rlinks = + case (latestLinkSample llinks, latestLinkSample rlinks) of + (Nothing, Nothing) -> Nothing + (Just ll, Nothing) -> Just $ doMerge ll Nothing + (Nothing, Just rl) -> Just $ doMerge rl Nothing + (Just ll, Just rl) -> Just $ doMerge ll $ Just rl + doMerge main_link msub_link = + case msub_link of + Nothing -> main_link + { lsLinkAttributes = MergedDIOLink main_ll Nothing } + Just sub_link -> + if neighborType main_ll <= neighborType sub_ll + then main_link { lsLinkAttributes = MergedDIOLink main_ll $ Just sub_ll } + else sub_link { lsLinkAttributes = MergedDIOLink sub_ll $ Just main_ll } + where + sub_ll = lsLinkAttributes sub_link + where + main_ll = lsLinkAttributes main_link + +instance Pan.ToAttributes MergedDIOLink where + toAttributes ml = + toAttributesPrefix "source_" (fromSource ml) + ++ + ( case fromDest ml of + Nothing -> [] + Just dl -> toAttributesPrefix "dest_" dl + ) diff --git a/src/NetSpider/RPL/FindingID.hs b/src/NetSpider/RPL/FindingID.hs new file mode 100644 --- /dev/null +++ b/src/NetSpider/RPL/FindingID.hs @@ -0,0 +1,144 @@ +{-# LANGUAGE OverloadedStrings, DeriveGeneric #-} +-- | +-- Module: NetSpider.RPL.FindingID +-- Description: NetSpider Node ID type for RPL network graph +-- Maintainer: Toshio Ito +-- +-- +module NetSpider.RPL.FindingID + ( -- * FindingID + FindingID(..), + idToText, + idFromText, + -- * FindingType + FindingType(..), + typeToText, + typeFromText, + -- * IPv6ID + IPv6ID(..), + ipv6ToText, + ipv6FromText, + ipv6Only + ) where + +import Control.Applicative ((<$>), (<*>)) +import Control.Monad.Fail (MonadFail) +import Data.Monoid ((<>)) +import Data.Aeson (FromJSON(..), ToJSON(..)) +import qualified Data.Aeson as Aeson +import Data.Greskell (FromGraphSON(..)) +import Data.Hashable (Hashable(..)) +import Data.Text (Text) +import qualified Data.Text as T +import GHC.Generics (Generic) +import Net.IPv6 (IPv6(..)) +import qualified Net.IPv6 as IPv6 +import NetSpider.Pangraph.Atom (ToAtom(..)) + +-- | Type of local finding. +data FindingType = FindingDIO + -- ^ Local finding about DIO (Upward) routes. + | FindingDAO + -- ^ Local finding about DAO (Downward) routes. + deriving (Show,Eq,Ord,Enum,Bounded,Generic) + +instance Hashable FindingType + +typeToText :: FindingType -> Text +typeToText ft = + case ft of + FindingDIO -> "dio" + FindingDAO -> "dao" + +typeFromText :: Text -> Maybe FindingType +typeFromText t = + case t of + "dio" -> Just FindingDIO + "dao" -> Just FindingDAO + _ -> Nothing + +-- | The node ID. +-- +-- Basically a node is identified by its IPv6 address in RPL +-- network. 'FindingID' is distinguished by 'FindingType' as well, +-- because in RPL there can be difference between topology formed by +-- DIOs and DAOs. +data FindingID = + FindingID + { findingType :: FindingType, + -- ^ Finding type + nodeAddress :: IPv6 + -- ^ IPv6 address of the subject node. + } + deriving (Show,Eq,Ord,Generic) + +idToText :: FindingID -> Text +idToText fid = ft_str <> "://[" <> addr_str <> "]" + where + ft_str = typeToText $ findingType fid + addr_str = ipv6ToText $ IPv6ID $ nodeAddress fid + +idFromText :: Text -> Maybe FindingID +idFromText t = FindingID <$> m_ft <*> m_addr + where + (ft_str, rest) = T.breakOn "://[" t + (addr_str, _) = T.breakOn "]" $ T.drop 4 rest + m_ft = typeFromText ft_str + m_addr = fmap unIPv6ID $ ipv6FromText addr_str + +instance ToJSON FindingID where + toJSON = Aeson.String . idToText + +parseFromText :: MonadFail m => Text -> m FindingID +parseFromText t = + case idFromText t of + Nothing -> fail ("Invalid FindingID: " <> T.unpack t) + Just fid -> return fid + +instance FromJSON FindingID where + parseJSON v = parseFromText =<< parseJSON v + +instance FromGraphSON FindingID where + parseGraphSON gv = parseFromText =<< parseGraphSON gv + +instance Hashable FindingID where + hashWithSalt s fid = s `hashWithSalt` ft `hashWithSalt` addr_id + where + ft = findingType fid + addr_id = IPv6ID $ nodeAddress fid + +instance ToAtom FindingID where + toAtom = toAtom . idToText + +-- | 'IPv6' address with additional type-class instances. +newtype IPv6ID = IPv6ID { unIPv6ID :: IPv6 } + deriving (Show,Eq,Ord,Generic) + +instance Hashable IPv6ID where + hashWithSalt s (IPv6ID a) = + s `hashWithSalt` (ipv6A a) `hashWithSalt` (ipv6B a) + +ipv6ToText :: IPv6ID -> Text +ipv6ToText (IPv6ID a) = IPv6.encode a + +ipv6FromText :: Text -> Maybe IPv6ID +ipv6FromText = fmap IPv6ID . IPv6.decode + +parseIPv6IDFromText :: MonadFail m => Text -> m IPv6ID +parseIPv6IDFromText t = + case ipv6FromText t of + Nothing -> fail ("Invalid IPv6 address: " <> T.unpack t) + Just a -> return a + +instance FromJSON IPv6ID where + parseJSON v = parseIPv6IDFromText =<< parseJSON v + +instance FromGraphSON IPv6ID where + parseGraphSON gv = parseIPv6IDFromText =<< parseGraphSON gv + +instance ToAtom IPv6ID where + toAtom = toAtom . ipv6ToText + +-- | Extract 'IPv6ID' from 'FindingID'. +ipv6Only :: FindingID -> IPv6ID +ipv6Only = IPv6ID . nodeAddress diff --git a/src/NetSpider/RPL/IPv6.hs b/src/NetSpider/RPL/IPv6.hs new file mode 100644 --- /dev/null +++ b/src/NetSpider/RPL/IPv6.hs @@ -0,0 +1,33 @@ +-- | +-- Module: NetSpider.RPL.IPv6 +-- Description: +-- Maintainer: Toshio Ito +-- +-- __This module is for internal use.__ +module NetSpider.RPL.IPv6 + ( Prefix, + InterfaceID, + isLinkLocal, + getPrefix, + setPrefix + ) where + +import Data.Bits ((.&.), shift) +import Data.Word (Word64) +import Net.IPv6 (IPv6(..), toWord16s) + +type Prefix = Word64 + +type InterfaceID = Word64 + +isLinkLocal :: IPv6 -> Bool +isLinkLocal addr = (== 0xfe80) $ (.&. bit_mask) $ top_word + where + (top_word, _, _, _, _, _, _, _) = toWord16s addr + bit_mask = (2 ^ (10 :: Int) - 1) `shift` 6 + +getPrefix :: IPv6 -> Prefix +getPrefix = ipv6A + +setPrefix :: Prefix -> IPv6 -> IPv6 +setPrefix p orig = orig { ipv6A = p } diff --git a/test/NetSpider/RPL/ContikiNGSpec.hs b/test/NetSpider/RPL/ContikiNGSpec.hs new file mode 100644 --- /dev/null +++ b/test/NetSpider/RPL/ContikiNGSpec.hs @@ -0,0 +1,259 @@ +{-# LANGUAGE OverloadedStrings #-} +module NetSpider.RPL.ContikiNGSpec (main,spec) where + +import Data.Maybe (fromJust) +import Data.Text (Text) +import NetSpider.Found (FoundNode(..), FoundLink(..), LinkState(..)) +import NetSpider.Timestamp (Timestamp, fromEpochMillisecond) +import Test.Hspec + +import NetSpider.RPL.ContikiNG (parseFile, pCoojaLogHead', pSyslogHead) +import NetSpider.RPL.FindingID (idFromText) +import qualified NetSpider.RPL.DIO as DIO +import qualified NetSpider.RPL.DAO as DAO + +main :: IO () +main = hspec spec + +daoEntry :: Timestamp -> Text -> Maybe Word -> [(Text, Word)] -> DAO.FoundNodeDAO +daoEntry ts src mroute_num dests = + FoundNode + { subjectNode = fromJust $ idFromText src, + foundAt = ts, + nodeAttributes = DAO.DAONode mroute_num, + neighborLinks = map toLink dests + } + where + toLink (dest, lifetime) = + FoundLink + { targetNode = fromJust $ idFromText dest, + linkState = LinkToTarget, + linkAttributes = DAO.DAOLink lifetime + } + +spec :: Spec +spec = do + describe "parseFile" $ do + specify "cooja log" $ do + let exp_dio = + FoundNode { subjectNode = fromJust $ idFromText "dio://[fd00::201:1:1:1]", + foundAt = fromEpochMillisecond 60382, + neighborLinks = exp_dio_links, + nodeAttributes = DIO.DIONode { DIO.rank = 128, DIO.dioInterval = 15 } + } + exp_dio_links = + [ FoundLink { targetNode = fromJust $ idFromText "dio://[fd00::202:2:2:2]", + linkState = LinkUnused, + linkAttributes = DIO.DIOLink { DIO.neighborType = DIO.ParentCandidate, + DIO.neighborRank = 299, + DIO.metric = Just 141 + } + } + ] + exp_daos = [ daoEntry (fromEpochMillisecond 60382) + "dao://[fd00::201:1:1:1]" (Just 2) + [("dao://[fd00::202:2:2:2]", 1740)] + ] + (got_dios, got_daos) <- parseFile pCoojaLogHead' "test/data/cooja.log" + got_dios `shouldBe` [exp_dio] + got_daos `shouldBe` exp_daos + specify "syslog root log" $ do + let exp_timestamp = fromEpochMillisecond 1546968337000 + exp_dio = + FoundNode + { subjectNode = fromJust $ idFromText "dio://[fd00::212:1199:eebb:62c4]", + foundAt = exp_timestamp, + nodeAttributes = DIO.DIONode { DIO.rank = 128, DIO.dioInterval = 14 }, + neighborLinks = + [ FoundLink + { targetNode = fromJust $ idFromText "dio://[fd00::212:1199:bbcc:4fdf]", + linkState = LinkUnused, + linkAttributes = DIO.DIOLink { DIO.neighborType = DIO.ParentCandidate, + DIO.neighborRank = 262, + DIO.metric = Just 128 + } + }, + FoundLink + { targetNode = fromJust $ idFromText "dio://[fd00::212:1199:bbcc:d52d]", + linkState = LinkUnused, + linkAttributes = DIO.DIOLink { DIO.neighborType = DIO.ParentCandidate, + DIO.neighborRank = 263, + DIO.metric = Just 128 + } + }, + FoundLink + { targetNode = fromJust $ idFromText "dio://[fd00::212:1199:bbcc:5e88]", + linkState = LinkUnused, + linkAttributes = DIO.DIOLink { DIO.neighborType = DIO.ParentCandidate, + DIO.neighborRank = 256, + DIO.metric = Just 128 + } + }, + FoundLink + { targetNode = fromJust $ idFromText "dio://[fd00::212:1199:eebb:62fe]", + linkState = LinkUnused, + linkAttributes = DIO.DIOLink { DIO.neighborType = DIO.ParentCandidate, + DIO.neighborRank = 256, + DIO.metric = Just 129 + } + } + ] + } + exp_daos = [ daoEntry exp_timestamp + "dao://[fd00::212:1199:eebb:62c4]" (Just 5) + [ ("dao://[fd00::212:1199:bbcc:d52d]", 1080), + ("dao://[fd00::212:1199:bbcc:4fdf]", 1260), + ("dao://[fd00::212:1199:eebb:62fe]", 1440), + ("dao://[fd00::212:1199:bbcc:5e88]", 1140) + ] + ] + pHead = pSyslogHead 2019 Nothing + (got_dios, got_daos) <- parseFile pHead "test/data/syslog_root.log" + got_dios `shouldBe` [exp_dio] + got_daos `shouldBe` exp_daos + specify "syslog nonroot" $ do + let exp_timestamp = fromEpochMillisecond 1547558149000 + exp_dio = + FoundNode + { subjectNode = fromJust $ idFromText "dio://[fd00::212:eeaa:0077:2f9c]", + foundAt = exp_timestamp, + nodeAttributes = DIO.DIONode { DIO.rank = 423, DIO.dioInterval = 16 }, + neighborLinks = + [ FoundLink + { targetNode = fromJust $ idFromText "dio://[fd00::212:eeaa:33cc:632a]", + linkState = LinkUnused, + linkAttributes = DIO.DIOLink { DIO.neighborType = DIO.ParentCandidate, + DIO.neighborRank = 256, + DIO.metric = Just 198 + } + }, + FoundLink + { targetNode = fromJust $ idFromText "dio://[fd00::212:eeaa:33ff:a874]", + linkState = LinkUnused, + linkAttributes = DIO.DIOLink { DIO.neighborType = DIO.ParentCandidate, + DIO.neighborRank = 256, + DIO.metric = Just 177 + } + }, + FoundLink + { targetNode = fromJust $ idFromText "dio://[fd00::212:eeaa:33cc:63d0]", + linkState = LinkToTarget, + linkAttributes = DIO.DIOLink { DIO.neighborType = DIO.PreferredParent, + DIO.neighborRank = 272, + DIO.metric = Just 151 + } + }, + FoundLink + { targetNode = fromJust $ idFromText "dio://[fd00::212:eeaa:9977:13ba]", + linkState = LinkUnused, + linkAttributes = DIO.DIOLink { DIO.neighborType = DIO.ParentCandidate, + DIO.neighborRank = 283, + DIO.metric = Just 152 + } + }, + FoundLink + { targetNode = fromJust $ idFromText "dio://[fd00::212:eeaa:33cc:6350]", + linkState = LinkUnused, + linkAttributes = DIO.DIOLink { DIO.neighborType = DIO.ParentCandidate, + DIO.neighborRank = 400, + DIO.metric = Just 171 + } + }, + FoundLink + { targetNode = fromJust $ idFromText "dio://[fd00::212:eeaa:e88:db36]", + linkState = LinkUnused, + linkAttributes = DIO.DIOLink { DIO.neighborType = DIO.ParentCandidate, + DIO.neighborRank = 432, + DIO.metric = Just 166 + } + }, + FoundLink + { targetNode = fromJust $ idFromText "dio://[fd00::212:eeaa:9977:b4]", + linkState = LinkUnused, + linkAttributes = DIO.DIOLink { DIO.neighborType = DIO.OtherNeighbor, + DIO.neighborRank = 584, + DIO.metric = Just 65535 + } + } + ] + } + pHead = pSyslogHead 2019 Nothing + (got_dios, got_daos) <- parseFile pHead "test/data/syslog_nonroot.log" + got_dios `shouldBe` [exp_dio] + got_daos `shouldBe` [] + specify "syslog sr tables" $ do + let exp_ts_jan = fromEpochMillisecond 1548843376000 + exp_ts_feb = fromEpochMillisecond 1549373162000 + exp_dio1 = + FoundNode + { subjectNode = fromJust $ idFromText "dio://[fd00::222:5566:cc99:62c4]", + foundAt = exp_ts_jan, + nodeAttributes = DIO.DIONode { DIO.rank = 128, DIO.dioInterval = 15 }, + neighborLinks = [] + } + exp_dio2 = + FoundNode + { subjectNode = fromJust $ idFromText "dio://[fd00::222:5566:cc99:62c4]", + foundAt = exp_ts_feb, + nodeAttributes = DIO.DIONode { DIO.rank = 128, DIO.dioInterval = 18 }, + neighborLinks = exp_dio_links2 + } + exp_dio_links2 = + [ FoundLink + { targetNode = fromJust $ idFromText "dio://[fd00::222:5566:ddee:4fdf]", + linkState = LinkUnused, + linkAttributes = DIO.DIOLink { DIO.neighborType = DIO.ParentCandidate, + DIO.neighborRank = 256, + DIO.metric = Just 128 + } + }, + FoundLink + { targetNode = fromJust $ idFromText "dio://[fd00::222:5566:ddee:d52d]", + linkState = LinkUnused, + linkAttributes = DIO.DIOLink { DIO.neighborType = DIO.ParentCandidate, + DIO.neighborRank = 396, + DIO.metric = Just 128 + } + }, + FoundLink + { targetNode = fromJust $ idFromText "dio://[fd00::222:5566:cc99:62fe]", + linkState = LinkUnused, + linkAttributes = DIO.DIOLink { DIO.neighborType = DIO.ParentCandidate, + DIO.neighborRank = 266, + DIO.metric = Just 137 + } + }, + FoundLink + { targetNode = fromJust $ idFromText "dio://[fd00::222:5566:ddee:401e]", + linkState = LinkUnused, + linkAttributes = DIO.DIOLink { DIO.neighborType = DIO.ParentCandidate, + DIO.neighborRank = 384, + DIO.metric = Just 128 + } + }, + FoundLink + { targetNode = fromJust $ idFromText "dio://[fd00::222:5566:ddee:5e88]", + linkState = LinkUnused, + linkAttributes = DIO.DIOLink { DIO.neighborType = DIO.ParentCandidate, + DIO.neighborRank = 406, + DIO.metric = Just 128 + } + } + ] + exp_daos = [ daoEntry exp_ts_feb + "dao://[fd00::222:5566:cc99:62c4]" (Just 6) + [ ("dao://[fd00::222:5566:ddee:4fdf]", 1140), + ("dao://[fd00::222:5566:cc99:62fe]", 1380) + ], + daoEntry exp_ts_feb + "dao://[fd00::222:5566:ddee:4fdf]" Nothing + [ ("dao://[fd00::222:5566:ddee:d52d]", 1380), + ("dao://[fd00::222:5566:ddee:401e]", 1740), + ("dao://[fd00::222:5566:ddee:5e88]", 1740) + ] + ] + pHead = pSyslogHead 2019 Nothing + (got_dios, got_daos) <- parseFile pHead "test/data/syslog_sr_tables.log" + got_dios `shouldBe` [exp_dio1, exp_dio2] + got_daos `shouldMatchList` exp_daos + diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/data/cooja.log b/test/data/cooja.log new file mode 100644 --- /dev/null +++ b/test/data/cooja.log @@ -0,0 +1,23 @@ +01:00.339 ID:2 [INFO: 6LoWPAN ] input: fragment (tag 4, payload 96, offset 232) -- 101 5 +01:00.339 ID:2 [INFO: TSCH-LOG ] {asn 00.0000176a link 0 7 2 2 0 ch 15} uc-1-0 rx LL-0001->LL-0002, len 122, seq 29, edr 0, dr 0 +01:00.339 ID:1 [INFO: RPL ] packet sent to 0002.0002.0002.0002, status 0, tx 1, new link metric 143 +01:00.347 ID:2 [INFO: 6LoWPAN ] input: fragment (tag 4, payload 24, offset 328) -- 29 5 +01:00.347 ID:2 [INFO: 6LoWPAN ] input: received IPv6 packet with len 352 +01:00.347 ID:2 [INFO: TCP/IP ] input: received 352 bytes +01:00.347 ID:2 [INFO: IPv6 ] packet received from fd00::201:1:1:1 to fd00::202:2:2:2 +01:00.347 ID:2 [INFO: IPv6 ] icmpv6 input length 352 type: 129 +01:00.347 ID:2 [INFO: ICMPv6 ] Received Echo Reply from fd00::201:1:1:1 to fd00::202:2:2:2 +01:00.347 ID:2 [INFO: TSCH-LOG ] {asn 00.0000176b link 0 7 3 3 0 ch 15} uc-1-0 rx LL-0001->LL-0002, len 50, seq 30, edr 0, dr 0 +01:00.347 ID:1 [INFO: RPL ] packet sent to 0002.0002.0002.0002, status 0, tx 1, new link metric 141 +01:00.382 ID:1 [INFO: RPL ] nbr: own state, addr fd00::201:1:1:1, DAG state: reachable, MOP 1 OCP 1 rank 128 max-rank 65535, dioint 15, nbr count 1 (Periodic) +01:00.382 ID:1 [INFO: RPL ] nbr: fe80::202:2:2:2 299, 141 => 440 -- 16 baf (last tx 0 min ago) +01:00.382 ID:1 [INFO: RPL ] nbr: end of list +01:00.382 ID:1 [INFO: RPL ] links: 2 routing links in total (Periodic) +01:00.382 ID:1 [INFO: RPL ] links: fd00::201:1:1:1 (DODAG root) (lifetime: infinite) +01:00.382 ID:1 [INFO: RPL ] links: fd00::202:2:2:2 to fd00::201:1:1:1 (lifetime: 1740 seconds) +01:00.382 ID:1 [INFO: RPL ] links: end of list +01:01.785 ID:1 [INFO: TSCH-LOG ] {asn 00.000017fb link 0 7 0 0 0 ch 20} bc-0-0 rx LL-0002->LL-NULL, len 35, seq 80, edr 0 +01:02.835 ID:2 [INFO: TSCH-LOG ] {asn 00.00001864 link 0 7 0 0 0 ch 15} bc-0-0 rx LL-0001->LL-NULL, len 35, seq 30, edr 0, dr 0 +01:05.425 ID:1 [INFO: TSCH-LOG ] {asn 00.00001967 link 0 7 0 0 0 ch 20} bc-0-0 rx LL-0002->LL-NULL, len 35, seq 80, edr 0 +01:05.581 ID:2 [INFO: RPL ] sending a multicast-DIO with rank 265 to ff02::1a +01:05.581 ID:2 [INFO: ICMPv6 ] Sending ICMPv6 packet to ff02::1a, type 155, code 1, len 72 diff --git a/test/data/syslog_nonroot.log b/test/data/syslog_nonroot.log new file mode 100644 --- /dev/null +++ b/test/data/syslog_nonroot.log @@ -0,0 +1,14 @@ +Jan 15 13:15:49 hostname label[15738]: [INFO: TSCH-LOG ] {asn 00.00e136df link 0 7 0 0 ch 16} bc-1-0 tx LL-2f9c->LL-NULL, len 94, seq 95, st 0 1 +Jan 15 13:15:49 hostname label[15738]: TSCH associated: 1 +Jan 15 13:15:49 hostname label[15738]: [WARN: RPL ] nbr: own state, addr fd00::212:eeaa:0077:2f9c, DAG state: reachable, MOP 1 OCP 1 rank 423 max-rank 1408, dioint 16, nbr count 10 (L-reporter) +Jan 15 13:15:49 hostname label[15738]: [WARN: RPL ] nbr: fe80::212:eeaa:33cc:632a 256, 198 => 454 -- 7 af +Jan 15 13:15:49 hostname label[15738]: [WARN: RPL ] nbr: fe80::212:eeaa:33ff:a874 256, 177 => 433 -- 3 a +Jan 15 13:15:49 hostname label[15738]: [WARN: RPL ] nbr: fe80::212:eeaa:33cc:63d0 272, 151 => 423 -- 16 bafp +Jan 15 13:15:49 hostname label[15738]: [WARN: RPL ] nbr: fe80::212:eeaa:9977:13ba 283, 152 => 435 -- 4 af +Jan 15 13:15:49 hostname label[15738]: [WARN: RPL ] nbr: fe80::212:eeaa:33cc:6350 400, 171 => 571 -- 2 a +Jan 15 13:15:49 hostname label[15738]: [WARN: RPL ] nbr: fe80::212:eeaa:e88:db36 432, 166 => 598 -- 3 a +Jan 15 13:15:49 hostname label[15738]: [WARN: RPL ] nbr: fe80::212:eeaa:9977:b4 584, 65535 => 65535 -- 0 +Jan 15 13:15:49 hostname label[15738]: [WARN: RPL ] nbr: end of list +Jan 15 13:15:49 hostname label[15738]: [INFO: TSCH-LOG ] {asn 00.00e136f4 link 0 7 0 0 ch 10} bc-0-0 rx LL-1391->LL-NULL, len 35, seq 19, edr -9 +Jan 15 13:15:50 hostname label[15738]: [INFO: TSCH-LOG ] {asn 00.00e1370b link 2 7 2 0 ch 16} bc-1-0 rx LL-1391->LL-NULL, len 94, seq 20, edr -5 +Jan 15 13:15:50 hostname label[15738]: [INFO: TSCH-LOG ] {asn 00.00e1371e link 0 7 0 0 ch 14} bc-0-0 tx LL-2f9c->LL-NULL, len 35, seq 96, st 0 1 diff --git a/test/data/syslog_root.log b/test/data/syslog_root.log new file mode 100644 --- /dev/null +++ b/test/data/syslog_root.log @@ -0,0 +1,13 @@ +Jan 8 17:25:37 hostname syslog_label[1715]: [INFO: RPL ] nbr: own state, addr fd00::212:1199:eebb:62c4, DAG state: reachable, MOP 1 OCP 1 rank 128 max-rank 65535, dioint 14, nbr count 5 (Periodic) +Jan 8 17:25:37 hostname syslog_label[1715]: [INFO: RPL ] nbr: fe80::212:1199:bbcc:4fdf 262, 128 => 390 -- 0 a (last tx 4945 min ago) +Jan 8 17:25:37 hostname syslog_label[1715]: [INFO: RPL ] nbr: fe80::212:1199:bbcc:d52d 263, 128 => 391 -- 0 a (last tx 1870 min ago) +Jan 8 17:25:37 hostname syslog_label[1715]: [INFO: RPL ] nbr: fe80::212:1199:bbcc:5e88 256, 128 => 384 -- 0 ba (last tx 4435 min ago) +Jan 8 17:25:37 hostname syslog_label[1715]: [INFO: RPL ] nbr: fe80::212:1199:eebb:62fe 256, 129 => 385 -- 0 a (last tx 2020 min ago) +Jan 8 17:25:37 hostname syslog_label[1715]: [INFO: RPL ] nbr: end of list +Jan 8 17:25:37 hostname syslog_label[1715]: [INFO: RPL ] links: 5 routing links in total (Periodic) +Jan 8 17:25:37 hostname syslog_label[1715]: [INFO: RPL ] links: fd00::212:1199:eebb:62c4 (DODAG root) (lifetime: infinite) +Jan 8 17:25:37 hostname syslog_label[1715]: [INFO: RPL ] links: fd00::212:1199:bbcc:d52d to fd00::212:1199:eebb:62c4 (lifetime: 1080 seconds) +Jan 8 17:25:37 hostname syslog_label[1715]: [INFO: RPL ] links: fd00::212:1199:bbcc:4fdf to fd00::212:1199:eebb:62c4 (lifetime: 1260 seconds) +Jan 8 17:25:37 hostname syslog_label[1715]: [INFO: RPL ] links: fd00::212:1199:eebb:62fe to fd00::212:1199:eebb:62c4 (lifetime: 1440 seconds) +Jan 8 17:25:37 hostname syslog_label[1715]: [INFO: RPL ] links: fd00::212:1199:bbcc:5e88 to fd00::212:1199:eebb:62c4 (lifetime: 1140 seconds) +Jan 8 17:25:37 hostname syslog_label[1715]: [INFO: RPL ] links: end of list diff --git a/test/data/syslog_sr_tables.log b/test/data/syslog_sr_tables.log new file mode 100644 --- /dev/null +++ b/test/data/syslog_sr_tables.log @@ -0,0 +1,20 @@ +Jan 30 10:16:16 hostname tag[3005]: [INFO: RPL ] nbr: own state, addr fd00::222:5566:cc99:62c4, DAG state: reachable, MOP 1 OCP 1 rank 128 max-rank 65535, dioint 15, nbr count 0 (Periodic) +Jan 30 10:16:16 hostname tag[3005]: [INFO: RPL ] nbr: end of list +Jan 30 10:16:16 hostname tag[3005]: [INFO: RPL ] No routing links +Feb 5 13:25:58 hostname tag[20840]: [INFO: RPL ] packet sent to 0222.5566.ddee.4fdf, status 0, tx 1, new link metric 128 +Feb 5 13:26:02 hostname tag[20840]: [INFO: RPL ] nbr: own state, addr fd00::222:5566:cc99:62c4, DAG state: reachable, MOP 1 OCP 1 rank 128 max-rank 65535, dioint 18, nbr count 5 (Periodic) +Feb 5 13:26:02 hostname tag[20840]: [INFO: RPL ] nbr: fe80::222:5566:ddee:4fdf 256, 128 => 384 -- 16 baf (last tx 0 min ago) +Feb 5 13:26:02 hostname tag[20840]: [INFO: RPL ] nbr: fe80::222:5566:ddee:d52d 396, 128 => 524 -- 1 a (last tx 7 min ago) +Feb 5 13:26:02 hostname tag[20840]: [INFO: RPL ] nbr: fe80::222:5566:cc99:62fe 266, 137 => 403 -- 13 af (last tx 0 min ago) +Feb 5 13:26:02 hostname tag[20840]: [INFO: RPL ] nbr: fe80::222:5566:ddee:401e 384, 128 => 512 -- 0 a (no tx) +Feb 5 13:26:02 hostname tag[20840]: [INFO: RPL ] nbr: fe80::222:5566:ddee:5e88 406, 128 => 534 -- 0 a (no tx) +Feb 5 13:26:02 hostname tag[20840]: [INFO: RPL ] nbr: end of list +Feb 5 13:26:02 hostname tag[20840]: [INFO: RPL ] links: 6 routing links in total (Periodic) +Feb 5 13:26:02 hostname tag[20840]: [INFO: RPL ] links: fd00::222:5566:cc99:62c4 (DODAG root) (lifetime: infinite) +Feb 5 13:26:02 hostname tag[20840]: [INFO: RPL ] links: fd00::222:5566:ddee:4fdf to fd00::222:5566:cc99:62c4 (lifetime: 1140 seconds) +Feb 5 13:26:02 hostname tag[20840]: [INFO: RPL ] links: fd00::222:5566:ddee:d52d to fd00::222:5566:ddee:4fdf (lifetime: 1380 seconds) +Feb 5 13:26:02 hostname tag[20840]: [INFO: RPL ] links: fd00::222:5566:cc99:62fe to fd00::222:5566:cc99:62c4 (lifetime: 1380 seconds) +Feb 5 13:26:02 hostname tag[20840]: [INFO: RPL ] links: fd00::222:5566:ddee:401e to fd00::222:5566:ddee:4fdf (lifetime: 1740 seconds) +Feb 5 13:26:02 hostname tag[20840]: [INFO: RPL ] links: fd00::222:5566:ddee:5e88 to fd00::222:5566:ddee:4fdf (lifetime: 1740 seconds) +Feb 5 13:26:02 hostname tag[20840]: [INFO: RPL ] links: end of list +Feb 5 13:26:03 hostname tag[20840]: [INFO: RPL ] sending a multicast-DIO with rank 128 to ff02::1a