Commit bb3a9c6c authored by Swann Perarnau's avatar Swann Perarnau

Execute cmd-specific actuators in the same env

Record the environment used to launch a command, and use the same
environment to launch cmd-specific actuators. Also augment this
environment so that actuators can know the cmd id and pid of the target
process.
parent d53e71f6
Pipeline #13476 failed with stages
in 11 minutes and 3 seconds
......@@ -22,10 +22,15 @@ let Instrumentation =
-- is a message rate limitation.
{ ratelimit : types.Frequency }
let EnvVar =
-- Key-value representation of environment variables
{ envName : Text, envValue : Text }
let AppActuator =
-- Configuration for an arbitrary actuator.
{ actuatorBinary : Text
, actuatorArguments : List Text
, actuatorEnv : List EnvVar
, actions : List Double
, referenceAction : Double
}
......@@ -54,4 +59,5 @@ in types
, Manifest = Manifest
, AppActuator = AppActuator
, AppActuatorKV = AppActuatorKV
, EnvVar = EnvVar
}
......@@ -198,7 +198,7 @@ registerLaunched cmdID pid st =
Right
( st & #slices . at sliceID
?~ ( slice &~ do
#cmds . at cmdID ?= registerPID cmdCore pid
#cmds . at cmdID ?= registerPID cmdID cmdCore pid
#awaiting %= sans cmdID
),
sliceID,
......
......@@ -72,6 +72,7 @@ data CmdCore
= CmdCore
{ cmdPath :: Command,
arguments :: [Arg],
cmdEnv :: Env,
upstreamClientID :: Maybe UC.UpstreamClientID,
manifest :: Manifest
}
......@@ -94,12 +95,18 @@ mkCmd :: CmdSpec -> Manifest -> Maybe UC.UpstreamClientID -> CmdCore
mkCmd s manifest clientID = CmdCore
{ cmdPath = cmd s,
arguments = args s,
cmdEnv = env s,
upstreamClientID = clientID,
manifest = manifest
}
registerPID :: CmdCore -> ProcessID -> Cmd
registerPID c pid = Cmd
-- | This function registers the pid associated with a command, and also
-- materializes cmd-level actuators based on their manifest description.
-- As a way to allow actuators to access environment variables related to the
-- NRM, we inject extra variables in the environment used to materialize
-- actuators
registerPID :: CmdID -> CmdCore -> ProcessID -> Cmd
registerPID id c pid = injectActuatorEnv id Cmd
{ cmdCore = c,
processState = blankState,
downstreamCmds = M.empty,
......@@ -110,6 +117,34 @@ registerPID c pid = Cmd
c & manifest & app & Ma.actuators
}
-- | inject the command environment into each of the cmd-specific actuators
injectActuatorEnv :: CmdID -> Cmd -> Cmd
injectActuatorEnv id c = Cmd
{ cmdCore = cmdCore c,
processState = processState c,
downstreamCmds = downstreamCmds c,
downstreamThreads = downstreamThreads c,
pid = pid c,
appActuators = fmap (\a -> injectAAEnv id c a) (appActuators c)
}
where
injectAAEnv :: CmdID -> Cmd -> Ma.AppActuator -> Ma.AppActuator
injectAAEnv id c a = Ma.AppActuator
{ actuatorBinary = Ma.actuatorBinary a,
actuatorArguments = Ma.actuatorArguments a,
actuatorEnv =
(Ma.actuatorEnv a)
++ envConvert (c & cmdCore & cmdEnv)
++ [ (Ma.EnvVar (fromString k) (fromString v))
| (k, v) <-
[("NRM_CMDPID", show $ pid c), ("NRM_CMDID", show id)]
],
actions = Ma.actions a,
referenceAction = Ma.referenceAction a
}
envConvert :: Env -> [Ma.EnvVar]
envConvert e = [(Ma.EnvVar k v) | (k, v) <- (M.toList $ fromEnv e)]
addDownstreamCmdClient ::
Cmd ->
DownstreamCmdID ->
......@@ -189,9 +224,12 @@ instance HasLensMap (Text, AppActuator) ActuatorKey Actuator where
referenceAction = Ma.referenceAction extraActuator,
go = \value ->
runProcess_ $
System.Process.Typed.proc
(toS $ Ma.actuatorBinary extraActuator)
((toS <$> Ma.actuatorArguments extraActuator) <> [show value])
System.Process.Typed.setEnv
([(toS k, toS v) | (EnvVar k v) <- Ma.actuatorEnv extraActuator])
( System.Process.Typed.proc
(toS $ Ma.actuatorBinary extraActuator)
((toS <$> Ma.actuatorArguments extraActuator) <> [show value])
)
}
setter :: Ma.AppActuator -> Actuator -> Ma.AppActuator
setter oldExtraActuator actuator = coerce $
......
......@@ -13,6 +13,7 @@ module NRM.Types.Manifest
App (..),
AppActuator (..),
AppActuatorKV (..),
EnvVar (..),
Instrumentation (..),
Perfwrapper (..),
toFrequency,
......@@ -42,6 +43,7 @@ makeHaskellTypes $
dRec "Perfwrapper" "Perfwrapper",
dRec "Instrumentation" "Instrumentation",
dRec "AppActuator" "AppActuator",
dRec "EnvVar" "EnvVar",
dRec "AppActuatorKV" "AppActuatorKV",
dRec "App" "App",
dRec "Manifest" "Manifest"
......@@ -69,6 +71,26 @@ instance MessagePack Integer where
fromObject x = (toInteger :: Int -> Integer) <$> fromObject x
deriving instance Generic EnvVar
deriving instance Eq EnvVar
deriving instance Ord EnvVar
deriving instance Show EnvVar
deriving instance MessagePack EnvVar
deriving instance FromDhall EnvVar
deriving instance ToDhall EnvVar
deriving via (GenericJSON EnvVar) instance FromJSON EnvVar
deriving via (GenericJSON EnvVar) instance ToJSON EnvVar
deriving via (GenericJSON EnvVar) instance JSONSchema EnvVar
deriving instance Generic AppActuatorKV
deriving instance Eq AppActuatorKV
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment