Commit 6e7c1645 authored by Ilias Tsitsimpis's avatar Ilias Tsitsimpis Committed by Jose A. Lopes
Browse files

Use 'getInstDisks' function to retrieve the disks



Change Haskell's Query code to use Config's 'getInstDisks' function in
order to retrieve the instance's disks.
Signed-off-by: default avatarIlias Tsitsimpis <iliastsi@grnet.gr>
Reviewed-by: default avatarJose A. Lopes <jabolopes@google.com>
parent 31b430c5
......@@ -201,7 +201,7 @@ buildResponse cdata req@(ConfdRequest { confdRqType = ReqNodeDrbd }) = do
PlainQuery str -> return str
_ -> fail $ "Invalid query type " ++ show (confdRqQuery req)
node <- gntErrorToResult $ getNode cfg node_name
let minors = concatMap (getInstMinorsForNode (nodeUuid node)) .
let minors = concatMap (getInstMinorsForNode cfg (nodeUuid node)) .
M.elems . fromContainer . configInstances $ cfg
encoded <- mapM (encodeMinors cfg) minors
return (ReplyStatusOk, J.showJSON encoded)
......@@ -228,7 +228,7 @@ buildResponse cdata req@(ConfdRequest { confdRqType = ReqInstanceDisks }) = do
case confdRqQuery req of
PlainQuery str -> return str
_ -> fail $ "Invalid query type " ++ show (confdRqQuery req)
case getInstDisksByName cfg inst_uuid of
case getInstDisks cfg inst_uuid of
Ok disks -> return (ReplyStatusOk, J.showJSON disks)
Bad e -> fail $ "Could not retrieve disks: " ++ show e
......
......@@ -114,19 +114,22 @@ computeDiskNodes dsk =
-- | Computes all disk-related nodes of an instance. For non-DRBD,
-- this will be empty, for DRBD it will contain both the primary and
-- the secondaries.
instDiskNodes :: Instance -> S.Set String
instDiskNodes = S.unions . map computeDiskNodes . instDisks
instDiskNodes :: ConfigData -> Instance -> S.Set String
instDiskNodes cfg inst =
case getInstDisksFromObj cfg inst of
Ok disks -> S.unions $ map computeDiskNodes disks
Bad _ -> S.empty
-- | Computes all nodes of an instance.
instNodes :: Instance -> S.Set String
instNodes inst = instPrimaryNode inst `S.insert` instDiskNodes inst
instNodes :: ConfigData -> Instance -> S.Set String
instNodes cfg inst = instPrimaryNode inst `S.insert` instDiskNodes cfg inst
-- | Computes the secondary nodes of an instance. Since this is valid
-- only for DRBD, we call directly 'instDiskNodes', skipping over the
-- extra primary insert.
instSecondaryNodes :: Instance -> S.Set String
instSecondaryNodes inst =
instPrimaryNode inst `S.delete` instDiskNodes inst
instSecondaryNodes :: ConfigData -> Instance -> S.Set String
instSecondaryNodes cfg inst =
instPrimaryNode inst `S.delete` instDiskNodes cfg inst
-- | Get instances of a given node.
-- The node is specified through its UUID.
......@@ -134,7 +137,7 @@ getNodeInstances :: ConfigData -> String -> ([Instance], [Instance])
getNodeInstances cfg nname =
let all_inst = M.elems . fromContainer . configInstances $ cfg
pri_inst = filter ((== nname) . instPrimaryNode) all_inst
sec_inst = filter ((nname `S.member`) . instSecondaryNodes) all_inst
sec_inst = filter ((nname `S.member`) . instSecondaryNodes cfg) all_inst
in (pri_inst, sec_inst)
-- | Computes the role of a node.
......@@ -338,8 +341,8 @@ getDrbdDiskNodes cfg disk =
-- the primary node has to be appended to the results.
getInstAllNodes :: ConfigData -> String -> ErrorResult [Node]
getInstAllNodes cfg name = do
inst <- getInstance cfg name
let diskNodes = concatMap (getDrbdDiskNodes cfg) $ instDisks inst
inst_disks <- getInstDisks cfg name
let diskNodes = concatMap (getDrbdDiskNodes cfg) inst_disks
pNode <- getInstPrimaryNode cfg name
return . nub $ pNode:diskNodes
......@@ -377,21 +380,25 @@ roleSecondary = "secondary"
-- | Gets the list of DRBD minors for an instance that are related to
-- a given node.
getInstMinorsForNode :: String -- ^ The UUID of a node.
getInstMinorsForNode :: ConfigData
-> String -- ^ The UUID of a node.
-> Instance
-> [(String, Int, String, String, String, String)]
getInstMinorsForNode node inst =
getInstMinorsForNode cfg node inst =
let role = if node == instPrimaryNode inst
then rolePrimary
else roleSecondary
iname = instName inst
inst_disks = case getInstDisksFromObj cfg inst of
Ok disks -> disks
Bad _ -> []
-- FIXME: the disk/ build there is hack-ish; unify this in a
-- separate place, or reuse the iv_name (but that is deprecated on
-- the Python side)
in concatMap (\(idx, dsk) ->
[(node, minor, iname, "disk/" ++ show idx, role, peer)
| (minor, peer) <- getDrbdMinorsForNode node dsk]) .
zip [(0::Int)..] . instDisks $ inst
zip [(0::Int)..] $ inst_disks
-- | Builds link -> ip -> instname map.
--
......
......@@ -47,7 +47,6 @@ module Ganeti.Objects
, fillBeParams
, allBeParamFields
, Instance(..)
, getDiskSizeRequirements
, PartialNDParams(..)
, FilledNDParams(..)
, fillNDParams
......@@ -485,19 +484,6 @@ instance SerialNoObject Instance where
instance TagsObject Instance where
tagsOf = instTags
-- | Retrieves the real disk size requirements for all the disks of the
-- instance. This includes the metadata etc. and is different from the values
-- visible to the instance.
getDiskSizeRequirements :: Instance -> Int
getDiskSizeRequirements inst =
sum . map
(\disk -> case instDiskTemplate inst of
DTDrbd8 -> diskSize disk + C.drbdMetaSize
DTDiskless -> 0
DTBlock -> 0
_ -> diskSize disk )
$ instDisks inst
-- * IPolicy definitions
$(buildParam "ISpec" "ispec"
......
......@@ -31,6 +31,7 @@ module Ganeti.Query.Common
, rsMaybeNoData
, rsMaybeUnavail
, rsErrorNoData
, rsErrorMaybeUnavail
, rsUnknown
, missingRuntime
, rpcErrorToStatus
......@@ -115,6 +116,16 @@ rsErrorNoData res = case res of
rsMaybeUnavail :: (JSON a) => Maybe a -> ResultEntry
rsMaybeUnavail = maybe rsUnavail rsNormal
-- | Helper to declare a result from 'ErrorResult Maybe'. This version
-- should be used if an error signals there was no data and at the same
-- time when we have optional fields that may not be setted (i.e. we
-- want to return a 'RSUnavail' in case of 'Nothing').
rsErrorMaybeUnavail :: (JSON a) => ErrorResult (Maybe a) -> ResultEntry
rsErrorMaybeUnavail res =
case res of
Ok x -> rsMaybeUnavail x
Bad _ -> rsNoData
-- | Helper for unknown field result.
rsUnknown :: ResultEntry
rsUnknown = ResultEntry RSUnknown Nothing
......
......@@ -177,42 +177,38 @@ instanceFields =
[ (FieldDefinition "disk_usage" "DiskUsage" QFTUnit
"Total disk space used by instance on each of its nodes; this is not the\
\ disk size visible to the instance, but the usage on the node",
FieldSimple (rsNormal . getDiskSizeRequirements), QffNormal)
FieldConfig getDiskSizeRequirements, QffNormal)
, (FieldDefinition "disk.count" "Disks" QFTNumber
"Number of disks",
FieldSimple (rsNormal . length . instDisks), QffNormal)
, (FieldDefinition "disk.sizes" "Disk_sizes" QFTOther
"List of disk sizes",
FieldSimple (rsNormal . map diskSize . instDisks), QffNormal)
FieldConfig getDiskSizes, QffNormal)
, (FieldDefinition "disk.spindles" "Disk_spindles" QFTOther
"List of disk spindles",
FieldSimple (rsNormal . map (MaybeForJSON . diskSpindles) .
instDisks),
QffNormal)
FieldConfig getDiskSpindles, QffNormal)
, (FieldDefinition "disk.names" "Disk_names" QFTOther
"List of disk names",
FieldSimple (rsNormal . map (MaybeForJSON . diskName) .
instDisks),
QffNormal)
FieldConfig getDiskNames, QffNormal)
, (FieldDefinition "disk.uuids" "Disk_UUIDs" QFTOther
"List of disk UUIDs",
FieldSimple (rsNormal . map diskUuid . instDisks), QffNormal)
FieldConfig getDiskUuids, QffNormal)
] ++
-- Per-disk parameter fields
instantiateIndexedFields C.maxDisks
[ (fieldDefinitionCompleter "disk.size/%d" "Disk/%d" QFTUnit
"Disk size of %s disk",
getIndexedField instDisks diskSize, QffNormal)
"Disk size of %s disk",
getIndexedConfField getInstDisksFromObj diskSize, QffNormal)
, (fieldDefinitionCompleter "disk.spindles/%d" "DiskSpindles/%d" QFTNumber
"Spindles of %s disk",
getIndexedOptionalField instDisks diskSpindles, QffNormal)
"Spindles of %s disk",
getIndexedOptionalConfField getInstDisksFromObj diskSpindles, QffNormal)
, (fieldDefinitionCompleter "disk.name/%d" "DiskName/%d" QFTText
"Name of %s disk",
getIndexedOptionalField instDisks diskName, QffNormal)
"Name of %s disk",
getIndexedOptionalConfField getInstDisksFromObj diskName, QffNormal)
, (fieldDefinitionCompleter "disk.uuid/%d" "DiskUUID/%d" QFTText
"UUID of %s disk",
getIndexedField instDisks diskUuid, QffNormal)
"UUID of %s disk",
getIndexedConfField getInstDisksFromObj diskUuid, QffNormal)
] ++
-- Aggregate nic parameter fields
......@@ -358,6 +354,70 @@ getDefaultNicParams :: ConfigData -> FilledNicParams
getDefaultNicParams cfg =
(Map.!) (fromContainer . clusterNicparams . configCluster $ cfg) C.ppDefault
-- | Retrieves the real disk size requirements for all the disks of the
-- instance. This includes the metadata etc. and is different from the values
-- visible to the instance.
getDiskSizeRequirements :: ConfigData -> Instance -> ResultEntry
getDiskSizeRequirements cfg inst =
rsErrorNoData . liftA (sum . map getSizes) . getInstDisksFromObj cfg $ inst
where
getSizes :: Disk -> Int
getSizes disk =
case instDiskTemplate inst of
DTDrbd8 -> diskSize disk + C.drbdMetaSize
DTDiskless -> 0
DTBlock -> 0
_ -> diskSize disk
-- | Get a list of disk sizes for an instance
getDiskSizes :: ConfigData -> Instance -> ResultEntry
getDiskSizes cfg =
rsErrorNoData . liftA (map diskSize) . getInstDisksFromObj cfg
-- | Get a list of disk spindles
getDiskSpindles :: ConfigData -> Instance -> ResultEntry
getDiskSpindles cfg =
rsErrorNoData . liftA (map (MaybeForJSON . diskSpindles)) .
getInstDisksFromObj cfg
-- | Get a list of disk names for an instance
getDiskNames :: ConfigData -> Instance -> ResultEntry
getDiskNames cfg =
rsErrorNoData . liftA (map (MaybeForJSON . diskName)) .
getInstDisksFromObj cfg
-- | Get a list of disk UUIDs for an instance
getDiskUuids :: ConfigData -> Instance -> ResultEntry
getDiskUuids cfg =
rsErrorNoData . liftA (map diskUuid) . getInstDisksFromObj cfg
-- | Creates a functions which produces a FieldConfig 'FieldGetter' when fed
-- an index. Works for fields that may not return a value, expressed through
-- the Maybe monad.
getIndexedOptionalConfField :: (J.JSON b)
=> (ConfigData -> Instance -> ErrorResult [a])
-- ^ Extracts a list of objects
-> (a -> Maybe b) -- ^ Possibly gets a property
-- from an object
-> Int -- ^ Index in list to use
-> FieldGetter Instance Runtime -- ^ Result
getIndexedOptionalConfField extractor optPropertyGetter index =
let getProperty x = maybeAt index x >>= optPropertyGetter
in FieldConfig (\cfg ->
rsErrorMaybeUnavail . liftA getProperty . extractor cfg)
-- | Creates a function which produces a FieldConfig 'FieldGetter' when fed
-- an index. Works only for fields that surely return a value.
getIndexedConfField :: (J.JSON b)
=> (ConfigData -> Instance -> ErrorResult [a])
-- ^ Extracts a list of objects
-> (a -> b) -- ^ Gets a property from an object
-> Int -- ^ Index in list to use
-> FieldGetter Instance Runtime -- ^ Result
getIndexedConfField extractor propertyGetter index =
let optPropertyGetter = Just . propertyGetter
in getIndexedOptionalConfField extractor optPropertyGetter index
-- | Returns a field that retrieves a given NIC's network name.
getIndexedNicNetworkNameField :: Int -> FieldGetter Instance Runtime
getIndexedNicNetworkNameField index =
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment