git.iko.soy/distributed-process
on master help sign in
Start CH node for onvm run

We pass the wrong IP address at the moment; we need to figure out how to find the right one

commit06237a3e8cdc144ff4105cea525b86e26c1805fc authorEdsko de Vries <edsko@well-typed.com> dateTue 31 Jul 2012, 17:35 (14 years ago) parentbf8d0bb
3 files changed+44−9
compare with master
unifiedsplit
distributed-process-azure/distributed-process-azure.cabal+4−1 distributed-process-azure/src/Control/Distributed/Process/Backend/Azure.hs+7−5 distributed-process-azure/src/Control/Distributed/Process/Backend/Azure/CommandLine.hs+33−3
distributed-process-azure/distributed-process-azure.cabal+4−1
@@ -38,4 +38,7 @@ Executable cloud-haskell-azure
3838 libssh2 >= 0.2 && < 0.3,
3939 filepath >= 1.3 && < 1.4,
4040 distributed-process-azure >= 0.1 && < 0.2,
41− optparse-applicative >= 0.2 && < 0.4
41+ optparse-applicative >= 0.2 && < 0.4,
42+ distributed-process >= 0.2 && < 0.3,
43+ transformers >= 0.3 && < 0.4,
44+ network-transport-tcp >= 0.2 && < 0.3
distributed-process-azure/src/Control/Distributed/Process/Backend/Azure.hs+7−5
@@ -114,13 +114,15 @@ apiCopyToVM params vm =
114114
115115-- | Start the executable on the remote machine
116116apiRunOnVM :: AzureParameters -> VirtualMachine -> IO ()
117−apiRunOnVM params vm =
117+apiRunOnVM params vm@(Azure.vmSshEndpoint -> Just ep) =
118118 void . withSSH2 params vm $ \fd s -> do
119− let exe = "/home/edsko/" ++ azureSshRemotePath params
119+ let exe = "/home/edsko/" ++ azureSshRemotePath params
120+ ++ " onvm run "
121+ ++ " --host " ++ endpointVip ep
122+ ++ " --port 8080 "
123+ ++ "2>&1"
120124 putStrLn $ "Executing " ++ show exe
121− r <- SSH.execCommands fd s [exe ++ " onvm run "
122− ++ "2>&1"
123− ] -- ++ " >/dev/null 2>&1 &"] /usr/bin/nohup
125+ r <- SSH.execCommands fd s [exe] -- ++ " >/dev/null 2>&1 &"] /usr/bin/nohup
124126 print r
125127
126128-- | Check the MD5 hash of the executable on the remote machine
distributed-process-azure/src/Control/Distributed/Process/Backend/Azure/CommandLine.hs+33−3
@@ -2,7 +2,9 @@ import System.Environment (getArgs)
22import System.Exit (exitSuccess, exitFailure)
33import System.IO (hFlush, stdout)
44import Control.Monad (unless, forM, forM_)
5+import Control.Monad.IO.Class (liftIO)
56import Control.Arrow (returnA)
7+import Control.Exception (throwIO)
68import Control.Distributed.Process.Backend.Azure
79 ( AzureParameters(azureSshUserName)
810 , defaultAzureParameters
@@ -35,6 +37,9 @@ import Options.Applicative
3537 , switch
3638 )
3739import Options.Applicative.Arrows (runA, asA)
40+import Control.Distributed.Process (getSelfPid, RemoteTable)
41+import Control.Distributed.Process.Node (newLocalNode, runProcess, initRemoteTable)
42+import Network.Transport.TCP (createTransport, defaultTCPParameters)
3843
3944--------------------------------------------------------------------------------
4045-- Command line options --
@@ -83,7 +88,10 @@ data Command =
8388 deriving Show
8489
8590data OnVmCommand =
86− OnVmRun
91+ OnVmRun {
92+ onVmIP :: String
93+ , onVmPort :: String
94+ }
8795 deriving Show
8896
8997azureOptionsParser :: Parser AzureOptions
@@ -161,7 +169,15 @@ runOnParser = RunOn
161169 <*> targetParser
162170
163171onVmRunParser :: Parser OnVmCommand
164−onVmRunParser = pure OnVmRun
172+onVmRunParser = OnVmRun
173+ <$> strOption ( long "host"
174+ & metavar "IP"
175+ & help "IP address"
176+ )
177+ <*> strOption ( long "port"
178+ & metavar "PORT"
179+ & help "port number"
180+ )
165181
166182onVmCommandParser :: Parser Command
167183onVmCommandParser = OnVmCommand <$> subparser
@@ -212,7 +228,8 @@ main = do
212228 runOnVM backend vm
213229 putStrLn "Done"
214230 OnVmCommand (vmCmd@OnVmRun {}) -> do
215− putStrLn "Hello"
231+ let rtable = initRemoteTable
232+ onVmRun rtable (onVmIP vmCmd) (onVmPort vmCmd)
216233 SSH.exit
217234 where
218235 opts = info (helper <*> commandParser)
@@ -240,3 +257,16 @@ azureParameters opts (Just sshOpts) = do
240257 return params {
241258 azureSshUserName = remoteUser sshOpts
242259 }
260+
261+onVmRun :: RemoteTable -> String -> String -> IO ()
262+onVmRun rtable host port = do
263+ mTransport <- createTransport host port defaultTCPParameters
264+ case mTransport of
265+ Left err -> throwIO err
266+ Right transport -> do
267+ node <- newLocalNode transport rtable
268+ runProcess node $ do
269+ pid <- getSelfPid
270+ liftIO . putStrLn $ "Azure controller has pid " ++ show pid
271+
272+