Revision b9666288 src/Ganeti/Query/Instance.hs
b/src/Ganeti/Query/Instance.hs | ||
---|---|---|
32 | 32 |
) where |
33 | 33 |
|
34 | 34 |
import Control.Applicative |
35 |
import Data.Either |
|
35 | 36 |
import Data.List |
36 | 37 |
import Data.Maybe |
37 | 38 |
import Data.Monoid |
38 | 39 |
import qualified Data.Map as Map |
40 |
import Data.Ord (comparing) |
|
39 | 41 |
import qualified Text.JSON as J |
40 | 42 |
import Text.Printf |
41 | 43 |
|
... | ... | |
55 | 57 |
import Ganeti.Types |
56 | 58 |
import Ganeti.Utils (formatOrdinal) |
57 | 59 |
|
58 |
-- | The LiveInfo structure packs additional information beside the |
|
59 |
-- 'InstanceInfo'. We also need to know whether the instance information was |
|
60 |
-- found on the primary node, and encode this as a Bool. |
|
61 |
type LiveInfo = (InstanceInfo, Bool) |
|
60 |
-- | The LiveInfo consists of two entries whose presence is independent. |
|
61 |
-- The 'InstanceInfo' is the live instance information, accompanied by a bool |
|
62 |
-- signifying if it was found on its designated primary node or not. |
|
63 |
-- The 'InstanceConsoleInfo' describes how to connect to an instance. |
|
64 |
-- Any combination of these may or may not be present, depending on node and |
|
65 |
-- instance availability. |
|
66 |
type LiveInfo = (Maybe (InstanceInfo, Bool), Maybe InstanceConsoleInfo) |
|
62 | 67 |
|
63 |
-- | Runtime possibly containing the 'LiveInfo'. See the genericQuery function
|
|
64 |
-- in the Query.hs file for an explanation of the terms used.
|
|
65 |
type Runtime = Either RpcError (Maybe LiveInfo)
|
|
68 |
-- | Runtime containing the 'LiveInfo'. See the genericQuery function in
|
|
69 |
-- the Query.hs file for an explanation of the terms used. |
|
70 |
type Runtime = Either RpcError LiveInfo
|
|
66 | 71 |
|
67 | 72 |
-- | The instance fields map. |
68 | 73 |
fieldsMap :: FieldMap Instance Runtime |
... | ... | |
138 | 143 |
-- Instance parameter fields, whole |
139 | 144 |
[ (FieldDefinition "hvparams" "HypervisorParameters" QFTOther |
140 | 145 |
"Hypervisor parameters (merged)", |
141 |
FieldConfig ((rsNormal .) . getFilledInstHvParams), QffNormal) |
|
142 |
, (FieldDefinition "beparams" "BackendParameters" QFTOther |
|
146 |
FieldConfig |
|
147 |
((rsNormal .) . getFilledInstHvParams (C.toList C.hvcGlobals)), |
|
148 |
QffNormal), |
|
149 |
|
|
150 |
(FieldDefinition "beparams" "BackendParameters" QFTOther |
|
143 | 151 |
"Backend parameters (merged)", |
144 | 152 |
FieldConfig ((rsErrorNoData .) . getFilledInstBeParams), QffNormal) |
145 | 153 |
, (FieldDefinition "osparams" "OpSysParameters" QFTOther |
... | ... | |
289 | 297 |
FieldConfigRuntime statusExtract, QffNormal) |
290 | 298 |
, (FieldDefinition "oper_state" "Running" QFTBool |
291 | 299 |
"Actual state of instance", |
292 |
FieldRuntime operStatusExtract, QffNormal) |
|
300 |
FieldRuntime operStatusExtract, QffNormal), |
|
301 |
|
|
302 |
(FieldDefinition "console" "Console" QFTOther |
|
303 |
"Instance console information", |
|
304 |
FieldRuntime consoleExtract, QffNormal) |
|
293 | 305 |
] ++ |
294 | 306 |
|
295 | 307 |
-- Simple live fields |
... | ... | |
522 | 534 |
-> ConfigData -> Instance -> ResultEntry |
523 | 535 |
hvParamGetter field cfg inst = |
524 | 536 |
rsMaybeUnavail . Map.lookup field . fromContainer $ |
525 |
getFilledInstHvParams cfg inst
|
|
537 |
getFilledInstHvParams (C.toList C.hvcGlobals) cfg inst
|
|
526 | 538 |
|
527 | 539 |
-- * Live fields functionality |
528 | 540 |
|
... | ... | |
542 | 554 |
instanceLiveFieldExtract n _ _ = J.showJSON $ |
543 | 555 |
"The field " ++ n ++ " is not an expected or extractable live field!" |
544 | 556 |
|
545 |
-- | Helper for extracting field from RPC result.
|
|
557 |
-- | Helper for extracting an instance live field from the RPC results.
|
|
546 | 558 |
instanceLiveRpcCall :: FieldName -> Runtime -> Instance -> ResultEntry |
547 |
instanceLiveRpcCall fname (Right (Just (res, _))) inst = |
|
559 |
instanceLiveRpcCall fname (Right (Just (res, _), _)) inst =
|
|
548 | 560 |
case instanceLiveFieldExtract fname res inst of |
549 | 561 |
J.JSNull -> rsNoData |
550 | 562 |
x -> rsNormal x |
551 |
instanceLiveRpcCall _ (Right Nothing) _ = rsUnavail
|
|
563 |
instanceLiveRpcCall _ (Right (Nothing, _)) _ = rsUnavail
|
|
552 | 564 |
instanceLiveRpcCall _ (Left err) _ = |
553 | 565 |
ResultEntry (rpcErrorToStatus err) Nothing |
554 | 566 |
|
... | ... | |
593 | 605 |
Bad _ -> error "Programmer error - result assumed to be OK is Bad!" |
594 | 606 |
|
595 | 607 |
-- | Determines the status of a live instance |
596 |
liveInstanceStatus :: LiveInfo -> Instance -> InstanceStatus
|
|
608 |
liveInstanceStatus :: (InstanceInfo, Bool) -> Instance -> InstanceStatus
|
|
597 | 609 |
liveInstanceStatus (_, foundOnPrimary) inst |
598 | 610 |
| not foundOnPrimary = WrongNode |
599 | 611 |
| adminState == AdminUp = Running |
... | ... | |
618 | 630 |
determineInstanceStatus cfg res inst |
619 | 631 |
| isPrimaryOffline cfg inst = NodeOffline |
620 | 632 |
| otherwise = case res of |
621 |
Left _ -> NodeDown
|
|
622 |
Right (Just liveData) -> liveInstanceStatus liveData inst
|
|
623 |
Right Nothing -> deadInstanceStatus inst
|
|
633 |
Left _ -> NodeDown
|
|
634 |
Right (Just liveData, _) -> liveInstanceStatus liveData inst
|
|
635 |
Right (Nothing, _) -> deadInstanceStatus inst
|
|
624 | 636 |
|
625 | 637 |
-- | Extracts the instance status, retrieving it using the functions above and |
626 | 638 |
-- transforming it into a 'ResultEntry'. |
... | ... | |
634 | 646 |
operStatusExtract res _ = |
635 | 647 |
rsMaybeNoData $ J.showJSON <$> |
636 | 648 |
case res of |
637 |
Left _ -> Nothing |
|
638 |
Right x -> Just $ isJust x |
|
649 |
Left _ -> Nothing |
|
650 |
Right (x, _) -> Just $ isJust x |
|
651 |
|
|
652 |
-- | Extracts the console connection information |
|
653 |
consoleExtract :: Runtime -> Instance -> ResultEntry |
|
654 |
consoleExtract (Left err) _ = ResultEntry (rpcErrorToStatus err) Nothing |
|
655 |
consoleExtract (Right (_, val)) _ = rsMaybeNoData val |
|
639 | 656 |
|
640 | 657 |
-- * Helper functions extracting information as necessary for the generic query |
641 | 658 |
-- interfaces |
642 | 659 |
|
660 |
-- | This function checks if a node with a given uuid has experienced an error |
|
661 |
-- or not. |
|
662 |
checkForNodeError :: [(String, ERpcError a)] |
|
663 |
-> String |
|
664 |
-> Maybe RpcError |
|
665 |
checkForNodeError uuidList uuid = |
|
666 |
case snd <$> pickPairUnique uuid uuidList of |
|
667 |
Just (Left err) -> Just err |
|
668 |
Just (Right _) -> Nothing |
|
669 |
Nothing -> Just . RpcResultError $ |
|
670 |
"Node response not present" |
|
671 |
|
|
643 | 672 |
-- | Finds information about the instance in the info delivered by a node |
644 |
findInstanceInfo :: Instance
|
|
645 |
-> ERpcError RpcResultAllInstancesInfo |
|
646 |
-> Maybe InstanceInfo |
|
647 |
findInstanceInfo inst nodeResponse =
|
|
673 |
findInfoInNodeResult :: Instance
|
|
674 |
-> ERpcError RpcResultAllInstancesInfo
|
|
675 |
-> Maybe InstanceInfo
|
|
676 |
findInfoInNodeResult inst nodeResponse =
|
|
648 | 677 |
case nodeResponse of |
649 | 678 |
Left _err -> Nothing |
650 | 679 |
Right allInfo -> |
... | ... | |
652 | 681 |
maybeMatch = pickPairUnique (instName inst) instances |
653 | 682 |
in snd <$> maybeMatch |
654 | 683 |
|
655 |
-- | Finds the node information ('RPCResultError') or the instance information |
|
656 |
-- (Maybe 'LiveInfo'). |
|
657 |
extractLiveInfo :: [(Node, ERpcError RpcResultAllInstancesInfo)] |
|
658 |
-> Instance |
|
659 |
-> Runtime |
|
660 |
extractLiveInfo nodeResultList inst = |
|
661 |
let uuidResultList = [(nodeUuid x, y) | (x, y) <- nodeResultList] |
|
662 |
pNodeUuid = instPrimaryNode inst |
|
663 |
maybeRPCError = getNodeStatus uuidResultList pNodeUuid |
|
664 |
in case maybeRPCError of |
|
665 |
Just err -> Left err |
|
666 |
Nothing -> Right $ getInstanceStatus uuidResultList pNodeUuid inst |
|
667 |
|
|
668 |
-- | Tries to find out if the node given by the uuid is bad - unreachable or |
|
669 |
-- returning errors, does not mather for the purpose of this call. |
|
670 |
getNodeStatus :: [(String, ERpcError RpcResultAllInstancesInfo)] |
|
671 |
-> String |
|
672 |
-> Maybe RpcError |
|
673 |
getNodeStatus uuidList uuid = |
|
674 |
case snd <$> pickPairUnique uuid uuidList of |
|
675 |
Just (Left err) -> Just err |
|
676 |
Just (Right _) -> Nothing |
|
677 |
Nothing -> Just . RpcResultError $ |
|
678 |
"Primary node response not present" |
|
679 |
|
|
680 | 684 |
-- | Retrieves the instance information if it is present anywhere in the all |
681 | 685 |
-- instances RPC result. Notes if it originates from the primary node. |
682 |
-- All nodes are represented as UUID's for ease of use.
|
|
683 |
getInstanceStatus :: [(String, ERpcError RpcResultAllInstancesInfo)]
|
|
684 |
-> String
|
|
685 |
-> Instance
|
|
686 |
-> Maybe LiveInfo
|
|
687 |
getInstanceStatus uuidList pNodeUuid inst =
|
|
688 |
let primarySearchResult =
|
|
689 |
snd <$> pickPairUnique pNodeUuid uuidList >>= findInstanceInfo inst
|
|
686 |
-- An error is delivered if there is no result, and the primary node is down.
|
|
687 |
getInstanceInfo :: [(String, ERpcError RpcResultAllInstancesInfo)]
|
|
688 |
-> Instance
|
|
689 |
-> ERpcError (Maybe (InstanceInfo, Bool))
|
|
690 |
getInstanceInfo uuidList inst =
|
|
691 |
let pNodeUuid = instPrimaryNode inst
|
|
692 |
primarySearchResult =
|
|
693 |
pickPairUnique pNodeUuid uuidList >>= findInfoInNodeResult inst . snd
|
|
690 | 694 |
in case primarySearchResult of |
691 |
Just instInfo -> Just (instInfo, True)
|
|
695 |
Just instInfo -> Right . Just $ (instInfo, True)
|
|
692 | 696 |
Nothing -> |
693 | 697 |
let allSearchResult = |
694 | 698 |
getFirst . mconcat $ map |
695 |
(First . findInstanceInfo inst . snd) uuidList
|
|
699 |
(First . findInfoInNodeResult inst . snd) uuidList
|
|
696 | 700 |
in case allSearchResult of |
697 |
Just liveInfo -> Just (liveInfo, False) |
|
698 |
Nothing -> Nothing |
|
701 |
Just instInfo -> Right . Just $ (instInfo, False) |
|
702 |
Nothing -> |
|
703 |
case checkForNodeError uuidList pNodeUuid of |
|
704 |
Just err -> Left err |
|
705 |
Nothing -> Right Nothing |
|
706 |
|
|
707 |
-- | Retrieves the console information if present anywhere in the given results |
|
708 |
getConsoleInfo :: [(String, ERpcError RpcResultInstanceConsoleInfo)] |
|
709 |
-> Instance |
|
710 |
-> Maybe InstanceConsoleInfo |
|
711 |
getConsoleInfo uuidList inst = |
|
712 |
let allValidResults = concatMap rpcResInstConsInfoInstancesInfo . |
|
713 |
rights . map snd $ uuidList |
|
714 |
in snd <$> pickPairUnique (instName inst) allValidResults |
|
715 |
|
|
716 |
-- | Extracts all the live information that can be extracted. |
|
717 |
extractLiveInfo :: [(Node, ERpcError RpcResultAllInstancesInfo)] |
|
718 |
-> [(Node, ERpcError RpcResultInstanceConsoleInfo)] |
|
719 |
-> Instance |
|
720 |
-> Runtime |
|
721 |
extractLiveInfo nodeResultList nodeConsoleList inst = |
|
722 |
let uuidConvert = map (\(x, y) -> (nodeUuid x, y)) |
|
723 |
uuidResultList = uuidConvert nodeResultList |
|
724 |
uuidConsoleList = uuidConvert nodeConsoleList |
|
725 |
in case getInstanceInfo uuidResultList inst of |
|
726 |
-- If we can't get the instance info, we can't get the console info either. |
|
727 |
-- Best to propagate the error further. |
|
728 |
Left err -> Left err |
|
729 |
Right res -> Right (res, getConsoleInfo uuidConsoleList inst) |
|
730 |
|
|
731 |
-- | Retrieves all the parameters for the console calls. |
|
732 |
getAllConsoleParams :: ConfigData |
|
733 |
-> [Instance] |
|
734 |
-> ErrorResult [InstanceConsoleInfoParams] |
|
735 |
getAllConsoleParams cfg instances = do |
|
736 |
pNodes <- mapM (getPrimaryNode cfg) instances |
|
737 |
let filledHvParams = map (getFilledInstHvParams [] cfg) instances |
|
738 |
filledBeParams <- mapM (getFilledInstBeParams cfg) instances |
|
739 |
return . map (\(i, n, h, b) -> InstanceConsoleInfoParams i n h b) $ |
|
740 |
zip4 instances pNodes filledHvParams filledBeParams |
|
741 |
|
|
742 |
-- | Compares two params according to their node, needed for grouping. |
|
743 |
compareParamsByNode :: InstanceConsoleInfoParams |
|
744 |
-> InstanceConsoleInfoParams |
|
745 |
-> Bool |
|
746 |
compareParamsByNode x y = instConsInfoParamsNode x == instConsInfoParamsNode y |
|
747 |
|
|
748 |
-- | Groups instance information calls heading out to the same nodes. |
|
749 |
consoleParamsToCalls :: [InstanceConsoleInfoParams] |
|
750 |
-> [(Node, RpcCallInstanceConsoleInfo)] |
|
751 |
consoleParamsToCalls params = |
|
752 |
let sortedParams = sortBy |
|
753 |
(comparing (instPrimaryNode . instConsInfoParamsInstance)) params |
|
754 |
groupedParams = groupBy compareParamsByNode sortedParams |
|
755 |
in map (\x -> case x of |
|
756 |
[] -> error "Programmer error: group must have one or more members" |
|
757 |
paramGroup@(y:_) -> |
|
758 |
let node = instConsInfoParamsNode y |
|
759 |
packer z = (instName $ instConsInfoParamsInstance z, z) |
|
760 |
in (node, RpcCallInstanceConsoleInfo . map packer $ paramGroup) |
|
761 |
) groupedParams |
|
762 |
|
|
763 |
-- | Retrieves a list of all the hypervisors and params used by the given |
|
764 |
-- instances. |
|
765 |
getHypervisorSpecs :: ConfigData -> [Instance] -> [(Hypervisor, HvParams)] |
|
766 |
getHypervisorSpecs cfg instances = |
|
767 |
let hvs = nub . map instHypervisor $ instances |
|
768 |
hvParamMap = (fromContainer . clusterHvparams . configCluster $ cfg) |
|
769 |
in zip hvs . map ((Map.!) hvParamMap . hypervisorToRaw) $ hvs |
|
699 | 770 |
|
700 | 771 |
-- | Collect live data from RPC query if enabled. |
701 | 772 |
collectLiveData :: Bool -> ConfigData -> [Instance] -> IO [(Instance, Runtime)] |
... | ... | |
703 | 774 |
| not liveDataEnabled = return . zip instances . repeat . Left . |
704 | 775 |
RpcResultError $ "Live data disabled" |
705 | 776 |
| otherwise = do |
706 |
let hvSpec = getDefaultHypervisorSpec cfg |
|
707 |
instance_nodes = nub . justOk $ |
|
708 |
map (getNode cfg . instPrimaryNode) instances |
|
709 |
good_nodes = nodesWithValidConfig cfg instance_nodes |
|
710 |
rpcres <- executeRpcCall good_nodes $ RpcCallAllInstancesInfo [hvSpec] |
|
711 |
return . zip instances . map (extractLiveInfo rpcres) $ instances |
|
777 |
let hvSpecs = getHypervisorSpecs cfg instances |
|
778 |
instanceNodes = nub . justOk $ |
|
779 |
map (getNode cfg . instPrimaryNode) instances |
|
780 |
goodNodes = nodesWithValidConfig cfg instanceNodes |
|
781 |
instInfoRes <- executeRpcCall goodNodes (RpcCallAllInstancesInfo hvSpecs) |
|
782 |
consInfoRes <- case getAllConsoleParams cfg instances of |
|
783 |
Bad _ -> return . zip goodNodes . repeat . Left $ RpcResultError |
|
784 |
"Cannot construct parameters for console info call" |
|
785 |
Ok p -> executeRpcCalls $ consoleParamsToCalls p |
|
786 |
return . zip instances . |
|
787 |
map (extractLiveInfo instInfoRes consInfoRes) $ instances |
Also available in: Unified diff