06237a3 · distributed-process

git.iko.soy/distributed-process

on master help sign in

Start CH node for onvm run

06237a3Edsko de Vries14 years ago

distributed-process-azure/distributed-process-azure.cabal+4−1

compare with master

unifiedsplit

@@ -38,4 +38,7 @@ Executable cloud-haskell-azure

38 libssh2 >= 0.2 && < 0.3,

39 filepath >= 1.3 && < 1.4,

40 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 =

114

115-- | Start the executable on the remote machine

116apiRunOnVM :: AzureParameters -> VirtualMachine -> IO ()

117−apiRunOnVM params vm =

117+apiRunOnVM params vm@(Azure.vmSshEndpoint -> Just ep) =

118 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"

120 putStrLn $ "Executing " ++ show exe

124 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

124 print r

126 print r

125

127

126-- | Check the MD5 hash of the executable on the remote machine

128-- | 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)

2import System.Exit (exitSuccess, exitFailure)

3import System.IO (hFlush, stdout)

4import Control.Monad (unless, forM, forM_)

5+import Control.Monad.IO.Class (liftIO)

5import Control.Arrow (returnA)

6import Control.Arrow (returnA)

7+import Control.Exception (throwIO)

6import Control.Distributed.Process.Backend.Azure

8import Control.Distributed.Process.Backend.Azure

7 ( AzureParameters(azureSshUserName)

9 ( AzureParameters(azureSshUserName)

8 , defaultAzureParameters

10 , defaultAzureParameters

@@ -35,6 +37,9 @@ import Options.Applicative

35 , switch

37 , switch

36 )

38 )

37import Options.Applicative.Arrows (runA, asA)

39import 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)

39--------------------------------------------------------------------------------

44--------------------------------------------------------------------------------

40-- Command line options --

45-- Command line options --

@@ -83,7 +88,10 @@ data Command =

83 deriving Show

88 deriving Show

85data OnVmCommand =

90data OnVmCommand =

86− OnVmRun

91+ OnVmRun {

92+ onVmIP :: String

93+ , onVmPort :: String

94+ }

87 deriving Show

95 deriving Show

89azureOptionsParser :: Parser AzureOptions

97azureOptionsParser :: Parser AzureOptions

@@ -161,7 +169,15 @@ runOnParser = RunOn

161 <*> targetParser

169 <*> targetParser

162

170

163onVmRunParser :: Parser OnVmCommand

171onVmRunParser :: 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+ )

165

181

166onVmCommandParser :: Parser Command

182onVmCommandParser :: Parser Command

167onVmCommandParser = OnVmCommand <$> subparser

183onVmCommandParser = OnVmCommand <$> subparser

@@ -212,7 +228,8 @@ main = do

212 runOnVM backend vm

228 runOnVM backend vm

213 putStrLn "Done"

229 putStrLn "Done"

214 OnVmCommand (vmCmd@OnVmRun {}) -> do

230 OnVmCommand (vmCmd@OnVmRun {}) -> do

215− putStrLn "Hello"

231+ let rtable = initRemoteTable

232+ onVmRun rtable (onVmIP vmCmd) (onVmPort vmCmd)

216 SSH.exit

233 SSH.exit

217 where

234 where

218 opts = info (helper <*> commandParser)

235 opts = info (helper <*> commandParser)

@@ -240,3 +257,16 @@ azureParameters opts (Just sshOpts) = do

240 return params {

257 return params {

241 azureSshUserName = remoteUser sshOpts

258 azureSshUserName = remoteUser sshOpts

242 }

259 }

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+