X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/1a82215d952e916f7fef933827d07bca22c04063..6bc3997090f4d390047f228c7e82eefb46b3a0cf:/Ganeti/HTools/Rapi.hs diff --git a/Ganeti/HTools/Rapi.hs b/Ganeti/HTools/Rapi.hs index af236f0..cab5efe 100644 --- a/Ganeti/HTools/Rapi.hs +++ b/Ganeti/HTools/Rapi.hs @@ -4,7 +4,7 @@ {- -Copyright (C) 2009 Google Inc. +Copyright (C) 2009, 2010 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 @@ -26,19 +26,20 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA module Ganeti.HTools.Rapi ( loadData + , parseData ) where import Network.Curl import Network.Curl.Types () -import Network.Curl.Code -import Data.List import Control.Monad -import Text.JSON (JSObject, JSValue) +import Text.JSON (JSObject, JSValue, fromJSObject, decodeStrict) +import Text.JSON.Types (JSValue(..)) import Text.Printf (printf) import Ganeti.HTools.Utils import Ganeti.HTools.Loader import Ganeti.HTools.Types +import qualified Ganeti.HTools.Group as Group import qualified Ganeti.HTools.Node as Node import qualified Ganeti.HTools.Instance as Instance @@ -46,7 +47,10 @@ import qualified Ganeti.HTools.Instance as Instance getUrl :: (Monad m) => String -> IO (m String) getUrl url = do (code, body) <- curlGetString url [CurlSSLVerifyPeer False, - CurlSSLVerifyHost 0] + CurlSSLVerifyHost 0, + CurlTimeout (fromIntegral queryTimeout), + CurlConnectTimeout + (fromIntegral connTimeout)] return (case code of CurlOK -> return body _ -> fail $ printf "Curl error for '%s', error %s" @@ -55,71 +59,106 @@ getUrl url = do -- | Append the default port if not passed in. formatHost :: String -> String formatHost master = - if elem ':' master then master + if ':' `elem` master then master else "https://" ++ master ++ ":5080" -- | Parse a instance list in JSON format. getInstances :: NameAssoc -> String -> Result [(String, Instance.Instance)] -getInstances ktn body = do - arr <- loadJSArray body - ilist <- mapM (parseInstance ktn) arr - return ilist +getInstances ktn body = + loadJSArray "Parsing instance data" body >>= + mapM (parseInstance ktn . fromJSObject) -- | Parse a node list in JSON format. -getNodes :: String -> Result [(String, Node.Node)] -getNodes body = do - arr <- loadJSArray body - nlist <- mapM parseNode arr - return nlist +getNodes :: NameAssoc -> String -> Result [(String, Node.Node)] +getNodes ktg body = loadJSArray "Parsing node data" body >>= + mapM (parseNode ktg . fromJSObject) + +-- | Parse a group list in JSON format. +getGroups :: String -> Result [(String, Group.Group)] +getGroups body = loadJSArray "Parsing group data" body >>= + mapM (parseGroup . fromJSObject) -- | Construct an instance from a JSON object. -parseInstance :: [(String, Ndx)] - -> JSObject JSValue +parseInstance :: NameAssoc + -> [(String, JSValue)] -> Result (String, Instance.Instance) parseInstance ktn a = do - name <- fromObj "name" a - disk <- fromObj "disk_usage" a - mem <- fromObj "beparams" a >>= fromObj "memory" - vcpus <- fromObj "beparams" a >>= fromObj "vcpus" - pnode <- fromObj "pnode" a >>= lookupNode ktn name - snodes <- fromObj "snodes" a + name <- tryFromObj "Parsing new instance" a "name" + let owner_name = "Instance '" ++ name ++ "'" + let extract s x = tryFromObj owner_name x s + disk <- extract "disk_usage" a + beparams <- liftM fromJSObject (extract "beparams" a) + omem <- extract "oper_ram" a + mem <- (case omem of + JSRational _ _ -> annotateResult owner_name (fromJVal omem) + _ -> extract "memory" beparams) + vcpus <- extract "vcpus" beparams + pnode <- extract "pnode" a >>= lookupNode ktn name + snodes <- extract "snodes" a snode <- (if null snodes then return Node.noSecondary else readEitherString (head snodes) >>= lookupNode ktn name) - running <- fromObj "status" a - let inst = Instance.create name mem disk vcpus running pnode snode + running <- extract "status" a + tags <- extract "tags" a + let inst = Instance.create name mem disk vcpus running tags pnode snode return (name, inst) -- | Construct a node from a JSON object. -parseNode :: JSObject JSValue -> Result (String, Node.Node) -parseNode a = do - name <- fromObj "name" a - offline <- fromObj "offline" a - node <- (case offline of - True -> return $ Node.create name 0 0 0 0 0 0 True - _ -> do - drained <- fromObj "drained" a - mtotal <- fromObj "mtotal" a - mnode <- fromObj "mnode" a - mfree <- fromObj "mfree" a - dtotal <- fromObj "dtotal" a - dfree <- fromObj "dfree" a - ctotal <- fromObj "ctotal" a - return $ Node.create name mtotal mnode mfree - dtotal dfree ctotal (offline || drained)) - return (name, node) - --- | Builds the cluster data from an URL. -loadData :: String -- ^ Cluster or URL to use as source - -> IO (Result (Node.AssocList, Instance.AssocList)) -loadData master = do -- IO monad +parseNode :: NameAssoc -> [(String, JSValue)] -> Result (String, Node.Node) +parseNode ktg a = do + name <- tryFromObj "Parsing new node" a "name" + let extract s = tryFromObj ("Node '" ++ name ++ "'") a s + offline <- extract "offline" + drained <- extract "drained" + guuid <- extract "group.uuid" >>= lookupGroup ktg name + node <- (if offline || drained + then return $ Node.create name 0 0 0 0 0 0 True guuid + else do + mtotal <- extract "mtotal" + mnode <- extract "mnode" + mfree <- extract "mfree" + dtotal <- extract "dtotal" + dfree <- extract "dfree" + ctotal <- extract "ctotal" + return $ Node.create name mtotal mnode mfree + dtotal dfree ctotal False guuid) + return (name, node) + +-- | Construct a group from a JSON object. +parseGroup :: [(String, JSValue)] -> Result (String, Group.Group) +parseGroup a = do + name <- tryFromObj "Parsing new group" a "name" + let extract s = tryFromObj ("Group '" ++ name ++ "'") a s + uuid <- extract "uuid" + apol <- extract "alloc_policy" + return (uuid, Group.create name uuid apol) + +-- | Loads the raw cluster data from an URL. +readData :: String -- ^ Cluster or URL to use as source + -> IO (Result String, Result String, Result String, Result String) +readData master = do let url = formatHost master + group_body <- getUrl $ printf "%s/2/groups?bulk=1" url node_body <- getUrl $ printf "%s/2/nodes?bulk=1" url inst_body <- getUrl $ printf "%s/2/instances?bulk=1" url - return $ do -- Result monad - node_data <- node_body >>= getNodes - let (node_names, node_idx) = assignIndices node_data - inst_data <- inst_body >>= getInstances node_names - let (_, inst_idx) = assignIndices inst_data - return (node_idx, inst_idx) + tags_body <- getUrl $ printf "%s/2/tags" url + return (group_body, node_body, inst_body, tags_body) + +-- | Builds the cluster data from the raw Rapi content +parseData :: (Result String, Result String, Result String, Result String) + -> Result ClusterData +parseData (group_body, node_body, inst_body, tags_body) = do + group_data <- group_body >>= getGroups + let (group_names, group_idx) = assignIndices group_data + node_data <- node_body >>= getNodes group_names + let (node_names, node_idx) = assignIndices node_data + inst_data <- inst_body >>= getInstances node_names + let (_, inst_idx) = assignIndices inst_data + tags_data <- tags_body >>= (fromJResult "Parsing tags data" . decodeStrict) + return (ClusterData group_idx node_idx inst_idx tags_data) + +-- | Top level function for data loading +loadData :: String -- ^ Cluster or URL to use as source + -> IO (Result ClusterData) +loadData master = readData master >>= return . parseData