code.grnet.gr Git - ganeti-local/blob - htools/Ganeti/Config.hs

   1 {-| Implementation of the Ganeti configuration database.
   2
   3 -}
   4
   5 {-
   6
   7 Copyright (C) 2011, 2012 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.Config
  27     ( LinkIpMap
  28     , loadConfig
  29     , getNodeInstances
  30     , getDefaultNicLink
  31     , getInstancesIpByLink
  32     , getNode
  33     , getInstance
  34     , getGroup
  35     , getInstPrimaryNode
  36     , getInstMinorsForNode
  37     , buildLinkIpInstnameMap
  38     , instNodes
  39     ) where
  40
  41 import Control.Monad (liftM)
  42 import Data.List (foldl')
  43 import qualified Data.Map as M
  44 import qualified Data.Set as S
  45 import qualified Text.JSON as J
  46
  47 import Ganeti.HTools.JSON
  48 import Ganeti.BasicTypes
  49
  50 import qualified Ganeti.Constants as C
  51 import Ganeti.Objects
  52
  53 -- | Type alias for the link and ip map.
  54 type LinkIpMap = M.Map String (M.Map String String)
  55
  56 -- | Reads the config file.
  57 readConfig :: FilePath -> IO String
  58 readConfig = readFile
  59
  60 -- | Parses the configuration file.
  61 parseConfig :: String -> Result ConfigData
  62 parseConfig = fromJResult "parsing configuration" . J.decodeStrict
  63
  64 -- | Wrapper over 'readConfig' and 'parseConfig'.
  65 loadConfig :: FilePath -> IO (Result ConfigData)
  66 loadConfig = fmap parseConfig . readConfig
  67
  68 -- * Query functions
  69
  70 -- | Computes the nodes covered by a disk.
  71 computeDiskNodes :: Disk -> S.Set String
  72 computeDiskNodes dsk =
  73   case diskLogicalId dsk of
  74     LIDDrbd8 nodeA nodeB _ _ _ _ -> S.fromList [nodeA, nodeB]
  75     _ -> S.empty
  76
  77 -- | Computes all disk-related nodes of an instance. For non-DRBD,
  78 -- this will be empty, for DRBD it will contain both the primary and
  79 -- the secondaries.
  80 instDiskNodes :: Instance -> S.Set String
  81 instDiskNodes = S.unions . map computeDiskNodes . instDisks
  82
  83 -- | Computes all nodes of an instance.
  84 instNodes :: Instance -> S.Set String
  85 instNodes inst = instPrimaryNode inst `S.insert` instDiskNodes inst
  86
  87 -- | Computes the secondary nodes of an instance. Since this is valid
  88 -- only for DRBD, we call directly 'instDiskNodes', skipping over the
  89 -- extra primary insert.
  90 instSecondaryNodes :: Instance -> S.Set String
  91 instSecondaryNodes inst =
  92   instPrimaryNode inst `S.delete` instDiskNodes inst
  93
  94 -- | Get instances of a given node.
  95 getNodeInstances :: ConfigData -> String -> ([Instance], [Instance])
  96 getNodeInstances cfg nname =
  97     let all_inst = M.elems . fromContainer . configInstances $ cfg
  98         pri_inst = filter ((== nname) . instPrimaryNode) all_inst
  99         sec_inst = filter ((nname `S.member`) . instSecondaryNodes) all_inst
 100     in (pri_inst, sec_inst)
 101
 102 -- | Returns the default cluster link.
 103 getDefaultNicLink :: ConfigData -> String
 104 getDefaultNicLink =
 105   nicpLink . (M.! C.ppDefault) . fromContainer .
 106   clusterNicparams . configCluster
 107
 108 -- | Returns instances of a given link.
 109 getInstancesIpByLink :: LinkIpMap -> String -> [String]
 110 getInstancesIpByLink linkipmap link =
 111   M.keys $ M.findWithDefault M.empty link linkipmap
 112
 113 -- | Generic lookup function that converts from a possible abbreviated
 114 -- name to a full name.
 115 getItem :: String -> String -> M.Map String a -> Result a
 116 getItem kind name allitems = do
 117   let lresult = lookupName (M.keys allitems) name
 118       err = \details -> Bad $ kind ++ " name " ++ name ++ " " ++ details
 119   fullname <- case lrMatchPriority lresult of
 120                 PartialMatch -> Ok $ lrContent lresult
 121                 ExactMatch -> Ok $ lrContent lresult
 122                 MultipleMatch -> err "has multiple matches"
 123                 FailMatch -> err "not found"
 124   maybe (err "not found after successfull match?!") Ok $
 125         M.lookup fullname allitems
 126
 127 -- | Looks up a node.
 128 getNode :: ConfigData -> String -> Result Node
 129 getNode cfg name = getItem "Node" name (fromContainer $ configNodes cfg)
 130
 131 -- | Looks up an instance.
 132 getInstance :: ConfigData -> String -> Result Instance
 133 getInstance cfg name =
 134   getItem "Instance" name (fromContainer $ configInstances cfg)
 135
 136 -- | Looks up a node group. This is more tricky than for
 137 -- node/instances since the groups map is indexed by uuid, not name.
 138 getGroup :: ConfigData -> String -> Result NodeGroup
 139 getGroup cfg name =
 140   let groups = fromContainer (configNodegroups cfg)
 141   in case getItem "NodeGroup" name groups of
 142        -- if not found by uuid, we need to look it up by name, slow
 143        Ok grp -> Ok grp
 144        Bad _ -> let by_name = M.mapKeys
 145                               (\k -> groupName ((M.!) groups k )) groups
 146                 in getItem "NodeGroup" name by_name
 147
 148 -- | Looks up an instance's primary node.
 149 getInstPrimaryNode :: ConfigData -> String -> Result Node
 150 getInstPrimaryNode cfg name =
 151   liftM instPrimaryNode (getInstance cfg name) >>= getNode cfg
 152
 153 -- | Filters DRBD minors for a given node.
 154 getDrbdMinorsForNode :: String -> Disk -> [(Int, String)]
 155 getDrbdMinorsForNode node disk =
 156   let child_minors = concatMap (getDrbdMinorsForNode node) (diskChildren disk)
 157       this_minors =
 158         case diskLogicalId disk of
 159           LIDDrbd8 nodeA nodeB _ minorA minorB _
 160             | nodeA == node -> [(minorA, nodeB)]
 161             | nodeB == node -> [(minorB, nodeA)]
 162           _ -> []
 163   in this_minors ++ child_minors
 164
 165 -- | String for primary role.
 166 rolePrimary :: String
 167 rolePrimary = "primary"
 168
 169 -- | String for secondary role.
 170 roleSecondary :: String
 171 roleSecondary = "secondary"
 172
 173 -- | Gets the list of DRBD minors for an instance that are related to
 174 -- a given node.
 175 getInstMinorsForNode :: String -> Instance
 176                      -> [(String, Int, String, String, String, String)]
 177 getInstMinorsForNode node inst =
 178   let role = if node == instPrimaryNode inst
 179                then rolePrimary
 180                else roleSecondary
 181       iname = instName inst
 182   -- FIXME: the disk/ build there is hack-ish; unify this in a
 183   -- separate place, or reuse the iv_name (but that is deprecated on
 184   -- the Python side)
 185   in concatMap (\(idx, dsk) ->
 186             [(node, minor, iname, "disk/" ++ show idx, role, peer)
 187                | (minor, peer) <- getDrbdMinorsForNode node dsk]) .
 188      zip [(0::Int)..] . instDisks $ inst
 189
 190 -- | Builds link -> ip -> instname map.
 191 --
 192 -- TODO: improve this by splitting it into multiple independent functions:
 193 --
 194 -- * abstract the \"fetch instance with filled params\" functionality
 195 --
 196 -- * abstsract the [instance] -> [(nic, instance_name)] part
 197 --
 198 -- * etc.
 199 buildLinkIpInstnameMap :: ConfigData -> LinkIpMap
 200 buildLinkIpInstnameMap cfg =
 201   let cluster = configCluster cfg
 202       instances = M.elems . fromContainer . configInstances $ cfg
 203       defparams = (M.!) (fromContainer $ clusterNicparams cluster) C.ppDefault
 204       nics = concatMap (\i -> [(instName i, nic) | nic <- instNics i])
 205              instances
 206   in foldl' (\accum (iname, nic) ->
 207                let pparams = nicNicparams nic
 208                    fparams = fillNICParams defparams pparams
 209                    link = nicpLink fparams
 210                in case nicIp nic of
 211                     Nothing -> accum
 212                     Just ip -> let oldipmap = M.findWithDefault (M.empty)
 213                                               link accum
 214                                    newipmap = M.insert ip iname oldipmap
 215                                in M.insert link newipmap accum
 216             ) M.empty nics