hsyslog-4/0000755000000000000000000000000012724332764011107 5ustar0000000000000000hsyslog-4/LICENSE0000644000000000000000000000260112724332764012113 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-4/Setup.lhs0000644000000000000000000000017412724332764012721 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main (main) where > > import Distribution.Simple > > main :: IO () > main = defaultMain hsyslog-4/hsyslog.cabal0000644000000000000000000000267512724332764013575 0ustar0000000000000000Name: hsyslog Version: 4 Copyright: Copyright (c) 2004-2016 by Peter Simons License: BSD3 License-File: LICENSE Author: Peter Simons, John Lato, Jonathan Childress 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 . Cabal-Version: >= 1.8 Build-Type: Simple 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 , bytestring == 0.10.* Extensions: CApiFFI , ForeignFunctionInterface , OverloadedStrings Exposed-Modules: System.Posix.Syslog Test-Suite tests Hs-Source-Dirs: test Main-Is: Main.hs Type: exitcode-stdio-1.0 Build-Depends: base , bytestring , hsyslog , QuickCheck hsyslog-4/src/0000755000000000000000000000000012724332764011676 5ustar0000000000000000hsyslog-4/src/System/0000755000000000000000000000000012724332764013162 5ustar0000000000000000hsyslog-4/src/System/Posix/0000755000000000000000000000000012724332764014264 5ustar0000000000000000hsyslog-4/src/System/Posix/Syslog.hsc0000644000000000000000000002542412724332764016252 0ustar0000000000000000{-# 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 . -} 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 , withSyslog , SyslogFn -- * The unsafe Haskell API to syslog , syslogUnsafe -- * Low-level C functions -- | See the -- . , _openlog , _closelog , _setlogmask , _syslog -- ** Low-level C macros , _LOG_MAKEPRI , _LOG_MASK , _LOG_UPTO -- * Utilities -- | Low-level utilities for syslog-related tools , 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 #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 #if __GLASGOW_HASKELL__ >= 706 , Generic #endif ) 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, Read #if __GLASGOW_HASKELL__ >= 706 , Generic #endif ) 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, Read #if __GLASGOW_HASKELL__ >= 706 , Generic #endif ) 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 , 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 -- identifier. defaultConfig :: SyslogConfig defaultConfig = SyslogConfig "hsyslog" [ODELAY] USER NoMask -- | 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 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 = 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 close :: IO () close = _closelog run :: IO () run = do useAsCString escape (f . syslogEscaped) return () in bracket_ open close run -- | The type of function provided by 'withSyslog'. type SyslogFn = Facility -- ^ the facility to log to -> Priority -- ^ the priority under which to log -> ByteString -- ^ the message to log -> IO () -- | Provides no guarantee that a call to '_openlog' has been made, inviting -- unpredictable results. syslogUnsafe :: SyslogFn syslogUnsafe fac pri msg = useAsCString msg (_syslog (makePri fac pri)) -- foreign imports foreign import ccall unsafe "openlog" _openlog :: CString -> CInt -> CInt -> IO () foreign import ccall unsafe "closelog" _closelog :: IO () foreign import ccall unsafe "setlogmask" _setlogmask :: CInt -> IO CInt 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 -- utilities -- | Calculate the full priority value of a 'Facility' and 'Priority' makePri :: Facility -> Priority -> CInt makePri fac pri = _LOG_MAKEPRI (fromFacility fac) (fromPriority pri) -- internal functions bitsOrWith :: (Bits b, Num b) => (a -> b) -> [a] -> b bitsOrWith f = foldl' (\bits x -> f x .|. bits) 0 escape :: ByteString escape = "%s" syslogEscaped :: CString -> Facility -> Priority -> ByteString -> IO () syslogEscaped esc fac pri msg = useAsCString msg (_syslogEscaped (makePri fac pri) esc) hsyslog-4/test/0000755000000000000000000000000012724332764012066 5ustar0000000000000000hsyslog-4/test/Main.hs0000644000000000000000000000260612724332764013312 0ustar0000000000000000{-# 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 outputTest dontExplodeTest {-- 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 USER Debug "%s%d hsyslog is working :)" syslog USER Error "hsyslog is not working :(" where config = defaultConfig { options = [PERROR, NDELAY] , priorityMask = Mask [Debug, Alert] } dontExplodeTest :: IO () dontExplodeTest = withSyslog defaultConfig $ \syslog -> do let prop_dontExplode :: Facility -> Priority -> ByteString -> Property prop_dontExplode fac pri msg = ioProperty $ do syslog fac pri msg return succeeded quickCheck prop_dontExplode