code.grnet.gr Git - ganeti-local/blob - src/Ganeti/DataCollectors/InstStatus.hs

   1 {-| Instance status data collector.
   2
   3 -}
   4
   5 {-
   6
   7 Copyright (C) 2013 Google Inc.
   8
   9 This program is free software; you can redistribute it and/or modify
  10 it under the terms of the GNU General Public License as published by
  11 the Free Software Foundation; either version 2 of the License, or
  12 (at your option) any later version.
  13
  14 This program is distributed in the hope that it will be useful, but
  15 WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 General Public License for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with this program; if not, write to the Free Software
  21 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  22 02110-1301, USA.
  23
  24 -}
  25
  26 module Ganeti.DataCollectors.InstStatus
  27   ( main
  28   , options
  29   , arguments
  30   , dcName
  31   , dcVersion
  32   , dcFormatVersion
  33   , dcCategory
  34   , dcKind
  35   , dcReport
  36   ) where
  37
  38
  39 import Control.Exception.Base
  40 import Data.List
  41 import Data.Maybe
  42 import qualified Data.Map as Map
  43 import Network.BSD (getHostName)
  44 import qualified Text.JSON as J
  45
  46 import qualified Ganeti.BasicTypes as BT
  47 import Ganeti.Confd.Client
  48 import Ganeti.Confd.Types
  49 import Ganeti.Common
  50 import Ganeti.DataCollectors.CLI
  51 import Ganeti.DataCollectors.InstStatusTypes
  52 import Ganeti.DataCollectors.Types
  53 import Ganeti.Hypervisor.Xen
  54 import Ganeti.Hypervisor.Xen.Types
  55 import Ganeti.Logging
  56 import Ganeti.Objects
  57 import Ganeti.Path
  58 import Ganeti.Types
  59 import Ganeti.Utils
  60
  61
  62 -- | The name of this data collector.
  63 dcName :: String
  64 dcName = "inst-status-xen"
  65
  66 -- | The version of this data collector.
  67 dcVersion :: DCVersion
  68 dcVersion = DCVerBuiltin
  69
  70 -- | The version number for the data format of this data collector.
  71 dcFormatVersion :: Int
  72 dcFormatVersion = 1
  73
  74 -- | The category of this data collector.
  75 dcCategory :: Maybe DCCategory
  76 dcCategory = Just DCInstance
  77
  78 -- | The kind of this data collector.
  79 dcKind :: DCKind
  80 dcKind = DCKStatus
  81
  82 -- | The report of this data collector.
  83 dcReport :: IO DCReport
  84 dcReport = buildInstStatusReport Nothing Nothing
  85
  86 -- * Command line options
  87
  88 options :: IO [OptType]
  89 options = return
  90   [ oConfdAddr
  91   , oConfdPort
  92   ]
  93
  94 -- | The list of arguments supported by the program.
  95 arguments :: [ArgCompletion]
  96 arguments = []
  97
  98 -- | Get the list of instances ([primary], [secondary]) on the given node.
  99 -- Implemented as a function, even if used a single time, to specify in a
 100 -- convenient and elegant way the return data type, required in order to
 101 -- prevent incurring in the monomorphism restriction.
 102 -- The server address and the server port parameters are mainly intended
 103 -- for testing purposes. If they are Nothing, the default values will be used.
 104 getInstances
 105   :: String
 106   -> Maybe String
 107   -> Maybe Int
 108   -> IO (BT.Result ([Ganeti.Objects.Instance], [Ganeti.Objects.Instance]))
 109 getInstances node srvAddr srvPort = do
 110   client <- getConfdClient srvAddr srvPort
 111   reply <- query client ReqNodeInstances $ PlainQuery node
 112   return $
 113     case fmap (J.readJSON . confdReplyAnswer) reply of
 114       Just (J.Ok instances) -> BT.Ok instances
 115       Just (J.Error msg) -> BT.Bad msg
 116       Nothing -> BT.Bad "No answer from the Confd server"
 117
 118 -- | Try to get the reason trail for an instance. In case it is not possible,
 119 -- log the failure and return an empty list instead.
 120 getReasonTrail :: String -> IO ReasonTrail
 121 getReasonTrail instanceName = do
 122   fileName <- getInstReasonFilename instanceName
 123   content <- try $ readFile fileName
 124   case content of
 125     Left e -> do
 126       logWarning $
 127         "Unable to open the reason trail for instance " ++ instanceName ++
 128         " expected at " ++ fileName ++ ": " ++ show (e :: IOException)
 129       return []
 130     Right trailString ->
 131       case J.decode trailString of
 132         J.Ok t -> return t
 133         J.Error msg -> do
 134           logWarning $ "Unable to parse the reason trail: " ++ msg
 135           return []
 136
 137 -- | Determine the value of the status field for the report of one instance
 138 computeStatusField :: AdminState -> ActualState -> DCStatus
 139 computeStatusField AdminDown actualState =
 140   if actualState `notElem` [ActualShutdown, ActualDying]
 141     then DCStatus DCSCBad "The instance is not stopped as it should be"
 142     else DCStatus DCSCOk ""
 143 computeStatusField AdminUp ActualHung =
 144   DCStatus DCSCUnknown "Instance marked as running, but it appears to be hung"
 145 computeStatusField AdminUp actualState =
 146   if actualState `notElem` [ActualRunning, ActualBlocked]
 147     then DCStatus DCSCBad "The instance is not running as it should be"
 148     else DCStatus DCSCOk ""
 149 computeStatusField AdminOffline _ =
 150   -- FIXME: The "offline" status seems not to be used anywhere in the source
 151   -- code, but it is defined, so we have to consider it anyway here.
 152   DCStatus DCSCUnknown "The instance is marked as offline"
 153
 154 -- Builds the status of an instance using runtime information about the Xen
 155 -- Domains, their uptime information and the static information provided by
 156 -- the ConfD server.
 157 buildStatus :: Map.Map String Domain -> Map.Map Int UptimeInfo -> Instance
 158   -> IO InstStatus
 159 buildStatus domains uptimes inst = do
 160   let name = instName inst
 161       currDomain = Map.lookup name domains
 162       idNum = fmap domId currDomain
 163       currUInfo = idNum >>= (`Map.lookup` uptimes)
 164       uptime = fmap uInfoUptime currUInfo
 165       adminState = instAdminState inst
 166       actualState =
 167         if adminState == AdminDown && isNothing currDomain
 168           then ActualShutdown
 169           else case currDomain of
 170             (Just dom@(Domain _ _ _ _ (Just isHung))) ->
 171               if isHung
 172                 then ActualHung
 173                 else domState dom
 174             _ -> ActualUnknown
 175       status = computeStatusField adminState actualState
 176   trail <- getReasonTrail name
 177   return $
 178     InstStatus
 179       name
 180       (instUuid inst)
 181       adminState
 182       actualState
 183       uptime
 184       (instMtime inst)
 185       trail
 186       status
 187
 188 -- | Compute the status code and message, given the current DRBD data
 189 -- The final state will have the code corresponding to the worst code of
 190 -- all the devices, and the error message given from the concatenation of the
 191 -- non-empty error messages.
 192 computeGlobalStatus :: [InstStatus] -> DCStatus
 193 computeGlobalStatus instStatusList =
 194   let dcstatuses = map iStatStatus instStatusList
 195       statuses = map (\s -> (dcStatusCode s, dcStatusMessage s)) dcstatuses
 196       (code, strList) = foldr mergeStatuses (DCSCOk, [""]) statuses
 197   in DCStatus code $ intercalate "\n" strList
 198
 199 -- | Build the report of this data collector, containing all the information
 200 -- about the status of the instances.
 201 buildInstStatusReport :: Maybe String -> Maybe Int -> IO DCReport
 202 buildInstStatusReport srvAddr srvPort = do
 203   node <- getHostName
 204   answer <- getInstances node srvAddr srvPort
 205   inst <- exitIfBad "Can't get instance info from ConfD" answer
 206   domains <- getInferredDomInfo
 207   uptimes <- getUptimeInfo
 208   let primaryInst =  fst inst
 209   iStatus <- mapM (buildStatus domains uptimes) primaryInst
 210   let globalStatus = computeGlobalStatus iStatus
 211       jsonReport = J.showJSON $ ReportData iStatus globalStatus
 212   buildReport dcName dcVersion dcFormatVersion dcCategory dcKind jsonReport
 213
 214 -- | Main function.
 215 main :: Options -> [String] -> IO ()
 216 main opts _ = do
 217   report <- buildInstStatusReport (optConfdAddr opts) (optConfdPort opts)
 218   putStrLn $ J.encode report