hnormalise (empty) → 0.2.0.0
raw patch · 31 files changed
+2066/−0 lines, 31 filesdep +aesondep +aeson-prettydep +attoparsecsetup-changed
Dependencies added: aeson, aeson-pretty, attoparsec, base, bytestring, conduit, conduit-combinators, conduit-extra, containers, criterion, directory, hnormalise, hspec, hspec-attoparsec, hspec-core, hspec-expectations, ip, optparse-applicative, permute, random, resourcet, text, word8, yaml
Files
- LICENSE +30/−0
- README.md +221/−0
- Setup.hs +2/−0
- app/Main.hs +152/−0
- hnormalise.cabal +111/−0
- src/HNormalise.hs +88/−0
- src/HNormalise/Common/Internal.hs +21/−0
- src/HNormalise/Common/Json.hs +24/−0
- src/HNormalise/Common/Parser.hs +80/−0
- src/HNormalise/Config.hs +81/−0
- src/HNormalise/Huppel/Internal.hs +17/−0
- src/HNormalise/Huppel/Json.hs +17/−0
- src/HNormalise/Huppel/Parser.hs +22/−0
- src/HNormalise/Internal.hs +72/−0
- src/HNormalise/Json.hs +51/−0
- src/HNormalise/Lmod/Internal.hs +29/−0
- src/HNormalise/Lmod/Json.hs +42/−0
- src/HNormalise/Lmod/Parser.hs +50/−0
- src/HNormalise/Parser.hs +78/−0
- src/HNormalise/Shorewall/Internal.hs +43/−0
- src/HNormalise/Shorewall/Json.hs +43/−0
- src/HNormalise/Shorewall/Parser.hs +117/−0
- src/HNormalise/Torque/Internal.hs +94/−0
- src/HNormalise/Torque/Json.hs +41/−0
- src/HNormalise/Torque/Parser.hs +188/−0
- test/Bench.hs +45/−0
- test/HNormalise/Common/ParserSpec.hs +29/−0
- test/HNormalise/Lmod/ParserSpec.hs +46/−0
- test/HNormalise/Shorewall/ParserSpec.hs +68/−0
- test/HNormalise/Torque/ParserSpec.hs +162/−0
- test/Spec.hs +2/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2017++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 Author name here 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.
+ README.md view
@@ -0,0 +1,221 @@+hNormalise+==========++[](http://travis-ci.org/itkovian/hnormalise)++`hNormalise` is a small tool and accompanying library for the conversion of regular [rsyslog](http://www.rsyslog.com) to+structured log messages, i.e., turning the `msg` payload into (a nested) JSON object.++Features:++- accepts JSON-style rsyslog data (sent as %jsonmesg% in the rsyslog template)+- accepts legacy encoded rsyslog data (currently sent with the fixed template+ <%PRI%>1 %TIMEGENERATED% %HOSTNAME% %SYSLOGTAG% - %APPNAME%: %msg%)+- sends out successfull converted results on a TCP port, allowing communication back to a wide range of services,+ including rsyslog, [logstash](http://www.elastic.co/products/logstash), ...+- sends out original messages to a (different) TCP port in case the parsing fails, allowing other services to process the+ information.++Usage and configuration+-----------------------++To run and build `hNormalise`, clone this repository and run `stack build` followed by `stack install` inside it.+To start just run `hnormalise`. If you need help, use the `-h` flag. To run the included tests, run `stack test`.+To run the included benchmarks, run `stack bench` (with the `--output target.html` flag to get a nice web page with+the results).++Ports and machines can be tweaked through a configuration file. See `data/hnormalise.yaml` for an example.++Testing the actual setup can be done trivially via `nc`, provided you have data to throw at `hNormalise`. A test example+is also provided below, or you can get useful examples from the tests, under `test/HNormalise/*/ParserSpec.hs`++Supported log messages+----------------------++Currently, hNormalise supports several log messages out of the box (i.e., the ones we need :)+- [Torque](http://www.adaptivecomputing.com/products/open-source/torque/) accounting logs for a job exit.+- [Shorewall](http://shorewall.org) firewall log messages for TCP, UDP and ICMP connections+- [Lmod](https://www.tacc.utexas.edu/research-development/tacc-projects/lmod) module load messages++More are forthcoming soon, e.g., (in no particular order)+- GPFS+- Icinga+- NFS+- OpenNebula+- SSH+- Snoopy+- Jube++Parsing+-------++`hNormalise` uses the [Attoparsec](https://github.com/bos/attoparsec) package to have fast and efficient parsing.+`Attoparsec` offers a clean and relatively simple DSL that allows getting the relevant data from the message and+discarding the rest. We also rely on [permute]() to deal with log lines that may contain e.g., key-value pairs in+no definite ordering. Note that this _will_ slow down the parsing.+++Caveat: at this point, we do not a priori restrict the possible parsers we unleash on each message. However, if the inbound+data can be tagged properly, we could reduce the maximal number of parsers tried and avoid extensive backtracking.++### Adding a new parser++To add a new parser for log lines from tool `Tool`, several actions must be taken:++- A `src/HNormalise/Tool` directory must be created, under which all specific code and data types for the new+ log lines will reside. Note that `Tool` can provide multiple types of log lines, but they should all be coded under+ the same location.+- Define a data type that holds the relevant data from the log line you wish to keep/forward in `HNOrmalise.Tool.Internal`.+ Make sure that the type derives `Generic` (and add the require language extentions on top of the file).+- The parser goes in the `HNormalise.Tool.Parser` module.+- Conversion of the data type that was defined to hold the data to JSON is done in `HNormalise.Tool.JSON`.+- Finally, the `HNormalise` module defines a sum-type container to which you should add your own entry. Remember to also+ add a line for the corresponding getJsonKey function, which defines the key under whoch the parsed data will be+ made available downstream.+- Add tests with relevant cases under `test/HNormalise/Tool/ParserSpec.hs`. The framework should pick these up+automagically.+- Add en entry for your test cases to the set of benchmarks, so we can have a reasonable estimate on how your parser is+ performing. Update the HTML page under `benchmarks` with the complete set of tests you ran.+++Example+-------++The original (anonymised) message sent by rsyslog (as JSON) for a Torque job exit event is++~~~~+{"msg":"05/14/2017 00:00:02;E;3275189.master.mycluster.mydomain.com;user=someuser group=somegroup jobname=myjob queue=long ctime=1494689613 qtime=1494689613 etime=1494689613 start=1494689684 owner=someuser@login.mycluster.mydomain.com exec_host=mynode.mycluster.mydomain.com/1 Resource_List.neednodes=mynode:ppn=1 Resource_List.nice=0 Resource_List.nodect=1 Resource_List.nodes=mynode:ppn=1 Resource_List.vmem=4720302336b Resource_List.walltime=71:59:59 session=102034 total_execution_slots=1 unique_node_count=1 end=1494712802 Exit_status=0 resources_used.cput=23076 resources_used.energy_used=0 resources_used.mem=64480kb resources_used.vmem=314996kb resources_used.walltime=06:25:15", "rawmsg": "redacted", "timereported": "2017-05-15T18:16:16.724002+02:00", "hostname": "master.mydomain.com", "syslogtag": "hnormalise", "inputname": "imfile", "fromhost": "", "fromhost-ip": "", "pri": "133", "syslogfacility": "16", "syslogseverity": "5", "timegenerated": "2017-05-15T18:16:16.724002+02:00", "programname": "hnormalise", "protocol-version": "0", "structured-data": "-", "app-name": "hnormalise", "procid": "-", "msgid": "-", "uuid": null, "$!": null }+~~~~++The resulting JSON is sent to logstash, which forwarded it to ES, e.g. with the following configuration++~~~~+input {+ tcp {+ type => "normalised_syslog"+ port => 26002+ codec => "json"+ }+}++filter {+ if [type] == 'normalised_syslog' {+ mutate {+ add_field => {+ "[@metadata][target_index]" => "rsyslog-test"+ }+ }+ }+}++output {+ elasticsearch {+ template_overwrite => true+ document_type => "%{@type}"+ index => "%{[@metadata][target_index]}"+ hosts => [ "127.0.0.1" ]+ flush_size => 50+ }+}+~~~~++The following information can be retrieved from Elasticsearch. The interesting part is the `torque` entry, which is what we+aimed to get.++~~~~{.json}+{+ "took" : 1,+ "timed_out" : false,+ "_shards" : {+ "total" : 5,+ "successful" : 5,+ "failed" : 0+ },+ "hits" : {+ "total" : 1,+ "max_score" : 1.0,+ "hits" : [+ {+ "_index" : "rsyslog-test",+ "_type" : "%{@type}",+ "_id" : "AVwWnWEqQ4ADFiA38GPp",+ "_score" : 1.0,+ "_source" : {+ "@timestamp" : "2017-05-17T13:33:51.690Z",+ "port" : 58031,+ "@version" : "1",+ "host" : "0:0:0:0:0:0:0:1",+ "torque" : {+ "owner" : "someuser@login.mycluster.mydomain.com",+ "startCount" : null,+ "resourceUsage" : {+ "mem" : 66027520,+ "vmem" : 322555904,+ "cputime" : 23076,+ "walltime" : {+ "hours" : 6,+ "seconds" : 15,+ "minutes" : 25,+ "days" : 0+ },+ "energy" : 0+ },+ "resourceRequest" : {+ "neednodes" : {+ "Right" : [+ {+ "name" : "mynode",+ "ppn" : 1+ }+ ]+ },+ "nodes" : {+ "Right" : [+ {+ "name" : "mynode",+ "ppn" : 1+ }+ ]+ },+ "vmem" : 4720302336,+ "nodeCount" : 1,+ "walltime" : {+ "hours" : 71,+ "seconds" : 59,+ "minutes" : 59,+ "days" : 0+ },+ "nice" : 0+ },+ "session" : 102034,+ "times" : {+ "qtime" : 1494689613,+ "etime" : 1494689613,+ "ctime" : 1494689613,+ "startTime" : 1494689684,+ "endTime" : 1494712802+ },+ "totalExecutionSlots" : 1,+ "name" : {+ "cluster" : "mycluster",+ "number" : 3275189,+ "array_id" : null,+ "master" : "master"+ },+ "uniqueNodeCount" : 1,+ "user" : "someuser",+ "exitStatus" : 0,+ "jobname" : "myjob",+ "queue" : "long",+ "group" : "somegroup"+ },+ "message" : "05/14/2017 00:00:02;E;3275189.master.mycluster.mydomain.com;user=someuser group=somegroup jobname=myjob queue=long ctime=1494689613 qtime=1494689613 etime=1494689613 start=1494689684 owner=someuser@login.mycluster.mydomain.com exec_host=mynode.mycluster.mydomain.com/1 Resource_List.neednodes=mynode:ppn=1 Resource_List.nice=0 Resource_List.nodect=1 Resource_List.nodes=mynode:ppn=1 Resource_List.vmem=4720302336b Resource_List.walltime=71:59:59 session=102034 total_execution_slots=1 unique_node_count=1 end=1494712802 Exit_status=0 resources_used.cput=23076 resources_used.energy_used=0 resources_used.mem=64480kb resources_used.vmem=314996kb resources_used.walltime=06:25:15",+ "syslog_abspri" : "5",+ "type" : "normalised_syslog",+ "tags" : [ ]+ }+ }+ ]+ }+}+~~~~
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Main where++--------------------------------------------------------------------------------+import Control.Applicative ((<$>), (<*>))+import Control.Monad+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Resource (runResourceT)+import Data.Aeson+import Data.Attoparsec.Text+import qualified Data.ByteString.Char8 as SBS+import qualified Data.ByteString.Lazy.Char8 as BS+import Data.Conduit+import Data.Conduit.Binary (sinkFile)+import qualified Data.Conduit.Binary as CB+import qualified Data.Conduit.Combinators as C+import Data.Conduit.Network+import qualified Data.Conduit.Text as DCT+import Data.Maybe (fromJust)+import Data.Monoid (mempty, (<>))+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import Data.Version (showVersion)+import qualified Options.Applicative as OA+import qualified Paths_hnormalise+import System.Exit (exitFailure, exitSuccess)++import Debug.Trace+--------------------------------------------------------------------------------+import HNormalise+import HNormalise.Config (Config (..), loadConfig)+import HNormalise.Internal (Rsyslog (..))+import HNormalise.Json++--------------------------------------------------------------------------------+data Options = Options+ { oConfigFilePath :: !(Maybe FilePath)+ , oJsonInput :: !Bool+ , oVersion :: !Bool+ , oTestFilePath :: !(Maybe FilePath)+ } deriving (Show)++--------------------------------------------------------------------------------+parserOptions :: OA.Parser Options+parserOptions = Options+ <$> (OA.optional $ OA.strOption $+ OA.long "configfile" <>+ OA.short 'c' <>+ OA.metavar "FILENAME" <>+ OA.help "configuration file location ")+ <*> (OA.switch $+ OA.long "jsoninput" <>+ OA.short 'j' <>+ OA.help "Input will be delivered as JSON (slower)")+ <*> (OA.switch $+ OA.long "version" <>+ OA.short 'v' <>+ OA.help "Display version and exit" <>+ OA.hidden)+ <*> (OA.optional $ OA.strOption $+ OA.long "test" <>+ OA.short 't' <>+ OA.metavar "OUTPUT FILENAME" <>+ OA.help "run in test modus, sinking output to the given file")+++--------------------------------------------------------------------------------+parserInfo :: OA.ParserInfo Options+parserInfo = OA.info (OA.helper <*> parserOptions)+ (OA.fullDesc+ <> OA.progDesc "Normalise rsyslog messages"+ <> OA.header ("hNormalise v" <> showVersion Paths_hnormalise.version)+ )++--------------------------------------------------------------------------------+messageSink success failure = loop+ where+ loop = do+ v <- await+ case v of+ Just (Transformed json) -> do+ yield json $$ appSink success+ yield (SBS.pack "\n") $$ appSink success+ loop+ Just (Original l) -> do+ yield l $$ appSink failure+ yield (SBS.pack "\n") $$ appSink success+ loop+ Nothing -> return ()+++--------------------------------------------------------------------------------+-- for testing purposes+mySink = loop+ where+ loop = do+ v <- await+ case v of+ Just (Transformed json) -> do+ yield (SBS.pack "success: ")+ yield json+ yield (SBS.pack "\n")+ loop+ Just (Original l) -> do+ yield (SBS.pack "fail - original: ")+ yield l+ yield (SBS.pack "\n")+ loop+ Nothing -> return ()+++--------------------------------------------------------------------------------+main :: IO ()+main = do+ options <- OA.execParser parserInfo++ when (oVersion options) $ do+ putStrLn $ showVersion Paths_hnormalise.version+ exitSuccess++ config <- loadConfig (oConfigFilePath options)++ let lHost = case listenHost config of+ Just h -> T.unpack h+ Nothing -> "*"+++ runTCPServer (serverSettings (fromJust $ listenPort config) "*") $ \appData -> do++ case oTestFilePath options of+ Nothing ->+ runTCPClient (clientSettings (fromJust $ successPort config) "localhost") $ \successServer ->+ runTCPClient (clientSettings (fromJust $ failPort config) "localhost") $ \failServer ->+ case oJsonInput options of+ True -> appSource appData+ $= CB.lines+ $= C.map normaliseJsonInput+ $$ messageSink successServer failServer+ False -> appSource appData+ $= DCT.decode DCT.utf8+ $= DCT.lines+ $= C.map normaliseText+ $$ messageSink successServer failServer+ Just testSinkFileName ->+ runResourceT $ appSource appData+ $= (case oJsonInput options of+ True -> CB.lines $= C.map normaliseJsonInput+ False -> DCT.decode DCT.utf8 $= DCT.lines $= C.map normaliseText)+ $= mySink+ $$ sinkFile testSinkFileName
+ hnormalise.cabal view
@@ -0,0 +1,111 @@+name: hnormalise+version: 0.2.0.0+synopsis: Log message normalisation tool producing structured JSON messages+description: Log message normalisation tool producing structured JSON messages+homepage: https://github.com/itkovian/hnormalise#readme+license: BSD3+license-file: LICENSE+author: Andy Georges+maintainer: itkovian@gmail.com+copyright: 2017 Andy Georges+category: Command line+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: HNormalise+ , HNormalise.Config+ , HNormalise.Internal+ , HNormalise.Json+ , HNormalise.Parser+ , HNormalise.Common.Json+ , HNormalise.Common.Parser+ , HNormalise.Common.Internal+ , HNormalise.Huppel.Internal+ , HNormalise.Huppel.Json+ , HNormalise.Huppel.Parser+ , HNormalise.Lmod.Internal+ , HNormalise.Lmod.Json+ , HNormalise.Lmod.Parser+ , HNormalise.Shorewall.Internal+ , HNormalise.Shorewall.Json+ , HNormalise.Shorewall.Parser+ , HNormalise.Torque.Internal+ , HNormalise.Torque.Json+ , HNormalise.Torque.Parser+ build-depends: base >= 4.7 && < 5+ , aeson+ , aeson-pretty+ , attoparsec+ , bytestring+ , containers+ , directory+ , ip+ , permute+ , text+ , yaml+ default-language: Haskell2010++executable hnormalise+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -funbox-strict-fields -optc-O2+ build-depends: base+ , hnormalise+ , aeson+ , aeson-pretty+ , attoparsec+ , bytestring+ , conduit+ , conduit-combinators+ , conduit-extra+ , containers+ , directory+ , ip+ , optparse-applicative+ , resourcet+ , text+ , word8+ , yaml+ default-language: Haskell2010++test-suite hnormalise-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ other-modules: HNormalise.Common.ParserSpec+ , HNormalise.Lmod.ParserSpec+ , HNormalise.Shorewall.ParserSpec+ , HNormalise.Torque.ParserSpec+ build-depends: base+ , aeson+ , attoparsec+ , conduit-extra+ , hnormalise+ , hspec+ , hspec-core+ , hspec-expectations+ , hspec-attoparsec+ , ip+ , text+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++benchmark hnormalise-bench+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Bench.hs+ build-depends: base+ , attoparsec+ , criterion+ , hnormalise+ , random+ , text+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -funbox-strict-fields -optc-O2+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/githubuser/hnormalise
+ src/HNormalise.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE OverloadedStrings #-}+++module HNormalise+ ( normaliseRsyslog+ , normaliseJsonInput+ , normaliseText+ , parseMessage+ , Normalised (..)+ ) where++--------------------------------------------------------------------------------+import Control.Applicative ((<|>))+import Data.Aeson (ToJSON)+import qualified Data.Aeson as Aeson+import Data.Aeson.Text (encodeToLazyText)+import Data.Attoparsec.Combinator (lookAhead, manyTill)+import Data.Attoparsec.Text+import qualified Data.ByteString.Char8 as SBS+import qualified Data.ByteString.Lazy.Char8 as BS+import Data.Text (Text, empty)+import Data.Text.Lazy (toStrict)++--------------------------------------------------------------------------------+import HNormalise.Huppel.Internal+import HNormalise.Huppel.Json+import HNormalise.Internal+import HNormalise.Json+import HNormalise.Lmod.Internal+import HNormalise.Lmod.Json+import HNormalise.Parser+import HNormalise.Torque.Internal+import HNormalise.Torque.Json++--------------------------------------------------------------------------------+data Normalised+ -- | A `Transformed` message contains the JSON normalised representation as a `ByteString`+ = Transformed !SBS.ByteString+ -- | An 'Original' messge contains the unaltered incoming message as a 'ByteString'+ | Original !SBS.ByteString++--------------------------------------------------------------------------------+-- | The 'normaliseJsonInput' function converts a `ByteString` to a normalised message or keeps the original if+-- the conversion (parsing) fails.+normaliseJsonInput :: SBS.ByteString -- ^ Input representing an rsyslog message in JSON format+ -> Normalised -- ^ Transformed or Original result+normaliseJsonInput logLine =+ case (Aeson.decodeStrict logLine :: Maybe Rsyslog) >>= normaliseRsyslog of+ Just j -> Transformed j+ Nothing -> Original logLine++--------------------------------------------------------------------------------+-- | The 'normaliseText' function converts a 'Text' to a normalised message or keeps the original (in 'ByteString')+-- format if the conversion fails+normaliseText :: Text -- ^ Input+ -> Normalised -- ^ Transformed or Original result+normaliseText logLine =+ case parse parseRsyslogLogstashString logLine of+ Done _ r -> Transformed r+ Partial c -> case c empty of+ Done _ r -> Transformed r+ _ -> original+ _ -> original+ where+ original = Original $ BS.toStrict $ Aeson.encode $ logLine++--------------------------------------------------------------------------------+-- | The 'convertMessage' function transforms the actual message to a 'Maybe' 'ParseResult'. If parsing fails,+-- the result is 'Nothing'.+convertMessage :: Text -> Maybe ParseResult+convertMessage message =+ case parse parseMessage message of+ Done _ pm -> Just pm+ Partial c -> case c empty of+ Done _ pm -> Just pm+ _ -> Nothing+ _ -> Nothing++--------------------------------------------------------------------------------+-- | The 'normaliseRsyslog' function returns an 'NRSyslog' structure tranformed to a 'ByteString' or 'Nothing'+-- when parsing fails+normaliseRsyslog :: Rsyslog -- ^ Incoming rsyslog information+ -> Maybe SBS.ByteString -- ^ IF the conversion succeeded the JSON encoded rsyslog message to forward+normaliseRsyslog rsyslog = do+ cm <- convertMessage $ msg rsyslog+ return $ BS.toStrict+ $ Aeson.encode+ $ NRsyslog { rsyslog = rsyslog, normalised = cm, jsonkey = getJsonKey cm }
+ src/HNormalise/Common/Internal.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE OverloadedStrings #-}++module HNormalise.Common.Internal+ ( Host (..)+ ) where++--------------------------------------------------------------------------------+import Data.Aeson (FromJSON, ToJSON, toEncoding,+ toJSON)+import Data.Text+import GHC.Generics (Generic)+import qualified Net.Types as Net++--------------------------------------------------------------------------------+data Host = Hostname Text -- hostname+ | IPv4 Net.IPv4+ | IPv6 Net.IPv6+ deriving (Show, Eq)
+ src/HNormalise/Common/Json.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+++module HNormalise.Common.Json where++--------------------------------------------------------------------------------+import Data.Aeson+import Data.Text+import Data.Aeson.Encoding.Internal+import Data.Monoid+import qualified Net.Types as NT+--------------------------------------------------------------------------------+import HNormalise.Common.Internal++instance ToJSON NT.IPv6 where+ toJSON = String . pack . show++--------------------------------------------------------------------------------+instance ToJSON Host where+ toJSON (Hostname h) = toJSON h+ toJSON (IPv4 ip) = toJSON ip+ toJSON (IPv6 ip) = toJSON ip
+ src/HNormalise/Common/Parser.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}++module HNormalise.Common.Parser where++--------------------------------------------------------------------------------+import Control.Applicative ((<|>))+import Data.Attoparsec.Text+import Data.Char (isSpace)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Net.IPv4.Text as IPv4+import qualified Net.IPv6.Text as IPv6++--------------------------------------------------------------------------------+import HNormalise.Common.Internal++--------------------------------------------------------------------------------+hostnameParser :: Parser Text+hostnameParser = sepBy' (takeWhile1 (inClass "a-z0-9-")) (char '.') >>= \hns -> return $ T.intercalate "." hns+{-# INLINE hostnameParser #-}++--------------------------------------------------------------------------------+hostnameOrIPParser :: Parser Host+hostnameOrIPParser = choice+ [ IPv4.parser >>= \ip -> return $ IPv4 ip+ , IPv6.parser >>= \ip -> return $ IPv6 ip+ , hostnameParser >>= \h -> return $ Hostname h+ ]+{-# INLINE hostnameOrIPParser #-}++--------------------------------------------------------------------------------+keyParser k = string k *> char '='+{-# INLINE keyParser #-}++--------------------------------------------------------------------------------+kvParser :: Parser (Text, Text)+kvParser = do+ key <- takeTill (== '=')+ value <- char '=' *> takeTill isSpace+ return (key, value)+{-# INLINE kvParser #-}++--------------------------------------------------------------------------------+kvTextParser :: Text -> Parser Text+kvTextParser key = kvTextDelimParser key " \n\t"+{-# INLINE kvTextParser #-}++--------------------------------------------------------------------------------+kvTextDelimParser :: Text -> String -> Parser Text+kvTextDelimParser key ds = keyParser key *> takeTill (`elem` ds)+{-# INLINE kvTextDelimParser #-}++--------------------------------------------------------------------------------+kvNumParser :: Integral a => Text -> Parser a+kvNumParser key = keyParser key *> decimal+{-# INLINE kvNumParser #-}++--------------------------------------------------------------------------------+kvYesNoParser :: Text -> Parser Bool+kvYesNoParser key = do+ keyParser key+ yn <- asciiCI "yes" <|> asciiCI "no"+ return $ case T.toLower yn of+ "yes" -> True+ "no" -> False+{-# INLINE kvYesNoParser #-}++--------------------------------------------------------------------------------+kvHostOrIPParser :: Text -> Parser Host+kvHostOrIPParser key = keyParser key *> hostnameOrIPParser++{-# INLINE kvHostOrIPParser #-}++--------------------------------------------------------------------------------+maybeOption :: Parser a -> Parser (Maybe a)+maybeOption p = option Nothing (Just <$> p)+{-# INLINE maybeOption #-}
+ src/HNormalise/Config.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module HNormalise.Config+ ( Config(..)+ , loadConfig+ ) where++--------------------------------------------------------------------------------+import Control.Monad (mplus)+import Data.Aeson (defaultOptions)+import Data.Aeson.TH (deriveJSON)+import qualified Data.ByteString as B+import Data.Monoid ((<>))+import Data.Text (Text)+import qualified Data.Yaml as Y+import System.Directory+++--------------------------------------------------------------------------------+data Config = Config+ { listenPort :: !(Maybe Int) -- ^ port for incoming messages+ , listenHost :: !(Maybe Text) -- ^ binding to this host specification (TODO: needs support for HostPreference)+ , successPort :: !(Maybe Int) -- ^ port to send rsyslog with successfully parsed and normalised msg part+ , successHost :: !(Maybe Text) -- ^ host to send normalised data to+ , failPort :: !(Maybe Int) -- ^ port to send rsyslog messges that failed to parse+ , failHost :: !(Maybe Text) -- ^ host to send original data to when parsing failed+ } deriving (Show)++--------------------------------------------------------------------------------+instance Monoid Config where+ mempty = Config+ Nothing Nothing Nothing Nothing Nothing Nothing+ mappend l r = Config+ { listenPort = listenPort l `mplus` listenPort r+ , listenHost = listenHost l `mplus` listenHost r+ , successPort = successPort l `mplus` successPort r+ , successHost = successHost l `mplus` successHost r+ , failPort = failPort l `mplus` failPort r+ , failHost = failHost l `mplus` failHost r+ }++--------------------------------------------------------------------------------+defaultConfig = Config+ { listenPort = Just 4019+ , listenHost = Just "localhost"+ , successPort = Just 26002+ , successHost = Just "localhost"+ , failPort = Just 4018+ , failHost = Just "localhost"+ }++--------------------------------------------------------------------------------+systemConfigFileLocation :: FilePath+systemConfigFileLocation = "/etc/hnormalise.yaml"++--------------------------------------------------------------------------------+readConfig :: FilePath -> IO Config+readConfig fp = do+ exists <- doesFileExist fp+ if exists then do+ contents <- B.readFile fp+ case Y.decodeEither contents of+ Left err -> error $ "HNormalise.Config.readConfig: " ++ err+ Right config -> return (config :: Config)+ else+ return mempty+++--------------------------------------------------------------------------------+loadConfig :: Maybe FilePath -> IO Config+loadConfig fp = do+ userConfig <- case fp of+ Just fp' -> readConfig fp'+ Nothing -> return mempty+ systemConfig <- readConfig systemConfigFileLocation+ return $ userConfig <> systemConfig <> defaultConfig++--------------------------------------------------------------------------------+$(deriveJSON defaultOptions ''Config)
+ src/HNormalise/Huppel/Internal.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}++module HNormalise.Huppel.Internal where+++--------------------------------------------------------------------------------+import Data.Text+import GHC.Generics (Generic)+--------------------------------------------------------------------------------++++data Huppel = Huppel+ { id :: Int } deriving (Eq, Show, Generic)
+ src/HNormalise/Huppel/Json.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++module HNormalise.Huppel.Json where++--------------------------------------------------------------------------------+import Data.Aeson++--------------------------------------------------------------------------------++import HNormalise.Huppel.Internal+--------------------------------------------------------------------------------+++instance ToJSON Huppel where+ toEncoding = genericToEncoding defaultOptions
+ src/HNormalise/Huppel/Parser.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}++module HNormalise.Huppel.Parser where++--------------------------------------------------------------------------------+import Control.Applicative ((<|>))+import Data.Attoparsec.Combinator (lookAhead, manyTill)+import Data.Attoparsec.Text+--------------------------------------------------------------------------------++import HNormalise.Common.Parser+import HNormalise.Huppel.Internal+--------------------------------------------------------------------------------+++parseHuppel :: Parser Huppel+parseHuppel = do+ i <- string "huppel" *> skipSpace *> decimal+ return $ Huppel { id = i }
+ src/HNormalise/Internal.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE OverloadedStrings #-}++module HNormalise.Internal where++--------------------------------------------------------------------------------+import Data.Aeson (FromJSON, ToJSON, toEncoding,+ toJSON)+import Data.Text+import GHC.Generics (Generic)++--------------------------------------------------------------------------------+import HNormalise.Huppel.Internal (Huppel)+import HNormalise.Huppel.Json+import HNormalise.Lmod.Internal (LmodLoad)+import HNormalise.Lmod.Json+import HNormalise.Shorewall.Internal (Shorewall)+import HNormalise.Shorewall.Json+import HNormalise.Torque.Internal (TorqueJobExit)+import HNormalise.Torque.Json++--------------------------------------------------------------------------------+data ParseResult+ -- | 'Huppel' Result for testing purposes, should you want to check the pipeline works without pushing in actual data+ = PR_H Huppel+ -- | Represents a parsed 'LmodLoad' message+ | PR_L LmodLoad+ -- | Represents a parsed 'Shorewall' message+ | PR_S Shorewall+ -- | Represents a parsed 'TorqueJobExit' message+ | PR_T TorqueJobExit+ deriving (Show, Eq, Generic)++--------------------------------------------------------------------------------+instance ToJSON ParseResult where+ toEncoding (PR_H v) = toEncoding v+ toEncoding (PR_L v) = toEncoding v+ toEncoding (PR_S v) = toEncoding v+ toEncoding (PR_T v) = toEncoding v++--------------------------------------------------------------------------------+data Rsyslog = Rsyslog+ { msg :: !Text+ --, rawmsg :: !Text+ , timereported :: !Text+ , hostname :: !Text+ , syslogtag :: !Text -- Could be a list?+ , inputname :: !Text+ , fromhost :: !Text+ , fromhost_ip :: !Text+ , pri :: !Text+ , syslogfacility :: !Text+ , syslogseverity :: !Text+ , timegenerated :: !Text+ , programname :: !Text+ , protocol_version :: !Text+ --, structured_data :: !Text+ , app_name :: !Text+ , procid :: !Text+ --, msgid :: !Text+ --, uuid :: !(Maybe Text)+ --, all_json :: !(Maybe Text)+ } deriving (Eq, Show, Generic)++--------------------------------------------------------------------------------+data NormalisedRsyslog = NRsyslog+ { rsyslog :: Rsyslog -- ^ The original rsyslog message in a parsed form+ , normalised :: ParseResult -- ^ The normalised message+ , jsonkey :: Text -- ^ The key under which the normalised info will appear in the JSON result+ } deriving (Eq, Show, Generic)
+ src/HNormalise/Json.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++module HNormalise.Json where++--------------------------------------------------------------------------------+import Control.Monad+import Data.Aeson+import Data.Monoid++--------------------------------------------------------------------------------+import HNormalise.Internal++--------------------------------------------------------------------------------+instance FromJSON Rsyslog where+ parseJSON = withObject "Rsyslog" $ \v ->+ Rsyslog <$>+ (v .: "msg") <*>+ -- (v .: "rawmsg") <*>+ (v .: "timereported") <*>+ (v .: "hostname") <*>+ (v .: "syslogtag") <*>+ (v .: "inputname") <*>+ (v .: "fromhost") <*>+ (v .: "fromhost-ip") <*>+ (v .: "pri") <*>+ (v .: "syslogfacility") <*>+ (v .: "syslogseverity") <*>+ (v .: "timegenerated") <*>+ (v .: "programname") <*>+ (v .: "protocol-version") <*>+ -- (v .: "structured-data") <*>+ (v .: "app-name") <*>+ (v .: "procid")+ -- (v .: "msgid") <*>+ -- (v .:? "uuid") <*>+ -- (v .:? "$!")++--------------------------------------------------------------------------------+instance ToJSON Rsyslog where+ toEncoding = genericToEncoding defaultOptions++--------------------------------------------------------------------------------+instance ToJSON NormalisedRsyslog where+ toEncoding (NRsyslog r n k) =+ pairs+ ( "message" .= msg r+ <> "syslog_abspri" .= syslogseverity r+ <> k .= n+ )
+ src/HNormalise/Lmod/Internal.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}++module HNormalise.Lmod.Internal where++--------------------------------------------------------------------------------+import Data.Text+import GHC.Generics (Generic)+--------------------------------------------------------------------------------++data LmodModule = LmodModule+ { name :: !Text+ , version :: !Text+ } deriving (Show, Eq, Generic)++data LmodInfo = LmodInfo+ { username :: !Text+ , cluster :: !Text+ , jobid :: !Text+ } deriving (Show, Eq, Generic)++data LmodLoad = LmodLoad+ { info :: !LmodInfo+ , userload :: !Bool+ , modul :: !LmodModule+ , filename :: !Text+ } deriving (Show, Eq, Generic)
+ src/HNormalise/Lmod/Json.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+++module HNormalise.Lmod.Json where++--------------------------------------------------------------------------------+import Data.Aeson+import Data.Monoid+--------------------------------------------------------------------------------++import HNormalise.Lmod.Internal+--------------------------------------------------------------------------------+++instance ToJSON LmodInfo where+ --toEncoding = genericToEncoding defaultOptions+ toEncoding (LmodInfo username cluster jobid) =+ pairs+ ( "username" .= username+ <> "cluster" .= cluster+ <> "jobid" .= jobid+ )++instance ToJSON LmodLoad where+ --toEncoding = genericToEncoding defaultOptions+ toEncoding (LmodLoad info userload modul filename) =+ pairs+ ( "info" .= info+ <> "userload" .= userload+ <> "module" .= modul+ <> "filename" .= filename+ )++instance ToJSON LmodModule where+ --toEncoding = genericToEncoding defaultOptions+ toEncoding (LmodModule name version) =+ pairs+ ( "name" .= name+ <> "version" .= version+ )
+ src/HNormalise/Lmod/Parser.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}++module HNormalise.Lmod.Parser where++--------------------------------------------------------------------------------+import Control.Applicative ((<|>))+import Data.Attoparsec.Combinator (lookAhead, manyTill)+import Data.Attoparsec.Text+--------------------------------------------------------------------------------++import HNormalise.Common.Parser+import HNormalise.Lmod.Internal+--------------------------------------------------------------------------------++parseLmodInfo :: Parser LmodInfo+parseLmodInfo = do+ username <- kvTextDelimParser "username" ","+ cluster <- char ',' *> skipSpace *> kvTextDelimParser "cluster" ","+ jobid <- char ',' *> skipSpace *> kvTextDelimParser "jobid" ","+ return LmodInfo+ { username = username+ , cluster = cluster+ , jobid = jobid+ }++parseLmodModule :: Parser LmodModule+parseLmodModule = do+ name <- kvTextDelimParser "module" "/"+ version <- char '/' *> Data.Attoparsec.Text.takeWhile (/= ',')+ return LmodModule+ { name = name+ , version = version+ }++parseLmodLoad :: Parser LmodLoad+parseLmodLoad = do+ string "lmod::"+ info <- skipSpace *> parseLmodInfo+ userload <- char ',' *> skipSpace *> kvYesNoParser "userload"+ m <- char ',' *> skipSpace *> parseLmodModule+ filename <- char ',' *> skipSpace *> kvTextParser "fn"+ return LmodLoad+ { info = info+ , userload = userload+ , modul = m+ , filename = filename+ }
+ src/HNormalise/Parser.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE OverloadedStrings #-}++module HNormalise.Parser where++--------------------------------------------------------------------------------+import Control.Applicative ((<|>))+import Data.Aeson (encode)+import Data.Attoparsec.Text+import qualified Data.ByteString.Char8 as SBS+import qualified Data.ByteString.Lazy.Char8 as BS+import Data.Char+import Data.Text (Text, empty)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+--------------------------------------------------------------------------------+import HNormalise.Huppel.Parser+import HNormalise.Internal+import HNormalise.Json+import HNormalise.Lmod.Parser+import HNormalise.Shorewall.Parser+import HNormalise.Torque.Parser+--------------------------------------------------------------------------------+rsyslogLogstashTemplate = "<%PRI%>1 %timegenerated:::date-rfc3339% %HOSTNAME% %syslogtag% - %APP-NAME%: %msg:::drop-last-lf%\n"++--------------------------------------------------------------------------------+-- | The 'parseMessage' function will try and use each configured parser to normalise the input it's given+parseMessage :: Parser ParseResult+parseMessage =+ (parseLmodLoad >>= (\v -> return $ PR_L v))+ <|> (parseShorewall >>= (\v -> return $ PR_S v))+ <|> (parseTorqueExit >>= (\v -> return $ PR_T v))++--------------------------------------------------------------------------------+-- | The 'getJsonKey' function return the key under which the normalised message should appear when JSON is produced+getJsonKey :: ParseResult -> Text+getJsonKey (PR_H _) = "huppel"+getJsonKey (PR_L _) = "lmod"+getJsonKey (PR_T _) = "torque"+getJsonKey (PR_S _) = "shorewall"++--------------------------------------------------------------------------------+-- | The 'parseRsyslogLogstashString' currently is a placeholder function that will convert the incoming rsyslog message+-- if it is encoded as expected in a plain string format+parseRsyslogLogstashString :: Parser SBS.ByteString+parseRsyslogLogstashString = do+ pri <- char '<' *> takeTill (== '>')+ char '>' *> decimal+ timegenerated <- skipSpace *> takeTill isSpace+ hostname <- skipSpace *> takeTill isSpace+ syslogtag <- skipSpace *> takeTill isSpace -- FIXME: this might be incorrect+ skipSpace *> char '-'+ appname <- skipSpace *> takeTill (== ':')+ (original, parsed) <- match $ char ':' *> skipSpace *> parseMessage+ return $ let jsonkey = getJsonKey parsed+ in BS.toStrict $ encode $ NRsyslog+ { rsyslog = Rsyslog+ { msg = original+ , timereported = T.empty+ , hostname = hostname+ , syslogtag = syslogtag+ , inputname = T.empty+ , fromhost = T.empty+ , fromhost_ip = T.empty+ , pri = pri+ , syslogfacility = T.empty+ , syslogseverity = T.empty+ , timegenerated = timegenerated+ , programname = T.empty+ , protocol_version = T.empty+ , app_name = appname+ , procid = T.empty+ }+ , normalised = parsed+ , jsonkey = jsonkey+ }
+ src/HNormalise/Shorewall/Internal.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE OverloadedStrings #-}++module HNormalise.Shorewall.Internal where++{-+SHOREWALL_TCP .*?%{WORD:fwrule}\:%{WORD:fwtarget}\:IN\=%{WORD:fwin} OUT\=\s*MAC\=%{DATA:fwmac} SRC\=%{IPORHOST:fwsrc} DST\=%{IPORHOST:fwdst} .*? PROTO\=%{WORD:fwproto} SPT\=%{INT:fwspt:int} DPT\=%{INT:fwdpt:int} .*?+SHOREWALL_UDP .*?%{WORD:fwrule}\:%{WORD:fwtarget}\:IN\=%{WORD:fwin} OUT\=%{WORD:fwout}.*?SRC\=%{IPORHOST:fwsrc} DST\=%{IPORHOST:fwdst} .*? PROTO\=%{WORD:fwproto} SPT\=%{INT:fwspt:int} DPT\=%{INT:fwdpt:int} .*?+SHOREWALL_ICMP .*?%{WORD:fwrule}\:%{WORD:fwtarget}\:IN\=%{WORD:fwin} OUT\=%{WORD:fwout} SRC\=%{IPORHOST:fwsrc} DST\=%{IPORHOST:fwdst} .*? PROTO\=%{WORD:fwproto} .*?++SHOREWALL_MSG (?:%{SHOREWALL_TCP}|%{SHOREWALL_UDP}|%{SHOREWALL_ICMP})++ "raw" : "2016-04-07T09:27:26.729986+02:00 gastly kernel: - kernel:: Shorewall:ipmi2ext:REJECT:IN=em4 OUT=em3 SRC=10.0.0.2 DST=10.0.0.1 LEN=28 TOS=0x00 PREC=0x00 TTL=63 ID=36216 PROTO=ICMP TYPE=8 CODE=0 ID=0 SEQ=1421",+ "raw" : "2016-03-31T23:45:27.615225+02:00 gastly kernel: - kernel:: Shorewall:ipmi2int:REJECT:IN=em4 OUT=em1 SRC=10.0.0.2 DST=10.0.0.1 LEN=57 TOS=0x00 PREC=0x00 TTL=63 ID=62392 PROTO=UDP SPT=57002 DPT=53 LEN=37",+ "raw" : "2016-03-29T16:10:49.386951+02:00 gligar03 kernel: - kernel:: Shorewall:ext2fw:REJECT:IN=em3 OUT= MAC=aa:aa:bb:ff:88:bc:bc:15:80:8b:f8:f8:80:00 SRC=78.0.0.1 DST=150.0.0.1 LEN=52 TOS=0x00 PREC=0x00 TTL=117 ID=7564 DF PROTO=TCP SPT=60048 DPT=22 WINDOW=65535 RES=0x00 SYN URGP=0",+-}+--------------------------------------------------------------------------------+import Data.Aeson (FromJSON, ToJSON, toEncoding,+ toJSON)+import Data.Text+import GHC.Generics (Generic)++--------------------------------------------------------------------------------+import HNormalise.Common.Internal++--------------------------------------------------------------------------------+data ShorewallProtocol = TCP | UDP | ICMP deriving (Show, Eq, Generic)++--------------------------------------------------------------------------------+data Shorewall = Shorewall+ { fwrule :: !Text+ , fwtarget :: !Text+ , fwin :: !Text+ , fwout :: !(Maybe Text)+ , fwmac :: !(Maybe Text)+ , fwsrc :: !Host+ , fwdst :: !Host+ , fwproto :: !ShorewallProtocol+ , fwspt :: !(Maybe Integer)+ , fwdpt :: !(Maybe Integer)+ } deriving (Show, Eq, Generic)
+ src/HNormalise/Shorewall/Json.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++module HNormalise.Shorewall.Json where++--------------------------------------------------------------------------------+import Control.Monad+import Data.Aeson+import Data.Monoid++--------------------------------------------------------------------------------+import HNormalise.Common.Json+import HNormalise.Shorewall.Internal++--------------------------------------------------------------------------------+instance ToJSON ShorewallProtocol where+ toJSON TCP = String "TCP"+ toJSON UDP = String "UDP"+ toJSON ICMP = String "ICMP"+--------------------------------------------------------------------------------+instance ToJSON Shorewall where+ toEncoding (Shorewall fwrule fwtarget fwin fwout fwmac fwsrc fwdst fwproto fwspt fwdpt) =+ pairs+ ( "fwrule" .= fwrule+ <> "fwtarget" .= fwtarget+ <> "fwin" .= fwin+ <> case fwout of+ Nothing -> mempty+ Just f -> "fwout" .= f+ <> case fwmac of+ Nothing -> mempty+ Just m -> "fwmac" .= m+ <> "fwsrc" .= fwsrc+ <> "fwdst" .= fwdst+ <> "fwproto" .= fwproto+ <> case fwspt of+ Nothing -> mempty+ Just p -> "fwspt" .= p+ <> case fwdpt of+ Nothing -> mempty+ Just p -> "fwdst" .= p+ )
+ src/HNormalise/Shorewall/Parser.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}++module HNormalise.Shorewall.Parser where++--------------------------------------------------------------------------------+import Control.Applicative ((<|>))+import Data.Attoparsec.Combinator (lookAhead, manyTill)+import Data.Attoparsec.Text+import qualified Data.Text as T++--------------------------------------------------------------------------------+import HNormalise.Common.Parser+import HNormalise.Shorewall.Internal++--------------------------------------------------------------------------------+parseShorewallTCP :: Parser Shorewall+parseShorewallTCP = do+ string " - kernel:: Shorewall:"+ fwrule <- takeTill (== ':')+ fwtarget <- char ':' *> takeTill (== ':')+ fwin <- char ':' *> kvTextParser "IN"+ fwmac <- skipSpace *> string "OUT=" *> skipSpace *> kvParser >>= return . snd -- FIXME: ideally this parses a MAC address+ fwsrc <- skipSpace *> kvHostOrIPParser "SRC"+ fwdst <- skipSpace *> kvHostOrIPParser "DST"+ manyTill anyChar (lookAhead $ string " PROTO=")+ string " PROTO=TCP"+ fwspt <- skipSpace *> kvNumParser "SPT"+ fwdpt <- skipSpace *> kvNumParser "DPT"+ takeText+ return $ Shorewall+ { fwrule = fwrule+ , fwtarget = fwtarget+ , fwin = fwin+ , fwout = Nothing+ , fwmac = Just fwmac+ , fwsrc = fwsrc+ , fwdst = fwdst+ , fwproto = TCP+ , fwspt = Just fwspt+ , fwdpt = Just fwdpt+ }++ {-+ SHOREWALL_UDP .*?%{WORD:fwrule}\:%{WORD:fwtarget}\:IN\=%{WORD:fwin} OUT\=%{WORD:fwout}.*?SRC\=%{IPORHOST:fwsrc} DST\=%{IPORHOST:fwdst} .*? PROTO\=%{WORD:fwproto} SPT\=%{INT:fwspt:int} DPT\=%{INT:fwdpt:int} .*?+ SHOREWALL_MSG (?:%{SHOREWALL_TCP}|%{SHOREWALL_UDP}|%{SHOREWALL_ICMP})+ "raw" : "2016-03-31T23:45:27.615225+02:00 gastly kernel: - kernel:: Shorewall:ipmi2int:REJECT:IN=em4 OUT=em1 SRC=10.0.0.2 DST=10.0.0.1 LEN=57 TOS=0x00 PREC=0x00 TTL=63 ID=62392 PROTO=UDP SPT=57002 DPT=53 LEN=37",+ -}++--------------------------------------------------------------------------------+parseShorewallUDP :: Parser Shorewall+parseShorewallUDP = do+ string " - kernel:: Shorewall:"+ fwrule <- takeTill (== ':')+ fwtarget <- char ':' *> takeTill (== ':')+ fwin <- char ':' *> kvTextParser "IN"+ fwout <- skipSpace *> kvTextParser "OUT"+ fwsrc <- skipSpace *> kvHostOrIPParser "SRC"+ fwdst <- skipSpace *> kvHostOrIPParser "DST"+ manyTill anyChar (lookAhead $ string "PROTO=")+ string "PROTO=UDP"+ fwspt <- skipSpace *> kvNumParser "SPT"+ fwdpt <- skipSpace *> kvNumParser "DPT"+ takeText+ return $ Shorewall+ { fwrule = fwrule+ , fwtarget = fwtarget+ , fwin = fwin+ , fwout = Just fwout+ , fwmac = Nothing+ , fwsrc = fwsrc+ , fwdst = fwdst+ , fwproto = UDP+ , fwspt = Just fwspt+ , fwdpt = Just fwdpt+ }+++ {-+ SHOREWALL_ICMP .*?%{WORD:fwrule}\:%{WORD:fwtarget}\:IN\=%{WORD:fwin} OUT\=%{WORD:fwout} SRC\=%{IPORHOST:fwsrc} DST\=%{IPORHOST:fwdst} .*? PROTO\=%{WORD:fwproto} .*?+ SHOREWALL_MSG (?:%{SHOREWALL_TCP}|%{SHOREWALL_UDP}|%{SHOREWALL_ICMP})+ "raw" : "2016-04-07T09:27:26.729986+02:00 gastly kernel: - kernel:: Shorewall:ipmi2ext:REJECT:IN=em4 OUT=em3 SRC=10.0.0.2 DST=10.0.0.1 LEN=28 TOS=0x00 PREC=0x00 TTL=63 ID=36216 PROTO=ICMP TYPE=8 CODE=0 ID=0 SEQ=1421",+ -}++--------------------------------------------------------------------------------+parseShorewallICMP :: Parser Shorewall+parseShorewallICMP = do+ string " - kernel:: Shorewall:"+ fwrule <- takeTill (== ':')+ fwtarget <- char ':' *> takeTill (== ':')+ fwin <- char ':' *> kvTextParser "IN"+ fwout <- skipSpace *> kvTextParser "OUT"+ fwsrc <- skipSpace *> kvHostOrIPParser "SRC"+ fwdst <- skipSpace *> kvHostOrIPParser "DST"+ manyTill anyChar (lookAhead $ string " PROTO=")+ string " PROTO=ICMP"+ takeText+ return $ Shorewall+ { fwrule = fwrule+ , fwtarget = fwtarget+ , fwin = fwin+ , fwout = Just fwout+ , fwmac = Nothing+ , fwsrc = fwsrc+ , fwdst = fwdst+ , fwproto = ICMP+ , fwspt = Nothing+ , fwdpt = Nothing+ }++parseShorewall :: Parser Shorewall+parseShorewall =+ parseShorewallTCP+ <|> parseShorewallUDP+ <|> parseShorewallICMP
+ src/HNormalise/Torque/Internal.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}++module HNormalise.Torque.Internal where++--------------------------------------------------------------------------------+import Data.Text+import GHC.Generics (Generic)++--------------------------------------------------------------------------------+++data TorqueJobShortNode = TorqueJobShortNode+ { number :: !Int+ , ppn :: !(Maybe Int)+ } deriving (Show, Eq, Generic)++--------------------------------------------------------------------------------+data TorqueJobFQNode = TorqueJobFQNode+ { name :: !Text+ , ppn :: !Int+ } deriving (Show, Eq, Generic)++--------------------------------------------------------------------------------+data TorqueExecHost = TorqueExecHost+ { name :: !Text+ , lowerCore :: !Int+ , upperCore :: !Int+ } deriving (Show, Eq, Generic)++--------------------------------------------------------------------------------+data TorqueWalltime = TorqueWalltime+ { days :: !Int+ , hours :: !Int+ , minutes :: !Int+ , seconds :: !Int+ } deriving (Show, Eq, Generic)++--------------------------------------------------------------------------------+data TorqueResourceRequest = TorqueResourceRequest+ { nodes :: !(Either TorqueJobShortNode [TorqueJobFQNode])+ , vmem :: !Integer+ , nodeCount :: !Int+ , neednodes :: !(Either TorqueJobShortNode [TorqueJobFQNode])+ , nice :: !(Maybe Int)+ , walltime :: !TorqueWalltime+ } deriving (Show, Eq, Generic)++--------------------------------------------------------------------------------+data TorqueResourceUsage = TorqueResourceUsage+ { cputime :: !Integer+ , energy :: !Integer+ , mem :: !Integer+ , vmem :: !Integer+ , walltime :: !TorqueWalltime+ } deriving (Show, Eq, Generic)++--------------------------------------------------------------------------------+data TorqueJobTime = TorqueJobTime+ { ctime :: !Integer+ , qtime :: !Integer+ , etime :: !Integer+ , startTime :: !Integer+ , endTime :: !Integer+ } deriving (Show, Eq, Generic)++--------------------------------------------------------------------------------+data TorqueJobExit = TorqueJobExit+ { name :: !TorqueJobName+ , user :: !Text+ , group :: !Text+ , jobname :: !Text+ , queue :: !Text+ , startCount :: !(Maybe Int)+ , owner :: !Text+ , session :: !Integer+ , times :: !TorqueJobTime+ , resourceRequest :: !TorqueResourceRequest+ , resourceUsage :: !TorqueResourceUsage+ , totalExecutionSlots :: !Int+ , uniqueNodeCount :: !Int+ , exitStatus :: !Int+ } deriving (Show, Eq, Generic)++--------------------------------------------------------------------------------+data TorqueJobName = TorqueJobName+ { number :: !Integer+ , array_id :: !(Maybe Integer)+ , master :: !Text+ , cluster :: !Text+ } deriving (Show, Eq, Generic)
+ src/HNormalise/Torque/Json.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+++module HNormalise.Torque.Json where++--------------------------------------------------------------------------------+import Data.Aeson++--------------------------------------------------------------------------------+import HNormalise.Torque.Internal++--------------------------------------------------------------------------------++instance ToJSON TorqueJobShortNode where+ toEncoding = genericToEncoding defaultOptions++instance ToJSON TorqueJobFQNode where+ toEncoding = genericToEncoding defaultOptions++instance ToJSON TorqueExecHost where+ toEncoding = genericToEncoding defaultOptions++instance ToJSON TorqueWalltime where+ toEncoding = genericToEncoding defaultOptions++instance ToJSON TorqueResourceRequest where+ toEncoding = genericToEncoding defaultOptions++instance ToJSON TorqueResourceUsage where+ toEncoding = genericToEncoding defaultOptions++instance ToJSON TorqueJobTime where+ toEncoding = genericToEncoding defaultOptions++instance ToJSON TorqueJobExit where+ toEncoding = genericToEncoding defaultOptions++instance ToJSON TorqueJobName where+ toEncoding = genericToEncoding defaultOptions
+ src/HNormalise/Torque/Parser.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}++module HNormalise.Torque.Parser where++--------------------------------------------------------------------------------+import Control.Applicative ((<|>))+import Data.Attoparsec.Combinator (lookAhead, manyTill)+import Data.Attoparsec.Text+import Data.Char (isDigit)+import qualified Data.Map as M+import Data.Text (Text)+import qualified Data.Text as T+import Text.ParserCombinators.Perm ((<$$>), (<||>), permute)++--------------------------------------------------------------------------------+import HNormalise.Common.Parser+import HNormalise.Torque.Internal++--------------------------------------------------------------------------------+parseTorqueWalltime :: Parser TorqueWalltime+parseTorqueWalltime =+ parseTorqueDays+ <|> parseTorqueHours+ <|> parseTorqueMinutes+ <|> parseTorqueSeconds++parseTorqueDays = do+ d <- decimal+ char ':'+ w <- parseTorqueHours+ return w { days = d }++parseTorqueHours = do+ h <- decimal+ char ':'+ w <- parseTorqueMinutes+ return w { hours = h }++parseTorqueMinutes = do+ m <- decimal+ char ':'+ w <- parseTorqueSeconds+ return w { minutes = m }++parseTorqueSeconds = do+ s <- decimal+ return TorqueWalltime { days = 0, hours = 0, minutes = 0, seconds = s}+++--------------------------------------------------------------------------------+parseTorqueMemory :: Parser Integer+parseTorqueMemory = do+ v <- decimal+ unit <- asciiCI "b"+ <|> asciiCI "kb"+ <|> asciiCI "mb"+ <|> asciiCI "gb"+ return $ case T.toLower unit of+ "b" -> v+ "kb" -> v * 1024+ "mb" -> v * 1024 * 1024+ "gb" -> v * 1024 * 1024 * 1024++--------------------------------------------------------------------------------+parseTorqueJobName :: Parser TorqueJobName+parseTorqueJobName = do+ n <- decimal+ a <- parseArrayId+ m <- char '.' *> takeTill (== '.')+ c <- char '.' *> takeTill (== '.')+ manyTill anyChar (lookAhead ";") *> char ';'+ return $ TorqueJobName { number = n, array_id = a, master = m, cluster = c}+ where+ parseArrayId :: Parser (Maybe Integer)+ parseArrayId = try $ maybeOption $ do+ char '['+ i <- decimal+ char ']'+ return i+++--------------------------------------------------------------------------------+parseTorqueResourceNodeList :: Parser (Either TorqueJobShortNode [TorqueJobFQNode])+parseTorqueResourceNodeList = do+ c <- peekChar'+ if Data.Char.isDigit c then do+ number <- decimal+ ppn <- maybeOption $ char ':' *> string "ppn=" *> decimal+ return $ Left $ TorqueJobShortNode { number = number, ppn = ppn }+ else Right <$> (flip sepBy (char '+') $ do+ fqdn <- Data.Attoparsec.Text.takeWhile (/= ':')+ ppn <- char ':' *> kvNumParser "ppn"+ return TorqueJobFQNode { name = fqdn, ppn = ppn})++--------------------------------------------------------------------------------+parseTorqueResourceRequest :: Parser TorqueResourceRequest+parseTorqueResourceRequest = do+ permute $ TorqueResourceRequest+ <$$> skipSpace *> string "Resource_List.nodes=" *> parseTorqueResourceNodeList+ <||> skipSpace *> string "Resource_List.vmem=" *> parseTorqueMemory+ <||> skipSpace *> kvNumParser "Resource_List.nodect"+ <||> skipSpace *> string "Resource_List.neednodes=" *> parseTorqueResourceNodeList+ <||> maybeOption (skipSpace *> kvNumParser "Resource_List.nice")+ <||> skipSpace *> string "Resource_List.walltime=" *> parseTorqueWalltime++--------------------------------------------------------------------------------+parseTorqueResourceUsage :: Parser TorqueResourceUsage+parseTorqueResourceUsage = do+ cput <- skipSpace *> kvNumParser "resources_used.cput"+ energy <- skipSpace *> kvNumParser "resources_used.energy_used"+ mem <- skipSpace *> string "resources_used.mem=" *> parseTorqueMemory+ vmem <- skipSpace *> string "resources_used.vmem=" *> parseTorqueMemory+ walltime <- skipSpace *> string "resources_used.walltime=" *> parseTorqueWalltime+ return $ TorqueResourceUsage+ { cputime = cput+ , energy = energy+ , mem = mem+ , vmem = vmem+ , walltime = walltime+ }++--------------------------------------------------------------------------------+parseTorqueHostList :: Parser [TorqueExecHost]+parseTorqueHostList = flip sepBy (char '+') $ do+ fqdn <- Data.Attoparsec.Text.takeWhile (/= '/')+ char '/'+ (lower, upper) <- try parseCoreRange <|> parseSingleCore+ return $ TorqueExecHost { name = fqdn, lowerCore = lower, upperCore = upper}+ where parseCoreRange :: Parser (Int, Int)+ parseCoreRange = do+ lower <- decimal+ char '-'+ upper <- decimal+ return (lower, upper)++ parseSingleCore = do+ lower <- decimal+ return (lower, lower)++--------------------------------------------------------------------------------+parseTorqueExit :: Parser TorqueJobExit+parseTorqueExit = do+ takeTill (== ';') *> string ";E;" -- drop the prefix+ name <- parseTorqueJobName+ user <- kvTextParser "user"+ group <- skipSpace *> kvTextParser "group"+ jobname <- skipSpace *> kvTextParser "jobname"+ queue <- skipSpace *> kvTextParser "queue"+ start_count <- maybeOption $ skipSpace *> kvNumParser "start_count"+ ctime <- skipSpace *> kvNumParser "ctime"+ qtime <- skipSpace *> kvNumParser "qtime"+ etime <- skipSpace *> kvNumParser "etime"+ start <- skipSpace *> kvNumParser "start"+ owner <- skipSpace *> kvTextParser "owner"+ exec_host <- skipSpace *> parseTorqueHostList+ request <- parseTorqueResourceRequest+ session <- skipSpace *> kvNumParser "session"+ total_execution_slots <- skipSpace *> kvNumParser "total_execution_slots"+ unique_node_count <- skipSpace *> kvNumParser "unique_node_count"+ end <- skipSpace *> kvNumParser "end"+ exit_status <- skipSpace *> kvNumParser "Exit_status"+ usage <- skipSpace *> parseTorqueResourceUsage++ return $ TorqueJobExit+ { name = name+ , user = user+ , group = group+ , jobname = jobname+ , queue = queue+ , startCount = start_count+ , owner = owner+ , session = session+ , times = TorqueJobTime+ { ctime = ctime+ , qtime = qtime+ , etime = etime+ , startTime = start+ , endTime = end+ }+ , resourceRequest = request+ , resourceUsage = usage+ , totalExecutionSlots = total_execution_slots+ , uniqueNodeCount = unique_node_count+ , exitStatus = exit_status+ }
+ test/Bench.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}++--------------------------------------------------------------------------------+module Main where++--------------------------------------------------------------------------------+import Criterion.Main+import qualified Data.Attoparsec.Text as AT+import Data.Text (Text)+--------------------------------------------------------------------------------+import qualified HNormalise.Lmod.Parser as LmodP+import qualified HNormalise.Shorewall.Parser as ShorewallP+import qualified HNormalise.Torque.Parser as TorqueP+++--------------------------------------------------------------------------------+torqueJobExitInput1 = "04/05/2017 13:06:53;E;45.master23.banette.gent.vsc;user=vsc40075 group=vsc40075 jobname=STDIN queue=short ctime=1491390300 qtime=1491390300 etime=1491390300 start=1491390307 owner=vsc40075@gligar01.gligar.gent.vsc exec_host=node2801.banette.gent.vsc/0-1+node2803.banette.gent.vsc/0-1 Resource_List.nodes=node2801.banette.gent.vsc:ppn=2+node2803.banette.gent.vsc:ppn=2 Resource_List.vmem=1gb Resource_List.nodect=2 Resource_List.neednodes=node2801.banette.gent.vsc:ppn=2+node2803.banette.gent.vsc:ppn=2 Resource_List.nice=0 Resource_List.walltime=01:00:00 session=15273 total_execution_slots=4 unique_node_count=2 end=1491390413 Exit_status=0 resources_used.cput=0 resources_used.energy_used=0 resources_used.mem=55048kb resources_used.vmem=92488kb resources_used.walltime=00:01:44" :: Text+torqueJobExitInput2 = "04/05/2017 13:06:53;E;45.master23.banette.gent.vsc;user=vsc40075 group=vsc40075 jobname=STDIN queue=short ctime=1491390300 qtime=1491390300 etime=1491390300 start=1491390307 owner=vsc40075@gligar01.gligar.gent.vsc exec_host=node2801.banette.gent.vsc/0-1+node2803.banette.gent.vsc/0-1 Resource_List.nodes=2 Resource_List.vmem=1gb Resource_List.nodect=2 Resource_List.neednodes=2 Resource_List.nice=0 Resource_List.walltime=01:00:00 session=15273 total_execution_slots=4 unique_node_count=2 end=1491390413 Exit_status=0 resources_used.cput=0 resources_used.energy_used=0 resources_used.mem=55048kb resources_used.vmem=92488kb resources_used.walltime=00:01:44" :: Text++torqueJobExitFailInput1 = "04/05/2017 13:06:53;E;45.master23.banette.gent.vsc;user=vsc40075 group=vsc40075 jobname=STDIN queue=short HUPPEL"++lmodLoadInput1 = "lmod:: username=myuser, cluster=mycluster, jobid=3230905.master.mycluster.mydomain, userload=yes, module=GSL/2.3-intel-2016b, fn=/apps/gent/CO7/sandybridge/modules/all/GSL/2.3-intel-2016b" :: Text++shorewallTCPInput = " - kernel:: Shorewall:ext2fw:REJECT:IN=em3 OUT= MAC=aa:aa:bb:ff:88:bc:bc:15:80:8b:f8:f8:80:00 SRC=78.0.0.1 DST=150.0.0.1 LEN=52 TOS=0x00 PREC=0x00 TTL=117 ID=7564 DF PROTO=TCP SPT=60048 DPT=22 WINDOW=65535 RES=0x00 SYN URGP=0"+shorewallUDPInput = " - kernel:: Shorewall:ipmi2int:REJECT:IN=em4 OUT=em1 SRC=10.0.0.2 DST=10.0.0.1 LEN=57 TOS=0x00 PREC=0x00 TTL=63 ID=62392 PROTO=UDP SPT=57002 DPT=53 LEN=37"+shorewallICMPInput = " - kernel:: Shorewall:ipmi2ext:REJECT:IN=em4 OUT=em3 SRC=10.0.0.2 DST=10.0.0.1 LEN=28 TOS=0x00 PREC=0x00 TTL=63 ID=36216 PROTO=ICMP TYPE=8 CODE=0 ID=0 SEQ=1421"++--------------------------------------------------------------------------------+main :: IO ()+main = defaultMain+ [ bgroup "torque"+ [ bench "jobexit full resource node list" $ whnf (AT.parse TorqueP.parseTorqueExit) torqueJobExitInput1+ , bench "jobexit short resource node number" $ whnf (AT.parse TorqueP.parseTorqueExit) torqueJobExitInput1+ , bench "jobexit borked input" $ whnf (AT.parse TorqueP.parseTorqueExit) torqueJobExitFailInput1+ ]+ , bgroup "lmod"+ [ bench "lmod successfull module load parse" $ whnf (AT.parse LmodP.parseLmodLoad) lmodLoadInput1+ ]+ , bgroup "shorewall"+ [ bench "tcp successfull input" $ whnf (AT.parse ShorewallP.parseShorewallTCP) shorewallTCPInput+ , bench "udp successfull input" $ whnf (AT.parse ShorewallP.parseShorewallUDP) shorewallUDPInput+ , bench "icmp successfull input" $ whnf (AT.parse ShorewallP.parseShorewallICMP) shorewallICMPInput+ ]+ ]
+ test/HNormalise/Common/ParserSpec.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}++module HNormalise.Common.ParserSpec (main, spec) where++--------------------------------------------------------------------------------+import Data.Attoparsec.Text+import Data.Text (Text)+import Test.Hspec+import Test.Hspec.Attoparsec+import HNormalise.Common.Parser++--------------------------------------------------------------------------------+main :: IO ()+main = hspec spec++--------------------------------------------------------------------------------+spec :: Spec+spec = do+ describe "kvTextParser" $ do+ it "parse a key value pair with given key" $ do+ ("foo=bar" :: Text) ~> (kvTextParser "foo") `shouldParse` ("bar" :: Text)++ describe "kvTextDelimParser" $ do+ it "parse a key value pair delimited by a given char" $ do+ ("foo=barD" :: Text) ~> (kvTextDelimParser "foo" "D") `shouldParse` ("bar" :: Text)++ describe "kvNumParser" $ do+ it "parse a key value pair with an integral value" $ do+ ("foo=42" :: Text) ~> (kvNumParser "foo") `shouldParse` 42
+ test/HNormalise/Lmod/ParserSpec.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}++module HNormalise.Lmod.ParserSpec (main, spec) where++--------------------------------------------------------------------------------+import Data.Text (Text)+import qualified Data.Text.Read as TR+import Test.Hspec+import Test.Hspec.Attoparsec++--------------------------------------------------------------------------------+import HNormalise.Lmod.Parser+import HNormalise.Lmod.Internal++--------------------------------------------------------------------------------+main :: IO ()+main = hspec spec++--------------------------------------------------------------------------------+spec :: Spec+spec = do+ describe "parseLmodInfo" $ do+ it "parse regular info" $ do+ let s = "username=someuser, cluster=myspace, jobid=myjobid" :: Text+ s ~> parseLmodInfo `shouldParse` LmodInfo { username = "someuser" , cluster = "myspace" , jobid = "myjobid" }++ it "parse module" $ do+ let s = "module=HNormalise/0.2.0.0-ghc-8.0.2," :: Text+ s ~> parseLmodModule `shouldParse` LmodModule { name = "HNormalise", version = "0.2.0.0-ghc-8.0.2" }++ it "parse module load" $ do+ let s = "lmod:: username=myuser, cluster=mycluster, jobid=3230905.master.mycluster.mydomain, userload=yes, module=GSL/2.3-intel-2016b, fn=/apps/gent/CO7/sandybridge/modules/all/GSL/2.3-intel-2016b" :: Text+ s ~> parseLmodLoad `shouldParse` LmodLoad+ { info = LmodInfo+ { username = "myuser"+ , cluster = "mycluster"+ , jobid = "3230905.master.mycluster.mydomain"+ }+ , userload = True+ , modul = LmodModule+ { name = "GSL"+ , version = "2.3-intel-2016b"+ }+ , filename = "/apps/gent/CO7/sandybridge/modules/all/GSL/2.3-intel-2016b"+ }
+ test/HNormalise/Shorewall/ParserSpec.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}++module HNormalise.Shorewall.ParserSpec (main, spec) where++--------------------------------------------------------------------------------+import Data.Text (Text)+import qualified Data.Text.Read as TR+import Test.Hspec+import Test.Hspec.Attoparsec+import qualified Net.IPv4 as NT++--------------------------------------------------------------------------------+import HNormalise.Common.Internal+import HNormalise.Shorewall.Parser+import HNormalise.Shorewall.Internal+--------------------------------------------------------------------------------+main :: IO ()+main = hspec spec++--------------------------------------------------------------------------------+spec :: Spec+spec = do+ describe "parseShorewall" $ do+ it "Shorewall UDP message" $ do+ let s = " - kernel:: Shorewall:ipmi2int:REJECT:IN=em4 OUT=em1 SRC=10.0.0.2 DST=10.0.0.1 LEN=57 TOS=0x00 PREC=0x00 TTL=63 ID=62392 PROTO=UDP SPT=57002 DPT=53 LEN=37" :: Text+ s ~> parseShorewallUDP `shouldParse` Shorewall+ { fwrule = "ipmi2int"+ , fwtarget = "REJECT"+ , fwin = "em4"+ , fwout = Just "em1"+ , fwmac = Nothing+ , fwsrc = IPv4 $ NT.fromOctets 10 0 0 2+ , fwdst = IPv4 $ NT.fromOctets 10 0 0 1+ , fwproto = UDP+ , fwspt = Just 57002+ , fwdpt = Just 53+ }++ it "Shorewall TCP message" $ do+ let s = " - kernel:: Shorewall:ext2fw:REJECT:IN=em3 OUT= MAC=aa:aa:bb:ff:88:bc:bc:15:80:8b:f8:f8:80:00 SRC=78.0.0.1 DST=150.0.0.1 LEN=52 TOS=0x00 PREC=0x00 TTL=117 ID=7564 DF PROTO=TCP SPT=60048 DPT=22 WINDOW=65535 RES=0x00 SYN URGP=0" :: Text+ s ~> parseShorewallTCP `shouldParse` Shorewall+ { fwrule = "ext2fw"+ , fwtarget = "REJECT"+ , fwin = "em3"+ , fwout = Nothing+ , fwmac = Just "aa:aa:bb:ff:88:bc:bc:15:80:8b:f8:f8:80:00"+ , fwsrc = IPv4 $ NT.fromOctets 78 0 0 1+ , fwdst = IPv4 $ NT.fromOctets 150 0 0 1+ , fwproto = TCP+ , fwspt = Just 60048+ , fwdpt = Just 22+ }++ it "Shorewall ICMP message" $ do+ let s = " - kernel:: Shorewall:ipmi2ext:REJECT:IN=em4 OUT=em3 SRC=10.0.0.2 DST=10.0.0.1 LEN=28 TOS=0x00 PREC=0x00 TTL=63 ID=36216 PROTO=ICMP TYPE=8 CODE=0 ID=0 SEQ=1421" :: Text+ s ~> parseShorewallICMP `shouldParse` Shorewall+ { fwrule = "ipmi2ext"+ , fwtarget = "REJECT"+ , fwin = "em4"+ , fwout = Just "em3"+ , fwmac = Nothing+ , fwsrc = IPv4 $ NT.fromOctets 10 0 0 2+ , fwdst = IPv4 $ NT.fromOctets 10 0 0 1+ , fwproto = ICMP+ , fwspt = Nothing+ , fwdpt = Nothing+ }
+ test/HNormalise/Torque/ParserSpec.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}++module HNormalise.Torque.ParserSpec (main, spec) where++--------------------------------------------------------------------------------+import Data.Text (Text)+import qualified Data.Text.Read as TR+import Test.Hspec+import Test.Hspec.Attoparsec++--------------------------------------------------------------------------------+import HNormalise.Torque.Parser+import HNormalise.Torque.Internal++--------------------------------------------------------------------------------+main :: IO ()+main = hspec spec++--------------------------------------------------------------------------------+spec :: Spec+spec = do+ describe "parseTorqueWalltime" $ do+ it "parse walltime given as SS" $ do+ let s = ("1234567" :: Text)+ Right (s', _) = TR.decimal s+ s ~> parseTorqueWalltime `shouldParse` TorqueWalltime { days = 0, hours = 0, minutes = 0, seconds = s' }++ it "parse walltime given as MM:SS" $ do+ let s = ("12:13") :: Text+ s ~> parseTorqueWalltime `shouldParse` TorqueWalltime { days = 0, hours = 0, minutes = 12, seconds = 13}++ it "parse walltime given as HH:MM:SS" $ do+ let s = ("11:12:13") :: Text+ s ~> parseTorqueWalltime `shouldParse` TorqueWalltime { days = 0, hours = 11, minutes = 12, seconds = 13 }++ it "parse walltime given as MM:SS" $ do+ let s = ("10:11:12:13") :: Text+ s ~> parseTorqueWalltime `shouldParse` TorqueWalltime { days = 10, hours = 11, minutes = 12, seconds = 13 }++ describe "parseTorqueMemory" $ do+ it "parse memory value in bytes (lowercase)" $ do+ let s = "123b" :: Text+ s ~> parseTorqueMemory `shouldParse` 123++ it "parse memory value in bytes (uppercase)" $ do+ let s = "123B" :: Text+ s ~> parseTorqueMemory `shouldParse` 123++ it "parse memory value in bytes (lowercase)" $ do+ let s = "123kb" :: Text+ s ~> parseTorqueMemory `shouldParse` (123 * 1024)++ it "parse memory value in bytes (mixed case)" $ do+ let s = "123Kb" :: Text+ s ~> parseTorqueMemory `shouldParse` (123 * 1024)++ it "parse memory value in bytes (mixed case)" $ do+ let s = "123kB" :: Text+ s ~> parseTorqueMemory `shouldParse` (123 * 1024)++ it "parse memory value in bytes (uppercase)" $ do+ let s = "123KB" :: Text+ s ~> parseTorqueMemory `shouldParse` (123 * 1024)++ it "parse memory value in bytes (lowercase)" $ do+ let s = "123mb" :: Text+ s ~> parseTorqueMemory `shouldParse` (123 * 1024 * 1024)++ it "parse memory value in bytes (mixed case)" $ do+ let s = "123Mb" :: Text+ s ~> parseTorqueMemory `shouldParse` (123 * 1024 * 1024)++ it "parse memory value in bytes (mixed case)" $ do+ let s = "123mB" :: Text+ s ~> parseTorqueMemory `shouldParse` (123 * 1024 * 1024)++ it "parse memory value in bytes (uppercase)" $ do+ let s = "123MB" :: Text+ s ~> parseTorqueMemory `shouldParse` (123 * 1024 * 1024)++ it "parse memory value in bytes (lowercase)" $ do+ let s = "123gb" :: Text+ s ~> parseTorqueMemory `shouldParse` (123 * 1024 * 1024 * 1024)++ it "parse memory value in bytes (mixed case)" $ do+ let s = "123Gb" :: Text+ s ~> parseTorqueMemory `shouldParse` (123 * 1024 * 1024 * 1024)++ it "parse memory value in bytes (mixed case)" $ do+ let s = "123gB" :: Text+ s ~> parseTorqueMemory `shouldParse` (123 * 1024 * 1024 * 1024)++ it "parse memory value in bytes (uppercase)" $ do+ let s = "123GB" :: Text+ s ~> parseTorqueMemory `shouldParse` (123 * 1024 * 1024 * 1024)++ describe "parseTorqueJobName" $ do+ it "parse regular torque job name" $ do+ let s = "123456789.master.mycluster.mydomain;" :: Text+ s ~> parseTorqueJobName `shouldParse` TorqueJobName { number = 123456789, array_id = Nothing, master = "master", cluster = "mycluster" }++ it "parse array torque job name" $ do+ let s = "123456[789].master.mycluster.mydomain;" :: Text+ s ~> parseTorqueJobName `shouldParse` TorqueJobName { number = 123456, array_id = Just 789, master = "master", cluster = "mycluster" }++ describe "parseTorqueExit" $ do+ it "parse job exit log line" $ do+ let s = "04/05/2017 13:06:53;E;45.master23.banette.gent.vsc;user=vsc40075 group=vsc40075 jobname=STDIN queue=short ctime=1491390300 qtime=1491390300 etime=1491390300 start=1491390307 owner=vsc40075@gligar01.gligar.gent.vsc exec_host=node2801.banette.gent.vsc/0-1+node2803.banette.gent.vsc/0-1 Resource_List.nodes=node2801.banette.gent.vsc:ppn=2+node2803.banette.gent.vsc:ppn=2 Resource_List.vmem=1gb Resource_List.nodect=2 Resource_List.neednodes=node2801.banette.gent.vsc:ppn=2+node2803.banette.gent.vsc:ppn=2 Resource_List.nice=0 Resource_List.walltime=01:00:00 session=15273 total_execution_slots=4 unique_node_count=2 end=1491390413 Exit_status=0 resources_used.cput=0 resources_used.energy_used=0 resources_used.mem=55048kb resources_used.vmem=92488kb resources_used.walltime=00:01:44" :: Text+ s ~> parseTorqueExit `shouldParse` TorqueJobExit+ { name = TorqueJobName { number = 45, array_id = Nothing, master = "master23", cluster = "banette" }+ , user = "vsc40075"+ , group = "vsc40075"+ , jobname = "STDIN"+ , queue = "short"+ , startCount = Nothing+ , owner = "vsc40075@gligar01.gligar.gent.vsc"+ , session = 15273+ , times = TorqueJobTime+ { ctime = 1491390300+ , qtime = 1491390300+ , etime = 1491390300+ , startTime = 1491390307+ , endTime = 1491390413+ }+ , resourceRequest = TorqueResourceRequest+ { nodes = Right+ [ TorqueJobFQNode+ { name = "node2801.banette.gent.vsc"+ , ppn = 2+ }+ , TorqueJobFQNode+ { name = "node2803.banette.gent.vsc"+ , ppn = 2+ }+ ]+ , vmem = 1 * 1024 * 1024 * 1024+ , nodeCount = 2+ , neednodes = Right+ [ TorqueJobFQNode+ { name = "node2801.banette.gent.vsc"+ , ppn = 2+ }+ , TorqueJobFQNode+ { name = "node2803.banette.gent.vsc"+ , ppn = 2+ }+ ]+ , nice = Just 0+ , walltime = TorqueWalltime { days = 0, hours = 1, minutes = 0, seconds = 0}+ }+ , resourceUsage = TorqueResourceUsage+ { cputime = 0+ , energy = 0+ , mem = 55048 * 1024+ , vmem = 92488 * 1024+ , walltime = TorqueWalltime { days = 0, hours = 0, minutes = 1, seconds = 44 }+ }+ , totalExecutionSlots = 4+ , uniqueNodeCount = 2+ , exitStatus = 0+ }
+ test/Spec.hs view
@@ -0,0 +1,2 @@+-- file test/Spec.hs+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}