Statistics
| Branch: | Tag: | Revision:

root / Ganeti / Luxi.hs @ 2cae47e9

History | View | Annotate | Download (8.4 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 9a2ff880 Iustin Pop
    , submitManyJobs
33 9a2ff880 Iustin Pop
    , queryJobsStatus
34 6583e677 Iustin Pop
    ) where
35 6583e677 Iustin Pop
36 6583e677 Iustin Pop
import Data.IORef
37 6583e677 Iustin Pop
import Control.Monad
38 0903280b Iustin Pop
import Text.JSON (encodeStrict, decodeStrict)
39 6583e677 Iustin Pop
import qualified Text.JSON as J
40 6583e677 Iustin Pop
import Text.JSON.Types
41 6583e677 Iustin Pop
import System.Timeout
42 6583e677 Iustin Pop
import qualified Network.Socket as S
43 6583e677 Iustin Pop
44 6583e677 Iustin Pop
import Ganeti.HTools.Utils
45 6583e677 Iustin Pop
import Ganeti.HTools.Types
46 6583e677 Iustin Pop
47 9a2ff880 Iustin Pop
import Ganeti.Jobs (JobStatus)
48 683b1ca7 Iustin Pop
import Ganeti.OpCodes (OpCode)
49 9a2ff880 Iustin Pop
50 6583e677 Iustin Pop
-- * Utility functions
51 6583e677 Iustin Pop
52 6583e677 Iustin Pop
-- | Wrapper over System.Timeout.timeout that fails in the IO monad.
53 6583e677 Iustin Pop
withTimeout :: Int -> String -> IO a -> IO a
54 6583e677 Iustin Pop
withTimeout secs descr action = do
55 6583e677 Iustin Pop
    result <- timeout (secs * 1000000) action
56 6583e677 Iustin Pop
    (case result of
57 6583e677 Iustin Pop
       Nothing -> fail $ "Timeout in " ++ descr
58 6583e677 Iustin Pop
       Just v -> return v)
59 6583e677 Iustin Pop
60 6583e677 Iustin Pop
-- * Generic protocol functionality
61 6583e677 Iustin Pop
62 6583e677 Iustin Pop
-- | Currently supported Luxi operations.
63 683b1ca7 Iustin Pop
data LuxiOp = QueryInstances [String] [String] Bool
64 683b1ca7 Iustin Pop
            | QueryNodes [String] [String] Bool
65 683b1ca7 Iustin Pop
            | QueryJobs [Int] [String]
66 04282772 Iustin Pop
            | QueryExports [String] Bool
67 04282772 Iustin Pop
            | QueryConfigValues [String]
68 f89235f1 Iustin Pop
            | QueryClusterInfo
69 04282772 Iustin Pop
            | QueryTags String String
70 9622919d Iustin Pop
            | SubmitJob [OpCode]
71 683b1ca7 Iustin Pop
            | SubmitManyJobs [[OpCode]]
72 9622919d Iustin Pop
            | WaitForJobChange Int [String] JSValue JSValue Int
73 9622919d Iustin Pop
            | ArchiveJob Int
74 9622919d Iustin Pop
            | AutoArchiveJobs Int Int
75 04282772 Iustin Pop
            | CancelJob Int
76 04282772 Iustin Pop
            | SetDrainFlag Bool
77 04282772 Iustin Pop
            | SetWatcherPause Double
78 9622919d Iustin Pop
              deriving (Show)
