X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/497e30a1b9417b47b20a785551615e40ffac30a6..31463db58ffa3ce346bdbf613a00263d14b17405:/Ganeti/HTools/Rapi.hs diff --git a/Ganeti/HTools/Rapi.hs b/Ganeti/HTools/Rapi.hs index ac0ff44..3f4a754 100644 --- a/Ganeti/HTools/Rapi.hs +++ b/Ganeti/HTools/Rapi.hs @@ -2,17 +2,38 @@ -} +{- + +Copyright (C) 2009 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 +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +02110-1301, USA. + +-} + 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 @@ -21,78 +42,104 @@ import Ganeti.HTools.Types import qualified Ganeti.HTools.Node as Node import qualified Ganeti.HTools.Instance as Instance --- | Read an URL via curl and return the body if successful +-- | Read an URL via curl and return the body if successful. 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" url (show code)) --- | Append the default port if not passed in +-- | 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 body = loadJSArray "Parsing node data" body >>= + mapM (parseNode . fromJSObject) -parseInstance :: [(String, Int)] - -> JSObject JSValue +-- | Construct an instance from a JSON object. +parseInstance :: [(String, Ndx)] + -> [(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" - 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 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) -parseNode :: JSObject JSValue -> Result (String, Node.Node) +-- | Construct a node from a JSON object. +parseNode :: [(String, 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 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 - return $ Node.create name mtotal mnode mfree - dtotal dfree (offline || drained)) - return (name, node) - -loadData :: String -- ^ Cluster/URL to use as source - -> IO (Result (NameAssoc, Node.AssocList, - NameAssoc, Instance.AssocList)) -loadData master = do -- IO monad + name <- tryFromObj "Parsing new node" a "name" + let extract s = tryFromObj ("Node '" ++ name ++ "'") a s + offline <- extract "offline" + drained <- extract "drained" + node <- (if offline || drained + then return $ Node.create name 0 0 0 0 0 0 True defaultUUID + 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 defaultUUID) + return (name, node) + +-- | Loads the raw cluster data from an URL. +readData :: String -- ^ Cluster or URL to use as source + -> IO (Result String, Result String, Result String) +readData master = do let url = formatHost master 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_names, inst_idx) = assignIndices inst_data - return (node_names, node_idx, inst_names, inst_idx) + tags_body <- getUrl $ printf "%s/2/tags" url + return (node_body, inst_body, tags_body) + +-- | Builds the cluster data from the raw Rapi content +parseData :: (Result String, Result String, Result String) + -> Result (Node.AssocList, Instance.AssocList, [String]) +parseData (node_body, inst_body, tags_body) = do + 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 + tags_data <- tags_body >>= (fromJResult "Parsing tags data" . decodeStrict) + return (node_idx, inst_idx, tags_data) + +-- | Top level function for data loading +loadData :: String -- ^ Cluster or URL to use as source + -> IO (Result (Node.AssocList, Instance.AssocList, [String])) +loadData master = readData master >>= return . parseData