Commit fbd84589 authored by Valentin Reis's avatar Valentin Reis

Cleaning perf-wrapper test, adding warning, help messages.

parent 7e7c66e4
......@@ -11,6 +11,6 @@ cabal-version: >=1.10
library
exposed-Modules: Argo.Stack
Argo.Utils
build-depends: base >=4 && <=8, turtle, data-default, managed, ansi-terminal, unix, system-filepath, async, process, text, optparse-applicative
build-depends: base >=4 && <=8, turtle, data-default, managed, ansi-terminal, unix, system-filepath, async, process, text, optparse-applicative, extra
hs-source-dirs: src
default-language: Haskell2010
......@@ -26,9 +26,11 @@ import Argo.Utils
import System.Process as P
hiding ( shell )
import Options.Applicative as OA
import Control.Monad.Extra as E
data StackArgs = StackArgs
{ app :: Text
, containerName :: Text
, workingDirectory :: FilePath
, manifestDir :: FilePath
, manifestName :: FilePath
......@@ -42,6 +44,7 @@ data StackArgs = StackArgs
instance Default StackArgs where
def = StackArgs
{ app = "echo foobar"
, containerName = "testContainer"
, workingDirectory = "_output"
, manifestDir = "manifests"
, manifestName = "basic.json"
......@@ -57,11 +60,18 @@ parseExtendStackArgs :: StackArgs -> Parser StackArgs
parseExtendStackArgs StackArgs {..} = do
app <- strOption
( long "application"
<> metavar "FILE"
<> metavar "APP"
<> help "Target application call, sh+path valid"
<> showDefault
<> value app
)
containerName <- strOption
( long "container_name"
<> metavar "ARGO_CONTAINER_UUID"
<> help "Container name"
<> showDefault
<> value containerName
)
workingDirectory <- strOption
( long "output"
<> metavar "FILE"
......@@ -127,9 +137,22 @@ parseExtendStackArgs StackArgs {..} = do
)
pure StackArgs {..}
cleanLeftoverProcesses :: Shell ()
cleanLeftoverProcesses = do
printInfo "Cleaning leftover processes.\n"
daemon <- myWhich "daemon"
verboseShell (format ("pkill " % fp) daemon) empty
cmd <- myWhich "cmd"
void $ verboseShell (format ("pkill " % fp) cmd) empty
daemon_wrapped <- myWhichMaybe ".daemon-wrapped"
E.whenJust daemon_wrapped (\x -> void $ verboseShell "pkill .daemon-wrapped" empty)
cmd_wrapped <- myWhichMaybe ".cmd-wrapped"
void $ E.whenJust cmd_wrapped (\x -> void $ verboseShell "pkill .cmd-wrapped" empty)
cleanLeftovers :: StackArgs -> Shell ()
cleanLeftovers StackArgs {..} = do
printInfo "Cleaning leftovers..\n"
cleanLeftoverProcesses
printInfo "Cleaning leftover files.\n"
mapM_
cleanLog
[ workingDirectory </> daemon_out
......@@ -141,6 +164,7 @@ cleanLeftovers StackArgs {..} = do
, workingDirectory </> ".argo_nodeos_config_exit_message"
, workingDirectory </> "argo_nodeos_config"
]
printInfo "Cleaning leftover sockets.\n"
mapM_ cleanSocket ["/tmp/nrm-downstream-in", "/tmp/nrm-upstream-in"]
prepareDaemonShell :: StackArgs -> Shell (IO ())
......@@ -159,16 +183,17 @@ prepareDaemonShellWithStoppingCriterion waitCondition StackArgs {..} = do
cp confPath confPath'
printInfo $ format ("Copied the configurator to " % fp % "\n") confPath'
printInfo $ format "Trying to sudo chown and chmod argo_nodeos_config\n"
shell (format ("sudo chown root:root " % fp) confPath') empty >>= \case
verboseShell (format ("sudo chown root:root " % fp) confPath') empty >>= \case
ExitSuccess -> printInfo "Chowned argo_nodeos_config to root:root.\n"
ExitFailure n ->
die ("Failed to set argo_nodeos_config permissions " <> repr n)
shell (format ("sudo chmod u+sw " % fp) confPath') empty >>= \case
verboseShell (format ("sudo chmod u+sw " % fp) confPath') empty >>= \case
ExitSuccess -> printInfo "Set the suid bit.\n"
ExitFailure n -> die ("Setting suid bit failed with exit code " <> repr n)
--Cleaning the config, running the daemon
shell (format (fp % " --clean_config=kill_content:true") confPath') empty
verboseShell (format (fp % " --clean_config=kill_content:true") confPath')
empty
>>= \case
ExitSuccess -> printInfo "Cleaned the argo config.\n"
ExitFailure n -> do
......@@ -200,8 +225,9 @@ prepareDaemonShellWithStoppingCriterion waitCondition StackArgs {..} = do
-- | See at the bottom of this file for discussion of this function. (1)
cmdShell :: StackArgs -> Shell ()
cmdShell StackArgs {..} =
shell
(format ("cmd run -u toto " % fp % " " % s % " > " % fp % " 2>" % fp)
verboseShell
(format ("cmd run -u "%s%" " % fp % " " % s % " > " % fp % " 2>" % fp)
containerName
(manifestDir </> manifestName)
app
cmd_out
......@@ -234,9 +260,9 @@ runSimpleStackWithCriterion
:: (Shell (Either Line Line) -> Shell (Either Line Line))
-> StackArgs
-> IO ()
runSimpleStackWithCriterion stoppingCriterion a@StackArgs {..} = sh $ do
runSimpleStackWithCriterion stoppingCriteria a@StackArgs {..} = sh $ do
cleanLeftovers a
daemonShell <- prepareDaemonShellWithStoppingCriterion stoppingCriterion a
daemonShell <- prepareDaemonShellWithStoppingCriterion stoppingCriteria a
liftIO $ withAsync daemonShell $ \daemon -> do
kbInstallHandler $ cancel daemon
withAsync (time $ sh $ cmdShell a) $ \cmd -> do
......
......@@ -16,17 +16,30 @@ colorShell color s = setC color *> s *> setC White
where setC c = liftIO $ setSGR [SetColor Foreground Dull c]
printInfo :: Text -> Shell ()
printCommand :: Text -> Shell ()
printError :: Text -> Shell ()
printWarning :: Text -> Shell ()
printInfo = printf ("Info:" % s)
printWarning = colorShell Yellow . printf ("Warning:" % s)
printError = colorShell Red . printf ("Error:" % s)
printSuccess :: Text -> Shell ()
dieRed :: Text -> Shell ()
printInfo = printf ("Info: " % s)
printCommand = printf ("Running: " % s % "\n")
printWarning = colorShell Yellow . printf ("Warning: " % s)
printError = colorShell Red . printf ("Error: " % s)
printSuccess = colorShell Green . printf ("Success: " % s)
dieRed str =
colorShell Red (printf ("Failure: " % s) str) >> exit (ExitFailure 1)
myWhich str = which str >>= \case
(Just p) ->
printInfo (format ("Found " % fp % " at " % fp % "\n") str p) >> return p
Nothing -> die $ format ("Argo `" % fp % "` not in $PATH.") str
myWhichMaybe str = which str >>= \case
(Just p) -> printInfo (format ("Found " % fp % " at " % fp % "\n") str p)
>> return (Just p)
Nothing -> return Nothing
sudoRemoveFile :: (Text -> Shell ()) -> Text -> FilePath -> Shell ()
sudoRemoveFile printer desc filePath = do
foundSocket <- testfile filePath
......@@ -50,9 +63,11 @@ sudoRemoveFile printer desc filePath = do
desc
go True
verboseShell :: Text -> Shell Line -> Shell ExitCode
verboseShell command input = printCommand command >> shell command input
cleanSocket = sudoRemoveFile printError "socket"
cleanLog = sudoRemoveFile printWarning "log file"
kbInstallHandler :: IO () -> IO Handler
kbInstallHandler h = installHandler keyboardSignal (Catch h) Nothing
......@@ -19,7 +19,12 @@ import System.Posix.Signals
import Control.Monad
import Data.Either
helloWorldText = "HelloWorldFromApp"
messageOption = strOption
( long "message"
<> metavar "MESSAGE"
<> help "String to look for in the NRM daemon standard output."
<> value "progress"
)
opts :: StackArgs -> Parser (IO ())
opts sa = hsubparser
......@@ -36,9 +41,19 @@ opts sa = hsubparser
)
<> command
"stack"
(info (runSimpleStack <$> parseExtendStackArgs sa)
(progDesc "Setup stack and run a command in a container.")
)
<> command
"grep"
(info
(runSimpleStack <$> parseExtendStackArgs sa)
(progDesc "Setup stack and run an arbitrary command in a container.")
(runWaitForMessage <$> messageOption <*> parseExtendStackArgs
(sa { app = "echo foobar" })
)
(progDesc
"Setup stack and look for a message in the daemon's \
\standard output."
)
)
<> command
"helloworld"
......@@ -54,15 +69,15 @@ opts sa = hsubparser
<> command
"perfwrapper"
(info
(runWaitForMessage "payload" <$> parseExtendStackArgs
(runWaitForMessage "progress" <$> parseExtendStackArgs
(sa { manifestName = "perfwrap.json"
, app = format ("sleep " % s) "5"
}
)
)
(progDesc
"Test 2: Setup stack and check that a hello world app sends \
\message back to cmd. Uses argo-perf-wrapper."
"Test 2: Setup stack and check that argo-perf-wrapper sends \
\ at least one progress message up."
)
)
<> help
......@@ -79,31 +94,33 @@ main = do
runCheckCmdOutput :: Text -> StackArgs -> IO ()
runCheckCmdOutput message a@StackArgs {..} = do
sh cleanLeftoverProcesses
runSimpleStack a
readTextFile cmd_err >>= \x -> case match (has (text message)) x of
[] ->
die $ "Test failure: Cmd did not recieve the '" <> message <> "' message."
sh $ dieRed $ "Cmd did not recieve the '" <> message <> "' message.\n"
_ ->
sh
$ printInfo
"Test success: The hello world app executed properly in a \
$ printSuccess
"The hello world app executed properly in a \
\ container and its message was received by `cmd`.\n"
runWaitForMessage :: Text -> StackArgs -> IO ()
runWaitForMessage message a@StackArgs {..} = do
sh $ printError "WARNING: TODO: DEBUG. THIS TEST CURRENTLY FAILS ONCE PER TWO RUNS AND REPORTS BAD EXIT CODES.\n"
runSimpleStackWithCriterion criteria a
die
("Test failure: did not find string '" <> message <> "' in daemon stdout.")
sh $ dieRed ("Did not find string '" <> message <> "' in daemon stdout.\n")
where
criteria :: (Shell (Either Line Line) -> Shell (Either Line Line))
criteria s = s >>= \case
Left out -> case match (has (text "payload")) (lineToText out) of
Left out -> case match (has (text message)) (lineToText out) of
[] -> return $ Left out
_ -> do
printInfo
$ "Test success: Found line containing '"
printSuccess
$ "Found line containing '"
<> message
<> "' in daemon stdout."
<> "' in daemon stdout.\n"
cleanLeftoverProcesses
exit ExitSuccess
Right err -> return $ Right err
......
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