Hello community, here is the log from the commit of package ghc-hsyslog for openSUSE:Factory checked in at 2017-03-24 02:18:19 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-hsyslog (Old) and /work/SRC/openSUSE:Factory/.ghc-hsyslog.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-hsyslog" Fri Mar 24 02:18:19 2017 rev:2 rq:479410 version:4 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-hsyslog/ghc-hsyslog.changes 2017-03-08 00:55:56.239825865 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-hsyslog.new/ghc-hsyslog.changes 2017-03-24 02:18:20.320215046 +0100 @@ -1,0 +2,5 @@ +Thu Sep 15 06:42:07 UTC 2016 - [email protected] + +- Update to version 4 revision 0 with cabal2obs. + +------------------------------------------------------------------- Old: ---- hsyslog-2.0.tar.gz New: ---- hsyslog-4.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-hsyslog.spec ++++++ --- /var/tmp/diff_new_pack.amAHKe/_old 2017-03-24 02:18:20.756153365 +0100 +++ /var/tmp/diff_new_pack.amAHKe/_new 2017-03-24 02:18:20.760152799 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-hsyslog # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,26 +19,25 @@ %global pkg_name hsyslog %bcond_with tests Name: ghc-%{pkg_name} -Version: 2.0 +Version: 4 Release: 0 Summary: FFI interface to syslog(3) from POSIX.1-2001 License: BSD-3-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel +BuildRequires: ghc-bytestring-devel BuildRequires: ghc-rpm-macros BuildRoot: %{_tmppath}/%{name}-%{version}-build -# Begin cabal-rpm deps: %if %{with tests} -BuildRequires: ghc-doctest-devel +BuildRequires: ghc-QuickCheck-devel %endif -# End cabal-rpm deps %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. +This library provides FFI bindings to syslog(3) from +<http://pubs.opengroup.org/onlinepubs/9699919799/basedefs/syslog.h.html +POSIX.1-2008>. %package devel Summary: Haskell %{pkg_name} library development files @@ -54,20 +53,14 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %check -%if %{with tests} -%{cabal} test -%endif - +%cabal_test %post devel %ghc_pkg_recache @@ -81,6 +74,5 @@ %files devel -f %{name}-devel.files %defattr(-,root,root,-) -%doc doctest.hs %changelog ++++++ hsyslog-2.0.tar.gz -> hsyslog-4.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hsyslog-2.0/System/Posix/Syslog.hsc new/hsyslog-4/System/Posix/Syslog.hsc --- old/hsyslog-2.0/System/Posix/Syslog.hsc 2014-08-08 12:43:24.000000000 +0200 +++ new/hsyslog-4/System/Posix/Syslog.hsc 1970-01-01 01:00:00.000000000 +0100 @@ -1,283 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} -#if __GLASGOW_HASKELL__ >= 706 -{-# LANGUAGE DeriveGeneric #-} -#endif -{- | - Module : System.Posix.Syslog - Maintainer : [email protected] - Stability : provisional - Portability : Posix - - 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 -#endif - -#include <syslog.h> -#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 --- (<https://github.com/peti/hsyslog/issues/5 issue #5>). - -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' --- (<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) - --- |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 --- (<https://github.com/peti/hsyslog/issues/8 issue #8>). - -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 () diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hsyslog-2.0/doctest.hs new/hsyslog-4/doctest.hs --- old/hsyslog-2.0/doctest.hs 2014-08-08 12:43:24.000000000 +0200 +++ new/hsyslog-4/doctest.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,8 +0,0 @@ --- doctest.hs - -module Main ( main ) where - -import Test.DocTest - -main :: IO () -main = doctest [ "dist/build/System/Posix/Syslog.hs" ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hsyslog-2.0/hsyslog.cabal new/hsyslog-4/hsyslog.cabal --- old/hsyslog-2.0/hsyslog.cabal 2014-08-08 12:43:24.000000000 +0200 +++ new/hsyslog-4/hsyslog.cabal 2016-06-03 18:53:08.000000000 +0200 @@ -1,33 +1,38 @@ Name: hsyslog -Version: 2.0 -Copyright: Peter Simons +Version: 4 +Copyright: Copyright (c) 2004-2016 by Peter Simons License: BSD3 License-File: LICENSE -Author: Peter Simons <[email protected]> +Author: Peter Simons, John Lato, Jonathan Childress Maintainer: Peter Simons <[email protected]> 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 <http://www.opengroup.org/onlinepubs/009695399/basedefs/syslog.h.html> for - further details. +Description: This library provides FFI bindings to syslog(3) from + <http://pubs.opengroup.org/onlinepubs/9699919799/basedefs/syslog.h.html POSIX.1-2008>. Cabal-Version: >= 1.8 Build-Type: Simple -Tested-With: GHC >= 6.10.4 && <= 7.8.3 +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 - Extensions: ForeignFunctionInterface + , bytestring == 0.10.* + Extensions: CApiFFI + , ForeignFunctionInterface + , OverloadedStrings 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 +Test-Suite tests + Hs-Source-Dirs: test + Main-Is: Main.hs + Type: exitcode-stdio-1.0 + Build-Depends: base + , bytestring + , hsyslog + , QuickCheck diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hsyslog-2.0/src/System/Posix/Syslog.hsc new/hsyslog-4/src/System/Posix/Syslog.hsc --- old/hsyslog-2.0/src/System/Posix/Syslog.hsc 1970-01-01 01:00:00.000000000 +0100 +++ new/hsyslog-4/src/System/Posix/Syslog.hsc 2016-06-03 18:53:08.000000000 +0200 @@ -0,0 +1,342 @@ +{-# LANGUAGE + CApiFFI + , ForeignFunctionInterface + , OverloadedStrings + #-} + +#if __GLASGOW_HASKELL__ >= 706 +{-# LANGUAGE DeriveGeneric #-} +#endif + +{- | + Module : System.Posix.Syslog + Maintainer : [email protected] + Stability : provisional + Portability : Posix + + FFI bindings to syslog(3) from + <http://pubs.opengroup.org/onlinepubs/9699919799/basedefs/syslog.h.html POSIX.1-2008>. +-} + +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 + -- <http://pubs.opengroup.org/onlinepubs/9699919799/functions/closelog.html POSIX.1-2008 documentation>. + , _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 <syslog.h> +#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) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hsyslog-2.0/test/Main.hs new/hsyslog-4/test/Main.hs --- old/hsyslog-2.0/test/Main.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hsyslog-4/test/Main.hs 2016-06-03 18:53:08.000000000 +0200 @@ -0,0 +1,48 @@ +{-# 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
