diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,16 @@ +# Revision history for net-spider-rpl-cli + +## 0.1.1.0 -- 2019-09-23 + +* First release. +* Improve README. +* Add `--filter` option to `input` command. +* Add `--year` option to `input` command. +* Improve debug messages. +* Now `--starts-from` option is mandatory for `snapshot` command. +* Now at least one input file is mandatory for `input` command. + + +## 0.1.0.0 -- 2019-09-16 + +* Preliminary version. Not released to hackage. Just to test Docker Hub. 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,90 @@ +# net-spider-rpl-cli + +An executable of [net-spider](https://hackage.haskell.org/package/net-spider) specialized for analyzing [RPL](https://tools.ietf.org/html/rfc6550) networks. + +## Synopsis + +Here is an example of using the Docker images of this package. You have to install [docker](https://docs.docker.com/install/) and [docker-compose](https://docs.docker.com/compose/) first. + +1. Start the graph database backend (i.e. Gremlin Server). + + $ docker-compose up -d + +2. Clear the entire database. + + $ ./run-net-spider.sh clear + +3. Input logs about RPL networks. + + $ ./run-net-spider.sh input < syslog + +4. Get a snapshot graph of the RPL network in GraphML format. + + $ ./run-net-spider.sh snapshot --time-to '2019-09-20T10:43:08' --starts-from 'fd00::212:eeaa:0077:2f9c' > snapshot.graphml + + +## Description + +net-spider-rpl-cli is a tool to analyze evolution of an RPL network. It collects "local findings" about the network topology from RPL nodes, and stores those data into a graph database. Then you can query the database to get a "snapshot graph", a network topology at the specified time. + +For general description about net-spider and its terminology, see [net-spider README](https://github.com/debug-ito/net-spider). + +For details on command-line options, run the tool with `--help` option. + +## Build and install + +net-spider-rpl-cli is a regular Haskell package with an executable. You can install it from [hackage repository](https://hackage.haskell.org/package/net-spider-rpl-cli). + +Or, you can just use [the pre-built Docker image](#Docker-image). + +## Graph database + +net-spider-rpl-cli stores time-varying topology of an RPL network into a graph dabase via the [Gremlin Server](http://tinkerpop.apache.org/). You have to set up the server, and pass the server's hostname and port to `--host` and `--port` options, respectively. + +## Commands + +net-spider-rpl-cli has the folowing sub-commands. + +### clear command + +`clear` command clears the entire database. Use with care. + +### input command + +`input` command reads log files, extracts information about the RPL network topology with timestamps and stores them into the database. + +Currently, the format of the log files must be **logs of rpl-lite module of [Contiki-NG](https://github.com/contiki-ng/contiki-ng) operating system, prefixed with the standard syslog header.** See [this test file](https://github.com/debug-ito/net-spider/blob/master/net-spider-rpl/test/data/syslog_root.log) for an example. + +There are two kinds of RPL network topology: the DIO (upward) graph and the DAO (downward) graph. `input` command extracts and stores both kinds of information. + +### snapshot command + +`snapshot` command queries the database to make a "snapshot graph", an RPL network topology observed at the specified time. You can specify a time range with `--time-from` and `--time-to` options, and then it makes a snapshot graph using only those input information observed during the time range. + +To run this command, you have to specify `--starts-from` option at least one time. This is the IPv6 address of the node from which it searches for a snapshot graph. Usually this should be the address of the DODAG root. + +It prints the obtained snapshot graph to STDOUT in [GraphML](http://graphml.graphdrawing.org/) format. The graph includes both DIO and DAO graphs, but you can distinguish them by `link_type` attribute of edges. + +### cis command + +`cis` command is a short for "clear + input + snapshot". It clears the database, inputs the specified log files and returns a snapshot graph. + +With this command, you don't have to specify `--starts-from` option (it's ignored.) Instead, all IPv6 addresses observed in the input log files are searched. + + +## Docker image + +We provide pre-built Docker images of net-spider-rpl-cli and the graph database. + +- The Docker image of the graph database is specified in `docker-compose.yml` in this directory. + + - You can start it with `docker-compose up` command. + - The "db" directory stores persistent graph data. + +- The Docker image of net-spider-rpl-cli is available at Docker Hub as [debugito/net-spider-rpl-cli](https://hub.docker.com/r/debugito/net-spider-rpl-cli). +- To run the net-spider-rpl-cli image with the graph database image, use "run-net-spider.sh" script in this directory. + + +## 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/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,3 @@ +module Main (main) where + +import NetSpider.RPL.CLI (main) diff --git a/net-spider-rpl-cli.cabal b/net-spider-rpl-cli.cabal new file mode 100644 --- /dev/null +++ b/net-spider-rpl-cli.cabal @@ -0,0 +1,71 @@ +name: net-spider-rpl-cli +version: 0.1.1.0 +author: Toshio Ito +maintainer: Toshio Ito +license: BSD3 +license-file: LICENSE +synopsis: CLI executable of NetSpider.RPL. +description: CLI executable of "NetSpider.RPL". It's also an example of "NetSpider.CLI" module. + . + __This package is an experimental release. CLI interface and functionality may change drastically in future.__ + . + For detail, see README.md +stability: alpha +category: Database +cabal-version: >= 1.10 +build-type: Simple +extra-source-files: README.md, ChangeLog.md +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, RankNTypes + exposed-modules: NetSpider.RPL.CLI + -- other-modules: + build-depends: base >=4.11.1.0 && <4.13, + net-spider >=0.3.2.0 && <0.4, + net-spider-rpl >=0.2.2.0 && <0.3, + net-spider-cli >=0.1.0.1 && <0.2, + text >=1.2.2.2 && <1.3, + unordered-containers >=0.2.8 && <0.3, + greskell >=0.2.3 && <0.3, + optparse-applicative >=0.14.3.0 && <0.16, + monad-logger >=0.3.28.1 && <0.4, + time >=1.8.0.2 && <1.10 + +flag static + description: Static link + default: False + +executable net-spider-rpl-cli + 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, net-spider-rpl-cli + if flag(static) + ld-options: -static + +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: + other-modules: NetSpider.RPL.CLISpec + build-depends: base, net-spider-rpl-cli, net-spider, net-spider-rpl, optparse-applicative, + hspec >=2.5.5, + ip >=1.3.0 && <1.5 + +source-repository head + type: git + location: https://github.com/debug-ito/net-spider.git diff --git a/src/NetSpider/RPL/CLI.hs b/src/NetSpider/RPL/CLI.hs new file mode 100644 --- /dev/null +++ b/src/NetSpider/RPL/CLI.hs @@ -0,0 +1,371 @@ +{-# LANGUAGE OverloadedStrings, RankNTypes #-} +-- | +-- Module: NetSpider.RPL.CLI +-- Description: CLI executable of NetSpider.RPL +-- Maintainer: Toshio Ito +-- +module NetSpider.RPL.CLI + ( main, + -- * Symbols only for testing + optionParser, + CLIConfig(..), + Cmd(..), + InputParams(..) + ) where + +import qualified Data.Text.Lazy.IO as TLIO +import qualified Data.Text.IO as TIO +import Control.Applicative (many, some, (<$>), (<*>), optional) +import Control.Exception (bracket) +import Control.Monad (forM_, when, void) +import Control.Monad.Logger (LogLevel(LevelDebug)) +import Data.Greskell (Key(..)) +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HM +import Data.List (sortOn, reverse, intercalate) +import Data.Monoid ((<>), mconcat) +import Data.Text (Text, pack, unpack) +import Data.Time (getZonedTime, ZonedTime(zonedTimeToLocalTime), LocalTime(localDay), toGregorian) +import NetSpider.GraphML.Writer (writeGraphML) +import qualified NetSpider.CLI.Snapshot as CLIS +import NetSpider.CLI.Spider (SpiderConfig, parserSpiderConfig) +import NetSpider.Input + ( defConfig, logThreshold, + addFoundNode, clearAll, + FoundNode(subjectNode, foundAt, neighborLinks, nodeAttributes), + FoundLink(targetNode, linkAttributes), + LinkAttributes, NodeAttributes, + Spider, withSpider, nodeIdKey + ) +import NetSpider.Output + ( getSnapshot, + defQuery, unifyLinkSamples, unifyStd, + Query(startsFrom, timeInterval), + SnapshotNode, SnapshotLink, secUpTo, + SnapshotGraph + ) +import NetSpider.RPL.FindingID + ( FindingID(..), idToText, FindingType(..), + IPv6ID(..), ipv6FromText, ipv6Only + ) +import NetSpider.RPL.DIO + ( FoundNodeDIO, DIONode, MergedDIOLink + ) +import qualified NetSpider.RPL.DIO as DIO +import NetSpider.RPL.DAO (FoundNodeDAO) +import qualified NetSpider.RPL.DAO as DAO +import qualified NetSpider.RPL.Combined as RPL +import NetSpider.RPL.ContikiNG (parseFile, parseFileHandle, pSyslogHead) +import qualified Options.Applicative as Opt +import System.Environment (getArgs) +import System.Exit (die) +import System.IO (hPutStrLn, stderr, stdin) + +main :: IO () +main = do + cli_conf <- Opt.execParser $ Opt.info (Opt.helper <*> optionParser) $ mconcat $ + [ Opt.progDesc "net-spider front-end for RPL data model." + ] + let sconf = cliSpiderConfig cli_conf + cmd = cliCmd cli_conf + case cmd of + CmdClear -> doClear sconf + CmdInput inp -> void $ doInput sconf inp + CmdSnapshot q -> doSnapshot sconf q + CmdCIS inp q -> doCIS sconf inp q + where + doClear sconf = do + hPutStrLn stderr "---- Clear graph database" + withSpider sconf $ clearAll + + doInput sconf (InputParams filenames fnfilter myear) = do + -- filenames is a list of syslog filenames + + year <- getYear myear + + -- Read DIO and DAO FoundNodes. It might take a long time to + -- insert a lot of FoundNodes, so this executable inserts only + -- the latest FoundNode per node into the net-spider database. + (dio_nodes, dao_nodes) <- applyFoundNodeFilter fnfilter + =<< (fmap concatPairs $ mapM (loadFile year) filenames) + hPutStrLn stderr ("---- Load done") + + -- Input DIO and DAO FoundNodes. Note that we have to cast + -- SpiderConfig's type to match DIO and DAO FoundNode. + hPutStrLn stderr ("---- Put " <> (show $ length dio_nodes) <> " local findings about DIO") + when (isVerboseDebug sconf) $ forM_ dio_nodes printDIONode + putNodes (castSpiderConfig sconf) dio_nodes + hPutStrLn stderr ("---- Put " <> (show $ length dao_nodes) <> " local findings about DAO") + when (isVerboseDebug sconf) $ forM_ dao_nodes printDAONode + putNodes (castSpiderConfig sconf) dao_nodes + return (dio_nodes, dao_nodes) + + doSnapshot sconf query = do + let start_node_num = length $ startsFrom query + hPutStrLn stderr ("---- Query starts from " ++ (show start_node_num) ++ " nodes") + when (start_node_num == 0) $ do + die ("Specify the starting nodes with -s option.") + forM_ (startsFrom query) $ \nid -> do + hPutStrLn stderr (show nid) + -- Get DIO and DAO snapshot graphs with the Query. + hPutStrLn stderr ("---- Get DIO SnapshotGraph") + dio_graph <- withSpider (castSpiderConfig sconf) $ \sp -> do + getSnapshot sp $ rebaseQuery query FindingDIO (DIO.dioDefQuery []) + hPutStrLn stderr ("---- Get DAO SnapshotGraph") + dao_graph <- withSpider (castSpiderConfig sconf) $ \sp -> do + getSnapshot sp $ rebaseQuery query FindingDAO (DAO.daoDefQuery []) + + -- Merge DIO and DAO SnapshotGraphs into one. + let com_graph = RPL.combineGraphs dio_graph dao_graph + -- Write the merged SnapshotGraph in GraphML to stdout. + hPutStrLn stderr ("---- Format DIO+DAO SnapshotGraph into GraphML") + TLIO.putStr $ writeGraphML com_graph + + doCIS sconf input_params query_base = do + doClear sconf + (dio_nodes, dao_nodes) <- doInput sconf input_params + -- Make a query from the FoundNodes just loaded. + let starts = (map (ipv6Only . subjectNode) $ sortDAONodes dao_nodes) + ++ + (map (ipv6Only . subjectNode) dio_nodes) + q = query_base { startsFrom = starts } + doSnapshot sconf q + isVerboseDebug sconf = logThreshold sconf <= LevelDebug + + +---- CLI parsers. + +-- | Filter function of 'FoundNode', agnostic of node and link +-- attributes. +data FoundNodeFilter = + FoundNodeFilter + { fnfRun :: forall na la . [FoundNode FindingID na la] -> [FoundNode FindingID na la], + fnfSymbol :: String, + fnfDesc :: Text + } + +applyFoundNodeFilter :: FoundNodeFilter + -> ([FoundNode FindingID na1 la1], [FoundNode FindingID na2 la2]) + -> IO ([FoundNode FindingID na1 la1], [FoundNode FindingID na2 la2]) +applyFoundNodeFilter fnf input = do + hPutStrLn stderr ("---- Apply filter '" ++ fnfSymbol fnf ++ "' to local findings.") + return $ filterPairs (fnfRun fnf) input + +-- | Top-level configuration obtained from command-line arguments. +data CLIConfig n na fla = + CLIConfig + { cliSpiderConfig :: SpiderConfig n na fla, + cliCmd :: Cmd + } + +-- | Parameters for input command. Filenames to input, filter for +-- FoundNodes, and the year that the parser use to parse the input +-- files. +data InputParams = InputParams [FilePath] FoundNodeFilter (Maybe Year) + +-- | CLI subcommands and their arguments. +data Cmd = CmdClear -- ^ Clear the entire database. + | CmdInput InputParams -- ^ Input FoundNodes to the database + | CmdSnapshot (Query IPv6ID () () ()) -- ^ Get a snapshot graph. + | CmdCIS InputParams (Query IPv6ID () () ()) -- ^ Clear + Input + Snapshot + +optionParser :: Opt.Parser (CLIConfig n na fla) +optionParser = CLIConfig <$> parserSpiderConfig <*> parserCommands + where + parserCommands = Opt.hsubparser $ mconcat commands + commands = [ Opt.command "clear" $ + Opt.info (pure CmdClear) (Opt.progDesc "Clear the entire database."), + Opt.command "input" $ + Opt.info (CmdInput <$> parserInputParams) + (Opt.progDesc "Input local findings into the database."), + Opt.command "snapshot" $ + Opt.info (parserSnapshot True) (Opt.progDesc "Get a snapshot graph from the database."), + Opt.command "cis" $ + Opt.info (CmdCIS <$> parserInputParams <*> parserSnapshotQuery False) + (Opt.progDesc "Clear + Input + Snapshot at once. `startsFrom` of the query is set by local findings loaded from the files.") + ] + parserInputParams = InputParams <$> parserInputFiles <*> parserFilter <*> parserYear + parserInputFiles = some $ Opt.strArgument $ mconcat + [ Opt.metavar "FILE", + Opt.help "Input file. You can specify multiple times. If '-' is specified, it reads STDIN." + ] + ipv6Reader = (maybe (fail "Invalid IPv6") return . ipv6FromText . pack) =<< Opt.str + parserSnapshot parse_arg = fmap CmdSnapshot $ parserSnapshotQuery parse_arg + parserSnapshotQuery parse_arg = + CLIS.parserSnapshotQuery $ + CLIS.SnapshotConfig + { CLIS.nodeIDReader = ipv6Reader, + CLIS.basisSnapshotQuery = defQuery [], + CLIS.startsFromAsArguments = parse_arg + } + parserFilter = Opt.option readerFilter $ mconcat + [ Opt.metavar "FILTER", + Opt.help ( "Filter for local findings. Out of the local findings loaded from the input files, " + <> "only those that pass the filter are input to the database. " + <> "Possible values are: " <> filterDescs + ), + Opt.short 'F', + Opt.long "filter", + Opt.value (allFilters !! 0) + ] + filterDescs = intercalate ", " $ map descFor allFilters + descFor fnf = "'" <> fnfSymbol fnf <> "': " <> (unpack $ fnfDesc fnf) + readerFilter = selectFoundNodeFilter =<< Opt.str + selectFoundNodeFilter symbol = + case filter (\fnf -> fnfSymbol fnf == symbol) allFilters of + [] -> fail ("Unknown filter: " <> symbol) + (x : _) -> return x + allFilters = + [ FoundNodeFilter + { fnfRun = id, + fnfSymbol = "none", + fnfDesc = "Not filter anything. This is the default." + }, + FoundNodeFilter + { fnfRun = getLatestForEachNode, + fnfSymbol = "latest", + fnfDesc = "Input only the latest local finding for each node." + } + ] + parserYear = optional $ Opt.option Opt.auto $ mconcat + [ Opt.long "year", + Opt.metavar "YEAR", + Opt.help ( "If specified, the year of timestamps in local findings is set to YEAR. " + <> "If not specified, the year of the local system time is used. " + <> "This is because the input file format does not contain the year in timestamp." + ) + ] + +---- Type adaptation of Config and Query + +-- | Cast type variables of 'SpiderConfig'. The type variables are +-- basically phantom types for now. +castSpiderConfig :: SpiderConfig n1 na1 fla1 -> SpiderConfig n2 na2 fla2 +castSpiderConfig sc = sc { nodeIdKey = Key $ unKey $ nodeIdKey sc } + +-- | Convert the base of the original query. +rebaseQuery :: Query IPv6ID na1 fla1 sla1 -- ^ original query + -> FindingType -- ^ new finding type + -> Query FindingID na2 fla2 sla2 -- ^ new query base + -> Query FindingID na2 fla2 sla2 +rebaseQuery orig ftype base = base { startsFrom = map liftToFindingID $ startsFrom orig, + timeInterval = timeInterval orig + } + where + liftToFindingID (IPv6ID ip) = FindingID ftype ip + +---- I/O of FoundNodes + +type Year = Integer + +-- | If input is 'Just', it returns that year. If 'Nothing', it gets +-- the local year from the system and returns it. +getYear :: Maybe Year -> IO Year +getYear (Just y) = return y +getYear Nothing = do + zt <- getZonedTime + let (y, _, _) = toGregorian $ localDay $ zonedTimeToLocalTime zt + return y + +-- | Read a Contiki-NG log file, parse it with +-- 'NetSpider.RPL.ContikiNG.parseFile' to get 'FoundNodeDIO' and +-- 'FoundNodeDAO'. +loadFile :: Year + -> FilePath + -> IO ([FoundNodeDIO], [FoundNodeDAO]) +loadFile year file = do + (dio_nodes, dao_nodes) <- loadNodes + hPutStrLn stderr ((show $ length dio_nodes) <> " DIO local findings loaded") + hPutStrLn stderr ((show $ length dao_nodes) <> " DAO local findings loaded") + return (dio_nodes, dao_nodes) + where + phead = pSyslogHead year Nothing + loadNodes = do + if file == "-" + then do + hPutStrLn stderr ("---- Loading from stdin") + parseFileHandle phead stdin + else do + hPutStrLn stderr ("---- Loading " <> file) + parseFile phead file + + +-- | Put (insert) the given 'FoundNode's into the net-spider +-- database +putNodes :: (LinkAttributes fla, NodeAttributes na) + => SpiderConfig FindingID na fla + -> [FoundNode FindingID na fla] + -> IO () +putNodes sconf input_nodes = do + withSpider sconf $ \sp -> do + hPutStrLn stderr ("---- Add " <> (show $ length $ input_nodes) <> " local findings") + forM_ (zip input_nodes ([0 ..] :: [Integer])) $ \(input_node, index) -> do + when ((index `mod` 100) == 0) $ hPutStrLn stderr ("Add local finding [" <> show index <> "]") + addFoundNode sp input_node + hPutStrLn stderr "Add done" + +---- Print FoundNodes for debug + +printDIONode :: FoundNodeDIO -> IO () +printDIONode fn = do + TIO.hPutStrLn stderr ("---- DIO finding: " <> (idToText $ subjectNode fn) <> ", rank " <> rank_text) + forM_ plinks $ \l -> do + TIO.hPutStrLn stderr (" -> " <> (idToText $ targetNode l)) + where + plinks = filter isPreferredParentLink $ neighborLinks fn + rank_text = pack $ show $ DIO.rank $ nodeAttributes fn + isPreferredParentLink l = + (DIO.neighborType $ linkAttributes l) == DIO.PreferredParent + +printDAONode :: FoundNodeDAO -> IO () +printDAONode fn = do + TIO.hPutStrLn stderr ("---- DAO finding: " <> (idToText $ subjectNode fn) <> route_num_text) + forM_ (neighborLinks fn) $ \l -> do + TIO.hPutStrLn stderr (" -> " <> (idToText $ targetNode l) <> ", lifetime " <> lt_text l) + where + lt_text l = pack $ show $ DAO.pathLifetimeSec $ linkAttributes l + route_num_text = + case DAO.daoRouteNum $ nodeAttributes fn of + Nothing -> "" + Just n -> ", route_num " <> (pack $ show n) + +---- General utility functions. + +filterPairs :: (forall na la . [FoundNode FindingID na la] -> [FoundNode FindingID na la]) + -> ([FoundNode FindingID na1 la1], [FoundNode FindingID na2 la2]) + -> ([FoundNode FindingID na1 la1], [FoundNode FindingID na2 la2]) +filterPairs f (ns1, ns2) = (f ns1, f ns2) + +concatPairs :: [([a], [b])] -> ([a], [b]) +concatPairs [] = ([],[]) +concatPairs ((as, bs) : rest) = (as ++ rest_as, bs ++ rest_bs) + where + (rest_as, rest_bs) = concatPairs rest + + +---- Filter for FoundNode. + +type NodeMap n = HashMap FindingID [n] + +collectNodes :: [FoundNode FindingID na la] -> NodeMap (FoundNode FindingID na la) +collectNodes = foldr addNode HM.empty + where + addNode n acc = HM.insertWith f (subjectNode n) [n] acc + where + f new old = new ++ old + +getLatestNodes :: NodeMap (FoundNode n na la) -> [FoundNode n na la] +getLatestNodes nm = concat $ HM.elems $ fmap filterLatest nm + where + filterLatest fns = getHead $ reverse $ sortOn foundAt fns + getHead [] = [] + getHead (a : _) = [a] + +getLatestForEachNode :: [FoundNode FindingID na la] -> [FoundNode FindingID na la] +getLatestForEachNode = getLatestNodes . collectNodes + + +---- FoundNode utility + +sortDAONodes :: [FoundNodeDAO] -> [FoundNodeDAO] +sortDAONodes = reverse . sortOn (DAO.daoRouteNum . nodeAttributes) diff --git a/test/NetSpider/RPL/CLISpec.hs b/test/NetSpider/RPL/CLISpec.hs new file mode 100644 --- /dev/null +++ b/test/NetSpider/RPL/CLISpec.hs @@ -0,0 +1,37 @@ +module NetSpider.RPL.CLISpec (main,spec) where + +import Data.Monoid (mempty) +import qualified Options.Applicative as Opt +import Net.IPv6 (ipv6) +import NetSpider.Query (startsFrom) +import NetSpider.RPL.FindingID (IPv6ID(..)) +import Test.Hspec + +import NetSpider.RPL.CLI (optionParser, Cmd(..), CLIConfig(..)) + +main :: IO () +main = hspec spec + +runParser :: Opt.Parser a -> [String] -> Either String a +runParser opt args = toEither $ Opt.execParserPure prefs info args + where + prefs = Opt.prefs mempty + info = Opt.info opt mempty + toEither (Opt.Success a) = Right a + toEither (Opt.Failure f) = Left $ show f + toEither (Opt.CompletionInvoked c) = Left $ show c + +spec :: Spec +spec = do + describe "optionParser" $ do + specify "--starts-from" $ do + let parse_result = runParser optionParser ["snapshot", "-s", "fd00::212:4b00:13a4:c554"] + case parse_result of + Right (CLIConfig _ (CmdSnapshot got_q)) -> + startsFrom got_q `shouldBe` [IPv6ID $ ipv6 0xfd00 0 0 0 0x0212 0x4b00 0x13a4 0xc554] + Right _ -> + expectationFailure ("Unexpected CLIConfig obtained.") + Left err -> + expectationFailure (err) + + 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 #-}