79 6583e677 Iustin Pop
80 6583e677 Iustin Pop
-- | The serialisation of LuxiOps into strings in messages.
81 6583e677 Iustin Pop
strOfOp :: LuxiOp -> String
82 04282772 Iustin Pop
strOfOp QueryNodes {}        = "QueryNodes"
83 04282772 Iustin Pop
strOfOp QueryInstances {}    = "QueryInstances"
84 04282772 Iustin Pop
strOfOp QueryJobs {}         = "QueryJobs"
85 04282772 Iustin Pop
strOfOp QueryExports {}      = "QueryExports"
86 04282772 Iustin Pop
strOfOp QueryConfigValues {} = "QueryConfigValues"
87 04282772 Iustin Pop
strOfOp QueryClusterInfo {}  = "QueryClusterInfo"
88 04282772 Iustin Pop
strOfOp QueryTags {}         = "QueryTags"
89 04282772 Iustin Pop
strOfOp SubmitManyJobs {}    = "SubmitManyJobs"
90 04282772 Iustin Pop
strOfOp WaitForJobChange {}  = "WaitForJobChange"
91 04282772 Iustin Pop
strOfOp SubmitJob {}         = "SubmitJob"
92 04282772 Iustin Pop
strOfOp ArchiveJob {}        = "ArchiveJob"
93 04282772 Iustin Pop
strOfOp AutoArchiveJobs {}   = "AutoArchiveJobs"
94 04282772 Iustin Pop
strOfOp CancelJob {}         = "CancelJob"
95 04282772 Iustin Pop
strOfOp SetDrainFlag {}      = "SetDrainFlag"
96 04282772 Iustin Pop
strOfOp SetWatcherPause {}   = "SetWatcherPause"
97 6583e677 Iustin Pop
98 6583e677 Iustin Pop
-- | The end-of-message separator.
99 6583e677 Iustin Pop
eOM :: Char
100 6583e677 Iustin Pop
eOM = '\3'
101 6583e677 Iustin Pop
102 6583e677 Iustin Pop
-- | Valid keys in the requests and responses.
103 6583e677 Iustin Pop
data MsgKeys = Method
104 6583e677 Iustin Pop
             | Args
105 6583e677 Iustin Pop
             | Success
106 6583e677 Iustin Pop
             | Result
107 6583e677 Iustin Pop
108 6583e677 Iustin Pop
-- | The serialisation of MsgKeys into strings in messages.
109 6583e677 Iustin Pop
strOfKey :: MsgKeys -> String
110 6583e677 Iustin Pop
strOfKey Method = "method"
111 6583e677 Iustin Pop
strOfKey Args = "args"
112 6583e677 Iustin Pop
strOfKey Success = "success"
113 6583e677 Iustin Pop
strOfKey Result = "result"
114 6583e677 Iustin Pop
115 6583e677 Iustin Pop
-- | Luxi client encapsulation.
116 6583e677 Iustin Pop
data Client = Client { socket :: S.Socket   -- ^ The socket of the client
117 6583e677 Iustin Pop
                     , rbuf :: IORef String -- ^ Already received buffer
118 6583e677 Iustin Pop
                     }
119 6583e677 Iustin Pop
120 6583e677 Iustin Pop
-- | Connects to the master daemon and returns a luxi Client.
121 6583e677 Iustin Pop
getClient :: String -> IO Client
122 6583e677 Iustin Pop
getClient path = do
123 6583e677 Iustin Pop
    s <- S.socket S.AF_UNIX S.Stream S.defaultProtocol
124 6583e677 Iustin Pop
    withTimeout connTimeout "creating luxi connection" $
125 6583e677 Iustin Pop
                S.connect s (S.SockAddrUnix path)
126 6583e677 Iustin Pop
    rf <- newIORef ""
127 6583e677 Iustin Pop
    return Client { socket=s, rbuf=rf}
128 6583e677 Iustin Pop
129 6583e677 Iustin Pop
-- | Closes the client socket.
130 6583e677 Iustin Pop
closeClient :: Client -> IO ()
131 6583e677 Iustin Pop
closeClient = S.sClose . socket
132 6583e677 Iustin Pop
133 6583e677 Iustin Pop
-- | Sends a message over a luxi transport.
134 6583e677 Iustin Pop
sendMsg :: Client -> String -> IO ()
135 6583e677 Iustin Pop
sendMsg s buf =
136 6583e677 Iustin Pop
    let _send obuf = do
137 6583e677 Iustin Pop
          sbytes <- withTimeout queryTimeout
138 6583e677 Iustin Pop
                    "sending luxi message" $
139 6583e677 Iustin Pop
                    S.send (socket s) obuf
140 3a3c1eb4 Iustin Pop
          unless (sbytes == length obuf) $ _send (drop sbytes obuf)
141 6583e677 Iustin Pop
    in _send (buf ++ [eOM])
