hsyslog 4 → 5

raw patch · 12 files changed

+534/−420 lines, 12 filesdep +doctestdep −QuickCheckdep ~basedep ~bytestringnew-component:exe:hsyslog-examplePVP ok

version bump matches the API change (PVP)

Dependencies added: doctest

Dependencies removed: QuickCheck

Dependency ranges changed: base, bytestring

API changes (from Hackage documentation)

Files

• c-bits/make-log-mask.c +6/−0
• c-bits/simple-syslog.c +27/−0
• example/Main.hs +43/−0
• hsyslog.cabal +65/−35
• src/System/Posix/Syslog.hs +115/−0
• src/System/Posix/Syslog.hsc +0/−342
• src/System/Posix/Syslog/Facility.hsc +65/−0
• src/System/Posix/Syslog/Functions.hs +71/−0
• src/System/Posix/Syslog/LogMask.hs +31/−0
• src/System/Posix/Syslog/Options.hsc +44/−0
• src/System/Posix/Syslog/Priority.hsc +61/−0
• test/Main.hs +6/−43

@@ -0,0 +1,6 @@+#include <syslog.h>++int makeLogMask(int priority)+{+  return LOG_MASK(priority);+}

@@ -0,0 +1,27 @@+#include <syslog.h>++/*+   A variant of syslog(3) that provides a simplified API to addresses the+   following issues:++   - Calling variadic functions via FFI kind-of sort-of works, but the Haskell+     standard actually doesn't guarantee it. There is a GHC extension, CApiFFI,+     which addresses this issue, but then that extension isn't part of any+     Haskell standard either.++   - Strings in Haskell are almost never terminated by a \0 byte. We generally+     do know their lengths, though, so it's more convenient to specify an+     explicit maximum field length in the format string via "%.*s" and pass our+     string as an argument to that. An added benefit is that our syslog+     function doesn't interpret any of those freaky % formatting features that+     can't support (and don't want to, really).++   Note that we totally don't make any effort whatsoever to guarantee+   meaningful argument values. If you wan to pass a negative string length,+   null pointers and non-existent  facility values ... be our guest!+ */++void simpleSyslog(int facility, int priority, const char * buf, int len)+{+  syslog(facility | priority, "%.*s", len, buf);+}

@@ -0,0 +1,43 @@+-- These extensions are required so that we can define a class instance for "String".+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}++module Main ( main ) where++import System.Posix.Syslog++import Data.ByteString.Char8 ( ByteString, pack )+import Data.ByteString.Unsafe ( unsafeUseAsCStringLen )+import Foreign.C.String ( CStringLen, withCStringLen )++-- This class allows us to log normal Strings, ByteStrings, and pretty much any+-- other type to syslog without. It abstracts the information of how to convert+-- the given type into a CStringLen that can be passed to syslog.++class LogMessage m where+  toCStringLen :: m -> (CStringLen -> IO a) -> IO a++instance LogMessage String where+  toCStringLen = withCStringLen++instance LogMessage ByteString where+  toCStringLen = unsafeUseAsCStringLen++-- This simplified syslog interface can deal efficiently with any LogMessage.+-- It relies on the default 'Facility' to be configured globally.++write :: LogMessage a => Priority -> a -> IO ()+write pri msg = toCStringLen msg (syslog Nothing pri)++-- Now write a couple of String and ByteString messages. On my system, the log+-- file shows the following output:+--+--    May 12 19:49:18 myhost example[26995]: Hello, World.+--    May 12 19:49:18 myhost example[26995]: Default logging mask is [Emergency,Alert,Critical,Error,Warning,Notice,Info,Debug]++main :: IO ()+main =+  withSyslog "example" [LogPID, Console] User $ do+    write Info "Hello, World."+    lm <- setlogmask [Debug]+    write Info (pack "This message does not show up.")+    write Debug ("Default logging mask is " ++ show lm)

