Skip to content

Commit fb980ca

Browse files
edskoedsko
committed
Start adding SSH stuff
1 parent a81f853 commit fb980ca

File tree

4 files changed

+60
-66
lines changed

4 files changed

+60
-66
lines changed

‎azure-service-api/src/Network/Azure/ServiceManagement.hs

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -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

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -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

Lines changed: 37 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -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

1112
import System.Environment (getEnv)
1213
import System.FilePath ((</>))
1314
import System.Environment.Executable (getExecutablePath)
15+
import Control.Concurrent (threadDelay)
1416
import Network.Azure.ServiceManagement
15-
( CloudService )
17+
( CloudService(..)
18+
, VirtualMachine(..)
19+
, Endpoint(..)
20+
)
1621
import 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
2338
data Backend = Backend {
2439
-- | Find virtual machines
2540
cloudServices :: IO [CloudService]
41+
, startOnVM :: VirtualMachine -> IO ()
2642
}
2743

2844
data 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
4259
defaultAzureParameters 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

Lines changed: 16 additions & 59 deletions
Original file line numberDiff line numberDiff line change
@@ -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)
42
import 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-
2512
main :: IO ()
2613
main = 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

0 commit comments

Comments
 (0)