hsyslog-2.0/0000755000000000000000000000000012371124714011233 5ustar0000000000000000hsyslog-2.0/doctest.hs0000644000000000000000000000020512371124714013231 0ustar0000000000000000-- doctest.hs module Main ( main ) where import Test.DocTest main :: IO () main = doctest [ "dist/build/System/Posix/Syslog.hs" ] hsyslog-2.0/LICENSE0000644000000000000000000000260112371124714012237 0ustar0000000000000000Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * The names of its contributors may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hsyslog-2.0/Setup.lhs0000644000000000000000000000017412371124714013045 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main (main) where > > import Distribution.Simple > > main :: IO () > main = defaultMain hsyslog-2.0/hsyslog.cabal0000644000000000000000000000240212371124714013705 0ustar0000000000000000Name: hsyslog Version: 2.0 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.8 Build-Type: Simple Tested-With: GHC >= 6.10.4 && <= 7.8.3 Source-Repository head Type: git Location: git://github.com/peti/hsyslog.git Library 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 hsyslog-2.0/System/0000755000000000000000000000000012371124714012517 5ustar0000000000000000hsyslog-2.0/System/Posix/0000755000000000000000000000000012371124714013621 5ustar0000000000000000hsyslog-2.0/System/Posix/Syslog.hsc0000644000000000000000000002464612371124714015614 0ustar0000000000000000{-# 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 . -} module System.Posix.Syslog where import Control.Exception ( bracket_ ) import Data.Bits 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. -- -- 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 -- (). 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' -- (). -- -- 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' (). 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 -- (). 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 ()