Implement QueryFields for Nodes

[ganeti-local] / htools / Ganeti / Queryd.hs

diff --git a/htools/Ganeti/Queryd.hs b/htools/Ganeti/Queryd.hs
index 4f265bd..621d804 100644 (file)
--- a/htools/Ganeti/Queryd.hs
+++ b/htools/Ganeti/Queryd.hs
@@ -26,9 +26,11 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 -}
 
 module Ganeti.Queryd
+  ( ConfigReader
+  , runQueryD
+  ) where
 
-where
-
+import Control.Applicative
 import Control.Concurrent
 import Control.Exception
 import Data.Bits (bitSize)
@@ -40,12 +42,14 @@ import Text.JSON.Pretty (pp_value)
 import System.Info (arch)
 
 import qualified Ganeti.Constants as C
+import Ganeti.Daemon
 import Ganeti.Objects
---import Ganeti.Config
+import qualified Ganeti.Config as Config
 import Ganeti.BasicTypes
 import Ganeti.Logging
 import Ganeti.Luxi
-
+import qualified Ganeti.Qlang as Qlang
+import Ganeti.Query.Query
 
 -- | A type for functions that can return the configuration when
 -- executed.
@@ -65,8 +69,6 @@ handleCall cdata QueryClusterInfo =
       hypervisors = clusterEnabledHypervisors cluster
       bits = show (bitSize (0::Int)) ++ "bits"
       arch_tuple = [bits, arch]
-      -- FIXME: this is for the missing *params fields
-      empty_params = showJSON $ J.makeObj ([]::[(String, JSValue)])
       obj = [ ("software_version", showJSON $ C.releaseVersion)
             , ("protocol_version", showJSON $ C.protocolVersion)
             , ("config_version", showJSON $ C.configVersion)
@@ -77,15 +79,14 @@ handleCall cdata QueryClusterInfo =
             , ("master", showJSON $ clusterMasterNode cluster)
             , ("default_hypervisor", showJSON $ head hypervisors)
             , ("enabled_hypervisors", showJSON $ hypervisors)
-            -- FIXME: *params missing
-            , ("hvparams", empty_params)
-            , ("os_hvp", empty_params)
+            , ("hvparams", showJSON $ clusterHvparams cluster)
+            , ("os_hvp", showJSON $ clusterOsHvp cluster)
             , ("beparams", showJSON $ clusterBeparams cluster)
             , ("osparams", showJSON $ clusterOsparams cluster)
             , ("ipolicy", showJSON $ clusterIpolicy cluster)
             , ("nicparams", showJSON $ clusterNicparams cluster)
             , ("ndparams", showJSON $ clusterNdparams cluster)
-            , ("diskparams", empty_params)
+            , ("diskparams", showJSON $ clusterDiskparams cluster)
             , ("candidate_pool_size",
                showJSON $ clusterCandidatePoolSize cluster)
             , ("master_netdev",  showJSON $ clusterMasterNetdev cluster)
@@ -118,6 +119,22 @@ handleCall cdata QueryClusterInfo =
 
   in return . Ok . J.makeObj $ obj
 
+handleCall cfg (QueryTags kind name) =
+  let tags = case kind of
+               TagCluster -> Ok . clusterTags $ configCluster cfg
+               TagGroup -> groupTags <$> Config.getGroup cfg name
+               TagNode -> nodeTags <$> Config.getNode cfg name
+               TagInstance -> instTags <$> Config.getInstance cfg name
+  in return (J.showJSON <$> tags)
+
+handleCall cfg (Query qkind qfields qfilter) = do
+  result <- query cfg (Qlang.Query qkind qfields qfilter)
+  return $ J.showJSON <$> result
+
+handleCall _ (QueryFields qkind qfields) = do
+  let result = queryFields (Qlang.QueryFields qkind qfields)
+  return $ J.showJSON <$> result
+
 handleCall _ op =
   return . Bad $ "Luxi call '" ++ strOfOp op ++ "' not implemented"
 
@@ -131,9 +148,10 @@ handleClientMsg client creader args = do
   call_result <- handleCallWrapper cfg args
   (!status, !rval) <-
     case call_result of
-      Bad x -> do
-        logWarning $ "Failed to execute request: " ++ x
-        return (False, JSString $ J.toJSString x)
+      Bad err -> do
+        let errmsg = "Failed to execute request: " ++ err
+        logWarning errmsg
+        return (False, showJSON errmsg)
       Ok result -> do
         logDebug $ "Result " ++ show (pp_value result)
         return (True, result)
@@ -151,8 +169,11 @@ handleClient client creader = do
                      return False
     RecvOk payload ->
       case validateCall payload >>= decodeCall of
-        Bad err -> logWarning ("Failed to parse request: " ++ err) >>
-                   return False
+        Bad err -> do
+             let errmsg = "Failed to parse request: " ++ err
+             logWarning errmsg
+             sendMsg client $ buildResponse False (showJSON errmsg)
+             return False
         Ok args -> handleClientMsg client creader args
 
 -- | Main client loop: runs one loop of 'handleClient', and if that
@@ -177,6 +198,7 @@ mainLoop creader socket = do
 runQueryD :: Maybe FilePath -> ConfigReader -> IO ()
 runQueryD fpath creader = do
   let socket_path = fromMaybe C.querySocket fpath
+  cleanupSocket socket_path
   bracket
     (getServer socket_path)
     (closeServer socket_path)