That is, for a pair "group" and "volume". The data type (de)serializes to/from JSON as a String of the form "group/volume".
Signed-off-by: Petr Pudlak <[email protected]> --- src/Ganeti/DataCollectors/Lv.hs | 5 ++- src/Ganeti/Objects.hs | 78 ++++++++++++++++++++++++++++++++++++----- test/hs/Test/Ganeti/Objects.hs | 27 +++++++++----- 3 files changed, 91 insertions(+), 19 deletions(-) diff --git a/src/Ganeti/DataCollectors/Lv.hs b/src/Ganeti/DataCollectors/Lv.hs index 933a1df..02232f0 100644 --- a/src/Ganeti/DataCollectors/Lv.hs +++ b/src/Ganeti/DataCollectors/Lv.hs @@ -151,9 +151,8 @@ getInstDiskList opts = do -- | Adds the name of the instance to the information about one logical volume. addInstNameToOneLv :: [(Instance, [Disk])] -> LVInfo -> LVInfo addInstNameToOneLv instDiskList lvInfo = - let vg_name = lviVgName lvInfo - lv_name = lviName lvInfo - instanceHasDisk = any (includesLogicalId vg_name lv_name) . snd + let lv = LogicalVolume (lviVgName lvInfo) (lviName lvInfo) + instanceHasDisk = any (includesLogicalId lv) . snd rightInstance = find instanceHasDisk instDiskList in case rightInstance of diff --git a/src/Ganeti/Objects.hs b/src/Ganeti/Objects.hs index 58e5500..cd46cdd 100644 --- a/src/Ganeti/Objects.hs +++ b/src/Ganeti/Objects.hs @@ -39,6 +39,7 @@ module Ganeti.Objects , PartialNic(..) , FileDriver(..) , DRBDSecret + , LogicalVolume(..) , DiskLogicalId(..) , Disk(..) , includesLogicalId @@ -95,7 +96,8 @@ module Ganeti.Objects ) where import Control.Applicative -import Data.List (foldl') +import Data.Char +import Data.List (foldl', isPrefixOf, isInfixOf) import Data.Maybe import qualified Data.Map as Map import qualified Data.Set as Set @@ -112,6 +114,7 @@ import Ganeti.Types import Ganeti.THH import Ganeti.THH.Field import Ganeti.Utils (sepSplit, tryRead, parseUnitAssumeBinary) +import Ganeti.Utils.Validate -- * Generic definitions @@ -282,12 +285,70 @@ type DiskParams = Container JSValue -- | An alias for DRBD secrets type DRBDSecret = String +-- Represents a group name and a volume name. +-- +-- From @man lvm@: +-- +-- The following characters are valid for VG and LV names: a-z A-Z 0-9 + _ . - +-- +-- VG and LV names cannot begin with a hyphen. There are also various reserved +-- names that are used internally by lvm that can not be used as LV or VG names. +-- A VG cannot be called anything that exists in /dev/ at the time of +-- creation, nor can it be called '.' or '..'. A LV cannot be called '.' '..' +-- 'snapshot' or 'pvmove'. The LV name may also not contain the strings '_mlog' +-- or '_mimage' +data LogicalVolume = LogicalVolume { lvGroup :: String + , lvVolume :: String + } + deriving (Eq, Ord) + +instance Show LogicalVolume where + showsPrec _ (LogicalVolume g v) = + showString g . showString "/" . showString v + +-- | Check the constraints for a VG/LV names (except the @/dev/@ check). +instance Validatable LogicalVolume where + validate (LogicalVolume g v) = do + let vgn = "Volume group name" + -- Group name checks + nonEmpty vgn g + validChars vgn g + notStartsDash vgn g + notIn vgn g [".", ".."] + -- Volume name checks + let lvn = "Volume name" + nonEmpty lvn v + validChars lvn v + notStartsDash lvn v + notIn lvn v [".", "..", "snapshot", "pvmove"] + reportIf ("_mlog" `isInfixOf` v) $ lvn ++ " must not contain '_mlog'." + reportIf ("_mimage" `isInfixOf` v) $ lvn ++ "must not contain '_mimage'." + where + nonEmpty prefix x = reportIf (null x) $ prefix ++ " must be non-empty" + notIn prefix x = + mapM_ (\y -> reportIf (x == y) + $ prefix ++ " must not be '" ++ y ++ "'") + notStartsDash prefix x = reportIf ("-" `isPrefixOf` x) + $ prefix ++ " must not start with '-'" + validChars prefix x = + reportIf (not . all validChar $ x) + $ prefix ++ " must consist only of [a-z][A-Z][0-9][+_.-]" + validChar c = isAsciiLower c || isAsciiUpper c || isDigit c + || (c `elem` "+_.-") + +instance J.JSON LogicalVolume where + showJSON = J.showJSON . show + readJSON (J.JSString s) | (g, _ : l) <- break (== '/') (J.fromJSString s) = + either fail return . evalValidate . validate' $ LogicalVolume g l + readJSON v = fail $ "Invalid JSON value " ++ show v + ++ " for a logical volume" + -- | The disk configuration type. This includes the disk type itself, -- for a more complete consistency. Note that since in the Python -- code-base there's no authoritative place where we document the -- logical id, this is probably a good reference point. data DiskLogicalId - = LIDPlain String String -- ^ Volume group, logical volume + = LIDPlain LogicalVolume -- ^ Volume group, logical volume | LIDDrbd8 String String Int Int Int DRBDSecret -- ^ NodeA, NodeB, Port, MinorA, MinorB, Secret | LIDFile FileDriver String -- ^ Driver, path @@ -313,7 +374,8 @@ lidEncodeType v = [(devType, showJSON . lidDiskType $ v)] -- | Custom encoder for DiskLogicalId (logical id only). encodeDLId :: DiskLogicalId -> JSValue -encodeDLId (LIDPlain vg lv) = JSArray [showJSON vg, showJSON lv] +encodeDLId (LIDPlain (LogicalVolume vg lv)) = + JSArray [showJSON vg, showJSON lv] encodeDLId (LIDDrbd8 nodeA nodeB port minorA minorB key) = JSArray [ showJSON nodeA, showJSON nodeB, showJSON port , showJSON minorA, showJSON minorB, showJSON key ] @@ -352,7 +414,7 @@ decodeDLId obj lid = do JSArray [vg, lv] -> do vg' <- readJSON vg lv' <- readJSON lv - return $ LIDPlain vg' lv' + return $ LIDPlain (LogicalVolume vg' lv') _ -> fail "Can't read logical_id for plain type" DTFile -> case lid of @@ -439,12 +501,12 @@ instance UuidObject Disk where -- | Determines whether a disk or one of his children has the given logical id -- (determined by the volume group name and by the logical volume name). -- This can be true only for DRBD or LVM disks. -includesLogicalId :: String -> String -> Disk -> Bool -includesLogicalId vg_name lv_name disk = +includesLogicalId :: LogicalVolume -> Disk -> Bool +includesLogicalId lv disk = case diskLogicalId disk of - LIDPlain vg lv -> vg_name == vg && lv_name == lv + LIDPlain lv' -> lv' == lv LIDDrbd8 {} -> - any (includesLogicalId vg_name lv_name) $ diskChildren disk + any (includesLogicalId lv) $ diskChildren disk _ -> False -- * Instance definitions diff --git a/test/hs/Test/Ganeti/Objects.hs b/test/hs/Test/Ganeti/Objects.hs index 6a4aaae..033feea 100644 --- a/test/hs/Test/Ganeti/Objects.hs +++ b/test/hs/Test/Ganeti/Objects.hs @@ -79,8 +79,14 @@ $(genArbitrary ''BlockDriver) $(genArbitrary ''DiskMode) +instance Arbitrary LogicalVolume where + arbitrary = LogicalVolume <$> validName <*> validName + where + validName = -- we intentionally omit '.' and '-' to avoid forbidden names + listOf1 $ elements (['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "+_") + instance Arbitrary DiskLogicalId where - arbitrary = oneof [ LIDPlain <$> arbitrary <*> arbitrary + arbitrary = oneof [ LIDPlain <$> arbitrary , LIDDrbd8 <$> genFQDN <*> genFQDN <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary , LIDFile <$> arbitrary <*> arbitrary @@ -560,19 +566,24 @@ casePyCompatInstances = do mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding") ) $ zip instances decoded +-- | A helper function for creating 'LIDPlain' values. +mkLIDPlain :: String -> String -> DiskLogicalId +mkLIDPlain = (LIDPlain .) . LogicalVolume + -- | Tests that the logical ID is correctly found in a plain disk caseIncludeLogicalIdPlain :: HUnit.Assertion caseIncludeLogicalIdPlain = let vg_name = "xenvg" :: String lv_name = "1234sdf-qwef-2134-asff-asd2-23145d.data" :: String + lv = LogicalVolume vg_name lv_name time = TOD 0 0 d = - Disk (LIDPlain vg_name lv_name) [] "diskname" 1000 DiskRdWr + Disk (LIDPlain lv) [] "diskname" 1000 DiskRdWr Nothing Nothing Nothing "asdfgr-1234-5123-daf3-sdfw-134f43" 0 time time in HUnit.assertBool "Unable to detect that plain Disk includes logical ID" $ - includesLogicalId vg_name lv_name d + includesLogicalId lv d -- | Tests that the logical ID is correctly found in a DRBD disk caseIncludeLogicalIdDrbd :: HUnit.Assertion @@ -583,15 +594,15 @@ caseIncludeLogicalIdDrbd = d = Disk (LIDDrbd8 "node1.example.com" "node2.example.com" 2000 1 5 "secret") - [ Disk (LIDPlain "onevg" "onelv") [] "disk1" 1000 DiskRdWr Nothing + [ Disk (mkLIDPlain "onevg" "onelv") [] "disk1" 1000 DiskRdWr Nothing Nothing Nothing "145145-asdf-sdf2-2134-asfd-534g2x" 0 time time - , Disk (LIDPlain vg_name lv_name) [] "disk2" 1000 DiskRdWr Nothing + , Disk (mkLIDPlain vg_name lv_name) [] "disk2" 1000 DiskRdWr Nothing Nothing Nothing "6gd3sd-423f-ag2j-563b-dg34-gj3fse" 0 time time ] "diskname" 1000 DiskRdWr Nothing Nothing Nothing "asdfgr-1234-5123-daf3-sdfw-134f43" 0 time time in HUnit.assertBool "Unable to detect that plain Disk includes logical ID" $ - includesLogicalId vg_name lv_name d + includesLogicalId (LogicalVolume vg_name lv_name) d -- | Tests that the logical ID is correctly NOT found in a plain disk caseNotIncludeLogicalIdPlain :: HUnit.Assertion @@ -600,12 +611,12 @@ caseNotIncludeLogicalIdPlain = lv_name = "1234sdf-qwef-2134-asff-asd2-23145d.data" :: String time = TOD 0 0 d = - Disk (LIDPlain "othervg" "otherlv") [] "diskname" 1000 DiskRdWr + Disk (mkLIDPlain "othervg" "otherlv") [] "diskname" 1000 DiskRdWr Nothing Nothing Nothing "asdfgr-1234-5123-daf3-sdfw-134f43" 0 time time in HUnit.assertBool "Unable to detect that plain Disk includes logical ID" $ - not (includesLogicalId vg_name lv_name d) + not (includesLogicalId (LogicalVolume vg_name lv_name) d) testSuite "Objects" [ 'prop_fillDict -- 2.0.0.526.g5318336
