hsyslog 2.0 → 3

raw patch · 5 files changed

+434/−302 lines, 5 filesdep +QuickCheckdep +bytestringdep +hsyslogdep −doctestPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, bytestring, hsyslog

Dependencies removed: doctest

API changes (from Hackage documentation)

Files

• System/Posix/Syslog.hsc +0/−283
• doctest.hs +0/−8
• hsyslog.cabal +17/−11
• src/System/Posix/Syslog.hsc +369/−0
• test/Main.hs +48/−0

@@ -1,283 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}-#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://www.opengroup.org/onlinepubs/009695399/basedefs/syslog.h.html POSIX.1-2001>.--}--module System.Posix.Syslog where--import Control.Exception ( bracket_ )-import Data.Bits-import Foreign.C-#if __GLASGOW_HASKELL__ >= 706-import GHC.Generics-#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---- * Marshaled Data Types---- |Log messages are prioritized.------ Note that the 'Enum' instance for this class is incomplete. We abuse--- 'toEnum' and 'fromEnum' to map these constructors to their--- corresponding bit-mask value in C, but not all uses cases provided by--- of enumerating that class are fully supported--- (<https://github.com/peti/hsyslog/issues/5 issue #5>).--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 ( Eq, Bounded, Show, Read-#if __GLASGOW_HASKELL__ >= 706-           , Generic-#endif-           )--instance Enum Priority where-  toEnum #{const LOG_EMERG}   = Emergency-  toEnum #{const LOG_ALERT}   = Alert-  toEnum #{const LOG_CRIT}    = Critical-  toEnum #{const LOG_ERR}     = Error-  toEnum #{const LOG_WARNING} = Warning-  toEnum #{const LOG_NOTICE}  = Notice-  toEnum #{const LOG_INFO}    = Info-  toEnum #{const LOG_DEBUG}   = Debug-  toEnum i = error (showString "Syslog.Priority cannot be mapped from value " (show i))--  fromEnum Emergency = #{const LOG_EMERG}-  fromEnum Alert     = #{const LOG_ALERT}-  fromEnum Critical  = #{const LOG_CRIT}-  fromEnum Error     = #{const LOG_ERR}-  fromEnum Warning   = #{const LOG_WARNING}-  fromEnum Notice    = #{const LOG_NOTICE}-  fromEnum Info      = #{const LOG_INFO}-  fromEnum 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 (Eq, Bounded, Show, Read)--instance Enum Facility where-  toEnum #{const LOG_KERN}      = KERN-  toEnum #{const LOG_USER}      = USER-  toEnum #{const LOG_MAIL}      = MAIL-  toEnum #{const LOG_DAEMON}    = DAEMON-  toEnum #{const LOG_AUTH}      = AUTH-  toEnum #{const LOG_SYSLOG}    = SYSLOG-  toEnum #{const LOG_LPR}       = LPR-  toEnum #{const LOG_NEWS}      = NEWS-  toEnum #{const LOG_UUCP}      = UUCP-  toEnum #{const LOG_CRON}      = CRON-  toEnum #{const LOG_AUTHPRIV}  = AUTHPRIV-  toEnum #{const LOG_FTP}       = FTP-  toEnum #{const LOG_LOCAL0}    = LOCAL0-  toEnum #{const LOG_LOCAL1}    = LOCAL1-  toEnum #{const LOG_LOCAL2}    = LOCAL2-  toEnum #{const LOG_LOCAL3}    = LOCAL3-  toEnum #{const LOG_LOCAL4}    = LOCAL4-  toEnum #{const LOG_LOCAL5}    = LOCAL5-  toEnum #{const LOG_LOCAL6}    = LOCAL6-  toEnum #{const LOG_LOCAL7}    = LOCAL7-  toEnum i = error ("Syslog.Facility cannot be mapped to value " ++ show i)--  fromEnum KERN      = #{const LOG_KERN}-  fromEnum USER      = #{const LOG_USER}-  fromEnum MAIL      = #{const LOG_MAIL}-  fromEnum DAEMON    = #{const LOG_DAEMON}-  fromEnum AUTH      = #{const LOG_AUTH}-  fromEnum SYSLOG    = #{const LOG_SYSLOG}-  fromEnum LPR       = #{const LOG_LPR}-  fromEnum NEWS      = #{const LOG_NEWS}-  fromEnum UUCP      = #{const LOG_UUCP}-  fromEnum CRON      = #{const LOG_CRON}-  fromEnum AUTHPRIV  = #{const LOG_AUTHPRIV}-  fromEnum FTP       = #{const LOG_FTP}-  fromEnum LOCAL0    = #{const LOG_LOCAL0}-  fromEnum LOCAL1    = #{const LOG_LOCAL1}-  fromEnum LOCAL2    = #{const LOG_LOCAL2}-  fromEnum LOCAL3    = #{const LOG_LOCAL3}-  fromEnum LOCAL4    = #{const LOG_LOCAL4}-  fromEnum LOCAL5    = #{const LOG_LOCAL5}-  fromEnum LOCAL6    = #{const LOG_LOCAL6}-  fromEnum LOCAL7    = #{const LOG_LOCAL7}---- |Options for the syslog service. Set with 'withSyslog'.--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 (Eq, Bounded, Show)--instance Enum Option where-  toEnum #{const LOG_PID}     = PID-  toEnum #{const LOG_CONS}    = CONS-  toEnum #{const LOG_ODELAY}  = ODELAY-  toEnum #{const LOG_NDELAY}  = NDELAY-  toEnum #{const LOG_NOWAIT}  = NOWAIT-  toEnum #{const LOG_PERROR}  = PERROR-  toEnum i = error ("Syslog.Option cannot be mapped to value " ++ show i)--  fromEnum PID     = #{const LOG_PID}-  fromEnum CONS    = #{const LOG_CONS}-  fromEnum ODELAY  = #{const LOG_ODELAY}-  fromEnum NDELAY  = #{const LOG_NDELAY}-  fromEnum NOWAIT  = #{const LOG_NOWAIT}-  fromEnum PERROR  = #{const LOG_PERROR}---- * Haskell API to syslog---- |Bracket an 'IO' computation between calls to '_openlog',--- '_setlogmask', and '_closelog'. The function can be used as follows:------ > main = withSyslog "my-ident" [PID, PERROR] USER (logUpTo Debug) $ do--- >          putStrLn "huhu"--- >          syslog Debug "huhu"------ Note that these are /process-wide/ settings, so multiple calls to--- this function will interfere with each other in unpredictable ways.--withSyslog :: String -> [Option] -> Facility -> [Priority] -> IO a -> IO a-withSyslog ident opts facil prio f = withCString ident $ \p ->-    bracket_ (_openlog p opt fac >> _setlogmask pri) (_closelog) f-  where-    fac = toEnum . fromEnum           $ facil-    pri = toEnum . foldl1 (.|.) . map (shift 1 . fromEnum) $ if null prio-                                                             then [minBound .. maxBound]-                                                             else prio-    opt = toEnum . sum . map fromEnum $ opts---- |Log a message with the given priority.------ Note that the API of this function is somewhat unsatisfactory and is--- likely to change in the future:------ 1. The function should accept a @['Facility']@ argument so that---    messages can be logged to certain facilities without depending on---    the process-wide global default value set by 'openlog'---    (<https://github.com/peti/hsyslog/issues/6 issue #6>).------ 2. The 'Priority' argument should be @['Priority']@.------ 3. Accepting a 'ByteString' instead of 'String' would be preferrable---    because we can log those more efficiently, i.e. without---    marshaling. On top of that, we can provide a wrapper for this---    function that accepts anything that can be marshaled into a---    'ByteString' (<https://github.com/peti/hsyslog/issues/7 issue #7>).--syslog :: Priority -> String -> IO ()-syslog l msg =-  withCString (safeMsg msg)-    (\p -> _syslog (toEnum (fromEnum l)) p)---- |Returns the list of priorities up to and including the argument.--- Note that the syslog priority 'Debug' is considered the highest one--- in this context, which may counter-intuitive for some.------ >>> logUpTo(Debug)--- [Emergency,Alert,Critical,Error,Warning,Notice,Info,Debug]------ >>> logUpTo(Emergency)--- [Emergency]--logUpTo :: Priority -> [Priority]-logUpTo p = [minBound .. p]---- * Helpers---- |Escape any occurances of \'@%@\' in a string, so that it is safe to--- pass it to '_syslog'. The 'syslog' wrapper does this automatically.------ Unfortunately, the application of this function to every single--- syslog message is a performence nightmare. Instead, we should call--- syslog the existence of this function is a kludge, in a way that--- doesn't require any escaping--- (<https://github.com/peti/hsyslog/issues/8 issue #8>).--safeMsg :: String -> String-safeMsg []       = []-safeMsg ('%':xs) = '%' : '%' : safeMsg xs-safeMsg ( x :xs) = x : safeMsg xs---- * Low-level C functions---- |Open a connection to the system logger for a program. The string--- identifier passed as the first argument is prepended to every--- message, and is typically set to the program name. The behavior is--- unspecified by POSIX.1-2008 if that identifier is 'nullPtr'.--foreign import ccall unsafe "openlog" _openlog :: CString -> CInt -> CInt -> IO ()---- |Close the descriptor being used to write to the system logger.--foreign import ccall unsafe "closelog" _closelog :: IO ()---- |A process has a log priority mask that determines which calls to--- 'syslog' may be logged. All other calls will be ignored. Logging is--- enabled for the priorities that have the corresponding bit set in--- mask. The initial mask is such that logging is enabled for all--- priorities. This function sets this logmask for the calling process,--- and returns the previous mask. If the mask argument is 0, the current--- logmask is not modified.--foreign import ccall unsafe "setlogmask" _setlogmask :: CInt -> IO CInt---- |Generate a log message, which will be distributed by @syslogd(8)@.--- The priority argument is formed by ORing the facility and the level--- values (explained below). The remaining arguments are a format, as in--- printf(3) and any arguments required by the format, except that the--- two character sequence %m will be replaced by the error message--- string strerror(errno). A trailing newline may be added if needed.--foreign import ccall unsafe "syslog" _syslog :: CInt -> CString -> IO ()

