X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/d752eb39e0c2c002d5b7bbd34cb64da18534164a..a334d536c7fbfaf875f678a32a6fc830837a735e:/Ganeti/HTools/Rapi.hs diff --git a/Ganeti/HTools/Rapi.hs b/Ganeti/HTools/Rapi.hs index f0790f6..58df9bd 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,14 +26,14 @@ 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 @@ -46,7 +46,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,70 +58,89 @@ 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 body = loadJSArray "Parsing node data" body >>= + mapM (parseNode . 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 :: [(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) - --- | 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 + 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" + 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) + +-- | 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_idx) = assignIndices inst_data - return (node_idx, 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.List, Instance.List, [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.List, Instance.List, [String])) +loadData master = readData master >>= return . parseData