Commit db519e20 authored by Jose A. Lopes's avatar Jose A. Lopes

Add KVM daemon logic

Add KVM daemon logic, which contains monitors for Qmp sockets and
directory/file watching.
Signed-off-by: default avatarJose A. Lopes <jabolopes@google.com>
Reviewed-by: default avatarMichele Tartara <mtartara@google.com>
parent cf51a981
......@@ -705,6 +705,7 @@ HS_LIB_SRCS = \
src/Ganeti/JQScheduler.hs \
src/Ganeti/JSON.hs \
src/Ganeti/Jobs.hs \
src/Ganeti/Kvmd.hs \
src/Ganeti/Logging.hs \
src/Ganeti/Luxi.hs \
src/Ganeti/Monitoring/Server.hs \
......
{-| KVM daemon
The KVM daemon is responsible for determining whether a given KVM
instance was shutdown by an administrator or a user. For more
information read the design document on the KVM daemon.
The KVM daemon design is split in 2 parts, namely, monitors for Qmp
sockets and directory/file watching.
The monitors are spawned in lightweight Haskell threads and are
reponsible for handling the communication between the KVM daemon and
the KVM instance using the Qmp protocol. During the communcation, the
monitor parses the Qmp messages and if powerdown or shutdown is
received, then the shutdown file is written in the KVM control
directory. Otherwise, when the communication terminates, that same
file is removed. The communication terminates when the KVM instance
stops or crashes.
The directory and file watching uses inotify to track down events on
the KVM control directory and its parents. There is a directory
crawler that will try to add a watch to the KVM control directory if
available or its parents, thus replacing watches until the KVM control
directory becomes available. When this happens, a monitor for the Qmp
socket is spawned. Given that the KVM daemon might stop or crash, the
directory watching also simulates events for the Qmp sockets that
already exist in the KVM control directory when the KVM daemon starts.
-}
{-
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 Ganeti.Kvmd where
import Prelude hiding (catch, rem)
import Control.Applicative ((<$>))
import Control.Exception (try)
import Control.Concurrent
import Control.Monad (unless, when)
import Data.List
import Data.Set (Set)
import qualified Data.Set as Set (delete, empty, insert, member)
import System.Directory
import System.FilePath
import System.IO
import System.IO.Error (isEOFError)
import System.INotify
import qualified AutoConf
import qualified Ganeti.Constants as Constants
import qualified Ganeti.Logging as Logging
import qualified Ganeti.UDSServer as UDSServer
type Lock = MVar ()
type Monitors = MVar (Set FilePath)
-- * Utils
-- | @isPrefixPath x y@ determines whether @x@ is a 'FilePath' prefix
-- of 'FilePath' @y@.
isPrefixPath :: FilePath -> FilePath -> Bool
isPrefixPath x y =
(splitPath x `isPrefixOf` splitPath y) ||
(splitPath (x ++ "/") `isPrefixOf` splitPath y)
monitorGreeting :: String
monitorGreeting = "{\"execute\": \"qmp_capabilities\"}"
-- | KVM control directory containing the Qmp sockets.
monitorDir :: String
monitorDir = AutoConf.localstatedir </> "run/ganeti/kvm-hypervisor/ctrl/"
monitorExtension :: String
monitorExtension = ".qmp"
isMonitorPath :: FilePath -> Bool
isMonitorPath = (== monitorExtension) . takeExtension
shutdownExtension :: String
shutdownExtension = ".shutdown"
shutdownPath :: String -> String
shutdownPath = (`replaceExtension` shutdownExtension)
touchFile :: FilePath -> IO ()
touchFile file = withFile file WriteMode (const . return $ ())
-- * Monitors for Qmp sockets
-- | @parseQmp isPowerdown isShutdown isStop str@ parses the packet
-- @str@ and returns whether a powerdown, shutdown, or stop event is
-- contained in that packet, defaulting to the values @isPowerdown@,
-- @isShutdown@, and @isStop@, otherwise.
parseQmp :: Bool -> Bool -> Bool -> String -> (Bool, Bool, Bool)
parseQmp isPowerdown isShutdown isStop str =
let
isPowerdown'
| "\"POWERDOWN\"" `isInfixOf` str = True
| otherwise = isPowerdown
isShutdown'
| "\"SHUTDOWN\"" `isInfixOf` str = True
| otherwise = isShutdown
isStop'
| "\"STOP\"" `isInfixOf` str = True
| otherwise = isStop
in
(isPowerdown', isShutdown', isStop')
-- | @receiveQmp handle@ listens for Qmp events on @handle@ and, when
-- @handle@ is closed, it returns 'True' if a user shutdown event was
-- received, and 'False' otherwise.
receiveQmp :: Handle -> IO Bool
receiveQmp handle = isUserShutdown <$> receive False False False
where -- | A user shutdown consists of a shutdown event with no
-- prior powerdown event and no stop event.
isUserShutdown (isShutdown, isPowerdown, isStop)
= isPowerdown && not isShutdown && not isStop
receive isPowerdown isShutdown isStop =
do res <- try $ hGetLine handle
case res of
Left err -> do
unless (isEOFError err) $
hPrint stderr err
return (isPowerdown, isShutdown, isStop)
Right str -> do
let (isPowerdown', isShutdown', isStop') =
parseQmp isPowerdown isShutdown isStop str
Logging.logDebug $ "Receive QMP message: " ++ str
receive isPowerdown' isShutdown' isStop'
-- | @detectMonitor monitorFile handle@ listens for Qmp events on
-- @handle@ for Qmp socket @monitorFile@ and, when communcation
-- terminates, it either creates the shutdown file, if a user shutdown
-- was detected, or it deletes that same file, if an administrator
-- shutdown was detected.
detectMonitor :: FilePath -> Handle -> IO ()
detectMonitor monitorFile handle =
do let shutdownFile = shutdownPath monitorFile
res <- receiveQmp handle
if res
then do
Logging.logInfo $ "Detect user shutdown, creating file " ++
show shutdownFile
touchFile shutdownFile
else do
Logging.logInfo $ "Detect admin shutdown, removing file " ++
show shutdownFile
(try (removeFile shutdownFile) :: IO (Either IOError ())) >> return ()
-- | @runMonitor monitorFile@ creates a monitor for the Qmp socket
-- @monitorFile@ and calls 'detectMonitor'.
runMonitor :: FilePath -> IO ()
runMonitor monitorFile =
do handle <- UDSServer.openClientSocket Constants.luxiDefRwto monitorFile
hPutStrLn handle monitorGreeting
hFlush handle
detectMonitor monitorFile handle
UDSServer.closeClientSocket handle
-- | @ensureMonitor monitors monitorFile@ ensures that there is
-- exactly one monitor running for the Qmp socket @monitorFile@, given
-- the existing set of monitors @monitors@.
ensureMonitor :: Monitors -> FilePath -> IO ()
ensureMonitor monitors monitorFile =
modifyMVar_ monitors $
\files ->
if monitorFile `Set.member` files
then return files
else do
forkIO tryMonitor >> return ()
return $ monitorFile `Set.insert` files
where tryMonitor =
do Logging.logInfo $ "Start monitor " ++ show monitorFile
res <- try (runMonitor monitorFile) :: IO (Either IOError ())
case res of
Left err ->
Logging.logError $ "Catch monitor exception: " ++ show err
_ ->
return ()
Logging.logInfo $ "Stop monitor " ++ show monitorFile
modifyMVar_ monitors (return . Set.delete monitorFile)
-- * Directory and file watching
-- | Handles an inotify event outside the target directory.
--
-- Tracks events on the parent directory of the KVM control directory
-- until one of its parents becomes available.
handleGenericEvent :: Lock -> String -> String -> Event -> IO ()
handleGenericEvent lock curDir tarDir ev@Created {}
| isDirectory ev && curDir /= tarDir &&
(curDir </> filePath ev) `isPrefixPath` tarDir = putMVar lock ()
handleGenericEvent lock _ _ event
| event == DeletedSelf || event == Unmounted = putMVar lock ()
handleGenericEvent _ _ _ _ = return ()
-- | Handles an inotify event in the target directory.
--
-- Upon a create or open event inside the KVM control directory, it
-- ensures that there is a monitor running for the new Qmp socket.
handleTargetEvent :: Lock -> Monitors -> String -> Event -> IO ()
handleTargetEvent _ monitors tarDir ev@Created {}
| not (isDirectory ev) && isMonitorPath (filePath ev) =
ensureMonitor monitors $ tarDir </> filePath ev
handleTargetEvent lock monitors tarDir ev@Opened {}
| not (isDirectory ev) =
case maybeFilePath ev of
Just p | isMonitorPath p ->
ensureMonitor monitors $ tarDir </> filePath ev
_ ->
handleGenericEvent lock tarDir tarDir ev
handleTargetEvent _ _ tarDir ev@Created {}
| not (isDirectory ev) && takeExtension (filePath ev) == shutdownExtension =
Logging.logInfo $ "User shutdown file opened " ++
show (tarDir </> filePath ev)
handleTargetEvent _ _ tarDir ev@Deleted {}
| not (isDirectory ev) && takeExtension (filePath ev) == shutdownExtension =
Logging.logInfo $ "User shutdown file deleted " ++
show (tarDir </> filePath ev)
handleTargetEvent lock _ tarDir ev =
handleGenericEvent lock tarDir tarDir ev
-- | Dispatches inotify events depending on the directory they occur in.
handleDir :: Lock -> Monitors -> String -> String -> Event -> IO ()
handleDir lock monitors curDir tarDir event =
do Logging.logDebug $ "Handle event " ++ show event
if curDir == tarDir
then handleTargetEvent lock monitors tarDir event
else handleGenericEvent lock curDir tarDir event
-- | Simulates file creation events for the Qmp sockets that already
-- exist in @dir@.
recapDir :: Lock -> Monitors -> FilePath -> IO ()
recapDir lock monitors dir =
do files <- getDirectoryContents dir
let files' = filter isMonitorPath files
mapM_ sendEvent files'
where sendEvent file =
handleTargetEvent lock monitors dir Created { isDirectory = False
, filePath = file }
-- | Crawls @tarDir@, or its parents until @tarDir@ becomes available,
-- always listening for inotify events.
--
-- Used for crawling the KVM control directory and its parents, as
-- well as simulating file creation events.
watchDir :: Lock -> FilePath -> INotify -> IO ()
watchDir lock tarDir inotify = watchDir' tarDir
where watchDirEvents dir
| dir == tarDir = [AllEvents]
| otherwise = [Create, DeleteSelf]
watchDir' dir =
do add <- doesDirectoryExist dir
if add
then do
let events = watchDirEvents dir
Logging.logInfo $ "Watch directory " ++ show dir
monitors <- newMVar Set.empty
wd <- addWatch inotify events dir
(handleDir lock monitors dir tarDir)
when (dir == tarDir) $ recapDir lock monitors dir
() <- takeMVar lock
rem <- doesDirectoryExist dir
if rem
then do
Logging.logInfo $ "Unwatch directory " ++ show dir
removeWatch wd
else
Logging.logInfo $ "Throw away watch from directory " ++
show dir
else
watchDir' (takeDirectory dir)
rewatchDir :: Lock -> FilePath -> INotify -> IO ()
rewatchDir lock tarDir inotify =
do watchDir lock tarDir inotify
rewatchDir lock tarDir inotify
-- * Starting point
startWith :: FilePath -> IO ()
startWith dir =
do lock <- newEmptyMVar
withINotify (rewatchDir lock dir)
start :: IO ()
start = startWith monitorDir
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment