root / src / Ganeti / Logging.hs @ d2029364
History | View | Annotate | Download (5.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 | ba4e38e8 | Iustin Pop | ) where |
50 | ba4e38e8 | Iustin Pop | |
51 | 43c329e7 | Petr Pudlak | import Control.Monad |
52 | d2029364 | Petr Pudlak | import Control.Monad.Error (Error(..)) |
53 | 43c329e7 | Petr Pudlak | import Control.Monad.Reader |
54 | ba4e38e8 | Iustin Pop | import System.Log.Logger |
55 | ba4e38e8 | Iustin Pop | import System.Log.Handler.Simple |
56 | a6e2a138 | Iustin Pop | import System.Log.Handler.Syslog |
57 | a6e2a138 | Iustin Pop | import System.Log.Handler (setFormatter, LogHandler) |
58 | ba4e38e8 | Iustin Pop | import System.Log.Formatter |
59 | ba4e38e8 | Iustin Pop | import System.IO |
60 | ba4e38e8 | Iustin Pop | |
61 | d2029364 | Petr Pudlak | import Ganeti.BasicTypes (ResultT(..)) |
62 | a6e2a138 | Iustin Pop | import Ganeti.THH |
63 | df726590 | Jose A. Lopes | import qualified Ganeti.ConstantUtils as ConstantUtils |
64 | ba4e38e8 | Iustin Pop | |
65 | a6e2a138 | Iustin Pop | -- | Syslog usage type. |
66 | df726590 | Jose A. Lopes | $(declareLADT ''String "SyslogUsage" |
67 | df726590 | Jose A. Lopes | [ ("SyslogNo", "no") |
68 | df726590 | Jose A. Lopes | , ("SyslogYes", "yes") |
69 | df726590 | Jose A. Lopes | , ("SyslogOnly", "only") |
70 | a6e2a138 | Iustin Pop | ]) |
71 | a6e2a138 | Iustin Pop | |
72 | ba4e38e8 | Iustin Pop | -- | Builds the log formatter. |
73 | ba4e38e8 | Iustin Pop | logFormatter :: String -- ^ Program |
74 | ba4e38e8 | Iustin Pop | -> Bool -- ^ Multithreaded |
75 | ba4e38e8 | Iustin Pop | -> Bool -- ^ Syslog |
76 | ba4e38e8 | Iustin Pop | -> LogFormatter a |
77 | ba4e38e8 | Iustin Pop | logFormatter prog mt syslog = |
78 | ba4e38e8 | Iustin Pop | let parts = [ if syslog |
79 | ba4e38e8 | Iustin Pop | then "[$pid]:" |
80 | ba4e38e8 | Iustin Pop | else "$time: " ++ prog ++ " pid=$pid" |
81 | ba4e38e8 | Iustin Pop | , if mt then if syslog then " ($tid)" else "/$tid" |
82 | ba4e38e8 | Iustin Pop | else "" |
83 | ba4e38e8 | Iustin Pop | , " $prio $msg" |
84 | ba4e38e8 | Iustin Pop | ] |
85 | ce817701 | Iustin Pop | in tfLogFormatter "%F %X,%q %Z" $ concat parts |
86 | ba4e38e8 | Iustin Pop | |
87 | a6e2a138 | Iustin Pop | -- | Helper to open and set the formatter on a log if enabled by a |
88 | a6e2a138 | Iustin Pop | -- given condition, otherwise returning an empty list. |
89 | a6e2a138 | Iustin Pop | openFormattedHandler :: (LogHandler a) => Bool |
90 | a6e2a138 | Iustin Pop | -> LogFormatter a -> IO a -> IO [a] |
91 | a6e2a138 | Iustin Pop | openFormattedHandler False _ _ = return [] |
92 | a6e2a138 | Iustin Pop | openFormattedHandler True fmt opener = do |
93 | a6e2a138 | Iustin Pop | handler <- opener |
94 | a6e2a138 | Iustin Pop | return [setFormatter handler fmt] |
95 | a6e2a138 | Iustin Pop | |
96 | ba4e38e8 | Iustin Pop | -- | Sets up the logging configuration. |
97 | 0c28bee1 | Iustin Pop | setupLogging :: Maybe String -- ^ Log file |
98 | ba4e38e8 | Iustin Pop | -> String -- ^ Program name |
99 | ba4e38e8 | Iustin Pop | -> Bool -- ^ Debug level |
100 | ba4e38e8 | Iustin Pop | -> Bool -- ^ Log to stderr |
101 | ba4e38e8 | Iustin Pop | -> Bool -- ^ Log to console |
102 | a6e2a138 | Iustin Pop | -> SyslogUsage -- ^ Syslog usage |
103 | ba4e38e8 | Iustin Pop | -> IO () |
104 | a6e2a138 | Iustin Pop | setupLogging logf program debug stderr_logging console syslog = do |
105 | ba4e38e8 | Iustin Pop | let level = if debug then DEBUG else INFO |
106 | df726590 | Jose A. Lopes | destf = if console then Just ConstantUtils.devConsole else logf |
107 | ba4e38e8 | Iustin Pop | fmt = logFormatter program False False |
108 | 0c28bee1 | Iustin Pop | file_logging = syslog /= SyslogOnly |
109 | ba4e38e8 | Iustin Pop | |
110 | ba4e38e8 | Iustin Pop | updateGlobalLogger rootLoggerName (setLevel level) |
111 | ba4e38e8 | Iustin Pop | |
112 | a6e2a138 | Iustin Pop | stderr_handlers <- openFormattedHandler stderr_logging fmt $ |
113 | a6e2a138 | Iustin Pop | streamHandler stderr level |
114 | a6e2a138 | Iustin Pop | |
115 | 0c28bee1 | Iustin Pop | file_handlers <- case destf of |
116 | 0c28bee1 | Iustin Pop | Nothing -> return [] |
117 | 0c28bee1 | Iustin Pop | Just path -> openFormattedHandler file_logging fmt $ |
118 | 0c28bee1 | Iustin Pop | fileHandler path level |
119 | a6e2a138 | Iustin Pop | |
120 | 2cdaf225 | Iustin Pop | let handlers = file_handlers ++ stderr_handlers |
121 | ba4e38e8 | Iustin Pop | updateGlobalLogger rootLoggerName $ setHandlers handlers |
122 | a6e2a138 | Iustin Pop | -- syslog handler is special (another type, still instance of the |
123 | a6e2a138 | Iustin Pop | -- typeclass, and has a built-in formatter), so we can't pass it in |
124 | a6e2a138 | Iustin Pop | -- the above list |
125 | a6e2a138 | Iustin Pop | when (syslog /= SyslogNo) $ do |
126 | a6e2a138 | Iustin Pop | syslog_handler <- openlog program [PID] DAEMON INFO |
127 | a6e2a138 | Iustin Pop | updateGlobalLogger rootLoggerName $ addHandler syslog_handler |
128 | ba4e38e8 | Iustin Pop | |
129 | ba4e38e8 | Iustin Pop | -- * Logging function aliases |
130 | ba4e38e8 | Iustin Pop | |
131 | 27f904f7 | Petr Pudlak | -- | A monad that allows logging. |
132 | 27f904f7 | Petr Pudlak | class Monad m => MonadLog m where |
133 | 27f904f7 | Petr Pudlak | -- | Log at a given level. |
134 | 27f904f7 | Petr Pudlak | logAt :: Priority -> String -> m () |
135 | 27f904f7 | Petr Pudlak | |
136 | 27f904f7 | Petr Pudlak | instance MonadLog IO where |
137 | 27f904f7 | Petr Pudlak | logAt = logM rootLoggerName |
138 | 27f904f7 | Petr Pudlak | |
139 | 43c329e7 | Petr Pudlak | instance (MonadLog m) => MonadLog (ReaderT r m) where |
140 | 43c329e7 | Petr Pudlak | logAt p x = lift $ logAt p x |
141 | 27f904f7 | Petr Pudlak | |
142 | d2029364 | Petr Pudlak | instance (MonadLog m, Error e) => MonadLog (ResultT e m) where |
143 | d2029364 | Petr Pudlak | logAt p = lift . logAt p |
144 | d2029364 | Petr Pudlak | |
145 | ba4e38e8 | Iustin Pop | -- | Log at debug level. |
146 | 27f904f7 | Petr Pudlak | logDebug :: (MonadLog m) => String -> m () |
147 | 27f904f7 | Petr Pudlak | logDebug = logAt DEBUG |
148 | ba4e38e8 | Iustin Pop | |
149 | ba4e38e8 | Iustin Pop | -- | Log at info level. |
150 | 27f904f7 | Petr Pudlak | logInfo :: (MonadLog m) => String -> m () |
151 | 27f904f7 | Petr Pudlak | logInfo = logAt INFO |
152 | ba4e38e8 | Iustin Pop | |
153 | ba4e38e8 | Iustin Pop | -- | Log at notice level. |
154 | 27f904f7 | Petr Pudlak | logNotice :: (MonadLog m) => String -> m () |
155 | 27f904f7 | Petr Pudlak | logNotice = logAt NOTICE |
156 | ba4e38e8 | Iustin Pop | |
157 | ba4e38e8 | Iustin Pop | -- | Log at warning level. |
158 | 27f904f7 | Petr Pudlak | logWarning :: (MonadLog m) => String -> m () |
159 | 27f904f7 | Petr Pudlak | logWarning = logAt WARNING |
160 | ba4e38e8 | Iustin Pop | |
161 | ba4e38e8 | Iustin Pop | -- | Log at error level. |
162 | 27f904f7 | Petr Pudlak | logError :: (MonadLog m) => String -> m () |
163 | 27f904f7 | Petr Pudlak | logError = logAt ERROR |
164 | ba4e38e8 | Iustin Pop | |
165 | ba4e38e8 | Iustin Pop | -- | Log at critical level. |
166 | 27f904f7 | Petr Pudlak | logCritical :: (MonadLog m) => String -> m () |
167 | 27f904f7 | Petr Pudlak | logCritical = logAt CRITICAL |
168 | ba4e38e8 | Iustin Pop | |
169 | ba4e38e8 | Iustin Pop | -- | Log at alert level. |
170 | 27f904f7 | Petr Pudlak | logAlert :: (MonadLog m) => String -> m () |
171 | 27f904f7 | Petr Pudlak | logAlert = logAt ALERT |
172 | ba4e38e8 | Iustin Pop | |
173 | ba4e38e8 | Iustin Pop | -- | Log at emergency level. |
174 | 27f904f7 | Petr Pudlak | logEmergency :: (MonadLog m) => String -> m () |
175 | 27f904f7 | Petr Pudlak | logEmergency = logAt EMERGENCY |