code.grnet.gr Git - ganeti-local/blob - htools/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 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 simpleLogFormatter $ 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 :: 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 C.devConsole else logf
 102       fmt = logFormatter program False False
 103
 104   updateGlobalLogger rootLoggerName (setLevel level)
 105
 106   stderr_handlers <- openFormattedHandler stderr_logging fmt $
 107                      streamHandler stderr level
 108
 109   file_handlers <- openFormattedHandler (syslog /= SyslogOnly) fmt $
 110                    fileHandler destf level
 111
 112   let handlers = concat [file_handlers, stderr_handlers]
 113   updateGlobalLogger rootLoggerName $ setHandlers handlers
 114   -- syslog handler is special (another type, still instance of the
 115   -- typeclass, and has a built-in formatter), so we can't pass it in
 116   -- the above list
 117   when (syslog /= SyslogNo) $ do
 118     syslog_handler <- openlog program [PID] DAEMON INFO
 119     updateGlobalLogger rootLoggerName $ addHandler syslog_handler
 120
 121 -- * Logging function aliases
 122
 123 -- | Log at debug level.
 124 logDebug :: String -> IO ()
 125 logDebug = debugM rootLoggerName
 126
 127 -- | Log at info level.
 128 logInfo :: String -> IO ()
 129 logInfo = infoM rootLoggerName
 130
 131 -- | Log at notice level.
 132 logNotice :: String -> IO ()
 133 logNotice = noticeM rootLoggerName
 134
 135 -- | Log at warning level.
 136 logWarning :: String -> IO ()
 137 logWarning = warningM rootLoggerName
 138
 139 -- | Log at error level.
 140 logError :: String -> IO ()
 141 logError = errorM rootLoggerName
 142
 143 -- | Log at critical level.
 144 logCritical :: String -> IO ()
 145 logCritical = criticalM rootLoggerName
 146
 147 -- | Log at alert level.
 148 logAlert :: String -> IO ()
 149 logAlert = alertM rootLoggerName
 150
 151 -- | Log at emergency level.
 152 logEmergency :: String -> IO ()
 153 logEmergency = emergencyM rootLoggerName