git.iko.soy/distributed-process
on master help sign in
Start adding SSH stuff
commitfb980cae57f1afd15745551ec19e2e4acec043ed authorEdsko de Vries <edsko@well-typed.com> dateFri 27 Jul 2012, 17:25 (14 years ago) parenta81f853
4 files changed+60−66
compare with master
unifiedsplit
azure-service-api/src/Network/Azure/ServiceManagement.hs+5−5 distributed-process-azure/distributed-process-azure.cabal+2−1 distributed-process-azure/src/Control/Distributed/Process/Backend/Azure.hs+37−1 distributed-process-azure/src/Control/Distributed/Process/Backend/Azure/CommandLine.hs+16−59
azure-service-api/src/Network/Azure/ServiceManagement.hs+5−5
@@ -6,7 +6,7 @@ module Network.Azure.ServiceManagement
66 , VirtualMachine(..)
77 , Endpoint(..)
88 -- * Pure functions
9− , cloudServiceSshEndpoints
9+ , vmSshEndpoint
1010 -- * Setup
1111 , AzureSetup(..)
1212 , azureSetup
@@ -81,10 +81,10 @@ data Endpoint = Endpoint {
8181-- Pure operations --
8282--------------------------------------------------------------------------------
8383
84−cloudServiceSshEndpoints :: CloudService -> [Endpoint]
85−cloudServiceSshEndpoints cs =
86− [ ep
87− | ep <- concatMap vmInputEndpoints (cloudServiceVMs cs)
84+vmSshEndpoint :: VirtualMachine -> Endpoint
85+vmSshEndpoint vm = head
86+ [ ep
87+ | ep <- vmInputEndpoints vm
8888 , endpointName ep == "SSH"
8989 ]
9090
distributed-process-azure/distributed-process-azure.cabal+2−1
@@ -22,7 +22,8 @@ Library
2222 Build-Depends: base >= 4.4 && < 5,
2323 azure-service-api >= 0.1 && < 0.2,
2424 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
2627 Exposed-modules: Control.Distributed.Process.Backend.Azure
2728 ghc-options: -Wall
2829 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
66 , initializeBackend
77 -- * Re-exports from Azure Service Management
88 , CloudService(..)
9+ , VirtualMachine(..)
910 ) where
1011
1112import System.Environment (getEnv)
1213import System.FilePath ((</>))
1314import System.Environment.Executable (getExecutablePath)
15+import Control.Concurrent (threadDelay)
1416import Network.Azure.ServiceManagement
15− ( CloudService )
17+ ( CloudService(..)
18+ , VirtualMachine(..)
19+ , Endpoint(..)
20+ )
1621import qualified Network.Azure.ServiceManagement as Azure
1722 ( cloudServices
1823 , AzureSetup
1924 , azureSetup
25+ , vmSshEndpoint
2026 )
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+ )
2136
2237-- | Azure backend
2338data Backend = Backend {
2439 -- | Find virtual machines
2540 cloudServices :: IO [CloudService]
41+ , startOnVM :: VirtualMachine -> IO ()
2642 }
2743
2844data AzureParameters = AzureParameters {
2945 azureSubscriptionId :: String
3046 , azureAuthCertificate :: FilePath
3147 , azureAuthPrivateKey :: FilePath
48+ , azureSshUserName :: FilePath
3249 , azureSshPublicKey :: FilePath
3350 , azureSshPrivateKey :: FilePath
3451 , azureSshKnownHosts :: FilePath
@@ -41,10 +58,12 @@ defaultAzureParameters :: String -- ^ Azure subscription ID
4158 -> IO AzureParameters
4259defaultAzureParameters sid x509 pkey = do
4360 home <- getEnv "HOME"
61+ user <- getEnv "USER"
4462 return AzureParameters
4563 { azureSubscriptionId = sid
4664 , azureAuthCertificate = x509
4765 , azureAuthPrivateKey = pkey
66+ , azureSshUserName = user
4867 , azureSshPublicKey = home </> ".ssh" </> "id_rsa.pub"
4968 , azureSshPrivateKey = home </> ".ssh" </> "id_rsa"
5069 , azureSshKnownHosts = home </> ".ssh" </> "known_hosts"
@@ -60,4 +79,21 @@ initializeBackend params = do
6079 print exe
6180 return Backend {
6281 cloudServices = Azure.cloudServices setup
82+ , startOnVM = apiStartOnVM params
6383 }
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)
2−import System.FilePath ((</>))
3−import System.Posix.Types (Fd)
1+import System.Environment (getArgs)
42import Control.Distributed.Process.Backend.Azure
5− ( defaultAzureParameters
3+ ( AzureParameters(azureSshUserName)
4+ , defaultAzureParameters
65 , initializeBackend
76 , cloudServices
7+ , CloudService(cloudServiceVMs)
8+ , VirtualMachine(vmName)
9+ , startOnVM
810 )
911
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−
2512main :: IO ()
2613main = do
27− args <- getArgs
28− case args of
29− ["azure", subscriptionId, pathToCert, pathToKey] ->
30− tryConnectToAzure subscriptionId pathToCert pathToKey
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−--------------------------------------------------------------------------------
14+ [subscriptionId, pathToCert, pathToKey, user] <- getArgs
15+ tryConnectToAzure subscriptionId pathToCert pathToKey user
6316
64−tryConnectToAzure :: String -> String -> String -> IO ()
65−tryConnectToAzure sid pathToCert pathToKey = do
17+tryConnectToAzure :: String -> String -> String -> String -> IO ()
18+tryConnectToAzure sid pathToCert pathToKey user = do
6619 params <- defaultAzureParameters sid pathToCert pathToKey
67− backend <- initializeBackend params
20+ backend <- initializeBackend params { azureSshUserName = user }
6821 css <- cloudServices backend
69− mapM_ print css
22+ let ch = head [ vm | vm <- concatMap cloudServiceVMs css
23+ , vmName vm == "CloudHaskell"
24+ ]
25+ print ch
26+ startOnVM backend ch