code.grnet.gr Git - ganeti-local/blob - src/Ganeti/Logging.hs

   1 {-# LANGUAGE TemplateHaskell #-}
   2
   3 {-| Implementation of the Ganeti logging functionality.
   4
   5 This currently lacks the following (FIXME):
   6
   7 - log file reopening
   8
   9 Note that this requires the hslogger library version 1.1 and above.
  10
  11 -}
  12
  13 {-
  14
  15 Copyright (C) 2011, 2012, 2013 Google Inc.
  16
  17 This program is free software; you can redistribute it and/or modify
  18 it under the terms of the GNU General Public License as published by
  19 the Free Software Foundation; either version 2 of the License, or
  20 (at your option) any later version.
  21
  22 This program is distributed in the hope that it will be useful, but
  23 WITHOUT ANY WARRANTY; without even the implied warranty of
  24 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  25 General Public License for more details.
  26
  27 You should have received a copy of the GNU General Public License
  28 along with this program; if not, write to the Free Software
  29 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  30 02110-1301, USA.
  31
  32 -}
  33
  34 module Ganeti.Logging
  35   ( setupLogging
  36   , logDebug
  37   , logInfo
  38   , logNotice
  39   , logWarning
  40   , logError
  41   , logCritical
  42   , logAlert
  43   , logEmergency
  44   , SyslogUsage(..)
  45   , syslogUsageToRaw
  46   , syslogUsageFromRaw
  47   ) where
  48
  49 import Control.Monad (when)
  50 import System.Log.Logger
  51 import System.Log.Handler.Simple
  52 import System.Log.Handler.Syslog
  53 import System.Log.Handler (setFormatter, LogHandler)
  54 import System.Log.Formatter
  55 import System.IO
  56
  57 import Ganeti.THH
  58 import qualified Ganeti.Constants as C
  59
  60 -- | Syslog usage type.
  61 $(declareSADT "SyslogUsage"
  62   [ ("SyslogNo",   'C.syslogNo)
  63   , ("SyslogYes",  'C.syslogYes)
  64   , ("SyslogOnly", 'C.syslogOnly)
  65   ])
  66
  67 -- | Builds the log formatter.
  68 logFormatter :: String  -- ^ Program
  69              -> Bool    -- ^ Multithreaded
  70              -> Bool    -- ^ Syslog
  71              -> LogFormatter a
  72 logFormatter prog mt syslog =
  73   let parts = [ if syslog
  74                   then "[$pid]:"
  75                   else "$time: " ++ prog ++ " pid=$pid"
  76               , if mt then if syslog then " ($tid)" else "/$tid"
  77                   else ""
  78               , " $prio $msg"
  79               ]
  80   in tfLogFormatter "%F %X,%q %Z" $ concat parts
  81
  82 -- | Helper to open and set the formatter on a log if enabled by a
  83 -- given condition, otherwise returning an empty list.
  84 openFormattedHandler :: (LogHandler a) => Bool
  85                      -> LogFormatter a -> IO a -> IO [a]
  86 openFormattedHandler False _ _ = return []
  87 openFormattedHandler True fmt opener = do
  88   handler <- opener
  89   return [setFormatter handler fmt]
  90
  91 -- | Sets up the logging configuration.
  92 setupLogging :: Maybe String    -- ^ Log file
  93              -> String    -- ^ Program name
  94              -> Bool      -- ^ Debug level
  95              -> Bool      -- ^ Log to stderr
  96              -> Bool      -- ^ Log to console
  97              -> SyslogUsage -- ^ Syslog usage
  98              -> IO ()
  99 setupLogging logf program debug stderr_logging console syslog = do
 100   let level = if debug then DEBUG else INFO
 101       destf = if console then Just C.devConsole else logf
 102       fmt = logFormatter program False False
 103       file_logging = syslog /= SyslogOnly
 104
 105   updateGlobalLogger rootLoggerName (setLevel level)
 106
 107   stderr_handlers <- openFormattedHandler stderr_logging fmt $
 108                      streamHandler stderr level
 109
 110   file_handlers <- case destf of
 111                      Nothing -> return []
 112                      Just path -> openFormattedHandler file_logging fmt $
 113                                   fileHandler path level
 114
 115   let handlers = file_handlers ++ stderr_handlers
 116   updateGlobalLogger rootLoggerName $ setHandlers handlers
 117   -- syslog handler is special (another type, still instance of the
 118   -- typeclass, and has a built-in formatter), so we can't pass it in
 119   -- the above list
 120   when (syslog /= SyslogNo) $ do
 121     syslog_handler <- openlog program [PID] DAEMON INFO
 122     updateGlobalLogger rootLoggerName $ addHandler syslog_handler
 123
 124 -- * Logging function aliases
 125
 126 -- | Log at debug level.
 127 logDebug :: String -> IO ()
 128 logDebug = debugM rootLoggerName
 129
 130 -- | Log at info level.
 131 logInfo :: String -> IO ()
 132 logInfo = infoM rootLoggerName
 133
 134 -- | Log at notice level.
 135 logNotice :: String -> IO ()
 136 logNotice = noticeM rootLoggerName
 137
 138 -- | Log at warning level.
 139 logWarning :: String -> IO ()
 140 logWarning = warningM rootLoggerName
 141
 142 -- | Log at error level.
 143 logError :: String -> IO ()
 144 logError = errorM rootLoggerName
 145
 146 -- | Log at critical level.
 147 logCritical :: String -> IO ()
 148 logCritical = criticalM rootLoggerName
 149
 150 -- | Log at alert level.
 151 logAlert :: String -> IO ()
 152 logAlert = alertM rootLoggerName
 153
 154 -- | Log at emergency level.
 155 logEmergency :: String -> IO ()
 156 logEmergency = emergencyM rootLoggerName