git.iko.soy/distributed-process
on master help sign in
Update to use modified libssh2
195023fEdsko de Vries
azure-service-api/src/Network/Azure/ServiceManagement/CommandLine.hs+12−45
@@ -2,7 +2,8 @@
2import Prelude hiding (catch)
2import Prelude hiding (catch)
3import System.Environment (getArgs, getEnv)
3import System.Environment (getArgs, getEnv)
4import System.IO (IOMode(ReadWriteMode), hClose)
4import System.IO (IOMode(ReadWriteMode), hClose)
5−import System.FilePath ((</>), takeFileName)
5+import System.FilePath ((</>))
6+import System.Posix.Types (Fd)
6import Data.IORef (IORef, writeIORef, readIORef, newIORef)
7import Data.IORef (IORef, writeIORef, readIORef, newIORef)
7import qualified Data.ByteString.Lazy.Char8 as BSLC (pack, putStrLn)
8import qualified Data.ByteString.Lazy.Char8 as BSLC (pack, putStrLn)
8import Control.Exception (SomeException, catch)
9import Control.Exception (SomeException, catch)
@@ -63,16 +64,14 @@ import Data.Certificate.X509 (X509)
63-- SSH
64-- SSH
64import Network.SSH.Client.LibSSH2
65import Network.SSH.Client.LibSSH2
65 ( withSSH2
66 ( withSSH2
66− , scpReceiveFile
67− , scpSendFile
68− , checkHost
69− , withSession
70 , readAllChannel
67 , readAllChannel
68+ , retryIfNeeded
69+ , Session
70+ , Channel
71 )
71 )
72import Network.SSH.Client.LibSSH2.Foreign
72import Network.SSH.Client.LibSSH2.Foreign
73 ( initialize
73 ( initialize
74 , exit
74 , exit
75− , publicKeyAuthFile
76 , channelExecute
75 , channelExecute
77 )
76 )
78import Codec.Binary.UTF8.String (decodeString)
77import Codec.Binary.UTF8.String (decodeString)
@@ -85,10 +84,6 @@ main = do
85 tryConnectToAzure subscriptionId pathToCert pathToKey
84 tryConnectToAzure subscriptionId pathToCert pathToKey
86 ["command", user, host, port, cmd] ->
85 ["command", user, host, port, cmd] ->
87 runCommand user host (read port) cmd
86 runCommand user host (read port) cmd
88− ["send", user, host, port, path] ->
89− sendFile user host (read port) path
90− ["receive", user, host, port, path] ->
91− receiveFile user host (read port) path
92 _ ->
87 _ ->
93 putStrLn "Invalid command line arguments"
88 putStrLn "Invalid command line arguments"
94
89
@@ -96,52 +91,24 @@ main = do
96-- Taken from libssh2/ssh-client --
91-- Taken from libssh2/ssh-client --
97--------------------------------------------------------------------------------
92--------------------------------------------------------------------------------
98
93
94+runCommand :: String -> String -> Int -> String -> IO ()
99runCommand login host port command =
95runCommand login host port command =
100− ssh login host port $ \ch -> do
96+ ssh login host port $ \fd s ch -> do
101− channelExecute ch command
97+ _ <- retryIfNeeded fd s $ channelExecute ch command
102− result <- readAllChannel ch
98+ result <- readAllChannel fd ch
103 let r = decodeString result
99 let r = decodeString result
104 print (length result)
100 print (length result)
105 print (length r)
101 print (length r)
106 putStrLn r
102 putStrLn r
107
103
108−sendFile login host port path = do
104+ssh :: String -> String -> Int -> (Fd -> Session -> Channel -> IO a) -> IO ()
109− initialize True
110− home <- getEnv "HOME"
111− let known_hosts = home </> ".ssh" </> "known_hosts"
112− public = home </> ".ssh" </> "id_rsa.pub"
113− private = home </> ".ssh" </> "id_rsa"
114−
115− withSession host port $ \_ s -> do
116− r <- checkHost s host port known_hosts
117− print r
118− publicKeyAuthFile s login public private ""
119− sz <- scpSendFile s 0o644 path (takeFileName path)
120− putStrLn $ "Sent: " ++ show sz ++ " bytes."
121− exit
122−
123−receiveFile login host port path = do
124− initialize True
125− home <- getEnv "HOME"
126− let known_hosts = home </> ".ssh" </> "known_hosts"
127− public = home </> ".ssh" </> "id_rsa.pub"
128− private = home </> ".ssh" </> "id_rsa"
129−
130− withSession host port $ \_ s -> do
131− r <- checkHost s host port known_hosts
132− print r
133− publicKeyAuthFile s login public private ""
134− sz <- scpReceiveFile s (takeFileName path) path
135− putStrLn $ "Received: " ++ show sz ++ " bytes."
136− exit
137−
138ssh login host port actions = do
105ssh login host port actions = do
139− initialize True
106+ _ <- initialize True
140 home <- getEnv "HOME"
107 home <- getEnv "HOME"
141 let known_hosts = home </> ".ssh" </> "known_hosts"
108 let known_hosts = home </> ".ssh" </> "known_hosts"
142 public = home </> ".ssh" </> "id_rsa.pub"
109 public = home </> ".ssh" </> "id_rsa.pub"
143 private = home </> ".ssh" </> "id_rsa"
110 private = home </> ".ssh" </> "id_rsa"
144− withSSH2 known_hosts public private login host port $ actions
111+ _ <- withSSH2 known_hosts public private login host port $ actions
145 exit
112 exit
146
113
147--------------------------------------------------------------------------------
114--------------------------------------------------------------------------------