Statistics
| Branch: | Tag: | Revision:

root / Ganeti / HTools / Rapi.hs @ 5aa48dbe

History | View | Annotate | Download (3 kB)

1
{-| Implementation of the RAPI client interface.
2

    
3
-}
4

    
5
module Ganeti.HTools.Rapi
6
    (
7
      getNodes
8
    , getInstances
9
    ) where
10

    
11
import Network.Curl
12
import Network.Curl.Types ()
13
import Network.Curl.Code
14
import Data.Either ()
15
import Data.Maybe
16
import Control.Monad
17
import Text.JSON (JSObject, JSValue)
18
import Text.Printf (printf)
19
import Ganeti.HTools.Utils
20

    
21

    
22
-- Some constants
23

    
24
-- | The fixed drbd overhead per disk (only used with 1.2's sdx_size)
25
drbdOverhead = 128
26

    
27
getUrl :: String -> IO (Result String)
28
getUrl url = do
29
  (code, body) <- curlGetString url [CurlSSLVerifyPeer False,
30
                                     CurlSSLVerifyHost 0]
31
  return (case code of
32
            CurlOK -> Ok body
33
            _ -> Bad $ printf "Curl error for '%s', error %s"
34
                 url (show code))
35

    
36
getInstances :: String -> IO (Result String)
37
getInstances master = do
38
  let url2 = printf "https://%s:5080/2/instances?bulk=1" master
39
  body <- getUrl url2
40
  return $ (body >>= \x -> do
41
              arr <- loadJSArray x
42
              ilist <- mapM parseInstance arr
43
              return $ unlines ilist)
44

    
45
getNodes :: String -> IO (Result String)
46
getNodes master = do
47
  let url2 = printf "https://%s:5080/2/nodes?bulk=1" master
48
  body <- getUrl url2
49
  return $ (body >>= \x -> do
50
             arr <- loadJSArray x
51
             nlist <- mapM parseNode arr
52
             return $ unlines nlist)
53

    
54
parseInstance :: JSObject JSValue -> Result String
55
parseInstance a =
56
    let name = getStringElement "name" a
57
        disk = case getIntElement "disk_usage" a of
58
                 Bad _ -> let log_sz = liftM2 (+)
59
                                       (getIntElement "sda_size" a)
60
                                       (getIntElement "sdb_size" a)
61
                          in liftM2 (+) log_sz (Ok $ drbdOverhead * 2)
62
                 x@(Ok _) -> x
63
        bep = fromObj "beparams" a
64
        pnode = getStringElement "pnode" a
65
        snode = (liftM head $ getListElement "snodes" a)
66
                >>= readEitherString
67
        mem = case bep of
68
                Bad _ -> getIntElement "admin_ram" a
69
                Ok o -> getIntElement "memory" o
70
        running = getStringElement "status" a
71
    in
72
      name |+ (show `liftM` mem) |+
73
              (show `liftM` disk) |+
74
              running |+ pnode |+ snode
75

    
76
boolToYN :: (Monad m) => Bool -> m String
77
boolToYN True = return "Y"
78
boolToYN _ = return "N"
79

    
80
parseNode :: JSObject JSValue -> Result String
81
parseNode a =
82
    let name = getStringElement "name" a
83
        offline = getBoolElement "offline" a
84
        drained = getBoolElement "drained" a
85
        mtotal = getIntElement "mtotal" a
86
        mnode = getIntElement "mnode" a
87
        mfree = getIntElement "mfree" a
88
        dtotal = getIntElement "dtotal" a
89
        dfree = getIntElement "dfree" a
90
    in name |+
91
       (case offline of
92
          Ok True -> Ok "0|0|0|0|0|Y"
93
          _ ->
94
              (show `liftM` mtotal) |+ (show `liftM` mnode) |+
95
              (show `liftM` mfree) |+ (show `liftM` dtotal) |+
96
              (show `liftM` dfree) |+
97
              ((liftM2 (||) offline drained) >>= boolToYN)
98
       )