{-
-Copyright (C) 2009 Google Inc.
+Copyright (C) 2009, 2010 Google Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
, queryJobsStatus
) where
-import Data.List
import Data.IORef
import Control.Monad
-import Text.JSON (JSObject, JSValue, toJSObject, encodeStrict, decodeStrict)
+import Text.JSON (encodeStrict, decodeStrict)
import qualified Text.JSON as J
import Text.JSON.Types
import System.Timeout
import Ganeti.HTools.Types
import Ganeti.Jobs (JobStatus)
+import Ganeti.OpCodes (OpCode)
-- * Utility functions
-- * Generic protocol functionality
-- | Currently supported Luxi operations.
-data LuxiOp = QueryInstances
- | QueryNodes
- | QueryJobs
+data LuxiOp = QueryInstances [String] [String] Bool
+ | QueryNodes [String] [String] Bool
+ | QueryGroups [String] [String] Bool
+ | QueryJobs [Int] [String]
+ | QueryExports [String] Bool
+ | QueryConfigValues [String]
| QueryClusterInfo
- | SubmitManyJobs
+ | QueryTags String String
+ | SubmitJob [OpCode]
+ | SubmitManyJobs [[OpCode]]
+ | WaitForJobChange Int [String] JSValue JSValue Int
+ | ArchiveJob Int
+ | AutoArchiveJobs Int Int
+ | CancelJob Int
+ | SetDrainFlag Bool
+ | SetWatcherPause Double
+ deriving (Show)
-- | The serialisation of LuxiOps into strings in messages.
strOfOp :: LuxiOp -> String
-strOfOp QueryNodes = "QueryNodes"
-strOfOp QueryInstances = "QueryInstances"
-strOfOp QueryJobs = "QueryJobs"
-strOfOp QueryClusterInfo = "QueryClusterInfo"
-strOfOp SubmitManyJobs = "SubmitManyJobs"
+strOfOp QueryNodes {} = "QueryNodes"
+strOfOp QueryGroups {} = "QueryGroups"
+strOfOp QueryInstances {} = "QueryInstances"
+strOfOp QueryJobs {} = "QueryJobs"
+strOfOp QueryExports {} = "QueryExports"
+strOfOp QueryConfigValues {} = "QueryConfigValues"
+strOfOp QueryClusterInfo {} = "QueryClusterInfo"
+strOfOp QueryTags {} = "QueryTags"
+strOfOp SubmitManyJobs {} = "SubmitManyJobs"
+strOfOp WaitForJobChange {} = "WaitForJobChange"
+strOfOp SubmitJob {} = "SubmitJob"
+strOfOp ArchiveJob {} = "ArchiveJob"
+strOfOp AutoArchiveJobs {} = "AutoArchiveJobs"
+strOfOp CancelJob {} = "CancelJob"
+strOfOp SetDrainFlag {} = "SetDrainFlag"
+strOfOp SetWatcherPause {} = "SetWatcherPause"
-- | The end-of-message separator.
eOM :: Char
let _recv obuf = do
nbuf <- withTimeout queryTimeout "reading luxi response" $
S.recv (socket s) 4096
- let (msg, remaining) = break ((==) eOM) (obuf ++ nbuf)
+ let (msg, remaining) = break (eOM ==) nbuf
(if null remaining
- then _recv msg
- else return (msg, tail remaining))
+ then _recv (obuf ++ msg)
+ else return (obuf ++ msg, tail remaining))
cbuf <- readIORef $ rbuf s
- (msg, nbuf) <- _recv cbuf
+ let (imsg, ibuf) = break (eOM ==) cbuf
+ (msg, nbuf) <-
+ (if null ibuf -- if old buffer didn't contain a full message
+ then _recv cbuf -- then we read from network
+ else return (imsg, tail ibuf)) -- else we return data from our buffer
writeIORef (rbuf s) nbuf
return msg
+-- | Compute the serialized form of a Luxi operation
+opToArgs :: LuxiOp -> JSValue
+opToArgs (QueryNodes names fields lock) = J.showJSON (names, fields, lock)
+opToArgs (QueryGroups names fields lock) = J.showJSON (names, fields, lock)
+opToArgs (QueryInstances names fields lock) = J.showJSON (names, fields, lock)
+opToArgs (QueryJobs ids fields) = J.showJSON (map show ids, fields)
+opToArgs (QueryExports nodes lock) = J.showJSON (nodes, lock)
+opToArgs (QueryConfigValues fields) = J.showJSON fields
+opToArgs (QueryClusterInfo) = J.showJSON ()
+opToArgs (QueryTags kind name) = J.showJSON (kind, name)
+opToArgs (SubmitJob j) = J.showJSON j
+opToArgs (SubmitManyJobs ops) = J.showJSON ops
+-- This is special, since the JSON library doesn't export an instance
+-- of a 5-tuple
+opToArgs (WaitForJobChange a b c d e) =
+ JSArray [ J.showJSON a, J.showJSON b, J.showJSON c
+ , J.showJSON d, J.showJSON e]
+opToArgs (ArchiveJob a) = J.showJSON (show a)
+opToArgs (AutoArchiveJobs a b) = J.showJSON (a, b)
+opToArgs (CancelJob a) = J.showJSON (show a)
+opToArgs (SetDrainFlag flag) = J.showJSON flag
+opToArgs (SetWatcherPause duration) = J.showJSON [duration]
+
-- | Serialize a request to String.
buildCall :: LuxiOp -- ^ The method
- -> JSValue -- ^ The arguments
-> String -- ^ The serialized form
-buildCall msg args =
- let ja = [(strOfKey Method,
- JSString $ toJSString $ strOfOp msg::JSValue),
- (strOfKey Args,
- args::JSValue)
+buildCall lo =
+ let ja = [ (strOfKey Method, JSString $ toJSString $ strOfOp lo::JSValue)
+ , (strOfKey Args, opToArgs lo::JSValue)
]
jo = toJSObject ja
in encodeStrict jo
-- call was successful.
validateResult :: String -> Result JSValue
validateResult s = do
- oarr <- fromJResult $ decodeStrict s::Result (JSObject JSValue)
+ oarr <- fromJResult "Parsing LUXI response"
+ (decodeStrict s)::Result (JSObject JSValue)
let arr = J.fromJSObject oarr
status <- fromObj (strOfKey Success) arr::Result Bool
let rkey = strOfKey Result
else fromObj rkey arr >>= fail)
-- | Generic luxi method call.
-callMethod :: LuxiOp -> JSValue -> Client -> IO (Result JSValue)
-callMethod method args s = do
- sendMsg s $ buildCall method args
+callMethod :: LuxiOp -> Client -> IO (Result JSValue)
+callMethod method s = do
+ sendMsg s $ buildCall method
result <- recvMsg s
let rval = validateResult result
return rval
-- | Specialized submitManyJobs call.
-submitManyJobs :: Client -> JSValue -> IO (Result [String])
+submitManyJobs :: Client -> [[OpCode]] -> IO (Result [String])
submitManyJobs s jobs = do
- rval <- callMethod SubmitManyJobs jobs s
+ rval <- callMethod (SubmitManyJobs jobs) s
-- map each result (status, payload) pair into a nice Result ADT
return $ case rval of
Bad x -> Bad x
-- | Custom queryJobs call.
queryJobsStatus :: Client -> [String] -> IO (Result [JobStatus])
queryJobsStatus s jids = do
- rval <- callMethod QueryJobs (J.showJSON (jids, ["status"])) s
+ rval <- callMethod (QueryJobs (map read jids) ["status"]) s
return $ case rval of
Bad x -> Bad x
Ok y -> case J.readJSON y::(J.Result [[JobStatus]]) of
projects / ganeti-local / blobdiff