diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,221 @@ +hNormalise +========== + +[![Build Status](https://secure.travis-ci.org/itkovian/hnormalise.svg?branch=master)](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" : [ ] + } + } + ] + } +} +~~~~ 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,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 diff --git a/hnormalise.cabal b/hnormalise.cabal new file mode 100644 --- /dev/null +++ b/hnormalise.cabal @@ -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 diff --git a/src/HNormalise.hs b/src/HNormalise.hs new file mode 100644 --- /dev/null +++ b/src/HNormalise.hs @@ -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 } diff --git a/src/HNormalise/Common/Internal.hs b/src/HNormalise/Common/Internal.hs new file mode 100644 --- /dev/null +++ b/src/HNormalise/Common/Internal.hs @@ -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) diff --git a/src/HNormalise/Common/Json.hs b/src/HNormalise/Common/Json.hs new file mode 100644 --- /dev/null +++ b/src/HNormalise/Common/Json.hs @@ -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 diff --git a/src/HNormalise/Common/Parser.hs b/src/HNormalise/Common/Parser.hs new file mode 100644 --- /dev/null +++ b/src/HNormalise/Common/Parser.hs @@ -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 #-} diff --git a/src/HNormalise/Config.hs b/src/HNormalise/Config.hs new file mode 100644 --- /dev/null +++ b/src/HNormalise/Config.hs @@ -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) diff --git a/src/HNormalise/Huppel/Internal.hs b/src/HNormalise/Huppel/Internal.hs new file mode 100644 --- /dev/null +++ b/src/HNormalise/Huppel/Internal.hs @@ -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) diff --git a/src/HNormalise/Huppel/Json.hs b/src/HNormalise/Huppel/Json.hs new file mode 100644 --- /dev/null +++ b/src/HNormalise/Huppel/Json.hs @@ -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 diff --git a/src/HNormalise/Huppel/Parser.hs b/src/HNormalise/Huppel/Parser.hs new file mode 100644 --- /dev/null +++ b/src/HNormalise/Huppel/Parser.hs @@ -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 } diff --git a/src/HNormalise/Internal.hs b/src/HNormalise/Internal.hs new file mode 100644 --- /dev/null +++ b/src/HNormalise/Internal.hs @@ -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) diff --git a/src/HNormalise/Json.hs b/src/HNormalise/Json.hs new file mode 100644 --- /dev/null +++ b/src/HNormalise/Json.hs @@ -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 + ) diff --git a/src/HNormalise/Lmod/Internal.hs b/src/HNormalise/Lmod/Internal.hs new file mode 100644 --- /dev/null +++ b/src/HNormalise/Lmod/Internal.hs @@ -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) diff --git a/src/HNormalise/Lmod/Json.hs b/src/HNormalise/Lmod/Json.hs new file mode 100644 --- /dev/null +++ b/src/HNormalise/Lmod/Json.hs @@ -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 + ) diff --git a/src/HNormalise/Lmod/Parser.hs b/src/HNormalise/Lmod/Parser.hs new file mode 100644 --- /dev/null +++ b/src/HNormalise/Lmod/Parser.hs @@ -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 + } diff --git a/src/HNormalise/Parser.hs b/src/HNormalise/Parser.hs new file mode 100644 --- /dev/null +++ b/src/HNormalise/Parser.hs @@ -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 + } diff --git a/src/HNormalise/Shorewall/Internal.hs b/src/HNormalise/Shorewall/Internal.hs new file mode 100644 --- /dev/null +++ b/src/HNormalise/Shorewall/Internal.hs @@ -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) diff --git a/src/HNormalise/Shorewall/Json.hs b/src/HNormalise/Shorewall/Json.hs new file mode 100644 --- /dev/null +++ b/src/HNormalise/Shorewall/Json.hs @@ -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 + ) diff --git a/src/HNormalise/Shorewall/Parser.hs b/src/HNormalise/Shorewall/Parser.hs new file mode 100644 --- /dev/null +++ b/src/HNormalise/Shorewall/Parser.hs @@ -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 diff --git a/src/HNormalise/Torque/Internal.hs b/src/HNormalise/Torque/Internal.hs new file mode 100644 --- /dev/null +++ b/src/HNormalise/Torque/Internal.hs @@ -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) diff --git a/src/HNormalise/Torque/Json.hs b/src/HNormalise/Torque/Json.hs new file mode 100644 --- /dev/null +++ b/src/HNormalise/Torque/Json.hs @@ -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 diff --git a/src/HNormalise/Torque/Parser.hs b/src/HNormalise/Torque/Parser.hs new file mode 100644 --- /dev/null +++ b/src/HNormalise/Torque/Parser.hs @@ -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 + } diff --git a/test/Bench.hs b/test/Bench.hs new file mode 100644 --- /dev/null +++ b/test/Bench.hs @@ -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 + ] + ] diff --git a/test/HNormalise/Common/ParserSpec.hs b/test/HNormalise/Common/ParserSpec.hs new file mode 100644 --- /dev/null +++ b/test/HNormalise/Common/ParserSpec.hs @@ -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 diff --git a/test/HNormalise/Lmod/ParserSpec.hs b/test/HNormalise/Lmod/ParserSpec.hs new file mode 100644 --- /dev/null +++ b/test/HNormalise/Lmod/ParserSpec.hs @@ -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" + } diff --git a/test/HNormalise/Shorewall/ParserSpec.hs b/test/HNormalise/Shorewall/ParserSpec.hs new file mode 100644 --- /dev/null +++ b/test/HNormalise/Shorewall/ParserSpec.hs @@ -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 + } diff --git a/test/HNormalise/Torque/ParserSpec.hs b/test/HNormalise/Torque/ParserSpec.hs new file mode 100644 --- /dev/null +++ b/test/HNormalise/Torque/ParserSpec.hs @@ -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 + } diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +-- file test/Spec.hs +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}