@@ -1,38 +1,68 @@-Name:                   hsyslog-Version:                4-Copyright:              Copyright (c) 2004-2016 by Peter Simons-License:                BSD3-License-File:           LICENSE-Author:                 Peter Simons, John Lato, Jonathan Childress-Maintainer:             Peter Simons <simons@cryp.to>-Homepage:               http://github.com/peti/hsyslog-Bug-Reports:            http://github.com/peti/hsyslog/issues-Category:               Foreign-Synopsis:               FFI interface to syslog(3) from POSIX.1-2001-Description:            This library provides FFI bindings to syslog(3) from-                        <http://pubs.opengroup.org/onlinepubs/9699919799/basedefs/syslog.h.html POSIX.1-2008>.-Cabal-Version:          >= 1.8-Build-Type:             Simple-Tested-With:            GHC > 7.6 && < 8.1+name:           hsyslog+version:        5+cabal-version:  >= 1.8+build-type:     Simple+license:        BSD3+license-file:   LICENSE+copyright:      Copyright (c) 2004-2017 by Peter Simons+author:         Peter Simons, John Lato, Jonathan Childress+maintainer:     Peter Simons <simons@cryp.to>+homepage:       http://github.com/peti/hsyslog+bug-reports:    http://github.com/peti/hsyslog/issues+synopsis:       FFI interface to syslog(3) from POSIX.1-2001+category:       Foreign+tested-with:    GHC >7.6 && <8.1 -Source-Repository head-  Type:                 git-  Location:             git://github.com/peti/hsyslog.git+extra-source-files:+  c-bits/simple-syslog.c+  c-bits/make-log-mask.c -Library-  Hs-Source-Dirs:       src-  Build-Depends:        base >= 3 && < 5-                      , bytestring == 0.10.*-  Extensions:           CApiFFI-                      , ForeignFunctionInterface-                      , OverloadedStrings-  Exposed-Modules:      System.Posix.Syslog+description:+  A Haskell interface to @syslog(3)@ as specified in+  <http://pubs.opengroup.org/onlinepubs/9699919799/functions/syslog.html POSIX.1-2008>.+  The entire public API lives in "System.Posix.Syslog". There is a set of exposed+  modules available underneath that one, which contain various implementation details+  that may be useful to other developers who want to implement syslog-related+  functionality. /Users/ of @syslog@, however, do not need them.+  .+  An example program that demonstrates how to use this library is available in the+  <https://github.com/peti/hsyslog/blob/master/example/Main.hs examples> directory of+  this package. -Test-Suite tests-  Hs-Source-Dirs:       test-  Main-Is:              Main.hs-  Type:                 exitcode-stdio-1.0-  Build-Depends:        base-                      , bytestring-                      , hsyslog-                      , QuickCheck+source-repository head+  type:     git+  location: git://github.com/peti/hsyslog.git++Flag install-examples+  Description:   Build and install example programs.+  Default:       False++library+  exposed-modules:  System.Posix.Syslog+                    System.Posix.Syslog.Facility+                    System.Posix.Syslog.Functions+                    System.Posix.Syslog.LogMask+                    System.Posix.Syslog.Options+                    System.Posix.Syslog.Priority+  build-depends:    base >= 4.6 && < 5+  other-extensions: ForeignFunctionInterface, DeriveGeneric+  hs-source-dirs:   src+  c-sources:        c-bits/simple-syslog.c+                    c-bits/make-log-mask.c++test-suite hsyslog-test+  type:           exitcode-stdio-1.0+  main-is:        Main.hs+  hs-source-dirs: test+  build-depends:  hsyslog, base, doctest+  ghc-options:    -threaded++executable hsyslog-example+  main-is:              Main.hs+  hs-source-dirs:       example+  build-depends:        base, hsyslog, bytestring+  if flag(install-examples)+    buildable:          True+    other-extensions:   TypeSynonymInstances, FlexibleInstances+  else+    buildable:          False

