Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Valentin Reis
argotest
Commits
fbd84589
Commit
fbd84589
authored
Dec 18, 2018
by
Valentin Reis
Browse files
Cleaning perf-wrapper test, adding warning, help messages.
parent
7e7c66e4
Changes
4
Hide whitespace changes
Inline
Side-by-side
argo/argo.cabal
View file @
fbd84589
...
...
@@ -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
argo/src/Argo/Stack.hs
View file @
fbd84589
...
...
@@ -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
"
s
hell
(
format
(
"sudo chown root:root "
%
fp
)
confPath'
)
empty
>>=
\
case
verboseS
hell
(
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
)
s
hell
(
format
(
"sudo chmod u+sw "
%
fp
)
confPath'
)
empty
>>=
\
case
verboseS
hell
(
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
stoppingCriteri
on
a
@
StackArgs
{
..
}
=
sh
$
do
runSimpleStackWithCriterion
stoppingCriteri
a
a
@
StackArgs
{
..
}
=
sh
$
do
cleanLeftovers
a
daemonShell
<-
prepareDaemonShellWithStoppingCriterion
stoppingCriteri
on
a
daemonShell
<-
prepareDaemonShellWithStoppingCriterion
stoppingCriteri
a
a
liftIO
$
withAsync
daemonShell
$
\
daemon
->
do
kbInstallHandler
$
cancel
daemon
withAsync
(
time
$
sh
$
cmdShell
a
)
$
\
cmd
->
do
...
...
argo/src/Argo/Utils.hs
View file @
fbd84589
...
...
@@ -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
argotk/argotk.hs
View file @
fbd84589
...
...
@@ -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
"p
ayload
"
<$>
parseExtendStackArgs
(
runWaitForMessage
"p
rogress
"
<$>
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 a
rgo-perf-wr
app
er
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
$
print
Info
"
Test success:
The hello world app executed properly in a
\
$
print
Success
"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
print
Info
$
"
Test success:
Found line containing '"
print
Success
$
"Found line containing '"
<>
message
<>
"' in daemon stdout."
<>
"' in daemon stdout.
\n
"
cleanLeftoverProcesses
exit
ExitSuccess
Right
err
->
return
$
Right
err
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment