Argotest.hs 5.94 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

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
21
import System.Process hiding (shell)
Valentin Reis's avatar
Valentin Reis committed
22 23
import Data.Text as Text hiding (empty)
import Data.Text.IO as Text
Valentin Reis's avatar
Valentin Reis committed
24 25

data StackArgs = StackArgs
26
  { dargs                :: [Text]        --"Daemon arguments. Properly quote this."
27
  , app                  :: Text        --"Target application call, sh+path valid"
28 29 30 31 32 33 34
  , 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
35 36 37

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

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

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

82 83 84 85
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"
86
  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
87 88
  mapM_ cleanSocket ["/tmp/nrm-downstream-in", "/tmp/nrm-upstream-in"]

89
prepareDaemonShell :: [Text] -> FilePath -> FilePath -> FilePath -> Shell (IO ())
90
prepareDaemonShell dargs daemon_out daemon_err nrm_log = do
Valentin Reis's avatar
Valentin Reis committed
91
  confPath      <- myWhich "argo_nodeos_config"
92
  myWhich "daemon"
Valentin Reis's avatar
Valentin Reis committed
93 94 95 96
  tempDirPath   <- mktempdir "/tmp" "argo-expe"
  let confPath' = tempDirPath </> "argo_nodeos_config"
  cp confPath confPath'
  printInfo $ format ("Copied the configurator to "%fp%"\n") confPath'
97
  printInfo $ format "Trying to sudo chown and chmod argo_nodeos_config\n"
Valentin Reis's avatar
Valentin Reis committed
98 99 100 101 102 103 104 105 106 107
  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"
108 109 110 111 112 113
    ExitFailure n -> do
      printError ("argo_nodeos_config failed with exit code :" <> repr n <> "\n" )
      testfile ".argo_nodeos_config_exit_message" >>= \case
        True -> do printInfo "Contents of .argo_nodeos_config_exit_message: \n"
                   view $ input "./argo_nodeos_config_exit_message"
        False ->  die ("Clean config failed with exit code " <> repr n)
114
  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
115
  export "ARGO_NODEOS_CONFIG" (format fp confPath')
Valentin Reis's avatar
Valentin Reis committed
116 117 118 119 120 121 122 123 124 125 126
  return $ twoWayPrint daemon_out daemon_err $ inprocWithErr "daemon"
          (dargs ++ ["--nrm_log", Text.pack $ encodeString nrm_log])
          empty

twoWayPrint :: FilePath -> FilePath -> Shell (Either Line Line) -> IO ()
twoWayPrint outPath errPath s = sh $ do
    handleOut <- using (writeonly outPath)
    handleErr <- using (writeonly errPath)
    s >>= \case
      Left out  -> liftIO $ Text.hPutStrLn handleOut (lineToText out)
      Right err  -> liftIO $ Text.hPutStrLn handleOut (lineToText err)
127 128 129 130 131 132 133

cmdShell :: FilePath -> Text -> FilePath -> FilePath -> Shell ()
cmdShell manifest app cmd_out cmd_err =
  shell (format ("cmd run -u toto "%fp%"  "%s%" > "%fp%" 2>"%fp) manifest app cmd_out cmd_err) empty >>= \case
  ExitSuccess   -> printInfo "cmd has exited successfuly.\n"
  ExitFailure n -> die ("cmd failed with exit code " <> repr n <>
    " . The application logs are at " <> repr cmd_out <> " " <> repr cmd_err )