diff --git a/src/Ganeti/Query/Export.hs b/src/Ganeti/Query/Export.hs index 6a9671b97a0070521d37ecf0e2599b3ef1965f3a..08635730101529fc443ec87244022e0c846ec985 100644 --- a/src/Ganeti/Query/Export.hs +++ b/src/Ganeti/Query/Export.hs @@ -58,7 +58,7 @@ rpcExtractor node (Left err) = [(node, rpcErrToRs err)] exportFields :: FieldList Node Runtime exportFields = [ (FieldDefinition "node" "Node" QFTText "Node name", - FieldSimple (rsNormal . nodeName), QffNormal) + FieldSimple (rsNormal . nodeName), QffHostname) , (FieldDefinition "export" "Export" QFTText "Export name", FieldRuntime (curry fst), QffNormal) ] diff --git a/src/Ganeti/Query/Filter.hs b/src/Ganeti/Query/Filter.hs index b4da1380b09eebd991f185a503d47d5dd279a561..ced50a929fcedc2c6a19fea8e76c4da35bc8c962 100644 --- a/src/Ganeti/Query/Filter.hs +++ b/src/Ganeti/Query/Filter.hs @@ -25,7 +25,7 @@ between the two runs, hence we will not get inconsistent results). {- -Copyright (C) 2012 Google Inc. +Copyright (C) 2012, 2013 Google Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -79,6 +79,7 @@ compileFilter fm = -- | Processes a field value given a QffMode. qffField :: QffMode -> JSValue -> ErrorResult JSValue qffField QffNormal v = Ok v +qffField QffHostname v = Ok v qffField QffTimestamp v = case v of JSArray [secs@(JSRational _ _), JSRational _ _] -> return secs @@ -92,19 +93,23 @@ wrapGetter :: ConfigData -> Maybe b -> a -> (FieldGetter a b, QffMode) - -> (JSValue -> ErrorResult Bool) + -> (QffMode -> JSValue -> ErrorResult Bool) -> ErrorResult Bool wrapGetter cfg b a (getter, qff) faction = case tryGetter cfg b a getter of Nothing -> Ok True -- runtime missing, accepting the value Just v -> case v of - ResultEntry RSNormal (Just fval) -> qffField qff fval >>= faction + ResultEntry RSNormal (Just fval) -> qffField qff fval >>= faction qff ResultEntry RSNormal Nothing -> Bad $ ProgrammerError "Internal error: Getter returned RSNormal/Nothing" _ -> Ok True -- filter has no data to work, accepting it +-- | Wrapper alias over field functions to ignore their first Qff argument. +ignoreMode :: a -> QffMode -> a +ignoreMode = const + -- | Helper to evaluate a filter getter (and the value it generates) in -- a boolean context. trueFilter :: JSValue -> ErrorResult Bool @@ -118,6 +123,25 @@ trueFilter v = Bad . ParameterError $ -- and for them to be used in multiple contexts. type Comparator = (Eq a, Ord a) => a -> a -> Bool +-- | Equality checker. +-- +-- This will handle hostnames correctly, if the mode is set to +-- 'QffHostname'. +eqFilter :: FilterValue -> QffMode -> JSValue -> ErrorResult Bool +-- send 'QffNormal' queries to 'binOpFilter' +eqFilter flv QffNormal jsv = binOpFilter (==) flv jsv +-- and 'QffTimestamp' as well +eqFilter flv QffTimestamp jsv = binOpFilter (==) flv jsv +-- error out if we set 'QffHostname' on a non-string field +eqFilter _ QffHostname (JSRational _ _) = + Bad . ProgrammerError $ "QffHostname field returned a numeric value" +-- test strings via 'compareNameComponent' +eqFilter (QuotedString y) QffHostname (JSString x) = + Ok $ goodLookupResult (fromJSString x `compareNameComponent` y) +-- send all other combinations (all errors) to 'binOpFilter', which +-- has good error messages +eqFilter flv _ jsv = binOpFilter (==) flv jsv + -- | Helper to evaluate a filder getter (and the value it generates) -- in a boolean context. Note the order of arguments is reversed from -- the filter definitions (due to the call chain), make sure to @@ -178,21 +202,21 @@ evaluateFilter c mb a (OrFilter flts) = helper flts evaluateFilter c mb a (NotFilter flt) = not <$> evaluateFilter c mb a flt evaluateFilter c mb a (TrueFilter getter) = - wrapGetter c mb a getter trueFilter + wrapGetter c mb a getter $ ignoreMode trueFilter evaluateFilter c mb a (EQFilter getter val) = - wrapGetter c mb a getter (binOpFilter (==) val) + wrapGetter c mb a getter (eqFilter val) evaluateFilter c mb a (LTFilter getter val) = - wrapGetter c mb a getter (binOpFilter (<) val) + wrapGetter c mb a getter $ ignoreMode (binOpFilter (<) val) evaluateFilter c mb a (LEFilter getter val) = - wrapGetter c mb a getter (binOpFilter (<=) val) + wrapGetter c mb a getter $ ignoreMode (binOpFilter (<=) val) evaluateFilter c mb a (GTFilter getter val) = - wrapGetter c mb a getter (binOpFilter (>) val) + wrapGetter c mb a getter $ ignoreMode (binOpFilter (>) val) evaluateFilter c mb a (GEFilter getter val) = - wrapGetter c mb a getter (binOpFilter (>=) val) + wrapGetter c mb a getter $ ignoreMode (binOpFilter (>=) val) evaluateFilter c mb a (RegexpFilter getter re) = - wrapGetter c mb a getter (regexpFilter re) + wrapGetter c mb a getter $ ignoreMode (regexpFilter re) evaluateFilter c mb a (ContainsFilter getter val) = - wrapGetter c mb a getter (containsFilter val) + wrapGetter c mb a getter $ ignoreMode (containsFilter val) -- | Runs a getter with potentially missing runtime context. tryGetter :: ConfigData -> Maybe b -> a -> FieldGetter a b -> Maybe ResultEntry diff --git a/src/Ganeti/Query/Node.hs b/src/Ganeti/Query/Node.hs index 55830542389361e7fa4d02e68fc29e8ba50c75a1..e639351ab1e9aaee327fcfd975fe9aa9ef525022 100644 --- a/src/Ganeti/Query/Node.hs +++ b/src/Ganeti/Query/Node.hs @@ -140,7 +140,7 @@ nodeFields = "Whether node can become a master candidate", FieldSimple (rsNormal . nodeMasterCapable), QffNormal) , (FieldDefinition "name" "Node" QFTText "Node name", - FieldSimple (rsNormal . nodeName), QffNormal) + FieldSimple (rsNormal . nodeName), QffHostname) , (FieldDefinition "offline" "Offline" QFTBool "Whether node is marked offline", FieldSimple (rsNormal . nodeOffline), QffNormal) diff --git a/src/Ganeti/Query/Types.hs b/src/Ganeti/Query/Types.hs index c9cbbbcdd242751b58348df2fe76925879216168..4c74dbaa2c1ba42e3fab742c010e93de2ccb0e09 100644 --- a/src/Ganeti/Query/Types.hs +++ b/src/Ganeti/Query/Types.hs @@ -7,7 +7,7 @@ use the library should not need to import it. {- -Copyright (C) 2012 Google Inc. +Copyright (C) 2012, 2013 Google Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -56,6 +56,7 @@ data FieldGetter a b = FieldSimple (a -> ResultEntry) -- don't use OR-able values. data QffMode = QffNormal -- ^ Value is used as-is in filters | QffTimestamp -- ^ Value is a timestamp tuple, convert to float + | QffHostname -- ^ Value is a hostname, compare it smartly deriving (Show, Eq) diff --git a/test/hs/Test/Ganeti/Query/Query.hs b/test/hs/Test/Ganeti/Query/Query.hs index db5ae8853d819bca8cbf104bba3f110e09a985fc..43efbe2f7608a12f7a7f452f3bdde96f78bf9e20 100644 --- a/test/hs/Test/Ganeti/Query/Query.hs +++ b/test/hs/Test/Ganeti/Query/Query.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell, BangPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Unittests for ganeti-htools. @@ -36,6 +36,7 @@ import Data.Function (on) import Data.List import qualified Data.Map as Map import Data.Maybe +import qualified Data.Set as Set import Text.JSON (JSValue(..), showJSON) import Test.Ganeti.TestHelper @@ -44,12 +45,15 @@ import Test.Ganeti.Objects (genEmptyCluster) import Ganeti.BasicTypes import Ganeti.Errors +import Ganeti.JSON +import Ganeti.Objects import Ganeti.Query.Filter import qualified Ganeti.Query.Group as Group import Ganeti.Query.Language import qualified Ganeti.Query.Node as Node import Ganeti.Query.Query import qualified Ganeti.Query.Job as Job +import Ganeti.Utils (sepSplit) {-# ANN module "HLint: ignore Use camelCase" #-} @@ -163,6 +167,34 @@ case_queryNode_allfields = do (sortBy field_sort . map (\(f, _, _) -> f) $ Map.elems Node.fieldsMap) (sortBy field_sort fdefs) +-- | Check if cluster node names are unique (first elems). +areNodeNamesSane :: ConfigData -> Bool +areNodeNamesSane cfg = + let fqdns = map nodeName . Map.elems . fromContainer $ configNodes cfg + names = map (head . sepSplit '.') fqdns + in length names == length (nub names) + +-- | Check that the nodes reported by a name filter are sane. +prop_queryNode_filter :: Property +prop_queryNode_filter = + forAll (choose (1, maxNodes)) $ \nodes -> + forAll (genEmptyCluster nodes `suchThat` + areNodeNamesSane) $ \cluster -> monadicIO $ do + let node_list = map nodeName . Map.elems . fromContainer $ + configNodes cluster + count <- pick $ choose (1, nodes) + fqdn_set <- pick . genSetHelper node_list $ Just count + let fqdns = Set.elems fqdn_set + names = map (head . sepSplit '.') fqdns + flt = makeSimpleFilter "name" $ map Left names + QueryResult _ fdata <- + run (query cluster False (Query (ItemTypeOpCode QRNode) + ["name"] flt)) >>= resultProp + stop $ conjoin + [ printTestCase "Invalid node names" $ + map (map rentryValue) fdata ==? map (\f -> [Just (showJSON f)]) fqdns + ] + -- ** Group queries prop_queryGroup_noUnknown :: Property @@ -328,6 +360,7 @@ testSuite "Query/Query" [ 'prop_queryNode_noUnknown , 'prop_queryNode_Unknown , 'prop_queryNode_types + , 'prop_queryNode_filter , 'case_queryNode_allfields , 'prop_queryGroup_noUnknown , 'prop_queryGroup_Unknown