@@ -12,9 +12,12 @@ module Control.Distributed.Process.Backend.Azure
1212import System.Environment (getEnv)
1313import System.FilePath ((</>), takeFileName)
1414import System.Environment.Executable (getExecutablePath)
15+import System.Posix.Types (Fd)
1516import Data.Digest.Pure.MD5 (md5, MD5Digest)
1617import qualified Data.ByteString.Lazy as BSL (readFile)
1718import Control.Applicative ((<$>))
19+import Control.Monad (void)
20+import Control.Exception (catches, Handler(Handler))
1821import 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 )
3539import 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
4453data 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
5161data 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
99110apiCopyToVM :: 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
114127apiCheckMD5 :: 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+
134166localHash :: AzureParameters -> IO MD5Digest
135167localHash params = md5 <$> BSL.readFile (azureSshLocalPath params)