├── .gitignore ├── BUILDING ├── Changelog.md ├── LICENSE ├── default.nix ├── flake.lock ├── flake.nix ├── libsystemd-journal.cabal ├── nix ├── default.nix ├── disabled-haskell-tests.nix ├── ghc-with-packages.nix ├── haskell-package-overrides.nix ├── haskell-package-selection.nix └── shell.nix ├── readme.md ├── shell.nix └── src └── Systemd └── Journal.hsc /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | dist/ 3 | dist-newstyle/ 4 | -------------------------------------------------------------------------------- /BUILDING: -------------------------------------------------------------------------------- 1 | 2 | ## Building with GHC 8.6.5 3 | 4 | $> nix-shell -p systemd.dev pkg-config haskell.compiler.ghc865 5 | 6 | and set the compiler in `cabal.project.local` 7 | 8 | 9 | ## Building with GHC 8.10.2 10 | 11 | $> nix-shell -p systemd.dev pkg-config haskell.compiler.ghc8102 12 | 13 | and set the compiler in `cabal.project.local` 14 | -------------------------------------------------------------------------------- /Changelog.md: -------------------------------------------------------------------------------- 1 | # 1.4.6.0 2 | 3 | * Support GHC 9.10 4 | 5 | # 1.4.5.1 6 | 7 | * Miscellaneous cleanup 8 | * Adjusted a number of dependency bounds 9 | * Supported GHC range is now 9.2 to 9.6 10 | 11 | Published by: Chris Martin 12 | 13 | Date: 2023-08-16 14 | 15 | # 1.4.5 16 | 17 | * Updated `base` upper bound to be compatible with GHC 8.8 and 8.10 (#21) 18 | * Fixed a warning (#20) 19 | 20 | Published by: Oliver Charles 21 | 22 | Date: 2020-09-24 23 | 24 | # 1.4.4 25 | 26 | * Updated `base` upper bound and compatibility with GHC 8.6 27 | * Updated `semigroup` upper bound. 28 | 29 | Published by: Oliver Charles 30 | 31 | Date: 2019-05-15 32 | 33 | # 1.4.3 34 | 35 | * Updated `base` upper bound and compatibility with GHC 8.4 36 | 37 | Published by: Oliver Charles 38 | 39 | Date: 2018-05-01 40 | 41 | # 1.4.2 42 | 43 | * Updated `base` upper bound 44 | 45 | Published by: Oliver Charles 46 | 47 | Date: 2017-07-24 48 | 49 | # 1.4.1 50 | 51 | * Updated `base` upper bound 52 | 53 | Published by: Oliver Charles 54 | 55 | Date: 2017-01-09 56 | 57 | # 1.4.0 58 | 59 | * Added the ability to read the journal backwards as well as forwards. Thanks to 60 | @defanor for this change. 61 | 62 | Published by: Oliver Charles 63 | 64 | Date: 2015-09-15 65 | 66 | # 1.3.4 67 | 68 | * Added the `journalEntryRealtime` property to `JournalEntry`s. This is backed by a call to 69 | `sd_journal_get_realtime_usec`. Thanks to @rickynils for this change. 70 | * Build with `vector` < 0.12. 71 | 72 | Published by: Oliver Charles 73 | 74 | Date: 2015-09-10 75 | 76 | # 1.3.3 77 | 78 | * Added `journalField :: JournalField -> Text`, to view the name of a `JournalField` as `Text`. 79 | Thanks to @rickynils. 80 | * Addressed a deprecation warning from `bytestring`. 81 | 82 | Published by: Oliver Charles 83 | 84 | Date: 2015-07-19 85 | 86 | # 1.3.2 87 | 88 | * Increase the upper-bound of `base`. 89 | 90 | Published by: Oliver Charles 91 | 92 | # 1.3.1 93 | 94 | * Increase the upper-bound of `text` to < 1.3. 95 | 96 | Published by: Oliver Charles 97 | 98 | Date: 2015-01-15 99 | 100 | # 1.3.0 101 | 102 | * Now depends on `systemd >= 209`. These versions of `systemd` feature the 103 | `journald` functions in the `systemd` library. 104 | 105 | Published by: Oliver Charles 106 | 107 | Date: 2014-12-31 108 | 109 | # 1.2.0 110 | 111 | * Builds with base 4.7 112 | * `openJournal` now takes an optional threshold parameter. Thanks Shea Levy 113 | (@shlevy). 114 | 115 | Published by: Oliver Charles 116 | 117 | Date: 2014-05-08 118 | 119 | # 1.1.0 120 | 121 | * It is now possible to read the journal. 122 | * Additionally, a lot of types/functions have changed their name from talking 123 | about logging to talking about sending messages to the journal. 124 | 125 | Published by: Oliver Charles 126 | 127 | Date: 2014-02-08 128 | 129 | # 1.0.0 130 | 131 | * Initial version, supporting structured logging to the journal. 132 | 133 | Published by: Oliver Charles 134 | 135 | Date: 2014-02-05 136 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2014, Oliver Charles 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Oliver Charles nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | { mkDerivation, base, bytestring, hashable, hsyslog, pipes 2 | , pipes-safe, stdenv, systemd, text, transformers, uniplate 3 | , unix-bytestring, unordered-containers, uuid, vector 4 | }: 5 | mkDerivation { 6 | pname = "libsystemd-journal"; 7 | version = "1.3.1"; 8 | src = ./.; 9 | buildDepends = [ 10 | base bytestring hashable hsyslog pipes pipes-safe text transformers 11 | uniplate unix-bytestring unordered-containers uuid vector 12 | ]; 13 | pkgconfigDepends = [ systemd ]; 14 | homepage = "http://github.com/ocharles/libsystemd-journal"; 15 | description = "Haskell bindings to libsystemd-journal"; 16 | license = stdenv.lib.licenses.bsd3; 17 | } 18 | -------------------------------------------------------------------------------- /flake.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "flake-utils": { 4 | "inputs": { 5 | "systems": "systems" 6 | }, 7 | "locked": { 8 | "lastModified": 1689068808, 9 | "narHash": "sha256-6ixXo3wt24N/melDWjq70UuHQLxGV8jZvooRanIHXw0=", 10 | "owner": "numtide", 11 | "repo": "flake-utils", 12 | "rev": "919d646de7be200f3bf08cb76ae1f09402b6f9b4", 13 | "type": "github" 14 | }, 15 | "original": { 16 | "owner": "numtide", 17 | "repo": "flake-utils", 18 | "type": "github" 19 | } 20 | }, 21 | "root": { 22 | "inputs": { 23 | "flake-utils": "flake-utils", 24 | "stable": "stable", 25 | "unstable": "unstable" 26 | } 27 | }, 28 | "stable": { 29 | "locked": { 30 | "lastModified": 1692134936, 31 | "narHash": "sha256-Z68O969cioC6I3k/AFBxsuEwpJwt4l9fzwuAMUhCCs0=", 32 | "owner": "nixos", 33 | "repo": "nixpkgs", 34 | "rev": "bfd953b2c6de4f550f75461bcc5768b6f966be10", 35 | "type": "github" 36 | }, 37 | "original": { 38 | "owner": "nixos", 39 | "ref": "nixos-23.05", 40 | "repo": "nixpkgs", 41 | "type": "github" 42 | } 43 | }, 44 | "systems": { 45 | "locked": { 46 | "lastModified": 1681028828, 47 | "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", 48 | "owner": "nix-systems", 49 | "repo": "default", 50 | "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", 51 | "type": "github" 52 | }, 53 | "original": { 54 | "owner": "nix-systems", 55 | "repo": "default", 56 | "type": "github" 57 | } 58 | }, 59 | "unstable": { 60 | "locked": { 61 | "lastModified": 1692174805, 62 | "narHash": "sha256-xmNPFDi/AUMIxwgOH/IVom55Dks34u1g7sFKKebxUm0=", 63 | "owner": "nixos", 64 | "repo": "nixpkgs", 65 | "rev": "caac0eb6bdcad0b32cb2522e03e4002c8975c62e", 66 | "type": "github" 67 | }, 68 | "original": { 69 | "owner": "nixos", 70 | "ref": "nixos-unstable", 71 | "repo": "nixpkgs", 72 | "type": "github" 73 | } 74 | } 75 | }, 76 | "root": "root", 77 | "version": 7 78 | } 79 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | inputs = { 3 | stable.url = "github:nixos/nixpkgs/nixos-23.05"; 4 | unstable.url = "github:nixos/nixpkgs/nixos-unstable"; 5 | flake-utils.url = "github:numtide/flake-utils"; 6 | }; 7 | outputs = inputs: 8 | inputs.flake-utils.lib.eachDefaultSystem (system: 9 | let 10 | nixpkgsArgs = { inherit system; config = { }; }; 11 | 12 | nixpkgs = { 13 | stable = import inputs.stable nixpkgsArgs; 14 | unstable = import inputs.unstable nixpkgsArgs; 15 | }; 16 | 17 | in 18 | { 19 | devShells.default = import ./nix/shell.nix { inherit nixpkgs system; }; 20 | packages = import ./nix { inherit nixpkgs; }; 21 | }); 22 | } 23 | -------------------------------------------------------------------------------- /libsystemd-journal.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | 3 | name: libsystemd-journal 4 | version: 1.4.6.0 5 | synopsis: Haskell bindings to libsystemd-journal 6 | homepage: https://github.com/ocharles/libsystemd-journal 7 | license: BSD-3-Clause 8 | license-file: LICENSE 9 | author: Oliver Charles 10 | maintainer: ch.martin@gmail.com, ollie@ocharles.org.uk 11 | copyright: Oliver Charles (c) 2014 12 | category: Logging 13 | 14 | description: 15 | Use this package to write to and read from journald. This is the 16 | logging system that is part of systemd, which you may be familiar 17 | with accessing via the command line using the journalctl command. 18 | 19 | extra-source-files: 20 | Changelog.md 21 | 22 | library 23 | exposed-modules: Systemd.Journal 24 | build-depends: , base ^>= 4.16 || ^>= 4.17 || ^>= 4.18 || ^>= 4.19 || ^>= 4.20 || ^>= 4.21 25 | , bytestring ^>= 0.11.1 || ^>= 0.12 26 | , pipes ^>= 4.3.10 27 | , pipes-safe ^>= 2.3.1 28 | , text ^>= 1.2.5 || ^>= 2.0 || ^>= 2.1 29 | , transformers ^>= 0.5.6 || ^>= 0.6 30 | , unix-bytestring ^>= 0.3.6 || ^>= 0.4 31 | , vector ^>= 0.12.3 || ^>= 0.13 32 | , uuid ^>= 1.3.13 33 | , unordered-containers ^>= 0.2.10 34 | , hashable ^>= 1.3.2 || ^>= 1.4 || ^>= 1.5 35 | , hsyslog ^>= 5.0 36 | , uniplate ^>= 1.6.1 37 | , semigroups ^>= 0.18.1 || ^>= 0.19 || ^>= 0.20 38 | hs-source-dirs: src 39 | default-language: GHC2021 40 | default-extensions: OverloadedStrings 41 | pkgconfig-depends: libsystemd >= 209 42 | -------------------------------------------------------------------------------- /nix/default.nix: -------------------------------------------------------------------------------- 1 | { nixpkgs }: 2 | { 3 | ghc-with-packages = import ./ghc-with-packages.nix { inherit nixpkgs; }; 4 | } 5 | -------------------------------------------------------------------------------- /nix/disabled-haskell-tests.nix: -------------------------------------------------------------------------------- 1 | /* 2 | 3 | These are overrides for Haskell packages that are marked as broken in nixpkgs 4 | solely because their tests fail. The test failures are typically just because 5 | the tests don't work in a pure nix environment, and so here we override them by 6 | skipping the tests and marking the package as not broken. 7 | 8 | */ 9 | { nixpkgs }: 10 | let 11 | list = [ 12 | # list of string package names, currently empty 13 | ]; 14 | inherit (builtins) map listToAttrs; 15 | inherit (nixpkgs.stable.haskell.lib) overrideCabal; 16 | in 17 | 18 | self: super: 19 | listToAttrs ( 20 | map 21 | (name: { 22 | inherit name; 23 | value = overrideCabal super.${name} 24 | (drv: { doCheck = false; broken = false; }); 25 | }) 26 | list 27 | ) 28 | -------------------------------------------------------------------------------- /nix/ghc-with-packages.nix: -------------------------------------------------------------------------------- 1 | /* 2 | 3 | This package contains GHC and a bunch of Haskell packages. 4 | 5 | */ 6 | { nixpkgs }: 7 | let 8 | haskellPackages = nixpkgs.stable.haskellPackages.override { 9 | inherit (nixpkgs.unstable) all-cabal-hashes; 10 | overrides = import ./haskell-package-overrides.nix 11 | { inherit nixpkgs; }; 12 | }; 13 | in 14 | haskellPackages.ghcWithPackages (import ./haskell-package-selection.nix) 15 | -------------------------------------------------------------------------------- /nix/haskell-package-overrides.nix: -------------------------------------------------------------------------------- 1 | { nixpkgs }: 2 | let 3 | inherit (nixpkgs.stable.lib) fold composeExtensions; 4 | in 5 | fold composeExtensions (_: _: { }) [ 6 | (self: super: { 7 | # e.g. 8 | # asana = super.callHackage "asana" "1.0.1.0" { }; 9 | }) 10 | (import ./disabled-haskell-tests.nix { inherit nixpkgs; }) 11 | ] 12 | -------------------------------------------------------------------------------- /nix/haskell-package-selection.nix: -------------------------------------------------------------------------------- 1 | p: with p; [ 2 | bytestring 3 | pipes 4 | pipes-safe 5 | text 6 | transformers 7 | unix-bytestring 8 | vector 9 | uuid 10 | unordered-containers 11 | hashable 12 | hsyslog 13 | uniplate 14 | semigroups 15 | ] 16 | -------------------------------------------------------------------------------- /nix/shell.nix: -------------------------------------------------------------------------------- 1 | { nixpkgs, system }: 2 | nixpkgs.stable.mkShell { 3 | name = "libsystemd-journal-shell"; 4 | buildInputs = 5 | with (import ./. { inherit nixpkgs; }); 6 | [ 7 | ghc-with-packages 8 | nixpkgs.stable.cabal-install 9 | nixpkgs.stable.pkg-config-unwrapped 10 | ]; 11 | shellHook = '' 12 | PKG_CONFIG_PATH+=":${nixpkgs.stable.systemd.dev}/lib/pkgconfig" 13 | export PKG_CONFIG_PATH 14 | ''; 15 | } 16 | -------------------------------------------------------------------------------- /readme.md: -------------------------------------------------------------------------------- 1 | When uploading to Hackage, it seems that one needs to upload the documentation 2 | manually: 3 | 4 | ``` 5 | dir=$(mktemp -d dist-docs.XXXXXX) 6 | cabal configure --builddir="$dir" 7 | cabal haddock --builddir="$dir" --haddock-for-hackage --haddock-option=--hyperlinked-source 8 | cabal upload --publish -d $dir/*-docs.tar.gz 9 | ``` 10 | -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | { nixpkgs ? import {}, compiler ? "default", doBenchmark ? false }: 2 | 3 | let 4 | 5 | inherit (nixpkgs) pkgs; 6 | 7 | f = { mkDerivation, base, bytestring, hashable, hsyslog, pipes 8 | , pipes-safe, stdenv, systemd, text, transformers, uniplate 9 | , unix-bytestring, unordered-containers, uuid, vector 10 | }: 11 | mkDerivation { 12 | pname = "libsystemd-journal"; 13 | version = "1.4.2"; 14 | src = ./.; 15 | libraryHaskellDepends = [ 16 | base bytestring hashable hsyslog pipes pipes-safe text transformers 17 | uniplate unix-bytestring unordered-containers uuid vector 18 | ]; 19 | libraryPkgconfigDepends = [ systemd ]; 20 | homepage = "http://github.com/ocharles/libsystemd-journal"; 21 | description = "Haskell bindings to libsystemd-journal"; 22 | license = stdenv.lib.licenses.bsd3; 23 | }; 24 | 25 | haskellPackages = if compiler == "default" 26 | then pkgs.haskellPackages 27 | else pkgs.haskell.packages.${compiler}; 28 | 29 | variant = if doBenchmark then pkgs.haskell.lib.doBenchmark else pkgs.lib.id; 30 | 31 | drv = variant (haskellPackages.callPackage f { inherit (pkgs) systemd; }); 32 | 33 | in 34 | 35 | if pkgs.lib.inNixShell then drv.env else drv 36 | -------------------------------------------------------------------------------- /src/Systemd/Journal.hsc: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | module Systemd.Journal 4 | ( -- * Writing to the journal 5 | sendMessage 6 | , sendMessageWith 7 | , sendJournalFields 8 | 9 | , JournalFields 10 | 11 | -- ** Standard systemd journal fields 12 | , message 13 | , messageId 14 | , priority 15 | , Syslog.Priority(..) 16 | , codeFile 17 | , codeLine 18 | , codeFunc 19 | , errno 20 | , syslogFacility 21 | , syslogIdentifier 22 | , syslogPid 23 | 24 | -- ** Custom journal fields 25 | , JournalField 26 | , mkJournalField 27 | , journalField 28 | 29 | -- * Reading the journal 30 | , openJournal 31 | , Start(..) 32 | , Direction(..) 33 | , JournalEntry, JournalEntryCursor 34 | , journalEntryFields, journalEntryCursor, journalEntryRealtime 35 | , JournalFlag (..) 36 | , Filter (..) 37 | ) where 38 | 39 | import Control.Applicative 40 | import Control.Monad (when, void) 41 | import Control.Monad.IO.Class (liftIO) 42 | import Data.Bits ((.|.)) 43 | import Data.Char (ord, toUpper) 44 | import Data.Data (Data) 45 | import Data.Foldable (for_) 46 | import Data.Hashable (Hashable) 47 | import Data.Int 48 | import Data.List (foldl') 49 | import Data.Monoid (Monoid, mappend, mempty) 50 | import Data.Semigroup (Semigroup) 51 | import Data.String (IsString (..)) 52 | import Data.Typeable (Typeable) 53 | import Data.Word 54 | import Foreign (Ptr, alloca, free, peek, throwIfNeg) 55 | import Foreign.C (CString, peekCString) 56 | import System.Posix.Types (CPid(..)) 57 | 58 | import Data.Generics.Uniplate.Data () 59 | 60 | import qualified Data.ByteString as BS 61 | import qualified Data.Generics.Uniplate.Operations as Uniplate 62 | import qualified Data.HashMap.Strict as HashMap 63 | import qualified Data.Text as Text 64 | import qualified Data.Text.Encoding as Text 65 | import qualified Data.UUID as UUID 66 | import qualified Data.Vector.Storable as V 67 | import qualified Pipes as Pipes 68 | import qualified Pipes.Safe as Pipes 69 | import qualified System.Posix.Syslog as Syslog 70 | import qualified System.Posix.Types.Iovec as Iovec 71 | 72 | -------------------------------------------------------------------------------- 73 | foreign import ccall "sd_journal_sendv" 74 | sdJournalSendV :: Ptr Iovec.CIovec -> Int -> IO Int 75 | 76 | -------------------------------------------------------------------------------- 77 | newtype JournalField = JournalField Text.Text 78 | deriving (Eq, Data, Hashable, Ord, Read, Show, Typeable, Monoid, Semigroup) 79 | 80 | instance IsString JournalField where 81 | fromString = JournalField . Text.pack . map toUpper 82 | 83 | -------------------------------------------------------------------------------- 84 | -- | Construct a 'JournalField' by converting to uppercase, as required by the 85 | -- journal. 86 | mkJournalField :: Text.Text -> JournalField 87 | mkJournalField = JournalField . Text.toUpper 88 | 89 | -------------------------------------------------------------------------------- 90 | -- | Extract the name of a 'JournalField'. 91 | journalField :: JournalField -> Text.Text 92 | journalField (JournalField f) = f 93 | 94 | -------------------------------------------------------------------------------- 95 | -- | A structured object of all the fields in an entry in the journal. You 96 | -- generally don't construct this yourself, but you use the monoid instance and 97 | -- smart constructors below. 98 | -- 99 | -- For example, 100 | -- 101 | -- > sendJournalFields (message "Oh god, it burns!" <> priority Emergency) 102 | type JournalFields = HashMap.HashMap JournalField BS.ByteString 103 | 104 | -------------------------------------------------------------------------------- 105 | -- | The human readable message string for this entry. This is supposed to be 106 | -- the primary text shown to the user. It is usually not translated (but might be 107 | -- in some cases), and is not supposed to be parsed for meta data. 108 | message :: Text.Text -> JournalFields 109 | message = HashMap.singleton (JournalField "MESSAGE") . Text.encodeUtf8 110 | 111 | -------------------------------------------------------------------------------- 112 | -- | A 128bit message identifier ID for recognizing certain message types, if 113 | -- this is desirable. Developers can generate a new ID for this purpose with 114 | -- @journalctl --new-id@. 115 | messageId :: UUID.UUID -> JournalFields 116 | messageId = 117 | HashMap.singleton (JournalField "MESSAGE_ID") . Text.encodeUtf8 . Text.pack . UUID.toString 118 | 119 | -------------------------------------------------------------------------------- 120 | -- | A priority value compatible with syslog's priority concept. 121 | priority :: Syslog.Priority -> JournalFields 122 | priority = 123 | HashMap.singleton (JournalField "PRIORITY") . Text.encodeUtf8 . Text.pack . show . fromEnum 124 | 125 | -------------------------------------------------------------------------------- 126 | -- | The source code file generating this message. 127 | codeFile :: FilePath -> JournalFields 128 | codeFile = 129 | HashMap.singleton (JournalField "CODE_FILE") . Text.encodeUtf8 . Text.pack 130 | 131 | -------------------------------------------------------------------------------- 132 | -- | The source code line number generating this message. 133 | codeLine :: Int -> JournalFields 134 | codeLine = HashMap.singleton (JournalField "CODE_LINE") . Text.encodeUtf8 . Text.pack . show 135 | 136 | -------------------------------------------------------------------------------- 137 | -- | The source code function name generating this message. 138 | codeFunc :: Text.Text -> JournalFields 139 | codeFunc = HashMap.singleton (JournalField "CODE_FUNC") . Text.encodeUtf8 140 | 141 | -------------------------------------------------------------------------------- 142 | -- | The low-level Unix error number causing this entry, if any. Contains the 143 | -- numeric value of @errno(3)@. 144 | errno :: Int -> JournalFields 145 | errno = HashMap.singleton (JournalField "ERRNO") . Text.encodeUtf8 . Text.pack . show 146 | 147 | -------------------------------------------------------------------------------- 148 | -- | Syslog compatibility field. 149 | syslogFacility :: Syslog.Facility -> JournalFields 150 | syslogFacility = 151 | HashMap.singleton (JournalField "SYSLOG_FACILITY") . Text.encodeUtf8 . Text.pack . show . fromEnum 152 | 153 | -------------------------------------------------------------------------------- 154 | -- | Syslog compatibility field. 155 | syslogIdentifier :: Text.Text -> JournalFields 156 | syslogIdentifier = 157 | HashMap.singleton (JournalField "SYSLOG_IDENTIFIER") . Text.encodeUtf8 158 | 159 | -------------------------------------------------------------------------------- 160 | -- | Syslog compatibility field. 161 | syslogPid :: CPid -> JournalFields 162 | syslogPid (CPid pid) = 163 | HashMap.singleton (JournalField "SYSLOG_PID") (Text.encodeUtf8 $ Text.pack $ show pid) 164 | 165 | -------------------------------------------------------------------------------- 166 | -- | Send a message to the systemd journal. 167 | -- 168 | -- > sendMessage t == sendJournalFields (message t) 169 | sendMessage :: Text.Text -> IO () 170 | sendMessage = sendJournalFields . message 171 | 172 | -------------------------------------------------------------------------------- 173 | -- | Send a message and supply extra fields. 174 | -- 175 | -- Note: The @MESSAGE@ field will be replaced with the first parameter to this 176 | -- function. If you don't want this, use 'sendJournalFields' 177 | sendMessageWith :: Text.Text -> JournalFields -> IO () 178 | sendMessageWith text meta = sendJournalFields $ mappend meta $ message text 179 | 180 | -------------------------------------------------------------------------------- 181 | -- | Send an exact set of fields to the systemd journal. 182 | sendJournalFields :: JournalFields -> IO () 183 | sendJournalFields meta = void $ 184 | throwIfNeg (("sd_journal_send returned :" ++) . show) $ 185 | go id 0 (HashMap.toList meta) 186 | 187 | where 188 | go f n [] = V.unsafeWith (V.fromList (f [])) $ \iovecs -> 189 | sdJournalSendV iovecs n 190 | 191 | go f n ((k, v) : xs) = 192 | Iovec.unsafeUseAsCIovec (encodeKv k v) $ 193 | \messageIovec -> go (f . (++ [messageIovec])) (n + 1) xs 194 | 195 | -------------------------------------------------------------------------------- 196 | encodeKv :: JournalField -> BS.ByteString -> BS.ByteString 197 | encodeKv (JournalField k) v = 198 | Text.encodeUtf8 k `mappend` BS.singleton (fromIntegral $ ord '=') `mappend` v 199 | 200 | -------------------------------------------------------------------------------- 201 | foreign import ccall "sd_journal_open" 202 | sdJournalOpen :: Ptr (Ptr JournalEntry) -> #{type int} -> IO Int 203 | 204 | foreign import ccall "sd_journal_enumerate_data" 205 | sdJournalEnumerateData :: Ptr JournalEntry -> Ptr CString -> Ptr #{type size_t} -> IO #{type int} 206 | 207 | foreign import ccall "sd_journal_next" 208 | sdJournalNext :: Ptr JournalEntry -> IO Int 209 | 210 | foreign import ccall "sd_journal_previous" 211 | sdJournalPrevious :: Ptr JournalEntry -> IO Int 212 | 213 | foreign import ccall "sd_journal_add_match" 214 | sdJournalAddMatch :: Ptr JournalEntry -> Ptr a -> #{type size_t} -> IO Int 215 | 216 | foreign import ccall "sd_journal_add_conjunction" 217 | sdJournalAddConjunction :: Ptr JournalEntry -> IO Int 218 | 219 | foreign import ccall "sd_journal_add_disjunction" 220 | sdJournalAddDisjunction :: Ptr JournalEntry -> IO Int 221 | 222 | foreign import ccall "sd_journal_close" 223 | sdJournalClose :: Ptr JournalEntry -> IO () 224 | 225 | foreign import ccall "sd_journal_get_cursor" 226 | sdJournalGetCursor :: Ptr JournalEntry -> Ptr CString -> IO () 227 | 228 | foreign import ccall "sd_journal_seek_cursor" 229 | sdJournalSeekCursor :: Ptr JournalEntry -> CString -> IO #{type int} 230 | 231 | foreign import ccall "sd_journal_seek_tail" 232 | sdJournalSeekTail :: Ptr JournalEntry -> IO #{type int} 233 | 234 | foreign import ccall "sd_journal_previous_skip" 235 | sdJournalPreviousSkip :: Ptr JournalEntry -> #{type uint64_t} -> IO #{type int} 236 | 237 | foreign import ccall "sd_journal_wait" 238 | sdJournalWait :: Ptr JournalEntry -> #{type uint64_t} -> IO #{type int} 239 | 240 | foreign import ccall "sd_journal_set_data_threshold" 241 | sdJournalSetDataThreshold :: Ptr JournalEntry -> #{type size_t} -> IO #{type int} 242 | 243 | foreign import ccall "strerror" c'strerror 244 | :: #{type int} -> IO CString 245 | 246 | foreign import ccall "sd_journal_get_realtime_usec" 247 | sdJournalGetRealtimeUsec :: Ptr JournalEntry -> Ptr #{type uint64_t} -> IO #{type int} 248 | 249 | -------------------------------------------------------------------------------- 250 | -- | Flags to specify which journal entries to read. 251 | data JournalFlag 252 | = LocalOnly 253 | -- ^ Only journal files generated on the local machine will be opened. 254 | | RuntimeOnly 255 | -- ^ Only volatile journal files will be opened, excluding those which are 256 | -- stored on persistent storage. 257 | | SystemOnly 258 | -- ^ Only journal files of system services and the kernel (in opposition to 259 | -- user session processes) will be opened. 260 | deriving (Bounded, Enum, Eq, Ord) 261 | 262 | -------------------------------------------------------------------------------- 263 | type JournalEntryCursor = BS.ByteString 264 | 265 | -------------------------------------------------------------------------------- 266 | -- | An entry that has been read from the systemd journal. 267 | data JournalEntry = JournalEntry 268 | { journalEntryFields :: JournalFields 269 | -- ^ A map of each 'JournalField' to its value. 270 | 271 | , journalEntryCursor :: JournalEntryCursor 272 | -- ^ A 'JournalCursor' can be used as marker into the journal stream. This can 273 | -- be used to re-open the journal at a specific point in the future, and 274 | -- 'JournalCursor's can be serialized to disk. 275 | 276 | , journalEntryRealtime :: Word64 277 | -- ^ The time (in microseconds since the epoch) when this journal entry was 278 | -- received by the systemd journal. 279 | } 280 | deriving (Eq, Show) 281 | 282 | -------------------------------------------------------------------------------- 283 | -- | A logical expression to filter journal entries when reading the journal. 284 | data Filter 285 | = Match JournalField BS.ByteString 286 | -- ^ A binary exact match on a given 'JournalField'. 287 | | And Filter Filter 288 | -- ^ Logical conjunction of two filters. Will only show journal entries that 289 | -- satisfy both conditions. 290 | | Or Filter Filter 291 | -- ^ Logical disjunction of two filters. Will show journal entries that 292 | -- satisfy either condition. 293 | deriving (Data, Eq, Show, Typeable) 294 | 295 | 296 | -------------------------------------------------------------------------------- 297 | -- | In which direction to read the journal. 298 | data Direction 299 | = Forwards 300 | -- ^ Read towards the end. 301 | | Backwards 302 | -- ^ Read towards the beginning. 303 | deriving (Eq) 304 | 305 | -------------------------------------------------------------------------------- 306 | -- | Where to begin reading the journal from. 307 | data Start 308 | = FromStart 309 | -- ^ Begin reading from the start of the journal. 310 | | FromEnd Direction 311 | -- ^ Begin reading from the end of the journal. 312 | | FromCursor JournalEntryCursor Direction 313 | -- ^ From a 'JournalEntryCursor'. 314 | 315 | -------------------------------------------------------------------------------- 316 | -- | Opens the journal for reading, optionally filtering the journal entries. 317 | -- Filters are defined as arbitrary binary expression trees, which are then 318 | -- rewritten to be in conjunctive normal form before filtering with systemd 319 | -- to comply with systemd's rule system. 320 | openJournal 321 | :: Pipes.MonadSafe m 322 | => [JournalFlag] 323 | -- ^ A list of flags taken under logical disjunction (or) to specify which 324 | -- journal files to open. 325 | -> Start 326 | -- ^ Where to begin reading journal entries from. 327 | -> Maybe Filter 328 | -- ^ An optional filter to apply the journal. Only entries satisfying the 329 | -- filter will be emitted. 330 | -> Maybe Integer 331 | -- ^ The data field size threshold, or Nothing for no field size limit 332 | -> Pipes.Producer' JournalEntry m () 333 | openJournal flags start journalFilter threshold = 334 | Pipes.bracket (liftIO openJournalPtr) (liftIO . sdJournalClose) go 335 | 336 | where 337 | openJournalPtr = do 338 | journalPtr <- alloca $ \journalPtrPtr -> do 339 | _ <- throwIfNeg (("sdl_journal_open returned: " ++) . show) $ 340 | sdJournalOpen journalPtrPtr encodedJournalFlags 341 | peek journalPtrPtr 342 | 343 | for_ journalFilter $ applyFilter journalPtr 344 | 345 | case start of 346 | FromStart -> 347 | return () 348 | 349 | FromEnd d -> void $ do 350 | throwIfNeg (("sd_journal_seek_tail: " ++) . show) $ 351 | sdJournalSeekTail journalPtr 352 | when (d == Forwards) $ do 353 | throwIfNeg (("sd_journal_previous_skip" ++) . show) $ 354 | sdJournalPreviousSkip journalPtr 1 355 | return () 356 | 357 | FromCursor cursor _ -> void $ 358 | BS.useAsCString cursor (sdJournalSeekCursor journalPtr) 359 | 360 | _ <- throwIfNeg (("sd_journal_set_data_threshold returned: " ++) . show) . 361 | sdJournalSetDataThreshold journalPtr $ case threshold of 362 | Nothing -> fromIntegral (0 :: Integer) 363 | Just n -> fromIntegral n 364 | 365 | return journalPtr 366 | 367 | encodedJournalFlags = foldl' (.|.) 0 (map encodeJournalFlag flags) 368 | 369 | applyFilter journalPtr = 370 | let cnf (Or a (And b c)) = And (Or a b) (Or a c) 371 | cnf (Or (And a b) c) = And (Or a c) (Or b c) 372 | cnf x = x 373 | 374 | addRule (And l r) = addRule l >> sdJournalAddConjunction journalPtr >> addRule r 375 | addRule (Or l r) = addRule l >> sdJournalAddDisjunction journalPtr >> addRule r 376 | addRule (Match k v) = BS.useAsCStringLen (encodeKv k v) $ \(ptr, len) -> 377 | sdJournalAddMatch journalPtr ptr (fromIntegral len) 378 | 379 | in addRule . Uniplate.transform cnf 380 | 381 | 382 | sdJournalDirection :: Direction 383 | sdJournalDirection = case start of 384 | FromStart -> Forwards 385 | FromEnd d -> d 386 | FromCursor _ d -> d 387 | 388 | sdJournalMove :: Ptr JournalEntry -> IO Int 389 | sdJournalMove = if sdJournalDirection == Forwards then sdJournalNext else sdJournalPrevious 390 | 391 | go journalPtr = do 392 | let readField = 393 | alloca $ \dataPtrPtr -> 394 | alloca $ \lengthPtr -> do 395 | ret <- sdJournalEnumerateData journalPtr dataPtrPtr lengthPtr 396 | if ret == 0 397 | then return Nothing 398 | else if ret < 0 399 | then c'strerror (negate ret) >>= peekCString 400 | >>= error . ("sd_journal_enumerate_data: " ++) 401 | else do dataPtr <- peek dataPtrPtr 402 | dataLength <- peek lengthPtr 403 | Just <$> BS.packCStringLen (dataPtr, fromIntegral $ dataLength) 404 | 405 | readFields acc = do 406 | field <- readField 407 | case field of 408 | Just f -> 409 | let (fieldName, fieldValue) = 410 | BS.break (== (fromIntegral $ ord '=')) f 411 | in readFields 412 | (HashMap.insert 413 | (JournalField $ Text.decodeUtf8 fieldName) 414 | (BS.tail fieldValue) 415 | acc) 416 | 417 | Nothing -> return acc 418 | 419 | progressedBy <- liftIO (sdJournalMove journalPtr) 420 | 421 | case compare progressedBy 0 of 422 | GT -> do 423 | entry <- liftIO $ JournalEntry 424 | <$> readFields mempty 425 | <*> (alloca $ \cursorStrPtr -> do 426 | sdJournalGetCursor journalPtr cursorStrPtr 427 | cursorCString <- peek cursorStrPtr 428 | BS.packCString cursorCString <* free cursorCString) 429 | <*> (alloca $ \realtimePtr -> do 430 | sdJournalGetRealtimeUsec journalPtr realtimePtr 431 | peek realtimePtr) 432 | 433 | Pipes.yield entry 434 | 435 | go journalPtr 436 | 437 | EQ -> when (sdJournalDirection == Forwards) $ do 438 | liftIO $ sdJournalWait journalPtr maxBound 439 | go journalPtr 440 | 441 | LT -> error $ "sd_journal_next: " ++ show progressedBy 442 | 443 | -------------------------------------------------------------------------------- 444 | encodeJournalFlag :: JournalFlag -> #{type int} 445 | encodeJournalFlag LocalOnly = #{const SD_JOURNAL_LOCAL_ONLY} 446 | encodeJournalFlag RuntimeOnly = #{const SD_JOURNAL_RUNTIME_ONLY} 447 | encodeJournalFlag SystemOnly = #{const SD_JOURNAL_SYSTEM_ONLY} 448 | --------------------------------------------------------------------------------