@@ -1,9 +1,13 @@
1+-- Base
12import Prelude hiding (catch)
2−import System.Environment (getArgs)
3+import System.Environment (getArgs, getEnv)
34import System.IO (IOMode(ReadWriteMode), hClose)
5+import System.FilePath ((</>), takeFileName)
46import Data.IORef (IORef, writeIORef, readIORef, newIORef)
57import qualified Data.ByteString.Lazy.Char8 as BSLC (pack, putStrLn)
68import Control.Exception (SomeException, catch)
9+
10+-- SSL
711import qualified Crypto.Random.AESCtr as RNG (makeSystem)
812import Network.Azure.ServiceManagement
913 ( fileReadCertificate
@@ -56,9 +60,96 @@ import Network.TLS.Extra
5660 )
5761import Data.Certificate.X509 (X509)
5862
63+-- SSH
64+import Network.SSH.Client.LibSSH2
65+ ( withSSH2
66+ , scpReceiveFile
67+ , scpSendFile
68+ , checkHost
69+ , withSession
70+ , readAllChannel
71+ )
72+import Network.SSH.Client.LibSSH2.Foreign
73+ ( initialize
74+ , exit
75+ , publicKeyAuthFile
76+ , channelExecute
77+ )
78+import Codec.Binary.UTF8.String (decodeString)
79+
5980main :: IO ()
6081main = do
61− [subscriptionId, pathToCert, pathToKey] <- getArgs
82+ args <- getArgs
83+ case args of
84+ ["azure", subscriptionId, pathToCert, pathToKey] ->
85+ tryConnectToAzure subscriptionId pathToCert pathToKey
86+ ["command", user, host, port, cmd] ->
87+ 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+ _ ->
93+ putStrLn "Invalid command line arguments"
94+
95+--------------------------------------------------------------------------------
96+-- Taken from libssh2/ssh-client --
97+--------------------------------------------------------------------------------
98+
99+runCommand login host port command =
100+ ssh login host port $ \ch -> do
101+ channelExecute ch command
102+ result <- readAllChannel ch
103+ let r = decodeString result
104+ print (length result)
105+ print (length r)
106+ putStrLn r
107+
108+sendFile login host port path = do
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+
138+ssh login host port actions = do
139+ initialize True
140+ home <- getEnv "HOME"
141+ let known_hosts = home </> ".ssh" </> "known_hosts"
142+ public = home </> ".ssh" </> "id_rsa.pub"
143+ private = home </> ".ssh" </> "id_rsa"
144+ withSSH2 known_hosts public private login host port $ actions
145+ exit
146+
147+--------------------------------------------------------------------------------
148+-- Taken from tls-debug/src/SimpleClient.hs --
149+--------------------------------------------------------------------------------
150+
151+tryConnectToAzure :: String -> String -> String -> IO ()
152+tryConnectToAzure subscriptionId pathToCert pathToKey = do
62153 cert <- fileReadCertificate pathToCert
63154 key <- fileReadPrivateKey pathToKey
64155 sessionState <- newIORef undefined
@@ -77,10 +168,6 @@ main = do
77168 bye ctx
78169 BSLC.putStrLn d
79170
80−--------------------------------------------------------------------------------
81−-- Taken from tls-debug/src/SimpleClient.hs --
82−--------------------------------------------------------------------------------
83−
84171runTLS :: Params -> HostName -> PortNumber -> (Context -> IO a) -> IO ()
85172runTLS params hostname portNumber f = do
86173 rng <- RNG.makeSystem