Skip to content

Commit 2b3d4bb

Browse files
edskoedsko
committed
Cleanup/skeleton onvm run
1 parent 8496c31 commit 2b3d4bb

File tree

2 files changed

+103
-31
lines changed

2 files changed

+103
-31
lines changed

‎distributed-process-azure/src/Control/Distributed/Process/Backend/Azure.hs

Lines changed: 59 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -12,9 +12,12 @@ module Control.Distributed.Process.Backend.Azure
1212
import System.Environment (getEnv)
1313
import System.FilePath ((</>), takeFileName)
1414
import System.Environment.Executable (getExecutablePath)
15+
import System.Posix.Types (Fd)
1516
import Data.Digest.Pure.MD5 (md5, MD5Digest)
1617
import qualified Data.ByteString.Lazy as BSL (readFile)
1718
import Control.Applicative ((<$>))
19+
import Control.Monad (void)
20+
import Control.Exception (catches, Handler(Handler))
1821
import Network.Azure.ServiceManagement
1922
( CloudService(..)
2023
, VirtualMachine(..)
@@ -31,6 +34,7 @@ import qualified Network.SSH.Client.LibSSH2 as SSH
3134
, scpSendFile
3235
, withChannel
3336
, readAllChannel
37+
, Session
3438
)
3539
import qualified Network.SSH.Client.LibSSH2.Foreign as SSH
3640
( openChannelSession
@@ -39,13 +43,19 @@ import qualified Network.SSH.Client.LibSSH2.Foreign as SSH
3943
, writeChannel
4044
, channelSendEOF
4145
)
46+
import qualified Network.SSH.Client.LibSSH2.Errors as SSH
47+
( ErrorCode
48+
, NULL_POINTER
49+
, getLastError
50+
)
4251

4352
-- | Azure backend
4453
data Backend = Backend {
4554
-- | Find virtual machines
4655
cloudServices :: IO [CloudService]
47-
, copyToVM :: VirtualMachine -> IO ()
56+
, copyToVM :: VirtualMachine -> IO ()
4857
, checkMD5 :: VirtualMachine -> IO Bool
58+
, runOnVM :: VirtualMachine -> IO ()
4959
}
5060

5161
data AzureParameters = AzureParameters {
@@ -91,45 +101,67 @@ initializeBackend params = do
91101
(azureAuthPrivateKey params)
92102
return Backend {
93103
cloudServices = Azure.cloudServices setup
94-
, copyToVM = apiCopyToVM params
104+
, copyToVM = apiCopyToVM params
95105
, checkMD5 = apiCheckMD5 params
106+
, runOnVM = apiRunOnVM params
96107
}
97108

98109
-- | Start a CH node on the given virtual machine
99110
apiCopyToVM :: AzureParameters -> VirtualMachine -> IO ()
100-
apiCopyToVM params (Azure.vmSshEndpoint -> Just ep) = do
101-
_ <- SSH.withSSH2 (azureSshKnownHosts params)
102-
(azureSshPublicKey params)
103-
(azureSshPrivateKey params)
104-
(azureSshPassphrase params)
105-
(azureSshUserName params)
106-
(endpointVip ep)
107-
(read $ endpointPort ep) $ \fd s -> do
108-
SSH.scpSendFile fd s 0o700 (azureSshLocalPath params) (azureSshRemotePath params)
109-
-- SSH.execCommands fd s ["nohup /home/edsko/testservice >/dev/null 2>&1 &"]
110-
return ()
111-
apiCopyToVM _ _ =
112-
error "copyToVM: No SSH endpoint"
111+
apiCopyToVM params vm =
112+
void . withSSH2 params vm $ \fd s -> catchSshError s $
113+
SSH.scpSendFile fd s 0o700 (azureSshLocalPath params) (azureSshRemotePath params)
114+
115+
-- | Start the executable on the remote machine
116+
apiRunOnVM :: AzureParameters -> VirtualMachine -> IO ()
117+
apiRunOnVM params vm =
118+
void . withSSH2 params vm $ \fd s -> do
119+
let exe = "/home/edsko/" ++ azureSshRemotePath params
120+
putStrLn $ "Executing " ++ show exe
121+
r <- SSH.execCommands fd s [exe ++ " onvm run "
122+
++ "2>&1"
123+
] -- ++ " >/dev/null 2>&1 &"] /usr/bin/nohup
124+
print r
113125

126+
-- | Check the MD5 hash of the executable on the remote machine
114127
apiCheckMD5 :: AzureParameters -> VirtualMachine -> IO Bool
115-
apiCheckMD5 params (Azure.vmSshEndpoint -> Just ep) = do
128+
apiCheckMD5 params vm = do
116129
hash <- localHash params
117-
match <- SSH.withSSH2 (azureSshKnownHosts params)
118-
(azureSshPublicKey params)
119-
(azureSshPrivateKey params)
120-
(azureSshPassphrase params)
121-
(azureSshUserName params)
122-
(endpointVip ep)
123-
(read $ endpointPort ep) $ \fd s -> do
130+
withSSH2 params vm $ \fd s -> do
124131
(r, _) <- SSH.withChannel (SSH.openChannelSession s) id fd s $ \ch -> do
125-
SSH.retryIfNeeded fd s $ SSH.channelExecute ch ("md5sum -c --status")
132+
SSH.retryIfNeeded fd s $ SSH.channelExecute ch "md5sum -c --status"
126133
SSH.writeChannel ch $ show hash ++ " " ++ azureSshRemotePath params
127134
SSH.channelSendEOF ch
128135
SSH.readAllChannel fd ch
129136
return (r == 0)
130-
return match
131-
apiCheckMD5 _ _ =
132-
error "checkMD5: No SSH endpoint"
133137

