module Instana.SDK.Internal.Logging
( initLogger
, instanaLogger
, parseLogLevel
, minimumLogLevel
)
where
import Control.Monad (when)
import Data.Maybe (catMaybes, isJust)
import Data.Traversable (sequence)
import System.Directory (getTemporaryDirectory)
import System.Environment (lookupEnv)
import System.IO (Handle, stdout)
import System.Log.Formatter
import System.Log.Handler (setFormatter)
import System.Log.Handler.Simple (GenericHandler, fileHandler,
streamHandler)
import System.Log.Logger (Priority (..), rootLoggerName,
setHandlers, setLevel,
updateGlobalLogger)
logLevelKey :: String
logLevelKey = "INSTANA_LOG_LEVEL"
logLevelStdOutKey :: String
logLevelStdOutKey = "INSTANA_LOG_LEVEL_STDOUT"
overrideHsloggerRootHandlerKey :: String
overrideHsloggerRootHandlerKey = "INSTANA_OVERRIDE_HSLOGGER_ROOT_HANDLER"
instanaLogger :: String
instanaLogger = "Instana"
initLogger :: String -> IO ()
initLogger pid = do
logLevelFileStr <- lookupEnv logLevelKey
logLevelStdOutStr <- lookupEnv logLevelStdOutKey
let
logLevelFile = logLevelFileStr >>= parseLogLevel
logLevelStdOut = logLevelStdOutStr >>= parseLogLevel
let
minLogLevel = minimumLogLevel logLevelFile logLevelStdOut
case minLogLevel of
Just minLevel ->
actuallyInitLogger pid minLevel logLevelFile logLevelStdOut
Nothing -> do
return ()
actuallyInitLogger ::
String ->
Priority ->
Maybe Priority ->
Maybe Priority ->
IO ()
actuallyInitLogger pid minLogLevel logLevelFile logLevelStdOut = do
updateGlobalLogger instanaLogger $ setLevel minLogLevel
logFileHandler <-
sequence $
(\logLevel -> createFileHandler pid logLevel) <$> logLevelFile
stdOutHandler <-
sequence $
(\logLevel -> createStdOutHandler logLevel) <$> logLevelStdOut
setLogHandlers logFileHandler stdOutHandler
createFileHandler :: String -> Priority -> IO (GenericHandler Handle)
createFileHandler pid logLevel = do
systemTempDir <- getTemporaryDirectory
let
systemTempDir' =
case last systemTempDir of
'/' -> systemTempDir
'\\' -> systemTempDir
_ -> systemTempDir ++ "/"
logPath = systemTempDir' ++ "instana-haskell-sdk." ++ pid ++ ".log"
instanaFileHandler <- fileHandler logPath logLevel
let
formattedInstanaFileHandler = withFormatter instanaFileHandler
return formattedInstanaFileHandler
createStdOutHandler :: Priority -> IO (GenericHandler Handle)
createStdOutHandler logLevel = do
instanaStreamHandler <- streamHandler stdout logLevel
let
formattedInstanaStreamHandler = withFormatter instanaStreamHandler
return formattedInstanaStreamHandler
setLogHandlers ::
Maybe (GenericHandler Handle)
-> Maybe (GenericHandler Handle)
-> IO ()
setLogHandlers logFileHandler stdOutHandler = do
overrideHsloggerRootHandlerVal <-
lookupEnv overrideHsloggerRootHandlerKey
let
overrideHsloggerRootHandler =
isJust overrideHsloggerRootHandlerVal
handlers =
catMaybes
[ logFileHandler
, if overrideHsloggerRootHandler
then Nothing
else stdOutHandler
]
updateGlobalLogger instanaLogger $ setHandlers handlers
when overrideHsloggerRootHandler
(do
actualStdOutHandler <-
case stdOutHandler of
Just handler ->
return handler
Nothing ->
createStdOutHandler EMERGENCY
let
overrideRootHhandlers = [ actualStdOutHandler ]
updateGlobalLogger rootLoggerName $ setHandlers overrideRootHhandlers
)
withFormatter :: GenericHandler Handle -> GenericHandler Handle
withFormatter handler = setFormatter handler formatter
where
timeFormat = "%F %H:%M:%S.%4q %z"
formatter = tfLogFormatter timeFormat "[$time $loggername $pid $prio] $msg"
parseLogLevel :: String -> Maybe Priority
parseLogLevel logLevelStr =
case logLevelStr of
"DEBUG" -> Just DEBUG
"INFO" -> Just INFO
"NOTICE" -> Just NOTICE
"WARNING" -> Just WARNING
"ERROR" -> Just ERROR
"CRITICAL" -> Just CRITICAL
"ALERT" -> Just ALERT
"EMERGENCY" -> Just EMERGENCY
_ -> Nothing
minimumLogLevel :: Maybe Priority -> Maybe Priority -> Maybe Priority
minimumLogLevel (Just l1) (Just l2) = Just $ min l1 l2
minimumLogLevel (Just l) Nothing = Just l
minimumLogLevel Nothing (Just l) = Just l
minimumLogLevel _ _ = Nothing