Argotest.hs 4.92 KB
Newer Older
Valentin Reis's avatar
Valentin Reis committed
1
{-# LANGUAGE
2 3 4 5 6
   LambdaCase
 , OverloadedStrings
 , DataKinds
 , FlexibleInstances
 , TypeOperators #-}
Valentin Reis's avatar
Valentin Reis committed
7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22

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
23
  { dargs                :: Text        --"Daemon arguments. Properly quote this."
24
  , app                  :: Text        --"Target application call, sh+path valid"
25 26 27 28 29 30 31
  , 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"
Valentin Reis's avatar
Valentin Reis committed
32 33 34 35

instance Default StackArgs where
  def = StackArgs
    { dargs = ""
36
    , app = "echo \"HelloWorld\""
Valentin Reis's avatar
Valentin Reis committed
37
    , manifest = "manifests/basic.json"
38 39 40 41
    , cmd_out = "cmd_out.log"
    , cmd_err = "cmd_err.log"
    , daemon_out = "daemon_out.log"
    , daemon_err = "daemon_err.log"
42
    , nrm_log = "nrm.log"
43
    , time_file = "time.log"
Valentin Reis's avatar
Valentin Reis committed
44 45 46 47 48 49 50 51 52
    }

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 ()
53 54 55
printInfo    = printf ("Info:"%s)
printWarning = colorShell Yellow . printf ("Warning:"%s)
printError   = colorShell Red . printf ("Error:"%s)
Valentin Reis's avatar
Valentin Reis committed
56 57 58 59 60 61 62

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
63
  foundSocket <- testfile filePath
Valentin Reis's avatar
Valentin Reis committed
64
  when foundSocket $ go False
65
  printInfo $ format ("OK: "%s%" "%fp%"\n") desc filePath
Valentin Reis's avatar
Valentin Reis committed
66
  where go useSudo = do
67
          printer $ format ("found stale " %s%" at "%fp%".. ") desc filePath
Valentin Reis's avatar
Valentin Reis committed
68
          shell (format ((if useSudo then "sudo " else "")%"rm -f "%fp) filePath) empty >>= \case
69
            ExitSuccess   -> colorShell Green $ printf " Successfully removed.\n"
Valentin Reis's avatar
Valentin Reis committed
70 71 72 73 74 75 76 77 78
            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"

79 80 81 82
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"
83
  mapM_ cleanLog [daemon_out, daemon_err, cmd_out, cmd_err, time_file, nrm_log, ".argo_nodeos_config_exit_message"]
Valentin Reis's avatar
Valentin Reis committed
84 85
  mapM_ cleanSocket ["/tmp/nrm-downstream-in", "/tmp/nrm-upstream-in"]

86 87
prepareDaemonShell :: Text -> FilePath -> FilePath -> FilePath -> Shell (Shell ())
prepareDaemonShell dargs daemon_out daemon_err nrm_log = do
Valentin Reis's avatar
Valentin Reis committed
88 89 90 91 92 93
  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'
94
  printInfo $ format "Trying to sudo chown and chmod argo_nodeos_config\n"
Valentin Reis's avatar
Valentin Reis committed
95 96 97 98 99 100 101 102 103 104
  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"
105
    ExitFailure n -> do printInfo "Contents of .argo_nodeos_config_exit_message: \n"
Valentin Reis's avatar
Valentin Reis committed
106 107
                        view $ cat  ["./argo_nodeos_config_exit_message"]
                        die ("Clean config failed with exit code " <> repr n)
108
  printInfo $ format ("Running the daemon, main log at "%fp%", stdout at "%fp%", stderr at "%fp%"\n") nrm_log daemon_out daemon_err
Valentin Reis's avatar
Valentin Reis committed
109
  export "ARGO_NODEOS_CONFIG" (format fp confPath')
110
  return $ sh $ inshell (format (fp%" "%s%" --nrm_log="%fp%" >"%fp%" 2>"%fp) daemonPath dargs nrm_log daemon_out daemon_err) empty