git.iko.soy/distributed-process
on master help sign in
Split into a generic main and a specific driver
fb36c9bEdsko de Vries
distributed-process-azure/distributed-process-azure.cabal+6−10
compare with master
unifiedsplit
@@ -27,8 +27,11 @@ Library
27 pureMD5 >= 2.1 && < 2.2,
27 pureMD5 >= 2.1 && < 2.2,
28 bytestring >= 0.9 && < 0.11,
28 bytestring >= 0.9 && < 0.11,
29 distributed-process >= 0.2 && < 0.3,
29 distributed-process >= 0.2 && < 0.3,
30− binary >= 0.5 && < 0.6
30+ binary >= 0.5 && < 0.6,
31+ network-transport-tcp >= 0.2 && < 0.3,
32+ optparse-applicative >= 0.2 && < 0.4
31− Exposed-modules: Control.Distributed.Process.Backend.Azure
33+ Exposed-modules: Control.Distributed.Process.Backend.Azure,
34+ Control.Distributed.Process.Backend.Azure.GenericMain
32 Extensions: ViewPatterns
35 Extensions: ViewPatterns
33 ghc-options: -Wall
36 ghc-options: -Wall
34 HS-Source-Dirs: src
37 HS-Source-Dirs: src
@@ -36,13 +39,6 @@ Library
36Executable cloud-haskell-azure
39Executable cloud-haskell-azure
37 Main-Is: src/Control/Distributed/Process/Backend/Azure/CommandLine.hs
40 Main-Is: src/Control/Distributed/Process/Backend/Azure/CommandLine.hs
38 Build-Depends: base >= 4.4 && < 5,
41 Build-Depends: base >= 4.4 && < 5,
39− utf8-string >= 0.3 && < 0.4,
40− libssh2 >= 0.2 && < 0.3,
41− filepath >= 1.3 && < 1.4,
42 distributed-process-azure >= 0.1 && < 0.2,
42 distributed-process-azure >= 0.1 && < 0.2,
43− optparse-applicative >= 0.2 && < 0.4,
44 distributed-process >= 0.2 && < 0.3,
43 distributed-process >= 0.2 && < 0.3,
45− transformers >= 0.3 && < 0.4,
44+ transformers >= 0.3 && < 0.4
46− network-transport-tcp >= 0.2 && < 0.3,
47− binary >= 0.5 && < 0.6,
48− bytestring >= 0.9 && < 0.11
distributed-process-azure/src/Control/Distributed/Process/Backend/Azure.hs+4−5
@@ -15,7 +15,8 @@ import System.Environment.Executable (getExecutablePath)
15import System.Posix.Types (Fd)
15import System.Posix.Types (Fd)
16import Data.Binary (encode)
16import Data.Binary (encode)
17import Data.Digest.Pure.MD5 (md5, MD5Digest)
17import Data.Digest.Pure.MD5 (md5, MD5Digest)
18−import qualified Data.ByteString.Lazy as BSL (readFile, length)
18+import qualified Data.ByteString.Lazy as BSL (readFile)
19+import qualified Data.ByteString.Lazy.Char8 as BSLC (putStr)
19import Control.Applicative ((<$>))
20import Control.Applicative ((<$>))
20import Control.Monad (void)
21import Control.Monad (void)
21import Control.Exception (catches, Handler(Handler))
22import Control.Exception (catches, Handler(Handler))
@@ -35,7 +36,6 @@ import qualified Network.Azure.ServiceManagement as Azure
35-- SSH
36-- SSH
36import qualified Network.SSH.Client.LibSSH2 as SSH
37import qualified Network.SSH.Client.LibSSH2 as SSH
37 ( withSSH2
38 ( withSSH2
38− , execCommands
39 , scpSendFile
39 , scpSendFile
40 , withChannel
40 , withChannel
41 , Session
41 , Session
@@ -138,13 +138,12 @@ apiRunOnVM params vm port proc =
138 ++ " --host " ++ vmIpAddress vm
138 ++ " --host " ++ vmIpAddress vm
139 ++ " --port " ++ port
139 ++ " --port " ++ port
140 ++ " 2>&1"
140 ++ " 2>&1"
141− putStrLn $ "Executing " ++ show exe
142− r <- SSH.withChannel (SSH.openChannelSession s) id fd s $ \ch -> do
141+ (_, r) <- SSH.withChannel (SSH.openChannelSession s) id fd s $ \ch -> do
143 SSH.retryIfNeeded fd s $ SSH.channelExecute ch exe
142 SSH.retryIfNeeded fd s $ SSH.channelExecute ch exe
144 SSHBS.writeChannel fd ch (encode proc)
143 SSHBS.writeChannel fd ch (encode proc)
145 SSH.channelSendEOF ch
144 SSH.channelSendEOF ch
146 SSHBS.readAllChannel fd ch
145 SSHBS.readAllChannel fd ch
147− print r
146+ BSLC.putStr r
148
147
149-- | Check the MD5 hash of the executable on the remote machine
148-- | Check the MD5 hash of the executable on the remote machine
150apiCheckMD5 :: AzureParameters -> VirtualMachine -> IO Bool
149apiCheckMD5 :: AzureParameters -> VirtualMachine -> IO Bool
distributed-process-azure/src/Control/Distributed/Process/Backend/Azure/CommandLine.hs+7−288
@@ -1,297 +1,16 @@
1{-# LANGUAGE TemplateHaskell #-}
1{-# LANGUAGE TemplateHaskell #-}
2−import Prelude hiding (catch)
2+
3−import System.Environment (getArgs)
4−import System.Exit (exitSuccess, exitFailure)
5−import System.IO
6− ( hFlush
7− , stdout
8− , stdin
9− , hSetBinaryMode
10− )
11−import Data.Binary (decode)
12−import qualified Data.ByteString.Lazy as BSL (ByteString, length, getContents)
13−import Control.Monad (unless, forM, forM_, join)
14import Control.Monad.IO.Class (liftIO)
3import Control.Monad.IO.Class (liftIO)
15−import Control.Arrow (returnA)
16−import Control.Exception (throwIO, SomeException)
17−import Control.Distributed.Process.Backend.Azure
4+import Control.Distributed.Process (Process)
18− ( AzureParameters(azureSshUserName)
19− , defaultAzureParameters
20− , initializeBackend
21− , cloudServices
22− , CloudService(cloudServiceName, cloudServiceVMs)
23− , VirtualMachine(vmName)
24− , Backend(copyToVM, checkMD5, runOnVM)
25− )
26−import qualified Network.SSH.Client.LibSSH2.Foreign as SSH
27− ( initialize
28− , exit
29− )
30−import Control.Applicative ((<$>), (<*>), (<|>), pure)
31−import Options.Applicative
32− ( Parser
33− , strOption
34− , long
35− , (&)
36− , metavar
37− , help
38− , subparser
39− , command
40− , info
41− , progDesc
42− , execParser
43− , helper
44− , fullDesc
45− , header
46− , switch
47− )
48−import Options.Applicative.Arrows (runA, asA)
49−import Control.Distributed.Process
50− ( getSelfPid
51− , RemoteTable
52− , Closure
53− , Process
54− , unClosure
55− , catch
56− )
57import Control.Distributed.Process.Closure (remotable, mkClosure)
5import Control.Distributed.Process.Closure (remotable, mkClosure)
58−import Control.Distributed.Process.Node (newLocalNode, runProcess, initRemoteTable)
6+import Control.Distributed.Process.Backend.Azure.GenericMain (genericMain)
59−import Network.Transport.TCP (createTransport, defaultTCPParameters)
60
7
61cprint :: String -> Process ()
8cprint :: String -> Process ()
62cprint = liftIO . putStrLn
9cprint = liftIO . putStrLn
63
10
64remotable ['cprint]
11remotable ['cprint]
65
12
66−--------------------------------------------------------------------------------
13+main = genericMain __remoteTable $ \cmd ->
67−-- Main --
68−--------------------------------------------------------------------------------
69−
70−main :: IO ()
71−main = do
72− _ <- SSH.initialize True
73− cmd <- execParser opts
74− case cmd of
14+ case cmd of
75− List {} -> do
76− params <- azureParameters (azureOptions cmd) Nothing
77− backend <- initializeBackend params
78− css <- cloudServices backend
79− mapM_ print css
80− CopyTo {} -> do
81− params <- azureParameters (azureOptions cmd) (Just (sshOptions cmd))
82− backend <- initializeBackend params
83− css <- cloudServices backend
84− forM_ (findTarget (target cmd) css) $ \vm -> do
85− putStr (vmName vm ++ ": ") >> hFlush stdout
86− copyToVM backend vm
87− putStrLn "Done"
88− CheckMD5 {} -> do
89− params <- azureParameters (azureOptions cmd) (Just (sshOptions cmd))
90− backend <- initializeBackend params
91− css <- cloudServices backend
92− matches <- forM (findTarget (target cmd) css) $ \vm -> do
93− unless (status cmd) $ putStr (vmName vm ++ ": ") >> hFlush stdout
94− match <- checkMD5 backend vm
95− unless (status cmd) $ putStrLn $ if match then "OK" else "FAILED"
96− return match
97− if and matches
98− then exitSuccess
99− else exitFailure
100− RunOn {} -> do
101− params <- azureParameters (azureOptions cmd) (Just (sshOptions cmd))
102− backend <- initializeBackend params
103− css <- cloudServices backend
104− forM_ (findTarget (target cmd) css) $ \vm -> do
105− putStr (vmName vm ++ ": ") >> hFlush stdout
106− runOnVM backend vm (port cmd) ($(mkClosure 'cprint) "Hello world")
15+ "hello" -> return $ $(mkClosure 'cprint) "Hi world!"
107− OnVmCommand (vmCmd@OnVmRun {}) -> do
16+ _ -> error "unknown command"
108− let rtable = __remoteTable initRemoteTable
109− onVmRun rtable (onVmIP vmCmd) (onVmPort vmCmd)
110− SSH.exit
111− where
112− opts = info (helper <*> commandParser)
113− ( fullDesc
114− & header "Cloud Haskell backend for Azure"
115− )
116−
117−findTarget :: Target -> [CloudService] -> [VirtualMachine]
118−findTarget (CloudService cs) css =
119− concatMap cloudServiceVMs . filter ((== cs) . cloudServiceName) $ css
120−findTarget (VirtualMachine virtualMachine) css =
121− [ vm | vm <- concatMap cloudServiceVMs css
122− , vmName vm == virtualMachine
123− ]
124−
125−azureParameters :: AzureOptions -> Maybe SshOptions -> IO AzureParameters
126−azureParameters opts Nothing =
127− defaultAzureParameters (subscriptionId opts)
128− (pathToCert opts)
129− (pathToKey opts)
130−azureParameters opts (Just sshOpts) = do
131− params <- defaultAzureParameters (subscriptionId opts)
132− (pathToCert opts)
133− (pathToKey opts)
134− return params {
135− azureSshUserName = remoteUser sshOpts
136− }
137−
138−onVmRun :: RemoteTable -> String -> String -> IO ()
139−onVmRun rtable host port = do
140− hSetBinaryMode stdin True
141− proc <- BSL.getContents :: IO BSL.ByteString
142− mTransport <- createTransport host port defaultTCPParameters
143− case mTransport of
144− Left err -> throwIO err
145− Right transport -> do
146− node <- newLocalNode transport rtable
147− runProcess node $ join . unClosure . decode $ proc
148−
149−--------------------------------------------------------------------------------
150−-- Command line options --
151−--------------------------------------------------------------------------------
152−
153−data AzureOptions = AzureOptions {
154− subscriptionId :: String
155− , pathToCert :: FilePath
156− , pathToKey :: FilePath
157− }
158− deriving Show
159−
160−data SshOptions = SshOptions {
161− remoteUser :: String
162− }
163− deriving Show
164−
165−data Target =
166− VirtualMachine String
167− | CloudService String
168− deriving Show
169−
170−data Command =
171− List {
172− azureOptions :: AzureOptions
173− }
174− | CopyTo {
175− azureOptions :: AzureOptions
176− , sshOptions :: SshOptions
177− , target :: Target
178− }
179− | CheckMD5 {
180− azureOptions :: AzureOptions
181− , sshOptions :: SshOptions
182− , target :: Target
183− , status :: Bool
184− }
185− | RunOn {
186− azureOptions :: AzureOptions
187− , sshOptions :: SshOptions
188− , target :: Target
189− , port :: String
190− }
191− | OnVmCommand {
192− onVmCommand :: OnVmCommand
193− }
194− deriving Show
195−
196−data OnVmCommand =
197− OnVmRun {
198− onVmIP :: String
199− , onVmPort :: String
200− }
201− deriving Show
202−
203−azureOptionsParser :: Parser AzureOptions
204−azureOptionsParser = AzureOptions
205− <$> strOption ( long "subscription-id"
206− & metavar "SID"
207− & help "Azure subscription ID"
208− )
209− <*> strOption ( long "certificate"
210− & metavar "CERT"
211− & help "X509 certificate"
212− )
213− <*> strOption ( long "private"
214− & metavar "PRI"
215− & help "Private key in PKCS#1 format"
216− )
217−
218−sshOptionsParser :: Parser SshOptions
219−sshOptionsParser = SshOptions
220− <$> strOption ( long "user"
221− & metavar "USER"
222− & help "Remove SSH username"
223− )
224−
225−listParser :: Parser Command
226−listParser = List <$> azureOptionsParser
227−
228−copyToParser :: Parser Command
229−copyToParser = CopyTo
230− <$> azureOptionsParser
231− <*> sshOptionsParser
232− <*> targetParser
233−
234−targetParser :: Parser Target
235−targetParser =
236− ( VirtualMachine <$> strOption ( long "virtual-machine"
237− & metavar "VM"
238− & help "Virtual machine name"
239− )
240− )
241− <|>
242− ( CloudService <$> strOption ( long "cloud-service"
243− & metavar "CS"
244− & help "Cloud service name"
245− )
246− )
247−
248−checkMD5Parser :: Parser Command
249−checkMD5Parser = CheckMD5
250− <$> azureOptionsParser
251− <*> sshOptionsParser
252− <*> targetParser
253− <*> switch ( long "status"
254− & help "Don't output anything, status code shows success"
255− )
256−
257−commandParser :: Parser Command
258−commandParser = subparser
259− ( command "list" (info listParser
260− (progDesc "List Azure cloud services"))
261− & command "install" (info copyToParser
262− (progDesc "Install the executable"))
263− & command "md5" (info checkMD5Parser
264− (progDesc "Check if the remote and local MD5 hash match"))
265− & command "run" (info runOnParser
266− (progDesc "Run the executable"))
267− & command "onvm" (info onVmCommandParser
268− (progDesc "Commands used when running ON the vm (usually used internally only)"))
269− )
270−
271−runOnParser :: Parser Command
272−runOnParser = RunOn
273− <$> azureOptionsParser
274− <*> sshOptionsParser
275− <*> targetParser
276− <*> strOption ( long "port"
277− & metavar "PORT"
278− & help "Port number of the CH instance"
279− )
280−
281−onVmRunParser :: Parser OnVmCommand
282−onVmRunParser = OnVmRun
283− <$> strOption ( long "host"
284− & metavar "IP"
285− & help "IP address"
286− )
287− <*> strOption ( long "port"
288− & metavar "PORT"
289− & help "port number"
290− )
291−
292−onVmCommandParser :: Parser Command
293−onVmCommandParser = OnVmCommand <$> subparser
294− ( command "run" (info onVmRunParser
295− (progDesc "Run the executable"))
296− )
297−
distributed-process-azure/src/Control/Distributed/Process/Backend/Azure/GenericMain.hsnew file+299
@@ -0,0 +1,299 @@
1+-- | Generic main
2+module Control.Distributed.Process.Backend.Azure.GenericMain (genericMain) where
3+
4+import Prelude hiding (catch)
5+import System.Exit (exitSuccess, exitFailure)
6+import System.IO
7+ ( hFlush
8+ , stdout
9+ , stdin
10+ , hSetBinaryMode
11+ )
12+import Data.Binary (decode)
13+import qualified Data.ByteString.Lazy as BSL (ByteString, getContents)
14+import Control.Monad (unless, forM, forM_, join)
15+import Control.Exception (throwIO)
16+import Control.Distributed.Process.Backend.Azure
17+ ( AzureParameters(azureSshUserName)
18+ , defaultAzureParameters
19+ , initializeBackend
20+ , cloudServices
21+ , CloudService(cloudServiceName, cloudServiceVMs)
22+ , VirtualMachine(vmName)
23+ , Backend(copyToVM, checkMD5, runOnVM)
24+ )
25+import qualified Network.SSH.Client.LibSSH2.Foreign as SSH
26+ ( initialize
27+ , exit
28+ )
29+import Control.Applicative ((<$>), (<*>), (<|>))
30+import Options.Applicative
31+ ( Parser
32+ , strOption
33+ , long
34+ , (&)
35+ , metavar
36+ , help
37+ , subparser
38+ , command
39+ , info
40+ , progDesc
41+ , execParser
42+ , helper
43+ , fullDesc
44+ , header
45+ , switch
46+ )
47+import Control.Distributed.Process
48+ ( RemoteTable
49+ , Closure
50+ , Process
51+ , unClosure
52+ )
53+import Control.Distributed.Process.Node (newLocalNode, runProcess, initRemoteTable)
54+import Network.Transport.TCP (createTransport, defaultTCPParameters)
55+
56+--------------------------------------------------------------------------------
57+-- Main --
58+--------------------------------------------------------------------------------
59+
60+genericMain :: (RemoteTable -> RemoteTable) -- ^ Standard CH remote table
61+ -> (String -> IO (Closure (Process ()))) -- ^ Closures to support in 'run'
62+ -> IO ()
63+genericMain remoteTable cmds = do
64+ _ <- SSH.initialize True
65+ cmd <- execParser opts
66+ case cmd of
67+ List {} -> do
68+ params <- azureParameters (azureOptions cmd) Nothing
69+ backend <- initializeBackend params
70+ css <- cloudServices backend
71+ mapM_ print css
72+ CopyTo {} -> do
73+ params <- azureParameters (azureOptions cmd) (Just (sshOptions cmd))
74+ backend <- initializeBackend params
75+ css <- cloudServices backend
76+ forM_ (findTarget (target cmd) css) $ \vm -> do
77+ putStr (vmName vm ++ ": ") >> hFlush stdout
78+ copyToVM backend vm
79+ putStrLn "Done"
80+ CheckMD5 {} -> do
81+ params <- azureParameters (azureOptions cmd) (Just (sshOptions cmd))
82+ backend <- initializeBackend params
83+ css <- cloudServices backend
84+ matches <- forM (findTarget (target cmd) css) $ \vm -> do
85+ unless (status cmd) $ putStr (vmName vm ++ ": ") >> hFlush stdout
86+ match <- checkMD5 backend vm
87+ unless (status cmd) $ putStrLn $ if match then "OK" else "FAILED"
88+ return match
89+ if and matches
90+ then exitSuccess
91+ else exitFailure
92+ RunOn {} -> do
93+ closure <- cmds (closureId cmd)
94+ params <- azureParameters (azureOptions cmd) (Just (sshOptions cmd))
95+ backend <- initializeBackend params
96+ css <- cloudServices backend
97+ forM_ (findTarget (target cmd) css) $ \vm -> do
98+ putStr (vmName vm ++ ": ") >> hFlush stdout
99+ runOnVM backend vm (remotePort cmd) closure
100+ OnVmCommand (vmCmd@OnVmRun {}) -> do
101+ onVmRun (remoteTable initRemoteTable) (onVmIP vmCmd) (onVmPort vmCmd)
102+ SSH.exit
103+ where
104+ opts = info (helper <*> commandParser)
105+ ( fullDesc
106+ & header "Cloud Haskell backend for Azure"
107+ )
108+
109+findTarget :: Target -> [CloudService] -> [VirtualMachine]
110+findTarget (CloudService cs) css =
111+ concatMap cloudServiceVMs . filter ((== cs) . cloudServiceName) $ css
112+findTarget (VirtualMachine virtualMachine) css =
113+ [ vm | vm <- concatMap cloudServiceVMs css
114+ , vmName vm == virtualMachine
115+ ]
116+
117+azureParameters :: AzureOptions -> Maybe SshOptions -> IO AzureParameters
118+azureParameters opts Nothing =
119+ defaultAzureParameters (subscriptionId opts)
120+ (pathToCert opts)
121+ (pathToKey opts)
122+azureParameters opts (Just sshOpts) = do
123+ params <- defaultAzureParameters (subscriptionId opts)
124+ (pathToCert opts)
125+ (pathToKey opts)
126+ return params {
127+ azureSshUserName = remoteUser sshOpts
128+ }
129+
130+onVmRun :: RemoteTable -> String -> String -> IO ()
131+onVmRun rtable host port = do
132+ hSetBinaryMode stdin True
133+ proc <- BSL.getContents :: IO BSL.ByteString
134+ mTransport <- createTransport host port defaultTCPParameters
135+ case mTransport of
136+ Left err -> throwIO err
137+ Right transport -> do
138+ node <- newLocalNode transport rtable
139+ runProcess node $ join . unClosure . decode $ proc
140+
141+--------------------------------------------------------------------------------
142+-- Command line options --
143+--------------------------------------------------------------------------------
144+
145+data AzureOptions = AzureOptions {
146+ subscriptionId :: String
147+ , pathToCert :: FilePath
148+ , pathToKey :: FilePath
149+ }
150+ deriving Show
151+
152+data SshOptions = SshOptions {
153+ remoteUser :: String
154+ }
155+ deriving Show
156+
157+data Target =
158+ VirtualMachine String
159+ | CloudService String
160+ deriving Show
161+
162+data Command =
163+ List {
164+ azureOptions :: AzureOptions
165+ }
166+ | CopyTo {
167+ azureOptions :: AzureOptions
168+ , sshOptions :: SshOptions
169+ , target :: Target
170+ }
171+ | CheckMD5 {
172+ azureOptions :: AzureOptions
173+ , sshOptions :: SshOptions
174+ , target :: Target
175+ , status :: Bool
176+ }
177+ | RunOn {
178+ azureOptions :: AzureOptions
179+ , sshOptions :: SshOptions
180+ , target :: Target
181+ , remotePort :: String
182+ , closureId :: String
183+ , background :: Bool
184+ }
185+ | OnVmCommand {
186+ onVmCommand :: OnVmCommand
187+ }
188+ deriving Show
189+
190+data OnVmCommand =
191+ OnVmRun {
192+ onVmIP :: String
193+ , onVmPort :: String
194+ }
195+ deriving Show
196+
197+azureOptionsParser :: Parser AzureOptions
198+azureOptionsParser = AzureOptions
199+ <$> strOption ( long "subscription-id"
200+ & metavar "SID"
201+ & help "Azure subscription ID"
202+ )
203+ <*> strOption ( long "certificate"
204+ & metavar "CERT"
205+ & help "X509 certificate"
206+ )
207+ <*> strOption ( long "private"
208+ & metavar "PRI"
209+ & help "Private key in PKCS#1 format"
210+ )
211+
212+sshOptionsParser :: Parser SshOptions
213+sshOptionsParser = SshOptions
214+ <$> strOption ( long "user"
215+ & metavar "USER"
216+ & help "Remove SSH username"
217+ )
218+
219+listParser :: Parser Command
220+listParser = List <$> azureOptionsParser
221+
222+copyToParser :: Parser Command
223+copyToParser = CopyTo
224+ <$> azureOptionsParser
225+ <*> sshOptionsParser
226+ <*> targetParser
227+
228+targetParser :: Parser Target
229+targetParser =
230+ ( VirtualMachine <$> strOption ( long "virtual-machine"
231+ & metavar "VM"
232+ & help "Virtual machine name"
233+ )
234+ )
235+ <|>
236+ ( CloudService <$> strOption ( long "cloud-service"
237+ & metavar "CS"
238+ & help "Cloud service name"
239+ )
240+ )
241+
242+checkMD5Parser :: Parser Command
243+checkMD5Parser = CheckMD5
244+ <$> azureOptionsParser
245+ <*> sshOptionsParser
246+ <*> targetParser
247+ <*> switch ( long "status"
248+ & help "Don't output anything, status code shows success"
249+ )
250+
251+commandParser :: Parser Command
252+commandParser = subparser
253+ ( command "list" (info listParser
254+ (progDesc "List Azure cloud services"))
255+ & command "install" (info copyToParser
256+ (progDesc "Install the executable"))
257+ & command "md5" (info checkMD5Parser
258+ (progDesc "Check if the remote and local MD5 hash match"))
259+ & command "run" (info runOnParser
260+ (progDesc "Run the executable"))
261+ & command "onvm" (info onVmCommandParser
262+ (progDesc "Commands used when running ON the vm (usually used internally only)"))
263+ )
264+
265+runOnParser :: Parser Command
266+runOnParser = RunOn
267+ <$> azureOptionsParser
268+ <*> sshOptionsParser
269+ <*> targetParser
270+ <*> strOption ( long "port"
271+ & metavar "PORT"
272+ & help "Port number of the CH instance"
273+ )
274+ <*> strOption ( long "closure"
275+ & metavar "PROC"
276+ & help "Process to run on the CH instance"
277+ )
278+ <*> switch ( long "background"
279+ & help "Run the process in the background"
280+ )
281+
282+onVmRunParser :: Parser OnVmCommand
283+onVmRunParser = OnVmRun
284+ <$> strOption ( long "host"
285+ & metavar "IP"
286+ & help "IP address"
287+ )
288+ <*> strOption ( long "port"
289+ & metavar "PORT"
290+ & help "port number"
291+ )
292+
293+onVmCommandParser :: Parser Command
294+onVmCommandParser = OnVmCommand <$> subparser
295+ ( command "run" (info onVmRunParser
296+ (progDesc "Run the executable"))
297+ )
298+
299+