test.hs 5.57 KB
Newer Older
Valentin Reis's avatar
Valentin Reis committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
#! /usr/bin/env nix-shell
#! nix-shell default.nix -i runhaskell -A test1

{-# LANGUAGE RecordWildCards
  , LambdaCase
  , OverloadedStrings
  , DataKinds
  , DeriveGeneric
  , FlexibleInstances
  , OverloadedStrings
  , TypeOperators #-}

import Turtle
import Prelude hiding (FilePath)

import Options.Applicative
import Options.Generic
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

printInfo    format = printf ("Info:"%format)
printWarning format = colorShell Yellow . printf ("Warning:"%format)
printError   format = colorShell Red    . printf ("Error:"%format)

colorShell :: Color -> Shell ()-> Shell ()
colorShell color s = setC color *> s *> setC White
  where setC c = liftIO $ setSGR [SetColor Foreground Dull c]

myWhich str = which str >>= \case
  (Just p) -> printInfo ("Found "%fp%" at "%fp%"\n") str p >> return p
  Nothing -> die (format ("Argo `"%fp%"` not in $PATH.") str)

data Args w = Args
  { dargs                :: w ::: Text     <?> "Daemon arguments. Properly quote this."
  , app                  :: w ::: FilePath <?> "Input file, target application script"
  , manifest             :: w ::: FilePath <?> "Input file, manifest."
  , app_out              :: w ::: FilePath <?> "Output file, application stdout"
  , app_err              :: w ::: FilePath <?> "Output file, application stderr"
  , daemon_out           :: w ::: FilePath <?> "Output file, daemon stdout"
  , daemon_err           :: w ::: FilePath <?> "Output file, daemon stderr"
  , log_progress         :: w ::: FilePath <?> "Output file, daemon progress log"
  , log_hardwareprogress :: w ::: FilePath <?> "Output file, daemon hardware progress log"
  , log_power            :: w ::: FilePath <?> "Output file, daemon power log"
  , time_file            :: w ::: FilePath <?> "Output file, application runtime" } deriving (Generic)
instance ParseRecord (Args Wrapped)

removeSocket :: FilePath -> Shell ()
removeSocket socketPath = do
  foundSocket <- (testfile socketPath)
  when foundSocket $ do
    printError ("found stale socket at "%fp%"..") socketPath
    shell (format ("sudo rm -f "%fp) socketPath) empty >>= \case
      ExitSuccess   -> colorShell Green $ printf (" Successfully removed.\n")
      ExitFailure n -> colorShell Red $ die ("Failed to remove stale socket." <> repr n)

cleanLog :: FilePath -> Shell ()
cleanLog logPath = do
  foundSocket <- (testfile logPath)
  when foundSocket $ do
    printWarning ("found stale log at "%fp%".. ") logPath
    shell (format ("sudo rm -f "%fp) logPath) empty >>= \case
      ExitSuccess   -> colorShell Green $  printf ("Successfully removed.\n")
      ExitFailure n -> die ("Failed to remove stale log file." <> repr n)
  printInfo ("Using log file "%fp%"\n") logPath

main :: IO ()
main = sh $ do
  Args{..}      <- unwrapRecord "minimal Argo benchmarking tool"

  --Cleaning
  mapM_ cleanLog [daemon_out, daemon_err, app_out, app_err, time_file,
                  log_progress, log_hardwareprogress, log_power]
  mapM_ removeSocket ["/tmp/nrm-downstream-in", "/tmp/nrm-upstream-in"]

  --Retrieving binaries,setting suid bits and perms
  confPath      <- myWhich "argo_nodeos_config"
  daemonPath    <- myWhich "daemon"
  tempDirPath   <- mktempdir "/tmp" "argo-expe"
  let confPath' = tempDirPath </> "argo_nodeos_config"
  cp confPath confPath'
  printInfo ("Copied the configurator to "%fp%"\n") confPath'
  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 liftIO $ 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 "Running the daemon.\n"
  export "ARGO_NODEOS_CONFIG" (format fp confPath')
  let daemon = inshell (format (fp%" "%s%" --log_hardwareprogress="%fp%" --log_progress="%fp%" --log_power="%fp%" >"%fp%" 2>"%fp)
                          daemonPath dargs log_hardwareprogress log_progress log_power daemon_out daemon_err) empty
  daemonAsync <- fork $ sh $ daemon
  printInfo "Daemon is running.\n"
  let handler = do
                sh $ printInfo "Interrupted. Killing daemon..."
                cancel daemonAsync
                sh $ inshell "pkill daemon" empty
                sh $ colorShell Green $ printf "Killed daemon.\n"
  liftIO $ installHandler keyboardSignal (Catch handler) Nothing

  --Running the app
  printInfo "Launching the application through cmd.\n"
  (_,t) <- time $
    shell (format ("cmd run -u toto "%fp%"  "%fp%" > "%fp%" 2>"%fp) manifest app app_out app_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 app_out <> " " <> repr app_err )
  liftIO $ writeTextFile time_file (repr t)

  --Cleanup
  printInfo "Killing the daemon.\n"
  liftIO $ cancel daemonAsync
  inshell "pkill daemon" empty
  printInfo "Daemon killed.\n"