hGelf (empty) → 0.1
raw patch · 5 files changed
+232/−0 lines, 5 filesdep +QuickCheckdep +aesondep +basesetup-changed
Dependencies added: QuickCheck, aeson, base, bytestring, cereal, network, old-time, pureMD5, text, time, zlib
Files
- BSD3 +25/−0
- Setup.lhs +6/−0
- hGelf.cabal +36/−0
- src/Network/Gelf.hs +122/−0
- src/Network/Gelf/Chunk.hs +43/−0
+ BSD3 view
@@ -0,0 +1,25 @@+Copyright (c) 2012, Andy Georges+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 the author nor the names of its 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 HOLDER 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.
+ Setup.lhs view
@@ -0,0 +1,6 @@+#!/usr/bin/runhaskell +> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMain+
+ hGelf.cabal view
@@ -0,0 +1,36 @@+name: hGelf+version: 0.1+cabal-version: >=1.14+build-type: Simple+license: BSD3+license-file: BSD3+copyright: Andy Georges+maintainer: itkovian@gmail.com+stability: experimental+synopsis: Haskell GELF library+description: Library for sending messages in the GELF format to a server accepting Graylog2 Extended Log Format messages.+category: Network+author: Andy Georges+tested-with: GHC ==7.4.1+data-dir: ""+extra-source-files: src/Network/Gelf.hs++source-repository this+ type: git+ location: git://github.com/itkovian/hGelf.git+ tag: 0.1+ +library+ build-depends: QuickCheck -any, aeson >=0.6, base >= 4 && < 5,+ bytestring >=0.9.2.1, network >=2.3.0.13, old-time >=1.1.0.0,+ text >=0.11.1, time >=1.4, zlib >=0.5.3.3, cereal >= 0.3.5.1,+ pureMD5 >= 2.1.0.3+ exposed-modules: Network.Gelf+ default-language: Haskell2010+ exposed: True+ buildable: True+ cpp-options: -DMAIN_FUNCTION=testMain+ default-extensions: OverloadedStrings+ hs-source-dirs: src+ other-modules: Network.Gelf.Chunk+
+ src/Network/Gelf.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+--+-- Module : Network.Gelf+-- Copyright : Andy Georges+-- License : AllRightsReserved+--+-- Maintainer : itkovian@gmail.com+-- Stability : experimental+-- Portability :+--+-- |+--+-----------------------------------------------------------------------------++module Network.Gelf (+ Network.Gelf.send+ , encode+) where++import Codec.Compression.Zlib (compress)+import Control.Arrow (second)+import qualified Data.Aeson as A+import Data.Bits(shiftL, (.|.))+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy.Char8 as BSLC+import Data.Digest.Pure.MD5 (md5)+import Data.Maybe (isJust)+import qualified Data.Text as T+import qualified Data.Serialize as DS (encode)+import Data.Word+import Network.BSD (getHostName)+import Network.Socket+import qualified Network.Socket.ByteString.Lazy as NSBL+import System.Time (getClockTime, ClockTime(TOD))++import Network.Gelf.Chunk (split)++{- TODO:+ - * timestamp: specs state microsecond timestamp, so correct this+ - * wrap this in a monad stack with IO at the bottom, and some static+ - configuration info on top of that, e.g., for setting the hostname,+ - the destination port, chunk size, etc.+ -}++catSecondMaybes :: [(a, Maybe b)]+ -> [(a, b)]+catSecondMaybes [] = []+catSecondMaybes ((k, v):vs) =+ case v of+ Just v' -> (k,v') : cvs+ Nothing -> cvs+ where cvs = catSecondMaybes vs+++gelfMessage :: T.Text -- ^Short message+ -> Maybe T.Text -- ^Long message (optional)+ -> String -- ^Hostname+ -> Integer -- ^Timestamp+ -> Maybe T.Text -- ^Filename (optional)+ -> Maybe Integer -- ^Line number (optional)+ -> [(T.Text, Maybe T.Text)] -- ^Additional fields+ -> A.Value+gelfMessage shortMessage longMessage hostname timestamp filename lineNumber fields =+ let loglevel = 1 :: Int+ allFields = [ ("version", A.toJSON `fmap` Just ("1.0" :: T.Text))+ , ("host" , A.toJSON `fmap` Just hostname)+ , ("short_message", A.toJSON `fmap` Just shortMessage)+ , ("full_message", A.toJSON `fmap` longMessage)+ , ("timestamp", A.toJSON `fmap` Just timestamp)+ , ("level", A.toJSON `fmap` Just loglevel)+ , ("facility", A.toJSON `fmap` Just ("GELF" :: T.Text))+ , ("line", A.toJSON `fmap` Just lineNumber)+ , ("file", A.toJSON `fmap` Just filename) ]+ ++ map (second (fmap A.toJSON)) fields+ in A.object $ catSecondMaybes allFields+++-- | Encode a log message as a GELF message.+--+-- This function wraps a given log message in a GELF structure. It creates the+-- JSON object, converts it to a ByteString and GZips the result.+-- If the resulting ByteString is longer than the maximal chunk size,+-- the GELF message is split up into chunks, each at most chunk size in length.+encode :: Int -- ^Maximal chunk size+ -> T.Text -- ^Short message+ -> Maybe T.Text -- ^Long message (optional)+ -> String -- ^Hostname+ -> Integer -- ^Timestamp+ -> Maybe T.Text -- ^Filename of the file causing the message, e.g., for debugging purposes+ -> Maybe Integer -- ^Line number in the file causing the message, e.g., for debugging purposes+ -> [(T.Text, Maybe T.Text)] -- ^Additional fields+ -> [BSL.ByteString] -- ^One or more chunks+encode chunkSize shortMessage longMessage hostname timestamp filename lineNumber fields =+ let j = gelfMessage shortMessage longMessage hostname timestamp filename lineNumber fields+ bs = compress $ A.encode j+ in if BSL.length bs + 2 < fromIntegral chunkSize+ then [bs]+ else split chunkSize id bs+ where id = foldl1 (\w b -> shiftL w 8 .|. b) . map fromIntegral . BS.unpack . BS.take 8 . DS.encode . md5 . BSLC.pack $ hostname ++ show timestamp :: Word64+++-- | Send a log message to a server accepting Graylog2 messages.+send :: HostName -- ^Remote hostname of the graylog server+ -> String -- ^Port number+ -> Int -- ^Chunk size+ -> T.Text -- ^Short message+ -> Maybe T.Text -- ^Long message (optional)+ -> Maybe T.Text -- ^Filename of the message cause+ -> Maybe Integer -- ^Line in the file where the message was sent for+ -> [(T.Text, Maybe T.Text)] -- ^Additional fields (name, information), should not contain 'id' as name+ -> IO () -- ^Does I/O+send serverName serverPort chunkSize shortMessage longMessage filename lineNumber fields = do+ addressInfos <- getAddrInfo Nothing (Just serverName) (Just serverPort)+ let serverAddress = head addressInfos -- FIXME: this should handle errors too+ sock <- socket (addrFamily serverAddress) Datagram defaultProtocol+ connect sock (addrAddress serverAddress)+ hostname <- getHostName+ timestamp <- getClockTime >>= (\(TOD seconds _) -> return seconds)+ let ms = encode chunkSize shortMessage longMessage hostname timestamp filename lineNumber fields+ mapM_ (NSBL.send sock) ms
+ src/Network/Gelf/Chunk.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+--+-- Module : Network.Gelf.Chunk+-- Copyright : Andy Georges+-- License : AllRightsReserved+--+-- Maintainer : itkovian@gmail.com+-- Stability : experimental+-- Portability :+--+-- |+--+-----------------------------------------------------------------------------++module Network.Gelf.Chunk (+ split+) where++import Data.Bits (shiftR, (.&.))+import qualified Data.ByteString.Lazy as BSL+import Data.Word+++split :: Int -- ^Chunk size+ -> Word64 -- ^Message identification (8 bytes)+ -> BSL.ByteString -- ^Message to split into chunks+ -> [BSL.ByteString] -- ^Resulting chunks+split size id bs =+ let cs = split' bs+ in zipWith (chunkify (length cs)) cs [0..]+ where split' :: BSL.ByteString -> [BSL.ByteString]+ split' bs =+ if BSL.length bs == 0+ then []+ else let (h,ts) = BSL.splitAt (fromIntegral size) bs+ in h : split' ts+ idBytes = BSL.pack [fromIntegral (shiftR id (x * 8) .&. 0xff) | x <- [7, 6 .. 0]]+ chunkify :: Int -- ^Total number of chunks+ -> BSL.ByteString -- ^Chunk data+ -> Int -- ^Chunk number+ -> BSL.ByteString -- ^Resulting bytestring+ chunkify total s i = BSL.cons 0x1e $ BSL.cons 0x0f $ BSL.append idBytes $ BSL.cons (fromIntegral i :: Word8) $ BSL.cons (fromIntegral total :: Word8) s