Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Logging.hs @ 11e90588

History | View | Annotate | Download (4.5 kB)

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, 2013 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 tfLogFormatter "%F %X,%q %Z" $ 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 :: 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
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 Just C.devConsole else logf
102
      fmt = logFormatter program False False
103
      file_logging = syslog /= SyslogOnly
104

    
105
  updateGlobalLogger rootLoggerName (setLevel level)
106

    
107
  stderr_handlers <- openFormattedHandler stderr_logging fmt $
108
                     streamHandler stderr level
109

    
110
  file_handlers <- case destf of
111
                     Nothing -> return []
112
                     Just path -> openFormattedHandler file_logging fmt $
113
                                  fileHandler path level
114

    
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
119
  -- the above list
120
  when (syslog /= SyslogNo) $ do
121
    syslog_handler <- openlog program [PID] DAEMON INFO
122
    updateGlobalLogger rootLoggerName $ addHandler syslog_handler
123

    
124
-- * Logging function aliases
125

    
126
-- | Log at debug level.
127
logDebug :: String -> IO ()
128
logDebug = debugM rootLoggerName
129

    
130
-- | Log at info level.
131
logInfo :: String -> IO ()
132
logInfo = infoM rootLoggerName
133

    
134
-- | Log at notice level.
135
logNotice :: String -> IO ()
136
logNotice = noticeM rootLoggerName
137

    
138
-- | Log at warning level.
139
logWarning :: String -> IO ()
140
logWarning = warningM rootLoggerName
141

    
142
-- | Log at error level.
143
logError :: String -> IO ()
144
logError = errorM rootLoggerName
145

    
146
-- | Log at critical level.
147
logCritical :: String -> IO ()
148
logCritical = criticalM rootLoggerName
149

    
150
-- | Log at alert level.
151
logAlert :: String -> IO ()
152
logAlert = alertM rootLoggerName
153

    
154
-- | Log at emergency level.
155
logEmergency :: String -> IO ()
156
logEmergency = emergencyM rootLoggerName