@@ -0,0 +1,115 @@+{- |+   Maintainer:  simons@cryp.to+   Stability:   provisional+   Portability: POSIX++   A Haskell interface to @syslog(3)@ as specified in+   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/syslog.html POSIX.1-2008>.+   The entire public API lives in this module. There is a set of exposed+   modules available underneath this one, which contain various implementation+   details that may be useful to other developers who want to implement+   syslog-related functionality. /Users/ of syslog, however, do not need those+   modules; "System.Posix.Syslog" has all you'll need.++   Check out the+   <https://github.com/peti/hsyslog/blob/master/example/Main.hs example program>+   that demonstrates how to use this library.+-}++module System.Posix.Syslog+  ( -- * Writing Log Messages+    syslog, Priority(..), Facility(..)+  , -- * Configuring the system's logging engine+    openlog, closelog, withSyslog, setlogmask, Option(..)+  )+  where++import System.Posix.Syslog.Facility+import System.Posix.Syslog.Functions+import System.Posix.Syslog.LogMask+import System.Posix.Syslog.Options+import System.Posix.Syslog.Priority++import Control.Exception ( assert, bracket_ )+import Data.Bits+import Foreign.C++-- |Log the given text message via @syslog(3)@. Please note that log messages+-- are committed to the log /verbatim/ --- @printf()@-style text formatting+-- features offered by the underlying system function are /not/ available. If+-- your log message reads @"%s"@, then that string is exactly what will be+-- written to the log. Also, log messages cannot contain @\\0@ bytes. If they+-- do, all content following that byte will be cut off because the C function+-- assumes that the string ends there.+--+-- The Haskell 'String' type can be easily logged with 'withCStringLen':+--+-- @+--  withCStringLen "Hello, world." $ syslog (Just User) Info+-- @+--+-- 'ByteStrings' can be logged in the same way with the 'unsafeUseAsCStringLen'+-- function from @Data.ByteString.Unsafe@, which extracts a 'CStringLen' from+-- the 'ByteString' in constant time (no copying!).++syslog :: Maybe Facility -- ^ Categorize this message as belonging into the+                         -- given system facility. If left unspecified, the+                         -- process-wide default will be used, which tends to+                         -- be 'User' by default.+       -> Priority       -- ^ Log with the specified priority.+       -> CStringLen     -- ^ The actual log message. The string does not need+                         -- to be terminated by a @\\0@ byte. If the string+                         -- /does/ contain a @\\0@ byte, then the message ends+                         -- there regardless of what the length argument says.+       -> IO ()+syslog facil prio (ptr,len) = assert (len >= 0) $ do+  _syslog (maybe 0 fromFacility facil) (fromPriority prio) ptr (fromIntegral len)++-- | This function configures the process-wide hidden state of the system's+-- syslog engine. It's probably a bad idea to call this function anywhere+-- except at the very top of your program's 'main' function. And even then you+-- should probably prefer 'withSyslog' instead, which guarantees that syslog is+-- properly initialized within its scope.++openlog :: CString      -- ^ An identifier to prepend to all log messages,+                        -- typically the name of the programm. Note that the+                        -- memory that contains this name must remain valid+                        -- until the pointer provided here is released by+                        -- calling 'closelog'.+        -> [Option]     -- ^ A set of options that configure the behavior of+                        -- the system's syslog engine.+        -> Facility     -- ^ The facility to use by default when none has been+                        -- specified with a 'syslog' call.+        -> IO ()+openlog ident opts facil =+  _openlog ident (foldr ((.|.) . fromOption) 0 opts) (fromFacility facil)++-- | Release all syslog-related resources.++closelog :: IO ()+closelog = _closelog++-- | Run the given @IO a@ computation within an initialized syslogging scope.+-- The definition is:+--+-- @+--   withSyslog ident opts facil f =+--     'withCString' ident $ \ptr ->+--       'bracket_' (openlog ptr opts facil) closelog f+-- @++withSyslog :: String -> [Option] -> Facility -> IO a -> IO a+withSyslog ident opts facil f =+  withCString ident $ \ptr ->+    bracket_ (openlog ptr opts facil) closelog f++-- | Configure a process-wide filter that determines which logging priorities+-- are ignored and which ones are forwarded to the @syslog@ implementation. For+-- example, use @setlogmask [Emergency .. Info]@ to filter out all debug-level+-- messages from the message stream. Calling @setlogmask [minBound..maxBound]@+-- enables /everything/. The special case @setlogmask []@ does /nothing/, i.e.+-- the current filter configuration is not modified. This can be used to+-- retrieve the current configuration.++setlogmask :: [Priority] -> IO [Priority]+setlogmask prios = fmap fromLogMask (_setlogmask (toLogMask prios))

