libsystemd-journal 1.0.0 → 1.1.0
raw patch · 4 files changed
+407/−164 lines, 4 filesdep +bytestringdep +pipesdep +pipes-safebuild-type:Custom
Dependencies added: bytestring, pipes, pipes-safe, transformers, uniplate
Files
- Changelog.md +6/−0
- libsystemd-journal.cabal +3/−3
- src/Systemd/Journal.hs +0/−161
- src/Systemd/Journal.hsc +398/−0
Changelog.md view
@@ -1,3 +1,9 @@+# 1.1.0++* It is now possible to read the journal.+* Additionally, a lot of types/functions have changed their name from talking+ about logging to talking about sending messages to the journal.+ # 1.0.0 * Initial version, supporting structured logging to the journal.
libsystemd-journal.cabal view
@@ -1,5 +1,5 @@ name: libsystemd-journal-version: 1.0.0+version: 1.1.0 synopsis: Haskell bindings to libsystemd-journal homepage: http://github.com/ocharles/libsystemd-journal license: BSD3@@ -8,7 +8,7 @@ maintainer: ollie@ocharles.org.uk copyright: Oliver Charles (c) 2014 category: System-build-type: Simple+build-type: Custom cabal-version: >=1.10 extra-source-files:@@ -16,7 +16,7 @@ library exposed-modules: Systemd.Journal- build-depends: base >=4.6 && <4.7, text >= 0.1 && < 1.2, unix-bytestring >= 0.3.2 && < 0.4, vector >= 0.4 && < 0.11, uuid, unordered-containers >= 0.1 && < 0.3, hashable >= 1.1.2.5, hsyslog+ build-depends: base >=4.6 && <4.7, bytestring >= 0.9.1, pipes >= 4.0, pipes-safe >= 2.0, text >= 0.1 && < 1.2, transformers >= 0.3, unix-bytestring >= 0.3.2 && < 0.4, vector >= 0.4 && < 0.11, uuid, unordered-containers >= 0.1 && < 0.3, hashable >= 1.1.2.5, hsyslog, uniplate >= 1.6 hs-source-dirs: src default-language: Haskell2010 extra-libraries: systemd-journal
− src/Systemd/Journal.hs
@@ -1,161 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-}-module Systemd.Journal- ( -- * Logging- logMessage- , logMessageWith- , logProperties-- -- * Log Properties- , LogProperties-- -- ** Standard systemd log properties- , message- , messageId- , priority- , Syslog.Priority(..)- , codeFile- , codeLine- , codeFunc- , errno- , syslogFacility- , syslogIdentifier- , syslogPid-- -- ** Custom Properties- , LogKey- , mkLogKey- ) where--import Control.Monad (void)-import Data.Char (toUpper)-import Data.Data (Data)-import Data.Hashable (Hashable)-import Data.Monoid (Monoid, mappend)-import Data.String (IsString (..))-import Data.Typeable (Typeable)-import Foreign (Ptr, throwIfNeg)-import System.Posix.Types (CPid(..))--import qualified Data.HashMap.Strict as HashMap-import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text-import qualified Data.UUID as UUID-import qualified Data.Vector.Storable as V-import qualified System.Posix.Syslog as Syslog-import qualified System.Posix.Types.Iovec as Iovec-----------------------------------------------------------------------------------foreign import ccall "sd_journal_sendv"- sdJournalSendV :: Ptr Iovec.CIovec -> Int -> IO Int-----------------------------------------------------------------------------------newtype LogKey = LogKey Text.Text- deriving (Eq, Data, Hashable, Ord, Read, Show, Typeable, Monoid)--instance IsString LogKey where- fromString = LogKey . Text.pack . map toUpper------------------------------------------------------------------------------------- | Construct a 'LogKey' by converting to uppercase, as required by the--- journal.-mkLogKey :: Text.Text -> LogKey-mkLogKey = LogKey . Text.toUpper------------------------------------------------------------------------------------- | A structured object of properties to log. You generally don't construct--- this yourself, but you use the monoid instance and smart constructors below.--- For example,------ > logProperties (message "Oh god, it burns!" <> priority Emergency)-type LogProperties = HashMap.HashMap LogKey Text.Text------------------------------------------------------------------------------------- | The human readable message string for this entry. This is supposed to be--- the primary text shown to the user. It is usually not translated (but might be--- in some cases), and is not supposed to be parsed for meta data.-message :: Text.Text -> LogProperties-message = HashMap.singleton (LogKey "MESSAGE")------------------------------------------------------------------------------------- | A 128bit message identifier ID for recognizing certain message types, if--- this is desirable. Developers can generate a new ID for this purpose with--- @journalctl --new-id@.-messageId :: UUID.UUID -> LogProperties-messageId =- HashMap.singleton (LogKey "MESSAGE_ID") . Text.pack . UUID.toString------------------------------------------------------------------------------------- | A priority value compatible with syslog's priority concept.-priority :: Syslog.Priority -> LogProperties-priority =- HashMap.singleton (LogKey "PRIORITY") . Text.pack . show . fromEnum------------------------------------------------------------------------------------- | The source code file generating this message.-codeFile :: FilePath -> LogProperties-codeFile =- HashMap.singleton (LogKey "CODE_FILE") . Text.pack------------------------------------------------------------------------------------- | The source code line number generating this message.-codeLine :: Int -> LogProperties-codeLine = HashMap.singleton (LogKey "CODE_LINE") . Text.pack . show------------------------------------------------------------------------------------- | The source code function name generating this message.-codeFunc :: Text.Text -> LogProperties-codeFunc = HashMap.singleton (LogKey "CODE_FUNC")------------------------------------------------------------------------------------- | The low-level Unix error number causing this entry, if any. Contains the--- numeric value of @errno(3)@.-errno :: Int -> LogProperties-errno = HashMap.singleton (LogKey "ERRNO") . Text.pack . show------------------------------------------------------------------------------------- | Syslog compatibility field.-syslogFacility :: Syslog.Facility -> LogProperties-syslogFacility =- HashMap.singleton (LogKey "SYSLOG_FACILITY") . Text.pack . show . fromEnum------------------------------------------------------------------------------------- | Syslog compatibility field.-syslogIdentifier :: Text.Text -> LogProperties-syslogIdentifier =- HashMap.singleton (LogKey "SYSLOG_IDENTIFIER")------------------------------------------------------------------------------------- | Syslog compatibility field.-syslogPid :: CPid -> LogProperties-syslogPid (CPid pid) =- HashMap.singleton (LogKey "SYSLOG_PID") (Text.pack $ show pid)------------------------------------------------------------------------------------- | Log a message to the systemd journal.-logMessage :: Text.Text -> IO ()-logMessage = logProperties . message------------------------------------------------------------------------------------- | Log a message and supply extra metadata. All metadata keys will be--- converted to uppercase for you.------ Note: The 'Message' meta-data property will be replaced with the first--- parameter to this function. If you don't want this, use 'logMap'-logMessageWith :: Text.Text -> LogProperties -> IO ()-logMessageWith text meta = logProperties $ mappend meta $ message text-----------------------------------------------------------------------------------logProperties :: LogProperties -> IO ()-logProperties meta = void $- throwIfNeg (("sd_journal_send returned :" ++) . show) $- go id 0 (HashMap.toList meta)-- where- go f n [] = V.unsafeWith (V.fromList (f [])) $ \iovecs ->- sdJournalSendV iovecs n-- go f n ((LogKey k, v) : xs) =- Iovec.unsafeUseAsCIovec (Text.encodeUtf8 (Text.intercalate "=" [k, v])) $- \messageIovec -> go (f . (++ [messageIovec])) (n + 1) xs
+ src/Systemd/Journal.hsc view
@@ -0,0 +1,398 @@+#include <systemd/sd-journal.h>++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+module Systemd.Journal+ ( -- * Writing to the journal+ sendMessage+ , sendMessageWith+ , sendJournalFields++ , JournalFields++ -- ** Standard systemd journal fields+ , message+ , messageId+ , priority+ , Syslog.Priority(..)+ , codeFile+ , codeLine+ , codeFunc+ , errno+ , syslogFacility+ , syslogIdentifier+ , syslogPid++ -- ** Custom journal fields+ , JournalField+ , mkJournalField++ -- * Reading the journal+ , openJournal+ , Start(..)+ , JournalEntry, JournalEntryCursor+ , journalEntryFields, journalEntryCursor+ , JournalFlag (..)+ , Filter (..)+ ) where++import Control.Applicative+import Control.Monad (when, void)+import Control.Monad.IO.Class (liftIO)+import Data.Bits ((.|.))+import Data.Char (ord, toUpper)+import Data.Data (Data)+import Data.Foldable (for_)+import Data.Hashable (Hashable)+import Data.Int+import Data.List (foldl')+import Data.Monoid (Monoid, mappend, mempty)+import Data.String (IsString (..))+import Data.Typeable (Typeable)+import Data.Word+import Foreign (Ptr, alloca, free, peek, throwIfNeg)+import Foreign.C (CString, peekCString)+import System.Posix.Types (CPid(..))++import Data.Generics.Uniplate.Data ()++import qualified Data.ByteString as BS+import qualified Data.Generics.Uniplate.Operations as Uniplate+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import qualified Data.UUID as UUID+import qualified Data.Vector.Storable as V+import qualified Pipes as Pipes+import qualified Pipes.Safe as Pipes+import qualified System.Posix.Syslog as Syslog+import qualified System.Posix.Types.Iovec as Iovec++--------------------------------------------------------------------------------+foreign import ccall "sd_journal_sendv"+ sdJournalSendV :: Ptr Iovec.CIovec -> Int -> IO Int++--------------------------------------------------------------------------------+newtype JournalField = JournalField Text.Text+ deriving (Eq, Data, Hashable, Ord, Read, Show, Typeable, Monoid)++instance IsString JournalField where+ fromString = JournalField . Text.pack . map toUpper++--------------------------------------------------------------------------------+-- | Construct a 'JournalField' by converting to uppercase, as required by the+-- journal.+mkJournalField :: Text.Text -> JournalField+mkJournalField = JournalField . Text.toUpper++--------------------------------------------------------------------------------+-- | A structured object of all the fields in an entry in the journal. You+-- generally don't construct this yourself, but you use the monoid instance and+-- smart constructors below.+--+-- For example,+--+-- > sendJournalFields (message "Oh god, it burns!" <> priority Emergency)+type JournalFields = HashMap.HashMap JournalField BS.ByteString++--------------------------------------------------------------------------------+-- | The human readable message string for this entry. This is supposed to be+-- the primary text shown to the user. It is usually not translated (but might be+-- in some cases), and is not supposed to be parsed for meta data.+message :: Text.Text -> JournalFields+message = HashMap.singleton (JournalField "MESSAGE") . Text.encodeUtf8++--------------------------------------------------------------------------------+-- | A 128bit message identifier ID for recognizing certain message types, if+-- this is desirable. Developers can generate a new ID for this purpose with+-- @journalctl --new-id@.+messageId :: UUID.UUID -> JournalFields+messageId =+ HashMap.singleton (JournalField "MESSAGE_ID") . Text.encodeUtf8 . Text.pack . UUID.toString++--------------------------------------------------------------------------------+-- | A priority value compatible with syslog's priority concept.+priority :: Syslog.Priority -> JournalFields+priority =+ HashMap.singleton (JournalField "PRIORITY") . Text.encodeUtf8 . Text.pack . show . fromEnum++--------------------------------------------------------------------------------+-- | The source code file generating this message.+codeFile :: FilePath -> JournalFields+codeFile =+ HashMap.singleton (JournalField "CODE_FILE") . Text.encodeUtf8 . Text.pack++--------------------------------------------------------------------------------+-- | The source code line number generating this message.+codeLine :: Int -> JournalFields+codeLine = HashMap.singleton (JournalField "CODE_LINE") . Text.encodeUtf8 . Text.pack . show++--------------------------------------------------------------------------------+-- | The source code function name generating this message.+codeFunc :: Text.Text -> JournalFields+codeFunc = HashMap.singleton (JournalField "CODE_FUNC") . Text.encodeUtf8++--------------------------------------------------------------------------------+-- | The low-level Unix error number causing this entry, if any. Contains the+-- numeric value of @errno(3)@.+errno :: Int -> JournalFields+errno = HashMap.singleton (JournalField "ERRNO") . Text.encodeUtf8 . Text.pack . show++--------------------------------------------------------------------------------+-- | Syslog compatibility field.+syslogFacility :: Syslog.Facility -> JournalFields+syslogFacility =+ HashMap.singleton (JournalField "SYSLOG_FACILITY") . Text.encodeUtf8 . Text.pack . show . fromEnum++--------------------------------------------------------------------------------+-- | Syslog compatibility field.+syslogIdentifier :: Text.Text -> JournalFields+syslogIdentifier =+ HashMap.singleton (JournalField "SYSLOG_IDENTIFIER") . Text.encodeUtf8++--------------------------------------------------------------------------------+-- | Syslog compatibility field.+syslogPid :: CPid -> JournalFields+syslogPid (CPid pid) =+ HashMap.singleton (JournalField "SYSLOG_PID") (Text.encodeUtf8 $ Text.pack $ show pid)++--------------------------------------------------------------------------------+-- | Send a message to the systemd journal.+--+-- > sendMessage t == sendJournalFields (message t)+sendMessage :: Text.Text -> IO ()+sendMessage = sendJournalFields . message++--------------------------------------------------------------------------------+-- | Send a message and supply extra fields.+--+-- Note: The @MESSAGE@ field will be replaced with the first parameter to this+-- function. If you don't want this, use 'sendJournalFields'+sendMessageWith :: Text.Text -> JournalFields -> IO ()+sendMessageWith text meta = sendJournalFields $ mappend meta $ message text++--------------------------------------------------------------------------------+-- | Send an exact set of fields to the systemd journal.+sendJournalFields :: JournalFields -> IO ()+sendJournalFields meta = void $+ throwIfNeg (("sd_journal_send returned :" ++) . show) $+ go id 0 (HashMap.toList meta)++ where+ go f n [] = V.unsafeWith (V.fromList (f [])) $ \iovecs ->+ sdJournalSendV iovecs n++ go f n ((k, v) : xs) =+ Iovec.unsafeUseAsCIovec (encodeKv k v) $+ \messageIovec -> go (f . (++ [messageIovec])) (n + 1) xs++--------------------------------------------------------------------------------+encodeKv :: JournalField -> BS.ByteString -> BS.ByteString+encodeKv (JournalField k) v =+ Text.encodeUtf8 k `mappend` BS.singleton (fromIntegral $ ord '=') `mappend` v++--------------------------------------------------------------------------------+foreign import ccall "sd_journal_open"+ sdJournalOpen :: Ptr (Ptr JournalEntry) -> #{type int} -> IO Int++foreign import ccall "sd_journal_enumerate_data"+ sdJournalEnumerateData :: Ptr JournalEntry -> Ptr CString -> Ptr #{type size_t} -> IO #{type int}++foreign import ccall "sd_journal_next"+ sdJournalNext :: Ptr JournalEntry -> IO Int++foreign import ccall "sd_journal_add_match"+ sdJournalAddMatch :: Ptr JournalEntry -> Ptr a -> #{type size_t} -> IO Int++foreign import ccall "sd_journal_add_conjunction"+ sdJournalAddConjunction :: Ptr JournalEntry -> IO Int++foreign import ccall "sd_journal_add_disjunction"+ sdJournalAddDisjunction :: Ptr JournalEntry -> IO Int++foreign import ccall "sd_journal_close"+ sdJournalClose :: Ptr JournalEntry -> IO ()++foreign import ccall "sd_journal_get_cursor"+ sdJournalGetCursor :: Ptr JournalEntry -> Ptr CString -> IO ()++foreign import ccall "sd_journal_seek_cursor"+ sdJournalSeekCursor :: Ptr JournalEntry -> CString -> IO #{type int}++foreign import ccall "sd_journal_seek_tail"+ sdJournalSeekTail :: Ptr JournalEntry -> IO #{type int}++foreign import ccall "sd_journal_previous_skip"+ sdJournalPreviousSkip :: Ptr JournalEntry -> #{type uint64_t} -> IO #{type int}++foreign import ccall "sd_journal_wait"+ sdJournalWait :: Ptr JournalEntry -> #{type uint64_t} -> IO #{type int}++foreign import ccall "strerror" c'strerror+ :: #{type int} -> IO CString++--------------------------------------------------------------------------------+-- | Flags to specify which journal entries to read.+data JournalFlag+ = LocalOnly+ -- ^ Only journal files generated on the local machine will be opened.+ | RuntimeOnly+ -- ^ Only volatile journal files will be opened, excluding those which are+ -- stored on persistent storage.+ | SystemOnly+ -- ^ Only journal files of system services and the kernel (in opposition to+ -- user session processes) will be opened.+ deriving (Bounded, Enum, Eq, Ord)++--------------------------------------------------------------------------------+type JournalEntryCursor = BS.ByteString++--------------------------------------------------------------------------------+-- | An entry that has been read from the systemd journal.+data JournalEntry = JournalEntry+ { journalEntryFields :: JournalFields+ -- ^ A map of each 'JournalField' to its value.++ , journalEntryCursor :: JournalEntryCursor+ -- ^ A 'JournalCursor' can be used as marker into the journal stream. This can+ -- be used to re-open the journal at a specific point in the future, and+ -- 'JournalCursor's can be serialized to disk.+ }+ deriving (Eq, Show)++--------------------------------------------------------------------------------+-- | A logical expression to filter journal entries when reading the journal.+data Filter+ = Match JournalField BS.ByteString+ -- ^ A binary exact match on a given 'JournalField'.+ | And Filter Filter+ -- ^ Logical conjunction of two filters. Will only show journal entries that+ -- satisfy both conditions.+ | Or Filter Filter+ -- ^ Logical disjunction of two filters. Will show journal entries that+ -- satisfy either condition.+ deriving (Data, Eq, Show, Typeable)++--------------------------------------------------------------------------------+-- | Where to begin reading the journal from.+data Start+ = FromStart+ -- ^ Begin reading from the start of the journal.+ | FromEnd+ -- ^ Begin reading from the end of the journal.+ | FromCursor JournalEntryCursor+ -- ^ From a 'JournalEntryCursor'.++--------------------------------------------------------------------------------+-- | Opens the journal for reading, optionally filtering the journal entries.+-- Filters are defined as arbitrary binary expression trees, which are then+-- rewritten to be in conjunctive normal form before filtering with systemd+-- to comply with systemd's rule system.+openJournal+ :: Pipes.MonadSafe m+ => [JournalFlag]+ -- ^ A list of flags taken under logical disjunction (or) to specify which+ -- journal files to open.+ -> Start+ -- ^ Where to begin reading journal entries from.+ -> Maybe Filter+ -- ^ An optional filter to apply the journal. Only entries satisfying the+ -- filter will be emitted.+ -> Pipes.Producer' JournalEntry m ()+openJournal flags start journalFilter =+ Pipes.bracket (liftIO openJournalPtr) (liftIO . sdJournalClose) go++ where+ openJournalPtr = do+ journalPtr <- alloca $ \journalPtrPtr -> do+ _ <- throwIfNeg (("sdl_journal_open returned: " ++) . show) $+ sdJournalOpen journalPtrPtr encodedJournalFlags+ peek journalPtrPtr++ for_ journalFilter $ applyFilter journalPtr++ case start of+ FromStart ->+ return ()++ FromEnd -> void $ do+ throwIfNeg (("sd_journal_seek_tail: " ++) . show) $+ sdJournalSeekTail journalPtr+ throwIfNeg (("sd_journal_previous_skip" ++) . show) $+ sdJournalPreviousSkip journalPtr 1++ FromCursor cursor -> void $+ BS.useAsCString cursor (sdJournalSeekCursor journalPtr)++ return journalPtr++ encodedJournalFlags = foldl' (.|.) 0 (map encodeJournalFlag flags)++ applyFilter journalPtr =+ let cnf (Or a (And b c)) = And (Or a b) (Or a c)+ cnf (Or (And a b) c) = And (Or a c) (Or b c)+ cnf x = x++ addRule (And l r) = addRule l >> sdJournalAddConjunction journalPtr >> addRule r+ addRule (Or l r) = addRule l >> sdJournalAddDisjunction journalPtr >> addRule r+ addRule (Match k v) = BS.useAsCStringLen (encodeKv k v) $ \(ptr, len) ->+ sdJournalAddMatch journalPtr ptr (fromIntegral len)++ in addRule . Uniplate.transform cnf++ go journalPtr = do+ let readField =+ alloca $ \dataPtrPtr ->+ alloca $ \lengthPtr -> do+ ret <- sdJournalEnumerateData journalPtr dataPtrPtr lengthPtr+ if ret == 0+ then return Nothing+ else if ret < 0+ then c'strerror (negate ret) >>= peekCString+ >>= error . ("sd_journal_enumerate_data: " ++)+ else do dataPtr <- peek dataPtrPtr+ dataLength <- peek lengthPtr+ Just <$> BS.packCStringLen (dataPtr, fromIntegral $ dataLength)++ readFields acc = do+ field <- readField+ case field of+ Just f ->+ let (fieldName, fieldValue) =+ BS.breakByte (fromIntegral $ ord '=') f+ in readFields+ (HashMap.insert+ (JournalField $ Text.decodeUtf8 fieldName)+ (BS.tail fieldValue)+ acc)++ Nothing -> return acc++ progressedBy <- liftIO (sdJournalNext journalPtr)++ case compare progressedBy 0 of+ GT -> do+ entry <- liftIO $ JournalEntry+ <$> readFields mempty+ <*> (alloca $ \cursorStrPtr -> do+ sdJournalGetCursor journalPtr cursorStrPtr+ cursorCString <- peek cursorStrPtr+ BS.packCString cursorCString <* free cursorCString)++ Pipes.yield entry++ go journalPtr++ EQ -> do+ liftIO $ sdJournalWait journalPtr (-1)+ go journalPtr++ LT -> error $ "sd_journal_next: " ++ show progressedBy++--------------------------------------------------------------------------------+encodeJournalFlag :: JournalFlag -> #{type int}+encodeJournalFlag LocalOnly = #{const SD_JOURNAL_LOCAL_ONLY}+encodeJournalFlag RuntimeOnly = #{const SD_JOURNAL_RUNTIME_ONLY}+encodeJournalFlag SystemOnly = #{const SD_JOURNAL_SYSTEM_ONLY}