@@ -1,8 +0,0 @@--- doctest.hs--module Main ( main ) where--import Test.DocTest--main :: IO ()-main = doctest [ "dist/build/System/Posix/Syslog.hs" ]

@@ -1,9 +1,9 @@ Name:                   hsyslog-Version:                2.0-Copyright:              Peter Simons+Version:                3+Copyright:              Copyright (c) 2004-2016 by Peter Simons License:                BSD3 License-File:           LICENSE-Author:                 Peter Simons <simons@cryp.to>+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@@ -14,20 +14,26 @@                         further details. Cabal-Version:          >= 1.8 Build-Type:             Simple-Tested-With:            GHC >= 6.10.4 && <= 7.8.3+Tested-With:            GHC > 7.6 && < 8.1  Source-Repository head   Type:                 git   Location:             git://github.com/peti/hsyslog.git  Library+  Hs-Source-Dirs:       src   Build-Depends:        base >= 3 && < 5-  Extensions:           ForeignFunctionInterface+                      , bytestring == 0.10.*+  Extensions:           CApiFFI+                      , ForeignFunctionInterface+                      , OverloadedStrings   Exposed-Modules:      System.Posix.Syslog-  Ghc-Options:          -Wall -Test-Suite self-test-  type:                 exitcode-stdio-1.0-  main-is:              doctest.hs-  Build-Depends:        base, doctest-  Ghc-Options:          -Wall+Test-Suite tests+  Hs-Source-Dirs:       test+  Main-Is:              Main.hs+  Type:                 exitcode-stdio-1.0+  Build-Depends:        base+                      , bytestring+                      , hsyslog+                      , QuickCheck

