@@ -1,3 +1,4 @@
1+{-# LANGUAGE TemplateHaskell #-}
12module Control.Distributed.Process.Backend.Azure
23 ( -- * Initialization
34 Backend(..)
@@ -13,13 +14,14 @@ import System.Environment (getEnv)
1314import System.FilePath ((</>), takeFileName)
1415import System.Environment.Executable (getExecutablePath)
1516import System.Posix.Types (Fd)
16−import Data.Binary (encode)
17+import Data.Binary (encode, decode)
1718import Data.Digest.Pure.MD5 (md5, MD5Digest)
18−import qualified Data.ByteString.Lazy as BSL (readFile)
19−import qualified Data.ByteString.Lazy.Char8 as BSLC (putStr)
19+import qualified Data.ByteString.Lazy as BSL (readFile, putStr)
20+import Data.Typeable (Typeable)
2021import Control.Applicative ((<$>))
2122import Control.Monad (void)
2223import Control.Exception (catches, Handler(Handler))
24+import Control.Monad.IO.Class (liftIO)
2325
2426-- Azure
2527import Network.Azure.ServiceManagement
@@ -61,7 +63,23 @@ import qualified Network.SSH.Client.LibSSH2.ByteString.Lazy as SSHBS
6163import Control.Distributed.Process
6264 ( Closure
6365 , Process
66+ , Static
6467 )
68+import Control.Distributed.Process.Closure
69+ ( remotable
70+ , mkClosure
71+ , cpBind
72+ , SerializableDict(SerializableDict)
73+ )
74+import Control.Distributed.Process.Serializable (Serializable)
75+
76+encodeToStdout :: Serializable a => a -> Process ()
77+encodeToStdout = liftIO . BSL.putStr . encode
78+
79+encodeToStdoutDict :: SerializableDict a -> a -> Process ()
80+encodeToStdoutDict SerializableDict = encodeToStdout
81+
82+remotable ['encodeToStdoutDict]
6583
6684-- | Azure backend
6785data Backend = Backend {
@@ -71,8 +89,8 @@ data Backend = Backend {
7189 , copyToVM :: VirtualMachine -> IO ()
7290 -- | Check the MD5 hash of the remote executable
7391 , checkMD5 :: VirtualMachine -> IO Bool
74− -- | @runOnVM vm port p@ starts a CH node on port 'port' and runs 'p'
75− , runOnVM :: VirtualMachine -> String -> Closure (Process ()) -> IO ()
92+ -- | @runOnVM vm port p bg@ starts a CH node on port 'port' and runs 'p'
93+ , callOnVM :: forall a. Serializable a => Static (SerializableDict a) -> VirtualMachine -> String -> Closure (Process a) -> IO a
7694 }
7795
7896data AzureParameters = AzureParameters {
@@ -120,7 +138,7 @@ initializeBackend params = do
120138 cloudServices = Azure.cloudServices setup
121139 , copyToVM = apiCopyToVM params
122140 , checkMD5 = apiCheckMD5 params
123− , runOnVM = apiRunOnVM params
141+ , callOnVM = apiCallOnVM params
124142 }
125143
126144-- | Start a CH node on the given virtual machine
@@ -129,21 +147,24 @@ apiCopyToVM params vm =
129147 void . withSSH2 params vm $ \fd s -> catchSshError s $
130148 SSH.scpSendFile fd s 0o700 (azureSshLocalPath params) (azureSshRemotePath params)
131149
132−-- | Start the executable on the remote machine
133−apiRunOnVM :: AzureParameters -> VirtualMachine -> String -> Closure (Process ()) -> IO ()
134−apiRunOnVM params vm port proc =
135− void . withSSH2 params vm $ \fd s -> do
136− let exe = "PATH=. " ++ azureSshRemotePath params
137− ++ " onvm run "
138− ++ " --host " ++ vmIpAddress vm
139− ++ " --port " ++ port
140− ++ " 2>&1"
141− (_, r) <- SSH.withChannel (SSH.openChannelSession s) id fd s $ \ch -> do
142− SSH.retryIfNeeded fd s $ SSH.channelExecute ch exe
143− SSHBS.writeChannel fd ch (encode proc)
144− SSH.channelSendEOF ch
145− SSHBS.readAllChannel fd ch
146− BSLC.putStr r
150+-- | Call a process on a VM
151+apiCallOnVM :: Serializable a => AzureParameters -> Static (SerializableDict a) -> VirtualMachine -> String -> Closure (Process a) -> IO a
152+apiCallOnVM params dict vm port proc =
153+ withSSH2 params vm $ \fd s -> do
154+ let exe = "PATH=. " ++ azureSshRemotePath params
155+ ++ " onvm run "
156+ ++ " --host " ++ vmIpAddress vm
157+ ++ " --port " ++ port
158+ ++ " 2>&1"
159+ (_, r) <- SSH.withChannel (SSH.openChannelSession s) id fd s $ \ch -> do
160+ SSH.retryIfNeeded fd s $ SSH.channelExecute ch exe
161+ SSHBS.writeChannel fd ch (encode proc)
162+ SSH.channelSendEOF ch
163+ SSHBS.readAllChannel fd ch
164+ return (decode r)
165+ where
166+ proc' :: Closure (Process ())
167+ proc' = proc `cpBind` undefined
147168
148169-- | Check the MD5 hash of the executable on the remote machine
149170apiCheckMD5 :: AzureParameters -> VirtualMachine -> IO Bool