git.iko.soy/distributed-process
on master help sign in
Add MD5 check
b3fe2fbEdsko de Vries
distributed-process-azure/distributed-process-azure.cabal+3−1
compare with master
unifiedsplit
@@ -23,7 +23,9 @@ Library
23 azure-service-api >= 0.1 && < 0.2,
23 azure-service-api >= 0.1 && < 0.2,
24 filepath >= 1.3 && < 1.4,
24 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
26+ libssh2 >= 0.2 && < 0.3,
27+ pureMD5 >= 2.1 && < 2.2,
28+ bytestring >= 0.9 && < 0.11
27 Exposed-modules: Control.Distributed.Process.Backend.Azure
29 Exposed-modules: Control.Distributed.Process.Backend.Azure
28 Extensions: ViewPatterns
30 Extensions: ViewPatterns
29 ghc-options: -Wall
31 ghc-options: -Wall
distributed-process-azure/src/Control/Distributed/Process/Backend/Azure.hs+46−8
@@ -12,6 +12,9 @@ module Control.Distributed.Process.Backend.Azure
12import System.Environment (getEnv)
12import System.Environment (getEnv)
13import System.FilePath ((</>), takeFileName)
13import System.FilePath ((</>), takeFileName)
14import System.Environment.Executable (getExecutablePath)
14import System.Environment.Executable (getExecutablePath)
15+import Data.Digest.Pure.MD5 (md5, MD5Digest)
16+import qualified Data.ByteString.Lazy as BSL (readFile)
17+import Control.Applicative ((<$>))
15import Network.Azure.ServiceManagement
18import Network.Azure.ServiceManagement
16 ( CloudService(..)
19 ( CloudService(..)
17 , VirtualMachine(..)
20 , VirtualMachine(..)
@@ -26,17 +29,25 @@ import qualified Network.SSH.Client.LibSSH2 as SSH
26 ( withSSH2
29 ( withSSH2
27 , execCommands
30 , execCommands
28 , scpSendFile
31 , scpSendFile
32+ , withChannel
33+ , readAllChannel
29 )
34 )
30import qualified Network.SSH.Client.LibSSH2.Foreign as SSH
35import qualified Network.SSH.Client.LibSSH2.Foreign as SSH
31 ( initialize
36 ( initialize
32 , exit
37 , exit
38+ , openChannelSession
39+ , retryIfNeeded
40+ , channelExecute
41+ , writeChannel
42+ , channelSendEOF
33 )
43 )
34
44
35-- | Azure backend
45-- | Azure backend
36data Backend = Backend {
46data Backend = Backend {
37 -- | Find virtual machines
47 -- | Find virtual machines
38 cloudServices :: IO [CloudService]
48 cloudServices :: IO [CloudService]
39− , startOnVM :: VirtualMachine -> IO ()
49+ , copyToVM :: VirtualMachine -> IO ()
50+ , checkMD5 :: VirtualMachine -> IO Bool
40 }
51 }
41
52
42data AzureParameters = AzureParameters {
53data AzureParameters = AzureParameters {
@@ -49,6 +60,7 @@ data AzureParameters = AzureParameters {
49 , azureSshPassphrase :: String
60 , azureSshPassphrase :: String
50 , azureSshKnownHosts :: FilePath
61 , azureSshKnownHosts :: FilePath
51 , azureSshRemotePath :: FilePath
62 , azureSshRemotePath :: FilePath
63+ , azureSshLocalPath :: FilePath
52 }
64 }
53
65
54-- | Create default azure parameters
66-- | Create default azure parameters
@@ -70,6 +82,7 @@ defaultAzureParameters sid x509 pkey = do
70 , azureSshPassphrase = ""
82 , azureSshPassphrase = ""
71 , azureSshKnownHosts = home </> ".ssh" </> "known_hosts"
83 , azureSshKnownHosts = home </> ".ssh" </> "known_hosts"
72 , azureSshRemotePath = takeFileName self
84 , azureSshRemotePath = takeFileName self
85+ , azureSshLocalPath = self
73 }
86 }
74
87
75-- | Initialize the backend
88-- | Initialize the backend
@@ -80,13 +93,13 @@ initializeBackend params = do
80 (azureAuthPrivateKey params)
93 (azureAuthPrivateKey params)
81 return Backend {
94 return Backend {
82 cloudServices = Azure.cloudServices setup
95 cloudServices = Azure.cloudServices setup
83− , startOnVM = apiStartOnVM params
96+ , copyToVM = apiCopyToVM params
97+ , checkMD5 = apiCheckMD5 params
84 }
98 }
85
99
86-- | Start a CH node on the given virtual machine
100-- | Start a CH node on the given virtual machine
87−apiStartOnVM :: AzureParameters -> VirtualMachine -> IO ()
101+apiCopyToVM :: AzureParameters -> VirtualMachine -> IO ()
88−apiStartOnVM params (Azure.vmSshEndpoint -> Just ep) = do
102+apiCopyToVM params (Azure.vmSshEndpoint -> Just ep) = do
89− self <- getExecutablePath
90 _ <- SSH.initialize True
103 _ <- SSH.initialize True
91 _ <- SSH.withSSH2 (azureSshKnownHosts params)
104 _ <- SSH.withSSH2 (azureSshKnownHosts params)
92 (azureSshPublicKey params)
105 (azureSshPublicKey params)
@@ -95,8 +108,33 @@ apiStartOnVM params (Azure.vmSshEndpoint -> Just ep) = do
95 (azureSshUserName params)
108 (azureSshUserName params)
96 (endpointVip ep)
109 (endpointVip ep)
97 (read $ endpointPort ep) $ \fd s -> do
110 (read $ endpointPort ep) $ \fd s -> do
98− SSH.scpSendFile fd s 0o700 self (azureSshRemotePath params)
111+ SSH.scpSendFile fd s 0o700 (azureSshLocalPath params) (azureSshRemotePath params)
99 -- SSH.execCommands fd s ["nohup /home/edsko/testservice >/dev/null 2>&1 &"]
112 -- SSH.execCommands fd s ["nohup /home/edsko/testservice >/dev/null 2>&1 &"]
100 SSH.exit
113 SSH.exit
101−apiStartOnVM _ _ =
114+apiCopyToVM _ _ =
102− error "startOnVM: No SSH endpoint"
115+ error "copyToVM: No SSH endpoint"
116+
117+apiCheckMD5 :: AzureParameters -> VirtualMachine -> IO Bool
118+apiCheckMD5 params (Azure.vmSshEndpoint -> Just ep) = do
119+ hash <- localHash params
120+ _ <- SSH.initialize True
121+ match <- SSH.withSSH2 (azureSshKnownHosts params)
122+ (azureSshPublicKey params)
123+ (azureSshPrivateKey params)
124+ (azureSshPassphrase params)
125+ (azureSshUserName params)
126+ (endpointVip ep)
127+ (read $ endpointPort ep) $ \fd s -> do
128+ (r, _) <- SSH.withChannel (SSH.openChannelSession s) id fd s $ \ch -> do
129+ SSH.retryIfNeeded fd s $ SSH.channelExecute ch ("md5sum -c --status")
130+ SSH.writeChannel ch $ show hash ++ " " ++ azureSshRemotePath params
131+ SSH.channelSendEOF ch
132+ SSH.readAllChannel fd ch
133+ return (r == 0)
134+ SSH.exit
135+ return match
136+apiCheckMD5 _ _ =
137+ error "checkMD5: No SSH endpoint"
138+
139+localHash :: AzureParameters -> IO MD5Digest
140+localHash params = md5 <$> BSL.readFile (azureSshLocalPath params)
distributed-process-azure/src/Control/Distributed/Process/Backend/Azure/CommandLine.hs+59−13
@@ -1,5 +1,7 @@
1{-# LANGUAGE Arrows #-}
1{-# LANGUAGE Arrows #-}
2import System.Environment (getArgs)
2import System.Environment (getArgs)
3+import System.Exit (exitSuccess, exitFailure)
4+import Control.Monad (unless)
3import Control.Distributed.Process.Backend.Azure
5import Control.Distributed.Process.Backend.Azure
4 ( AzureParameters(azureSshUserName)
6 ( AzureParameters(azureSshUserName)
5 , defaultAzureParameters
7 , defaultAzureParameters
@@ -7,7 +9,7 @@ import Control.Distributed.Process.Backend.Azure
7 , cloudServices
9 , cloudServices
8 , CloudService(cloudServiceVMs)
10 , CloudService(cloudServiceVMs)
9 , VirtualMachine(vmName)
11 , VirtualMachine(vmName)
10− , startOnVM
12+ , Backend(copyToVM, checkMD5)
11 )
13 )
12import Control.Arrow (returnA)
14import Control.Arrow (returnA)
13import Control.Applicative ((<$>), (<*>))
15import Control.Applicative ((<$>), (<*>))
@@ -26,6 +28,7 @@ import Options.Applicative
26 , helper
28 , helper
27 , fullDesc
29 , fullDesc
28 , header
30 , header
31+ , switch
29 )
32 )
30import Options.Applicative.Arrows (runA, asA)
33import Options.Applicative.Arrows (runA, asA)
31
34
@@ -46,8 +49,20 @@ data SshOptions = SshOptions {
46 deriving Show
49 deriving Show
47
50
48data Command =
51data Command =
52+ List {
53+ azureOptions :: AzureOptions
54+ }
55+ | CopyTo {
49− List AzureOptions
56+ azureOptions :: AzureOptions
57+ , sshOptions :: SshOptions
58+ , virtualMachine :: String
59+ }
60+ | CheckMD5 {
50− | Start AzureOptions SshOptions String
61+ azureOptions :: AzureOptions
62+ , sshOptions :: SshOptions
63+ , virtualMachine :: String
64+ , status :: Bool
65+ }
51 deriving Show
66 deriving Show
52
67
53azureOptionsParser :: Parser AzureOptions
68azureOptionsParser :: Parser AzureOptions
@@ -75,8 +90,8 @@ sshOptionsParser = SshOptions
75listParser :: Parser Command
90listParser :: Parser Command
76listParser = List <$> azureOptionsParser
91listParser = List <$> azureOptionsParser
77
92
78−startParser :: Parser Command
93+copyToParser :: Parser Command
79−startParser = Start
94+copyToParser = CopyTo
80 <$> azureOptionsParser
95 <$> azureOptionsParser
81 <*> sshOptionsParser
96 <*> sshOptionsParser
82 <*> strOption ( long "vm"
97 <*> strOption ( long "vm"
@@ -84,12 +99,26 @@ startParser = Start
84 & help "Virtual machine name"
99 & help "Virtual machine name"
85 )
100 )
86
101
102+checkMD5Parser :: Parser Command
103+checkMD5Parser = CheckMD5
104+ <$> azureOptionsParser
105+ <*> sshOptionsParser
106+ <*> strOption ( long "vm"
107+ & metavar "VM"
108+ & help "Virtual machine name"
109+ )
110+ <*> switch ( long "status"
111+ & help "Don't output anything, status code shows success"
112+ )
113+
87commandParser :: Parser Command
114commandParser :: Parser Command
88commandParser = subparser
115commandParser = subparser
89 ( command "list" (info listParser
116 ( command "list" (info listParser
90 (progDesc "List Azure cloud services"))
117 (progDesc "List Azure cloud services"))
91− & command "start" (info startParser
118+ & command "install" (info copyToParser
92− (progDesc "Start a new Cloud Haskell node"))
119+ (progDesc "Install the executable on a virtual machine"))
120+ & command "md5" (info checkMD5Parser
121+ (progDesc "Check if the remote and local MD5 hash match"))
93 )
122 )
94
123
95--------------------------------------------------------------------------------
124--------------------------------------------------------------------------------
@@ -100,20 +129,37 @@ main :: IO ()
100main = do
129main = do
101 cmd <- execParser opts
130 cmd <- execParser opts
102 case cmd of
131 case cmd of
103− List azureOpts -> do
132+ List {} -> do
104− params <- azureParameters azureOpts Nothing
133+ params <- azureParameters (azureOptions cmd) Nothing
105 backend <- initializeBackend params
134 backend <- initializeBackend params
106 css <- cloudServices backend
135 css <- cloudServices backend
107 mapM_ print css
136 mapM_ print css
108− Start azureOpts sshOpts name -> do
137+ CopyTo {} -> do
109− params <- azureParameters azureOpts (Just sshOpts)
138+ params <- azureParameters (azureOptions cmd) (Just (sshOptions cmd))
110 backend <- initializeBackend params
139 backend <- initializeBackend params
111 css <- cloudServices backend
140 css <- cloudServices backend
112 let ch = head [ vm | vm <- concatMap cloudServiceVMs css
141 let ch = head [ vm | vm <- concatMap cloudServiceVMs css
113− , vmName vm == name
142+ , vmName vm == virtualMachine cmd
114 ]
143 ]
115 print ch
144 print ch
116− startOnVM backend ch
145+ copyToVM backend ch
146+ CheckMD5 {} -> do
147+ params <- azureParameters (azureOptions cmd) (Just (sshOptions cmd))
148+ backend <- initializeBackend params
149+ css <- cloudServices backend
150+ let ch = head [ vm | vm <- concatMap cloudServiceVMs css
151+ , vmName vm == virtualMachine cmd
152+ ]
153+ match <- checkMD5 backend ch
154+ if match
155+ then do
156+ unless (status cmd) $
157+ putStrLn "Local and remote MD5 hash match"
158+ exitSuccess
159+ else do
160+ unless (status cmd) $
161+ putStrLn "Local and remote MD5 hash do NOT match"
162+ exitFailure
117 where
163 where
118 opts = info (helper <*> commandParser)
164 opts = info (helper <*> commandParser)
119 ( fullDesc
165 ( fullDesc