commit ghc-hsyslog for openSUSE:Factory
Hello community, here is the log from the commit of package ghc-hsyslog for openSUSE:Factory checked in at 2017-08-31 20:47:47 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-hsyslog (Old) and /work/SRC/openSUSE:Factory/.ghc-hsyslog.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-hsyslog" Thu Aug 31 20:47:47 2017 rev:3 rq:513393 version:5.0.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-hsyslog/ghc-hsyslog.changes 2017-03-24 02:18:20.320215046 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-hsyslog.new/ghc-hsyslog.changes 2017-08-31 20:47:48.840295634 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:58 UTC 2017 - psimons@suse.com + +- Update to version 5.0.1. + +------------------------------------------------------------------- Old: ---- hsyslog-4.tar.gz New: ---- hsyslog-5.0.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-hsyslog.spec ++++++ --- /var/tmp/diff_new_pack.kdJjFK/_old 2017-08-31 20:47:49.640183357 +0200 +++ /var/tmp/diff_new_pack.kdJjFK/_new 2017-08-31 20:47:49.652181673 +0200 @@ -19,7 +19,7 @@ %global pkg_name hsyslog %bcond_with tests Name: ghc-%{pkg_name} -Version: 4 +Version: 5.0.1 Release: 0 Summary: FFI interface to syslog(3) from POSIX.1-2001 License: BSD-3-Clause @@ -27,17 +27,25 @@ 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-cabal-doctest-devel BuildRequires: ghc-rpm-macros BuildRoot: %{_tmppath}/%{name}-%{version}-build %if %{with tests} -BuildRequires: ghc-QuickCheck-devel +BuildRequires: ghc-doctest-devel %endif %description -This library provides FFI bindings to syslog(3) from -<http://pubs.opengroup.org/onlinepubs/9699919799/basedefs/syslog.h.html -POSIX.1-2008>. +A Haskell interface to 'syslog(3)' as specified in +<http://pubs.opengroup.org/onlinepubs/9699919799/functions/syslog.html +POSIX.1-2008>. 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 <https://github.com/peti/hsyslog/blob/master/example/Main.hs examples> +directory of this package. %package devel Summary: Haskell %{pkg_name} library development files @@ -74,5 +82,6 @@ %files devel -f %{name}-devel.files %defattr(-,root,root,-) +%doc example %changelog ++++++ hsyslog-4.tar.gz -> hsyslog-5.0.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hsyslog-4/Setup.hs new/hsyslog-5.0.1/Setup.hs --- old/hsyslog-4/Setup.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hsyslog-5.0.1/Setup.hs 2017-07-07 14:05:07.000000000 +0200 @@ -0,0 +1,34 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wall #-} + +module Main ( main ) where + +#ifndef MIN_VERSION_cabal_doctest +#define MIN_VERSION_cabal_doctest(x,y,z) 0 +#endif + +#if MIN_VERSION_cabal_doctest(1,0,0) + +import Distribution.Extra.Doctest ( defaultMainWithDoctests ) +main :: IO () +main = defaultMainWithDoctests "doctests" + +#else + +#ifdef MIN_VERSION_Cabal +-- If the macro is defined, we have new cabal-install, +-- but for some reason we don't have cabal-doctest in package-db +-- +-- Probably we are running cabal sdist, when otherwise using new-build +-- workflow +#warning You are configuring this package without cabal-doctest installed. \ + The doctests test-suite will not work as a result. \ + To fix this, install cabal-doctest before configuring. +#endif + +import Distribution.Simple + +main :: IO () +main = defaultMain + +#endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hsyslog-4/Setup.lhs new/hsyslog-5.0.1/Setup.lhs --- old/hsyslog-4/Setup.lhs 2016-06-03 18:53:08.000000000 +0200 +++ new/hsyslog-5.0.1/Setup.lhs 1970-01-01 01:00:00.000000000 +0100 @@ -1,8 +0,0 @@ -#!/usr/bin/env runhaskell - -> module Main (main) where -> -> import Distribution.Simple -> -> main :: IO () -> main = defaultMain diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hsyslog-4/c-bits/make-log-mask.c new/hsyslog-5.0.1/c-bits/make-log-mask.c --- old/hsyslog-4/c-bits/make-log-mask.c 1970-01-01 01:00:00.000000000 +0100 +++ new/hsyslog-5.0.1/c-bits/make-log-mask.c 2017-07-07 14:05:07.000000000 +0200 @@ -0,0 +1,6 @@ +#include <syslog.h> + +int makeLogMask(int priority) +{ + return LOG_MASK(priority); +} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hsyslog-4/c-bits/simple-syslog.c new/hsyslog-5.0.1/c-bits/simple-syslog.c --- old/hsyslog-4/c-bits/simple-syslog.c 1970-01-01 01:00:00.000000000 +0100 +++ new/hsyslog-5.0.1/c-bits/simple-syslog.c 2017-07-07 14:05:07.000000000 +0200 @@ -0,0 +1,27 @@ +#include <syslog.h> + +/* + A variant of syslog(3) that provides a simplified API to addresses the + following issues: + + - Calling variadic functions via FFI kind-of sort-of works, but the Haskell + standard actually doesn't guarantee it. There is a GHC extension, CApiFFI, + which addresses this issue, but then that extension isn't part of any + Haskell standard either. + + - Strings in Haskell are almost never terminated by a \0 byte. We generally + do know their lengths, though, so it's more convenient to specify an + explicit maximum field length in the format string via "%.*s" and pass our + string as an argument to that. An added benefit is that our syslog + function doesn't interpret any of those freaky % formatting features that + can't support (and don't want to, really). + + Note that we totally don't make any effort whatsoever to guarantee + meaningful argument values. If you wan to pass a negative string length, + null pointers and non-existent facility values ... be our guest! + */ + +void simpleSyslog(int facility, int priority, const char * buf, int len) +{ + syslog(facility | priority, "%.*s", len, buf); +} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hsyslog-4/example/Main.hs new/hsyslog-5.0.1/example/Main.hs --- old/hsyslog-4/example/Main.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hsyslog-5.0.1/example/Main.hs 2017-07-07 14:05:07.000000000 +0200 @@ -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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hsyslog-4/hsyslog.cabal new/hsyslog-5.0.1/hsyslog.cabal --- old/hsyslog-4/hsyslog.cabal 2016-06-03 18:53:08.000000000 +0200 +++ new/hsyslog-5.0.1/hsyslog.cabal 2017-07-07 14:05:07.000000000 +0200 @@ -1,38 +1,77 @@ -Name: 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 <simons@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 - <http://pubs.opengroup.org/onlinepubs/9699919799/basedefs/syslog.h.html POSIX.1-2008>. -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 +name: hsyslog +version: 5.0.1 +cabal-version: >= 1.10 +build-type: Custom +license: BSD3 +license-file: LICENSE +copyright: Copyright (c) 2004-2017 by Peter Simons +author: Peter Simons, John Lato, Jonathan Childress +maintainer: Peter Simons <simons@cryp.to> +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 && < 8.3 + +extra-source-files: + c-bits/simple-syslog.c + c-bits/make-log-mask.c + +description: + A Haskell interface to @syslog(3)@ as specified in + <http://pubs.opengroup.org/onlinepubs/9699919799/functions/syslog.html POSIX.1-2008>. + 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 + <https://github.com/peti/hsyslog/blob/master/example/Main.hs examples> directory of + this package. + +custom-setup + setup-depends: base >= 4 && <5, + Cabal, + cabal-doctest >= 1 && <1.1 + +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 + +test-suite doctests + type: exitcode-stdio-1.0 + main-is: doctests.hs + hs-source-dirs: test + build-depends: hsyslog, base, doctest + ghc-options: -threaded + default-language: Haskell2010 + +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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hsyslog-4/src/System/Posix/Syslog/Facility.hsc new/hsyslog-5.0.1/src/System/Posix/Syslog/Facility.hsc --- old/hsyslog-4/src/System/Posix/Syslog/Facility.hsc 1970-01-01 01:00:00.000000000 +0100 +++ new/hsyslog-5.0.1/src/System/Posix/Syslog/Facility.hsc 2017-07-07 14:05:07.000000000 +0200 @@ -0,0 +1,65 @@ +{-# LANGUAGE DeriveGeneric #-} + +{- | + Maintainer: simons@cryp.to + Stability: provisional + Portability: POSIX + + FFI bindings to @syslog(3)@ from + <http://pubs.opengroup.org/onlinepubs/9699919799/functions/syslog.html POSIX.1-2008>. + 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.h> + +-- | 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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hsyslog-4/src/System/Posix/Syslog/Functions.hs new/hsyslog-5.0.1/src/System/Posix/Syslog/Functions.hs --- old/hsyslog-4/src/System/Posix/Syslog/Functions.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hsyslog-5.0.1/src/System/Posix/Syslog/Functions.hs 2017-07-07 14:05:07.000000000 +0200 @@ -0,0 +1,71 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +{- | + Maintainer: simons@cryp.to + Stability: provisional + Portability: POSIX + + Low-level FFI bindings to @syslog(3)@ et al from + <http://pubs.opengroup.org/onlinepubs/9699919799/basedefs/syslog.h.html POSIX.1-2008>. + 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 <http://pubs.opengroup.org/onlinepubs/9699919799/functions/syslog.html syslog(3)> +-- 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 <http://pubs.opengroup.org/onlinepubs/9699919799/functions/openlog.html openlog(3)>, +-- 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 <http://pubs.opengroup.org/onlinepubs/9699919799/functions/closelog.html closelog(3)> +-- imported into Haskell directly as an "unsafe" foreign function call. +foreign import ccall unsafe "syslog.h closelog" _closelog :: IO () + +-- | The POSIX function <http://pubs.opengroup.org/onlinepubs/9699919799/functions/setlogmask.html setlogmask(3)> +-- 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 <http://pubs.opengroup.org/onlinepubs/009695399/basedefs/syslog.h.html LOG_MASK()> +-- 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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hsyslog-4/src/System/Posix/Syslog/LogMask.hs new/hsyslog-5.0.1/src/System/Posix/Syslog/LogMask.hs --- old/hsyslog-4/src/System/Posix/Syslog/LogMask.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hsyslog-5.0.1/src/System/Posix/Syslog/LogMask.hs 2017-07-07 14:05:07.000000000 +0200 @@ -0,0 +1,31 @@ +{- | + Maintainer: simons@cryp.to + Stability: provisional + Portability: POSIX + + FFI bindings to @syslog(3)@ from + <http://pubs.opengroup.org/onlinepubs/9699919799/functions/syslog.html POSIX.1-2008>. + 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 (.|.) 0 . map (_logMask . fromPriority) + +-- | 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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hsyslog-4/src/System/Posix/Syslog/Options.hsc new/hsyslog-5.0.1/src/System/Posix/Syslog/Options.hsc --- old/hsyslog-4/src/System/Posix/Syslog/Options.hsc 1970-01-01 01:00:00.000000000 +0100 +++ new/hsyslog-5.0.1/src/System/Posix/Syslog/Options.hsc 2017-07-07 14:05:07.000000000 +0200 @@ -0,0 +1,44 @@ +{-# LANGUAGE DeriveGeneric #-} + +{- | + Maintainer: simons@cryp.to + Stability: provisional + Portability: POSIX + + FFI bindings to @syslog(3)@ from + <http://pubs.opengroup.org/onlinepubs/9699919799/functions/syslog.html POSIX.1-2008>. + 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 <syslog.h> + +-- | The function 'openlog' allows one to configure a handful of process-wide +-- options that modify the bahavior of the 'syslog' funcion. 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 -- ^ Initalize 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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hsyslog-4/src/System/Posix/Syslog/Priority.hsc new/hsyslog-5.0.1/src/System/Posix/Syslog/Priority.hsc --- old/hsyslog-4/src/System/Posix/Syslog/Priority.hsc 1970-01-01 01:00:00.000000000 +0100 +++ new/hsyslog-5.0.1/src/System/Posix/Syslog/Priority.hsc 2017-07-07 14:05:07.000000000 +0200 @@ -0,0 +1,61 @@ +{-# LANGUAGE DeriveGeneric #-} + +{- | + Maintainer: simons@cryp.to + Stability: provisional + Portability: POSIX + + FFI bindings to @syslog(3)@ from + <http://pubs.opengroup.org/onlinepubs/9699919799/functions/syslog.html POSIX.1-2008>. + 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 <syslog.h> + +-- * 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} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hsyslog-4/src/System/Posix/Syslog.hs new/hsyslog-5.0.1/src/System/Posix/Syslog.hs --- old/hsyslog-4/src/System/Posix/Syslog.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hsyslog-5.0.1/src/System/Posix/Syslog.hs 2017-07-07 14:05:07.000000000 +0200 @@ -0,0 +1,115 @@ +{- | + Maintainer: simons@cryp.to + Stability: provisional + Portability: POSIX + + A Haskell interface to @syslog(3)@ as specified in + <http://pubs.opengroup.org/onlinepubs/9699919799/functions/syslog.html POSIX.1-2008>. + 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 + <https://github.com/peti/hsyslog/blob/master/example/Main.hs example program> + 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) $ do + _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 programm. 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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hsyslog-4/src/System/Posix/Syslog.hsc new/hsyslog-5.0.1/src/System/Posix/Syslog.hsc --- old/hsyslog-4/src/System/Posix/Syslog.hsc 2016-06-03 18:53:08.000000000 +0200 +++ new/hsyslog-5.0.1/src/System/Posix/Syslog.hsc 1970-01-01 01:00:00.000000000 +0100 @@ -1,342 +0,0 @@ -{-# 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 - <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-4/test/Main.hs new/hsyslog-5.0.1/test/Main.hs --- old/hsyslog-4/test/Main.hs 2016-06-03 18:53:08.000000000 +0200 +++ new/hsyslog-5.0.1/test/Main.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,48 +0,0 @@ -{-# 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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hsyslog-4/test/doctests.hs new/hsyslog-5.0.1/test/doctests.hs --- old/hsyslog-4/test/doctests.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hsyslog-5.0.1/test/doctests.hs 2017-07-07 14:05:07.000000000 +0200 @@ -0,0 +1,10 @@ +module Main where + +import Build_doctests (flags, pkgs, module_sources) +import Data.Foldable (traverse_) +import Test.DocTest (doctest) + +main :: IO () +main = do let args = flags ++ pkgs ++ module_sources + traverse_ putStrLn args -- optionally print arguments + doctest args
participants (1)
-
root@hilbert.suse.de