{-# LINE 1 "System/Posix/Syslog.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LINE 2 "System/Posix/Syslog.hsc" #-}
{- |
   Module      :  System.Posix.Syslog
   Copyright   :  (c) 2008 Peter Simons
   License     :  BSD3

   Maintainer  :  simons@cryp.to
   Stability   :  provisional
   Portability :  Posix

   FFI bindings to Unix's @syslog(3)@. Process this file
   with @hsc2hs@ to obtain a Haskell module.
-}

module System.Posix.Syslog where

import System.IO
import Control.Exception ( bracket_ )
import Foreign.C


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

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


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


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

-- * Marshaled Data Types

-- |Log messages are prioritized.

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)

instance Enum Priority where
  toEnum 0   = Emergency
{-# LINE 51 "System/Posix/Syslog.hsc" #-}
  toEnum 1   = Alert
{-# LINE 52 "System/Posix/Syslog.hsc" #-}
  toEnum 2    = Critical
{-# LINE 53 "System/Posix/Syslog.hsc" #-}
  toEnum 3     = Error
{-# LINE 54 "System/Posix/Syslog.hsc" #-}
  toEnum 4 = Warning
{-# LINE 55 "System/Posix/Syslog.hsc" #-}
  toEnum 5  = Notice
{-# LINE 56 "System/Posix/Syslog.hsc" #-}
  toEnum 6    = Info
{-# LINE 57 "System/Posix/Syslog.hsc" #-}
  toEnum 7   = Debug
{-# LINE 58 "System/Posix/Syslog.hsc" #-}
  toEnum i = error (showString "Syslog.Priority cannot be mapped from value " (show i))

  fromEnum Emergency = 0
{-# LINE 61 "System/Posix/Syslog.hsc" #-}
  fromEnum Alert     = 1
{-# LINE 62 "System/Posix/Syslog.hsc" #-}
  fromEnum Critical  = 2
{-# LINE 63 "System/Posix/Syslog.hsc" #-}
  fromEnum Error     = 3
{-# LINE 64 "System/Posix/Syslog.hsc" #-}
  fromEnum Warning   = 4
{-# LINE 65 "System/Posix/Syslog.hsc" #-}
  fromEnum Notice    = 5
{-# LINE 66 "System/Posix/Syslog.hsc" #-}
  fromEnum Info      = 6
{-# LINE 67 "System/Posix/Syslog.hsc" #-}
  fromEnum Debug     = 7
{-# LINE 68 "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)

instance Enum Facility where
  toEnum 0      = KERN
{-# LINE 97 "System/Posix/Syslog.hsc" #-}
  toEnum 8      = USER
{-# LINE 98 "System/Posix/Syslog.hsc" #-}
  toEnum 16      = MAIL
{-# LINE 99 "System/Posix/Syslog.hsc" #-}
  toEnum 24    = DAEMON
{-# LINE 100 "System/Posix/Syslog.hsc" #-}
  toEnum 32      = AUTH
{-# LINE 101 "System/Posix/Syslog.hsc" #-}
  toEnum 40    = SYSLOG
{-# LINE 102 "System/Posix/Syslog.hsc" #-}
  toEnum 48       = LPR
{-# LINE 103 "System/Posix/Syslog.hsc" #-}
  toEnum 56      = NEWS
{-# LINE 104 "System/Posix/Syslog.hsc" #-}
  toEnum 64      = UUCP
{-# LINE 105 "System/Posix/Syslog.hsc" #-}
  toEnum 72      = CRON
{-# LINE 106 "System/Posix/Syslog.hsc" #-}
  toEnum 80  = AUTHPRIV
{-# LINE 107 "System/Posix/Syslog.hsc" #-}
  toEnum 88       = FTP
{-# LINE 108 "System/Posix/Syslog.hsc" #-}
  toEnum 128    = LOCAL0
{-# LINE 109 "System/Posix/Syslog.hsc" #-}
  toEnum 136    = LOCAL1
{-# LINE 110 "System/Posix/Syslog.hsc" #-}
  toEnum 144    = LOCAL2
{-# LINE 111 "System/Posix/Syslog.hsc" #-}
  toEnum 152    = LOCAL3
{-# LINE 112 "System/Posix/Syslog.hsc" #-}
  toEnum 160    = LOCAL4
{-# LINE 113 "System/Posix/Syslog.hsc" #-}
  toEnum 168    = LOCAL5
{-# LINE 114 "System/Posix/Syslog.hsc" #-}
  toEnum 176    = LOCAL6
{-# LINE 115 "System/Posix/Syslog.hsc" #-}
  toEnum 184    = LOCAL7
{-# LINE 116 "System/Posix/Syslog.hsc" #-}
  toEnum i = error ("Syslog.Facility cannot be mapped to value " ++ show i)

  fromEnum KERN      = 0
{-# LINE 119 "System/Posix/Syslog.hsc" #-}
  fromEnum USER      = 8
{-# LINE 120 "System/Posix/Syslog.hsc" #-}
  fromEnum MAIL      = 16
{-# LINE 121 "System/Posix/Syslog.hsc" #-}
  fromEnum DAEMON    = 24
{-# LINE 122 "System/Posix/Syslog.hsc" #-}
  fromEnum AUTH      = 32
{-# LINE 123 "System/Posix/Syslog.hsc" #-}
  fromEnum SYSLOG    = 40
{-# LINE 124 "System/Posix/Syslog.hsc" #-}
  fromEnum LPR       = 48
{-# LINE 125 "System/Posix/Syslog.hsc" #-}
  fromEnum NEWS      = 56
{-# LINE 126 "System/Posix/Syslog.hsc" #-}
  fromEnum UUCP      = 64
{-# LINE 127 "System/Posix/Syslog.hsc" #-}
  fromEnum CRON      = 72
{-# LINE 128 "System/Posix/Syslog.hsc" #-}
  fromEnum AUTHPRIV  = 80
{-# LINE 129 "System/Posix/Syslog.hsc" #-}
  fromEnum FTP       = 88
{-# LINE 130 "System/Posix/Syslog.hsc" #-}
  fromEnum LOCAL0    = 128
{-# LINE 131 "System/Posix/Syslog.hsc" #-}
  fromEnum LOCAL1    = 136
{-# LINE 132 "System/Posix/Syslog.hsc" #-}
  fromEnum LOCAL2    = 144
{-# LINE 133 "System/Posix/Syslog.hsc" #-}
  fromEnum LOCAL3    = 152
{-# LINE 134 "System/Posix/Syslog.hsc" #-}
  fromEnum LOCAL4    = 160
{-# LINE 135 "System/Posix/Syslog.hsc" #-}
  fromEnum LOCAL5    = 168
{-# LINE 136 "System/Posix/Syslog.hsc" #-}
  fromEnum LOCAL6    = 176
{-# LINE 137 "System/Posix/Syslog.hsc" #-}
  fromEnum LOCAL7    = 184
{-# LINE 138 "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 152 "System/Posix/Syslog.hsc" #-}
  toEnum 2    = CONS
{-# LINE 153 "System/Posix/Syslog.hsc" #-}
  toEnum 4  = ODELAY
{-# LINE 154 "System/Posix/Syslog.hsc" #-}
  toEnum 8  = NDELAY
{-# LINE 155 "System/Posix/Syslog.hsc" #-}
  toEnum 16  = NOWAIT
{-# LINE 156 "System/Posix/Syslog.hsc" #-}
  toEnum 32  = PERROR
{-# LINE 157 "System/Posix/Syslog.hsc" #-}
  toEnum i = error ("Syslog.Option cannot be mapped to value " ++ show i)

  fromEnum PID     = 1
{-# LINE 160 "System/Posix/Syslog.hsc" #-}
  fromEnum CONS    = 2
{-# LINE 161 "System/Posix/Syslog.hsc" #-}
  fromEnum ODELAY  = 4
{-# LINE 162 "System/Posix/Syslog.hsc" #-}
  fromEnum NDELAY  = 8
{-# LINE 163 "System/Posix/Syslog.hsc" #-}
  fromEnum NOWAIT  = 16
{-# LINE 164 "System/Posix/Syslog.hsc" #-}
  fromEnum PERROR  = 32
{-# LINE 165 "System/Posix/Syslog.hsc" #-}

-- * Haskell API to syslog

-- |Bracket an 'IO' computation between calls to '_openlog'
-- and '_closelog'. Since these settings are for the
-- /process/, multiple calls to this function will,
-- unfortunately, overwrite each other.
--
-- Example:
--
-- > main = withSyslog "my-ident" [PID, PERROR] USER $ do
-- >          putStrLn "huhu"
-- >          syslog Debug "huhu"

withSyslog :: String -> [Option] -> Facility -> IO a -> IO a
withSyslog ident opts facil f = do
  let opt = toEnum . sum . map fromEnum $ opts
  let fac = toEnum . fromEnum           $ facil
  withCString ident $ \p ->
    bracket_ (_openlog p opt fac) (_closelog) f

-- |Log a message with the given priority.

syslog :: Priority -> String -> IO ()
syslog l msg =
  withCString (safeMsg msg)
    (\p -> _syslog (toEnum (fromEnum l)) p)

-- * Helpers

-- | @useSyslog ident@ @=@ @withSyslog ident [PID, PERROR] USER@

useSyslog :: String -> IO a -> IO a
useSyslog ident = withSyslog ident [PID, PERROR] USER

-- |Escape any occurances of \'@%@\' in a string, so that it
-- is safe to pass it to '_syslog'. The 'syslog' wrapper
-- does this automatically.

safeMsg :: String -> String
safeMsg []       = []
safeMsg ('%':xs) = '%' : '%' : safeMsg xs
safeMsg ( x :xs) = x : safeMsg xs

-- * Low-level C functions

foreign import ccall unsafe "closelog" _closelog ::
  IO ()

foreign import ccall unsafe "openlog" _openlog ::
  CString -> CInt -> CInt -> IO ()

foreign import ccall unsafe "setlogmask" _setlogmask ::
  CInt -> IO CInt

foreign import ccall unsafe "syslog" _syslog ::
  CInt -> CString -> IO ()