@@ -14,10 +14,10 @@ module Control.Distributed.Process.Backend.Azure
1414import System.Environment (getEnv)
1515import System.FilePath ((</>), takeFileName)
1616import System.Environment.Executable (getExecutablePath)
17−import System.Posix.Types (Fd)
1817import Data.Binary (encode, decode)
1918import Data.Digest.Pure.MD5 (md5, MD5Digest)
20−import qualified Data.ByteString.Lazy as BSL (ByteString, readFile, putStr, length, writeFile)
19+import qualified Data.ByteString.Char8 as BSSC (pack)
20+import qualified Data.ByteString.Lazy as BSL (ByteString, readFile, putStr)
2121import Data.Typeable (Typeable)
2222import Control.Applicative ((<$>))
2323import Control.Monad (void)
@@ -40,12 +40,13 @@ import qualified Network.Azure.ServiceManagement as Azure
4040import qualified Network.SSH.Client.LibSSH2 as SSH
4141 ( withSSH2
4242 , scpSendFile
43− , withChannel
43+ , withChannelBy
4444 , Session
45+ , readAllChannel
46+ , writeAllChannel
4547 )
4648import qualified Network.SSH.Client.LibSSH2.Foreign as SSH
4749 ( openChannelSession
48− , retryIfNeeded
4950 , channelExecute
5051 , writeChannel
5152 , channelSendEOF
@@ -55,10 +56,6 @@ import qualified Network.SSH.Client.LibSSH2.Errors as SSH
5556 , NULL_POINTER
5657 , getLastError
5758 )
58−import qualified Network.SSH.Client.LibSSH2.ByteString.Lazy as SSHBS
59− ( writeChannel
60− , readAllChannel
61− )
6259
6360-- CH
6461import Control.Distributed.Process
@@ -158,23 +155,23 @@ initializeBackend params = do
158155-- | Start a CH node on the given virtual machine
159156apiCopyToVM :: AzureParameters -> VirtualMachine -> IO ()
160157apiCopyToVM params vm =
161− void . withSSH2 params vm $ \fd s -> catchSshError s $
162− SSH.scpSendFile fd s 0o700 (azureSshLocalPath params) (azureSshRemotePath params)
158+ void . withSSH2 params vm $ \s -> catchSshError s $
159+ SSH.scpSendFile s 0o700 (azureSshLocalPath params) (azureSshRemotePath params)
163160
164161-- | Call a process on a VM
165162apiCallOnVM :: Serializable a => AzureParameters -> Static (SerializableDict a) -> VirtualMachine -> String -> Closure (Process a) -> IO a
166163apiCallOnVM params dict vm port proc =
167− withSSH2 params vm $ \fd s -> do
164+ withSSH2 params vm $ \s -> do
168165 let exe = "PATH=. " ++ azureSshRemotePath params
169166 ++ " onvm run "
170167 ++ " --host " ++ vmIpAddress vm
171168 ++ " --port " ++ port
172169 ++ " 2>&1"
173− (_, r) <- SSH.withChannel (SSH.openChannelSession s) id fd s $ \ch -> do
174− SSH.retryIfNeeded fd s $ SSH.channelExecute ch exe
175− cnt <- SSHBS.writeChannel fd ch (encode proc')
170+ (_, r) <- SSH.withChannelBy (SSH.openChannelSession s) id $ \ch -> do
171+ SSH.channelExecute ch exe
172+ _cnt <- SSH.writeAllChannel ch (encode proc')
176173 SSH.channelSendEOF ch
177− SSHBS.readAllChannel fd ch
174+ SSH.readAllChannel ch
178175 return (decode r)
179176 where
180177 proc' :: Closure (Process ())
@@ -184,15 +181,15 @@ apiCallOnVM params dict vm port proc =
184181apiCheckMD5 :: AzureParameters -> VirtualMachine -> IO Bool
185182apiCheckMD5 params vm = do
186183 hash <- localHash params
187− withSSH2 params vm $ \fd s -> do
188− (r, _) <- SSH.withChannel (SSH.openChannelSession s) id fd s $ \ch -> do
189− SSH.retryIfNeeded fd s $ SSH.channelExecute ch "md5sum -c --status"
190− SSH.writeChannel ch $ show hash ++ " " ++ azureSshRemotePath params
184+ withSSH2 params vm $ \s -> do
185+ (r, _) <- SSH.withChannelBy (SSH.openChannelSession s) id $ \ch -> do
186+ SSH.channelExecute ch "md5sum -c --status"
187+ SSH.writeChannel ch . BSSC.pack $ show hash ++ " " ++ azureSshRemotePath params
191188 SSH.channelSendEOF ch
192− SSHBS.readAllChannel fd ch
189+ SSH.readAllChannel ch
193190 return (r == 0)
194191
195−withSSH2 :: AzureParameters -> VirtualMachine -> (Fd -> SSH.Session -> IO a) -> IO a
192+withSSH2 :: AzureParameters -> VirtualMachine -> (SSH.Session -> IO a) -> IO a
196193withSSH2 params (Azure.vmSshEndpoint -> Just ep) =
197194 SSH.withSSH2 (azureSshKnownHosts params)
198195 (azureSshPublicKey params)