{-# 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 :: InternalContext -> IO ()
initConnectLoop context :: InternalContext
context = do
ProcessID
pid <- IO ProcessID
PosixProcess.getProcessID
String
progName <- IO String
Environment.getProgName
String
execPath <- IO String
Environment.getExecutablePath
[String]
args <- IO [String]
Environment.getArgs
let
pidStr :: String
pidStr = ProcessID -> String
forall a. Show a => a -> String
show ProcessID
pid
Maybe Text
cpuSetFileContent <- String -> IO (Maybe Text)
getCpuSetFileContent String
pidStr
Maybe String
parentNsPid <- String -> IO (Maybe String)
getPidFromParentNamespace String
pidStr
let
processInfo :: ProcessInfo
processInfo =
ProcessInfo :: String
-> String
-> String
-> [String]
-> Maybe Text
-> Maybe String
-> ProcessInfo
ProcessInfo
{ pidString :: String
ProcessInfo.pidString = String
pidStr
, programName :: String
ProcessInfo.programName = String
progName
, executablePath :: String
ProcessInfo.executablePath = String
execPath
, arguments :: [String]
ProcessInfo.arguments = [String]
args
, cpuSetFileContent :: Maybe Text
ProcessInfo.cpuSetFileContent = Maybe Text
cpuSetFileContent
, parentNsPid :: Maybe String
ProcessInfo.parentNsPid = Maybe String
parentNsPid
}
if Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
parentNsPid then
String -> String -> IO ()
warningM String
instanaLogger (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Could not parse PID from sched file. " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"Discovery might not work if this process is running inside a " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"container."
else
if (String -> Maybe String
forall a. a -> Maybe a
Just String
pidStr) Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
parentNsPid then
String -> String -> IO ()
debugM String
instanaLogger (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
"PID in sched file matches process PID. Probably not running inside " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"a PID namespace"
else do
let
Just parentPid :: String
parentPid = Maybe String
parentNsPid
String -> String -> IO ()
infoM String
instanaLogger (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Changing PID from " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pidStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ " to " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
parentPid String -> String -> String
forall a. [a] -> [a] -> [a]
++
" due to successful identification of PID in parent namespace."
String -> String -> IO ()
debugM String
instanaLogger (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "discovered process info " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ProcessInfo -> String
forall a. Show a => a -> String
show ProcessInfo
processInfo
IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
InternalContext -> ProcessInfo -> IO ()
establishAgentConnectionSafe InternalContext
context ProcessInfo
processInfo
Int -> IO ()
Concurrent.threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ 5 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 1000
establishAgentConnectionSafe ::
InternalContext
-> ProcessInfo
-> IO ()
establishAgentConnectionSafe :: InternalContext -> ProcessInfo -> IO ()
establishAgentConnectionSafe context :: InternalContext
context processInfo :: ProcessInfo
processInfo =
IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
(InternalContext -> ProcessInfo -> IO ()
establishAgentConnection InternalContext
context ProcessInfo
processInfo)
(\e :: SomeException
e -> String -> String -> IO ()
warningM String
instanaLogger (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show (SomeException
e :: SomeException))
establishAgentConnection ::
InternalContext
-> ProcessInfo
-> IO ()
establishAgentConnection :: InternalContext -> ProcessInfo -> IO ()
establishAgentConnection context :: InternalContext
context processInfo :: ProcessInfo
processInfo = do
ConnectionState
currentState <- STM ConnectionState -> IO ConnectionState
forall a. STM a -> IO a
STM.atomically (STM ConnectionState -> IO ConnectionState)
-> STM ConnectionState -> IO ConnectionState
forall a b. (a -> b) -> a -> b
$
TVar ConnectionState -> STM ConnectionState
forall a. TVar a -> STM a
STM.readTVar (InternalContext -> TVar ConnectionState
InternalContext.connectionState InternalContext
context)
if ConnectionState
currentState ConnectionState -> ConnectionState -> Bool
forall a. Eq a => a -> a -> Bool
/= ConnectionState
Unconnected
then
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar ConnectionState -> ConnectionState -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar
(InternalContext -> TVar ConnectionState
InternalContext.connectionState InternalContext
context)
ConnectionState
AgentHostLookup
String -> String -> IO ()
debugM String
instanaLogger (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "agent connection is not up, attempting reconnect"
InternalContext -> ProcessInfo -> IO ()
AgentHostLookup.lookupAgentHost InternalContext
context ProcessInfo
processInfo
getCpuSetFileContent :: String -> IO (Maybe Text)
getCpuSetFileContent :: String -> IO (Maybe Text)
getCpuSetFileContent pidStr :: String
pidStr = do
let
cpuSetPath :: String
cpuSetPath = "/proc/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pidStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/cpuset"
IO (Maybe Text)
-> (SomeException -> IO (Maybe Text)) -> IO (Maybe Text)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
( do
Text
content <- String -> IO Text
TextIO.readFile String
cpuSetPath
if Text -> Int
T.length Text
content Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 2000 then
Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
else
Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
content
)
(\(SomeException
_ :: SomeException) -> do
String -> String -> IO ()
debugM String
instanaLogger (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Can't read " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cpuSetPath String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", process " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"is probably not running in a container."
Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
)
getPidFromParentNamespace :: String -> IO (Maybe String)
getPidFromParentNamespace :: String -> IO (Maybe String)
getPidFromParentNamespace pidStr :: String
pidStr = do
let
schedFilePath :: String
schedFilePath = "/proc/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pidStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/sched"
IO (Maybe String)
-> (SomeException -> IO (Maybe String)) -> IO (Maybe String)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
( do
String
schedFileContent <- String -> IO String
readFile String
schedFilePath
Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
parsePidFromSchedFile String
schedFileContent
)
(\(SomeException
_ :: SomeException) -> do
String -> String -> IO ()
debugM String
instanaLogger (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Can't read " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
schedFilePath String -> String -> String
forall a. [a] -> [a] -> [a]
++ "."
Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
)