Revision 588d0ee4
b/Makefile.am | ||
---|---|---|
772 | 772 |
test/hs/Test/Ganeti/JSON.hs \ |
773 | 773 |
test/hs/Test/Ganeti/Jobs.hs \ |
774 | 774 |
test/hs/Test/Ganeti/JQueue.hs \ |
775 |
test/hs/Test/Ganeti/Kvmd.hs \ |
|
775 | 776 |
test/hs/Test/Ganeti/Luxi.hs \ |
776 | 777 |
test/hs/Test/Ganeti/Network.hs \ |
777 | 778 |
test/hs/Test/Ganeti/Objects.hs \ |
b/test/hs/Test/Ganeti/Kvmd.hs | ||
---|---|---|
1 |
{-# LANGUAGE TemplateHaskell #-} |
|
2 |
{-| Unittests for the KVM daemon. |
|
3 |
|
|
4 |
-} |
|
5 |
|
|
6 |
{- |
|
7 |
|
|
8 |
Copyright (C) 2013 Google Inc. |
|
9 |
|
|
10 |
This program is free software; you can redistribute it and/or modify |
|
11 |
it under the terms of the GNU General Public License as published by |
|
12 |
the Free Software Foundation; either version 2 of the License, or |
|
13 |
(at your option) any later version. |
|
14 |
|
|
15 |
This program is distributed in the hope that it will be useful, but |
|
16 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
|
17 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
18 |
General Public License for more details. |
|
19 |
|
|
20 |
You should have received a copy of the GNU General Public License |
|
21 |
along with this program; if not, write to the Free Software |
|
22 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
|
23 |
02110-1301, USA. |
|
24 |
|
|
25 |
-} |
|
26 |
|
|
27 |
module Test.Ganeti.Kvmd (testKvmd) where |
|
28 |
|
|
29 |
import Control.Concurrent |
|
30 |
import Control.Exception (try) |
|
31 |
import qualified Network.Socket as Socket |
|
32 |
import System.Directory |
|
33 |
import System.FilePath |
|
34 |
import System.IO |
|
35 |
|
|
36 |
import qualified Ganeti.Kvmd as Kvmd |
|
37 |
import qualified Ganeti.UDSServer as UDSServer |
|
38 |
import Test.HUnit as HUnit |
|
39 |
|
|
40 |
import qualified Test.Ganeti.TestHelper as TestHelper (testSuite) |
|
41 |
import qualified Test.Ganeti.TestCommon as TestCommon (getTempFileName) |
|
42 |
|
|
43 |
import qualified Ganeti.Logging as Logging |
|
44 |
|
|
45 |
{-# ANN module "HLint: ignore Use camelCase" #-} |
|
46 |
|
|
47 |
startKvmd :: FilePath -> IO ThreadId |
|
48 |
startKvmd dir = |
|
49 |
forkIO (do Logging.setupLogging Nothing "ganeti-kvmd" False False |
|
50 |
False Logging.SyslogNo |
|
51 |
Kvmd.startWith dir) |
|
52 |
|
|
53 |
stopKvmd :: ThreadId -> IO () |
|
54 |
stopKvmd = killThread |
|
55 |
|
|
56 |
delayKvmd :: IO () |
|
57 |
delayKvmd = threadDelay 1000000 |
|
58 |
|
|
59 |
detectShutdown :: (Handle -> IO ()) -> IO Bool |
|
60 |
detectShutdown putFn = |
|
61 |
do monitorDir <- TestCommon.getTempFileName "ganeti" |
|
62 |
let monitor = "instance.qmp" |
|
63 |
monitorFile = monitorDir </> monitor |
|
64 |
shutdownFile = Kvmd.shutdownPath monitorFile |
|
65 |
-- ensure the KVM directory exists |
|
66 |
createDirectoryIfMissing True monitorDir |
|
67 |
-- ensure the shutdown file does not exist |
|
68 |
(try (removeFile shutdownFile) :: IO (Either IOError ())) >> return () |
|
69 |
-- start KVM daemon |
|
70 |
threadId <- startKvmd monitorDir |
|
71 |
threadDelay 1000 |
|
72 |
-- create a Unix socket |
|
73 |
sock <- UDSServer.openServerSocket monitorFile |
|
74 |
Socket.listen sock 1 |
|
75 |
handle <- UDSServer.acceptSocket sock |
|
76 |
-- read 'qmp_capabilities' message |
|
77 |
res <- try . hGetLine $ handle :: IO (Either IOError String) |
|
78 |
case res of |
|
79 |
Left err -> |
|
80 |
assertFailure $ "Expecting " ++ show Kvmd.monitorGreeting ++ |
|
81 |
", received " ++ show err |
|
82 |
Right str -> Kvmd.monitorGreeting @=? str |
|
83 |
-- send Qmp messages |
|
84 |
putFn handle |
|
85 |
hFlush handle |
|
86 |
-- close the Unix socket |
|
87 |
UDSServer.closeClientSocket handle |
|
88 |
UDSServer.closeServerSocket sock monitorFile |
|
89 |
-- KVM needs time to create the shutdown file |
|
90 |
delayKvmd |
|
91 |
-- stop the KVM daemon |
|
92 |
stopKvmd threadId |
|
93 |
-- check for shutdown file |
|
94 |
doesFileExist shutdownFile |
|
95 |
|
|
96 |
case_DetectAdminShutdown :: Assertion |
|
97 |
case_DetectAdminShutdown = |
|
98 |
do res <- detectShutdown putMessage |
|
99 |
assertBool "Detected user shutdown instead of administrator shutdown" $ |
|
100 |
not res |
|
101 |
where putMessage handle = |
|
102 |
do hPrint handle "POWERDOWN" |
|
103 |
hPrint handle "SHUTDOWN" |
|
104 |
|
|
105 |
case_DetectUserShutdown :: Assertion |
|
106 |
case_DetectUserShutdown = |
|
107 |
do res <- detectShutdown putMessage |
|
108 |
assertBool "Detected administrator shutdown instead of user shutdown" res |
|
109 |
where putMessage handle = |
|
110 |
hPrint handle "SHUTDOWN" |
|
111 |
|
|
112 |
TestHelper.testSuite "Kvmd" |
|
113 |
[ 'case_DetectAdminShutdown |
|
114 |
, 'case_DetectUserShutdown |
|
115 |
] |
b/test/hs/Test/Ganeti/Luxi.hs | ||
---|---|---|
36 | 36 |
import Control.Applicative |
37 | 37 |
import Control.Concurrent (forkIO) |
38 | 38 |
import Control.Exception (bracket) |
39 |
import System.Directory (getTemporaryDirectory, removeFile) |
|
40 |
import System.IO (hClose, openTempFile) |
|
41 | 39 |
import qualified Text.JSON as J |
42 | 40 |
|
43 | 41 |
import Test.Ganeti.TestHelper |
... | ... | |
100 | 98 |
prop_CallEncoding op = |
101 | 99 |
(US.parseCall (Luxi.buildCall op) >>= uncurry Luxi.decodeLuxiCall) ==? Ok op |
102 | 100 |
|
103 |
-- | Helper to a get a temporary file name. |
|
104 |
getTempFileName :: IO FilePath |
|
105 |
getTempFileName = do |
|
106 |
tempdir <- getTemporaryDirectory |
|
107 |
(fpath, handle) <- openTempFile tempdir "luxitest" |
|
108 |
_ <- hClose handle |
|
109 |
removeFile fpath |
|
110 |
return fpath |
|
111 |
|
|
112 | 101 |
-- | Server ping-pong helper. |
113 | 102 |
luxiServerPong :: Luxi.Client -> IO () |
114 | 103 |
luxiServerPong c = do |
... | ... | |
128 | 117 |
prop_ClientServer :: [[DNSChar]] -> Property |
129 | 118 |
prop_ClientServer dnschars = monadicIO $ do |
130 | 119 |
let msgs = map (map dnsGetChar) dnschars |
131 |
fpath <- run getTempFileName
|
|
120 |
fpath <- run $ getTempFileName "luxitest"
|
|
132 | 121 |
-- we need to create the server first, otherwise (if we do it in the |
133 | 122 |
-- forked thread) the client could try to connect to it before it's |
134 | 123 |
-- ready |
b/test/hs/Test/Ganeti/TestCommon.hs | ||
---|---|---|
66 | 66 |
, genPropParser |
67 | 67 |
, genNonNegative |
68 | 68 |
, relativeError |
69 |
, getTempFileName |
|
69 | 70 |
) where |
70 | 71 |
|
71 | 72 |
import Control.Applicative |
... | ... | |
76 | 77 |
import Data.Text (pack) |
77 | 78 |
import Data.Word |
78 | 79 |
import qualified Data.Set as Set |
80 |
import System.Directory (getTemporaryDirectory, removeFile) |
|
79 | 81 |
import System.Environment (getEnv) |
80 | 82 |
import System.Exit (ExitCode(..)) |
83 |
import System.IO (hClose, openTempFile) |
|
81 | 84 |
import System.IO.Error (isDoesNotExistError) |
82 | 85 |
import System.Process (readProcessWithExitCode) |
83 | 86 |
import qualified Test.HUnit as HUnit |
... | ... | |
421 | 424 |
in if delta == 0 |
422 | 425 |
then 0 |
423 | 426 |
else delta / greatest |
427 |
|
|
428 |
-- | Helper to a get a temporary file name. |
|
429 |
getTempFileName :: String -> IO FilePath |
|
430 |
getTempFileName filename = do |
|
431 |
tempdir <- getTemporaryDirectory |
|
432 |
(fpath, handle) <- openTempFile tempdir filename |
|
433 |
_ <- hClose handle |
|
434 |
removeFile fpath |
|
435 |
return fpath |
b/test/hs/htest.hs | ||
---|---|---|
55 | 55 |
import Test.Ganeti.JSON |
56 | 56 |
import Test.Ganeti.Jobs |
57 | 57 |
import Test.Ganeti.JQueue |
58 |
import Test.Ganeti.Kvmd |
|
58 | 59 |
import Test.Ganeti.Luxi |
59 | 60 |
import Test.Ganeti.Network |
60 | 61 |
import Test.Ganeti.Objects |
... | ... | |
118 | 119 |
, testJSON |
119 | 120 |
, testJobs |
120 | 121 |
, testJQueue |
122 |
, testKvmd |
|
121 | 123 |
, testLuxi |
122 | 124 |
, testNetwork |
123 | 125 |
, testObjects |
Also available in: Unified diff