Interdiff follows.
Thanks,
Jose
Interdiff:
diff --git a/src/Ganeti/Kvmd.hs b/src/Ganeti/Kvmd.hs
index 1dc678e..d9ae139 100644
--- a/src/Ganeti/Kvmd.hs
+++ b/src/Ganeti/Kvmd.hs
@@ -76,7 +76,7 @@ type Monitors = MVar (Set FilePath)
-- * Utils
-- | @isPrefixPath x y@ determines whether @x@ is a 'FilePath' prefix
--- of 'FilePath' @y@
+-- of 'FilePath' @y@.
isPrefixPath :: FilePath -> FilePath -> Bool
isPrefixPath x y =
(splitPath x `isPrefixOf` splitPath y) ||
@@ -85,7 +85,7 @@ isPrefixPath x y =
monitorGreeting :: String
monitorGreeting = "{\"execute\": \"qmp_capabilities\"}"
--- | KVM control directory containing the Qmp sockets
+-- | KVM control directory containing the Qmp sockets.
monitorDir :: String
monitorDir = AutoConf.localstatedir </> "run/ganeti/kvm-hypervisor/ctrl/"
@@ -106,10 +106,10 @@ touchFile file = withFile file WriteMode (const . return
$ ())
-- * Monitors for Qmp sockets
--- | @parseQmp isPowerdown isShutdown str@ parses the packet @str@ and
--- returns whether a powerdown or shutdown event is contained in that
--- packet, defaulting to the values @isPowerdown@ and @isShutdown@
--- otherwise
+-- | @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
@@ -127,11 +127,11 @@ parseQmp isPowerdown isShutdown isStop str =
-- | @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
+-- 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
+ -- prior powerdown event and no stop event.
isUserShutdown (isShutdown, isPowerdown, isStop)
= isPowerdown && not isShutdown && not isStop
@@ -152,7 +152,7 @@ receiveQmp handle = isUserShutdown <$> receive False False
False
-- @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
+-- shutdown was detected.
detectMonitor :: FilePath -> Handle -> IO ()
detectMonitor monitorFile handle =
do let shutdownFile = shutdownPath monitorFile
@@ -168,7 +168,7 @@ detectMonitor monitorFile handle =
(try (removeFile shutdownFile) :: IO (Either IOError ())) >> return ()
-- | @runMonitor monitorFile@ creates a monitor for the Qmp socket
--- @monitorFile@ and calls 'detectMonitor'
+-- @monitorFile@ and calls 'detectMonitor'.
runMonitor :: FilePath -> IO ()
runMonitor monitorFile =
do handle <- UDSServer.openClientSocket Constants.luxiDefRwto monitorFile
@@ -179,7 +179,7 @@ runMonitor monitorFile =
-- | @ensureMonitor monitors monitorFile@ ensures that there is
-- exactly one monitor running for the Qmp socket @monitorFile@, given
--- the existing set of monitors @monitors@
+-- the existing set of monitors @monitors@.
ensureMonitor :: Monitors -> FilePath -> IO ()
ensureMonitor monitors monitorFile =
modifyMVar_ monitors $
@@ -202,7 +202,7 @@ ensureMonitor monitors monitorFile =
-- * Directory and file watching
--- | Handles an inotify event outside the target directory
+-- | 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.
@@ -214,7 +214,7 @@ handleGenericEvent lock _ _ event
| event == DeletedSelf || event == Unmounted = putMVar lock ()
handleGenericEvent _ _ _ _ = return ()
--- | Handles an inotify event in the target directory
+-- | 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.
@@ -240,7 +240,7 @@ handleTargetEvent _ _ tarDir ev@Deleted {}
handleTargetEvent lock _ tarDir ev =
handleGenericEvent lock tarDir tarDir ev
--- | Dispatches inotify events depending on the directory they occur in
+-- | 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
@@ -249,7 +249,7 @@ handleDir lock monitors curDir tarDir event =
else handleGenericEvent lock curDir tarDir event
-- | Simulates file creation events for the Qmp sockets that already
--- exist in @dir@
+-- exist in @dir@.
recapDir :: Lock -> Monitors -> FilePath -> IO ()
recapDir lock monitors dir =
do files <- getDirectoryContents dir
@@ -260,7 +260,7 @@ recapDir lock monitors dir =
, filePath = file }
-- | Crawls @tarDir@, or its parents until @tarDir@ becomes available,
--- always listening for inotify events
+-- always listening for inotify events.
--
-- Used for crawling the KVM control directory and its parents, as
-- well as simulating file creation events.
On Fri, Jan 10, 2014 at 12:31:31PM +0100, Michele Tartara wrote:
> On Fri, Jan 3, 2014 at 9:42 AM, Jose A. Lopes <[email protected]> wrote:
> > Add KVM daemon logic, which contains monitors for Qmp sockets and
> > directory/file watching.
> >
> > Signed-off-by: Jose A. Lopes <[email protected]>
> > ---
> > Makefile.am | 1 +
> > src/Ganeti/Kvmd.hs | 308
> > +++++++++++++++++++++++++++++++++++++++++++++++++++++
> > 2 files changed, 309 insertions(+)
> > create mode 100644 src/Ganeti/Kvmd.hs
> >
> > diff --git a/Makefile.am b/Makefile.am
> > index 8611dfe..eb23dfd 100644
> > --- a/Makefile.am
> > +++ b/Makefile.am
> > @@ -692,6 +692,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 \
> > diff --git a/src/Ganeti/Kvmd.hs b/src/Ganeti/Kvmd.hs
> > new file mode 100644
> > index 0000000..1dc678e
> > --- /dev/null
> > +++ b/src/Ganeti/Kvmd.hs
> > @@ -0,0 +1,308 @@
> > +{-| 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 str@ parses the packet @str@ and
> > +-- returns whether a powerdown or shutdown event is contained in that
> > +-- packet, defaulting to the values @isPowerdown@ and @isShutdown@
> > +-- 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')
>
> The function has an isStop parameter, but the documentation line at
> its top doesn't mention it.
>
>
> > +
> > +-- | @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
> > --
> > 1.8.5.1
> >
>
> Many description of functions are not properly terminated by full
> stops. Please, fix them.
>
> Rest 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
--
Jose Antonio Lopes
Ganeti Engineering
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
Steuernummer: 48/725/00206
Umsatzsteueridentifikationsnummer: DE813741370
