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 - psim...@suse.com
+
+- 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 : sim...@cryp.to
- 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 <sim...@cryp.to>
+Author: Peter Simons, John Lato, Jonathan Childress
Maintainer: Peter Simons <sim...@cryp.to>
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 : sim...@cryp.to
+ 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
