diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,16 @@ # Revision history for net-spider-rpl +## 0.3.0.0 -- 2019-09-30 + +### ContikiNG module + +* [BREAKING CHANGE] `parseStream`, `parserFoundNodeDIO` and + `parserFoundNodeDAO` functions now require `MonadLogger` context. +* Add `parseFileHandleM` function. +* Now the parser functions can emit Warning logs when the parser fails + in an unexpected context. + + ## 0.2.3.0 -- 2019-09-24 ### ContikiNG module diff --git a/net-spider-rpl.cabal b/net-spider-rpl.cabal --- a/net-spider-rpl.cabal +++ b/net-spider-rpl.cabal @@ -1,5 +1,5 @@ name: net-spider-rpl -version: 0.2.3.0 +version: 0.3.0.0 author: Toshio Ito maintainer: Toshio Ito license: BSD3 @@ -14,7 +14,8 @@ test/data/syslog_root.log, test/data/syslog_nonroot.log, test/data/syslog_sr_tables.log, - test/data/syslog_inf_rank.log + test/data/syslog_inf_rank.log, + test/data/syslog_interleaving.log homepage: https://github.com/debug-ito/net-spider bug-reports: https://github.com/debug-ito/net-spider/issues @@ -42,7 +43,8 @@ conduit-parse >=0.2.1.0 && <0.3, conduit >=1.3.1 && <1.4, mtl >=2.2.2 && <2.3, - safe-exceptions >=0.1.7.0 && <0.2 + safe-exceptions >=0.1.7.0 && <0.2, + monad-logger >=0.3.28.1 && <0.4 -- executable net-spider-rpl -- default-language: Haskell2010 @@ -63,8 +65,10 @@ -- default-extensions: other-extensions: OverloadedStrings other-modules: NetSpider.RPL.ContikiNGSpec - build-depends: base, net-spider-rpl, net-spider, text, - hspec >=2.5.5 + build-depends: base, net-spider-rpl, net-spider, text, monad-logger, + hspec >=2.5.5, + bytestring >=0.10.8.2 && <0.11, + fast-logger >=2.4.11 && <2.5 source-repository head type: git diff --git a/src/NetSpider/RPL/ContikiNG.hs b/src/NetSpider/RPL/ContikiNG.hs --- a/src/NetSpider/RPL/ContikiNG.hs +++ b/src/NetSpider/RPL/ContikiNG.hs @@ -12,6 +12,7 @@ ( -- * Parser functions parseFile, parseFileHandle, + parseFileHandleM, parseStream, -- * Parser components -- ** Parsers for line stream @@ -28,8 +29,13 @@ import Control.Applicative ((<|>), (<$>), (<*>), (*>), (<*), many, optional) import Control.Exception.Safe (MonadThrow) import Control.Monad (void) -import Control.Monad.Except (throwError) +import Control.Monad.Except (throwError, catchError) +import Control.Monad.Logger + ( MonadLogger, runStderrLoggingT, filterLogger, LogLevel(LevelWarn), + logInfoN, logWarnN + ) import Control.Monad.IO.Class (liftIO, MonadIO) +import Control.Monad.Trans (lift) import Data.Bifunctor (Bifunctor(first)) import Data.Bits (shift) import Data.Char (isDigit, isHexDigit, isSpace) @@ -82,7 +88,8 @@ Just a -> return a -- | Read and parse a log file from a Contiki-NG application to make --- 'FoundNodeDIO' and 'FoundNodeDAO'. +-- 'FoundNodeDIO' and 'FoundNodeDAO'. This function may output warning +-- and error messages to STDERR. -- -- Currently this parser function supports logs from \"rpl-lite\" -- module only. @@ -108,7 +115,18 @@ parseFileHandle :: Parser Timestamp -- ^ Parser for log prefix -> Handle -- ^ File handle to read -> IO ([FoundNodeDIO], [FoundNodeDAO]) -parseFileHandle pTimestamp handle = +parseFileHandle p h = runStderrLoggingT $ filterLogger f $ parseFileHandleM p h + where + f _ level = level >= LevelWarn + +-- | Same as 'parseFileHandle', but in a generic monad. +-- +-- @since 0.3.0.0 +parseFileHandleM :: (MonadIO m, MonadThrow m, MonadLogger m) + => Parser Timestamp -- ^ Parser for log prefix + -> Handle -- ^ File handle to read + -> m ([FoundNodeDIO], [FoundNodeDAO]) +parseFileHandleM pTimestamp handle = fmap partitionEithers $ runConduit (the_source .| parseStream pTimestamp .| CL.consume) where the_source = do @@ -126,8 +144,8 @@ -- | Same as 'parseFile' but as an conduit. -- --- @since 0.2.3.0 -parseStream :: (MonadThrow m) +-- @since 0.3.0.0 +parseStream :: (MonadThrow m, MonadLogger m) => Parser Timestamp -- ^ Parser for log prefix -> ConduitT Line (Either FoundNodeDIO FoundNodeDAO) m () parseStream pTimestamp = go @@ -150,8 +168,8 @@ -- | Parse stream of log lines for a 'FoundNodeDIO'. -- --- @since 0.2.3.0 -parserFoundNodeDIO :: Monad m +-- @since 0.3.0.0 +parserFoundNodeDIO :: MonadLogger m => Parser Timestamp -- ^ Text parser for log head. -> ConduitParser Line m FoundNodeDIO parserFoundNodeDIO pTimestamp = do @@ -163,28 +181,42 @@ pDIOHead = (,) <$> pTimestamp <*> (pLogHead *> pDIONode) withPrefix p = pTimestamp *> pLogHead *> p proceedDIO ts addr node = do - links <- readUntilCP (withPrefix pDIONeighbor) (withPrefix pDIONeighborEnd) + links <- handleBlockError "DIO" $ readUntilCP (withPrefix pDIONeighbor) (withPrefix pDIONeighborEnd) return $ makeFoundNodeDIO ts addr node $ map (first $ setNonLocalPrefix addr) links +handleBlockError :: MonadLogger m => Text -> ConduitParser Line m r -> ConduitParser Line m r +handleBlockError target p = p `catchError` (\e -> (lift $ doLog e) >> throwError e) + where + doLog CP.UnexpectedEndOfInput = do + logInfoN ("EOF while parsing a block of " <> target <> ". The block is discarded.") + doLog (CP.Unexpected msg) = do + logWarnN ("Unexpected input while parsing a block of " <> target <> ": " <> msg) + doLog e = do + logWarnN ("Error while parsing a block of " <> target <> ": " <> (pack $ show e)) + -- | Parse stream of log lines for a 'FoundNodeDAO'. -- --- @since 0.2.3.0 -parserFoundNodeDAO :: Monad m +-- @since 0.3.0.0 +parserFoundNodeDAO :: MonadLogger m => Parser Timestamp -- ^ Text parser for log head. -> ConduitParser Line m [FoundNodeDAO] parserFoundNodeDAO pTimestamp = do line <- CP.await case runParser pDAOHead $ unpack line of Nothing -> throwError $ CP.Unexpected ("Not a log line head of local findings about DAO.") - Just (ts, r) -> proceedDAO ts r + Just (ts, r) -> proceedDAO line ts r where withPrefix p = pTimestamp *> pLogHead *> p pDAOHead = (,) <$> pTimestamp <*> (pLogHead *> pDAOLogHeader) - proceedDAO ts route_num = do - links <- readUntilCP (withPrefix pDAOLink) (withPrefix pDAOLinkEnd) - root_address <- maybe (throwError $ CP.Unexpected "No root address found in SR log") return - $ getRootAddress links + proceedDAO line ts route_num = do + links <- handleBlockError "DAO" $ readUntilCP (withPrefix pDAOLink) (withPrefix pDAOLinkEnd) + root_address <- maybe (rootAddressFailure line) return $ getRootAddress links return $ map (makeDAONodeFromTuple root_address route_num ts) $ groupDAOLinks links + rootAddressFailure :: MonadLogger m => Text -> ConduitParser Line m IPv6 + rootAddressFailure line = do + let msg = ("No root address found in DAO log: " <> line) + lift $ logWarnN msg + throwError $ CP.Unexpected msg getRootAddress :: [(IPv6, Maybe (IPv6, Word))] -> Maybe IPv6 getRootAddress links = fmap fst $ listToMaybe $ filter isRootEntry links where @@ -223,7 +255,7 @@ go acc = do line <- CP.await case runParser ((Left <$> pEnd) <|> (Right <$> pBody)) $ unpack line of - Nothing -> throwError $ CP.Unexpected ("Parse error at line: " <> line) + Nothing -> throwError $ CP.Unexpected line Just (Left _) -> return $ reverse acc Just (Right body) -> go (body : acc) diff --git a/test/NetSpider/RPL/ContikiNGSpec.hs b/test/NetSpider/RPL/ContikiNGSpec.hs --- a/test/NetSpider/RPL/ContikiNGSpec.hs +++ b/test/NetSpider/RPL/ContikiNGSpec.hs @@ -1,13 +1,18 @@ {-# LANGUAGE OverloadedStrings #-} module NetSpider.RPL.ContikiNGSpec (main,spec) where +import Control.Monad.Logger (runWriterLoggingT, LogLevel(LevelWarn)) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS import Data.Maybe (fromJust) import Data.Text (Text) import NetSpider.Found (FoundNode(..), FoundLink(..), LinkState(..)) import NetSpider.Timestamp (Timestamp, fromEpochMillisecond) +import System.IO (withFile, IOMode(ReadMode)) +import System.Log.FastLogger (fromLogStr) import Test.Hspec -import NetSpider.RPL.ContikiNG (parseFile, pCoojaLogHead', pSyslogHead) +import NetSpider.RPL.ContikiNG (parseFile, pCoojaLogHead', pSyslogHead, parseFileHandleM) import NetSpider.RPL.FindingID (idFromText) import qualified NetSpider.RPL.DIO as DIO import qualified NetSpider.RPL.DAO as DAO @@ -294,3 +299,43 @@ (got_dios, got_daos) <- parseFile pHead "test/data/syslog_inf_rank.log" got_dios `shouldBe` [exp_dio] got_daos `shouldMatchList` [] + specify "syslog_interleaving" $ do + let exp_dio = + FoundNode + { subjectNode = fromJust $ idFromText "dio://[fd00::212:eeaa:0077:2f9c]", + foundAt = fromEpochMillisecond 1547558152000, + nodeAttributes = DIO.DIONode { DIO.rank = 332, DIO.dioInterval = 14 }, + neighborLinks = exp_links + } + exp_links = + [ FoundLink + { targetNode = fromJust $ idFromText "dio://[fd00::212:eeaa:33cc:63d0]", + linkState = LinkToTarget, + linkAttributes = DIO.DIOLink { DIO.neighborType = DIO.PreferredParent, + DIO.neighborRank = 188, + DIO.metric = Just 144 + } + }, + FoundLink + { targetNode = fromJust $ idFromText "dio://[fd00::212:eeaa:9977:13ba]", + linkState = LinkUnused, + linkAttributes = DIO.DIOLink { DIO.neighborType = DIO.ParentCandidate, + DIO.neighborRank = 263, + DIO.metric = Just 152 + } + } + ] + pHead = pSyslogHead 2019 Nothing + ((got_dios, got_daos), got_logs) <- withFile "test/data/syslog_interleaving.log" ReadMode + (runWriterLoggingT . parseFileHandleM pHead) + got_dios `shouldBe` [exp_dio] + got_daos `shouldBe` [] + -- Because the log file contains interleaving lines inside DIO + -- block, it should emit a warning message. + length got_logs `shouldBe` 1 + let exp_msg = "Jan 15 13:15:49 hostname hoge[3392]: this is a log not related to ContikiNG." + (_, _, got_level, got_msg_str) = got_logs !! 0 + got_msg = fromLogStr got_msg_str + got_level `shouldBe` LevelWarn + got_msg `shouldSatisfy` BS.isInfixOf exp_msg + got_msg `shouldSatisfy` BS.isInfixOf "DIO" diff --git a/test/data/syslog_interleaving.log b/test/data/syslog_interleaving.log new file mode 100644 --- /dev/null +++ b/test/data/syslog_interleaving.log @@ -0,0 +1,21 @@ +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 hoge[3392]: this is a log not related to ContikiNG. +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 hoge[3392]: this is another log. +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 +Jan 15 13:15:49 hostname hoge[3392]: the log block below should be parsed correctly. +Jan 15 13:15:52 hostname label[15738]: [WARN: RPL ] nbr: own state, addr fd00::212:eeaa:0077:2f9c, DAG state: reachable, MOP 1 OCP 1 rank 332 max-rank 1408, dioint 14, nbr count 2 (L-reporter) +Jan 15 13:15:52 hostname label[15738]: [WARN: RPL ] nbr: fe80::212:eeaa:33cc:63d0 188, 144 => 332 -- 16 bafp +Jan 15 13:15:53 hostname label[15738]: [WARN: RPL ] nbr: fe80::212:eeaa:9977:13ba 263, 152 => 415 -- 4 af +Jan 15 13:15:49 hostname label[15738]: [WARN: RPL ] nbr: end of list