Revision 665a9ddc src/Ganeti/Query/Query.hs

b/src/Ganeti/Query/Query.hs
56 56 
    , uuidField
57 57 
    ) where
58 58 

  		





  
  59
  
    
import Control.Arrow ((&&&))


  		





  59
  60
  
    
import Control.DeepSeq


  		





  60
  61
  
    
import Control.Monad (filterM, foldM, liftM, unless)


  		





  61
  62
  
    
import Control.Monad.IO.Class


  		





  62
  63
  
    
import Control.Monad.Trans (lift)


  		





  63
  64
  
    
import qualified Data.Foldable as Foldable


  		





  64
  
  
    
import Data.List (intercalate, nub)


  		





  
  65
  
    
import Data.List (intercalate, nub, find)


  		





  65
  66
  
    
import Data.Maybe (fromMaybe)


  		





  66
  67
  
    
import qualified Data.Map as Map


  		





  67
  68
  
    
import qualified Text.JSON as J


  		





  ......




  71
  72
  
    
import Ganeti.Errors


  		





  72
  73
  
    
import Ganeti.JQueue


  		





  73
  74
  
    
import Ganeti.JSON


  		





  
  75
  
    
import Ganeti.Locking.Allocation (OwnerState)


  		





  
  76
  
    
import Ganeti.Locking.Locks (GanetiLocks, ClientId, lockName)


  		





  74
  77
  
    
import Ganeti.Logging


  		





  75
  
  
    
import qualified Ganeti.Luxi as L


  		





  76
  78
  
    
import Ganeti.Objects


  		





  77
  79
  
    
import Ganeti.Query.Common


  		





  78
  80
  
    
import qualified Ganeti.Query.Export as Export


  		





  ......




  86
  88
  
    
import qualified Ganeti.Query.Node as Node


  		





  87
  89
  
    
import Ganeti.Query.Types


  		





  88
  90
  
    
import Ganeti.Path


  		





  
  91
  
    
import Ganeti.THH.HsRPC (runRpcClient)


  		





  89
  92
  
    
import Ganeti.Types


  		





  90
  93
  
    
import Ganeti.Utils


  		





  
  94
  
    
import Ganeti.WConfd.Client (getWConfdClient, listAllLocksOwners)


  		





  91
  95
  
    

  		





  92
  96
  
    
-- | Collector type


  		





  93
  97
  
    
data CollectorType a b


  		





  ......




  225
  229
  
    
              runtimes


  		





  226
  230
  
    
  return QueryResult { qresFields = fdefs, qresData = fdata }


  		





  227
  231
  
    

  		





  
  232
  
    
-- | Dummy recollection of the data for a lock from the prefected


  		





  
  233
  
    
-- data for all locks.


  		





  
  234
  
    
recollectLocksData :: [(GanetiLocks, [(ClientId, OwnerState)])]


  		





  
  235
  
    
                   -> Bool -> ConfigData -> [String]


  		





  
  236
  
    
                   -> IO [(String, Locks.RuntimeData)]


  		





  
  237
  
    
recollectLocksData allLocks _ _  =


  		





  
  238
  
    
  let lookuplock lock = (,) lock


  		





  
  239
  
    
                          . find ((==) lock . lockName . fst)


  		





  
  240
  
    
                          $ allLocks


  		





  
  241
  
    
  in return . map lookuplock


  		





  
  242
  
    

  		





  228
  243
  
    
-- | Main query execution function.


  		





  229
  244
  
    
query :: ConfigData   -- ^ The current configuration


  		





  230
  245
  
    
      -> Bool         -- ^ Whether to collect live data


  		





  ......




  232
  247
  
    
      -> IO (ErrorResult QueryResult) -- ^ Result


  		





  233
  248
  
    
query cfg live (Query (ItemTypeLuxi QRJob) fields qfilter) =


  		





  234
  249
  
    
  queryJobs cfg live fields qfilter


  		





  235
  
  
    
query _ live (Query (ItemTypeLuxi QRLock) fields qfilter) = runResultT $ do


  		





  
  250
  
    
query cfg live (Query (ItemTypeLuxi QRLock) fields qfilter) = runResultT $ do


  		





  236
  251
  
    
  unless live (failError "Locks can only be queried live")


  		





  237
  252
  
    
  cl <- liftIO $ do


  		





  238
  
  
    
    socketpath <- liftIO defaultMasterSocket


  		





  239
  
  
    
    logDebug $ "Forwarding live query on locks for " ++ show fields


  		





  240
  
  
    
                 ++ ", " ++ show qfilter ++ " to " ++ socketpath


  		





  241
  
  
    
    liftIO $ L.getLuxiClient socketpath


  		





  242
  
  
    
  answer <- ResultT $ L.callMethod (L.Query (ItemTypeLuxi QRLock)


  		





  243
  
  
    
                                            fields qfilter) cl


  		





  244
  
  
    
  fromJResultE "Got unparsable answer from masterd: " $ J.readJSON answer


  		





  
  253
  
    
     socketpath <- defaultWConfdSocket


  		





  
  254
  
    
     getWConfdClient socketpath


  		





  
  255
  
    
  livedata <- runRpcClient listAllLocksOwners cl


  		





  
  256
  
    
  logDebug $ "Live state of all locks is " ++ show livedata


  		





  
  257
  
    
  answer <- liftIO $ genericQuery


  		





  
  258
  
    
             Locks.fieldsMap


  		





  
  259
  
    
             (CollectorSimple $ recollectLocksData livedata)


  		





  
  260
  
    
             id


  		





  
  261
  
    
             (const . GenericContainer . Map.fromList


  		





  
  262
  
    
              . map ((id &&& id) . lockName) $ map fst livedata)


  		





  
  263
  
    
             (const Ok)


  		





  
  264
  
    
             cfg live fields qfilter []


  		





  
  265
  
    
  toError answer


  		





  245
  266
  
    

  		





  246
  267
  
    
query cfg live qry = queryInner cfg live qry $ getRequestedNames qry


  		





  247
  268
  
    

  		












Also available in:
  Unified diff