Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Logging.hs @ 241cea1e

History | View | Annotate | Download (4.5 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 ba4e38e8 Iustin Pop
  , logDebug
37 ba4e38e8 Iustin Pop
  , logInfo
38 ba4e38e8 Iustin Pop
  , logNotice
39 ba4e38e8 Iustin Pop
  , logWarning
40 ba4e38e8 Iustin Pop
  , logError
41 ba4e38e8 Iustin Pop
  , logCritical
42 ba4e38e8 Iustin Pop
  , logAlert
43 ba4e38e8 Iustin Pop
  , logEmergency
44 a6e2a138 Iustin Pop
  , SyslogUsage(..)
45 a6e2a138 Iustin Pop
  , syslogUsageToRaw
46 a6e2a138 Iustin Pop
  , syslogUsageFromRaw
47 ba4e38e8 Iustin Pop
  ) where
48 ba4e38e8 Iustin Pop
49 a6e2a138 Iustin Pop
import Control.Monad (when)
50 ba4e38e8 Iustin Pop
import System.Log.Logger
51 ba4e38e8 Iustin Pop
import System.Log.Handler.Simple
52 a6e2a138 Iustin Pop
import System.Log.Handler.Syslog
53 a6e2a138 Iustin Pop
import System.Log.Handler (setFormatter, LogHandler)
54 ba4e38e8 Iustin Pop
import System.Log.Formatter
55 ba4e38e8 Iustin Pop
import System.IO
56 ba4e38e8 Iustin Pop
57 a6e2a138 Iustin Pop
import Ganeti.THH
58 ba4e38e8 Iustin Pop
import qualified Ganeti.Constants as C
59 ba4e38e8 Iustin Pop
60 a6e2a138 Iustin Pop
-- | Syslog usage type.
61 a6e2a138 Iustin Pop
$(declareSADT "SyslogUsage"
62 a6e2a138 Iustin Pop
  [ ("SyslogNo",   'C.syslogNo)
63 a6e2a138 Iustin Pop
  , ("SyslogYes",  'C.syslogYes)
64 a6e2a138 Iustin Pop
  , ("SyslogOnly", 'C.syslogOnly)
65 a6e2a138 Iustin Pop
  ])
66 a6e2a138 Iustin Pop
67 ba4e38e8 Iustin Pop
-- | Builds the log formatter.
68 ba4e38e8 Iustin Pop
logFormatter :: String  -- ^ Program
69 ba4e38e8 Iustin Pop
             -> Bool    -- ^ Multithreaded
70 ba4e38e8 Iustin Pop
             -> Bool    -- ^ Syslog
71 ba4e38e8 Iustin Pop
             -> LogFormatter a
72 ba4e38e8 Iustin Pop
logFormatter prog mt syslog =
73 ba4e38e8 Iustin Pop
  let parts = [ if syslog
74 ba4e38e8 Iustin Pop
                  then "[$pid]:"
75 ba4e38e8 Iustin Pop
                  else "$time: " ++ prog ++ " pid=$pid"
76 ba4e38e8 Iustin Pop
              , if mt then if syslog then " ($tid)" else "/$tid"
77 ba4e38e8 Iustin Pop
                  else ""
78 ba4e38e8 Iustin Pop
              , " $prio $msg"
79 ba4e38e8 Iustin Pop
              ]
80 ce817701 Iustin Pop
  in tfLogFormatter "%F %X,%q %Z" $ concat parts
81 ba4e38e8 Iustin Pop
82 a6e2a138 Iustin Pop
-- | Helper to open and set the formatter on a log if enabled by a
83 a6e2a138 Iustin Pop
-- given condition, otherwise returning an empty list.
84 a6e2a138 Iustin Pop
openFormattedHandler :: (LogHandler a) => Bool
85 a6e2a138 Iustin Pop
                     -> LogFormatter a -> IO a -> IO [a]
86 a6e2a138 Iustin Pop
openFormattedHandler False _ _ = return []
87 a6e2a138 Iustin Pop
openFormattedHandler True fmt opener = do
88 a6e2a138 Iustin Pop
  handler <- opener
89 a6e2a138 Iustin Pop
  return [setFormatter handler fmt]
90 a6e2a138 Iustin Pop
91 ba4e38e8 Iustin Pop
-- | Sets up the logging configuration.
92 0c28bee1 Iustin Pop
setupLogging :: Maybe String    -- ^ Log file
93 ba4e38e8 Iustin Pop
             -> String    -- ^ Program name
94 ba4e38e8 Iustin Pop
             -> Bool      -- ^ Debug level
95 ba4e38e8 Iustin Pop
             -> Bool      -- ^ Log to stderr
96 ba4e38e8 Iustin Pop
             -> Bool      -- ^ Log to console
97 a6e2a138 Iustin Pop
             -> SyslogUsage -- ^ Syslog usage
98 ba4e38e8 Iustin Pop
             -> IO ()
99 a6e2a138 Iustin Pop
setupLogging logf program debug stderr_logging console syslog = do
100 ba4e38e8 Iustin Pop
  let level = if debug then DEBUG else INFO
101 0c28bee1 Iustin Pop
      destf = if console then Just C.devConsole else logf
102 ba4e38e8 Iustin Pop
      fmt = logFormatter program False False
103 0c28bee1 Iustin Pop
      file_logging = syslog /= SyslogOnly
104 ba4e38e8 Iustin Pop
105 ba4e38e8 Iustin Pop
  updateGlobalLogger rootLoggerName (setLevel level)
106 ba4e38e8 Iustin Pop
107 a6e2a138 Iustin Pop
  stderr_handlers <- openFormattedHandler stderr_logging fmt $
108 a6e2a138 Iustin Pop
                     streamHandler stderr level
109 a6e2a138 Iustin Pop
110 0c28bee1 Iustin Pop
  file_handlers <- case destf of
111 0c28bee1 Iustin Pop
                     Nothing -> return []
112 0c28bee1 Iustin Pop
                     Just path -> openFormattedHandler file_logging fmt $
113 0c28bee1 Iustin Pop
                                  fileHandler path level
114 a6e2a138 Iustin Pop
115 2cdaf225 Iustin Pop
  let handlers = file_handlers ++ stderr_handlers
116 ba4e38e8 Iustin Pop
  updateGlobalLogger rootLoggerName $ setHandlers handlers
117 a6e2a138 Iustin Pop
  -- syslog handler is special (another type, still instance of the
118 a6e2a138 Iustin Pop
  -- typeclass, and has a built-in formatter), so we can't pass it in
119 a6e2a138 Iustin Pop
  -- the above list
120 a6e2a138 Iustin Pop
  when (syslog /= SyslogNo) $ do
121 a6e2a138 Iustin Pop
    syslog_handler <- openlog program [PID] DAEMON INFO
122 a6e2a138 Iustin Pop
    updateGlobalLogger rootLoggerName $ addHandler syslog_handler
123 ba4e38e8 Iustin Pop
124 ba4e38e8 Iustin Pop
-- * Logging function aliases
125 ba4e38e8 Iustin Pop
126 ba4e38e8 Iustin Pop
-- | Log at debug level.
127 ba4e38e8 Iustin Pop
logDebug :: String -> IO ()
128 ba4e38e8 Iustin Pop
logDebug = debugM rootLoggerName
129 ba4e38e8 Iustin Pop
130 ba4e38e8 Iustin Pop
-- | Log at info level.
131 ba4e38e8 Iustin Pop
logInfo :: String -> IO ()
132 ba4e38e8 Iustin Pop
logInfo = infoM rootLoggerName
133 ba4e38e8 Iustin Pop
134 ba4e38e8 Iustin Pop
-- | Log at notice level.
135 ba4e38e8 Iustin Pop
logNotice :: String -> IO ()
136 ba4e38e8 Iustin Pop
logNotice = noticeM rootLoggerName
137 ba4e38e8 Iustin Pop
138 ba4e38e8 Iustin Pop
-- | Log at warning level.
139 ba4e38e8 Iustin Pop
logWarning :: String -> IO ()
140 ba4e38e8 Iustin Pop
logWarning = warningM rootLoggerName
141 ba4e38e8 Iustin Pop
142 ba4e38e8 Iustin Pop
-- | Log at error level.
143 ba4e38e8 Iustin Pop
logError :: String -> IO ()
144 ba4e38e8 Iustin Pop
logError = errorM rootLoggerName
145 ba4e38e8 Iustin Pop
146 ba4e38e8 Iustin Pop
-- | Log at critical level.
147 ba4e38e8 Iustin Pop
logCritical :: String -> IO ()
148 ba4e38e8 Iustin Pop
logCritical = criticalM rootLoggerName
149 ba4e38e8 Iustin Pop
150 ba4e38e8 Iustin Pop
-- | Log at alert level.
151 ba4e38e8 Iustin Pop
logAlert :: String -> IO ()
152 ba4e38e8 Iustin Pop
logAlert = alertM rootLoggerName
153 ba4e38e8 Iustin Pop
154 ba4e38e8 Iustin Pop
-- | Log at emergency level.
155 ba4e38e8 Iustin Pop
logEmergency :: String -> IO ()
156 ba4e38e8 Iustin Pop
logEmergency = emergencyM rootLoggerName