root / src / Ganeti / Logging.hs @ 2868f3f7
History | View | Annotate | Download (6.1 kB)
1 | a6e2a138 | Iustin Pop | {-# LANGUAGE TemplateHaskell #-} |
---|---|---|---|
2 | a6e2a138 | Iustin Pop | |
3 | ba4e38e8 | Iustin Pop | {-| Implementation of the Ganeti logging functionality. |
4 | ba4e38e8 | Iustin Pop | |
5 | ba4e38e8 | Iustin Pop | This currently lacks the following (FIXME): |
6 | ba4e38e8 | Iustin Pop | |
7 | ba4e38e8 | Iustin Pop | - log file reopening |
8 | ba4e38e8 | Iustin Pop | |
9 | ba4e38e8 | Iustin Pop | Note that this requires the hslogger library version 1.1 and above. |
10 | ba4e38e8 | Iustin Pop | |
11 | ba4e38e8 | Iustin Pop | -} |
12 | ba4e38e8 | Iustin Pop | |
13 | ba4e38e8 | Iustin Pop | {- |
14 | ba4e38e8 | Iustin Pop | |
15 | ce817701 | Iustin Pop | Copyright (C) 2011, 2012, 2013 Google Inc. |
16 | ba4e38e8 | Iustin Pop | |
17 | ba4e38e8 | Iustin Pop | This program is free software; you can redistribute it and/or modify |
18 | ba4e38e8 | Iustin Pop | it under the terms of the GNU General Public License as published by |
19 | ba4e38e8 | Iustin Pop | the Free Software Foundation; either version 2 of the License, or |
20 | ba4e38e8 | Iustin Pop | (at your option) any later version. |
21 | ba4e38e8 | Iustin Pop | |
22 | ba4e38e8 | Iustin Pop | This program is distributed in the hope that it will be useful, but |
23 | ba4e38e8 | Iustin Pop | WITHOUT ANY WARRANTY; without even the implied warranty of |
24 | ba4e38e8 | Iustin Pop | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
25 | ba4e38e8 | Iustin Pop | General Public License for more details. |
26 | ba4e38e8 | Iustin Pop | |
27 | ba4e38e8 | Iustin Pop | You should have received a copy of the GNU General Public License |
28 | ba4e38e8 | Iustin Pop | along with this program; if not, write to the Free Software |
29 | ba4e38e8 | Iustin Pop | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
30 | ba4e38e8 | Iustin Pop | 02110-1301, USA. |
31 | ba4e38e8 | Iustin Pop | |
32 | ba4e38e8 | Iustin Pop | -} |
33 | ba4e38e8 | Iustin Pop | |
34 | ba4e38e8 | Iustin Pop | module Ganeti.Logging |
35 | ba4e38e8 | Iustin Pop | ( setupLogging |
36 | 27f904f7 | Petr Pudlak | , MonadLog(..) |
37 | 27f904f7 | Petr Pudlak | , Priority(..) |
38 | ba4e38e8 | Iustin Pop | , logDebug |
39 | ba4e38e8 | Iustin Pop | , logInfo |
40 | ba4e38e8 | Iustin Pop | , logNotice |
41 | ba4e38e8 | Iustin Pop | , logWarning |
42 | ba4e38e8 | Iustin Pop | , logError |
43 | ba4e38e8 | Iustin Pop | , logCritical |
44 | ba4e38e8 | Iustin Pop | , logAlert |
45 | ba4e38e8 | Iustin Pop | , logEmergency |
46 | a6e2a138 | Iustin Pop | , SyslogUsage(..) |
47 | a6e2a138 | Iustin Pop | , syslogUsageToRaw |
48 | a6e2a138 | Iustin Pop | , syslogUsageFromRaw |
49 | 426f0900 | Petr Pudlak | , withErrorLogAt |
50 | 3062d395 | Santi Raffa | , isDebugMode |
51 | ba4e38e8 | Iustin Pop | ) where |
52 | ba4e38e8 | Iustin Pop | |
53 | 3062d395 | Santi Raffa | import Control.Applicative ((<$>)) |
54 | 43c329e7 | Petr Pudlak | import Control.Monad |
55 | 426f0900 | Petr Pudlak | import Control.Monad.Error (Error(..), MonadError(..), catchError) |
56 | 43c329e7 | Petr Pudlak | import Control.Monad.Reader |
57 | 12121213 | Petr Pudlak | import qualified Control.Monad.RWS.Strict as RWSS |
58 | 78e0f701 | Petr Pudlak | import qualified Control.Monad.State.Strict as SS |
59 | 78e0f701 | Petr Pudlak | import Control.Monad.Trans.Identity |
60 | 12121213 | Petr Pudlak | import Data.Monoid |
61 | ba4e38e8 | Iustin Pop | import System.Log.Logger |
62 | ba4e38e8 | Iustin Pop | import System.Log.Handler.Simple |
63 | a6e2a138 | Iustin Pop | import System.Log.Handler.Syslog |
64 | a6e2a138 | Iustin Pop | import System.Log.Handler (setFormatter, LogHandler) |
65 | ba4e38e8 | Iustin Pop | import System.Log.Formatter |
66 | ba4e38e8 | Iustin Pop | import System.IO |
67 | ba4e38e8 | Iustin Pop | |
68 | d2029364 | Petr Pudlak | import Ganeti.BasicTypes (ResultT(..)) |
69 | a6e2a138 | Iustin Pop | import Ganeti.THH |
70 | df726590 | Jose A. Lopes | import qualified Ganeti.ConstantUtils as ConstantUtils |
71 | ba4e38e8 | Iustin Pop | |
72 | a6e2a138 | Iustin Pop | -- | Syslog usage type. |
73 | df726590 | Jose A. Lopes | $(declareLADT ''String "SyslogUsage" |
74 | df726590 | Jose A. Lopes | [ ("SyslogNo", "no") |
75 | df726590 | Jose A. Lopes | , ("SyslogYes", "yes") |
76 | df726590 | Jose A. Lopes | , ("SyslogOnly", "only") |
77 | a6e2a138 | Iustin Pop | ]) |
78 | a6e2a138 | Iustin Pop | |
79 | ba4e38e8 | Iustin Pop | -- | Builds the log formatter. |
80 | ba4e38e8 | Iustin Pop | logFormatter :: String -- ^ Program |
81 | ba4e38e8 | Iustin Pop | -> Bool -- ^ Multithreaded |
82 | ba4e38e8 | Iustin Pop | -> Bool -- ^ Syslog |
83 | ba4e38e8 | Iustin Pop | -> LogFormatter a |
84 | ba4e38e8 | Iustin Pop | logFormatter prog mt syslog = |
85 | ba4e38e8 | Iustin Pop | let parts = [ if syslog |
86 | ba4e38e8 | Iustin Pop | then "[$pid]:" |
87 | ba4e38e8 | Iustin Pop | else "$time: " ++ prog ++ " pid=$pid" |
88 | ba4e38e8 | Iustin Pop | , if mt then if syslog then " ($tid)" else "/$tid" |
89 | ba4e38e8 | Iustin Pop | else "" |
90 | ba4e38e8 | Iustin Pop | , " $prio $msg" |
91 | ba4e38e8 | Iustin Pop | ] |
92 | ce817701 | Iustin Pop | in tfLogFormatter "%F %X,%q %Z" $ concat parts |
93 | ba4e38e8 | Iustin Pop | |
94 | a6e2a138 | Iustin Pop | -- | Helper to open and set the formatter on a log if enabled by a |
95 | a6e2a138 | Iustin Pop | -- given condition, otherwise returning an empty list. |
96 | a6e2a138 | Iustin Pop | openFormattedHandler :: (LogHandler a) => Bool |
97 | a6e2a138 | Iustin Pop | -> LogFormatter a -> IO a -> IO [a] |
98 | a6e2a138 | Iustin Pop | openFormattedHandler False _ _ = return [] |
99 | a6e2a138 | Iustin Pop | openFormattedHandler True fmt opener = do |
100 | a6e2a138 | Iustin Pop | handler <- opener |
101 | a6e2a138 | Iustin Pop | return [setFormatter handler fmt] |
102 | a6e2a138 | Iustin Pop | |
103 | ba4e38e8 | Iustin Pop | -- | Sets up the logging configuration. |
104 | 0c28bee1 | Iustin Pop | setupLogging :: Maybe String -- ^ Log file |
105 | ba4e38e8 | Iustin Pop | -> String -- ^ Program name |
106 | ba4e38e8 | Iustin Pop | -> Bool -- ^ Debug level |
107 | ba4e38e8 | Iustin Pop | -> Bool -- ^ Log to stderr |
108 | ba4e38e8 | Iustin Pop | -> Bool -- ^ Log to console |
109 | a6e2a138 | Iustin Pop | -> SyslogUsage -- ^ Syslog usage |
110 | ba4e38e8 | Iustin Pop | -> IO () |
111 | a6e2a138 | Iustin Pop | setupLogging logf program debug stderr_logging console syslog = do |
112 | ba4e38e8 | Iustin Pop | let level = if debug then DEBUG else INFO |
113 | df726590 | Jose A. Lopes | destf = if console then Just ConstantUtils.devConsole else logf |
114 | ba4e38e8 | Iustin Pop | fmt = logFormatter program False False |
115 | 0c28bee1 | Iustin Pop | file_logging = syslog /= SyslogOnly |
116 | ba4e38e8 | Iustin Pop | |
117 | ba4e38e8 | Iustin Pop | updateGlobalLogger rootLoggerName (setLevel level) |
118 | ba4e38e8 | Iustin Pop | |
119 | a6e2a138 | Iustin Pop | stderr_handlers <- openFormattedHandler stderr_logging fmt $ |
120 | a6e2a138 | Iustin Pop | streamHandler stderr level |
121 | a6e2a138 | Iustin Pop | |
122 | 0c28bee1 | Iustin Pop | file_handlers <- case destf of |
123 | 0c28bee1 | Iustin Pop | Nothing -> return [] |
124 | 0c28bee1 | Iustin Pop | Just path -> openFormattedHandler file_logging fmt $ |
125 | 0c28bee1 | Iustin Pop | fileHandler path level |
126 | a6e2a138 | Iustin Pop | |
127 | 2cdaf225 | Iustin Pop | let handlers = file_handlers ++ stderr_handlers |
128 | ba4e38e8 | Iustin Pop | updateGlobalLogger rootLoggerName $ setHandlers handlers |
129 | a6e2a138 | Iustin Pop | -- syslog handler is special (another type, still instance of the |
130 | a6e2a138 | Iustin Pop | -- typeclass, and has a built-in formatter), so we can't pass it in |
131 | a6e2a138 | Iustin Pop | -- the above list |
132 | a6e2a138 | Iustin Pop | when (syslog /= SyslogNo) $ do |
133 | a6e2a138 | Iustin Pop | syslog_handler <- openlog program [PID] DAEMON INFO |
134 | a6e2a138 | Iustin Pop | updateGlobalLogger rootLoggerName $ addHandler syslog_handler |
135 | ba4e38e8 | Iustin Pop | |
136 | ba4e38e8 | Iustin Pop | -- * Logging function aliases |
137 | ba4e38e8 | Iustin Pop | |
138 | 27f904f7 | Petr Pudlak | -- | A monad that allows logging. |
139 | 27f904f7 | Petr Pudlak | class Monad m => MonadLog m where |
140 | 27f904f7 | Petr Pudlak | -- | Log at a given level. |
141 | 27f904f7 | Petr Pudlak | logAt :: Priority -> String -> m () |
142 | 27f904f7 | Petr Pudlak | |
143 | 27f904f7 | Petr Pudlak | instance MonadLog IO where |
144 | 27f904f7 | Petr Pudlak | logAt = logM rootLoggerName |
145 | 27f904f7 | Petr Pudlak | |
146 | 78e0f701 | Petr Pudlak | instance (MonadLog m) => MonadLog (IdentityT m) where |
147 | 78e0f701 | Petr Pudlak | logAt p = lift . logAt p |
148 | 78e0f701 | Petr Pudlak | |
149 | 43c329e7 | Petr Pudlak | instance (MonadLog m) => MonadLog (ReaderT r m) where |
150 | 861ddf80 | Petr Pudlak | logAt p = lift . logAt p |
151 | 27f904f7 | Petr Pudlak | |
152 | 78e0f701 | Petr Pudlak | instance (MonadLog m) => MonadLog (SS.StateT s m) where |
153 | 78e0f701 | Petr Pudlak | logAt p = lift . logAt p |
154 | 78e0f701 | Petr Pudlak | |
155 | 12121213 | Petr Pudlak | instance (MonadLog m, Monoid w) => MonadLog (RWSS.RWST r w s m) where |
156 | 12121213 | Petr Pudlak | logAt p = lift . logAt p |
157 | 12121213 | Petr Pudlak | |
158 | d2029364 | Petr Pudlak | instance (MonadLog m, Error e) => MonadLog (ResultT e m) where |
159 | d2029364 | Petr Pudlak | logAt p = lift . logAt p |
160 | d2029364 | Petr Pudlak | |
161 | ba4e38e8 | Iustin Pop | -- | Log at debug level. |
162 | 27f904f7 | Petr Pudlak | logDebug :: (MonadLog m) => String -> m () |
163 | 27f904f7 | Petr Pudlak | logDebug = logAt DEBUG |
164 | ba4e38e8 | Iustin Pop | |
165 | ba4e38e8 | Iustin Pop | -- | Log at info level. |
166 | 27f904f7 | Petr Pudlak | logInfo :: (MonadLog m) => String -> m () |
167 | 27f904f7 | Petr Pudlak | logInfo = logAt INFO |
168 | ba4e38e8 | Iustin Pop | |
169 | ba4e38e8 | Iustin Pop | -- | Log at notice level. |
170 | 27f904f7 | Petr Pudlak | logNotice :: (MonadLog m) => String -> m () |
171 | 27f904f7 | Petr Pudlak | logNotice = logAt NOTICE |
172 | ba4e38e8 | Iustin Pop | |
173 | ba4e38e8 | Iustin Pop | -- | Log at warning level. |
174 | 27f904f7 | Petr Pudlak | logWarning :: (MonadLog m) => String -> m () |
175 | 27f904f7 | Petr Pudlak | logWarning = logAt WARNING |
176 | ba4e38e8 | Iustin Pop | |
177 | ba4e38e8 | Iustin Pop | -- | Log at error level. |
178 | 27f904f7 | Petr Pudlak | logError :: (MonadLog m) => String -> m () |
179 | 27f904f7 | Petr Pudlak | logError = logAt ERROR |
180 | ba4e38e8 | Iustin Pop | |
181 | ba4e38e8 | Iustin Pop | -- | Log at critical level. |
182 | 27f904f7 | Petr Pudlak | logCritical :: (MonadLog m) => String -> m () |
183 | 27f904f7 | Petr Pudlak | logCritical = logAt CRITICAL |
184 | ba4e38e8 | Iustin Pop | |
185 | ba4e38e8 | Iustin Pop | -- | Log at alert level. |
186 | 27f904f7 | Petr Pudlak | logAlert :: (MonadLog m) => String -> m () |
187 | 27f904f7 | Petr Pudlak | logAlert = logAt ALERT |
188 | ba4e38e8 | Iustin Pop | |
189 | ba4e38e8 | Iustin Pop | -- | Log at emergency level. |
190 | 27f904f7 | Petr Pudlak | logEmergency :: (MonadLog m) => String -> m () |
191 | 27f904f7 | Petr Pudlak | logEmergency = logAt EMERGENCY |
192 | 426f0900 | Petr Pudlak | |
193 | 3062d395 | Santi Raffa | -- | Check if the logging is at DEBUG level. |
194 | 3062d395 | Santi Raffa | -- DEBUG logging is unacceptable for production. |
195 | 3062d395 | Santi Raffa | isDebugMode :: IO Bool |
196 | 3062d395 | Santi Raffa | isDebugMode = (Just DEBUG ==) . getLevel <$> getRootLogger |
197 | 3062d395 | Santi Raffa | |
198 | 426f0900 | Petr Pudlak | -- * Logging in an error monad with rethrowing errors |
199 | 426f0900 | Petr Pudlak | |
200 | 426f0900 | Petr Pudlak | -- | If an error occurs within a given computation, it annotated |
201 | 426f0900 | Petr Pudlak | -- with a given message and logged and the error is re-thrown. |
202 | 426f0900 | Petr Pudlak | withErrorLogAt :: (MonadLog m, MonadError e m, Show e) |
203 | 426f0900 | Petr Pudlak | => Priority -> String -> m a -> m a |
204 | 426f0900 | Petr Pudlak | withErrorLogAt prio msg = flip catchError $ \e -> do |
205 | 426f0900 | Petr Pudlak | logAt prio (msg ++ ": " ++ show e) |
206 | 426f0900 | Petr Pudlak | throwError e |