diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2015 Keith Duncan + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 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/logplex-parse.cabal b/logplex-parse.cabal new file mode 100644 --- /dev/null +++ b/logplex-parse.cabal @@ -0,0 +1,89 @@ +-- Initial logplex-parse.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +-- The name of the package. +name: logplex-parse + +-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented. +-- http://www.haskell.org/haskellwiki/Package_versioning_policy +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.1.0.0 + +-- A short (one-line) description of the package. +synopsis: Parse Heroku application/logplex documents + +-- A longer description of the package. +-- description: + +-- URL for the project homepage or repository. +homepage: https://github.com/keithduncan/logplex-parse + +-- The license under which the package is released. +license: MIT + +-- The file containing the license text. +license-file: LICENSE + +-- The package author(s). +author: Keith Duncan + +-- An email address to which users can send suggestions, bug reports, and +-- patches. +maintainer: keith.duncan@github.com + +-- A copyright notice. +-- copyright: + +category: Text + +build-type: Simple + +-- Extra files to be distributed with the package, such as examples or a +-- README. +-- extra-source-files: + +-- Constraint on the version of Cabal needed to build this package. +cabal-version: >=1.10 + +source-repository head + type: git + location: https://github.com/keithduncan/logplex-parse + +library + -- Modules exported by the library. + exposed-modules: Text.Logplex.Parser, + Text.Syslog.Parser + + -- Modules included in this library but not exported. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + + -- Other library packages from which modules are imported. + build-depends: base >=4.8 && <4.9, + parsec >= 3.1.9 && <3.2, + text >= 1.2.1.3 && <1.3, + iso8601-time >= 0.1.4 && <0.2, + time >= 1.5.0.1 && <1.6 + + -- Directories containing source files. + hs-source-dirs: src + + -- Base language which the package is written in. + default-language: Haskell2010 + +test-suite tests + ghc-options: -Wall + default-extensions: OverloadedStrings + type: exitcode-stdio-1.0 + hs-source-dirs: spec + main-is: Spec.hs + build-depends: base, + logplex-parse, + hspec >= 1.8, + time >= 1.5.0.1 && <1.6 + default-language: Haskell2010 diff --git a/spec/Spec.hs b/spec/Spec.hs new file mode 100644 --- /dev/null +++ b/spec/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/src/Text/Logplex/Parser.hs b/src/Text/Logplex/Parser.hs new file mode 100644 --- /dev/null +++ b/src/Text/Logplex/Parser.hs @@ -0,0 +1,35 @@ +module Text.Logplex.Parser ( + parseLogplex, +) where + +import Control.Monad +import Data.Maybe + +import Text.ParserCombinators.Parsec +import Text.ParserCombinators.Parsec.Error + +import Text.Syslog.Parser + +parseLogplex :: String -> Either ParseError [LogEntry] +parseLogplex = parse logplexDocument "(unknown)" + +logplexDocument :: GenParser Char st [LogEntry] +logplexDocument = many frame <* eof + +{- + +-} + +frame :: GenParser Char st LogEntry +frame = do + len <- read <$> msgLen + space + frameContent <- replicateM len anyChar + + case parseSyslog frameContent of + -- should probably include all the errors? + Left err -> fail . head $ messageString <$> errorMessages err + Right le -> return le + +msgLen :: GenParser Char st String +msgLen = liftM2 (:) nonZeroDigit (many digit) diff --git a/src/Text/Syslog/Parser.hs b/src/Text/Syslog/Parser.hs new file mode 100644 --- /dev/null +++ b/src/Text/Syslog/Parser.hs @@ -0,0 +1,123 @@ +{-# LANGUAGE FlexibleContexts #-} + +module Text.Syslog.Parser ( + parseSyslog, + + LogEntry(..), + + StructuredData(..), + Key, + Value, + Param, + + nonZeroDigit, +) where + +import Control.Monad +import Data.Maybe + +import Text.ParserCombinators.Parsec + +import Data.Time.ISO8601 +import Data.Time.Clock +import Text.Printf + +data LogEntry = LogEntry { getPriority :: String + , getVersion :: String + , getTimestamp :: UTCTime + , getHostname :: String + , getAppname :: String + , getProcessId :: String + , getMessageId :: String + , getStructuredData :: [StructuredData] + , getMessage :: Maybe String + } deriving (Show, Eq) + +data StructuredData = StructuredData { getId :: String + , getParams :: [Param] + } deriving (Show, Eq) + +type Key = String +type Value = String +type Param = (Key, Value) + +parseSyslog :: String -> Either ParseError LogEntry +parseSyslog = parse syslogLine "(unknown)" + +syslogLine = LogEntry <$> + pri <*> + version <*> + (space >> timestamp) <*> + (space >> hostname) <*> + (space >> appName) <*> + (space >> procid) <*> + (space >> msgid) <*> + (space >> structuredData) <*> + optionMaybe (space >> message) <* + eof + +pri = between (char '<') (char '>') (countBetween 1 3 digit) "priority value" +nonZeroDigit = oneOf "123456789" +version = liftM2 (:) nonZeroDigit (countBetween 0 2 digit) "syslog protocol version" + +timestamp = do + time <- (nilvalue >> return "") <|> (mconcat <$> sequence [fullDate, string "T", fullTime]) "ISO8601 full date time timestamp with timezone" + case parseISO8601 time of + Nothing -> fail $ printf "invalid timestamp `%s`" time + Just t -> return t + +nilvalue = string "-" + +fullDate = mconcat <$> sequence [count 4 digit, string "-", count 2 digit, string "-", count 2 digit] + +fullTime = liftM2 (++) partialTime timeOffset + +partialTime = mconcat <$> sequence [time, string ":", second, fromMaybe "" <$> optionMaybe (liftM2 (++) (string ".") (countBetween 1 6 digit))] + +timeHour = count 2 digit +timeMinute = count 2 digit +second = count 2 digit +timeOffset = string "Z" <|> timeNumOffset +timeNumOffset = liftM2 (:) (oneOf "+-") time +time = mconcat <$> sequence [timeHour, string ":", timeMinute] + +hostname = nilvalue <|> countBetween 1 255 printascii "hostname" + +printascii = oneOf printasciiSet +printasciiSet = toEnum <$> [33..126] :: String + +appName = nilvalue <|> countBetween 1 48 printascii "application name" +procid = nilvalue <|> countBetween 1 128 printascii "process id" +msgid = nilvalue <|> countBetween 1 32 printascii "message id" + +structuredData = (nilvalue >> return []) <|> many1 sdElement + +sdElement = between (char '[') (char ']') (liftM2 StructuredData sdId (many (space >> sdParam))) + +sdId = sdName + +sdName = countBetween 1 32 (oneOf (filter (`notElem` "= ]\"") printasciiSet)) + +sdParam = liftM2 (,) paramName (string "=" >> quoted (many1 $ escaped '\\' "\"]")) + +quoted = between doubleQuote doubleQuote +doubleQuote = char '"' + +paramName = sdName + +escaped echar chars = let echars = echar:chars + in noneOf echars <|> choice ((try . (char echar >>) . char) <$> echars) + +message = msgUtf8 <|> msgAny "message" + +msgUtf8 = try (bom >> utf8String) +utf8String = many anyChar +bom = string ['\xEF', '\xBB', '\xBF'] + +msgAny = utf8String + +{-# CONTRACT countBetween :: { x y | x < y } -> Ok #-} +countBetween min' max' parser + | min' > max' = error "min occurences cannot be greater than max occurrences" + | min' == max' = count max' parser + | otherwise = try (count max' parser) <|> countBetween min' (max'-1) parser