@@ -0,0 +1,369 @@+{-# 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://www.opengroup.org/onlinepubs/009695399/basedefs/syslog.h.html POSIX.1-2001>.+-}++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+    -- | These are also the most performant calls to syslog, with the minimum+    -- amount of 'CString' copying necessary.+  , withSyslog+  , SyslogFn+  , withSyslogTo+  , SyslogToFn+    -- * The unsafe Haskell API to syslog+    -- | Using these functions provides no guarantee that a call to '_openlog'+    -- has been made.+  , syslogUnsafe+  , syslogToUnsafe+    -- * Low-level C functions+  , _openlog+  , _closelog+  , _setlogmask+  , _syslog+    -- ** Low-level C macros+    -- | See the+    -- <http://www.gnu.org/software/libc/manual/html_node/Submitting-Syslog-Messages.html GNU libc documentation>+    -- for their intended usage.+  , _LOG_MASK+  , _LOG_UPTO+  , _LOG_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)++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)++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)++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+  , defaultFacilities :: [Facility]   -- ^ facilities logged to when none are provided+  , 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', and provide a logging function which can be used as follows:+--+-- > main = withSyslog defaultConfig $ \syslog -> do+-- >          putStrLn "huhu"+-- >          syslog [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 =+    withinOpenCloseSyslog config $ do+      useAsCString escape (f . flip syslogEscaped [])+      return ()++-- |The type of logging function provided by 'withSyslog'.++type SyslogFn+  =  [Priority] -- ^ the priorities under which to log+  -> ByteString -- ^ the message to log+  -> IO ()++-- |Like 'withSyslog' but provides a function for logging to specific+-- facilities per message rather than the default facilities in your+-- 'SyslogConfig'.++withSyslogTo :: SyslogConfig -> (SyslogToFn -> IO ()) -> IO ()+withSyslogTo config f =+    withinOpenCloseSyslog config $ do+      useAsCString escape (f . syslogEscaped)+      return ()++-- |The type of function provided by 'withSyslogTo'.++type SyslogToFn+  =  [Facility] -- ^ the facilities to log to+  -> [Priority] -- ^ the priorities under which to log+  -> ByteString -- ^ the message to log+  -> IO ()++syslogUnsafe :: SyslogFn+syslogUnsafe = syslogToUnsafe []++syslogToUnsafe :: SyslogToFn+syslogToUnsafe facs pris msg = useAsCString msg (_syslog (makePri facs pris))++-- |Open a connection to the system logger for a program. The string+-- identifier passed as the first argument is prepended to every+-- message, and is typically set to the program name. The behavior is+-- unspecified by POSIX.1-2008 if that identifier is 'nullPtr'.++foreign import ccall unsafe "openlog" _openlog :: CString -> CInt -> CInt -> IO ()++-- |Close the descriptor being used to write to the system logger.++foreign import ccall unsafe "closelog" _closelog :: IO ()++-- |A process has a log priority mask that determines which calls to+-- syslog may be logged. All other calls will be ignored. Logging is+-- enabled for the priorities that have the corresponding bit set in+-- mask. The initial mask is such that logging is enabled for all+-- priorities. This function sets this logmask for the calling process,+-- and returns the previous mask. If the mask argument is 0, the current+-- logmask is not modified.++foreign import ccall unsafe "setlogmask" _setlogmask :: CInt -> IO CInt++-- |Generate a log message, which will be distributed by @syslogd(8)@.+-- The priority argument is formed by ORing the facility and the level+-- values (explained below). The remaining arguments are a format, as in+-- printf(3) and any arguments required by the format, except that the+-- two character sequence %m will be replaced by the error message+-- string strerror(errno). A trailing newline may be added if needed.++_syslog :: CInt -> CString -> IO ()+_syslog int msg = useAsCString escape $ \e -> _syslogEscaped int e msg++foreign import capi "syslog.h LOG_MASK" _LOG_MASK :: CInt -> CInt+foreign import capi "syslog.h LOG_UPTO" _LOG_UPTO :: CInt -> CInt+foreign import capi "syslog.h LOG_MAKEPRI" _LOG_MAKEPRI :: CInt -> CInt -> CInt++-- internal functions++bitsOrWith :: (Bits b, Num b) => (a -> b) -> [a] -> b+bitsOrWith f = foldl' (\bits x -> f x .|. bits) 0++makePri :: [Facility] -> [Priority] -> CInt+makePri facs pris =+    _LOG_MAKEPRI (bitsOrWith fromFacility facs) (bitsOrWith fromPriority pris)++foreign import ccall unsafe "syslog" _syslogEscaped+  :: CInt -> CString -> CString -> IO ()++syslogEscaped :: CString -> [Facility] -> [Priority] -> ByteString -> IO ()+syslogEscaped esc facs pris msg =+    useAsCString msg (_syslogEscaped (makePri facs pris) esc)++escape :: ByteString+escape = "%s"++withinOpenCloseSyslog :: SyslogConfig -> IO () -> IO ()+withinOpenCloseSyslog config run =+    useAsCString (identifier config) $ \cIdent ->+      let++        open :: IO ()+        open = do+            _openlog cIdent cOpts cFacs+            _setlogmask cMask+            return ()+          where+            cFacs = bitsOrWith fromFacility $ defaultFacilities config+            cMask = fromPriorityMask $ priorityMask config+            cOpts = bitsOrWith fromOption $ options config++        close :: IO ()+        close = _closelog++      in bracket_ open close run

@@ -0,0 +1,48 @@+{-# 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++main :: IO ()+main = do+  dontExplodeTest+  outputTest++{--+ 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 [Debug, Error] "%s%d hsyslog is working :)"+    syslog [Error] "hsyslog is not working :("+  where+    config = defaultConfig+        { options = [PERROR, NDELAY]+        , priorityMask = Mask [Debug, Alert]+        }++dontExplodeTest :: IO ()+dontExplodeTest = withSyslogTo defaultConfig $ \syslogTo -> do+    let+      prop_dontExplode :: [Facility] -> [Priority] -> ByteString -> Property+      prop_dontExplode facs pris msg = ioProperty $ do+          syslogTo facs pris msg+          return succeeded+    quickCheck prop_dontExplode