{-# LANGUAGE LambdaCase , OverloadedStrings , DataKinds , FlexibleInstances , TypeOperators #-} module Argotest where import Data.Default import Turtle import Prelude hiding (FilePath) import System.IO (withFile) import Debug.Trace import Filesystem.Path (()) import Control.Concurrent.Async import System.Console.ANSI import System.Console.ANSI.Types (Color) import System.Posix.Signals data StackArgs = StackArgs { dargs :: Text --"Daemon arguments. Properly quote this." , app :: Text --"Target application call, sh+path valid" , manifest :: FilePath --"Input file, manifest." , cmd_out :: FilePath --"Output file, application stdout" , cmd_err :: FilePath --"Output file, application stderr" , daemon_out :: FilePath --"Output file, daemon stdout" , daemon_err :: FilePath --"Output file, daemon stderr" , nrm_log :: FilePath --"Output file, daemon log" , time_file :: FilePath } --"Output file, application runtime" instance Default StackArgs where def = StackArgs { dargs = "" , app = "echo \"HelloWorld\"" , manifest = "manifests/basic.json" , cmd_out = "cmd_out.log" , cmd_err = "cmd_err.log" , daemon_out = "daemon_out.log" , daemon_err = "daemon_err.log" , nrm_log = "nrm.log" , time_file = "time.log" } colorShell :: Color -> Shell ()-> Shell () colorShell color s = setC color *> s *> setC White where setC c = liftIO $ setSGR [SetColor Foreground Dull c] printInfo :: Text -> Shell () printError :: Text -> Shell () printWarning :: Text -> Shell () printInfo = printf ("Info:"%s) printWarning = colorShell Yellow . printf ("Warning:"%s) printError = colorShell Red . printf ("Error:"%s) 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 sudoRemoveFile :: (Text -> Shell ()) -> Text -> FilePath -> Shell () sudoRemoveFile printer desc filePath = do foundSocket <- testfile filePath when foundSocket $ go False printInfo $ format ("OK: "%s%" "%fp%"\n") desc filePath where go useSudo = do printer $ format ("found stale " %s%" at "%fp%".. ") desc filePath shell (format ((if useSudo then "sudo " else "")%"rm -f "%fp) filePath) empty >>= \case ExitSuccess -> colorShell Green $ printf " Successfully removed.\n" ExitFailure n -> if useSudo then printer $ format ("Failed to remove stale "%s%", even with sudo.") desc else do printer $ format ("Failed to remove stale "%s%". Trying sudo..\n") desc go True cleanSocket = sudoRemoveFile printError "socket" cleanLog = sudoRemoveFile printWarning "log file" cleanLeftovers :: FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> Shell () cleanLeftovers daemon_out daemon_err cmd_out cmd_err time_file nrm_log = do printInfo "Cleaning leftovers..\n" mapM_ cleanLog [daemon_out, daemon_err, cmd_out, cmd_err, time_file, nrm_log] mapM_ cleanSocket ["/tmp/nrm-downstream-in", "/tmp/nrm-upstream-in"] prepareDaemonShell :: Text -> FilePath -> FilePath -> FilePath -> Shell (Shell ()) prepareDaemonShell dargs daemon_out daemon_err nrm_log = do confPath <- myWhich "argo_nodeos_config" daemonPath <- myWhich "daemon" tempDirPath <- mktempdir "/tmp" "argo-expe" let confPath' = tempDirPath "argo_nodeos_config" 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 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 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 >>= \case ExitSuccess -> printInfo "Cleaned the argo config.\n" ExitFailure n -> do printInfo "Contents of argo_nodeos_config_exit_message: \n" view $ cat ["./argo_nodeos_config_exit_message"] die ("Clean config failed with exit code " <> repr n) printInfo $ format ("Running the daemon, main log at "%fp%", stdout at "%fp%", stderr at "%fp%"\n") nrm_log daemon_out daemon_err export "ARGO_NODEOS_CONFIG" (format fp confPath') return $ sh $ inshell (format (fp%" "%s%" --nrm_log="%fp%" >"%fp%" 2>"%fp) daemonPath dargs nrm_log daemon_out daemon_err) empty