{-# LANGUAGE ScopedTypeVariables #-}
module Instana.SDK.Internal.AgentConnection.ConnectLoop
( initConnectLoop
) where
import qualified Control.Concurrent as Concurrent
import qualified Control.Concurrent.STM as STM
import Control.Exception (SomeException,
catch)
import Control.Monad (forever)
import Data.Maybe (isNothing)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TextIO
import qualified System.Environment as Environment
import System.Log.Logger (debugM,
infoM,
warningM)
import qualified System.Posix.Process as PosixProcess
import qualified Instana.SDK.Internal.AgentConnection.AgentHostLookup as AgentHostLookup
import Instana.SDK.Internal.AgentConnection.ProcessInfo (ProcessInfo (ProcessInfo))
import qualified Instana.SDK.Internal.AgentConnection.ProcessInfo as ProcessInfo
import Instana.SDK.Internal.AgentConnection.SchedFile (parsePidFromSchedFile)
import Instana.SDK.Internal.Context (ConnectionState (..),
InternalContext)
import qualified Instana.SDK.Internal.Context as InternalContext
import Instana.SDK.Internal.Logging (instanaLogger)
initConnectLoop :: InternalContext -> IO ()
initConnectLoop context = do
pid <- PosixProcess.getProcessID
progName <- Environment.getProgName
execPath <- Environment.getExecutablePath
args <- Environment.getArgs
let
pidStr = show pid
cpuSetFileContent <- getCpuSetFileContent pidStr
parentNsPid <- getPidFromParentNamespace pidStr
let
processInfo =
ProcessInfo
{ ProcessInfo.pidString = pidStr
, ProcessInfo.programName = progName
, ProcessInfo.executablePath = execPath
, ProcessInfo.arguments = args
, ProcessInfo.cpuSetFileContent = cpuSetFileContent
, ProcessInfo.parentNsPid = parentNsPid
}
if isNothing parentNsPid then
warningM instanaLogger $ "Could not parse PID from sched file. " ++
"Discovery might not work if this process is running inside a " ++
"container."
else
if (Just pidStr) == parentNsPid then
debugM instanaLogger $
"PID in sched file matches process PID. Probably not running inside " ++
"a PID namespace"
else do
let
Just parentPid = parentNsPid
infoM instanaLogger $ "Changing PID from " ++ pidStr ++ " to " ++
parentPid ++
" due to successful identification of PID in parent namespace."
debugM instanaLogger $ "discovered process info " ++ show processInfo
forever $ do
establishAgentConnectionSafe context processInfo
Concurrent.threadDelay $ 5 * 1000 * 1000
establishAgentConnectionSafe ::
InternalContext
-> ProcessInfo
-> IO ()
establishAgentConnectionSafe context processInfo =
catch
(establishAgentConnection context processInfo)
(\e -> warningM instanaLogger $ show (e :: SomeException))
establishAgentConnection ::
InternalContext
-> ProcessInfo
-> IO ()
establishAgentConnection context processInfo = do
currentState <- STM.atomically $
STM.readTVar (InternalContext.connectionState context)
if currentState /= Unconnected
then
return ()
else do
STM.atomically $ STM.writeTVar
(InternalContext.connectionState context)
AgentHostLookup
debugM instanaLogger $ "agent connection is not up, attempting reconnect"
AgentHostLookup.lookupAgentHost context processInfo
getCpuSetFileContent :: String -> IO (Maybe Text)
getCpuSetFileContent pidStr = do
let
cpuSetPath = "/proc/" ++ pidStr ++ "/cpuset"
catch
( do
content <- TextIO.readFile cpuSetPath
if T.length content >= 2000 then
return Nothing
else
return $ Just content
)
(\(_ :: SomeException) -> do
debugM instanaLogger $ "Can't read " ++ cpuSetPath ++ ", process " ++
"is probably not running in a container."
return Nothing
)
getPidFromParentNamespace :: String -> IO (Maybe String)
getPidFromParentNamespace pidStr = do
let
schedFilePath = "/proc/" ++ pidStr ++ "/sched"
catch
( do
schedFileContent <- readFile schedFilePath
return $ parsePidFromSchedFile schedFileContent
)
(\(_ :: SomeException) -> do
debugM instanaLogger $ "Can't read " ++ schedFilePath ++ "."
return Nothing
)