4d26aad · distributed-process

git.iko.soy/distributed-process

on master help sign in

Use updated libssh2 bindings

4d26aadEdsko de Vries14 years ago

azure-service-api/src/Network/Azure/ServiceManagement.hs+3−2

compare with master

unifiedsplit

@@ -19,6 +19,7 @@ import Prelude hiding (id, (.))

19import Control.Category (id, (>>>), (.))

20import Control.Arrow (arr)

21import Control.Monad (forM)

22+import Data.Maybe (listToMaybe)

22import Data.ByteString.Char8 as BSC (pack)

23import Data.ByteString.Char8 as BSC (pack)

23import Data.ByteString.Lazy.Char8 as BSLC (unpack)

24import Data.ByteString.Lazy.Char8 as BSLC (unpack)

24import Network.TLS (PrivateKey)

25import Network.TLS (PrivateKey)

@@ -81,8 +82,8 @@ data Endpoint = Endpoint {

81-- Pure operations --

82-- Pure operations --

82--------------------------------------------------------------------------------

83--------------------------------------------------------------------------------

84−vmSshEndpoint :: VirtualMachine -> Endpoint

85+vmSshEndpoint :: VirtualMachine -> Maybe Endpoint

85−vmSshEndpoint vm = head

86+vmSshEndpoint vm = listToMaybe

86 [ ep

87 [ ep

87 | ep <- vmInputEndpoints vm

88 | ep <- vmInputEndpoints vm

88 , endpointName ep == "SSH"

89 , endpointName ep == "SSH"

distributed-process-azure/distributed-process-azure.cabal+1

@@ -25,6 +25,7 @@ Library

25 executable-path >= 0.0.3 && < 0.1,

26 libssh2 >= 0.2 && < 0.3

27 Exposed-modules: Control.Distributed.Process.Backend.Azure

28+ Extensions: ViewPatterns

28 ghc-options: -Wall

29 ghc-options: -Wall

29 HS-Source-Dirs: src

30 HS-Source-Dirs: src

distributed-process-azure/src/Control/Distributed/Process/Backend/Azure.hs+17−15

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

10 ) where

12import System.Environment (getEnv)

13−import System.FilePath ((</>))

13+import System.FilePath ((</>), takeFileName)

14import System.Environment.Executable (getExecutablePath)

15−import Control.Concurrent (threadDelay)

16import Network.Azure.ServiceManagement

15import Network.Azure.ServiceManagement

17 ( CloudService(..)

16 ( CloudService(..)

18 , VirtualMachine(..)

17 , VirtualMachine(..)

@@ -20,18 +19,16 @@ import Network.Azure.ServiceManagement

20 )

19 )

21import qualified Network.Azure.ServiceManagement as Azure

20import qualified Network.Azure.ServiceManagement as Azure

22 ( cloudServices

21 ( cloudServices

23− , AzureSetup

24 , azureSetup

22 , azureSetup

25 , vmSshEndpoint

23 , vmSshEndpoint

26 )

24 )

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

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

28 ( withSSH2

26 ( withSSH2

29− , retryIfNeeded

27+ , execCommands

30 )

28 )

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

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

32 ( initialize

30 ( initialize

33 , exit

31 , exit

34− , channelExecute

35 )

32 )

37-- | Azure backend

34-- | Azure backend

@@ -48,7 +45,9 @@ data AzureParameters = AzureParameters {

48 , azureSshUserName :: FilePath

45 , azureSshUserName :: FilePath

49 , azureSshPublicKey :: FilePath

46 , azureSshPublicKey :: FilePath

50 , azureSshPrivateKey :: FilePath

47 , azureSshPrivateKey :: FilePath

48+ , azureSshPassphrase :: String

51 , azureSshKnownHosts :: FilePath

49 , azureSshKnownHosts :: FilePath

50+ , azureSshRemotePath :: FilePath

52 }

51 }

54-- | Create default azure parameters

53-- | Create default azure parameters

@@ -59,6 +58,7 @@ defaultAzureParameters :: String -- ^ Azure subscription ID

59defaultAzureParameters sid x509 pkey = do

58defaultAzureParameters sid x509 pkey = do

60 home <- getEnv "HOME"

59 home <- getEnv "HOME"

61 user <- getEnv "USER"

60 user <- getEnv "USER"

61+ self <- getExecutablePath

62 return AzureParameters

63 { azureSubscriptionId = sid

64 , azureAuthCertificate = x509

@@ -66,7 +66,9 @@ defaultAzureParameters sid x509 pkey = do

66 , azureSshUserName = user

67 , azureSshPublicKey = home </> ".ssh" </> "id_rsa.pub"

68 , azureSshPrivateKey = home </> ".ssh" </> "id_rsa"

69+ , azureSshPassphrase = ""

69 , azureSshKnownHosts = home </> ".ssh" </> "known_hosts"

70 , azureSshKnownHosts = home </> ".ssh" </> "known_hosts"

71+ , azureSshRemotePath = "/home" </> user </> takeFileName self

70 }

72 }

72-- | Initialize the backend

74-- | Initialize the backend

@@ -75,8 +77,6 @@ initializeBackend params = do

75 setup <- Azure.azureSetup (azureSubscriptionId params)

77 setup <- Azure.azureSetup (azureSubscriptionId params)

76 (azureAuthCertificate params)

78 (azureAuthCertificate params)

77 (azureAuthPrivateKey params)

79 (azureAuthPrivateKey params)

78− exe <- getExecutablePath

79− print exe

80 return Backend {

81 cloudServices = Azure.cloudServices setup

82 , startOnVM = apiStartOnVM params

@@ -84,14 +84,16 @@ initializeBackend params = do

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

86apiStartOnVM :: AzureParameters -> VirtualMachine -> IO ()

87−apiStartOnVM params vm = do

87+apiStartOnVM params (Azure.vmSshEndpoint -> Just ep) = do

88 _ <- SSH.initialize True

89− let ep = Azure.vmSshEndpoint vm

90 _ <- SSH.withSSH2 (azureSshKnownHosts params)

89 _ <- SSH.withSSH2 (azureSshKnownHosts params)

91− (azureSshPublicKey params)

90+ (azureSshPublicKey params)

92− (azureSshPrivateKey params)

91+ (azureSshPrivateKey params)

92+ (azureSshPassphrase params)

93− (azureSshUserName params)

93+ (azureSshUserName params)

94− (endpointVip ep)

94+ (endpointVip ep)

95− (read $ endpointPort ep) $ \fd s ch -> do

95+ (read $ endpointPort ep) $ \fd s -> do

96− SSH.retryIfNeeded fd s $ SSH.channelExecute ch "nohup /home/edsko/testservice >/dev/null 2>&1 &"

96+ SSH.execCommands fd s ["nohup /home/edsko/testservice >/dev/null 2>&1 &"]

97 SSH.exit

98+apiStartOnVM _ _ =

99+ error "startOnVM: No SSH endpoint"