diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Distribution.Simple + +main :: IO () +main = defaultMain diff --git a/Setup.lhs b/Setup.lhs deleted file mode 100644 --- a/Setup.lhs +++ /dev/null @@ -1,8 +0,0 @@ -#!/usr/bin/env runhaskell - -> module Main (main) where -> -> import Distribution.Simple -> -> main :: IO () -> main = defaultMain diff --git a/System/Posix/Syslog.hsc b/System/Posix/Syslog.hsc deleted file mode 100644 --- a/System/Posix/Syslog.hsc +++ /dev/null @@ -1,230 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} -#if __GLASGOW_HASKELL__ >= 706 -{-# LANGUAGE DeriveGeneric #-} -#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. --} - -module System.Posix.Syslog where - -import Control.Exception ( bracket_ ) -import Foreign.C -#if __GLASGOW_HASKELL__ >= 706 -import GHC.Generics -#endif - -#include -#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. - -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 -#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) - -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' --- and '_closelog'. Since these settings are for the --- /process/, multiple calls to this function will, --- unfortunately, overwrite each other. --- --- Example: --- --- > main = withSyslog "my-ident" [PID, PERROR] USER $ do --- > putStrLn "huhu" --- > syslog Debug "huhu" - -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 - --- |Log a message with the given priority. - -syslog :: Priority -> String -> IO () -syslog l msg = - withCString (safeMsg msg) - (\p -> _syslog (toEnum (fromEnum l)) p) - --- * Helpers - --- | @useSyslog ident@ @=@ @withSyslog ident [PID, PERROR] USER@ - -useSyslog :: String -> IO a -> IO a -useSyslog ident = withSyslog ident [PID, PERROR] USER - --- |Escape any occurances of \'@%@\' in a string, so that it --- is safe to pass it to '_syslog'. The 'syslog' wrapper --- does this automatically. - -safeMsg :: String -> String -safeMsg [] = [] -safeMsg ('%':xs) = '%' : '%' : safeMsg xs -safeMsg ( x :xs) = x : safeMsg xs - --- * Low-level C functions - -foreign import ccall unsafe "closelog" _closelog :: - IO () - -foreign import ccall unsafe "openlog" _openlog :: - CString -> CInt -> CInt -> IO () - -foreign import ccall unsafe "setlogmask" _setlogmask :: - CInt -> IO CInt - -foreign import ccall unsafe "syslog" _syslog :: - CInt -> CString -> IO () diff --git a/c-bits/make-log-mask.c b/c-bits/make-log-mask.c new file mode 100644 --- /dev/null +++ b/c-bits/make-log-mask.c @@ -0,0 +1,6 @@ +#include + +int makeLogMask(int priority) +{ + return LOG_MASK(priority); +} diff --git a/c-bits/simple-syslog.c b/c-bits/simple-syslog.c new file mode 100644 --- /dev/null +++ b/c-bits/simple-syslog.c @@ -0,0 +1,27 @@ +#include + +/* + A variant of syslog(3) that provides a simplified API to address the + following issues: + + - Calling variadic functions via FFI kind-of "just works", but the Haskell + standard actually doesn't guarantee that it does. There's a GHC extension, + CApiFFI, which addresses this issue, but that extension isn't part of any + Haskell standard either. + + - Strings in Haskell are almost never terminated by a \0 byte, but we tend + to know their length, so it's more convenient (and more efficient) to + specify an explicit maximum field length in the format string via "%.*s" + and pass our string as an argument to that. A welcome side-effect of this + approach is that the call won't try to interpret any of those freaky % + formatting features that we can't support (and don't want to, really). + + Note that this function makes no effort to verify the validity of its + arguments. If you want to pass a negative string length, null pointers, and + non-existent facilities here ... have at it and see what happens! + */ + +void simpleSyslog(int facility, int priority, const char * buf, int len) +{ + syslog(facility | priority, "%.*s", len, buf); +} diff --git a/example/Main.hs b/example/Main.hs new file mode 100644 --- /dev/null +++ b/example/Main.hs @@ -0,0 +1,44 @@ +-- 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 any explicit conversions. 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) diff --git a/hsyslog.cabal b/hsyslog.cabal --- a/hsyslog.cabal +++ b/hsyslog.cabal @@ -1,27 +1,65 @@ -Name: hsyslog -Version: 1.6 -Copyright: Peter Simons -License: BSD3 -License-File: LICENSE -Author: Peter Simons -Maintainer: Peter Simons -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 POSIX.1-2001. - See for - further details. -Cabal-Version: >= 1.6 -Build-Type: Simple -Tested-With: GHC >= 6.10.4 && <= 7.6.3 +name: hsyslog +version: 5.0.2 +cabal-version: >= 1.10 +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 +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.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2 + , GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3 -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 - Build-Depends: base >= 3 && < 5 - Extensions: ForeignFunctionInterface - Exposed-Modules: System.Posix.Syslog - Ghc-Options: -Wall +description: + A Haskell interface to @syslog(3)@ as specified in + . + 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 + directory of + this package. + +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 + default-language: Haskell2010 + build-tools: hsc2hs + +executable hsyslog-example + main-is: Main.hs + hs-source-dirs: example + if flag(install-examples) + buildable: True + build-depends: base, hsyslog, bytestring + other-extensions: TypeSynonymInstances, FlexibleInstances + else + buildable: False + default-language: Haskell2010 diff --git a/src/System/Posix/Syslog.hs b/src/System/Posix/Syslog.hs new file mode 100644 --- /dev/null +++ b/src/System/Posix/Syslog.hs @@ -0,0 +1,115 @@ +{- | + Maintainer: simons@cryp.to + Stability: provisional + Portability: POSIX + + A Haskell interface to @syslog(3)@ as specified in + . + 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 + + 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) $ + _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 program. 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)) diff --git a/src/System/Posix/Syslog/Facility.hsc b/src/System/Posix/Syslog/Facility.hsc new file mode 100644 --- /dev/null +++ b/src/System/Posix/Syslog/Facility.hsc @@ -0,0 +1,65 @@ +{-# LANGUAGE DeriveGeneric #-} + +{- | + Maintainer: simons@cryp.to + Stability: provisional + Portability: POSIX + + FFI bindings to @syslog(3)@ from + . + 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 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} diff --git a/src/System/Posix/Syslog/Functions.hs b/src/System/Posix/Syslog/Functions.hs new file mode 100644 --- /dev/null +++ b/src/System/Posix/Syslog/Functions.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +{- | + Maintainer: simons@cryp.to + Stability: provisional + Portability: POSIX + + Low-level FFI bindings to @syslog(3)@ et al from + . + 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 +-- 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 , +-- 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 +-- imported into Haskell directly as an "unsafe" foreign function call. +foreign import ccall unsafe "syslog.h closelog" _closelog :: IO () + +-- | The POSIX function +-- 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 +-- 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 diff --git a/src/System/Posix/Syslog/LogMask.hs b/src/System/Posix/Syslog/LogMask.hs new file mode 100644 --- /dev/null +++ b/src/System/Posix/Syslog/LogMask.hs @@ -0,0 +1,31 @@ +{- | + Maintainer: simons@cryp.to + Stability: provisional + Portability: POSIX + + FFI bindings to @syslog(3)@ from + . + 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 ((.|.) . _logMask . fromPriority) 0 + +-- | 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 ] diff --git a/src/System/Posix/Syslog/Options.hsc b/src/System/Posix/Syslog/Options.hsc new file mode 100644 --- /dev/null +++ b/src/System/Posix/Syslog/Options.hsc @@ -0,0 +1,44 @@ +{-# LANGUAGE DeriveGeneric #-} + +{- | + Maintainer: simons@cryp.to + Stability: provisional + Portability: POSIX + + FFI bindings to @syslog(3)@ from + . + 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 + +-- | The function 'openlog' allows one to configure a handful of process-wide +-- options that modify the behavior of the 'syslog' function. 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 -- ^ Initialize 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} diff --git a/src/System/Posix/Syslog/Priority.hsc b/src/System/Posix/Syslog/Priority.hsc new file mode 100644 --- /dev/null +++ b/src/System/Posix/Syslog/Priority.hsc @@ -0,0 +1,61 @@ +{-# LANGUAGE DeriveGeneric #-} + +{- | + Maintainer: simons@cryp.to + Stability: provisional + Portability: POSIX + + FFI bindings to @syslog(3)@ from + . + 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 + +-- * 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}