hsyslog 1.6 → 2.0
raw patch · 3 files changed
+105/−38 lines, 3 filesdep +doctestdep ~base
Dependencies added: doctest
Dependency ranges changed: base
Files
- System/Posix/Syslog.hsc +88/−35
- doctest.hs +8/−0
- hsyslog.cabal +9/−3
System/Posix/Syslog.hsc view
@@ -4,20 +4,18 @@ #endif {- | Module : System.Posix.Syslog- Copyright : (c) 2008 Peter Simons- License : BSD3- Maintainer : simons@cryp.to Stability : provisional Portability : Posix - FFI bindings to Unix's @syslog(3)@. Process this file- with @hsc2hs@ to obtain a Haskell module.+ 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@@ -39,6 +37,12 @@ -- * 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@@ -49,7 +53,7 @@ | Notice -- ^ normal but significant condition | Info -- ^ informational | Debug -- ^ debug-level messages- deriving ( Eq, Bounded, Show+ deriving ( Eq, Bounded, Show, Read #if __GLASGOW_HASKELL__ >= 706 , Generic #endif@@ -99,7 +103,7 @@ | LOCAL5 -- ^ reserved for local use | LOCAL6 -- ^ reserved for local use | LOCAL7 -- ^ reserved for local use- deriving (Eq, Bounded, Show)+ deriving (Eq, Bounded, Show, Read) instance Enum Facility where toEnum #{const LOG_KERN} = KERN@@ -174,41 +178,72 @@ -- * Haskell API to syslog --- |Bracket an 'IO' computation between calls to '_openlog'--- and '_closelog'. Since these settings are for the--- /process/, multiple calls to this function will,--- unfortunately, overwrite each other.------ Example:+-- |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 $ do+-- > 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 -> IO a -> IO a-withSyslog ident opts facil f = do- let opt = toEnum . sum . map fromEnum $ opts- let fac = toEnum . fromEnum $ facil- withCString ident $ \p ->- bracket_ (_openlog p opt fac) (_closelog) f+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) --- * Helpers+-- |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] --- | @useSyslog ident@ @=@ @withSyslog ident [PID, PERROR] USER@+logUpTo :: Priority -> [Priority]+logUpTo p = [minBound .. p] -useSyslog :: String -> IO a -> IO a-useSyslog ident = withSyslog ident [PID, PERROR] USER+-- * Helpers --- |Escape any occurances of \'@%@\' in a string, so that it--- is safe to pass it to '_syslog'. The 'syslog' wrapper--- does this automatically.+-- |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 [] = []@@ -217,14 +252,32 @@ -- * Low-level C functions -foreign import ccall unsafe "closelog" _closelog ::- IO ()+-- |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 ()+foreign import ccall unsafe "openlog" _openlog :: CString -> CInt -> CInt -> IO () -foreign import ccall unsafe "setlogmask" _setlogmask ::- CInt -> IO CInt+-- |Close the descriptor being used to write to the system logger. -foreign import ccall unsafe "syslog" _syslog ::- CInt -> CString -> IO ()+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 ()
+ doctest.hs view
@@ -0,0 +1,8 @@+-- doctest.hs++module Main ( main ) where++import Test.DocTest++main :: IO ()+main = doctest [ "dist/build/System/Posix/Syslog.hs" ]
hsyslog.cabal view
@@ -1,5 +1,5 @@ Name: hsyslog-Version: 1.6+Version: 2.0 Copyright: Peter Simons License: BSD3 License-File: LICENSE@@ -12,9 +12,9 @@ Description: This library provides FFI bindings to syslog(3) from POSIX.1-2001. See <http://www.opengroup.org/onlinepubs/009695399/basedefs/syslog.h.html> for further details.-Cabal-Version: >= 1.6+Cabal-Version: >= 1.8 Build-Type: Simple-Tested-With: GHC >= 6.10.4 && <= 7.6.3+Tested-With: GHC >= 6.10.4 && <= 7.8.3 Source-Repository head Type: git@@ -24,4 +24,10 @@ Build-Depends: base >= 3 && < 5 Extensions: ForeignFunctionInterface 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