diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,13 @@ + DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE + Version 2, December 2004 + + Copyright (C) 2016 Andrew Rademacher + + Everyone is permitted to copy and distribute verbatim or modified + copies of this license document, and changing it is allowed as long + as the name is changed. + + DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. You just DO WHAT THE FUCK YOU WANT TO. 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/graylog.cabal b/graylog.cabal new file mode 100644 --- /dev/null +++ b/graylog.cabal @@ -0,0 +1,64 @@ +name: graylog +version: 0.1.0.0 +synopsis: Support for graylog output. +description: Support for sending GELF formatted messages to graylog over + chunked UDP. +homepage: https://github.com/AndrewRademacher/haskell-graylog +license: OtherLicense +license-file: LICENSE +author: Andrew Rademacher +maintainer: andrewrademacher@gmail.com +copyright: 2016 Andrew Rademacher +category: Web +build-type: Simple +cabal-version: >=1.10 + +library + hs-source-dirs: src + default-language: Haskell2010 + + exposed-modules: Graylog.Gelf + , Graylog.UDP + + other-modules: Graylog.Types + + ghc-options: -Wall -rtsopts + + build-depends: base ==4.* + + , aeson + , aeson-casing + , bytestring + , network + , random + , scientific + , text + , time + , vector + +test-suite test-state + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: test + default-language: Haskell2010 + + ghc-options: -Wall -threaded -with-rtsopts=-N -rtsopts + + other-modules: Test.Graylog.UDP + + build-depends: base ==4.* + + , graylog + + , aeson + , aeson-casing + , bytestring + , file-embed + , network + , scientific + , tasty + , tasty-hunit + , text + , time + , vector + diff --git a/src/Graylog/Gelf.hs b/src/Graylog/Gelf.hs new file mode 100644 --- /dev/null +++ b/src/Graylog/Gelf.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Default formatting for Graylog messages, +-- see http://docs.graylog.org/en/latest/pages/gelf.html +module Graylog.Gelf where + +import Data.Aeson (ToJSON (..), Value (..), genericToJSON, + toJSON) +import Data.Aeson.Casing +import Data.Text (Text) +import Data.Time +import Data.Typeable +import GHC.Generics + +data GELF + = GELF + { _gelfVersion :: Version + , _gelfHost :: Text + , _gelfShortMessage :: Text + , _gelfFullMessage :: Maybe Text + , _gelfTimestamp :: Maybe UTCTime + , _gelfLevel :: Maybe SyslogLevel + , _gelfLine :: Maybe Word + , _gelfFile :: Maybe Text + } + deriving (Show, Typeable, Generic) + +instance ToJSON GELF where + toJSON = genericToJSON $ aesonPrefix snakeCase + +-- + +data Version + = Version1x1 + deriving (Eq, Show, Typeable, Generic) + +instance ToJSON Version where + toJSON Version1x1 = String "1.1" + +-- + +data SyslogLevel + = Emergency + | Alert + | Critical + | Error + | Warning + | Notice + | Informational + | Debug + deriving (Eq, Ord, Show, Typeable, Generic) + +instance ToJSON SyslogLevel where + toJSON Emergency = Number 0 + toJSON Alert = Number 1 + toJSON Critical = Number 2 + toJSON Error = Number 3 + toJSON Warning = Number 4 + toJSON Notice = Number 5 + toJSON Informational = Number 6 + toJSON Debug = Number 7 + +-- + +simpleGelf + :: Text -- ^ Hostname + -> Text -- ^ Short message + -> GELF +simpleGelf host short = + GELF Version1x1 host short Nothing Nothing Nothing Nothing Nothing diff --git a/src/Graylog/Types.hs b/src/Graylog/Types.hs new file mode 100644 --- /dev/null +++ b/src/Graylog/Types.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} + +module Graylog.Types + ( Graylog + , _graylogHost + , _graylogPort + , _graylogAddress + , _graylogSocket + , _graylogHostName + , _graylogChunkSize + , ChunkSize + + , defaultChunkSize + , openGraylog + , closeGraylog + ) where + +import Data.List +import Data.Text (Text) +import qualified Data.Text as T +import Network.BSD +import Network.Socket + +-- | The maximum size of each datagram when using UDP transit methods. +type ChunkSize = Word + +-- | Handle for a socket connected to Graylog. In some cases this socket +-- is UDP and will not have a maintained session. +data Graylog + = Graylog + { _graylogHost :: String + , _graylogPort :: String + , _graylogAddress :: AddrInfo + , _graylogSocket :: Socket + , _graylogHostName :: Text + , _graylogChunkSize :: ChunkSize + } + +defaultChunkSize :: ChunkSize +defaultChunkSize = 8192 + +openGraylog + :: HostName -- ^ The host on which graylog is running. + -> ServiceName -- ^ The port on which graylog is running. + -> ChunkSize -- ^ The maximum size of each UDP datagram. + -> IO (Either String Graylog) +openGraylog h p cksize + | cksize < 1024 = return $ Left "ChunkSize must be at least 1024." + | otherwise = getAddrInfo Nothing (Just h) (Just p) >>= \case + [] -> return $ Left "No address info found." + infos -> + case find (\i -> addrSocketType i == Datagram) infos of + Nothing -> return $ Left "No datagram info found for address." + Just i -> do + sock <- socket (addrFamily i) Datagram defaultProtocol + connect sock (addrAddress i) + hostname <- getHostName + return $ Right $ Graylog h p i sock (T.pack hostname) cksize + +closeGraylog :: Graylog -> IO () +closeGraylog Graylog{..} = close _graylogSocket diff --git a/src/Graylog/UDP.hs b/src/Graylog/UDP.hs new file mode 100644 --- /dev/null +++ b/src/Graylog/UDP.hs @@ -0,0 +1,50 @@ +-- | UDP Chunked support for sending messages to graylog. +module Graylog.UDP + ( sendLog + + , module Export + ) where + +import Data.Aeson +import Data.ByteString.Builder +import qualified Data.ByteString.Lazy as LBS +import Data.Monoid +import Data.Word +import Network.Socket.ByteString.Lazy +import System.Random + +import Graylog.Gelf as Export +import Graylog.Types as Export + +sendLog :: Graylog -> GELF -> IO () +sendLog glog msg = do + cks <- chunky glog raw + mapM_ (send $ _graylogSocket glog) cks + where + raw = encode msg + +chunky :: Graylog -> LBS.ByteString -> IO [LBS.ByteString] +chunky glog raw = do + groupId <- randomIO + let groups = divide totalNum raw + return $ append groupId groups seqNums + where + magic = word8 0x1e <> word8 0x0f + seqNums = [0..] :: [Word8] + totalNum = if excess > 0 then count + 1 else count + (count, excess) = quotRem (LBS.length raw) gsize + hlen = 12 + gsize = (fromIntegral (_graylogChunkSize glog)) - hlen + + divide 0 dat = [dat] + divide num dat = let (pre, post) = LBS.splitAt gsize dat + in pre : divide (num - 1) post + + append _ [] _ = [] + append _ _ [] = error "the impossible has happened." + append gid (g:gs) (s:ss) = (toLazyByteString + $ magic + <> word64BE gid + <> word8 s + <> word8 (fromIntegral totalNum) + <> lazyByteString g) : append gid gs ss diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,12 @@ +import qualified Test.Graylog.UDP (tests) + +import Test.Tasty + +main :: IO () +main = defaultMain tests + +tests :: TestTree +tests = testGroup "Graylog Library" + [ Test.Graylog.UDP.tests + ] + diff --git a/test/Test/Graylog/UDP.hs b/test/Test/Graylog/UDP.hs new file mode 100644 --- /dev/null +++ b/test/Test/Graylog/UDP.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module Test.Graylog.UDP where + +import qualified Data.ByteString as BS +import Data.FileEmbed +import qualified Data.Text.Encoding as T +import Test.Tasty +import Test.Tasty.HUnit + +import Graylog.UDP + +largeSample :: BS.ByteString +largeSample = $(embedFile "./test/Test/Graylog/UDP/large-sample.json") + +tests :: TestTree +tests = testGroup "Test.Graylog.UDP" + [ testCase "Send sample message." case_sendSample + , testCase "Send large sample message." case_sendLargeSample + ] + +case_sendSample :: IO () +case_sendSample = do + eglog <- openGraylog "192.168.99.100" "12201" defaultChunkSize + case eglog of + Left e -> assertFailure e + Right g -> sendLog g sample >> closeGraylog g + where + sample = simpleGelf "localhost" "hello world!" + +case_sendLargeSample :: IO () +case_sendLargeSample = do + eglog <- openGraylog "192.168.99.100" "12201" defaultChunkSize + case eglog of + Left e -> assertFailure e + Right g -> sendLog g sample >> closeGraylog g + where + sample = (simpleGelf "localhost" "hello world!") + { _gelfFullMessage = Just $ T.decodeUtf8 largeSample } +