fb980ca · distributed-process

git.iko.soy/distributed-process

on master help sign in

Start adding SSH stuff

fb980caEdsko de Vries14 years ago

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

compare with master

unifiedsplit

@@ -6,7 +6,7 @@ module Network.Azure.ServiceManagement

6 , VirtualMachine(..)

7 , Endpoint(..)

8 -- * Pure functions

9− , cloudServiceSshEndpoints

9+ , vmSshEndpoint

10 -- * Setup

11 , AzureSetup(..)

12 , azureSetup

@@ -81,10 +81,10 @@ data Endpoint = Endpoint {

81-- Pure operations --

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

84−cloudServiceSshEndpoints :: CloudService -> [Endpoint]

84+vmSshEndpoint :: VirtualMachine -> Endpoint

85−cloudServiceSshEndpoints cs =

85+vmSshEndpoint vm = head

86− [ ep

86+ [ ep

87− | ep <- concatMap vmInputEndpoints (cloudServiceVMs cs)

87+ | ep <- vmInputEndpoints vm

88 , endpointName ep == "SSH"

89 ]

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

@@ -22,7 +22,8 @@ Library

22 Build-Depends: base >= 4.4 && < 5,

23 azure-service-api >= 0.1 && < 0.2,

24 filepath >= 1.3 && < 1.4,

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

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

26+ libssh2 >= 0.2 && < 0.3

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

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

27 ghc-options: -Wall

28 ghc-options: -Wall

28 HS-Source-Dirs: src

29 HS-Source-Dirs: src

distributed-process-azure/src/Control/Distributed/Process/Backend/Azure.hs+37−1

@@ -6,29 +6,46 @@ module Control.Distributed.Process.Backend.Azure

6 , initializeBackend

7 -- * Re-exports from Azure Service Management

8 , CloudService(..)

9+ , VirtualMachine(..)

9 ) where

10 ) where

11import System.Environment (getEnv)

12import System.Environment (getEnv)

12import System.FilePath ((</>))

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

13import System.Environment.Executable (getExecutablePath)

14import System.Environment.Executable (getExecutablePath)

15+import Control.Concurrent (threadDelay)

14import Network.Azure.ServiceManagement

16import Network.Azure.ServiceManagement

15− ( CloudService )

17+ ( CloudService(..)

18+ , VirtualMachine(..)

19+ , Endpoint(..)

20+ )

16import qualified Network.Azure.ServiceManagement as Azure

21import qualified Network.Azure.ServiceManagement as Azure

17 ( cloudServices

22 ( cloudServices

18 , AzureSetup

23 , AzureSetup

19 , azureSetup

24 , azureSetup

25+ , vmSshEndpoint

20 )

26 )

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

28+ ( withSSH2

29+ , retryIfNeeded

30+ )

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

32+ ( initialize

33+ , exit

34+ , channelExecute

35+ )

22-- | Azure backend

37-- | Azure backend

23data Backend = Backend {

38data Backend = Backend {

24 -- | Find virtual machines

39 -- | Find virtual machines

25 cloudServices :: IO [CloudService]

40 cloudServices :: IO [CloudService]

41+ , startOnVM :: VirtualMachine -> IO ()

26 }

42 }

