Revision 8472a321
b/Ganeti/HTools/CLI.hs | ||
---|---|---|
98 | 98 |
-- | External tool data loader from a variety of sources |
99 | 99 |
loadExternalData :: (EToolOptions a) => |
100 | 100 |
a |
101 |
-> IO (NodeList, InstanceList, String, NameList, NameList)
|
|
101 |
-> IO (NodeList, InstanceList, String) |
|
102 | 102 |
loadExternalData opts = do |
103 | 103 |
(env_node, env_inst) <- parseEnv () |
104 | 104 |
let nodef = if nodeSet opts then nodeFile opts |
... | ... | |
111 | 111 |
host -> Rapi.loadData host |
112 | 112 |
|
113 | 113 |
let ldresult = input_data >>= Loader.mergeData |
114 |
(loaded_nl, il, csf, ktn, kti) <-
|
|
114 |
(loaded_nl, il, csf) <- |
|
115 | 115 |
(case ldresult of |
116 | 116 |
Ok x -> return x |
117 | 117 |
Bad s -> do |
... | ... | |
124 | 124 |
putStrLn "Warning: cluster has inconsistent data:" |
125 | 125 |
putStrLn . unlines . map (\s -> printf " - %s" s) $ fix_msgs |
126 | 126 |
|
127 |
return (fixed_nl, il, csf, ktn, kti) |
|
127 |
return (fixed_nl, il, csf) |
b/Ganeti/HTools/IAlloc.hs | ||
---|---|---|
26 | 26 |
| Relocate Int |
27 | 27 |
deriving (Show) |
28 | 28 |
|
29 |
data Request = Request RqType NodeList InstanceList String NameList NameList
|
|
29 |
data Request = Request RqType NodeList InstanceList String |
|
30 | 30 |
deriving (Show) |
31 | 31 |
|
32 | 32 |
parseBaseInstance :: String |
... | ... | |
101 | 101 |
ridx <- lookupNode kti rname rname |
102 | 102 |
return $ Relocate ridx |
103 | 103 |
other -> fail $ ("Invalid request type '" ++ other ++ "'") |
104 |
(map_n, map_i, csf, xtn, xti) <- mergeData (ktn, nl, kti, il)
|
|
105 |
return $ Request rqtype map_n map_i csf xtn xti
|
|
104 |
(map_n, map_i, csf) <- mergeData (ktn, nl, kti, il) |
|
105 |
return $ Request rqtype map_n map_i csf |
|
106 | 106 |
|
107 | 107 |
formatResponse :: Bool -> String -> [String] -> String |
108 | 108 |
formatResponse success info nodes = |
b/Ganeti/HTools/Loader.hs | ||
---|---|---|
68 | 68 |
|
69 | 69 |
-- | Compute the longest common suffix of a NameList list that |
70 | 70 |
-- | starts with a dot |
71 |
longestDomain :: NameList -> String
|
|
71 |
longestDomain :: [String] -> String
|
|
72 | 72 |
longestDomain [] = "" |
73 |
longestDomain ((_,x):xs) = |
|
74 |
let |
|
75 |
onlyStrings = snd $ unzip xs |
|
76 |
in |
|
77 |
foldr (\ suffix accu -> if all (isSuffixOf suffix) onlyStrings |
|
73 |
longestDomain (x:xs) = |
|
74 |
foldr (\ suffix accu -> if all (isSuffixOf suffix) xs |
|
78 | 75 |
then suffix |
79 | 76 |
else accu) |
80 | 77 |
"" $ filter (isPrefixOf ".") (tails x) |
... | ... | |
89 | 86 |
[(String, Int)], Instance.AssocList) -- ^ Data from either |
90 | 87 |
-- Text.loadData |
91 | 88 |
-- or Rapi.loadData |
92 |
-> Result (NodeList, InstanceList, String, NameList, NameList)
|
|
89 |
-> Result (NodeList, InstanceList, String) |
|
93 | 90 |
mergeData (ktn, nl, kti, il) = do |
94 | 91 |
let |
95 | 92 |
nl2 = fixNodes nl il |
96 | 93 |
il3 = Container.fromAssocList il |
97 | 94 |
nl3 = Container.fromAssocList |
98 | 95 |
(map (\ (k, v) -> (k, Node.buildPeers v il3 (length nl2))) nl2) |
99 |
xtn = swapPairs ktn
|
|
100 |
xti = swapPairs kti
|
|
101 |
common_suffix = longestDomain (xti ++ xtn)
|
|
96 |
node_names = map Node.name $ Container.elems nl3
|
|
97 |
inst_names = map Instance.name $ Container.elems il3
|
|
98 |
common_suffix = longestDomain (node_names ++ inst_names)
|
|
102 | 99 |
csl = length common_suffix |
103 |
stn = map (\(x, y) -> (x, stripSuffix csl y)) xtn |
|
104 |
sti = map (\(x, y) -> (x, stripSuffix csl y)) xti |
|
105 | 100 |
snl = Container.map (\n -> setName n (stripSuffix csl $ name n)) nl3 |
106 | 101 |
sil = Container.map (\i -> setName i (stripSuffix csl $ name i)) il3 |
107 |
return (snl, sil, common_suffix, stn, sti)
|
|
102 |
return (snl, sil, common_suffix) |
|
108 | 103 |
|
109 | 104 |
-- | Check cluster data for consistency |
110 | 105 |
checkData :: NodeList -> InstanceList |
b/hbal.hs | ||
---|---|---|
181 | 181 |
let oneline = optOneline opts |
182 | 182 |
verbose = optVerbose opts |
183 | 183 |
|
184 |
(fixed_nl, il, csf, _, _) <- CLI.loadExternalData opts
|
|
184 |
(fixed_nl, il, csf) <- CLI.loadExternalData opts |
|
185 | 185 |
|
186 | 186 |
let offline_names = optOffline opts |
187 | 187 |
all_nodes = Container.elems fixed_nl |
b/hn1.hs | ||
---|---|---|
145 | 145 |
hPutStrLn stderr "Error: this program doesn't take any arguments." |
146 | 146 |
exitWith $ ExitFailure 1 |
147 | 147 |
|
148 |
(nl, il, csf, _, _) <- CLI.loadExternalData opts
|
|
148 |
(nl, il, csf) <- CLI.loadExternalData opts |
|
149 | 149 |
|
150 | 150 |
printf "Loaded %d nodes, %d instances\n" |
151 | 151 |
(Container.size nl) |
b/hscan.hs | ||
---|---|---|
6 | 6 |
|
7 | 7 |
import Data.List |
8 | 8 |
import Data.Function |
9 |
import Data.Maybe(fromJust) |
|
10 | 9 |
import Monad |
11 | 10 |
import System |
12 | 11 |
import System.IO |
... | ... | |
162 | 161 |
Bad err -> printf "\nError: failed to load data. \ |
163 | 162 |
\Details:\n%s\n" err |
164 | 163 |
Ok x -> do |
165 |
let (nl, il, csf, _, _) = x
|
|
164 |
let (nl, il, csf) = x |
|
166 | 165 |
(_, fix_nl) = Loader.checkData nl il |
167 | 166 |
putStrLn $ printCluster fix_nl il |
168 | 167 |
when (optShowNodes opts) $ do |
Also available in: Unified diff