diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..18f70b9 --- /dev/null +++ b/.gitignore @@ -0,0 +1,28 @@ +dist +dist-* +cabal-dev +*.o +*.hi +*.chi +*.chs.h +*.dyn_o +*.dyn_hi +.hpc +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +*.prof +*.aux +*.hp +*.eventlog +.stack-work/ +cabal.project.local +cabal.project.local~ +.HTF/ +.ghc.environment.* +stack.yaml +*.swm +*.swo +*.swp +test_results/** +examples/validate diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..251f625 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for syslog + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..c31eb7a --- /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/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/examples/validate.hs b/examples/validate.hs new file mode 100644 index 0000000..864949f --- /dev/null +++ b/examples/validate.hs @@ -0,0 +1,35 @@ +{-# language BangPatterns #-} +{-# language LambdaCase #-} + +import Data.Primitive (ByteArray) +import Data.ByteString (ByteString) +import Data.Bool (bool) +import Control.Exception +import System.IO.Error (isEOFError) +import Foreign.C.Types (CChar) + +import qualified Data.Primitive as PM +import qualified Data.Primitive.Ptr as PM +import qualified Data.ByteString as ByteString +import qualified Data.Bytes as Bytes +import qualified Syslog.Bsd as Bsd + +main :: IO () +main = do + let go !ix = catchJust (bool Nothing (Just ()) . isEOFError) (Just <$> ByteString.getLine) (\() -> pure Nothing) >>= \case + Nothing -> pure () + Just b0 -> do + b1 <- b2b b0 + case Bsd.decode (Bytes.fromByteArray b1) of + Nothing -> fail $ "Decode failure on line " ++ show ix + Just _ -> go (ix + 1) + go 0 + +b2b :: ByteString -> IO ByteArray +b2b !b = ByteString.useAsCStringLen b $ \(ptr,len) -> do + arr <- PM.newByteArray len + PM.copyPtrToMutablePrimArray (castArray arr) 0 ptr len + PM.unsafeFreezeByteArray arr + +castArray :: PM.MutableByteArray s -> PM.MutablePrimArray s CChar +castArray (PM.MutableByteArray x) = PM.MutablePrimArray x diff --git a/src/Syslog/Bsd.hs b/src/Syslog/Bsd.hs new file mode 100644 index 0000000..fe1c871 --- /dev/null +++ b/src/Syslog/Bsd.hs @@ -0,0 +1,96 @@ +{-# language NamedFieldPuns #-} + +module Syslog.Bsd + ( Message(..) + , decode + ) where + +import Control.Monad (when) +import Data.Bytes.Types (Bytes(Bytes)) +import Data.Bytes.Parser (Parser) +import Data.Word (Word8,Word32) + +import qualified Chronos +import qualified Data.Bytes as Bytes +import qualified Data.Maybe.Unpacked.Numeric.Word32 as Word32 +import qualified Data.Bytes.Parser as Parser +import qualified Data.Bytes.Parser.Latin as Latin +import qualified Data.Bytes.Parser.Unsafe as Unsafe + +data Message = Message + { priority :: !Word32 + , month :: !Chronos.Month + , day :: !Chronos.DayOfMonth + , hour :: !Word8 + , minute :: !Word8 + , second :: !Word8 + , host :: {-# UNPACK #-} !Bytes + , process :: {-# UNPACK #-} !Bytes + , processId :: {-# UNPACK #-} !Word32.Maybe + , message :: {-# UNPACK #-} !Bytes + } + +decode :: Bytes -> Maybe Message +decode = Parser.parseBytesMaybe parser + +parser :: Parser () s Message +parser = do + Latin.char () '<' + priority <- Latin.decWord32 () + Latin.char () '>' + monthBytes <- Parser.take () 3 + month <- case resolveMonth monthBytes of + Chronos.Month 12 -> Parser.fail () + m -> pure m + -- There might be two spaces here since single-digit days get + -- padded with a space. + Latin.skipChar1 () ' ' + dayRaw <- Latin.decWord8 () + day <- if dayRaw < 32 + then pure (Chronos.DayOfMonth (fromIntegral dayRaw)) + else Parser.fail () + Latin.char () ' ' + hour <- Latin.decWord8 () + when (hour > 23) (Parser.fail ()) + Latin.char () ':' + minute <- Latin.decWord8 () + when (minute > 59) (Parser.fail ()) + Latin.char () ':' + second <- Latin.decWord8 () + when (second > 59) (Parser.fail ()) + Latin.char () ' ' + host <- Latin.takeTrailedBy () ' ' + -- TODO: This should actually be a takeWhile1. + processStart <- Unsafe.cursor + hasPid <- Parser.skipTrailedBy2 () 0x3A 0x5B + processEndSucc <- Unsafe.cursor + arr <- Unsafe.expose + let process = Bytes arr processStart ((processEndSucc - 1) - processStart) + case hasPid of + False -> do + Latin.skipChar ' ' + message <- Parser.remaining + pure Message{priority,month,day,hour,minute,second,host,process,processId=Word32.nothing,message} + True -> do + pid <- Latin.decWord32 () + Latin.char2 () ']' ':' + Latin.skipChar ' ' + message <- Parser.remaining + pure Message{priority,month,day,hour,minute,second,host,process,processId=Word32.just pid,message} + +-- Precondition: length of bytes is 3 +resolveMonth :: Bytes -> Chronos.Month +resolveMonth b + | Bytes.equalsLatin3 'A' 'p' 'r' b = Chronos.april + | Bytes.equalsLatin3 'A' 'u' 'g' b = Chronos.august + | Bytes.equalsLatin3 'D' 'e' 'c' b = Chronos.december + | Bytes.equalsLatin3 'F' 'e' 'b' b = Chronos.february + | Bytes.equalsLatin3 'J' 'a' 'n' b = Chronos.january + | Bytes.equalsLatin3 'J' 'u' 'l' b = Chronos.july + | Bytes.equalsLatin3 'J' 'u' 'n' b = Chronos.june + | Bytes.equalsLatin3 'M' 'a' 'r' b = Chronos.march + | Bytes.equalsLatin3 'M' 'a' 'y' b = Chronos.may + | Bytes.equalsLatin3 'N' 'o' 'v' b = Chronos.november + | Bytes.equalsLatin3 'O' 'c' 't' b = Chronos.october + | Bytes.equalsLatin3 'S' 'e' 'p' b = Chronos.september + | otherwise = Chronos.Month 12 diff --git a/syslog.cabal b/syslog.cabal new file mode 100644 index 0000000..efa18ea --- /dev/null +++ b/syslog.cabal @@ -0,0 +1,29 @@ +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). +bug-reports: https://github.com/layer-3-communications/syslog +license: BSD-3-Clause +license-file: LICENSE +author: Andrew Martin +maintainer: andrew.thaddeus@gmail.com +copyright: 2020 Andrew Martin +category: Data +build-type: Simple +extra-source-files: CHANGELOG.md + +library + exposed-modules: + Syslog.Bsd + build-depends: + , base >=4.12 && <5 + , unpacked-maybe-numeric>=0.1.1 + , chronos >=1.1 + , byteslice >=0.2.2 + , bytesmith >=0.3.6 + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -O2 -Wall