@@ -1,65 +1,17 @@
11-- Base
22import Prelude hiding (catch)
33import System.Environment (getArgs, getEnv)
4−import System.IO (IOMode(ReadWriteMode), hClose)
54import System.FilePath ((</>))
65import System.Posix.Types (Fd)
7−import Data.IORef (IORef, writeIORef, readIORef, newIORef)
8−import qualified Data.ByteString.Lazy.Char8 as BSLC (pack, putStrLn)
9−import Control.Exception (SomeException, catch)
6+import qualified Data.ByteString.Lazy.Char8 as BSLC (putStrLn)
107
118-- SSL
12−import qualified Crypto.Random.AESCtr as RNG (makeSystem)
13−import Network.Azure.ServiceManagement
14− ( fileReadCertificate
9+import Network.Azure.ServiceManagement
10+ ( SubscriptionId(SubscriptionId)
11+ , azureRequest
12+ , fileReadCertificate
1513 , fileReadPrivateKey
1614 )
17−import Network.Socket
18− ( socket
19− , Family(AF_INET)
20− , SocketType(Stream)
21− , defaultProtocol
22− , SockAddr(SockAddrInet)
23− , connect
24− , sClose
25− , socketToHandle
26− , HostName
27− , PortNumber
28− )
29−import Network.BSD (getHostByName, hostAddresses)
30−import Network.TLS
31− ( contextNewOnHandle
32− , Params
33− , Context
34− , defaultLogging
35− , loggingPacketSent
36− , loggingPacketRecv
37− , onCertificateRequest
38− , onCertificatesRecv
39− , pLogging
40− , pCertificates
41− , pCiphers
42− , pConnectVersion
43− , pAllowedVersions
44− , setSessionManager
45− , defaultParamsClient
46− , updateClientParams
47− , clientWantSessionResume
48− , Version(TLS10, TLS11, TLS12)
49− , SessionManager(sessionEstablish, sessionResume, sessionInvalidate)
50− , SessionID
51− , SessionData
52− , PrivateKey
53− , handshake
54− , sendData
55− , recvData'
56− , bye
57− )
58−import Network.TLS.Extra
59− ( certificateVerifyChain
60− , ciphersuite_all
61− )
62−import Data.Certificate.X509 (X509)
6315
6416-- SSH
6517import Network.SSH.Client.LibSSH2
@@ -116,68 +68,8 @@ ssh login host port actions = do
11668--------------------------------------------------------------------------------
11769
11870tryConnectToAzure :: String -> String -> String -> IO ()
119−tryConnectToAzure subscriptionId pathToCert pathToKey = do
71+tryConnectToAzure sid pathToCert pathToKey = do
12072 cert <- fileReadCertificate pathToCert
12173 key <- fileReadPrivateKey pathToKey
122− sessionState <- newIORef undefined
123− let hostname = "management.core.windows.net"
124− let port = 443
125− runTLS (getDefaultParams sessionState [(cert, Just key)]) hostname port $ \ctx -> do
126− handshake ctx
127− sendData ctx $ BSLC.pack $ concat
128− [ "GET /" ++ subscriptionId ++ "/services/hostedservices HTTP/1.1\r\n"
129− , "host: " ++ hostname ++ "\r\n"
130− , "content-type: application/xml\r\n"
131− , "x-ms-version: 2010-10-28\r\n"
132− , "\r\n"
133− ]
134− d <- recvData' ctx
135− bye ctx
136− BSLC.putStrLn d
137−
138−runTLS :: Params -> HostName -> PortNumber -> (Context -> IO a) -> IO ()
139−runTLS params hostname portNumber f = do
140− rng <- RNG.makeSystem
141− he <- getHostByName hostname
142− sock <- socket AF_INET Stream defaultProtocol
143− let sockaddr = SockAddrInet portNumber (head $ hostAddresses he)
144− catch (connect sock sockaddr)
145− (\(e :: SomeException) -> sClose sock >> error ("cannot open socket " ++ show sockaddr ++ " " ++ show e))
146− dsth <- socketToHandle sock ReadWriteMode
147− ctx <- contextNewOnHandle dsth params rng
148− _ <- f ctx
149− hClose dsth
150−
151−getDefaultParams :: IORef (SessionID, SessionData)
152− -> [(X509, Maybe PrivateKey)]
153− -> Params
154−getDefaultParams sessionState certs =
155− updateClientParams setCParams $ setSessionManager (SessionRef sessionState) $ defaultParamsClient
156− { pConnectVersion = TLS10
157− , pAllowedVersions = [TLS10,TLS11,TLS12]
158− , pCiphers = ciphersuite_all
159− , pCertificates = certs
160− , pLogging = logging
161− , onCertificatesRecv = crecv
162− }
163− where
164− setCParams cparams = cparams { clientWantSessionResume = Nothing
165− , onCertificateRequest = creq
166− }
167− logging = defaultLogging
168− { loggingPacketSent = putStrLn . ("debug: >> " ++)
169− , loggingPacketRecv = putStrLn . ("debug: << " ++)
170− }
171− crecv = certificateVerifyChain
172− creq _ = return certs
173−
174−data SessionRef = SessionRef (IORef (SessionID, SessionData))
175−
176−instance SessionManager SessionRef where
177− sessionEstablish (SessionRef ref) sid sdata =
178− writeIORef ref (sid,sdata)
179− sessionResume (SessionRef ref) sid = do
180− (s, d) <- readIORef ref
181− if s == sid then return (Just d) else return Nothing
182− sessionInvalidate _ _ =
183− return ()
74+ outp <- azureRequest (SubscriptionId sid) cert key "/services/hostedservices"
75+ BSLC.putStrLn outp