diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for syslog + +## 0.1.0.0 -- 2024-02-14 + +* First version. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2020, Andrew Martin + +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 Andrew Martin 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/src/Syslog/Bsd.hs b/src/Syslog/Bsd.hs new file mode 100644 --- /dev/null +++ b/src/Syslog/Bsd.hs @@ -0,0 +1,280 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE UnboxedTuples #-} + +{- | Parse RFC 3164 messages. For example: + +> <133>Feb 25 14:09:07 webserver syslogd: restart +> <0>Oct 22 10:52:01 scapegoat.dmz.example.org sched[0]: That's All Folks! + +This library assumes that the @TAG@ field described by section 5.3 of +RFC 3164 is a process name. It also assumes that the optional bracketed +number that follows it is a process id. This library also addresses three +common extensions to RFC 3164: + +* Some vendors include a year after the timestamp. For example: + @<14>Oct 15 11:14:59 2019 example.com ...@. When present, the year + is parsed and provided to the user. +* Some vendors include a priority that preceeds the process name. For + example: @<133>Aug 10 09:05:14 my-host notice tmsh[4726]: ...@. The + Linux man page for @syslog.conf@ lists these options for priority: + @debug@, @info@, @notice@, @warning@, @warn@, @err@, @error@, @crit@, + @alert@, @emerg@, @panic@. If a process name begins with any of these + keywords (followed by a space), the keyword and the trailing space + are removed from the process name, and the keyword is made available + in the @priority@ field. +* Cisco ASAs omit the hostname sometimes. This is totally bizarre and leads + to messages that looks like: @<190>Jun 08 2022 14:46:28: message@. In + this case, the hostname is set to the empty string. +-} +module Syslog.Bsd + ( -- * Types + Message (..) + , Process (..) + , Timestamp (..) + + -- * Full Decode + , decode + , parser + + -- * Parsing Fragments + , takePriority + , takeTimestamp + , takeHostname + , takeProcess + ) where + +import Prelude hiding (id) + +import Control.Monad (when) +import Data.Bytes.Parser (Parser) +import Data.Bytes.Types (Bytes (Bytes)) +import Data.Word (Word32, Word8) + +import qualified Chronos +import qualified Data.Bytes as Bytes +import qualified Data.Bytes.Parser as Parser +import qualified Data.Bytes.Parser.Latin as Latin +import qualified Data.Bytes.Parser.Unsafe as Unsafe +import qualified Data.Bytes.Text.Latin1 as Latin1 +import qualified Data.Maybe.Unpacked.Numeric.Word32 as Word32 + +data Message = Message + { priority :: !Word32 + , timestamp :: !Timestamp + , hostname :: {-# UNPACK #-} !Bytes + , process :: !(Maybe Process) + , message :: {-# UNPACK #-} !Bytes + } + deriving (Show) + +data Timestamp = Timestamp + { month :: !Chronos.Month + , day :: !Chronos.DayOfMonth + , hour :: !Word8 + , minute :: !Word8 + , second :: !Word8 + , year :: {-# UNPACK #-} !Word32.Maybe + -- ^ Section 5.1 of RFC 3164 notes that some software appends + -- a four-character year after the time of day. Since hostnames + -- cannot start with digits, we can parse this unambiguously. We + -- extend RFC 3164 to handle these nonstandard years. + } + deriving (Show) + +data Process = Process + { priority :: {-# UNPACK #-} !Bytes + -- ^ Priority is nonstandard. This field is the empty byte sequence + -- when the priority is not present. + , name :: {-# UNPACK #-} !Bytes + , id :: {-# UNPACK #-} !Word32.Maybe + } + deriving (Show) + +-- | Run the RFC 3164 parser. See 'parser'. +decode :: Bytes -> Maybe Message +decode = Parser.parseBytesMaybe parser + +{- | Parse a RFC 3164 message. Note that this is just @takePriority@, +@takeTimestamp@, @takeHostname, and @takeProcess@ called in sequence, +followed by skipping whitespace and then treating the remaining input +as the original message. +-} +parser :: Parser () s Message +parser = do + priority <- takePriority () + timestamp <- takeTimestamp () + Latin.trySatisfy (== ':') >>= \case + True -> do + Latin.skipChar ' ' + message <- Parser.remaining + pure Message {priority, timestamp, hostname = Bytes.empty, process = Nothing, message} + False -> do + hostname <- takeHostname () + -- Watchguard includes a serial number and an ISO8601-encoded datetime + -- in parenthesis before the process name. If we detect this, we skip over it. + -- Note that, in compliant BSD-style syslog, there is no way for + -- an open parenthesis to appear in this position. So, by doing + -- this, we do not reject any good logs. + Latin.peek' () >>= \case + c + | c >= 'A' && c <= 'Z' -> + Parser.orElse + ( do + Latin.skipWhile (\x -> (x >= 'A' && x <= 'Z') || (x >= '0' && x <= '9')) + Latin.char () ' ' + Latin.char () '(' + Latin.skipDigits1 () + Latin.char () '-' + Latin.skipDigits1 () + Latin.char () '-' + Latin.skipDigits1 () + Latin.char () 'T' + Latin.skipDigits1 () + Latin.char () ':' + Latin.skipDigits1 () + Latin.char () ':' + Latin.skipDigits1 () + Latin.char () ')' + Latin.char () ' ' + ) + (pure ()) + _ -> pure () + process <- + Latin.trySatisfy (== ':') >>= \case + True -> pure Nothing + False -> do + p <- takeProcess () + pure (Just p) + Latin.skipChar ' ' + message <- Parser.remaining + pure Message {priority, timestamp, hostname, process, message} + +{- | Consume the angle-bracketed priority. RFC 3164 does not allow +a space to follow the priority, so this does not consume a +trailing space. +-} +takePriority :: e -> Parser e s Word32 +takePriority e = do + Latin.char e '<' + priority <- Latin.decWord32 e + Latin.char e '>' + pure priority + +{- | Consume the hostname and the space that follows it. Returns +the hostname. +-} +takeHostname :: e -> Parser e s Bytes +takeHostname e = + -- TODO: This should actually use a takeWhile1. + Latin.takeTrailedBy e ' ' + +{- | Consume the timestamp and the trailing space character if a trailing +space exists. Returns the parsed timestamp. This allows two extensions +to the RFC 3164 datetime format. The year may be present either right +after the day of the month or after the time of day. +-} +takeTimestamp :: e -> Parser e s Timestamp +takeTimestamp e = do + monthBytes <- Parser.take e 3 + month <- case resolveMonth monthBytes of + Chronos.Month 12 -> Parser.fail e + m -> pure m + -- There might be two spaces here since single-digit days get + -- padded with a space. + Latin.skipChar1 e ' ' + dayRaw <- Latin.decWord8 e + day <- + if dayRaw < 32 + then pure (Chronos.DayOfMonth (fromIntegral dayRaw)) + else Parser.fail e + Latin.char e ' ' + hourOrYear <- Latin.decWord32 e + Latin.any e >>= \case + -- We interpret the number as a year if it is followed by + -- a space, and we interpret it as an hour if it is followed + -- by a colon. + ' ' -> do + hour <- Latin.decWord8 e + when (hour > 23) (Parser.fail e) + Latin.char e ':' + minute <- Latin.decWord8 e + when (minute > 59) (Parser.fail e) + Latin.char e ':' + second <- Latin.decWord8 e + when (second > 59) (Parser.fail e) + _ <- Latin.trySatisfy (== ' ') + pure Timestamp {month, day, hour, minute, second, year = Word32.just hourOrYear} + ':' -> do + when (hourOrYear > 23) (Parser.fail e) + let hour = fromIntegral @Word32 @Word8 hourOrYear + minute <- Latin.decWord8 e + when (minute > 59) (Parser.fail e) + Latin.char e ':' + second <- Latin.decWord8 e + when (second > 59) (Parser.fail e) + Latin.trySatisfy (== ' ') >>= \case + False -> pure Timestamp {month, day, hour, minute, second, year = Word32.nothing} + True -> do + -- The only good way to allow a year is with backtracking. We do not + -- learn until we encounter the space following the decimal number + -- whether it was a year or part of a hostname (likely an ip address). + Parser.orElse + ( do + y <- Latin.decWord32 e + Latin.char e ' ' + pure Timestamp {month, day, hour, minute, second, year = Word32.just y} + ) + (pure Timestamp {month, day, hour, minute, second, year = Word32.nothing}) + _ -> Parser.fail e + +{- | Take the process name and the process id and consume the colon +that follows them. Does not consume any space after the colon. +-} +takeProcess :: e -> Parser e s Process +takeProcess e = do + processStart <- Unsafe.cursor + hasPid <- Parser.skipTrailedBy2 e 0x3A 0x5B + processEndSucc <- Unsafe.cursor + arr <- Unsafe.expose + let name0 = Bytes arr processStart ((processEndSucc - 1) - processStart) + !(# name, priority #) = case Bytes.split1 0x20 name0 of + Just (pre, post) + | Latin1.equals3 'e' 'r' 'r' pre -> (# post, pre #) + | Latin1.equals4 'c' 'r' 'i' 't' pre -> (# post, pre #) + | Latin1.equals4 'i' 'n' 'f' 'o' pre -> (# post, pre #) + | Latin1.equals4 'w' 'a' 'r' 'n' pre -> (# post, pre #) + | Latin1.equals5 'a' 'l' 'e' 'r' 't' pre -> (# post, pre #) + | Latin1.equals5 'd' 'e' 'b' 'u' 'g' pre -> (# post, pre #) + | Latin1.equals5 'e' 'm' 'e' 'r' 'g' pre -> (# post, pre #) + | Latin1.equals5 'e' 'r' 'r' 'o' 'r' pre -> (# post, pre #) + | Latin1.equals5 'p' 'a' 'n' 'i' 'c' pre -> (# post, pre #) + | Latin1.equals6 'n' 'o' 't' 'i' 'c' 'e' pre -> (# post, pre #) + | Latin1.equals7 'w' 'a' 'r' 'n' 'i' 'n' 'g' pre -> (# post, pre #) + _ -> (# name0, Bytes arr 0 0 #) + case hasPid of + False -> pure Process {priority, name, id = Word32.nothing} + True -> do + pid <- Latin.decWord32 e + Latin.char2 e ']' ':' + pure Process {priority, name, id = Word32.just pid} + +-- Precondition: length of bytes is 3 +resolveMonth :: Bytes -> Chronos.Month +resolveMonth b + | Latin1.equals3 'A' 'p' 'r' b = Chronos.april + | Latin1.equals3 'A' 'u' 'g' b = Chronos.august + | Latin1.equals3 'D' 'e' 'c' b = Chronos.december + | Latin1.equals3 'F' 'e' 'b' b = Chronos.february + | Latin1.equals3 'J' 'a' 'n' b = Chronos.january + | Latin1.equals3 'J' 'u' 'l' b = Chronos.july + | Latin1.equals3 'J' 'u' 'n' b = Chronos.june + | Latin1.equals3 'M' 'a' 'r' b = Chronos.march + | Latin1.equals3 'M' 'a' 'y' b = Chronos.may + | Latin1.equals3 'N' 'o' 'v' b = Chronos.november + | Latin1.equals3 'O' 'c' 't' b = Chronos.october + | Latin1.equals3 'S' 'e' 'p' b = Chronos.september + | otherwise = Chronos.Month 12 diff --git a/src/Syslog/Ietf.hs b/src/Syslog/Ietf.hs new file mode 100644 --- /dev/null +++ b/src/Syslog/Ietf.hs @@ -0,0 +1,322 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE UnboxedTuples #-} + +{- | Parse RFC 5424 messages. For example (from the spec itself): + +> <165>1 2003-10-11T22:14:15.003Z mymachine.example.com +> evntslog - ID47 [exampleSDID@32473 iut="3" eventSource="Application" +> eventID="1011"] BOMAn application event log entry... +-} +module Syslog.Ietf + ( -- * Types + Message (..) + , Element (..) + , Parameter (..) + + -- * Full Decode + , decode + , parser + ) where + +import Prelude hiding (id) + +import Control.Monad (when) +import Control.Monad.ST.Run (runIntByteArrayST) +import Data.Bytes.Parser (Parser) +import Data.Bytes.Types (Bytes (Bytes)) +import Data.Int (Int64) +import Data.Primitive (SmallArray) +import Data.Word (Word32, Word64, Word8) + +import qualified Chronos +import qualified Data.Bytes.Parser as Parser +import qualified Data.Bytes.Parser.Latin as Latin +import qualified Data.Bytes.Parser.Unsafe as Unsafe +import qualified Data.Bytes.Types +import qualified Data.Maybe.Unpacked.Numeric.Word32 as Word32 +import qualified Data.Primitive as PM +import qualified Data.Primitive.Contiguous as C + +data Message = Message + { priority :: !Word32 + , version :: !Word32 + , timestamp :: !Chronos.OffsetDatetime + , hostname :: {-# UNPACK #-} !Bytes + , application :: {-# UNPACK #-} !Bytes + , processId :: {-# UNPACK #-} !Word32.Maybe + , messageType :: {-# UNPACK #-} !Bytes + -- ^ A missing message type, represented as a hyphen in IETF-flavor + -- syslog, is represented by the empty byte sequence. + , structuredData :: {-# UNPACK #-} !(SmallArray Element) + , message :: {-# UNPACK #-} !Bytes + } + deriving (Show) + +data Element = Element + { id :: {-# UNPACK #-} !Bytes + , parameters :: {-# UNPACK #-} !(SmallArray Parameter) + } + deriving (Show) + +data Parameter = Parameter + { name :: {-# UNPACK #-} !Bytes + , value :: {-# UNPACK #-} !Bytes + } + deriving (Show) + +-- | Run the RFC 5424 parser. See 'parser'. +decode :: Bytes -> Maybe Message +decode = Parser.parseBytesMaybe parser + +-- | Parse a RFC 5424 message. +parser :: Parser () s Message +parser = do + priority <- takePriority () + version <- Latin.decWord32 () + Latin.char () ' ' + timestamp <- takeTimestamp + Latin.char () ' ' + hostname <- takeKeywordAndSpace () + application <- takeKeywordAndSpace () + processId <- + Latin.trySatisfy (== '-') >>= \case + True -> do + Latin.char () ' ' + pure Word32.nothing + False -> + Parser.orElse + -- This is a hack to smooth over a mistake. The process id + -- can actually be things other than a decimal-encoded number. + -- Sometimes it is 128-bit or 256-bit hexadecimal number. In + -- these cases, we just ignore it. + ( do + w <- Latin.decWord32 () + Latin.char () ' ' + pure (Word32.just w) + ) + ( do + Latin.skipWhile + (\c -> (c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F') || (c >= '0' && c <= '9')) + Latin.char () ' ' + pure Word32.nothing + ) + messageType <- + Latin.trySatisfy (== '-') >>= \case + True -> do + Latin.char () ' ' + array <- Unsafe.expose + pure Bytes {array, offset = 0, length = 0} + False -> takeKeywordAndSpace () + structuredData <- + Latin.trySatisfy (== '-') >>= \case + True -> pure mempty + False -> takeStructuredData + message <- + Parser.isEndOfInput >>= \case + True -> do + arr <- Unsafe.expose + pure Bytes {array = arr, offset = 0, length = 0} + False -> do + Latin.char () ' ' + Parser.remaining + pure + Message + { priority + , version + , timestamp + , hostname + , application + , processId + , messageType + , structuredData + , message + } + +takeStructuredData :: Parser () s (SmallArray Element) +takeStructuredData = go 0 [] + where + go :: Int -> [Element] -> Parser () s (SmallArray Element) + go !n !acc = + Latin.trySatisfy (== '[') >>= \case + True -> do + id <- takeKeyword + parameters <- takeParameters + let !e = Element {id, parameters} + go (n + 1) (e : acc) + False -> pure $! C.unsafeFromListReverseN n acc + +takeParameters :: Parser () s (SmallArray Parameter) +takeParameters = go 0 [] + where + go :: Int -> [Parameter] -> Parser () s (SmallArray Parameter) + go !n !acc = + Latin.trySatisfy (== ']') >>= \case + True -> pure $! C.unsafeFromListReverseN n acc + False -> do + Latin.char () ' ' + name <- takeKeywordAndEquals + value <- takeParameterValue + let !p = Parameter {name, value} + go (n + 1) (p : acc) + +-- This handles escape sequences correctly. +takeParameterValue :: Parser () s Bytes +takeParameterValue = do + Latin.char () '"' + start <- Unsafe.cursor + Parser.skipTrailedBy2 () 0x22 0x5C >>= \case + False -> do + -- no backslashes, went all the way to a double quote + end <- Unsafe.cursor + let !len = (end - start) - 1 + arr <- Unsafe.expose + pure Bytes {array = arr, offset = start, length = len} + True -> do + -- found a backslash, we will need to escape quotes + c <- Latin.any () + if c == '"' || c == '\\' + then pure () + else Parser.fail () + consumeThroughUnescapedQuote + end <- Unsafe.cursor + let !len = (end - start) - 1 + arr <- Unsafe.expose + let bs = Bytes {array = arr, offset = start, length = len} + pure $! removeEscapeSequences bs + +consumeThroughUnescapedQuote :: Parser () s () +consumeThroughUnescapedQuote = + Parser.skipTrailedBy2 () 0x22 0x5C >>= \case + False -> pure () + True -> do + c <- Latin.any () + if c == '"' || c == '\\' + then consumeThroughUnescapedQuote + else Parser.fail () + +{- | Precondition: Every backslash is followed by a double quote or by +a backslash. +-} +removeEscapeSequences :: Bytes -> Bytes +removeEscapeSequences Bytes {array, offset = off0, length = len0} = + let (lengthX, arrayX) = runIntByteArrayST $ do + dst <- PM.newByteArray len0 + let go !ixSrc !ixDst !len = case len of + 0 -> pure ixDst + _ -> do + let w :: Word8 = PM.indexByteArray array ixSrc + case w of + 0x5C -> case PM.indexByteArray array (ixSrc + 1) :: Word8 of + 0x5C -> do + PM.writeByteArray dst ixDst (0x5C :: Word8) + go (ixSrc + 2) (ixDst + 1) (len - 2) + 0x22 -> do + PM.writeByteArray dst ixDst (0x22 :: Word8) + go (ixSrc + 2) (ixDst + 1) (len - 2) + _ -> errorWithoutStackTrace "Syslog.Ietf.removeEscapeSequences: invariant violated" + _ -> do + PM.writeByteArray dst ixDst w + go (ixSrc + 1) (ixDst + 1) (len - 1) + lenDst <- go off0 0 len0 + PM.shrinkMutableByteArray dst lenDst + dst' <- PM.unsafeFreezeByteArray dst + pure (lenDst, dst') + in Bytes {array = arrayX, length = lengthX, offset = 0} + +{- | Consume the angle-bracketed priority. RFC 5424 does not allow +a space to follow the priority, so this does not consume a +trailing space. +-} +takePriority :: e -> Parser e s Word32 +takePriority e = do + Latin.char e '<' + priority <- Latin.decWord32 e + Latin.char e '>' + pure priority + +{- | Consume the keyword and the space that follows it. Returns +the hostname. +-} +takeKeywordAndSpace :: e -> Parser e s Bytes +takeKeywordAndSpace e = + -- TODO: This should actually use a takeWhile1. + Latin.takeTrailedBy e ' ' + +-- | Consume the keyword. Returns the keyword. +takeKeyword :: Parser e s Bytes +takeKeyword = + -- TODO: Should use takeWhile1 + Parser.takeWhile (\c -> c /= 0x20) + +{- | Consume the keyword and the equals sign that follows it. Returns +the keyword. +-} +takeKeywordAndEquals :: Parser () s Bytes +takeKeywordAndEquals = + -- TODO: This should actually use a takeWhile1. + Latin.takeTrailedBy () '=' + +-- | Consume the timestamp. +takeTimestamp :: Parser () s Chronos.OffsetDatetime +takeTimestamp = do + year <- Latin.decWord () + Latin.char () '-' + month' <- Latin.decWord () + let !month = month' - 1 + when (month >= 12) (Parser.fail ()) + Latin.char () '-' + day <- Latin.decWord () + Latin.char () 'T' + hour <- Latin.decWord () + Latin.char () ':' + minute <- Latin.decWord () + Latin.char () ':' + sec <- Latin.decWord () + let date = + Chronos.Date + (Chronos.Year (fromIntegral year)) + (Chronos.Month (fromIntegral month)) + (Chronos.DayOfMonth (fromIntegral day)) + !nanos <- + Latin.trySatisfy (== '.') >>= \case + True -> do + (n, w) <- Parser.measure (Latin.decWord64 ()) + when (n > 9) (Parser.fail ()) + let go !acc !b = case b of + 0 -> acc + _ -> go (acc * 10) (b - 1) + !ns = go w (9 - n) + pure ns + False -> pure 0 + off <- + Latin.any () >>= \case + 'Z' -> pure 0 + '+' -> parserOffset + '-' -> do + !off <- parserOffset + pure (negate off) + _ -> Parser.fail () + pure $! + Chronos.OffsetDatetime + ( Chronos.Datetime date $ + Chronos.TimeOfDay + (fromIntegral hour) + (fromIntegral minute) + (fromIntegral @Word64 @Int64 (fromIntegral sec * 1000000000 + nanos)) + ) + (Chronos.Offset off) + +-- Should consume exactly five characters: HH:MM. However, the implementation +-- is more generous. +parserOffset :: Parser () s Int +parserOffset = do + h <- Latin.decWord8 () + Latin.char () ':' + m <- Latin.decWord8 () + let !r = ((fromIntegral @Word8 @Int h) * 60) + fromIntegral @Word8 @Int m + pure r diff --git a/syslog.cabal b/syslog.cabal new file mode 100644 --- /dev/null +++ b/syslog.cabal @@ -0,0 +1,57 @@ +cabal-version: 2.4 +name: syslog +version: 0.1.0.0 +synopsis: Decode RFC 3164 and RFC 5424 syslog message formats +description: + Decode syslog messages that were formatted using RFC 3164 (BSD-syslog) or + RFC 5424 (IETF-syslog). + +homepage: https://github.com/byteverse/syslog +bug-reports: https://github.com/byteverse/syslog/issues +license: BSD-3-Clause +license-file: LICENSE +author: Andrew Martin +maintainer: amartin@layer3com.com +copyright: 2020 Andrew Martin +category: Data +build-type: Simple +extra-doc-files: CHANGELOG.md +tested-with: GHC ==9.4.8 || ==9.6.3 || ==9.8.1 + +common build-settings + default-language: Haskell2010 + ghc-options: -Wall -Wunused-packages + +library + import: build-settings + exposed-modules: + Syslog.Bsd + Syslog.Ietf + + build-depends: + , base >=4.12 && <5 + , byteslice >=0.2.6 + , bytesmith >=0.3.6 + , chronos >=1.1 + , contiguous >=0.5.1 + , primitive >=0.7.1 + , run-st >=0.1.1 + , unpacked-maybe-numeric >=0.1.1 + + hs-source-dirs: src + ghc-options: -O2 + +test-suite test + import: build-settings + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + build-depends: + , base >=4.12.0.0 && <5 + , byteslice >=0.2 + , primitive >=0.7.1 + , syslog + +source-repository head + type: git + location: git://github.com/byteverse/syslog.git diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,192 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} + +import Prelude hiding (id) + +import Data.Bytes (Bytes) +import Data.Maybe (isNothing) +import Syslog.Bsd (Message (Message), Process (Process)) + +import qualified Data.Bytes as Bytes +import qualified Data.Bytes.Text.Latin1 as Latin1 +import qualified Data.Primitive as PM +import qualified Syslog.Bsd as Bsd +import qualified Syslog.Ietf as Ietf + +main :: IO () +main = do + putStrLn "Starting" + putStrLn "Test A" + case Bsd.decode msgA of + Nothing -> fail "Could not decode message A" + Just Message {priority, hostname, process = Just Process {name}, message} -> do + assert "priority" (priority == 133) + assert "hostname" (hostname == Latin1.fromString "webserver") + assert "process_name" (name == Latin1.fromString "syslogd") + assert "message" (message == Latin1.fromString "restart") + Just _ -> fail "Message A missing process name" + putStrLn "Test B" + case Bsd.decode msgB of + Nothing -> fail "Could not decode message B" + Just Message {priority, hostname, process = Just Process {name}, message} -> do + assert "priority" (priority == 0) + assert "hostname" (hostname == Latin1.fromString "foo.example.org") + assert "process_name" (name == Latin1.fromString "sched") + assert "message" (message == Latin1.fromString "That's all") + Just _ -> fail "Message B missing process name" + putStrLn "Test C" + case Bsd.decode msgC of + Nothing -> fail "Could not decode message C" + Just Message {priority, hostname, process = Just Process {name}, message} -> do + assert "priority" (priority == 133) + assert "hostname" (hostname == Latin1.fromString "192.0.2.231") + assert "process_name" (name == Latin1.fromString "stm") + assert "message" (message == Latin1.fromString "Hello") + Just _ -> fail "Message C missing process name" + putStrLn "Test D" + case Bsd.decode msgD of + Nothing -> fail "Could not decode message D" + Just Message {priority, process, message} -> do + assert "priority" (priority == 26) + assert "process_name" (isNothing process) + assert "message" (message == Latin1.fromString "ASA log") + putStrLn "Test E" + case Bsd.decode msgE of + Nothing -> fail "Could not decode message E" + Just Message {process} -> case process of + Just Process {priority, name} -> do + assert "process_priority" (priority == Latin1.fromString "notice") + assert "process_name" (name == Latin1.fromString "tmsh") + Nothing -> fail "Message E missing process information" + putStrLn "Test F" + case Bsd.decode msgF of + Nothing -> fail "Could not decode message F" + Just Message {message} -> do + assert "message" (message == Latin1.fromString "foo") + putStrLn "Test G" + case Bsd.decode msgG of + Nothing -> fail "Could not decode message G" + Just {} -> pure () + putStrLn "Test IETF A" + case Ietf.decode ietfA of + Nothing -> fail "Could not decode IETF message A" + Just Ietf.Message {version, hostname, structuredData} -> do + assert "version" (version == 1) + assert "hostname" (hostname == Latin1.fromString "mymachine.example.com") + assert "structured_data_length" (length structuredData == 1) + putStrLn "Test IETF B" + case Ietf.decode ietfB of + Nothing -> fail "Could not decode IETF message B" + Just Ietf.Message {version, hostname, application, messageType, structuredData} -> do + assert "version" (version == 1) + assert "hostname" (hostname == Latin1.fromString "FOOBAR-SRX-FWL0") + assert "application" (application == Latin1.fromString "RT_FLOW") + assert "message_type" (messageType == Latin1.fromString "RT_FLOW_SESSION_CLOSE") + assert "structured_data_length" (length structuredData == 1) + let Ietf.Element {id, parameters} = PM.indexSmallArray structuredData 0 + assert "structured_data.id" (id == Latin1.fromString "junos@2636.1.1.1.2.133") + assert "structured_data.parameters_length" (length parameters == 32) + putStrLn "Test IETF C" + case Ietf.decode ietfC of + Nothing -> fail "Could not decode IETF message C" + Just Ietf.Message {version, hostname, application, messageType, structuredData, message} -> do + assert "version" (version == 1) + assert "hostname" (hostname == Latin1.fromString "mymachine.example.com") + assert "application" (application == Latin1.fromString "bigapp") + assert "message_type" (Bytes.null messageType) + assert "structured_data_length" (length structuredData == 0) + assert "message" (message == Latin1.fromString "hey world") + putStrLn "Test IETF D" + case Ietf.decode ietfD of + Nothing -> fail "Could not decode IETF message D" + Just Ietf.Message {message, structuredData} -> do + assert "structured_data_length" (length structuredData == 3) + let Ietf.Element {parameters} = PM.indexSmallArray structuredData 2 + assert "parameters_length" (length parameters == 1) + let Ietf.Parameter {value} = PM.indexSmallArray parameters 0 + case value == Latin1.fromString "\\foo\\bar.txt" of + True -> pure () + False -> fail ("structured_data.2.0: " ++ show value) + assert "message" (message == Latin1.fromString "bad news") + putStrLn "Test IETF E" + case Ietf.decode ietfE of + Nothing -> fail "Could not decode IETF message E" + Just _ -> pure () + putStrLn "Test IETF F" + case Ietf.decode ietfF of + Nothing -> fail "Could not decode IETF message F" + Just _ -> pure () + putStrLn "Finished" + +assert :: String -> Bool -> IO () +assert ctx b = if b then pure () else fail ctx + +msgA, msgB, msgC, msgD, msgE, msgF, msgG :: Bytes +msgA = Latin1.fromString "<133>Feb 25 14:09:07 webserver syslogd: restart" +msgB = Latin1.fromString "<0>Oct 22 10:52:01 foo.example.org sched[0]: That's all" +msgC = Latin1.fromString "<133>May 2 11:43:37 2020 192.0.2.231 stm[8753]: Hello" +msgD = Latin1.fromString "<26>May 05 2020 07:30:21 192.0.2.10 : ASA log" +msgE = Latin1.fromString "<133>Aug 10 07:12:13 example.local notice tmsh[4067]: hey" +msgF = Latin1.fromString "<133>Aug 10 07:12:13: foo" +msgG = Latin1.fromString "<134>Oct 30 12:31:49 10.22.16.11 logrhythm: " + +ietfA :: Bytes +ietfA = + Latin1.fromString $ + concat + [ "<165>1 2003-10-11T22:14:15.003Z mymachine.example.com evntslog - ID47 " + , "[exampleSDID@32473 iut=\"3\" eventSource=\"Application\" eventID=\"1011\"] " + , "BOMAn application event log entry" + ] + +ietfB :: Bytes +ietfB = + Latin1.fromString $ + concat + [ "<14>1 2020-10-15T17:01:23.466Z FOOBAR-SRX-FWL0 RT_FLOW - RT_FLOW_SESSION_CLOSE " + , "[junos@2636.1.1.1.2.133 reason=\"application failure or action\" " + , "source-address=\"192.0.2.29\" source-port=\"55110\" " + , "destination-address=\"192.0.2.30\" destination-port=\"135\" connection-tag=\"0\" " + , "service-name=\"junos-ms-rpc-tcp\" nat-source-address=\"192.0.2.229\" " + , "nat-source-port=\"55110\" nat-destination-address=\"192.0.2.230\" " + , "nat-destination-port=\"135\" nat-connection-tag=\"0\" src-nat-rule-type=\"N/A\" " + , "src-nat-rule-name=\"N/A\" dst-nat-rule-type=\"N/A\" dst-nat-rule-name=\"N/A\" " + , "protocol-id=\"6\" policy-name=\"EXAMPLE-POLICY\" " + , "source-zone-name=\"MYSRCZONE\" destination-zone-name=\"MYDSTZONE\" " + , "session-id-32=\"14953\" packets-from-client=\"0\" bytes-from-client=\"0\" " + , "packets-from-server=\"0\" bytes-from-server=\"0\" elapsed-time=\"1\" " + , "application=\"UNKNOWN\" nested-application=\"UNKNOWN\" username=\"N/A\" " + , "roles=\"N/A\" packet-incoming-interface=\"ge-0/0/5.0\" encrypted=\"UNKNOWN\"] " + , "session closed application failure or action" + ] + +ietfC :: Bytes +ietfC = + Latin1.fromString $ + concat + [ "<165>1 2003-10-11T22:14:15.003Z mymachine.example.com bigapp - - - " + , "hey world" + ] + +ietfD :: Bytes +ietfD = + Latin1.fromString $ + concat + [ "<38>1 2021-11-18T11:55:55.661764Z 192.0.2.20 SentinelOne " + , "ab1fc131b2f29bc49b09286bb05e0b94e5c36610 1291980691205274618 " + , "[fileName@53163 fileName=\"badcat.exe\"]" + , "[deviceAddress@53163 deviceAddress=\"192.0.2.21\"]" + , "[path@53163 path=\"\\\\foo\\\\bar.txt\"]" + , " bad news" + ] + +ietfE :: Bytes +ietfE = + Latin1.fromString $ + concat + [ "<14>1 2021-12-10T09:19:19.614-05:00 THE-HOST RT_FLOW - RT_FLOW_SESSION_DENY " + , "[junos@2636.1.1.1.2.40 source-address=\"192.0.2.13\"]" + ] + +ietfF :: Bytes +ietfF = Latin1.fromString "<14>1 2023-05-09T16:21:33-04:00 192.0.2.5 - - - - CEF:0"