diff --git a/hsyslog.cabal b/hsyslog.cabal --- a/hsyslog.cabal +++ b/hsyslog.cabal @@ -1,5 +1,5 @@ Name: hsyslog -Version: 3 +Version: 4 Copyright: Copyright (c) 2004-2016 by Peter Simons License: BSD3 License-File: LICENSE @@ -9,9 +9,8 @@ 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 POSIX.1-2001. - See for - further details. +Description: This library provides FFI bindings to syslog(3) from + . Cabal-Version: >= 1.8 Build-Type: Simple Tested-With: GHC > 7.6 && < 8.1 diff --git a/src/System/Posix/Syslog.hsc b/src/System/Posix/Syslog.hsc --- a/src/System/Posix/Syslog.hsc +++ b/src/System/Posix/Syslog.hsc @@ -15,7 +15,7 @@ Portability : Posix FFI bindings to syslog(3) from - . + . -} module System.Posix.Syslog @@ -35,29 +35,24 @@ , 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 + -- | See the + -- . , _openlog , _closelog , _setlogmask , _syslog -- ** Low-level C macros - -- | See the - -- - -- for their intended usage. + , _LOG_MAKEPRI , _LOG_MASK , _LOG_UPTO - , _LOG_MAKEPRI + -- * Utilities + -- | Low-level utilities for syslog-related tools + , makePri ) where import Control.Exception (bracket_) @@ -83,7 +78,7 @@ #define LOG_PERROR 0 #endif --- |Log messages have a priority attached. +-- | Log messages have a priority attached. data Priority = Emergency -- ^ system is unusable @@ -121,8 +116,8 @@ fromPriority Info = #{const LOG_INFO} fromPriority Debug = #{const LOG_DEBUG} --- |Syslog distinguishes various system facilities. Most --- applications should log in 'USER'. +-- | Syslog distinguishes various system facilities. Most applications should +-- log in 'USER'. data Facility = KERN -- ^ kernel messages @@ -145,7 +140,11 @@ | LOCAL5 -- ^ reserved for local use | LOCAL6 -- ^ reserved for local use | LOCAL7 -- ^ reserved for local use - deriving (Bounded, Enum, Eq, Show, Read) + deriving ( Bounded, Enum, Eq, Show, Read +#if __GLASGOW_HASKELL__ >= 706 + , Generic +#endif + ) toFacility :: CInt -> Facility toFacility #{const LOG_KERN} = KERN @@ -192,7 +191,7 @@ fromFacility LOCAL6 = #{const LOG_LOCAL6} fromFacility LOCAL7 = #{const LOG_LOCAL7} --- |'withSyslog' options for the syslog service. +-- | 'withSyslog' options for the syslog service. data Option = PID -- ^ log the pid with each message @@ -201,7 +200,11 @@ | 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) + deriving ( Bounded, Enum, Eq, Show, Read +#if __GLASGOW_HASKELL__ >= 706 + , Generic +#endif + ) toOption :: CInt -> Option toOption #{const LOG_PID} = PID @@ -220,13 +223,17 @@ fromOption NOWAIT = #{const LOG_NOWAIT} fromOption PERROR = #{const LOG_PERROR} --- |`withSyslog` options for the priority mask +-- | '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) + deriving ( Eq, Show, Read +#if __GLASGOW_HASKELL__ >= 706 + , Generic +#endif + ) fromPriorityMask :: PriorityMask -> CInt fromPriorityMask (Mask pris) = bitsOrWith (_LOG_MASK . fromPriority) pris @@ -234,136 +241,102 @@ 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 + { 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 +-- | A practical default syslog config. You'll at least want to change the -- identifier. defaultConfig :: SyslogConfig -defaultConfig = SyslogConfig "hsyslog" [ODELAY] [USER] NoMask +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: +-- | 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 [Debug] "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 = - 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 () + 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 --- |Like 'withSyslog' but provides a function for logging to specific --- facilities per message rather than the default facilities in your --- 'SyslogConfig'. + close :: IO () + close = _closelog -withSyslogTo :: SyslogConfig -> (SyslogToFn -> IO ()) -> IO () -withSyslogTo config f = - withinOpenCloseSyslog config $ do - useAsCString escape (f . syslogEscaped) - return () + run :: IO () + run = do + useAsCString escape (f . syslogEscaped) + return () + in + bracket_ open close run --- |The type of function provided by 'withSyslogTo'. +-- | The type of function provided by 'withSyslog'. -type SyslogToFn - = [Facility] -- ^ the facilities to log to - -> [Priority] -- ^ the priorities under which to log +type SyslogFn + = Facility -- ^ the facility to log to + -> Priority -- ^ the priority under which to log -> ByteString -- ^ the message to log -> IO () -syslogUnsafe :: SyslogFn -syslogUnsafe = syslogToUnsafe [] +-- | Provides no guarantee that a call to '_openlog' has been made, inviting +-- unpredictable results. -syslogToUnsafe :: SyslogToFn -syslogToUnsafe facs pris msg = useAsCString msg (_syslog (makePri facs pris)) +syslogUnsafe :: SyslogFn +syslogUnsafe fac pri msg = useAsCString msg (_syslog (makePri fac pri)) --- |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 imports 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" _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 -foreign import capi "syslog.h LOG_MAKEPRI" _LOG_MAKEPRI :: CInt -> CInt -> CInt --- internal functions +-- utilities -bitsOrWith :: (Bits b, Num b) => (a -> b) -> [a] -> b -bitsOrWith f = foldl' (\bits x -> f x .|. bits) 0 +-- | Calculate the full priority value of a 'Facility' and 'Priority' -makePri :: [Facility] -> [Priority] -> CInt -makePri facs pris = - _LOG_MAKEPRI (bitsOrWith fromFacility facs) (bitsOrWith fromPriority pris) +makePri :: Facility -> Priority -> CInt +makePri fac pri = _LOG_MAKEPRI (fromFacility fac) (fromPriority pri) -foreign import ccall unsafe "syslog" _syslogEscaped - :: CInt -> CString -> CString -> IO () +-- internal functions -syslogEscaped :: CString -> [Facility] -> [Priority] -> ByteString -> IO () -syslogEscaped esc facs pris msg = - useAsCString msg (_syslogEscaped (makePri facs pris) esc) +bitsOrWith :: (Bits b, Num b) => (a -> b) -> [a] -> b +bitsOrWith f = foldl' (\bits x -> f x .|. bits) 0 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 +syslogEscaped :: CString -> Facility -> Priority -> ByteString -> IO () +syslogEscaped esc fac pri msg = + useAsCString msg (_syslogEscaped (makePri fac pri) esc) diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -18,8 +18,8 @@ main :: IO () main = do - dontExplodeTest outputTest + dontExplodeTest {-- This isn't a true test. Instead, we're passing the PERROR option (meaning @@ -30,8 +30,8 @@ --} outputTest :: IO () outputTest = withSyslog config $ \syslog -> do - syslog [Debug, Error] "%s%d hsyslog is working :)" - syslog [Error] "hsyslog is not working :(" + syslog USER Debug "%s%d hsyslog is working :)" + syslog USER Error "hsyslog is not working :(" where config = defaultConfig { options = [PERROR, NDELAY] @@ -39,10 +39,10 @@ } dontExplodeTest :: IO () -dontExplodeTest = withSyslogTo defaultConfig $ \syslogTo -> do +dontExplodeTest = withSyslog defaultConfig $ \syslog -> do let - prop_dontExplode :: [Facility] -> [Priority] -> ByteString -> Property - prop_dontExplode facs pris msg = ioProperty $ do - syslogTo facs pris msg + prop_dontExplode :: Facility -> Priority -> ByteString -> Property + prop_dontExplode fac pri msg = ioProperty $ do + syslog fac pri msg return succeeded quickCheck prop_dontExplode