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     , getInstPrimaryNode
  35     , buildLinkIpInstnameMap
  36     ) where
  37
  38 import Data.List (foldl')
  39 import qualified Data.Map as M
  40 import qualified Text.JSON as J
  41
  42 import Ganeti.HTools.JSON
  43 import Ganeti.BasicTypes
  44
  45 import qualified Ganeti.Constants as C
  46 import Ganeti.Objects
  47
  48 -- | Type alias for the link and ip map.
  49 type LinkIpMap = M.Map String (M.Map String String)
  50
  51 -- | Reads the config file.
  52 readConfig :: FilePath -> IO String
  53 readConfig = readFile
  54
  55 -- | Parses the configuration file.
  56 parseConfig :: String -> Result ConfigData
  57 parseConfig = fromJResult "parsing configuration" . J.decodeStrict
  58
  59 -- | Wrapper over 'readConfig' and 'parseConfig'.
  60 loadConfig :: FilePath -> IO (Result ConfigData)
  61 loadConfig = fmap parseConfig . readConfig
  62
  63 -- * Query functions
  64
  65 -- | Get instances of a given node.
  66 getNodeInstances :: ConfigData -> String -> ([Instance], [Instance])
  67 getNodeInstances cfg nname =
  68     let all_inst = M.elems . configInstances $ cfg
  69         pri_inst = filter ((== nname) . instPrimaryNode) all_inst
  70         -- FIXME: actually compute the secondary nodes
  71         sec_inst = undefined
  72     in (pri_inst, sec_inst)
  73
  74 -- | Returns the default cluster link.
  75 getDefaultNicLink :: ConfigData -> String
  76 getDefaultNicLink =
  77   nicpLink . (M.! C.ppDefault) . clusterNicparams . configCluster
  78
  79 -- | Returns instances of a given link.
  80 getInstancesIpByLink :: LinkIpMap -> String -> [String]
  81 getInstancesIpByLink linkipmap link =
  82   M.keys $ M.findWithDefault M.empty link linkipmap
  83
  84 -- | Generic lookup function that converts from a possible abbreviated
  85 -- name to a full name.
  86 getItem :: String -> String -> M.Map String a -> Result a
  87 getItem kind name allitems = do
  88   let lresult = lookupName (M.keys allitems) name
  89       err = \details -> Bad $ kind ++ " name " ++ name ++ " " ++ details
  90   fullname <- case lrMatchPriority lresult of
  91                 PartialMatch -> Ok $ lrContent lresult
  92                 ExactMatch -> Ok $ lrContent lresult
  93                 MultipleMatch -> err "has multiple matches"
  94                 FailMatch -> err "not found"
  95   maybe (err "not found after successfull match?!") Ok $
  96         M.lookup fullname allitems
  97
  98 -- | Looks up a node.
  99 getNode :: ConfigData -> String -> Result Node
 100 getNode cfg name = getItem "Node" name (configNodes cfg)
 101
 102 -- | Looks up an instance.
 103 getInstance :: ConfigData -> String -> Result Instance
 104 getInstance cfg name = getItem "Instance" name (configInstances cfg)
 105
 106 -- | Looks up an instance's primary node.
 107 getInstPrimaryNode :: ConfigData -> String -> Result Node
 108 getInstPrimaryNode cfg name =
 109   getInstance cfg name >>= return . instPrimaryNode >>= getNode cfg
 110
 111 -- | Builds link -> ip -> instname map.
 112 --
 113 -- TODO: improve this by splitting it into multiple independent functions:
 114 --
 115 -- * abstract the \"fetch instance with filled params\" functionality
 116 --
 117 -- * abstsract the [instance] -> [(nic, instance_name)] part
 118 --
 119 -- * etc.
 120 buildLinkIpInstnameMap :: ConfigData -> LinkIpMap
 121 buildLinkIpInstnameMap cfg =
 122   let cluster = configCluster cfg
 123       instances = M.elems . configInstances $ cfg
 124       defparams = (M.!) (clusterNicparams cluster) C.ppDefault
 125       nics = concatMap (\i -> [(instName i, nic) | nic <- instNics i])
 126              instances
 127   in foldl' (\accum (iname, nic) ->
 128                let pparams = nicNicparams nic
 129                    fparams = fillNICParams defparams pparams
 130                    link = nicpLink fparams
 131                in case nicIp nic of
 132                     Nothing -> accum
 133                     Just ip -> let oldipmap = M.findWithDefault (M.empty)
 134                                               link accum
 135                                    newipmap = M.insert ip iname oldipmap
 136                                in M.insert link newipmap accum
 137             ) M.empty nics