b0fb243 · distributed-process

git.iko.soy/distributed-process

on master help sign in

Work with the revised version of libssh2(-hs)

b0fb243Edsko de Vries14 years ago

distributed-process-azure/src/Control/Distributed/Process/Backend/Azure.hs+18−21

compare with master

unifiedsplit

@@ -14,10 +14,10 @@ module Control.Distributed.Process.Backend.Azure

14import System.Environment (getEnv)

15import System.FilePath ((</>), takeFileName)

16import System.Environment.Executable (getExecutablePath)

17−import System.Posix.Types (Fd)

18import Data.Binary (encode, decode)

17import Data.Binary (encode, decode)

19import Data.Digest.Pure.MD5 (md5, MD5Digest)

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

21import Data.Typeable (Typeable)

22import Control.Applicative ((<$>))

23import Control.Monad (void)

@@ -40,12 +40,13 @@ import qualified Network.Azure.ServiceManagement as Azure

40import qualified Network.SSH.Client.LibSSH2 as SSH

41 ( withSSH2

42 , scpSendFile

43− , withChannel

43+ , withChannelBy

44 , Session

45+ , readAllChannel

46+ , writeAllChannel

45 )

47 )

46import qualified Network.SSH.Client.LibSSH2.Foreign as SSH

48import qualified Network.SSH.Client.LibSSH2.Foreign as SSH

47 ( openChannelSession

49 ( openChannelSession

48− , retryIfNeeded

49 , channelExecute

50 , channelExecute

50 , writeChannel

51 , writeChannel

51 , channelSendEOF

52 , channelSendEOF

@@ -55,10 +56,6 @@ import qualified Network.SSH.Client.LibSSH2.Errors as SSH

55 , NULL_POINTER

56 , NULL_POINTER

56 , getLastError

57 , getLastError

57 )

58 )

58−import qualified Network.SSH.Client.LibSSH2.ByteString.Lazy as SSHBS

59− ( writeChannel

60− , readAllChannel

61− )

63-- CH

60-- CH

64import Control.Distributed.Process

61import Control.Distributed.Process

@@ -158,23 +155,23 @@ initializeBackend params = do

158-- | Start a CH node on the given virtual machine

155-- | Start a CH node on the given virtual machine

159apiCopyToVM :: AzureParameters -> VirtualMachine -> IO ()

156apiCopyToVM :: AzureParameters -> VirtualMachine -> IO ()

160apiCopyToVM params vm =

157apiCopyToVM params vm =

161− void . withSSH2 params vm $ \fd s -> catchSshError s $

158+ void . withSSH2 params vm $ \s -> catchSshError s $

162− SSH.scpSendFile fd s 0o700 (azureSshLocalPath params) (azureSshRemotePath params)

159+ SSH.scpSendFile s 0o700 (azureSshLocalPath params) (azureSshRemotePath params)

163

160

164-- | Call a process on a VM

161-- | Call a process on a VM

165apiCallOnVM :: Serializable a => AzureParameters -> Static (SerializableDict a) -> VirtualMachine -> String -> Closure (Process a) -> IO a

162apiCallOnVM :: Serializable a => AzureParameters -> Static (SerializableDict a) -> VirtualMachine -> String -> Closure (Process a) -> IO a

166apiCallOnVM params dict vm port proc =

163apiCallOnVM params dict vm port proc =

167− withSSH2 params vm $ \fd s -> do

164+ withSSH2 params vm $ \s -> do

168 let exe = "PATH=. " ++ azureSshRemotePath params

165 let exe = "PATH=. " ++ azureSshRemotePath params

169 ++ " onvm run "

166 ++ " onvm run "

170 ++ " --host " ++ vmIpAddress vm

167 ++ " --host " ++ vmIpAddress vm

171 ++ " --port " ++ port

168 ++ " --port " ++ port

172 ++ " 2>&1"

169 ++ " 2>&1"

173− (_, r) <- SSH.withChannel (SSH.openChannelSession s) id fd s $ \ch -> do

170+ (_, r) <- SSH.withChannelBy (SSH.openChannelSession s) id $ \ch -> do

174− SSH.retryIfNeeded fd s $ SSH.channelExecute ch exe

171+ SSH.channelExecute ch exe

175− cnt <- SSHBS.writeChannel fd ch (encode proc')

172+ _cnt <- SSH.writeAllChannel ch (encode proc')

176 SSH.channelSendEOF ch

173 SSH.channelSendEOF ch

177− SSHBS.readAllChannel fd ch

174+ SSH.readAllChannel ch

178 return (decode r)

175 return (decode r)

179 where

176 where

180 proc' :: Closure (Process ())

177 proc' :: Closure (Process ())

@@ -184,15 +181,15 @@ apiCallOnVM params dict vm port proc =

184apiCheckMD5 :: AzureParameters -> VirtualMachine -> IO Bool

181apiCheckMD5 :: AzureParameters -> VirtualMachine -> IO Bool

185apiCheckMD5 params vm = do

182apiCheckMD5 params vm = do

186 hash <- localHash params

183 hash <- localHash params

187− withSSH2 params vm $ \fd s -> do

184+ withSSH2 params vm $ \s -> do

188− (r, _) <- SSH.withChannel (SSH.openChannelSession s) id fd s $ \ch -> do

185+ (r, _) <- SSH.withChannelBy (SSH.openChannelSession s) id $ \ch -> do

189− SSH.retryIfNeeded fd s $ SSH.channelExecute ch "md5sum -c --status"

186+ SSH.channelExecute ch "md5sum -c --status"

190− SSH.writeChannel ch $ show hash ++ " " ++ azureSshRemotePath params

187+ SSH.writeChannel ch . BSSC.pack $ show hash ++ " " ++ azureSshRemotePath params

191 SSH.channelSendEOF ch

188 SSH.channelSendEOF ch

192− SSHBS.readAllChannel fd ch

189+ SSH.readAllChannel ch

193 return (r == 0)

190 return (r == 0)

194

191

195−withSSH2 :: AzureParameters -> VirtualMachine -> (Fd -> SSH.Session -> IO a) -> IO a

192+withSSH2 :: AzureParameters -> VirtualMachine -> (SSH.Session -> IO a) -> IO a

196withSSH2 params (Azure.vmSshEndpoint -> Just ep) =

193withSSH2 params (Azure.vmSshEndpoint -> Just ep) =

197 SSH.withSSH2 (azureSshKnownHosts params)

194 SSH.withSSH2 (azureSshKnownHosts params)

198 (azureSshPublicKey params)

195 (azureSshPublicKey params)

distributed-process-azure/src/Control/Distributed/Process/Backend/Azure/GenericMain.hs+2−2

@@ -13,7 +13,7 @@ import System.IO

13 , hSetBinaryMode

14 )

15import Data.Binary (decode)

16−import qualified Data.ByteString.Lazy as BSL (ByteString, getContents, length)

16+import qualified Data.ByteString.Lazy as BSL (ByteString, getContents)

17import Control.Monad (unless, forM, forM_, join)

18import Control.Exception (throwIO, SomeException)

19import Control.Applicative ((<$>), (<*>), (<|>))

@@ -120,7 +120,7 @@ genericMain remoteTable cmds = do

120 case procPair of

121 ProcessPair rProc lProc dict ->

122 callOnVM backend dict vm (remotePort cmd) rProc >>= lProc

123− OnVmCommand (vmCmd@OnVmRun {}) -> do

123+ OnVmCommand (vmCmd@OnVmRun {}) ->

124 onVmRun (remoteTable . Azure.remoteTable $ initRemoteTable)

125 (onVmIP vmCmd)

126 (onVmPort vmCmd)