1 {-# LANGUAGE TemplateHaskell #-}
3 {-| Implementation of the Ganeti logging functionality.
5 This currently lacks the following (FIXME):
9 Note that this requires the hslogger library version 1.1 and above.
15 Copyright (C) 2011, 2012, 2013 Google Inc.
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.
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.
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
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
58 import qualified Ganeti.Constants as C
60 -- | Syslog usage type.
61 $(declareSADT "SyslogUsage"
62 [ ("SyslogNo", 'C.syslogNo)
63 , ("SyslogYes", 'C.syslogYes)
64 , ("SyslogOnly", 'C.syslogOnly)
67 -- | Builds the log formatter.
68 logFormatter :: String -- ^ Program
69 -> Bool -- ^ Multithreaded
72 logFormatter prog mt syslog =
73 let parts = [ if syslog
75 else "$time: " ++ prog ++ " pid=$pid"
76 , if mt then if syslog then " ($tid)" else "/$tid"
80 in tfLogFormatter "%F %X,%q %Z" $ concat parts
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
89 return [setFormatter handler fmt]
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
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
105 updateGlobalLogger rootLoggerName (setLevel level)
107 stderr_handlers <- openFormattedHandler stderr_logging fmt $
108 streamHandler stderr level
110 file_handlers <- case destf of
112 Just path -> openFormattedHandler file_logging fmt $
113 fileHandler path level
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
120 when (syslog /= SyslogNo) $ do
121 syslog_handler <- openlog program [PID] DAEMON INFO
122 updateGlobalLogger rootLoggerName $ addHandler syslog_handler
124 -- * Logging function aliases
126 -- | Log at debug level.
127 logDebug :: String -> IO ()
128 logDebug = debugM rootLoggerName
130 -- | Log at info level.
131 logInfo :: String -> IO ()
132 logInfo = infoM rootLoggerName
134 -- | Log at notice level.
135 logNotice :: String -> IO ()
136 logNotice = noticeM rootLoggerName
138 -- | Log at warning level.
139 logWarning :: String -> IO ()
140 logWarning = warningM rootLoggerName
142 -- | Log at error level.
143 logError :: String -> IO ()
144 logError = errorM rootLoggerName
146 -- | Log at critical level.
147 logCritical :: String -> IO ()
148 logCritical = criticalM rootLoggerName
150 -- | Log at alert level.
151 logAlert :: String -> IO ()
152 logAlert = alertM rootLoggerName
154 -- | Log at emergency level.
155 logEmergency :: String -> IO ()
156 logEmergency = emergencyM rootLoggerName