root / Ganeti / Luxi.hs @ a1b5eeaf
History | View | Annotate | Download (4.8 kB)
1 | 6583e677 | Iustin Pop | {-| Implementation of the Ganeti LUXI interface. |
---|---|---|---|
2 | 6583e677 | Iustin Pop | |
3 | 6583e677 | Iustin Pop | -} |
4 | 6583e677 | Iustin Pop | |
5 | 6583e677 | Iustin Pop | {- |
6 | 6583e677 | Iustin Pop | |
7 | 6583e677 | Iustin Pop | Copyright (C) 2009 Google Inc. |
8 | 6583e677 | Iustin Pop | |
9 | 6583e677 | Iustin Pop | This program is free software; you can redistribute it and/or modify |
10 | 6583e677 | Iustin Pop | it under the terms of the GNU General Public License as published by |
11 | 6583e677 | Iustin Pop | the Free Software Foundation; either version 2 of the License, or |
12 | 6583e677 | Iustin Pop | (at your option) any later version. |
13 | 6583e677 | Iustin Pop | |
14 | 6583e677 | Iustin Pop | This program is distributed in the hope that it will be useful, but |
15 | 6583e677 | Iustin Pop | WITHOUT ANY WARRANTY; without even the implied warranty of |
16 | 6583e677 | Iustin Pop | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
17 | 6583e677 | Iustin Pop | General Public License for more details. |
18 | 6583e677 | Iustin Pop | |
19 | 6583e677 | Iustin Pop | You should have received a copy of the GNU General Public License |
20 | 6583e677 | Iustin Pop | along with this program; if not, write to the Free Software |
21 | 6583e677 | Iustin Pop | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
22 | 6583e677 | Iustin Pop | 02110-1301, USA. |
23 | 6583e677 | Iustin Pop | |
24 | 6583e677 | Iustin Pop | -} |
25 | 6583e677 | Iustin Pop | |
26 | 6583e677 | Iustin Pop | module Ganeti.Luxi |
27 | 6583e677 | Iustin Pop | ( LuxiOp(..) |
28 | 6583e677 | Iustin Pop | , Client |
29 | 6583e677 | Iustin Pop | , getClient |
30 | 6583e677 | Iustin Pop | , closeClient |
31 | 6583e677 | Iustin Pop | , callMethod |
32 | 6583e677 | Iustin Pop | ) where |
33 | 6583e677 | Iustin Pop | |
34 | 6583e677 | Iustin Pop | import Data.List |
35 | 6583e677 | Iustin Pop | import Data.IORef |
36 | 6583e677 | Iustin Pop | import Control.Monad |
37 | 6583e677 | Iustin Pop | import Text.JSON (JSObject, JSValue, toJSObject, encodeStrict, decodeStrict) |
38 | 6583e677 | Iustin Pop | import qualified Text.JSON as J |
39 | 6583e677 | Iustin Pop | import Text.JSON.Types |
40 | 6583e677 | Iustin Pop | import System.Timeout |
41 | 6583e677 | Iustin Pop | import qualified Network.Socket as S |
42 | 6583e677 | Iustin Pop | |
43 | 6583e677 | Iustin Pop | import Ganeti.HTools.Utils |
44 | 6583e677 | Iustin Pop | import Ganeti.HTools.Types |
45 | 6583e677 | Iustin Pop | |
46 | 6583e677 | Iustin Pop | -- * Utility functions |
47 | 6583e677 | Iustin Pop | |
48 | 6583e677 | Iustin Pop | -- | Wrapper over System.Timeout.timeout that fails in the IO monad. |
49 | 6583e677 | Iustin Pop | withTimeout :: Int -> String -> IO a -> IO a |
50 | 6583e677 | Iustin Pop | withTimeout secs descr action = do |
51 | 6583e677 | Iustin Pop | result <- timeout (secs * 1000000) action |
52 | 6583e677 | Iustin Pop | (case result of |
53 | 6583e677 | Iustin Pop | Nothing -> fail $ "Timeout in " ++ descr |
54 | 6583e677 | Iustin Pop | Just v -> return v) |
55 | 6583e677 | Iustin Pop | |
56 | 6583e677 | Iustin Pop | -- * Generic protocol functionality |
57 | 6583e677 | Iustin Pop | |
58 | 6583e677 | Iustin Pop | -- | Currently supported Luxi operations. |
59 | 6583e677 | Iustin Pop | data LuxiOp = QueryInstances |
60 | 6583e677 | Iustin Pop | | QueryNodes |
61 | a1b5eeaf | Iustin Pop | | QueryJobs |
62 | a1b5eeaf | Iustin Pop | | SubmitManyJobs |
63 | 6583e677 | Iustin Pop | |
64 | 6583e677 | Iustin Pop | -- | The serialisation of LuxiOps into strings in messages. |
65 | 6583e677 | Iustin Pop | strOfOp :: LuxiOp -> String |
66 | 6583e677 | Iustin Pop | strOfOp QueryNodes = "QueryNodes" |
67 | 6583e677 | Iustin Pop | strOfOp QueryInstances = "QueryInstances" |
68 | a1b5eeaf | Iustin Pop | strOfOp QueryJobs = "QueryJobs" |
69 | a1b5eeaf | Iustin Pop | strOfOp SubmitManyJobs = "SubmitManyJobs" |
70 | 6583e677 | Iustin Pop | |
71 | 6583e677 | Iustin Pop | -- | The end-of-message separator. |
72 | 6583e677 | Iustin Pop | eOM :: Char |
73 | 6583e677 | Iustin Pop | eOM = '\3' |
74 | 6583e677 | Iustin Pop | |
75 | 6583e677 | Iustin Pop | -- | Valid keys in the requests and responses. |
76 | 6583e677 | Iustin Pop | data MsgKeys = Method |
77 | 6583e677 | Iustin Pop | | Args |
78 | 6583e677 | Iustin Pop | | Success |
79 | 6583e677 | Iustin Pop | | Result |
80 | 6583e677 | Iustin Pop | |
81 | 6583e677 | Iustin Pop | -- | The serialisation of MsgKeys into strings in messages. |
82 | 6583e677 | Iustin Pop | strOfKey :: MsgKeys -> String |
83 | 6583e677 | Iustin Pop | strOfKey Method = "method" |
84 | 6583e677 | Iustin Pop | strOfKey Args = "args" |
85 | 6583e677 | Iustin Pop | strOfKey Success = "success" |
86 | 6583e677 | Iustin Pop | strOfKey Result = "result" |
87 | 6583e677 | Iustin Pop | |
88 | 6583e677 | Iustin Pop | -- | Luxi client encapsulation. |
89 | 6583e677 | Iustin Pop | data Client = Client { socket :: S.Socket -- ^ The socket of the client |
90 | 6583e677 | Iustin Pop | , rbuf :: IORef String -- ^ Already received buffer |
91 | 6583e677 | Iustin Pop | } |
92 | 6583e677 | Iustin Pop | |
93 | 6583e677 | Iustin Pop | -- | Connects to the master daemon and returns a luxi Client. |
94 | 6583e677 | Iustin Pop | getClient :: String -> IO Client |
95 | 6583e677 | Iustin Pop | getClient path = do |
96 | 6583e677 | Iustin Pop | s <- S.socket S.AF_UNIX S.Stream S.defaultProtocol |
97 | 6583e677 | Iustin Pop | withTimeout connTimeout "creating luxi connection" $ |
98 | 6583e677 | Iustin Pop | S.connect s (S.SockAddrUnix path) |
99 | 6583e677 | Iustin Pop | rf <- newIORef "" |
100 | 6583e677 | Iustin Pop | return Client { socket=s, rbuf=rf} |
101 | 6583e677 | Iustin Pop | |
102 | 6583e677 | Iustin Pop | -- | Closes the client socket. |
103 | 6583e677 | Iustin Pop | closeClient :: Client -> IO () |
104 | 6583e677 | Iustin Pop | closeClient = S.sClose . socket |
105 | 6583e677 | Iustin Pop | |
106 | 6583e677 | Iustin Pop | -- | Sends a message over a luxi transport. |
107 | 6583e677 | Iustin Pop | sendMsg :: Client -> String -> IO () |
108 | 6583e677 | Iustin Pop | sendMsg s buf = |
109 | 6583e677 | Iustin Pop | let _send obuf = do |
110 | 6583e677 | Iustin Pop | sbytes <- withTimeout queryTimeout |
111 | 6583e677 | Iustin Pop | "sending luxi message" $ |
112 | 6583e677 | Iustin Pop | S.send (socket s) obuf |
113 | 6583e677 | Iustin Pop | (if sbytes == length obuf |
114 | 6583e677 | Iustin Pop | then return () |
115 | 6583e677 | Iustin Pop | else _send (drop sbytes obuf)) |
116 | 6583e677 | Iustin Pop | in _send (buf ++ [eOM]) |
117 | 6583e677 | Iustin Pop | |
118 | 6583e677 | Iustin Pop | -- | Waits for a message over a luxi transport. |
119 | 6583e677 | Iustin Pop | recvMsg :: Client -> IO String |
120 | 6583e677 | Iustin Pop | recvMsg s = do |
121 | 6583e677 | Iustin Pop | let _recv obuf = do |
122 | 6583e677 | Iustin Pop | nbuf <- withTimeout queryTimeout "reading luxi response" $ |
123 | 6583e677 | Iustin Pop | S.recv (socket s) 4096 |
124 | 6583e677 | Iustin Pop | let (msg, remaining) = break ((==) eOM) (obuf ++ nbuf) |
125 | 6583e677 | Iustin Pop | (if null remaining |
126 | 6583e677 | Iustin Pop | then _recv msg |
127 | 6583e677 | Iustin Pop | else return (msg, tail remaining)) |
128 | 6583e677 | Iustin Pop | cbuf <- readIORef $ rbuf s |
129 | 6583e677 | Iustin Pop | (msg, nbuf) <- _recv cbuf |
130 | 6583e677 | Iustin Pop | writeIORef (rbuf s) nbuf |
131 | 6583e677 | Iustin Pop | return msg |
132 | 6583e677 | Iustin Pop | |
133 | 6583e677 | Iustin Pop | -- | Serialize a request to String. |
134 | 6583e677 | Iustin Pop | buildCall :: LuxiOp -- ^ The method |
135 | 6583e677 | Iustin Pop | -> JSValue -- ^ The arguments |
136 | 6583e677 | Iustin Pop | -> String -- ^ The serialized form |
137 | 6583e677 | Iustin Pop | buildCall msg args = |
138 | 6583e677 | Iustin Pop | let ja = [(strOfKey Method, |
139 | 6583e677 | Iustin Pop | JSString $ toJSString $ strOfOp msg::JSValue), |
140 | 6583e677 | Iustin Pop | (strOfKey Args, |
141 | 6583e677 | Iustin Pop | args::JSValue) |
142 | 6583e677 | Iustin Pop | ] |
143 | 6583e677 | Iustin Pop | jo = toJSObject ja |
144 | 6583e677 | Iustin Pop | in encodeStrict jo |
145 | 6583e677 | Iustin Pop | |
146 | 6583e677 | Iustin Pop | -- | Check that luxi responses contain the required keys and that the |
147 | 6583e677 | Iustin Pop | -- call was successful. |
148 | 6583e677 | Iustin Pop | validateResult :: String -> Result JSValue |
149 | 6583e677 | Iustin Pop | validateResult s = do |
150 | 6583e677 | Iustin Pop | arr <- fromJResult $ decodeStrict s::Result (JSObject JSValue) |
151 | 6583e677 | Iustin Pop | status <- fromObj (strOfKey Success) arr::Result Bool |
152 | 6583e677 | Iustin Pop | let rkey = strOfKey Result |
153 | 6583e677 | Iustin Pop | (if status |
154 | 6583e677 | Iustin Pop | then fromObj rkey arr |
155 | 6583e677 | Iustin Pop | else fromObj rkey arr >>= fail) |
156 | 6583e677 | Iustin Pop | |
157 | 6583e677 | Iustin Pop | -- | Generic luxi method call. |
158 | 6583e677 | Iustin Pop | callMethod :: LuxiOp -> JSValue -> Client -> IO (Result JSValue) |
159 | 6583e677 | Iustin Pop | callMethod method args s = do |
160 | 6583e677 | Iustin Pop | sendMsg s $ buildCall method args |
161 | 6583e677 | Iustin Pop | result <- recvMsg s |
162 | 6583e677 | Iustin Pop | let rval = validateResult result |
163 | 6583e677 | Iustin Pop | return rval |