@@ -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)
64import Network.SSH.Client.LibSSH2
65import Network.SSH.Client.LibSSH2
65 ( withSSH2
66 ( withSSH2
70 , readAllChannel
67 , readAllChannel
72import Network.SSH.Client.LibSSH2.Foreign
72import Network.SSH.Client.LibSSH2.Foreign
73 ( initialize
73 ( initialize
76 , channelExecute
75 , channelExecute
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
93 putStrLn "Invalid command line arguments"
88 putStrLn "Invalid command line arguments"
@@ -96,52 +91,24 @@ main = do
96-- Taken from libssh2/ssh-client --
91-- Taken from libssh2/ssh-client --
97--------------------------------------------------------------------------------
92--------------------------------------------------------------------------------
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
108−sendFile login host port path = do
104+ssh :: String -> String -> Int -> (Fd -> Session -> Channel -> IO a) -> IO ()
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"
115− withSession host port $ \_ s -> do
116− r <- checkHost s host port known_hosts
118− publicKeyAuthFile s login public private ""
119− sz <- scpSendFile s 0o644 path (takeFileName path)
120− putStrLn $ "Sent: " ++ show sz ++ " bytes."
123−receiveFile login host port path = do
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"
130− withSession host port $ \_ s -> do
131− r <- checkHost s host port known_hosts
133− publicKeyAuthFile s login public private ""
134− sz <- scpReceiveFile s (takeFileName path) path
135− putStrLn $ "Received: " ++ show sz ++ " bytes."
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
147--------------------------------------------------------------------------------
114--------------------------------------------------------------------------------