142 6583e677 Iustin Pop
143 6583e677 Iustin Pop
-- | Waits for a message over a luxi transport.
144 6583e677 Iustin Pop
recvMsg :: Client -> IO String
145 6583e677 Iustin Pop
recvMsg s = do
146 6583e677 Iustin Pop
  let _recv obuf = do
147 6583e677 Iustin Pop
              nbuf <- withTimeout queryTimeout "reading luxi response" $
148 6583e677 Iustin Pop
                      S.recv (socket s) 4096
149 95f490de Iustin Pop
              let (msg, remaining) = break (eOM ==) nbuf
150 6583e677 Iustin Pop
              (if null remaining
151 95f490de Iustin Pop
               then _recv (obuf ++ msg)
152 95f490de Iustin Pop
               else return (obuf ++ msg, tail remaining))
153 6583e677 Iustin Pop
  cbuf <- readIORef $ rbuf s
154 95f490de Iustin Pop
  let (imsg, ibuf) = break (eOM ==) cbuf
155 95f490de Iustin Pop
  (msg, nbuf) <-
156 95f490de Iustin Pop
      (if null ibuf      -- if old buffer didn't contain a full message
157 95f490de Iustin Pop
       then _recv cbuf   -- then we read from network
158 95f490de Iustin Pop
       else return (imsg, tail ibuf)) -- else we return data from our buffer
159 6583e677 Iustin Pop
  writeIORef (rbuf s) nbuf
160 6583e677 Iustin Pop
  return msg
161 6583e677 Iustin Pop
162 683b1ca7 Iustin Pop
-- | Compute the serialized form of a Luxi operation
163 683b1ca7 Iustin Pop
opToArgs :: LuxiOp -> JSValue
164 683b1ca7 Iustin Pop
opToArgs (QueryNodes names fields lock) = J.showJSON (names, fields, lock)
165 04282772 Iustin Pop
opToArgs (QueryInstances names fields lock) = J.showJSON (names, fields, lock)
166 683b1ca7 Iustin Pop
opToArgs (QueryJobs ids fields) = J.showJSON (map show ids, fields)
167 04282772 Iustin Pop
opToArgs (QueryExports nodes lock) = J.showJSON (nodes, lock)
168 04282772 Iustin Pop
opToArgs (QueryConfigValues fields) = J.showJSON fields
169 683b1ca7 Iustin Pop
opToArgs (QueryClusterInfo) = J.showJSON ()
170 04282772 Iustin Pop
opToArgs (QueryTags kind name) =  J.showJSON (kind, name)
171 9622919d Iustin Pop
opToArgs (SubmitJob j) = J.showJSON j
172 04282772 Iustin Pop
opToArgs (SubmitManyJobs ops) = J.showJSON ops
173 9622919d Iustin Pop
-- This is special, since the JSON library doesn't export an instance
174 9622919d Iustin Pop
-- of a 5-tuple
175 9622919d Iustin Pop
opToArgs (WaitForJobChange a b c d e) =
176 9622919d Iustin Pop
    JSArray [ J.showJSON a, J.showJSON b, J.showJSON c
177 9622919d Iustin Pop
            , J.showJSON d, J.showJSON e]
178 04282772 Iustin Pop
opToArgs (ArchiveJob a) = J.showJSON (show a)
179 9622919d Iustin Pop
opToArgs (AutoArchiveJobs a b) = J.showJSON (a, b)
180 04282772 Iustin Pop
opToArgs (CancelJob a) = J.showJSON (show a)
181 04282772 Iustin Pop
opToArgs (SetDrainFlag flag) = J.showJSON flag
182 04282772 Iustin Pop
opToArgs (SetWatcherPause duration) = J.showJSON [duration]
183 683b1ca7 Iustin Pop
184 6583e677 Iustin Pop
-- | Serialize a request to String.
185 6583e677 Iustin Pop
buildCall :: LuxiOp  -- ^ The method
186 6583e677 Iustin Pop
          -> String  -- ^ The serialized form
187 683b1ca7 Iustin Pop
buildCall lo =
188 683b1ca7 Iustin Pop
    let ja = [ (strOfKey Method, JSString $ toJSString $ strOfOp lo::JSValue)
189 683b1ca7 Iustin Pop
             , (strOfKey Args, opToArgs lo::JSValue)
190 6583e677 Iustin Pop
             ]
