On Mon, Jan 13, 2014 at 5:25 PM, Jose A. Lopes <[email protected]> wrote: > 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
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
