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