Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Kvmd.hs @ db519e20

History | View | Annotate | Download (11.5 kB)

1
{-| KVM daemon
2

    
3
The KVM daemon is responsible for determining whether a given KVM
4
instance was shutdown by an administrator or a user.  For more
5
information read the design document on the KVM daemon.
6

    
7
The KVM daemon design is split in 2 parts, namely, monitors for Qmp
8
sockets and directory/file watching.
9

    
10
The monitors are spawned in lightweight Haskell threads and are
11
reponsible for handling the communication between the KVM daemon and
12
the KVM instance using the Qmp protocol.  During the communcation, the
13
monitor parses the Qmp messages and if powerdown or shutdown is
14
received, then the shutdown file is written in the KVM control
15
directory.  Otherwise, when the communication terminates, that same
16
file is removed.  The communication terminates when the KVM instance
17
stops or crashes.
18

    
19
The directory and file watching uses inotify to track down events on
20
the KVM control directory and its parents.  There is a directory
21
crawler that will try to add a watch to the KVM control directory if
22
available or its parents, thus replacing watches until the KVM control
23
directory becomes available.  When this happens, a monitor for the Qmp
24
socket is spawned.  Given that the KVM daemon might stop or crash, the
25
directory watching also simulates events for the Qmp sockets that
26
already exist in the KVM control directory when the KVM daemon starts.
27

    
28
-}
29

    
30
{-
31

    
32
Copyright (C) 2013 Google Inc.
33

    
34
This program is free software; you can redistribute it and/or modify
35
it under the terms of the GNU General Public License as published by
36
the Free Software Foundation; either version 2 of the License, or
37
(at your option) any later version.
38

    
39
This program is distributed in the hope that it will be useful, but
40
WITHOUT ANY WARRANTY; without even the implied warranty of
41
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
42
General Public License for more details.
43

    
44
You should have received a copy of the GNU General Public License
45
along with this program; if not, write to the Free Software
46
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
47
02110-1301, USA.
48

    
49
-}
50

    
51
module Ganeti.Kvmd where
52

    
53
import Prelude hiding (catch, rem)
54

    
55
import Control.Applicative ((<$>))
56
import Control.Exception (try)
57
import Control.Concurrent
58
import Control.Monad (unless, when)
59
import Data.List
60
import Data.Set (Set)
61
import qualified Data.Set as Set (delete, empty, insert, member)
62
import System.Directory
63
import System.FilePath
64
import System.IO
65
import System.IO.Error (isEOFError)
66
import System.INotify
67

    
68
import qualified AutoConf
69
import qualified Ganeti.Constants as Constants
70
import qualified Ganeti.Logging as Logging
71
import qualified Ganeti.UDSServer as UDSServer
72

    
73
type Lock = MVar ()
74
type Monitors = MVar (Set FilePath)
75

    
76
-- * Utils
77

    
78
-- | @isPrefixPath x y@ determines whether @x@ is a 'FilePath' prefix
79
-- of 'FilePath' @y@.
80
isPrefixPath :: FilePath -> FilePath -> Bool
81
isPrefixPath x y =
82
  (splitPath x `isPrefixOf` splitPath y) ||
83
  (splitPath (x ++ "/") `isPrefixOf` splitPath y)
84

    
85
monitorGreeting :: String
86
monitorGreeting = "{\"execute\": \"qmp_capabilities\"}"
87

    
88
-- | KVM control directory containing the Qmp sockets.
89
monitorDir :: String
90
monitorDir = AutoConf.localstatedir </> "run/ganeti/kvm-hypervisor/ctrl/"
91

    
92
monitorExtension :: String
93
monitorExtension = ".qmp"
94

    
95
isMonitorPath :: FilePath -> Bool
96
isMonitorPath = (== monitorExtension) . takeExtension
97

    
98
shutdownExtension :: String
99
shutdownExtension = ".shutdown"
100

    
101
shutdownPath :: String -> String
102
shutdownPath = (`replaceExtension` shutdownExtension)
103

    
104
touchFile :: FilePath -> IO ()
105
touchFile file = withFile file WriteMode (const . return $ ())
106

    
107
-- * Monitors for Qmp sockets
108

    
109
-- | @parseQmp isPowerdown isShutdown isStop str@ parses the packet
110
-- @str@ and returns whether a powerdown, shutdown, or stop event is
111
-- contained in that packet, defaulting to the values @isPowerdown@,
112
-- @isShutdown@, and @isStop@, otherwise.
113
parseQmp :: Bool -> Bool -> Bool -> String -> (Bool, Bool, Bool)
114
parseQmp isPowerdown isShutdown isStop str =
115
  let