191 6583e677 Iustin Pop
        jo = toJSObject ja
192 6583e677 Iustin Pop
    in encodeStrict jo
193 6583e677 Iustin Pop
194 6583e677 Iustin Pop
-- | Check that luxi responses contain the required keys and that the
195 6583e677 Iustin Pop
-- call was successful.
196 6583e677 Iustin Pop
validateResult :: String -> Result JSValue
197 6583e677 Iustin Pop
validateResult s = do
198 c96d44df Iustin Pop
  oarr <- fromJResult "Parsing LUXI response"
199 c96d44df Iustin Pop
          (decodeStrict s)::Result (JSObject JSValue)
200 262f3e6c Iustin Pop
  let arr = J.fromJSObject oarr
201 6583e677 Iustin Pop
  status <- fromObj (strOfKey Success) arr::Result Bool
202 6583e677 Iustin Pop
  let rkey = strOfKey Result
203 6583e677 Iustin Pop
  (if status
204 6583e677 Iustin Pop
   then fromObj rkey arr
205 6583e677 Iustin Pop
   else fromObj rkey arr >>= fail)
206 6583e677 Iustin Pop
207 6583e677 Iustin Pop
-- | Generic luxi method call.
208 683b1ca7 Iustin Pop
callMethod :: LuxiOp -> Client -> IO (Result JSValue)
209 683b1ca7 Iustin Pop
callMethod method s = do
210 683b1ca7 Iustin Pop
  sendMsg s $ buildCall method
211 6583e677 Iustin Pop
  result <- recvMsg s
212 6583e677 Iustin Pop
  let rval = validateResult result
213 6583e677 Iustin Pop
  return rval
214 9a2ff880 Iustin Pop
215 9a2ff880 Iustin Pop
-- | Specialized submitManyJobs call.
216 683b1ca7 Iustin Pop
submitManyJobs :: Client -> [[OpCode]] -> IO (Result [String])
217 9a2ff880 Iustin Pop
submitManyJobs s jobs = do
218 683b1ca7 Iustin Pop
  rval <- callMethod (SubmitManyJobs jobs) s
219 9a2ff880 Iustin Pop
  -- map each result (status, payload) pair into a nice Result ADT
220 9a2ff880 Iustin Pop
  return $ case rval of
221 9a2ff880 Iustin Pop
             Bad x -> Bad x
222 9a2ff880 Iustin Pop
             Ok (JSArray r) ->
223 9a2ff880 Iustin Pop
                 mapM (\v -> case v of
224 9a2ff880 Iustin Pop
                               JSArray [JSBool True, JSString x] ->
225 9a2ff880 Iustin Pop
                                   Ok (fromJSString x)
226 9a2ff880 Iustin Pop
                               JSArray [JSBool False, JSString x] ->
227 9a2ff880 Iustin Pop
                                   Bad (fromJSString x)
228 9a2ff880 Iustin Pop
                               _ -> Bad "Unknown result from the master daemon"
229 9a2ff880 Iustin Pop
                      ) r
230 9a2ff880 Iustin Pop
             x -> Bad ("Cannot parse response from Ganeti: " ++ show x)
231 9a2ff880 Iustin Pop
232 9a2ff880 Iustin Pop
-- | Custom queryJobs call.
233 9a2ff880 Iustin Pop
queryJobsStatus :: Client -> [String] -> IO (Result [JobStatus])
234 9a2ff880 Iustin Pop
queryJobsStatus s jids = do
235 683b1ca7 Iustin Pop
  rval <- callMethod (QueryJobs (map read jids) ["status"]) s
236 9a2ff880 Iustin Pop
  return $ case rval of
237 9a2ff880 Iustin Pop
             Bad x -> Bad x
238 9a2ff880 Iustin Pop
             Ok y -> case J.readJSON y::(J.Result [[JobStatus]]) of
239 9a2ff880 Iustin Pop
                       J.Ok vals -> if any null vals
240 9a2ff880 Iustin Pop
                                    then Bad "Missing job status field"
241 9a2ff880 Iustin Pop
                                    else Ok (map head vals)
242 9a2ff880 Iustin Pop
                       J.Error x -> Bad x