@@ -1,342 +0,0 @@-{-# LANGUAGE-    CApiFFI-  , ForeignFunctionInterface-  , OverloadedStrings-  #-}--#if __GLASGOW_HASKELL__ >= 706-{-# LANGUAGE DeriveGeneric #-}-#endif--{- |-   Module      :  System.Posix.Syslog-   Maintainer  :  simons@cryp.to-   Stability   :  provisional-   Portability :  Posix--   FFI bindings to syslog(3) from-   <http://pubs.opengroup.org/onlinepubs/9699919799/basedefs/syslog.h.html POSIX.1-2008>.--}--module System.Posix.Syslog-  ( -- * Marshaled Data Types-    Priority (..)-  , toPriority-  , fromPriority-  , Facility (..)-  , toFacility-  , fromFacility-  , Option (..)-  , toOption-  , fromOption-  , PriorityMask (..)-  , fromPriorityMask-    -- * Configuring syslog-  , SyslogConfig (..)-  , defaultConfig-    -- * The preferred Haskell API to syslog-  , withSyslog-  , SyslogFn-    -- * The unsafe Haskell API to syslog-  , syslogUnsafe-    -- * Low-level C functions-    -- | See the-    -- <http://pubs.opengroup.org/onlinepubs/9699919799/functions/closelog.html POSIX.1-2008 documentation>.-  , _openlog-  , _closelog-  , _setlogmask-  , _syslog-    -- ** Low-level C macros-  , _LOG_MAKEPRI-  , _LOG_MASK-  , _LOG_UPTO-    -- * Utilities-    -- | Low-level utilities for syslog-related tools-  , makePri-  ) where--import Control.Exception (bracket_)-import Data.Bits (Bits, (.|.))-import Data.ByteString (ByteString, useAsCString)-import Data.List (foldl')-import Foreign.C (CInt (..), CString (..))--#if __GLASGOW_HASKELL__ >= 706-import GHC.Generics (Generic)-#endif--#include <syslog.h>-#ifndef LOG_AUTHPRIV-#define LOG_AUTHPRIV LOG_AUTH-#endif--#ifndef LOG_FTP-#define LOG_FTP LOG_DAEMON-#endif--#ifndef LOG_PERROR-#define LOG_PERROR 0-#endif---- | Log messages have a priority attached.--data Priority-  = Emergency   -- ^ system is unusable-  | Alert       -- ^ action must be taken immediately-  | Critical    -- ^ critical conditions-  | Error       -- ^ error conditions-  | Warning     -- ^ warning conditions-  | Notice      -- ^ normal but significant condition-  | Info        -- ^ informational-  | Debug       -- ^ debug-level messages-  deriving ( Bounded, Enum, Eq, Show, Read-#if __GLASGOW_HASKELL__ >= 706-           , Generic-#endif-           )--toPriority :: CInt -> Priority-toPriority #{const LOG_EMERG}   = Emergency-toPriority #{const LOG_ALERT}   = Alert-toPriority #{const LOG_CRIT}    = Critical-toPriority #{const LOG_ERR}     = Error-toPriority #{const LOG_WARNING} = Warning-toPriority #{const LOG_NOTICE}  = Notice-toPriority #{const LOG_INFO}    = Info-toPriority #{const LOG_DEBUG}   = Debug-toPriority i = error (shows i " is not a valid syslog priority value")--fromPriority :: Priority -> CInt-fromPriority Emergency = #{const LOG_EMERG}-fromPriority Alert     = #{const LOG_ALERT}-fromPriority Critical  = #{const LOG_CRIT}-fromPriority Error     = #{const LOG_ERR}-fromPriority Warning   = #{const LOG_WARNING}-fromPriority Notice    = #{const LOG_NOTICE}-fromPriority Info      = #{const LOG_INFO}-fromPriority Debug     = #{const LOG_DEBUG}---- | Syslog distinguishes various system facilities. Most applications should--- log in 'USER'.--data Facility-  = KERN        -- ^ kernel messages-  | USER        -- ^ user-level messages (default unless set otherwise)-  | MAIL        -- ^ mail system-  | DAEMON      -- ^ system daemons-  | AUTH        -- ^ security\/authorization messages-  | SYSLOG      -- ^ messages generated internally by syslogd-  | LPR         -- ^ line printer subsystem-  | NEWS        -- ^ network news subsystem-  | UUCP        -- ^ UUCP subsystem-  | CRON        -- ^ clock daemon-  | AUTHPRIV    -- ^ security\/authorization messages (effectively equals 'AUTH' on some systems)-  | FTP         -- ^ ftp daemon (effectively equals 'DAEMON' on some systems)-  | LOCAL0      -- ^ reserved for local use-  | LOCAL1      -- ^ reserved for local use-  | LOCAL2      -- ^ reserved for local use-  | LOCAL3      -- ^ reserved for local use-  | LOCAL4      -- ^ reserved for local use-  | LOCAL5      -- ^ reserved for local use-  | LOCAL6      -- ^ reserved for local use-  | LOCAL7      -- ^ reserved for local use-  deriving ( Bounded, Enum, Eq, Show, Read-#if __GLASGOW_HASKELL__ >= 706-           , Generic-#endif-           )--toFacility :: CInt -> Facility-toFacility #{const LOG_KERN}      = KERN-toFacility #{const LOG_USER}      = USER-toFacility #{const LOG_MAIL}      = MAIL-toFacility #{const LOG_DAEMON}    = DAEMON-toFacility #{const LOG_AUTH}      = AUTH-toFacility #{const LOG_SYSLOG}    = SYSLOG-toFacility #{const LOG_LPR}       = LPR-toFacility #{const LOG_NEWS}      = NEWS-toFacility #{const LOG_UUCP}      = UUCP-toFacility #{const LOG_CRON}      = CRON-toFacility #{const LOG_AUTHPRIV}  = AUTHPRIV-toFacility #{const LOG_FTP}       = FTP-toFacility #{const LOG_LOCAL0}    = LOCAL0-toFacility #{const LOG_LOCAL1}    = LOCAL1-toFacility #{const LOG_LOCAL2}    = LOCAL2-toFacility #{const LOG_LOCAL3}    = LOCAL3-toFacility #{const LOG_LOCAL4}    = LOCAL4-toFacility #{const LOG_LOCAL5}    = LOCAL5-toFacility #{const LOG_LOCAL6}    = LOCAL6-toFacility #{const LOG_LOCAL7}    = LOCAL7-toFacility i = error (shows i " is not a valid syslog facility value")--fromFacility :: Facility -> CInt-fromFacility KERN      = #{const LOG_KERN}-fromFacility USER      = #{const LOG_USER}-fromFacility MAIL      = #{const LOG_MAIL}-fromFacility DAEMON    = #{const LOG_DAEMON}-fromFacility AUTH      = #{const LOG_AUTH}-fromFacility SYSLOG    = #{const LOG_SYSLOG}-fromFacility LPR       = #{const LOG_LPR}-fromFacility NEWS      = #{const LOG_NEWS}-fromFacility UUCP      = #{const LOG_UUCP}-fromFacility CRON      = #{const LOG_CRON}-fromFacility AUTHPRIV  = #{const LOG_AUTHPRIV}-fromFacility FTP       = #{const LOG_FTP}-fromFacility LOCAL0    = #{const LOG_LOCAL0}-fromFacility LOCAL1    = #{const LOG_LOCAL1}-fromFacility LOCAL2    = #{const LOG_LOCAL2}-fromFacility LOCAL3    = #{const LOG_LOCAL3}-fromFacility LOCAL4    = #{const LOG_LOCAL4}-fromFacility LOCAL5    = #{const LOG_LOCAL5}-fromFacility LOCAL6    = #{const LOG_LOCAL6}-fromFacility LOCAL7    = #{const LOG_LOCAL7}---- | 'withSyslog' options for the syslog service.--data Option-  = PID       -- ^ log the pid with each message-  | CONS      -- ^ log on the console if errors in sending-  | ODELAY    -- ^ delay open until first @syslog()@ (default)-  | NDELAY    -- ^ don't delay open-  | NOWAIT    -- ^ don't wait for console forks: DEPRECATED-  | PERROR    -- ^ log to 'stderr' as well (might be a no-op on some systems)-  deriving ( Bounded, Enum, Eq, Show, Read-#if __GLASGOW_HASKELL__ >= 706-           , Generic-#endif-           )--toOption :: CInt -> Option-toOption #{const LOG_PID}     = PID-toOption #{const LOG_CONS}    = CONS-toOption #{const LOG_ODELAY}  = ODELAY-toOption #{const LOG_NDELAY}  = NDELAY-toOption #{const LOG_NOWAIT}  = NOWAIT-toOption #{const LOG_PERROR}  = PERROR-toOption i = error (shows i " is not a valid syslog option value")--fromOption :: Option -> CInt-fromOption PID     = #{const LOG_PID}-fromOption CONS    = #{const LOG_CONS}-fromOption ODELAY  = #{const LOG_ODELAY}-fromOption NDELAY  = #{const LOG_NDELAY}-fromOption NOWAIT  = #{const LOG_NOWAIT}-fromOption PERROR  = #{const LOG_PERROR}---- | 'withSyslog' options for the priority mask.--data PriorityMask-  = NoMask          -- ^ allow all messages thru-  | Mask [Priority] -- ^ allow only messages with the priorities listed-  | UpTo Priority   -- ^ allow only messages down to and including the specified priority-  deriving ( Eq, Show, Read-#if __GLASGOW_HASKELL__ >= 706-           , Generic-#endif-           )--fromPriorityMask :: PriorityMask -> CInt-fromPriorityMask (Mask pris) = bitsOrWith (_LOG_MASK . fromPriority) pris-fromPriorityMask (UpTo pri) = _LOG_UPTO $ fromPriority pri-fromPriorityMask NoMask = 0--data SyslogConfig = SyslogConfig-  { identifier :: ByteString-    -- ^ string appended to each log message-  , options :: [Option]-    -- ^ options for syslog behavior-  , defaultFacility :: Facility-    -- ^ facility logged to when none are provided (currently unsupported)-  , priorityMask :: PriorityMask-    -- ^ filter by priority which messages are logged-  }-  deriving (Eq, Show)---- | A practical default syslog config. You'll at least want to change the--- identifier.--defaultConfig :: SyslogConfig-defaultConfig = SyslogConfig "hsyslog" [ODELAY] USER NoMask---- | Bracket an 'IO' computation between calls to '_openlog', '_setlogmask',--- and '_closelog', providing a logging function which can be used as follows:------ > main = withSyslog defaultConfig $ \syslog -> do--- >          putStrLn "huhu"--- >          syslog USER Debug "huhu"------ Note that these are /process-wide/ settings, so multiple calls to--- this function will interfere with each other in unpredictable ways.--withSyslog :: SyslogConfig -> (SyslogFn -> IO ()) -> IO ()-withSyslog config f =-    useAsCString (identifier config) $ \cIdent ->-      let-        open :: IO ()-        open = do-            _openlog cIdent cOpts cFac-            _setlogmask cMask-            return ()-          where-            cFac = fromFacility $ defaultFacility config-            cMask = fromPriorityMask $ priorityMask config-            cOpts = bitsOrWith fromOption $ options config--        close :: IO ()-        close = _closelog--        run :: IO ()-        run = do-            useAsCString escape (f . syslogEscaped)-            return ()-      in-        bracket_ open close run---- | The type of function provided by 'withSyslog'.--type SyslogFn-  =  Facility -- ^ the facility to log to-  -> Priority -- ^ the priority under which to log-  -> ByteString -- ^ the message to log-  -> IO ()---- | Provides no guarantee that a call to '_openlog' has been made, inviting--- unpredictable results.--syslogUnsafe :: SyslogFn-syslogUnsafe fac pri msg = useAsCString msg (_syslog (makePri fac pri))---- foreign imports--foreign import ccall unsafe "openlog" _openlog :: CString -> CInt -> CInt -> IO ()-foreign import ccall unsafe "closelog" _closelog :: IO ()-foreign import ccall unsafe "setlogmask" _setlogmask :: CInt -> IO CInt--foreign import ccall unsafe "syslog" _syslogEscaped-  :: CInt -> CString -> CString -> IO ()--_syslog :: CInt -> CString -> IO ()-_syslog int msg = useAsCString escape $ \e -> _syslogEscaped int e msg--foreign import capi "syslog.h LOG_MAKEPRI" _LOG_MAKEPRI :: CInt -> CInt -> CInt-foreign import capi "syslog.h LOG_MASK" _LOG_MASK :: CInt -> CInt-foreign import capi "syslog.h LOG_UPTO" _LOG_UPTO :: CInt -> CInt---- utilities---- | Calculate the full priority value of a 'Facility' and 'Priority'--makePri :: Facility -> Priority -> CInt-makePri fac pri = _LOG_MAKEPRI (fromFacility fac) (fromPriority pri)---- internal functions--bitsOrWith :: (Bits b, Num b) => (a -> b) -> [a] -> b-bitsOrWith f = foldl' (\bits x -> f x .|. bits) 0--escape :: ByteString-escape = "%s"--syslogEscaped :: CString -> Facility -> Priority -> ByteString -> IO ()-syslogEscaped esc fac pri msg =-    useAsCString msg (_syslogEscaped (makePri fac pri) esc)

@@ -0,0 +1,65 @@+{-# LANGUAGE DeriveGeneric #-}++{- |+   Maintainer: simons@cryp.to+   Stability: provisional+   Portability: POSIX++   FFI bindings to @syslog(3)@ from+   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/syslog.html POSIX.1-2008>.+   This module is intended for purposes of low-level implementation. Users of+   this library should prefer safer and more convenient API provided by+   "System.Posix.Syslog".+-}++module System.Posix.Syslog.Facility where++import Foreign.C.Types+import GHC.Generics ( Generic )++#include <syslog.h>++-- | Syslog distinguishes various system facilities. Most applications should+-- log in 'USER'.++data Facility  = Kernel      -- ^ kernel messages+               | User        -- ^ user-level messages (default unless set otherwise)+               | Mail        -- ^ mail system+               | News        -- ^ network news subsystem+               | UUCP        -- ^ UUCP subsystem+               | Daemon      -- ^ system daemons+               | Auth        -- ^ security and authorization messages+               | Cron        -- ^ clock daemon+               | LPR         -- ^ line printer subsystem+               | Local0      -- ^ reserved for local use+               | Local1      -- ^ reserved for local use+               | Local2      -- ^ reserved for local use+               | Local3      -- ^ reserved for local use+               | Local4      -- ^ reserved for local use+               | Local5      -- ^ reserved for local use+               | Local6      -- ^ reserved for local use+               | Local7      -- ^ reserved for local use+   deriving (Show, Read, Bounded, Enum, Eq, Generic)++-- | Translate a 'Facility' into the system-dependent identifier that's used by+-- the @syslog(3)@ implementation.++{-# INLINE fromFacility #-}+fromFacility :: Facility -> CInt+fromFacility Kernel    = #{const LOG_KERN}+fromFacility User      = #{const LOG_USER}+fromFacility Mail      = #{const LOG_MAIL}+fromFacility Daemon    = #{const LOG_DAEMON}+fromFacility Auth      = #{const LOG_AUTH}+fromFacility LPR       = #{const LOG_LPR}+fromFacility News      = #{const LOG_NEWS}+fromFacility UUCP      = #{const LOG_UUCP}+fromFacility Cron      = #{const LOG_CRON}+fromFacility Local0    = #{const LOG_LOCAL0}+fromFacility Local1    = #{const LOG_LOCAL1}+fromFacility Local2    = #{const LOG_LOCAL2}+fromFacility Local3    = #{const LOG_LOCAL3}+fromFacility Local4    = #{const LOG_LOCAL4}+fromFacility Local5    = #{const LOG_LOCAL5}+fromFacility Local6    = #{const LOG_LOCAL6}+fromFacility Local7    = #{const LOG_LOCAL7}

@@ -0,0 +1,71 @@+{-# LANGUAGE ForeignFunctionInterface #-}++{- |+   Maintainer: simons@cryp.to+   Stability: provisional+   Portability: POSIX++   Low-level FFI bindings to @syslog(3)@ et al from+   <http://pubs.opengroup.org/onlinepubs/9699919799/basedefs/syslog.h.html POSIX.1-2008>.+   This module is intended for purposes of low-level implementation. Users of+   this library should prefer safer and more convenient API provided by+   "System.Posix.Syslog"+-}++module System.Posix.Syslog.Functions where++import Foreign.C++-- | The POSIX function <http://pubs.opengroup.org/onlinepubs/9699919799/functions/syslog.html syslog(3)>+-- imported into Haskell directly as an "unsafe" C-API call. We chose this+-- specific signature for the variadic function, because it's ideal for the+-- efficient zero-copy implementation provided by the high-level function+-- 'System.Posix.Syslog.syslog'.+foreign import ccall unsafe "syslog.h simpleSyslog" _syslog+  :: CInt       -- ^ The system-specific identifier for 'System.Posix.Syslog.Facility'.+  -> CInt       -- ^ The system-specific identifier for 'System.Posix.Syslog.Priority'.+  -> CString    -- ^ The actual log message, which does not need to be+                -- terminated by a NUL byte. It should not contain NUL bytes+                -- either, though.+  -> CInt       -- ^ The length of the log message. Yes, this is a signed+                -- integer. Yes, an unsigned integer would be better. No, I+                -- can't do anything about it. It's frickin' C code from one+                -- and a half centuries ago; what do you expect? Just don't+                -- pass any negative values here, okay?+  -> IO ()++-- | The POSIX function <http://pubs.opengroup.org/onlinepubs/9699919799/functions/openlog.html openlog(3)>,+-- imported into Haskell directly as an "unsafe" foreign function call.+foreign import ccall unsafe "syslog.h openlog" _openlog+  :: CString    -- ^ A process-wide identifier to prepent to every log message.+                -- Note that this string must exist until 'closelog' is called.+                -- If the underlying memory buffer changes, the identifier used+                -- by 'System.Posix.Syslog.syslog' /probably/ changes too. It's+                -- safe to pass 'nullPtr', but POSIX does not specify how that+                -- choice is+                -- interpreted.+  -> CInt       -- ^ A bit set that combines various 'Option' values.+  -> CInt       -- ^ A default 'Facility' to use for messages that don't+                -- specify one.+  -> IO ()++-- | The POSIX function <http://pubs.opengroup.org/onlinepubs/9699919799/functions/closelog.html closelog(3)>+-- imported into Haskell directly as an "unsafe" foreign function call.+foreign import ccall unsafe "syslog.h closelog" _closelog :: IO ()++-- | The POSIX function <http://pubs.opengroup.org/onlinepubs/9699919799/functions/setlogmask.html setlogmask(3)>+-- imported into Haskell directly as an "unsafe" foreign function call.+foreign import ccall unsafe "syslog.h setlogmask" _setlogmask+  :: CInt       -- ^ A bit mask that determines which priorities are enabled or+                -- disabled. See also '_LOG_MASK'.+  -> IO CInt++-- | The POSIX macro <http://pubs.opengroup.org/onlinepubs/009695399/basedefs/syslog.h.html LOG_MASK()>+-- imported into Haskell directly as a pure, "unsafe" foreign function call. It+-- does feel a little silly to bother with this functions since we pretty much know+-- @+--   _logMask = (2^)+-- @+-- for certain, but, well, POSIX provides this abstraction and so it's probably+-- no good idea to make that assumption.+foreign import ccall unsafe "makeLogMask" _logMask :: CInt -> CInt

@@ -0,0 +1,31 @@+{- |+   Maintainer:  simons@cryp.to+   Stability:   provisional+   Portability: POSIX++   FFI bindings to @syslog(3)@ from+   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/syslog.html POSIX.1-2008>.+   This module is intended for purposes of low-level implementation. Users of+   this library should prefer safer and more convenient API provided by+   "System.Posix.Syslog".+-}++module System.Posix.Syslog.LogMask where++import System.Posix.Syslog.Functions ( _logMask )+import System.Posix.Syslog.Priority ( Priority, fromPriority )++import Data.Bits+import Foreign.C.Types++-- | Convert a set of logging priorities into a system-dependent binary+-- representation suitable for calling '_setlogmask'.++toLogMask :: [Priority] -> CInt+toLogMask = foldr (.|.) 0 . map (_logMask . fromPriority)++-- | Decode the the system-dependent binary representation returned by+-- '_setlogmask' back into a set of logging priorities.++fromLogMask :: CInt -> [Priority]+fromLogMask old = [ p | p <- [minBound..maxBound], _logMask (fromPriority p) .&. old /= 0 ]

@@ -0,0 +1,44 @@+{-# LANGUAGE DeriveGeneric #-}++{- |+   Maintainer: simons@cryp.to+   Stability: provisional+   Portability: POSIX++   FFI bindings to @syslog(3)@ from+   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/syslog.html POSIX.1-2008>.+   This module is intended for purposes of low-level implementation. Users of+   this library should prefer safer and more convenient API provided by+   "System.Posix.Syslog".+-}++module System.Posix.Syslog.Options where++import Foreign.C.Types+import GHC.Generics ( Generic )++#include <syslog.h>++-- | The function 'openlog' allows one to configure a handful of process-wide+-- options that modify the bahavior of the 'syslog' funcion. These options are+-- 'pid', 'cons', 'odelay', and 'ndelay'.++data Option = LogPID              -- ^ Log the pid with each message.+            | Console             -- ^ Log on the console if errors occur while sending messages.+            | DelayedOpen         -- ^ Delay all initialization until first @syslog()@ call (default).+            | ImmediateOpen       -- ^ Initalize the syslog system immediately.+            | DontWaitForChildren -- ^ The syslog system should not attempt to wait for child+                                  -- process it may have created. This option is required by+                                  -- applications who enable @SIGCHLD@ themselves.+  deriving (Show, Read, Bounded, Enum, Eq, Generic)++-- | Translate an 'Option' into the system-dependent identifier that's used by+-- the @syslog(3)@ implementation.++{-# INLINE fromOption #-}+fromOption :: Option -> CInt+fromOption LogPID              = #{const LOG_PID}+fromOption Console             = #{const LOG_CONS}+fromOption DelayedOpen         = #{const LOG_ODELAY}+fromOption ImmediateOpen       = #{const LOG_NDELAY}+fromOption DontWaitForChildren = #{const LOG_NOWAIT}

@@ -0,0 +1,61 @@+{-# LANGUAGE DeriveGeneric #-}++{- |+   Maintainer: simons@cryp.to+   Stability: provisional+   Portability: POSIX++   FFI bindings to @syslog(3)@ from+   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/syslog.html POSIX.1-2008>.+   This module is intended for purposes of low-level implementation. Users of+   this library should prefer safer and more convenient API provided by+   "System.Posix.Syslog".+-}++module System.Posix.Syslog.Priority where++import Foreign.C+import GHC.Generics ( Generic )++#include <syslog.h>++-- * Message Priorities++-- | Log messages are prioritized with one of the following levels:+--+-- >>> [minBound..maxBound] :: [Priority]+-- [Emergency,Alert,Critical,Error,Warning,Notice,Info,Debug]+--+-- The 'Ord' instance for 'Priority' considers the more urgent level lower than+-- less urgent ones:+--+-- >>> Emergency < Debug+-- True+-- >>> minimum [minBound..maxBound] :: Priority+-- Emergency+-- >>> maximum [minBound..maxBound] :: Priority+-- Debug++data Priority = Emergency       -- ^ the system is unusable+              | Alert           -- ^ action must be taken immediately+              | Critical        -- ^ critical conditions+              | Error           -- ^ error conditions+              | Warning         -- ^ warning conditions+              | Notice          -- ^ normal but significant condition+              | Info            -- ^ informational+              | Debug           -- ^ debug-level messages+  deriving (Show, Read, Eq, Ord, Bounded, Enum, Generic)++-- | Translate a 'Priority' into the system-dependent identifier that's used by+-- the @syslog(3)@ implementation.++{-# INLINE fromPriority #-}+fromPriority :: Priority -> CInt+fromPriority Emergency = #{const LOG_EMERG}+fromPriority Alert     = #{const LOG_ALERT}+fromPriority Critical  = #{const LOG_CRIT}+fromPriority Error     = #{const LOG_ERR}+fromPriority Warning   = #{const LOG_WARNING}+fromPriority Notice    = #{const LOG_NOTICE}+fromPriority Info      = #{const LOG_INFO}+fromPriority Debug     = #{const LOG_DEBUG}

@@ -1,48 +1,11 @@-{-# LANGUAGE OverloadedStrings #-}- module Main (main) where -import Data.ByteString.Char8-import System.Posix.Syslog-import Test.QuickCheck-import Test.QuickCheck.Property--instance Arbitrary Priority where-  arbitrary = arbitraryBoundedEnum--instance Arbitrary Facility where-  arbitrary = arbitraryBoundedEnum--instance Arbitrary ByteString where-  arbitrary = fmap pack arbitrary+import Test.DocTest+import System.Environment+import Data.Maybe  main :: IO () main = do-  outputTest-  dontExplodeTest--{--- This isn't a true test. Instead, we're passing the PERROR option (meaning- syslog will also send messages to STDERR), sending a message that should be- whitelisted by the priority mask, and sending a message that should be- blacklisted by the priority mask. If hsyslog is working correctly, then only- "hsyslog is working" should appear in your test log output.---}-outputTest :: IO ()-outputTest = withSyslog config $ \syslog -> do-    syslog USER Debug "%s%d hsyslog is working :)"-    syslog USER Error "hsyslog is not working :("-  where-    config = defaultConfig-        { options = [PERROR, NDELAY]-        , priorityMask = Mask [Debug, Alert]-        }--dontExplodeTest :: IO ()-dontExplodeTest = withSyslog defaultConfig $ \syslog -> do-    let-      prop_dontExplode :: Facility -> Priority -> ByteString -> Property-      prop_dontExplode fac pri msg = ioProperty $ do-          syslog fac pri msg-          return succeeded-    quickCheck prop_dontExplode+  distDir <- fromMaybe "dist" `fmap` lookupEnv "HASKELL_DIST_DIR"+  let hscFilesDir = distDir ++ "/build"+  doctest [ "-i" ++ hscFilesDir, "src" ]