116
    isPowerdown'
117
      | "\"POWERDOWN\"" `isInfixOf` str = True
118
      | otherwise = isPowerdown
119
    isShutdown'
120
      | "\"SHUTDOWN\"" `isInfixOf` str = True
121
      | otherwise = isShutdown
122
    isStop'
123
      | "\"STOP\"" `isInfixOf` str = True
124
      | otherwise = isStop
125
  in
126
   (isPowerdown', isShutdown', isStop')
127

    
128
-- | @receiveQmp handle@ listens for Qmp events on @handle@ and, when
129
-- @handle@ is closed, it returns 'True' if a user shutdown event was
130
-- received, and 'False' otherwise.
131
receiveQmp :: Handle -> IO Bool
132
receiveQmp handle = isUserShutdown <$> receive False False False
133
  where -- | A user shutdown consists of a shutdown event with no
134
        -- prior powerdown event and no stop event.
135
        isUserShutdown (isShutdown, isPowerdown, isStop)
136
          = isPowerdown && not isShutdown && not isStop
137

    
138
        receive isPowerdown isShutdown isStop =
139
          do res <- try $ hGetLine handle
140
             case res of
141
               Left err -> do
142
                 unless (isEOFError err) $
143
                   hPrint stderr err
144
                 return (isPowerdown, isShutdown, isStop)
145
               Right str -> do
146
                 let (isPowerdown', isShutdown', isStop') =
147
                       parseQmp isPowerdown isShutdown isStop str
148
                 Logging.logDebug $ "Receive QMP message: " ++ str
149
                 receive isPowerdown' isShutdown' isStop'
150

    
151
-- | @detectMonitor monitorFile handle@ listens for Qmp events on
152
-- @handle@ for Qmp socket @monitorFile@ and, when communcation
153
-- terminates, it either creates the shutdown file, if a user shutdown
154
-- was detected, or it deletes that same file, if an administrator
155
-- shutdown was detected.
156
detectMonitor :: FilePath -> Handle -> IO ()
157
detectMonitor monitorFile handle =
158
  do let shutdownFile = shutdownPath monitorFile
159
     res <- receiveQmp handle
160
     if res
161
       then do
162
         Logging.logInfo $ "Detect user shutdown, creating file " ++
163
           show shutdownFile
164
         touchFile shutdownFile
165
       else do
166
         Logging.logInfo $ "Detect admin shutdown, removing file " ++
167
           show shutdownFile
168
         (try (removeFile shutdownFile) :: IO (Either IOError ())) >> return ()
169

    
170
-- | @runMonitor monitorFile@ creates a monitor for the Qmp socket
171
-- @monitorFile@ and calls 'detectMonitor'.
172
runMonitor :: FilePath -> IO ()
173
runMonitor monitorFile =
174
  do handle <- UDSServer.openClientSocket Constants.luxiDefRwto monitorFile
175
     hPutStrLn handle monitorGreeting
176
     hFlush handle
177
     detectMonitor monitorFile handle
178
     UDSServer.closeClientSocket handle
179

    
180
-- | @ensureMonitor monitors monitorFile@ ensures that there is
181
-- exactly one monitor running for the Qmp socket @monitorFile@, given
182
-- the existing set of monitors @monitors@.
183
ensureMonitor :: Monitors -> FilePath -> IO ()
184
ensureMonitor monitors monitorFile =
185
  modifyMVar_ monitors $
186
    \files ->
187
      if monitorFile `Set.member` files
188
      then return files
189
      else do
190
        forkIO tryMonitor >> return ()
191
        return $ monitorFile `Set.insert` files
192
  where tryMonitor =
193
          do Logging.logInfo $ "Start monitor " ++ show monitorFile
194
             res <- try (runMonitor monitorFile) :: IO (Either IOError ())
195
             case res of
196
               Left err ->
197
                 Logging.logError $ "Catch monitor exception: " ++ show err
198
               _ ->
199
                 return ()
200
             Logging.logInfo $ "Stop monitor " ++ show monitorFile
201
             modifyMVar_ monitors (return . Set.delete monitorFile)
202

    
203
-- * Directory and file watching
204

    
205
-- | Handles an inotify event outside the target directory.
206
--
207
-- Tracks events on the parent directory of the KVM control directory
208
-- until one of its parents becomes available.
209
handleGenericEvent :: Lock -> String -> String -> Event -> IO ()
210
handleGenericEvent lock curDir tarDir ev@Created {}
211
  | isDirectory ev && curDir /= tarDir &&
212
    (curDir </> filePath ev) `isPrefixPath` tarDir = putMVar lock ()
213
handleGenericEvent lock _ _ event
214
  | event == DeletedSelf || event == Unmounted = putMVar lock ()
215
handleGenericEvent _ _ _ _ = return ()
216

    
217
-- | Handles an inotify event in the target directory.
218
--
219
-- Upon a create or open event inside the KVM control directory, it
220
-- ensures that there is a monitor running for the new Qmp socket.
221
handleTargetEvent :: Lock -> Monitors -> String -> Event -> IO ()
222
handleTargetEvent _ monitors tarDir ev@Created {}
223
  | not (isDirectory ev) && isMonitorPath (filePath ev) =
224
    ensureMonitor monitors $ tarDir </> filePath ev
225
handleTargetEvent lock monitors tarDir ev@Opened {}
226
  | not (isDirectory ev) =
227
    case maybeFilePath ev of
228
      Just p | isMonitorPath p ->
229
        ensureMonitor monitors $ tarDir </> filePath ev
230
      _ ->
231
        handleGenericEvent lock tarDir tarDir ev
232
handleTargetEvent _ _ tarDir ev@Created {}
233
  | not (isDirectory ev) && takeExtension (filePath ev) == shutdownExtension =
234
    Logging.logInfo $ "User shutdown file opened " ++
235
      show (tarDir </> filePath ev)
236
handleTargetEvent _ _ tarDir ev@Deleted {}
237
  | not (isDirectory ev) && takeExtension (filePath ev) == shutdownExtension =
238
    Logging.logInfo $ "User shutdown file deleted " ++
239
      show (tarDir </> filePath ev)
240
handleTargetEvent lock _ tarDir ev =
241
  handleGenericEvent lock tarDir tarDir ev
242

    
243
-- | Dispatches inotify events depending on the directory they occur in.
244
handleDir :: Lock -> Monitors -> String -> String -> Event -> IO ()
245
handleDir lock monitors curDir tarDir event =
246
  do Logging.logDebug $ "Handle event " ++ show event
247
     if curDir == tarDir
248
       then handleTargetEvent lock monitors tarDir event
249
       else handleGenericEvent lock curDir tarDir event
250

    
251
-- | Simulates file creation events for the Qmp sockets that already
252
-- exist in @dir@.
253
recapDir :: Lock -> Monitors -> FilePath -> IO ()
254
recapDir lock monitors dir =
255
  do files <- getDirectoryContents dir
256
     let files' = filter isMonitorPath files
257
     mapM_ sendEvent files'
258
  where sendEvent file =
259
          handleTargetEvent lock monitors dir Created { isDirectory = False
260
                                                      , filePath = file }
261

    
262
-- | Crawls @tarDir@, or its parents until @tarDir@ becomes available,
263
-- always listening for inotify events.
264
--
265
-- Used for crawling the KVM control directory and its parents, as
266
-- well as simulating file creation events.
267
watchDir :: Lock -> FilePath -> INotify -> IO ()
268
watchDir lock tarDir inotify = watchDir' tarDir
269
  where watchDirEvents dir
270
          | dir == tarDir = [AllEvents]
271
          | otherwise = [Create, DeleteSelf]
272

    
273
        watchDir' dir =
274
          do add <- doesDirectoryExist dir
275
             if add
276
               then do
277
                 let events = watchDirEvents dir
278
                 Logging.logInfo $ "Watch directory " ++ show dir
279
                 monitors <- newMVar Set.empty
280
                 wd <- addWatch inotify events dir
281
                       (handleDir lock monitors dir tarDir)
282
                 when (dir == tarDir) $ recapDir lock monitors dir
283
                 () <- takeMVar lock
284
                 rem <- doesDirectoryExist dir
285
                 if rem
286
                   then do
287
                     Logging.logInfo $ "Unwatch directory " ++ show dir
288
                     removeWatch wd
289
                   else
290
                     Logging.logInfo $ "Throw away watch from directory " ++
291
                       show dir
292
               else
293
                 watchDir' (takeDirectory dir)
294

    
295
rewatchDir :: Lock -> FilePath -> INotify -> IO ()
296
rewatchDir lock tarDir inotify =
297
  do watchDir lock tarDir inotify
298
     rewatchDir lock tarDir inotify
299

    
300
-- * Starting point
301

    
302
startWith :: FilePath -> IO ()
303
startWith dir =
304
  do lock <- newEmptyMVar
305
     withINotify (rewatchDir lock dir)
306

    
307
start :: IO ()
308
start = startWith monitorDir