diff --git a/htools/Ganeti/HTools/Cluster.hs b/htools/Ganeti/HTools/Cluster.hs index 9500aeafa79213e88dbc52ca39bca6e9186b720e..ea8661587e37bb1d3de343664aa37e947c8a3a14 100644 --- a/htools/Ganeti/HTools/Cluster.hs +++ b/htools/Ganeti/HTools/Cluster.hs @@ -902,6 +902,12 @@ nodeEvacInstance nl il mode inst@(Instance.Instance failOnSecondaryChange mode dt >> evacOneNodeOnly nl il inst gdx avail_nodes +nodeEvacInstance nl il mode inst@(Instance.Instance + {Instance.diskTemplate = dt@DTExt}) + gdx avail_nodes = + failOnSecondaryChange mode dt >> + evacOneNodeOnly nl il inst gdx avail_nodes + nodeEvacInstance nl il ChangePrimary inst@(Instance.Instance {Instance.diskTemplate = DTDrbd8}) _ _ = diff --git a/htools/Ganeti/HTools/Instance.hs b/htools/Ganeti/HTools/Instance.hs index 76465cee4e8152e7b6c2ab84dfd60e145e338b91..44d0891ffdcba92cdf3d1c3371b7896610558cc6 100644 --- a/htools/Ganeti/HTools/Instance.hs +++ b/htools/Ganeti/HTools/Instance.hs @@ -144,6 +144,7 @@ movableDiskTemplates = , T.DTBlock , T.DTSharedFile , T.DTRbd + , T.DTExt ] -- | A simple name for the int, instance association list. diff --git a/htools/Ganeti/HTools/Types.hs b/htools/Ganeti/HTools/Types.hs index b6e92b7394fe032a6f6d1eb369b71a2dbf9f93f4..14ff195183fb82deaf22ab49adf31357fe93e632 100644 --- a/htools/Ganeti/HTools/Types.hs +++ b/htools/Ganeti/HTools/Types.hs @@ -123,6 +123,7 @@ $(THH.declareSADT "DiskTemplate" , ("DTBlock", 'C.dtBlock) , ("DTDrbd8", 'C.dtDrbd8) , ("DTRbd", 'C.dtRbd) + , ("DTExt", 'C.dtExt) ]) $(THH.makeJSONInstance ''DiskTemplate) @@ -141,6 +142,7 @@ templateMirrorType DTPlain = MirrorNone templateMirrorType DTBlock = MirrorExternal templateMirrorType DTDrbd8 = MirrorInternal templateMirrorType DTRbd = MirrorExternal +templateMirrorType DTExt = MirrorExternal -- | The Group allocation policy type. -- diff --git a/htools/Ganeti/Objects.hs b/htools/Ganeti/Objects.hs index 6aa064994daa3afec2314532816cff7e18b3ee49..75715789343baf3f1bb188d610d20d059c54e919 100644 --- a/htools/Ganeti/Objects.hs +++ b/htools/Ganeti/Objects.hs @@ -96,6 +96,7 @@ $(declareSADT "DiskType" , ("LD_FILE", 'C.ldFile) , ("LD_BLOCKDEV", 'C.ldBlockdev) , ("LD_RADOS", 'C.ldRbd) + , ("LD_EXT", 'C.ldExt) ]) $(makeJSONInstance ''DiskType) @@ -127,6 +128,7 @@ data DiskLogicalId | LIDFile FileDriver String -- ^ Driver, path | LIDBlockDev BlockDriver String -- ^ Driver, path (must be under /dev) | LIDRados String String -- ^ Unused, path + | LIDExt String String -- ^ ExtProvider, unique name deriving (Read, Show, Eq) -- | Mapping from a logical id to a disk type. @@ -136,6 +138,7 @@ lidDiskType (LIDDrbd8 {}) = LD_DRBD8 lidDiskType (LIDFile {}) = LD_FILE lidDiskType (LIDBlockDev {}) = LD_BLOCKDEV lidDiskType (LIDRados {}) = LD_RADOS +lidDiskType (LIDExt {}) = LD_EXT -- | Builds the extra disk_type field for a given logical id. lidEncodeType :: DiskLogicalId -> [(String, JSValue)] @@ -150,6 +153,7 @@ encodeDLId (LIDDrbd8 nodeA nodeB port minorA minorB key) = encodeDLId (LIDRados pool name) = JSArray [showJSON pool, showJSON name] encodeDLId (LIDFile driver name) = JSArray [showJSON driver, showJSON name] encodeDLId (LIDBlockDev driver name) = JSArray [showJSON driver, showJSON name] +encodeDLId (LIDExt extprovider name) = JSArray [showJSON extprovider, showJSON name] -- | Custom encoder for DiskLogicalId, composing both the logical id -- and the extra disk_type field. @@ -201,6 +205,13 @@ decodeDLId obj lid = do path' <- readJSON path return $ LIDRados driver' path' _ -> fail $ "Can't read logical_id for rdb type" + LD_EXT -> + case lid of + JSArray [extprovider, name] -> do + extprovider' <- readJSON extprovider + name' <- readJSON name + return $ LIDExt extprovider' name' + _ -> fail $ "Can't read logical_id for extstorage type" -- | Disk data structure. -- @@ -235,6 +246,7 @@ $(declareSADT "DiskTemplate" , ("DTPlain", 'C.dtPlain) , ("DTBlock", 'C.dtBlock) , ("DTDrbd8", 'C.dtDrbd8) + , ("DTExt", 'C.dtExt) ]) $(makeJSONInstance ''DiskTemplate)