code.grnet.gr Git - ganeti-local/blob - htools/Ganeti/HTools/Rapi.hs

   1 {-| Implementation of the RAPI client interface.
   2
   3 -}
   4
   5 {-
   6
   7 Copyright (C) 2009, 2010, 2011 Google Inc.
   8
   9 This program is free software; you can redistribute it and/or modify
  10 it under the terms of the GNU General Public License as published by
  11 the Free Software Foundation; either version 2 of the License, or
  12 (at your option) any later version.
  13
  14 This program is distributed in the hope that it will be useful, but
  15 WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 General Public License for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with this program; if not, write to the Free Software
  21 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  22 02110-1301, USA.
  23
  24 -}
  25
  26 {-# LANGUAGE BangPatterns, CPP #-}
  27
  28 module Ganeti.HTools.Rapi
  29     (
  30       loadData
  31     , parseData
  32     ) where
  33
  34 import Data.Maybe (fromMaybe)
  35 #ifndef NO_CURL
  36 import Network.Curl
  37 import Network.Curl.Types ()
  38 #endif
  39 import Control.Monad
  40 import Text.JSON (JSObject, fromJSObject, decodeStrict)
  41 import Text.JSON.Types (JSValue(..))
  42 import Text.Printf (printf)
  43
  44 import Ganeti.HTools.Utils
  45 import Ganeti.HTools.Loader
  46 import Ganeti.HTools.Types
  47 import qualified Ganeti.HTools.Group as Group
  48 import qualified Ganeti.HTools.Node as Node
  49 import qualified Ganeti.HTools.Instance as Instance
  50 import qualified Ganeti.Constants as C
  51
  52 -- | Read an URL via curl and return the body if successful.
  53 getUrl :: (Monad m) => String -> IO (m String)
  54
  55 #ifdef NO_CURL
  56 getUrl _ = return $ fail "RAPI/curl backend disabled at compile time"
  57
  58 #else
  59
  60 -- | The curl options we use.
  61 curlOpts :: [CurlOption]
  62 curlOpts = [ CurlSSLVerifyPeer False
  63            , CurlSSLVerifyHost 0
  64            , CurlTimeout (fromIntegral queryTimeout)
  65            , CurlConnectTimeout (fromIntegral connTimeout)
  66            ]
  67
  68 getUrl url = do
  69   (code, !body) <- curlGetString url curlOpts
  70   return (case code of
  71             CurlOK -> return body
  72             _ -> fail $ printf "Curl error for '%s', error %s"
  73                  url (show code))
  74 #endif
  75
  76 -- | Append the default port if not passed in.
  77 formatHost :: String -> String
  78 formatHost master =
  79     if ':' `elem` master then  master
  80     else "https://" ++ master ++ ":" ++ show C.defaultRapiPort
  81
  82 -- | Parse a instance list in JSON format.
  83 getInstances :: NameAssoc
  84              -> String
  85              -> Result [(String, Instance.Instance)]
  86 getInstances ktn body =
  87     loadJSArray "Parsing instance data" body >>=
  88     mapM (parseInstance ktn . fromJSObject)
  89
  90 -- | Parse a node list in JSON format.
  91 getNodes :: NameAssoc -> String -> Result [(String, Node.Node)]
  92 getNodes ktg body = loadJSArray "Parsing node data" body >>=
  93                 mapM (parseNode ktg . fromJSObject)
  94
  95 -- | Parse a group list in JSON format.
  96 getGroups :: String -> Result [(String, Group.Group)]
  97 getGroups body = loadJSArray "Parsing group data" body >>=
  98                 mapM (parseGroup . fromJSObject)
  99
 100 -- | Generates a fake group list.
 101 getFakeGroups :: Result [(String, Group.Group)]
 102 getFakeGroups =
 103   return [(defaultGroupID,
 104            Group.create "default" defaultGroupID AllocPreferred)]
 105
 106 -- | Construct an instance from a JSON object.
 107 parseInstance :: NameAssoc
 108               -> JSRecord
 109               -> Result (String, Instance.Instance)
 110 parseInstance ktn a = do
 111   name <- tryFromObj "Parsing new instance" a "name"
 112   let owner_name = "Instance '" ++ name ++ "', error while parsing data"
 113   let extract s x = tryFromObj owner_name x s
 114   disk <- extract "disk_usage" a
 115   beparams <- liftM fromJSObject (extract "beparams" a)
 116   omem <- extract "oper_ram" a
 117   mem <- (case omem of
 118             JSRational _ _ -> annotateResult owner_name (fromJVal omem)
 119             _ -> extract "memory" beparams)
 120   vcpus <- extract "vcpus" beparams
 121   pnode <- extract "pnode" a >>= lookupNode ktn name
 122   snodes <- extract "snodes" a
 123   snode <- (if null snodes then return Node.noSecondary
 124             else readEitherString (head snodes) >>= lookupNode ktn name)
 125   running <- extract "status" a
 126   tags <- extract "tags" a
 127   auto_balance <- extract "auto_balance" beparams
 128   let inst = Instance.create name mem disk vcpus running tags
 129              auto_balance pnode snode
 130   return (name, inst)
 131
 132 -- | Construct a node from a JSON object.
 133 parseNode :: NameAssoc -> JSRecord -> Result (String, Node.Node)
 134 parseNode ktg a = do
 135   name <- tryFromObj "Parsing new node" a "name"
 136   let desc = "Node '" ++ name ++ "', error while parsing data"
 137       extract s = tryFromObj desc a s
 138   offline <- extract "offline"
 139   drained <- extract "drained"
 140   vm_cap  <- annotateResult desc $ maybeFromObj a "vm_capable"
 141   let vm_cap' = fromMaybe True vm_cap
 142   guuid   <- annotateResult desc $ maybeFromObj a "group.uuid"
 143   guuid' <-  lookupGroup ktg name (fromMaybe defaultGroupID guuid)
 144   node <- (if offline || drained || not vm_cap'
 145            then return $ Node.create name 0 0 0 0 0 0 True guuid'
 146            else do
 147              mtotal  <- extract "mtotal"
 148              mnode   <- extract "mnode"
 149              mfree   <- extract "mfree"
 150              dtotal  <- extract "dtotal"
 151              dfree   <- extract "dfree"
 152              ctotal  <- extract "ctotal"
 153              return $ Node.create name mtotal mnode mfree
 154                     dtotal dfree ctotal False guuid')
 155   return (name, node)
 156
 157 -- | Construct a group from a JSON object.
 158 parseGroup :: JSRecord -> Result (String, Group.Group)
 159 parseGroup a = do
 160   name <- tryFromObj "Parsing new group" a "name"
 161   let extract s = tryFromObj ("Group '" ++ name ++ "'") a s
 162   uuid <- extract "uuid"
 163   apol <- extract "alloc_policy"
 164   return (uuid, Group.create name uuid apol)
 165
 166 -- | Loads the raw cluster data from an URL.
 167 readData :: String -- ^ Cluster or URL to use as source
 168          -> IO (Result String, Result String, Result String, Result String)
 169 readData master = do
 170   let url = formatHost master
 171   group_body <- getUrl $ printf "%s/2/groups?bulk=1" url
 172   node_body <- getUrl $ printf "%s/2/nodes?bulk=1" url
 173   inst_body <- getUrl $ printf "%s/2/instances?bulk=1" url
 174   tags_body <- getUrl $ printf "%s/2/tags" url
 175   return (group_body, node_body, inst_body, tags_body)
 176
 177 -- | Builds the cluster data from the raw Rapi content.
 178 parseData :: (Result String, Result String, Result String, Result String)
 179           -> Result ClusterData
 180 parseData (group_body, node_body, inst_body, tags_body) = do
 181   group_data <-
 182       -- TODO: handle different ganeti versions properly, not via "all
 183       -- errors mean Ganeti 2.3"
 184       case group_body of
 185         Bad _ -> getFakeGroups
 186         Ok v -> getGroups v
 187   let (group_names, group_idx) = assignIndices group_data
 188   node_data <- node_body >>= getNodes group_names
 189   let (node_names, node_idx) = assignIndices node_data
 190   inst_data <- inst_body >>= getInstances node_names
 191   let (_, inst_idx) = assignIndices inst_data
 192   tags_data <- tags_body >>= (fromJResult "Parsing tags data" . decodeStrict)
 193   return (ClusterData group_idx node_idx inst_idx tags_data)
 194
 195 -- | Top level function for data loading.
 196 loadData :: String -- ^ Cluster or URL to use as source
 197          -> IO (Result ClusterData)
 198 loadData = fmap parseData . readData