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

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

{-# LINE 5 "System/Posix/Syslog.hsc" #-}
{- |
   Module      :  System.Posix.Syslog
   Maintainer  :  simons@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

{-# LINE 21 "System/Posix/Syslog.hsc" #-}
import GHC.Generics

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


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

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


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


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

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

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

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

instance Enum Priority where
  toEnum 0   = Emergency
{-# LINE 64 "System/Posix/Syslog.hsc" #-}
  toEnum 1   = Alert
{-# LINE 65 "System/Posix/Syslog.hsc" #-}
  toEnum 2    = Critical
{-# LINE 66 "System/Posix/Syslog.hsc" #-}
  toEnum 3     = Error
{-# LINE 67 "System/Posix/Syslog.hsc" #-}
  toEnum 4 = Warning
{-# LINE 68 "System/Posix/Syslog.hsc" #-}
  toEnum 5  = Notice
{-# LINE 69 "System/Posix/Syslog.hsc" #-}
  toEnum 6    = Info
{-# LINE 70 "System/Posix/Syslog.hsc" #-}
  toEnum 7   = Debug
{-# LINE 71 "System/Posix/Syslog.hsc" #-}
  toEnum i = error (showString "Syslog.Priority cannot be mapped from value " (show i))

  fromEnum Emergency = 0
{-# LINE 74 "System/Posix/Syslog.hsc" #-}
  fromEnum Alert     = 1
{-# LINE 75 "System/Posix/Syslog.hsc" #-}
  fromEnum Critical  = 2
{-# LINE 76 "System/Posix/Syslog.hsc" #-}
  fromEnum Error     = 3
{-# LINE 77 "System/Posix/Syslog.hsc" #-}
  fromEnum Warning   = 4
{-# LINE 78 "System/Posix/Syslog.hsc" #-}
  fromEnum Notice    = 5
{-# LINE 79 "System/Posix/Syslog.hsc" #-}
  fromEnum Info      = 6
{-# LINE 80 "System/Posix/Syslog.hsc" #-}
  fromEnum Debug     = 7
{-# LINE 81 "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 (Eq, Bounded, Show, Read)

instance Enum Facility where
  toEnum 0      = KERN
{-# LINE 110 "System/Posix/Syslog.hsc" #-}
  toEnum 8      = USER
{-# LINE 111 "System/Posix/Syslog.hsc" #-}
  toEnum 16      = MAIL
{-# LINE 112 "System/Posix/Syslog.hsc" #-}
  toEnum 24    = DAEMON
{-# LINE 113 "System/Posix/Syslog.hsc" #-}
  toEnum 32      = AUTH
{-# LINE 114 "System/Posix/Syslog.hsc" #-}
  toEnum 40    = SYSLOG
{-# LINE 115 "System/Posix/Syslog.hsc" #-}
  toEnum 48       = LPR
{-# LINE 116 "System/Posix/Syslog.hsc" #-}
  toEnum 56      = NEWS
{-# LINE 117 "System/Posix/Syslog.hsc" #-}
  toEnum 64      = UUCP
{-# LINE 118 "System/Posix/Syslog.hsc" #-}
  toEnum 72      = CRON
{-# LINE 119 "System/Posix/Syslog.hsc" #-}
  toEnum 80  = AUTHPRIV
{-# LINE 120 "System/Posix/Syslog.hsc" #-}
  toEnum 88       = FTP
{-# LINE 121 "System/Posix/Syslog.hsc" #-}
  toEnum 128    = LOCAL0
{-# LINE 122 "System/Posix/Syslog.hsc" #-}
  toEnum 136    = LOCAL1
{-# LINE 123 "System/Posix/Syslog.hsc" #-}
  toEnum 144    = LOCAL2
{-# LINE 124 "System/Posix/Syslog.hsc" #-}
  toEnum 152    = LOCAL3
{-# LINE 125 "System/Posix/Syslog.hsc" #-}
  toEnum 160    = LOCAL4
{-# LINE 126 "System/Posix/Syslog.hsc" #-}
  toEnum 168    = LOCAL5
{-# LINE 127 "System/Posix/Syslog.hsc" #-}
  toEnum 176    = LOCAL6
{-# LINE 128 "System/Posix/Syslog.hsc" #-}
  toEnum 184    = LOCAL7
{-# LINE 129 "System/Posix/Syslog.hsc" #-}
  toEnum i = error ("Syslog.Facility cannot be mapped to value " ++ show i)

  fromEnum KERN      = 0
{-# LINE 132 "System/Posix/Syslog.hsc" #-}
  fromEnum USER      = 8
{-# LINE 133 "System/Posix/Syslog.hsc" #-}
  fromEnum MAIL      = 16
{-# LINE 134 "System/Posix/Syslog.hsc" #-}
  fromEnum DAEMON    = 24
{-# LINE 135 "System/Posix/Syslog.hsc" #-}
  fromEnum AUTH      = 32
{-# LINE 136 "System/Posix/Syslog.hsc" #-}
  fromEnum SYSLOG    = 40
{-# LINE 137 "System/Posix/Syslog.hsc" #-}
  fromEnum LPR       = 48
{-# LINE 138 "System/Posix/Syslog.hsc" #-}
  fromEnum NEWS      = 56
{-# LINE 139 "System/Posix/Syslog.hsc" #-}
  fromEnum UUCP      = 64
{-# LINE 140 "System/Posix/Syslog.hsc" #-}
  fromEnum CRON      = 72
{-# LINE 141 "System/Posix/Syslog.hsc" #-}
  fromEnum AUTHPRIV  = 80
{-# LINE 142 "System/Posix/Syslog.hsc" #-}
  fromEnum FTP       = 88
{-# LINE 143 "System/Posix/Syslog.hsc" #-}
  fromEnum LOCAL0    = 128
{-# LINE 144 "System/Posix/Syslog.hsc" #-}
  fromEnum LOCAL1    = 136
{-# LINE 145 "System/Posix/Syslog.hsc" #-}
  fromEnum LOCAL2    = 144
{-# LINE 146 "System/Posix/Syslog.hsc" #-}
  fromEnum LOCAL3    = 152
{-# LINE 147 "System/Posix/Syslog.hsc" #-}
  fromEnum LOCAL4    = 160
{-# LINE 148 "System/Posix/Syslog.hsc" #-}
  fromEnum LOCAL5    = 168
{-# LINE 149 "System/Posix/Syslog.hsc" #-}
  fromEnum LOCAL6    = 176
{-# LINE 150 "System/Posix/Syslog.hsc" #-}
  fromEnum LOCAL7    = 184
{-# LINE 151 "System/Posix/Syslog.hsc" #-}

-- |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 1     = PID
{-# LINE 165 "System/Posix/Syslog.hsc" #-}
  toEnum 2    = CONS
{-# LINE 166 "System/Posix/Syslog.hsc" #-}
  toEnum 4  = ODELAY
{-# LINE 167 "System/Posix/Syslog.hsc" #-}
  toEnum 8  = NDELAY
{-# LINE 168 "System/Posix/Syslog.hsc" #-}
  toEnum 16  = NOWAIT
{-# LINE 169 "System/Posix/Syslog.hsc" #-}
  toEnum 32  = PERROR
{-# LINE 170 "System/Posix/Syslog.hsc" #-}
  toEnum i = error ("Syslog.Option cannot be mapped to value " ++ show i)

  fromEnum PID     = 1
{-# LINE 173 "System/Posix/Syslog.hsc" #-}
  fromEnum CONS    = 2
{-# LINE 174 "System/Posix/Syslog.hsc" #-}
  fromEnum ODELAY  = 4
{-# LINE 175 "System/Posix/Syslog.hsc" #-}
  fromEnum NDELAY  = 8
{-# LINE 176 "System/Posix/Syslog.hsc" #-}
  fromEnum NOWAIT  = 16
{-# LINE 177 "System/Posix/Syslog.hsc" #-}
  fromEnum PERROR  = 32
{-# LINE 178 "System/Posix/Syslog.hsc" #-}

-- * 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 ()