28data AzureParameters = AzureParameters {

44data AzureParameters = AzureParameters {

29 azureSubscriptionId :: String

45 azureSubscriptionId :: String

30 , azureAuthCertificate :: FilePath

46 , azureAuthCertificate :: FilePath

31 , azureAuthPrivateKey :: FilePath

47 , azureAuthPrivateKey :: FilePath

48+ , azureSshUserName :: FilePath

32 , azureSshPublicKey :: FilePath

49 , azureSshPublicKey :: FilePath

33 , azureSshPrivateKey :: FilePath

50 , azureSshPrivateKey :: FilePath

34 , azureSshKnownHosts :: FilePath

51 , azureSshKnownHosts :: FilePath

@@ -41,10 +58,12 @@ defaultAzureParameters :: String -- ^ Azure subscription ID

41 -> IO AzureParameters

58 -> IO AzureParameters

42defaultAzureParameters sid x509 pkey = do

59defaultAzureParameters sid x509 pkey = do

43 home <- getEnv "HOME"

60 home <- getEnv "HOME"

61+ user <- getEnv "USER"

44 return AzureParameters

62 return AzureParameters

45 { azureSubscriptionId = sid

63 { azureSubscriptionId = sid

46 , azureAuthCertificate = x509

64 , azureAuthCertificate = x509

47 , azureAuthPrivateKey = pkey

65 , azureAuthPrivateKey = pkey

66+ , azureSshUserName = user

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

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

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

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

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

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

@@ -60,4 +79,21 @@ initializeBackend params = do

60 print exe

79 print exe

61 return Backend {

80 return Backend {

62 cloudServices = Azure.cloudServices setup

81 cloudServices = Azure.cloudServices setup

82+ , startOnVM = apiStartOnVM params

63 }

83 }

84+

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

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

87+apiStartOnVM params vm = do

88+ _ <- SSH.initialize True

89+ let ep = Azure.vmSshEndpoint vm

90+ SSH.withSSH2 (azureSshKnownHosts params)

91+ (azureSshPublicKey params)

92+ (azureSshPrivateKey params)

93+ (azureSshUserName params)

94+ (endpointVip ep)

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

96+ _ <- SSH.retryIfNeeded fd s $ SSH.channelExecute ch "/home/edsko/testservice"

97+ threadDelay $ 10 * 1000000 -- 10 seconds

98+ return ()

99+ SSH.exit

distributed-process-azure/src/Control/Distributed/Process/Backend/Azure/CommandLine.hs+16−59

@@ -1,69 +1,26 @@

1−import System.Environment (getArgs, getEnv)

1+import System.Environment (getArgs)

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

3−import System.Posix.Types (Fd)

4import Control.Distributed.Process.Backend.Azure

2import Control.Distributed.Process.Backend.Azure

3+ ( AzureParameters(azureSshUserName)

5− ( defaultAzureParameters

4+ , defaultAzureParameters

6 , initializeBackend

5 , initializeBackend

7 , cloudServices

6 , cloudServices

7+ , CloudService(cloudServiceVMs)

8+ , VirtualMachine(vmName)

9+ , startOnVM

8 )

10 )

10−-- SSH

11−import Network.SSH.Client.LibSSH2

12− ( withSSH2

13− , readAllChannel

14− , retryIfNeeded

15− , Session

16− , Channel

17− )

18−import Network.SSH.Client.LibSSH2.Foreign

19− ( initialize

20− , exit

21− , channelExecute

22− )

23−import Codec.Binary.UTF8.String (decodeString)

24−

25main :: IO ()

12main :: IO ()

26main = do

13main = do

27− args <- getArgs

14+ [subscriptionId, pathToCert, pathToKey, user] <- getArgs

28− case args of

29− ["azure", subscriptionId, pathToCert, pathToKey] ->

30− tryConnectToAzure subscriptionId pathToCert pathToKey

15+ tryConnectToAzure subscriptionId pathToCert pathToKey user

31− ["command", user, host, port, cmd] ->

32− runCommand user host (read port) cmd

33− _ ->

34− putStrLn "Invalid command line arguments"

35−

36−--------------------------------------------------------------------------------

37−-- Taken from libssh2/ssh-client --

38−--------------------------------------------------------------------------------

39−

40−runCommand :: String -> String -> Int -> String -> IO ()

41−runCommand login host port command =

42− ssh login host port $ \fd s ch -> do

43− _ <- retryIfNeeded fd s $ channelExecute ch command

44− result <- readAllChannel fd ch

45− let r = decodeString result

46− print (length result)

47− print (length r)

48− putStrLn r

49−

50−ssh :: String -> String -> Int -> (Fd -> Session -> Channel -> IO a) -> IO ()

51−ssh login host port actions = do

52− _ <- initialize True

53− home <- getEnv "HOME"

54− let known_hosts = home </> ".ssh" </> "known_hosts"

55− public = home </> ".ssh" </> "id_rsa.pub"

56− private = home </> ".ssh" </> "id_rsa"

57− _ <- withSSH2 known_hosts public private login host port $ actions

58− exit

59−

60−--------------------------------------------------------------------------------

61−-- Azure tests --

62−--------------------------------------------------------------------------------

64−tryConnectToAzure :: String -> String -> String -> IO ()

17+tryConnectToAzure :: String -> String -> String -> String -> IO ()

65−tryConnectToAzure sid pathToCert pathToKey = do

18+tryConnectToAzure sid pathToCert pathToKey user = do

66 params <- defaultAzureParameters sid pathToCert pathToKey

19 params <- defaultAzureParameters sid pathToCert pathToKey

67− backend <- initializeBackend params

20+ backend <- initializeBackend params { azureSshUserName = user }

68 css <- cloudServices backend

21 css <- cloudServices backend

22+ let ch = head [ vm | vm <- concatMap cloudServiceVMs css

23+ , vmName vm == "CloudHaskell"

24+ ]

69− mapM_ print css

25+ print ch

26+ startOnVM backend ch