Revision 0aff2293
b/htools/Ganeti/Luxi.hs | ||
---|---|---|
32 | 32 |
, LuxiReq(..) |
33 | 33 |
, Client |
34 | 34 |
, JobId |
35 |
, RecvResult(..) |
|
36 |
, strOfOp |
|
35 | 37 |
, checkRS |
36 | 38 |
, getClient |
37 | 39 |
, getServer |
38 | 40 |
, acceptClient |
39 | 41 |
, closeClient |
42 |
, closeServer |
|
40 | 43 |
, callMethod |
41 | 44 |
, submitManyJobs |
42 | 45 |
, queryJobsStatus |
43 | 46 |
, buildCall |
47 |
, buildResponse |
|
44 | 48 |
, validateCall |
45 | 49 |
, decodeCall |
46 | 50 |
, recvMsg |
51 |
, recvMsgExt |
|
47 | 52 |
, sendMsg |
48 | 53 |
) where |
49 | 54 |
|
55 |
import Control.Exception (catch) |
|
50 | 56 |
import Data.IORef |
51 | 57 |
import Data.Ratio (numerator, denominator) |
52 | 58 |
import qualified Data.ByteString as B |
53 | 59 |
import qualified Data.ByteString.UTF8 as UTF8 |
54 | 60 |
import Data.Word (Word8) |
55 | 61 |
import Control.Monad |
62 |
import Prelude hiding (catch) |
|
56 | 63 |
import Text.JSON (encodeStrict, decodeStrict) |
57 | 64 |
import qualified Text.JSON as J |
58 | 65 |
import Text.JSON.Types |
66 |
import System.Directory (removeFile) |
|
59 | 67 |
import System.IO (hClose, hFlush, hWaitForInput, Handle, IOMode(..)) |
68 |
import System.IO.Error (isEOFError) |
|
60 | 69 |
import System.Timeout |
61 | 70 |
import qualified Network.Socket as S |
62 | 71 |
|
... | ... | |
81 | 90 |
|
82 | 91 |
-- * Generic protocol functionality |
83 | 92 |
|
93 |
-- | Result of receiving a message from the socket. |
|
94 |
data RecvResult = RecvConnClosed -- ^ Connection closed |
|
95 |
| RecvError String -- ^ Any other error |
|
96 |
| RecvOk String -- ^ Successfull receive |
|
97 |
deriving (Show, Read, Eq) |
|
98 |
|
|
84 | 99 |
-- | The Ganeti job type. |
85 | 100 |
type JobId = Int |
86 | 101 |
|
... | ... | |
228 | 243 |
S.listen s 5 -- 5 is the max backlog |
229 | 244 |
return s |
230 | 245 |
|
246 |
-- | Closes a server endpoint. |
|
247 |
-- FIXME: this should be encapsulated into a nicer type. |
|
248 |
closeServer :: FilePath -> S.Socket -> IO () |
|
249 |
closeServer path sock = do |
|
250 |
S.sClose sock |
|
251 |
removeFile path |
|
252 |
|
|
231 | 253 |
-- | Accepts a client |
232 | 254 |
acceptClient :: S.Socket -> IO Client |
233 | 255 |
acceptClient s = do |
... | ... | |
276 | 298 |
writeIORef (rbuf s) nbuf |
277 | 299 |
return $ UTF8.toString msg |
278 | 300 |
|
301 |
-- | Extended wrapper over recvMsg. |
|
302 |
recvMsgExt :: Client -> IO RecvResult |
|
303 |
recvMsgExt s = |
|
304 |
catch (liftM RecvOk (recvMsg s)) $ \e -> |
|
305 |
if isEOFError e |
|
306 |
then return RecvConnClosed |
|
307 |
else return $ RecvError (show e) |
|
308 |
|
|
279 | 309 |
-- | Serialize a request to String. |
280 | 310 |
buildCall :: LuxiOp -- ^ The method |
281 | 311 |
-> String -- ^ The serialized form |
... | ... | |
286 | 316 |
jo = toJSObject ja |
287 | 317 |
in encodeStrict jo |
288 | 318 |
|
319 |
-- | Serialize the response to String. |
|
320 |
buildResponse :: Bool -- ^ Success |
|
321 |
-> JSValue -- ^ The arguments |
|
322 |
-> String -- ^ The serialized form |
|
323 |
buildResponse success args = |
|
324 |
let ja = [ (strOfKey Success, JSBool success) |
|
325 |
, (strOfKey Result, args)] |
|
326 |
jo = toJSObject ja |
|
327 |
in encodeStrict jo |
|
328 |
|
|
289 | 329 |
-- | Check that luxi request contains the required keys and parse it. |
290 | 330 |
validateCall :: String -> Result LuxiCall |
291 | 331 |
validateCall s = do |
292 |
arr <- fromJResult "luxi call" $ decodeStrict s::Result (JSObject JSValue) |
|
332 |
arr <- fromJResult "parsing top-level luxi message" $ |
|
333 |
decodeStrict s::Result (JSObject JSValue) |
|
293 | 334 |
let aobj = fromJSObject arr |
294 | 335 |
call <- fromObj aobj (strOfKey Method)::Result LuxiReq |
295 | 336 |
args <- fromObj aobj (strOfKey Args) |
Also available in: Unified diff