Commit b63572ee authored by Valentin Reis's avatar Valentin Reis
Browse files

refactor to explicit returns for success/failure, adds verbosity, test

target fixes.
parent 9d5e473f
Pipeline #7299 passed with stages
in 35 seconds
......@@ -53,7 +53,7 @@ data NixStaticInOut = Both Text
| SimpleTarget Text
| StringArg Text
| Target Text deriving (Eq)
data NixCommand = NixBuild | NixShell | NixTest
data NixCommand = NixBuild | NixShell | NixTest deriving (Eq)
instance Default ArgsCommon where
def = ArgsCommon
......
......@@ -19,8 +19,8 @@ where
import Args
import Protolude
import qualified Data.Text as T
( lines
, isInfixOf
( isInfixOf
, lines
)
import Options.Applicative
import System.Console.ANSI
......@@ -30,7 +30,7 @@ import qualified System.Process.Typed as P
( runProcess
, runProcess_
, setEnv
, readProcessStdout_
, readProcessStdout
, proc
, shell
)
......@@ -51,11 +51,11 @@ checkFsAttributes :: Verbosity -> FilePath -> IO ()
checkFsAttributes verbosity workingDirectory = do
putVerbose verbosity "Checking filesystem attributes on /tmp"
findmnt <-
P.readProcessStdout_
$ P.shell
$ "findmnt -T "
<> workingDirectory
<> " -o OPTIONS"
P.readProcessStdout
(P.shell $ "findmnt -T " <> workingDirectory <> " -o OPTIONS")
>>= \case
(ExitSuccess , t) -> return t
(ExitFailure _, _) -> die "failing running findmnt on /tmp"
when (T.isInfixOf "nosuid" $ toS findmnt) $ die
( "The output directory, "
<> toS workingDirectory
......@@ -149,22 +149,17 @@ shellVerbose verbosity s = do
putVerbose verbosity s
P.runProcess (P.shell $ toS s)
readProcessVerbose :: Verbosity -> Text -> [Text] -> [(Text, Text)] -> IO Text
readProcessVerbose
:: Verbosity -> Text -> [Text] -> [(Text, Text)] -> IO (ExitCode, Text)
readProcessVerbose verbosity name arguments envVars = do
putVerbose verbosity $ name <> " " <> mconcat (intersperse " " arguments)
head
. T.lines
. toS
<$> P.readProcessStdout_
P.readProcessStdout
( P.setEnv (fmap (\(x, y) -> (toS x, toS y)) envVars)
$ P.proc (toS name) (fmap toS arguments)
)
>>= \case
Just r -> return r
Nothing -> return ""
runProcessVerbose :: Verbosity -> Text -> [Text] -> [(Text, Text)] -> IO ()
runProcessVerbose a b c d = void $ readProcessVerbose a b c d
(exitcode, bs) ->
return (exitcode, fromMaybe "" (head $ T.lines $ toS bs))
setupSystem :: Text -> ArgsCommon -> IO ([(Text, Text)], Text)
setupSystem target sa = do
......@@ -177,11 +172,15 @@ setupSystem target sa = do
ExitSuccess -> putText "removed ./nixtmpdir"
ExitFailure n -> die ("Failed to remove ./nixtmpdir " <> show n)
varXDG_CACHE_HOME <- rpVerbose "mktemp"
["-d", "/tmp/deletable-nix-cache-XXXX"]
[]
varXDG_CACHE_HOME <-
rpVerbose "mktemp" ["-d", "/tmp/deletable-nix-cache-XXXX"] [] >>= \case
(ExitSuccess , t) -> return t
(ExitFailure _, _) -> die "failed mktemp for XDG_CACHE_HOME"
varTMPDIR <- rpVerbose "mktemp" ["-d", "/tmp/tmpdir-XXXX"] [] >>= \case
(ExitSuccess , t) -> return t
(ExitFailure _, _) -> die "failed mktemp for TMPDIR"
varTMPDIR <- rpVerbose "mktemp" ["-d", "/tmp/tmpdir-XXXX"] []
sVerbose ("chmod 777 " <> varTMPDIR) >>= \case
ExitFailure _ -> die "chmod failed for tmpdir"
ExitSuccess -> return ()
......@@ -211,10 +210,13 @@ setupSystem target sa = do
setupNodeOs env = do
cleanSockets $ verbosity sa
checkFsAttributes (verbosity sa) "/tmp"
nodeos_config <- rpVerbose
"nix-build"
nodeos_config <-
rpVerbose "nix-build"
(fmap toS (nixArguments "containers" sa) ++ ["--no-out-link"])
env
>>= \case
(ExitSuccess , t) -> return t
(ExitFailure _, _) -> die "failed building containers"
sVerbose "sudo rm -rf /tmp/argo_nodeos_config" >>= \case
ExitSuccess -> return ()
ExitFailure n ->
......@@ -241,8 +243,8 @@ setupSystem target sa = do
ExitSuccess -> return ()
ExitFailure n ->
die ("NodeOS config cleaning failed with exit code" <> show n)
sVerbose = shellVerbose $ verbosity sa
rpVerbose = readProcessVerbose $ verbosity sa
sVerbose = shellVerbose (verbosity sa)
rpVerbose = readProcessVerbose (verbosity sa)
nixArguments :: Text -> ArgsCommon -> [Text]
nixArguments target ArgsCommon {..} =
......@@ -258,43 +260,47 @@ nixArguments target ArgsCommon {..} =
wrap :: NixCommand -> Text -> ArgsCommon -> IO ()
wrap nixCommand target sa@ArgsCommon {..} = do
when (verbosity == Verbose) $ print sa
(envVars, tmpDir) <- setupSystem target sa
(envVars, tmpDir) <- setupSystem
(if nixCommand == NixTest then "testGeneric" else target)
sa
case nixCommand of
NixShell ->
executeFile (toS nixc) True (fmap toS arglist) (Just $ evC envVars)
NixTest
-> P.runProcess
(P.setEnv (evC envVars) (P.proc (toS nixc) $ fmap toS arglistTest))
>>= \case
ExitSuccess -> copySuccess "/tmp/papa"
ExitFailure _ -> copyFailure (toS tmpDir) >> die "build failed."
NixBuild ->
P.runProcess
(P.setEnv (evC envVars) (P.proc (toS nixc) $ fmap toS arglist))
>>= \case
ExitSuccess -> copySuccess "/tmp/papa"
ExitFailure _ -> copyFailure (toS tmpDir) >> die "build failed."
NixTest -> rpv (toS nixc) (fmap toS arglistTest) envVars >>= \case
(ExitSuccess , _) -> copySuccess "/tmp/papa"
(ExitFailure _, _) -> copyFailure (toS tmpDir) >> die "build failed."
NixBuild -> rpv (toS nixc) (fmap toS arglist) envVars >>= \case
(ExitSuccess , _) -> copySuccess "/tmp/papa"
(ExitFailure _, _) -> copyFailure (toS tmpDir) >> die "build failed."
where
evC = fmap (\(x, y) -> (toS x, toS y))
copySuccess source = do
runProcessVerbose verbosity
"cp"
["--no-preserve=mode", "-Hr", source, "./result"]
[]
runProcessVerbose verbosity "find" ["./result", "-type", "l", "-delete"] []
runProcessVerbose verbosity "chmod" ["-R", "+w", "./result"] []
rpv "cp" ["--no-preserve=mode", "-Hr", source, "./result"] [] >>= \case
(ExitFailure _, _) -> die "failed copying back the result from the store"
(ExitSuccess , _) -> return ()
rpv "find" ["./result", "-type", "l", "-delete"] [] >>= \case
(ExitFailure _, _) -> die "failed deleting links"
(ExitSuccess , _) -> return ()
rpv "chmod" ["-R", "+w", "./result"] [] >>= \case
(ExitFailure _, _) -> die "failed changing the mode of the result"
(ExitSuccess , _) -> return ()
copyFailure source = do
runProcessVerbose verbosity
"cp"
["--no-preserve=mode", "-r", source, "./nixtmpdir"]
[]
runProcessVerbose verbosity "chmod" ["-R", "+w", "./nixtmpdir"] []
rpv "cp" ["--no-preserve=mode", "-r", source, "./nixtmpdir"] [] >>= \case
(ExitFailure _, _) -> die "failed copying the failed build dir."
(ExitSuccess , _) -> return ()
rpv "chmod" ["-R", "+w", "./nixtmpdir"] [] >>= \case
(ExitFailure _, _) -> die "failed changing perms on the failure dir."
(ExitSuccess , _) -> return ()
nixc = toCommand nixCommand
arglist = nixArguments target sa ++ extraBuildArgs
rpv = readProcessVerbose verbosity
arglist = nixArguments target sa ++ extraBuildArgs
arglistTest =
nixArguments "testGeneric" sa ++ ["--argstr", "genericTestName", target]
nixArguments "testGeneric" sa
++ ["--argstr", "genericTestName", target]
++ extraBuildArgs
extraBuildArgs =
["--allow-new-privileges", "-K", "--option", "build-use-sandbox"]
......
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