{-# LINE 1 "src/System/Posix/Syslog.hsc" #-}
{-# LANGUAGE
{-# LINE 2 "src/System/Posix/Syslog.hsc" #-}
    CApiFFI
  , ForeignFunctionInterface
  , OverloadedStrings
  #-}


{-# LINE 8 "src/System/Posix/Syslog.hsc" #-}
{-# LANGUAGE DeriveGeneric #-}

{-# LINE 10 "src/System/Posix/Syslog.hsc" #-}

{- |
   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 (..))


{-# LINE 65 "src/System/Posix/Syslog.hsc" #-}
import GHC.Generics (Generic)

{-# LINE 67 "src/System/Posix/Syslog.hsc" #-}


{-# LINE 69 "src/System/Posix/Syslog.hsc" #-}

{-# LINE 72 "src/System/Posix/Syslog.hsc" #-}


{-# LINE 76 "src/System/Posix/Syslog.hsc" #-}


{-# LINE 80 "src/System/Posix/Syslog.hsc" #-}

-- | 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

{-# LINE 94 "src/System/Posix/Syslog.hsc" #-}
           , Generic

{-# LINE 96 "src/System/Posix/Syslog.hsc" #-}
           )

toPriority :: CInt -> Priority
toPriority 0   = Emergency
{-# LINE 100 "src/System/Posix/Syslog.hsc" #-}
toPriority 1   = Alert
{-# LINE 101 "src/System/Posix/Syslog.hsc" #-}
toPriority 2    = Critical
{-# LINE 102 "src/System/Posix/Syslog.hsc" #-}
toPriority 3     = Error
{-# LINE 103 "src/System/Posix/Syslog.hsc" #-}
toPriority 4 = Warning
{-# LINE 104 "src/System/Posix/Syslog.hsc" #-}
toPriority 5  = Notice
{-# LINE 105 "src/System/Posix/Syslog.hsc" #-}
toPriority 6    = Info
{-# LINE 106 "src/System/Posix/Syslog.hsc" #-}
toPriority 7   = Debug
{-# LINE 107 "src/System/Posix/Syslog.hsc" #-}
toPriority i = error (shows i " is not a valid syslog priority value")

fromPriority :: Priority -> CInt
fromPriority Emergency = 0
{-# LINE 111 "src/System/Posix/Syslog.hsc" #-}
fromPriority Alert     = 1
{-# LINE 112 "src/System/Posix/Syslog.hsc" #-}
fromPriority Critical  = 2
{-# LINE 113 "src/System/Posix/Syslog.hsc" #-}
fromPriority Error     = 3
{-# LINE 114 "src/System/Posix/Syslog.hsc" #-}
fromPriority Warning   = 4
{-# LINE 115 "src/System/Posix/Syslog.hsc" #-}
fromPriority Notice    = 5
{-# LINE 116 "src/System/Posix/Syslog.hsc" #-}
fromPriority Info      = 6
{-# LINE 117 "src/System/Posix/Syslog.hsc" #-}
fromPriority Debug     = 7
{-# LINE 118 "src/System/Posix/Syslog.hsc" #-}

-- | 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

{-# LINE 145 "src/System/Posix/Syslog.hsc" #-}
           , Generic

{-# LINE 147 "src/System/Posix/Syslog.hsc" #-}
           )

toFacility :: CInt -> Facility
toFacility 0      = KERN
{-# LINE 151 "src/System/Posix/Syslog.hsc" #-}
toFacility 8      = USER
{-# LINE 152 "src/System/Posix/Syslog.hsc" #-}
toFacility 16      = MAIL
{-# LINE 153 "src/System/Posix/Syslog.hsc" #-}
toFacility 24    = DAEMON
{-# LINE 154 "src/System/Posix/Syslog.hsc" #-}
toFacility 32      = AUTH
{-# LINE 155 "src/System/Posix/Syslog.hsc" #-}
toFacility 40    = SYSLOG
{-# LINE 156 "src/System/Posix/Syslog.hsc" #-}
toFacility 48       = LPR
{-# LINE 157 "src/System/Posix/Syslog.hsc" #-}
toFacility 56      = NEWS
{-# LINE 158 "src/System/Posix/Syslog.hsc" #-}
toFacility 64      = UUCP
{-# LINE 159 "src/System/Posix/Syslog.hsc" #-}
toFacility 72      = CRON
{-# LINE 160 "src/System/Posix/Syslog.hsc" #-}
toFacility 80  = AUTHPRIV
{-# LINE 161 "src/System/Posix/Syslog.hsc" #-}
toFacility 88       = FTP
{-# LINE 162 "src/System/Posix/Syslog.hsc" #-}
toFacility 128    = LOCAL0
{-# LINE 163 "src/System/Posix/Syslog.hsc" #-}
toFacility 136    = LOCAL1
{-# LINE 164 "src/System/Posix/Syslog.hsc" #-}
toFacility 144    = LOCAL2
{-# LINE 165 "src/System/Posix/Syslog.hsc" #-}
toFacility 152    = LOCAL3
{-# LINE 166 "src/System/Posix/Syslog.hsc" #-}
toFacility 160    = LOCAL4
{-# LINE 167 "src/System/Posix/Syslog.hsc" #-}
toFacility 168    = LOCAL5
{-# LINE 168 "src/System/Posix/Syslog.hsc" #-}
toFacility 176    = LOCAL6
{-# LINE 169 "src/System/Posix/Syslog.hsc" #-}
toFacility 184    = LOCAL7
{-# LINE 170 "src/System/Posix/Syslog.hsc" #-}
toFacility i = error (shows i " is not a valid syslog facility value")

fromFacility :: Facility -> CInt
fromFacility KERN      = 0
{-# LINE 174 "src/System/Posix/Syslog.hsc" #-}
fromFacility USER      = 8
{-# LINE 175 "src/System/Posix/Syslog.hsc" #-}
fromFacility MAIL      = 16
{-# LINE 176 "src/System/Posix/Syslog.hsc" #-}
fromFacility DAEMON    = 24
{-# LINE 177 "src/System/Posix/Syslog.hsc" #-}
fromFacility AUTH      = 32
{-# LINE 178 "src/System/Posix/Syslog.hsc" #-}
fromFacility SYSLOG    = 40
{-# LINE 179 "src/System/Posix/Syslog.hsc" #-}
fromFacility LPR       = 48
{-# LINE 180 "src/System/Posix/Syslog.hsc" #-}
fromFacility NEWS      = 56
{-# LINE 181 "src/System/Posix/Syslog.hsc" #-}
fromFacility UUCP      = 64
{-# LINE 182 "src/System/Posix/Syslog.hsc" #-}
fromFacility CRON      = 72
{-# LINE 183 "src/System/Posix/Syslog.hsc" #-}
fromFacility AUTHPRIV  = 80
{-# LINE 184 "src/System/Posix/Syslog.hsc" #-}
fromFacility FTP       = 88
{-# LINE 185 "src/System/Posix/Syslog.hsc" #-}
fromFacility LOCAL0    = 128
{-# LINE 186 "src/System/Posix/Syslog.hsc" #-}
fromFacility LOCAL1    = 136
{-# LINE 187 "src/System/Posix/Syslog.hsc" #-}
fromFacility LOCAL2    = 144
{-# LINE 188 "src/System/Posix/Syslog.hsc" #-}
fromFacility LOCAL3    = 152
{-# LINE 189 "src/System/Posix/Syslog.hsc" #-}
fromFacility LOCAL4    = 160
{-# LINE 190 "src/System/Posix/Syslog.hsc" #-}
fromFacility LOCAL5    = 168
{-# LINE 191 "src/System/Posix/Syslog.hsc" #-}
fromFacility LOCAL6    = 176
{-# LINE 192 "src/System/Posix/Syslog.hsc" #-}
fromFacility LOCAL7    = 184
{-# LINE 193 "src/System/Posix/Syslog.hsc" #-}

-- | '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

{-# LINE 205 "src/System/Posix/Syslog.hsc" #-}
           , Generic

{-# LINE 207 "src/System/Posix/Syslog.hsc" #-}
           )

toOption :: CInt -> Option
toOption 1     = PID
{-# LINE 211 "src/System/Posix/Syslog.hsc" #-}
toOption 2    = CONS
{-# LINE 212 "src/System/Posix/Syslog.hsc" #-}
toOption 4  = ODELAY
{-# LINE 213 "src/System/Posix/Syslog.hsc" #-}
toOption 8  = NDELAY
{-# LINE 214 "src/System/Posix/Syslog.hsc" #-}
toOption 16  = NOWAIT
{-# LINE 215 "src/System/Posix/Syslog.hsc" #-}
toOption 32  = PERROR
{-# LINE 216 "src/System/Posix/Syslog.hsc" #-}
toOption i = error (shows i " is not a valid syslog option value")

fromOption :: Option -> CInt
fromOption PID     = 1
{-# LINE 220 "src/System/Posix/Syslog.hsc" #-}
fromOption CONS    = 2
{-# LINE 221 "src/System/Posix/Syslog.hsc" #-}
fromOption ODELAY  = 4
{-# LINE 222 "src/System/Posix/Syslog.hsc" #-}
fromOption NDELAY  = 8
{-# LINE 223 "src/System/Posix/Syslog.hsc" #-}
fromOption NOWAIT  = 16
{-# LINE 224 "src/System/Posix/Syslog.hsc" #-}
fromOption PERROR  = 32
{-# LINE 225 "src/System/Posix/Syslog.hsc" #-}

-- | '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

{-# LINE 234 "src/System/Posix/Syslog.hsc" #-}
           , Generic

{-# LINE 236 "src/System/Posix/Syslog.hsc" #-}
           )

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)