diff --git a/src/Ganeti/HTools/Backend/IAlloc.hs b/src/Ganeti/HTools/Backend/IAlloc.hs index fe0746fc669f4cbcf40712fa2afed633d34c203b..6c3fdf161d5c0dbd409b314dce50cd4ceffc1589 100644 --- a/src/Ganeti/HTools/Backend/IAlloc.hs +++ b/src/Ganeti/HTools/Backend/IAlloc.hs @@ -34,6 +34,7 @@ import Data.Either () import Data.Maybe (fromMaybe, isJust, fromJust) import Data.List import Control.Monad +import System.Time import Text.JSON (JSObject, JSValue(JSArray), makeObj, encodeStrict, decodeStrict, fromJSObject, showJSON) @@ -138,9 +139,10 @@ parseGroup u a = do -- The result is a tuple of eventual warning messages and the parsed -- request; if parsing the input data fails, we'll return a 'Bad' -- value. -parseData :: String -- ^ The JSON message as received from Ganeti +parseData :: ClockTime -- ^ The current time + -> String -- ^ The JSON message as received from Ganeti -> Result ([String], Request) -- ^ Result tuple -parseData body = do +parseData now body = do decoded <- fromJResult "Parsing input IAllocator message" (decodeStrict body) let obj = fromJSObject decoded extrObj x = tryFromObj "invalid iallocator message" obj x @@ -165,7 +167,7 @@ parseData body = do let (kti, il) = assignIndices iobj -- cluster tags ctags <- extrObj "cluster_tags" - cdata1 <- mergeData [] [] [] [] (ClusterData gl nl il ctags defIPolicy) + cdata1 <- mergeData [] [] [] [] now (ClusterData gl nl il ctags defIPolicy) let (msgs, fix_nl) = checkData (cdNodes cdata1) (cdInstances cdata1) cdata = cdata1 { cdNodes = fix_nl } map_n = cdNodes cdata @@ -380,10 +382,11 @@ processRequest request = -- | Reads the request from the data file(s). readRequest :: FilePath -> IO Request readRequest fp = do + now <- getClockTime input_data <- case fp of "-" -> getContents _ -> readFile fp - case parseData input_data of + case parseData now input_data of Bad err -> exitErr err Ok (fix_msgs, rq) -> maybeShowWarnings fix_msgs >> return rq diff --git a/src/Ganeti/HTools/ExtLoader.hs b/src/Ganeti/HTools/ExtLoader.hs index 89b147843293f8182e53e7c89d011e0871c4c55e..a6b19a25b24b3d020e30c09159862b0dbe7d25c9 100644 --- a/src/Ganeti/HTools/ExtLoader.hs +++ b/src/Ganeti/HTools/ExtLoader.hs @@ -38,6 +38,7 @@ import Control.Exception import Data.Maybe (isJust, fromJust) import System.FilePath import System.IO +import System.Time (getClockTime) import Text.Printf (hPrintf) import qualified Ganeti.HTools.Backend.Luxi as Luxi @@ -107,8 +108,9 @@ loadExternalData opts = do | setFile -> wrapIO . Text.loadData $ fromJust tfile | setIAllocSrc -> wrapIO . IAlloc.loadData $ fromJust iallocsrc | otherwise -> return $ Bad "No backend selected! Exiting." + now <- getClockTime - let ldresult = input_data >>= mergeData util_data exTags selInsts exInsts + let ldresult = input_data >>= mergeData util_data exTags selInsts exInsts now cdata <- exitIfBad "failed to load data, aborting" ldresult let (fix_msgs, nl) = checkData (cdNodes cdata) (cdInstances cdata) diff --git a/src/Ganeti/HTools/Loader.hs b/src/Ganeti/HTools/Loader.hs index ab41f036446ce600f15d557c3c4552fe462c415d..f5b5c723dc15b96726e7ea10f6c44295c41df54e 100644 --- a/src/Ganeti/HTools/Loader.hs +++ b/src/Ganeti/HTools/Loader.hs @@ -182,11 +182,13 @@ setArPolicy :: [String] -- ^ Cluster tags -> Group.List -- ^ List of node groups -> Node.List -- ^ List of nodes -> Instance.List -- ^ List of instances + -> ClockTime -- ^ Current timestamp, to evaluate ArSuspended -> Instance.List -- ^ Updated list of instances -setArPolicy ctags gl nl il = - let cpol = fromMaybe ArNotEnabled $ getArPolicy ctags - gpols = Container.map (fromMaybe cpol . getArPolicy . Group.allTags) gl - ipolfn = getArPolicy . Instance.allTags +setArPolicy ctags gl nl il time = + let getArPolicy' = flip getArPolicy time + cpol = fromMaybe ArNotEnabled $ getArPolicy' ctags + gpols = Container.map (fromMaybe cpol . getArPolicy' . Group.allTags) gl + ipolfn = getArPolicy' . Instance.allTags nlookup = flip Container.find nl . Instance.pNode glookup = flip Container.find gpols . Node.group . nlookup updateInstance inst = inst { @@ -199,23 +201,22 @@ setArPolicy ctags gl nl il = -- This examines the ganeti:watcher:autorepair and -- ganeti:watcher:autorepair:suspend tags to determine the policy. If none of -- these tags are present, Nothing (and not ArNotEnabled) is returned. -getArPolicy :: [String] -> Maybe AutoRepairPolicy -getArPolicy tags = +getArPolicy :: [String] -> ClockTime -> Maybe AutoRepairPolicy +getArPolicy tags time = let enabled = mapMaybe (autoRepairTypeFromRaw <=< chompPrefix C.autoRepairTagEnabled) tags suspended = mapMaybe (chompPrefix C.autoRepairTagSuspended) tags - suspTime = if "" `elem` suspended - then Forever - else Until . flip TOD 0 . maximum $ - mapMaybe (tryRead "auto-repair suspend time") suspended + futureTs = filter (> time) . map (flip TOD 0) $ + mapMaybe (tryRead "auto-repair suspend time") suspended in case () of -- Note how we must return ArSuspended even if "enabled" is empty, so that -- node groups or instances can suspend repairs that were enabled at an -- upper scope (cluster or node group). - _ | not $ null suspended -> Just $ ArSuspended suspTime - | not $ null enabled -> Just $ ArEnabled (minimum enabled) - | otherwise -> Nothing + _ | "" `elem` suspended -> Just $ ArSuspended Forever + | not $ null futureTs -> Just . ArSuspended . Until . maximum $ futureTs + | not $ null enabled -> Just $ ArEnabled (minimum enabled) + | otherwise -> Nothing -- | Compute the longest common suffix of a list of strings that -- starts with a dot. @@ -244,10 +245,11 @@ mergeData :: [(String, DynUtil)] -- ^ Instance utilisation data -> [String] -- ^ Exclusion tags -> [String] -- ^ Selected instances (if not empty) -> [String] -- ^ Excluded instances + -> ClockTime -- ^ The current timestamp -> ClusterData -- ^ Data from backends -> Result ClusterData -- ^ Fixed cluster data -mergeData um extags selinsts exinsts cdata@(ClusterData gl nl il ctags _) = - let il2 = setArPolicy ctags gl nl il +mergeData um extags selinsts exinsts time cdata@(ClusterData gl nl il ctags _) = + let il2 = setArPolicy ctags gl nl il time il3 = foldl' (\im (name, n_util) -> case Container.findByName im name of Nothing -> im -- skipping unknown instance diff --git a/src/Ganeti/HTools/Program/Hscan.hs b/src/Ganeti/HTools/Program/Hscan.hs index 854b764d7ae8ec133187d541a41b5139a376c651..38829cdc2b77d3bb21e075c73e1b09d6ecfd51e1 100644 --- a/src/Ganeti/HTools/Program/Hscan.hs +++ b/src/Ganeti/HTools/Program/Hscan.hs @@ -34,6 +34,7 @@ import Data.Maybe (isJust, fromJust, fromMaybe) import System.Exit import System.IO import System.FilePath +import System.Time import Text.Printf (printf) @@ -89,9 +90,9 @@ fixSlash :: String -> String fixSlash = map (\x -> if x == '/' then '_' else x) -- | Generates serialized data from loader input. -processData :: ClusterData -> Result ClusterData -processData input_data = do - cdata@(ClusterData _ nl il _ _) <- mergeData [] [] [] [] input_data +processData :: ClockTime -> ClusterData -> Result ClusterData +processData now input_data = do + cdata@(ClusterData _ nl il _ _) <- mergeData [] [] [] [] now input_data let (_, fix_nl) = checkData nl il return cdata { cdNodes = fix_nl } @@ -106,7 +107,8 @@ writeData _ name _ (Bad err) = return False writeData nlen name opts (Ok cdata) = do - let fixdata = processData cdata + now <- getClockTime + let fixdata = processData now cdata case fixdata of Bad err -> printf "\nError for %s: failed to process data. Details:\n%s\n" name err >> return False diff --git a/test/hs/Test/Ganeti/HTools/Backend/Text.hs b/test/hs/Test/Ganeti/HTools/Backend/Text.hs index ce95ff79536f5a2f570ce3ef9359b64f7a56f28a..5763fa0a6160e2f5986d3e14e2d13645c44b3115 100644 --- a/test/hs/Test/Ganeti/HTools/Backend/Text.hs +++ b/test/hs/Test/Ganeti/HTools/Backend/Text.hs @@ -33,6 +33,7 @@ import Test.QuickCheck import qualified Data.Map as Map import Data.List import Data.Maybe +import System.Time (ClockTime(..)) import Test.Ganeti.TestHelper import Test.Ganeti.TestCommon @@ -191,7 +192,8 @@ prop_CreateSerialise = let cdata = Loader.ClusterData defGroupList nl' il' ctags Types.defIPolicy saved = Text.serializeCluster cdata - in case Text.parseData saved >>= Loader.mergeData [] [] [] [] of + in case Text.parseData saved >>= Loader.mergeData [] [] [] [] (TOD 0 0) + of Bad msg -> failTest $ "Failed to load/merge: " ++ msg Ok (Loader.ClusterData gl2 nl2 il2 ctags2 cpol2) -> conjoin [ ctags ==? ctags2 diff --git a/test/hs/Test/Ganeti/HTools/Loader.hs b/test/hs/Test/Ganeti/HTools/Loader.hs index e825f2bd49d182ca08a2307e52ca57693539e419..673a443d0fd936d96955a6185161e4c1e5a5fdd5 100644 --- a/test/hs/Test/Ganeti/HTools/Loader.hs +++ b/test/hs/Test/Ganeti/HTools/Loader.hs @@ -33,6 +33,7 @@ import Test.QuickCheck import qualified Data.IntMap as IntMap import qualified Data.Map as Map import Data.List +import System.Time (ClockTime(..)) import Test.Ganeti.TestHelper import Test.Ganeti.TestCommon @@ -71,7 +72,7 @@ prop_assignIndices = prop_mergeData :: [Node.Node] -> Bool prop_mergeData ns = let na = Container.fromList $ map (\n -> (Node.idx n, n)) ns - in case Loader.mergeData [] [] [] [] + in case Loader.mergeData [] [] [] [] (TOD 0 0) (Loader.emptyCluster {Loader.cdNodes = na}) of BasicTypes.Bad _ -> False BasicTypes.Ok (Loader.ClusterData _ nl il _ _) ->