138+
withSSH2 :: AzureParameters -> VirtualMachine -> (Fd -> SSH.Session -> IO a) -> IO a
139+
withSSH2 params (Azure.vmSshEndpoint -> Just ep) =
140+
SSH.withSSH2 (azureSshKnownHosts params)
141+
(azureSshPublicKey params)
142+
(azureSshPrivateKey params)
143+
(azureSshPassphrase params)
144+
(azureSshUserName params)
145+
(endpointVip ep)
146+
(read $ endpointPort ep)
147+
withSSH2 _ vm =
148+
error $ "withSSH2: No SSH endpoint for virtual machine " ++ vmName vm
149+
150+
catchSshError :: SSH.Session -> IO a -> IO a
151+
catchSshError s io =
152+
catches io [ Handler handleErrorCode
153+
, Handler handleNullPointer
154+
]
155+
where
156+
handleErrorCode :: SSH.ErrorCode -> IO a
157+
handleErrorCode _ = do
158+
(_, str) <- SSH.getLastError s
159+
error str
160+
161+
handleNullPointer :: SSH.NULL_POINTER -> IO a
162+
handleNullPointer _ = do
163+
(_, str) <- SSH.getLastError s
164+
error str
165+
134166
localHash :: AzureParameters -> IO MD5Digest
135167
localHash params = md5 <$> BSL.readFile (azureSshLocalPath params)

‎distributed-process-azure/src/Control/Distributed/Process/Backend/Azure/CommandLine.hs

Lines changed: 44 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,3 @@
1-
{-# LANGUAGE Arrows #-}
21
import System.Environment (getArgs)
32
import System.Exit (exitSuccess, exitFailure)
43
import System.IO (hFlush, stdout)
@@ -11,13 +10,13 @@ import Control.Distributed.Process.Backend.Azure
1110
, cloudServices
1211
, CloudService(cloudServiceName, cloudServiceVMs)
1312
, VirtualMachine(vmName)
14-
, Backend(copyToVM, checkMD5)
13+
, Backend(copyToVM, checkMD5, runOnVM)
1514
)
1615
import qualified Network.SSH.Client.LibSSH2.Foreign as SSH
1716
( initialize
1817
, exit
1918
)
20-
import Control.Applicative ((<$>), (<*>), (<|>))
19+
import Control.Applicative ((<$>), (<*>), (<|>), pure)
2120
import Options.Applicative
2221
( Parser
2322
, strOption
@@ -73,6 +72,18 @@ data Command =
7372
, target :: Target
7473
, status :: Bool
7574
}
75+
| RunOn {
76+
azureOptions :: AzureOptions
77+
, sshOptions :: SshOptions
78+
, target :: Target
79+
}
80+
| OnVmCommand {
81+
onVmCommand :: OnVmCommand
82+
}
83+
deriving Show
84+
85+
data OnVmCommand =
86+
OnVmRun
7687
deriving Show
7788

7889
azureOptionsParser :: Parser AzureOptions
@@ -134,9 +145,28 @@ commandParser = subparser
134145
( command "list" (info listParser
135146
(progDesc "List Azure cloud services"))
136147
& command "install" (info copyToParser
137-
(progDesc "Install the executable on a virtual machine"))
148+
(progDesc "Install the executable"))
138149
& command "md5" (info checkMD5Parser
139150
(progDesc "Check if the remote and local MD5 hash match"))
151+
& command "run" (info runOnParser
152+
(progDesc "Run the executable"))
153+
& command "onvm" (info onVmCommandParser
154+
(progDesc "Commands used when running ON the vm (usually used internally only)"))
155+
)
156+
157+
runOnParser :: Parser Command
158+
runOnParser = RunOn
159+
<$> azureOptionsParser
160+
<*> sshOptionsParser
161+
<*> targetParser
162+
163+
onVmRunParser :: Parser OnVmCommand
164+
onVmRunParser = pure OnVmRun
165+
166+
onVmCommandParser :: Parser Command
167+
onVmCommandParser = OnVmCommand <$> subparser
168+
( command "run" (info onVmRunParser
169+
(progDesc "Run the executable"))
140170
)
141171

142172
--------------------------------------------------------------------------------
@@ -173,6 +203,16 @@ main = do
173203
if and matches
174204
then exitSuccess
175205
else exitFailure
206+
RunOn {} -> do
207+
params <- azureParameters (azureOptions cmd) (Just (sshOptions cmd))
208+
backend <- initializeBackend params
209+
css <- cloudServices backend
210+
forM_ (findTarget (target cmd) css) $ \vm -> do
211+
putStr (vmName vm ++ ": ") >> hFlush stdout
212+
runOnVM backend vm
213+
putStrLn "Done"
214+
OnVmCommand (vmCmd@OnVmRun {}) -> do
215+
putStrLn "Hello"
176216
SSH.exit
177217
where
178218
opts = info (helper <*> commandParser)

0 commit comments

Comments
 (0)