On Fri, Jan 3, 2014 at 9:42 AM, Jose A. Lopes <[email protected]> wrote: > Add unit tests for KVM daemon. > > Signed-off-by: Jose A. Lopes <[email protected]> > --- > Makefile.am | 1 + > test/hs/Test/Ganeti/Kvmd.hs | 115 > ++++++++++++++++++++++++++++++++++++++ > test/hs/Test/Ganeti/Luxi.hs | 13 +---- > test/hs/Test/Ganeti/TestCommon.hs | 12 ++++ > test/hs/htest.hs | 2 + > 5 files changed, 131 insertions(+), 12 deletions(-) > create mode 100644 test/hs/Test/Ganeti/Kvmd.hs > > diff --git a/Makefile.am b/Makefile.am > index fa11d6b..d05bf5d 100644 > --- a/Makefile.am > +++ b/Makefile.am > @@ -758,6 +758,7 @@ HS_TEST_SRCS = \ > test/hs/Test/Ganeti/JSON.hs \ > test/hs/Test/Ganeti/Jobs.hs \ > test/hs/Test/Ganeti/JQueue.hs \ > + test/hs/Test/Ganeti/Kvmd.hs \ > test/hs/Test/Ganeti/Luxi.hs \ > test/hs/Test/Ganeti/Network.hs \ > test/hs/Test/Ganeti/Objects.hs \ > diff --git a/test/hs/Test/Ganeti/Kvmd.hs b/test/hs/Test/Ganeti/Kvmd.hs > new file mode 100644 > index 0000000..bc7339f > --- /dev/null > +++ b/test/hs/Test/Ganeti/Kvmd.hs > @@ -0,0 +1,115 @@ > +{-# LANGUAGE TemplateHaskell #-} > +{-| Unittests for the KVM daemon. > + > +-} > + > +{- > + > +Copyright (C) 2013 Google Inc. > + > +This program is free software; you can redistribute it and/or modify > +it under the terms of the GNU General Public License as published by > +the Free Software Foundation; either version 2 of the License, or > +(at your option) any later version. > + > +This program is distributed in the hope that it will be useful, but > +WITHOUT ANY WARRANTY; without even the implied warranty of > +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU > +General Public License for more details. > + > +You should have received a copy of the GNU General Public License > +along with this program; if not, write to the Free Software > +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA > +02110-1301, USA. > + > +-} > + > +module Test.Ganeti.Kvmd (testKvmd) where > + > +import Control.Concurrent > +import Control.Exception (try) > +import qualified Network.Socket as Socket > +import System.Directory > +import System.FilePath > +import System.IO > + > +import qualified Ganeti.Kvmd as Kvmd > +import qualified Ganeti.UDSServer as UDSServer > +import Test.HUnit as HUnit > + > +import qualified Test.Ganeti.TestHelper as TestHelper (testSuite) > +import qualified Test.Ganeti.TestCommon as TestCommon (getTempFileName) > + > +import qualified Ganeti.Logging as Logging > + > +{-# ANN module "HLint: ignore Use camelCase" #-} > + > +startKvmd :: FilePath -> IO ThreadId > +startKvmd dir = > + forkIO (do Logging.setupLogging Nothing "ganeti-kvmd" False False > + False Logging.SyslogNo > + Kvmd.startWith dir) > + > +stopKvmd :: ThreadId -> IO () > +stopKvmd = killThread > + > +delayKvmd :: IO () > +delayKvmd = threadDelay 1000000 > + > +detectShutdown :: (Handle -> IO ()) -> IO Bool > +detectShutdown putFn = > + do monitorDir <- TestCommon.getTempFileName "ganeti" > + let monitor = "instance.qmp" > + monitorFile = monitorDir </> monitor > + shutdownFile = Kvmd.shutdownPath monitorFile > + -- ensure the KVM directory exists > + createDirectoryIfMissing True monitorDir > + -- ensure the shutdown file does not exist > + (try (removeFile shutdownFile) :: IO (Either IOError ())) >> return () > + -- start KVM daemon > + threadId <- startKvmd monitorDir > + threadDelay 1000 > + -- create a Unix socket > + sock <- UDSServer.openServerSocket monitorFile > + Socket.listen sock 1 > + handle <- UDSServer.acceptSocket sock > + -- read 'qmp_capabilities' message > + res <- try . hGetLine $ handle :: IO (Either IOError String) > + case res of > + Left err -> > + assertFailure $ "Expecting " ++ show Kvmd.monitorGreeting ++ > + ", received " ++ show err > + Right str -> Kvmd.monitorGreeting @=? str > + -- send Qmp messages > + putFn handle > + hFlush handle > + -- close the Unix socket > + UDSServer.closeClientSocket handle > + UDSServer.closeServerSocket sock monitorFile > + -- KVM needs time to create the shutdown file > + delayKvmd > + -- stop the KVM daemon > + stopKvmd threadId > + -- check for shutdown file > + doesFileExist shutdownFile > + > +case_DetectAdminShutdown :: Assertion > +case_DetectAdminShutdown = > + do res <- detectShutdown putMessage > + assertBool "Detected user shutdown instead of administrator shutdown" $ > + not res > + where putMessage handle = > + do hPrint handle "POWERDOWN" > + hPrint handle "SHUTDOWN" > + > +case_DetectUserShutdown :: Assertion > +case_DetectUserShutdown = > + do res <- detectShutdown putMessage > + assertBool "Detected administrator shutdown instead of user shutdown" > res > + where putMessage handle = > + hPrint handle "SHUTDOWN" > + > +TestHelper.testSuite "Kvmd" > + [ 'case_DetectAdminShutdown > + , 'case_DetectUserShutdown > + ] > diff --git a/test/hs/Test/Ganeti/Luxi.hs b/test/hs/Test/Ganeti/Luxi.hs > index 5880f74..cd00a8d 100644 > --- a/test/hs/Test/Ganeti/Luxi.hs > +++ b/test/hs/Test/Ganeti/Luxi.hs > @@ -36,8 +36,6 @@ import Data.List > import Control.Applicative > import Control.Concurrent (forkIO) > import Control.Exception (bracket) > -import System.Directory (getTemporaryDirectory, removeFile) > -import System.IO (hClose, openTempFile) > import qualified Text.JSON as J > > import Test.Ganeti.TestHelper > @@ -100,15 +98,6 @@ prop_CallEncoding :: Luxi.LuxiOp -> Property > prop_CallEncoding op = > (US.parseCall (Luxi.buildCall op) >>= uncurry Luxi.decodeLuxiCall) ==? Ok > op > > --- | Helper to a get a temporary file name. > -getTempFileName :: IO FilePath > -getTempFileName = do > - tempdir <- getTemporaryDirectory > - (fpath, handle) <- openTempFile tempdir "luxitest" > - _ <- hClose handle > - removeFile fpath > - return fpath > - > -- | Server ping-pong helper. > luxiServerPong :: Luxi.Client -> IO () > luxiServerPong c = do > @@ -128,7 +117,7 @@ luxiClientPong c = > prop_ClientServer :: [[DNSChar]] -> Property > prop_ClientServer dnschars = monadicIO $ do > let msgs = map (map dnsGetChar) dnschars > - fpath <- run getTempFileName > + fpath <- run $ getTempFileName "luxitest" > -- we need to create the server first, otherwise (if we do it in the > -- forked thread) the client could try to connect to it before it's > -- ready > diff --git a/test/hs/Test/Ganeti/TestCommon.hs > b/test/hs/Test/Ganeti/TestCommon.hs > index 0f310de..239a3e8 100644 > --- a/test/hs/Test/Ganeti/TestCommon.hs > +++ b/test/hs/Test/Ganeti/TestCommon.hs > @@ -66,6 +66,7 @@ module Test.Ganeti.TestCommon > , genPropParser > , genNonNegative > , relativeError > + , getTempFileName > ) where > > import Control.Applicative > @@ -76,8 +77,10 @@ import Data.List > import Data.Text (pack) > import Data.Word > import qualified Data.Set as Set > +import System.Directory (getTemporaryDirectory, removeFile) > import System.Environment (getEnv) > import System.Exit (ExitCode(..)) > +import System.IO (hClose, openTempFile) > import System.IO.Error (isDoesNotExistError) > import System.Process (readProcessWithExitCode) > import qualified Test.HUnit as HUnit > @@ -421,3 +424,12 @@ relativeError d1 d2 = > in if delta == 0 > then 0 > else delta / greatest > + > +-- | Helper to a get a temporary file name. > +getTempFileName :: String -> IO FilePath > +getTempFileName filename = do > + tempdir <- getTemporaryDirectory > + (fpath, handle) <- openTempFile tempdir filename > + _ <- hClose handle > + removeFile fpath > + return fpath > diff --git a/test/hs/htest.hs b/test/hs/htest.hs > index 1bd7272..449f124 100644 > --- a/test/hs/htest.hs > +++ b/test/hs/htest.hs > @@ -55,6 +55,7 @@ import Test.Ganeti.Hypervisor.Xen.XmParser > import Test.Ganeti.JSON > import Test.Ganeti.Jobs > import Test.Ganeti.JQueue > +import Test.Ganeti.Kvmd > import Test.Ganeti.Luxi > import Test.Ganeti.Network > import Test.Ganeti.Objects > @@ -118,6 +119,7 @@ allTests = > , testJSON > , testJobs > , testJQueue > + , testKvmd > , testLuxi > , testNetwork > , testObjects > -- > 1.8.5.1 >
LGTM, thanks. Michele -- Google Germany GmbH Dienerstr. 12 80331 München Registergericht und -nummer: Hamburg, HRB 86891 Sitz der Gesellschaft: Hamburg Geschäftsführer: Graham Law, Christine Elizabeth Flores
