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